{-# LANGUAGE UndecidableInstances #-}

module Tendermint.SDK.Application.Module
  ( Module(..)
  , Component
  , ModuleEffs
  , ModuleList(..)
  , Application(..)
  , ToApplication(..)
  , hoistApplication
  , Eval(..)
  , makeApplication
  , applyAnteHandler

  ) where

import           Data.Kind                           (Type)
import           Data.Proxy
import           GHC.TypeLits                        (ErrorMessage (..), Symbol,
                                                      TypeError)
import qualified Network.ABCI.Types.Messages.Request as Req
import           Polysemy                            (EffectRow, Members, Sem)
import           Servant.API                         ((:<|>) (..), (:>))
import           Tendermint.SDK.BaseApp              ((:&), BaseAppEffs,
                                                      BaseEffs)
import           Tendermint.SDK.BaseApp.Block
import qualified Tendermint.SDK.BaseApp.Query        as Q
import           Tendermint.SDK.BaseApp.Store        (Scope (..))
import qualified Tendermint.SDK.BaseApp.Transaction  as T
-- import qualified Network.ABCI.Types.Messages.Response     as Resp

type Component = EffectRow -> Type

-- NOTE: This does not pull in transitive dependencies on purpose to avoid
-- unintended enlarged scope
type family DependencyEffs (ms :: [Component]) :: EffectRow where
  DependencyEffs '[] = '[]
  DependencyEffs (Module _ _ _ _ es deps ': rest) = es :& DependencyEffs rest
  DependencyEffs _ = TypeError ('Text "DependencyEffs is a partial function defined only on partially applied Modules")

data Module (name :: Symbol) (check :: Type) (deliver :: Type) (query :: Type) (es :: EffectRow) (deps :: [Component]) (r :: EffectRow) = Module
  { Module name check deliver query es deps r -> RouteTx check r
moduleTxChecker :: T.RouteTx check r
  , Module name check deliver query es deps r -> RouteTx deliver r
moduleTxDeliverer :: T.RouteTx deliver r
  , Module name check deliver query es deps r -> RouteQ query r
moduleQuerier :: Q.RouteQ query r
  , Module name check deliver query es deps r
-> forall (s :: [(* -> *) -> * -> *]) a.
   (Members TxEffs s, Members BaseEffs s,
    Members (DependencyEffs deps) s) =>
   Sem (es :& s) a -> Sem s a
moduleEval :: forall s. (Members T.TxEffs s, Members BaseEffs s, Members (DependencyEffs deps) s) => forall a. Sem (es :& s) a -> Sem s a
  }

type family ModuleEffs (m :: Component) :: EffectRow where
  ModuleEffs (Module _ _ _ _ es deps) = es :& DependencyEffs deps :& T.TxEffs :& BaseEffs
  ModuleEffs _ = TypeError ('Text "ModuleEffs is a partial function defined only on Component")

data ModuleList (ms :: [Component]) r where
  NilModules :: ModuleList '[] r
  (:+) :: Module name check deliver query es deps r
       -> ModuleList ms r
       -> ModuleList (Module name check deliver query es deps ': ms) r

infixr 5 :+

data Application check deliver query r s = Application
  { Application check deliver query r s -> RouteTx check r
applicationTxChecker    :: T.RouteTx check r
  , Application check deliver query r s -> RouteTx deliver r
applicationTxDeliverer  :: T.RouteTx deliver r
  , Application check deliver query r s -> RouteQ query s
applicationQuerier      :: Q.RouteQ query s
  , Application check deliver query r s -> BeginBlock -> Sem r ()
applicationBeginBlocker :: Req.BeginBlock -> Sem r ()
  , Application check deliver query r s
-> EndBlock -> Sem r EndBlockResult
applicationEndBlocker   :: Req.EndBlock -> Sem r EndBlockResult
  }

class ToApplication ms r where
  type ApplicationC ms :: Type
  type ApplicationD ms :: Type
  type ApplicationQ ms :: Type

  toApplication :: ModuleList ms r -> Application (ApplicationC ms) (ApplicationD ms) (ApplicationQ ms) r r

instance ToApplication '[Module name check deliver query es deps] r where
  type ApplicationC '[Module name check deliver query es deps] = name :> check
  type ApplicationD '[Module name check deliver query es deps] = name :> deliver
  type ApplicationQ '[Module name check deliver query es deps] = name :> query

  toApplication :: ModuleList '[Module name check deliver query es deps] r
-> Application
     (ApplicationC '[Module name check deliver query es deps])
     (ApplicationD '[Module name check deliver query es deps])
     (ApplicationQ '[Module name check deliver query es deps])
     r
     r
toApplication (Module{..} :+ NilModules) =
    Application :: forall k k k (check :: k) (deliver :: k) (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
RouteTx check r
-> RouteTx deliver r
-> RouteQ query s
-> (BeginBlock -> Sem r ())
-> (EndBlock -> Sem r EndBlockResult)
-> Application check deliver query r s
Application
      { applicationTxChecker :: RouteTx (name :> check) r
applicationTxChecker = RouteTx check r
RouteTx (name :> check) r
moduleTxChecker
      , applicationTxDeliverer :: RouteTx (name :> deliver) r
applicationTxDeliverer = RouteTx deliver r
RouteTx (name :> deliver) r
moduleTxDeliverer
      , applicationQuerier :: RouteQ (name :> query) r
applicationQuerier = RouteQ query r
RouteQ (name :> query) r
moduleQuerier
      , applicationBeginBlocker :: BeginBlock -> Sem r ()
applicationBeginBlocker = BeginBlock -> Sem r ()
forall (r :: [(* -> *) -> * -> *]). BeginBlock -> Sem r ()
defaultBeginBlocker
      , applicationEndBlocker :: EndBlock -> Sem r EndBlockResult
applicationEndBlocker = EndBlock -> Sem r EndBlockResult
forall (r :: [(* -> *) -> * -> *]).
EndBlock -> Sem r EndBlockResult
defaultEndBlocker
      }

instance ToApplication (m' ': ms) r => ToApplication (Module name check deliver query es deps ': m' ': ms) r where
  type ApplicationC (Module name check deliver query es deps ': m' ': ms) = (name :> check) :<|> ApplicationC (m' ': ms)
  type ApplicationD (Module name check deliver query es deps ': m' ': ms) = (name :> deliver) :<|> ApplicationD (m' ': ms)
  type ApplicationQ (Module name check deliver query es deps ': m' ': ms) = (name :> query) :<|> ApplicationQ (m' ': ms)

  toApplication :: ModuleList (Module name check deliver query es deps : m' : ms) r
-> Application
     (ApplicationC (Module name check deliver query es deps : m' : ms))
     (ApplicationD (Module name check deliver query es deps : m' : ms))
     (ApplicationQ (Module name check deliver query es deps : m' : ms))
     r
     r
toApplication (Module{..} :+ rest :: ModuleList ms r
rest) =
    let app :: Application
  (ApplicationC ms) (ApplicationD ms) (ApplicationQ ms) r r
app = ModuleList ms r
-> Application
     (ApplicationC ms) (ApplicationD ms) (ApplicationQ ms) r r
forall (ms :: [[(* -> *) -> * -> *] -> *])
       (r :: [(* -> *) -> * -> *]).
ToApplication ms r =>
ModuleList ms r
-> Application
     (ApplicationC ms) (ApplicationD ms) (ApplicationQ ms) r r
toApplication ModuleList ms r
rest
    in Application :: forall k k k (check :: k) (deliver :: k) (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
RouteTx check r
-> RouteTx deliver r
-> RouteQ query s
-> (BeginBlock -> Sem r ())
-> (EndBlock -> Sem r EndBlockResult)
-> Application check deliver query r s
Application
         { applicationTxChecker :: RouteTx ((name :> check) :<|> ApplicationC (m' : ms)) r
applicationTxChecker = RouteTx check r
RouteTx check r
moduleTxChecker RouteTx check r
-> RouteTx (ApplicationC (m' : ms)) r
-> RouteTx check r :<|> RouteTx (ApplicationC (m' : ms)) r
forall a b. a -> b -> a :<|> b
:<|> Application
  (ApplicationC (m' : ms))
  (ApplicationD (m' : ms))
  (ApplicationQ (m' : ms))
  r
  r
-> RouteTx (ApplicationC (m' : ms)) r
forall k (check :: k) k (deliver :: k) k (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
Application check deliver query r s -> RouteTx check r
applicationTxChecker Application
  (ApplicationC ms) (ApplicationD ms) (ApplicationQ ms) r r
Application
  (ApplicationC (m' : ms))
  (ApplicationD (m' : ms))
  (ApplicationQ (m' : ms))
  r
  r
app
         , applicationTxDeliverer :: RouteTx ((name :> deliver) :<|> ApplicationD (m' : ms)) r
applicationTxDeliverer = RouteTx deliver r
RouteTx deliver r
moduleTxDeliverer RouteTx deliver r
-> RouteTx (ApplicationD (m' : ms)) r
-> RouteTx deliver r :<|> RouteTx (ApplicationD (m' : ms)) r
forall a b. a -> b -> a :<|> b
:<|> Application
  (ApplicationC (m' : ms))
  (ApplicationD (m' : ms))
  (ApplicationQ (m' : ms))
  r
  r
-> RouteTx (ApplicationD (m' : ms)) r
forall k (check :: k) k (deliver :: k) k (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
Application check deliver query r s -> RouteTx deliver r
applicationTxDeliverer Application
  (ApplicationC ms) (ApplicationD ms) (ApplicationQ ms) r r
Application
  (ApplicationC (m' : ms))
  (ApplicationD (m' : ms))
  (ApplicationQ (m' : ms))
  r
  r
app
         , applicationQuerier :: RouteQ ((name :> query) :<|> ApplicationQ (m' : ms)) r
applicationQuerier = RouteQ query r
RouteQ query r
moduleQuerier RouteQ query r
-> RouteQ (ApplicationQ (m' : ms)) r
-> RouteQ query r :<|> RouteQ (ApplicationQ (m' : ms)) r
forall a b. a -> b -> a :<|> b
:<|> Application
  (ApplicationC (m' : ms))
  (ApplicationD (m' : ms))
  (ApplicationQ (m' : ms))
  r
  r
-> RouteQ (ApplicationQ (m' : ms)) r
forall k (check :: k) k (deliver :: k) k (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
Application check deliver query r s -> RouteQ query s
applicationQuerier Application
  (ApplicationC ms) (ApplicationD ms) (ApplicationQ ms) r r
Application
  (ApplicationC (m' : ms))
  (ApplicationD (m' : ms))
  (ApplicationQ (m' : ms))
  r
  r
app
         , applicationBeginBlocker :: BeginBlock -> Sem r ()
applicationBeginBlocker = BeginBlock -> Sem r ()
forall (r :: [(* -> *) -> * -> *]). BeginBlock -> Sem r ()
defaultBeginBlocker
         , applicationEndBlocker :: EndBlock -> Sem r EndBlockResult
applicationEndBlocker = EndBlock -> Sem r EndBlockResult
forall (r :: [(* -> *) -> * -> *]).
EndBlock -> Sem r EndBlockResult
defaultEndBlocker
         }

hoistApplication
  :: T.HasTxRouter check r 'QueryAndMempool
  => T.HasTxRouter deliver r 'Consensus
  => Q.HasQueryRouter query s
  => (forall a. Sem r a -> Sem r' a)
  -> (forall a. Sem s a -> Sem s' a)
  -> Application check deliver query r s
  -> Application check deliver query r' s'
hoistApplication :: (forall a. Sem r a -> Sem r' a)
-> (forall a. Sem s a -> Sem s' a)
-> Application check deliver query r s
-> Application check deliver query r' s'
hoistApplication natT :: forall a. Sem r a -> Sem r' a
natT natQ :: forall a. Sem s a -> Sem s' a
natQ (Application check deliver query r s
app :: Application check deliver query r s) =
  Application :: forall k k k (check :: k) (deliver :: k) (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
RouteTx check r
-> RouteTx deliver r
-> RouteQ query s
-> (BeginBlock -> Sem r ())
-> (EndBlock -> Sem r EndBlockResult)
-> Application check deliver query r s
Application
    { applicationTxChecker :: RouteTx check r'
applicationTxChecker = Proxy check
-> Proxy r
-> Proxy 'QueryAndMempool
-> (forall a. Sem r a -> Sem r' a)
-> RouteTx check r
-> RouteTx check r'
forall k (layout :: k) (r :: [(* -> *) -> * -> *]) (scope :: Scope)
       (s :: [(* -> *) -> * -> *]) (s' :: [(* -> *) -> * -> *]).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx layout s
-> RouteTx layout s'
T.hoistTxRouter (Proxy check
forall k (t :: k). Proxy t
Proxy @check) (Proxy r
forall k (t :: k). Proxy t
Proxy @r) (Proxy 'QueryAndMempool
forall k (t :: k). Proxy t
Proxy @'QueryAndMempool) forall a. Sem r a -> Sem r' a
natT (RouteTx check r -> RouteTx check r')
-> RouteTx check r -> RouteTx check r'
forall a b. (a -> b) -> a -> b
$ Application check deliver query r s -> RouteTx check r
forall k (check :: k) k (deliver :: k) k (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
Application check deliver query r s -> RouteTx check r
applicationTxChecker Application check deliver query r s
app
    , applicationTxDeliverer :: RouteTx deliver r'
applicationTxDeliverer = Proxy deliver
-> Proxy r
-> Proxy 'Consensus
-> (forall a. Sem r a -> Sem r' a)
-> RouteTx deliver r
-> RouteTx deliver r'
forall k (layout :: k) (r :: [(* -> *) -> * -> *]) (scope :: Scope)
       (s :: [(* -> *) -> * -> *]) (s' :: [(* -> *) -> * -> *]).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx layout s
-> RouteTx layout s'
T.hoistTxRouter (Proxy deliver
forall k (t :: k). Proxy t
Proxy @deliver) (Proxy r
forall k (t :: k). Proxy t
Proxy @r) (Proxy 'Consensus
forall k (t :: k). Proxy t
Proxy @'Consensus) forall a. Sem r a -> Sem r' a
natT (RouteTx deliver r -> RouteTx deliver r')
-> RouteTx deliver r -> RouteTx deliver r'
forall a b. (a -> b) -> a -> b
$ Application check deliver query r s -> RouteTx deliver r
forall k (check :: k) k (deliver :: k) k (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
Application check deliver query r s -> RouteTx deliver r
applicationTxDeliverer Application check deliver query r s
app
    , applicationQuerier :: RouteQ query s'
applicationQuerier = Proxy query
-> Proxy s
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ query s
-> RouteQ query s'
forall k (layout :: k) (r :: [(* -> *) -> * -> *])
       (s :: [(* -> *) -> * -> *]) (s' :: [(* -> *) -> * -> *]).
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> (forall a. Sem s a -> Sem s' a)
-> RouteQ layout s
-> RouteQ layout s'
Q.hoistQueryRouter (Proxy query
forall k (t :: k). Proxy t
Proxy @query) (Proxy s
forall k (t :: k). Proxy t
Proxy @s) forall a. Sem s a -> Sem s' a
natQ (RouteQ query s -> RouteQ query s')
-> RouteQ query s -> RouteQ query s'
forall a b. (a -> b) -> a -> b
$ Application check deliver query r s -> RouteQ query s
forall k (check :: k) k (deliver :: k) k (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
Application check deliver query r s -> RouteQ query s
applicationQuerier Application check deliver query r s
app
    , applicationBeginBlocker :: BeginBlock -> Sem r' ()
applicationBeginBlocker = Sem r () -> Sem r' ()
forall a. Sem r a -> Sem r' a
natT (Sem r () -> Sem r' ())
-> (BeginBlock -> Sem r ()) -> BeginBlock -> Sem r' ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Application check deliver query r s -> BeginBlock -> Sem r ()
forall k (check :: k) k (deliver :: k) k (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
Application check deliver query r s -> BeginBlock -> Sem r ()
applicationBeginBlocker Application check deliver query r s
app
    , applicationEndBlocker :: EndBlock -> Sem r' EndBlockResult
applicationEndBlocker = Sem r EndBlockResult -> Sem r' EndBlockResult
forall a. Sem r a -> Sem r' a
natT (Sem r EndBlockResult -> Sem r' EndBlockResult)
-> (EndBlock -> Sem r EndBlockResult)
-> EndBlock
-> Sem r' EndBlockResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Application check deliver query r s
-> EndBlock -> Sem r EndBlockResult
forall k (check :: k) k (deliver :: k) k (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
Application check deliver query r s
-> EndBlock -> Sem r EndBlockResult
applicationEndBlocker Application check deliver query r s
app
    }

class Eval ms (core :: EffectRow) where
  type Effs ms core :: EffectRow
  eval
    :: proxy core
    -> ModuleList ms r
    -> forall a.
       Sem (Effs ms core) a
    -> Sem (T.TxEffs :& BaseAppEffs core) a

instance (DependencyEffs deps ~ '[]) => Eval '[Module name check deliver query es deps] core where
  type Effs '[Module name check deliver query es deps] core = es :& T.TxEffs :& BaseAppEffs core
  eval :: proxy core
-> ModuleList '[Module name check deliver query es deps] r
-> forall a.
   Sem (Effs '[Module name check deliver query es deps] core) a
   -> Sem (TxEffs :& BaseAppEffs core) a
eval _ (m :: Module name check deliver query es deps r
m :+ NilModules) = Module name check deliver query es deps r
-> forall (s :: [(* -> *) -> * -> *]) a.
   (Members TxEffs s, Members BaseEffs s,
    Members (DependencyEffs deps) s) =>
   Sem (es :& s) a -> Sem s a
forall (name :: Symbol) check deliver query
       (es :: [(* -> *) -> * -> *]) (deps :: [[(* -> *) -> * -> *] -> *])
       (r :: [(* -> *) -> * -> *]).
Module name check deliver query es deps r
-> forall (s :: [(* -> *) -> * -> *]) a.
   (Members TxEffs s, Members BaseEffs s,
    Members (DependencyEffs deps) s) =>
   Sem (es :& s) a -> Sem s a
moduleEval Module name check deliver query es deps r
m

instance ( Members (DependencyEffs deps) (Effs (m' ': ms) s)
         , Members T.TxEffs (Effs (m' ': ms) s)
         , Members BaseEffs (Effs (m' ': ms) s)
         , Eval (m' ': ms) s
         ) => Eval (Module name check deliver query es deps ': m' ': ms) s where
  type Effs (Module name check deliver query es deps ': m' ': ms) s = es :& (Effs (m': ms)) s
  eval :: proxy s
-> ModuleList (Module name check deliver query es deps : m' : ms) r
-> forall a.
   Sem (Effs (Module name check deliver query es deps : m' : ms) s) a
   -> Sem (TxEffs :& BaseAppEffs s) a
eval pcore :: proxy s
pcore (m :: Module name check deliver query es deps r
m :+ rest :: ModuleList ms r
rest) = proxy s
-> ModuleList ms r
-> forall a. Sem (Effs ms s) a -> Sem (TxEffs :& BaseAppEffs s) a
forall (ms :: [[(* -> *) -> * -> *] -> *])
       (core :: [(* -> *) -> * -> *]) (proxy :: [(* -> *) -> * -> *] -> *)
       (r :: [(* -> *) -> * -> *]).
Eval ms core =>
proxy core
-> ModuleList ms r
-> forall a.
   Sem (Effs ms core) a -> Sem (TxEffs :& BaseAppEffs core) a
eval proxy s
pcore ModuleList ms r
rest (Sem (Effs (m' : ms) s) a
 -> Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError
         : Tagged 'Consensus ReadStore : Tagged 'QueryAndMempool ReadStore
         : Tagged 'Consensus WriteStore : Transaction : CommitBlock
         : Metrics : Logger : Resource : Error AppError : s)
      a)
-> (Sem (es :& Effs (m' : ms) s) a -> Sem (Effs (m' : ms) s) a)
-> Sem (es :& Effs (m' : ms) s) a
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError
        : Tagged 'Consensus ReadStore : Tagged 'QueryAndMempool ReadStore
        : Tagged 'Consensus WriteStore : Transaction : CommitBlock
        : Metrics : Logger : Resource : Error AppError : s)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module name check deliver query es deps r
-> forall (s :: [(* -> *) -> * -> *]) a.
   (Members TxEffs s, Members BaseEffs s,
    Members (DependencyEffs deps) s) =>
   Sem (es :& s) a -> Sem s a
forall (name :: Symbol) check deliver query
       (es :: [(* -> *) -> * -> *]) (deps :: [[(* -> *) -> * -> *] -> *])
       (r :: [(* -> *) -> * -> *]).
Module name check deliver query es deps r
-> forall (s :: [(* -> *) -> * -> *]) a.
   (Members TxEffs s, Members BaseEffs s,
    Members (DependencyEffs deps) s) =>
   Sem (es :& s) a -> Sem s a
moduleEval Module name check deliver query es deps r
m

makeApplication
  :: Eval ms core
  => ToApplication ms (Effs ms core)
  => T.HasTxRouter (ApplicationC ms) (Effs ms core) 'QueryAndMempool
  => T.HasTxRouter (ApplicationD ms) (Effs ms core) 'Consensus
  => Q.HasQueryRouter (ApplicationQ ms) (Effs ms core)
  => Proxy core
  -> T.AnteHandler (Effs ms core)
  -> ModuleList ms (Effs ms core)
  -> (Req.BeginBlock -> Sem (Effs ms core) ())
  -> (Req.EndBlock -> Sem (Effs ms core) EndBlockResult)
  -> Application (ApplicationC ms) (ApplicationD ms) (ApplicationQ ms) (T.TxEffs :& BaseAppEffs core) (Q.QueryEffs :& BaseAppEffs core)
makeApplication :: Proxy core
-> AnteHandler (Effs ms core)
-> ModuleList ms (Effs ms core)
-> (BeginBlock -> Sem (Effs ms core) ())
-> (EndBlock -> Sem (Effs ms core) EndBlockResult)
-> Application
     (ApplicationC ms)
     (ApplicationD ms)
     (ApplicationQ ms)
     (TxEffs :& BaseAppEffs core)
     (QueryEffs :& BaseAppEffs core)
makeApplication p :: Proxy core
p@(Proxy core
Proxy :: Proxy core) ah :: AnteHandler (Effs ms core)
ah (ms :: ModuleList ms (Effs ms core)) beginBlocker :: BeginBlock -> Sem (Effs ms core) ()
beginBlocker endBlocker :: EndBlock -> Sem (Effs ms core) EndBlockResult
endBlocker =
  let app :: Application
  (ApplicationC ms)
  (ApplicationD ms)
  (ApplicationQ ms)
  (Effs ms core)
  (Effs ms core)
app = AnteHandler (Effs ms core)
-> Application
     (ApplicationC ms)
     (ApplicationD ms)
     (ApplicationQ ms)
     (Effs ms core)
     (Effs ms core)
-> Application
     (ApplicationC ms)
     (ApplicationD ms)
     (ApplicationQ ms)
     (Effs ms core)
     (Effs ms core)
forall k k k (check :: k) (r :: [(* -> *) -> * -> *])
       (deliver :: k) (query :: k) (s :: [(* -> *) -> * -> *]).
(HasTxRouter check r 'QueryAndMempool,
 HasTxRouter deliver r 'Consensus) =>
AnteHandler r
-> Application check deliver query r s
-> Application check deliver query r s
applyAnteHandler AnteHandler (Effs ms core)
ah (Application
   (ApplicationC ms)
   (ApplicationD ms)
   (ApplicationQ ms)
   (Effs ms core)
   (Effs ms core)
 -> Application
      (ApplicationC ms)
      (ApplicationD ms)
      (ApplicationQ ms)
      (Effs ms core)
      (Effs ms core))
-> Application
     (ApplicationC ms)
     (ApplicationD ms)
     (ApplicationQ ms)
     (Effs ms core)
     (Effs ms core)
-> Application
     (ApplicationC ms)
     (ApplicationD ms)
     (ApplicationQ ms)
     (Effs ms core)
     (Effs ms core)
forall a b. (a -> b) -> a -> b
$ ModuleList ms (Effs ms core)
-> Application
     (ApplicationC ms)
     (ApplicationD ms)
     (ApplicationQ ms)
     (Effs ms core)
     (Effs ms core)
forall (ms :: [[(* -> *) -> * -> *] -> *])
       (r :: [(* -> *) -> * -> *]).
ToApplication ms r =>
ModuleList ms r
-> Application
     (ApplicationC ms) (ApplicationD ms) (ApplicationQ ms) r r
toApplication ModuleList ms (Effs ms core)
ms :: Application (ApplicationC ms) (ApplicationD ms) (ApplicationQ ms) (Effs ms core) (Effs ms core)
      -- WEIRD: if you move the eval into a separate let binding then it doesn't typecheck...
  in (forall a.
 Sem (Effs ms core) a
 -> Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError
         : Tagged 'Consensus ReadStore : Tagged 'QueryAndMempool ReadStore
         : Tagged 'Consensus WriteStore : Transaction : CommitBlock
         : Metrics : Logger : Resource : Error AppError : core)
      a)
-> (forall a.
    Sem (Effs ms core) a
    -> Sem
         (ReadStore
            : Error AppError : Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core)
         a)
-> Application
     (ApplicationC ms)
     (ApplicationD ms)
     (ApplicationQ ms)
     (Effs ms core)
     (Effs ms core)
-> Application
     (ApplicationC ms)
     (ApplicationD ms)
     (ApplicationQ ms)
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError
        : Tagged 'Consensus ReadStore : Tagged 'QueryAndMempool ReadStore
        : Tagged 'Consensus WriteStore : Transaction : CommitBlock
        : Metrics : Logger : Resource : Error AppError : core)
     (ReadStore
        : Error AppError : Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
forall k k k (check :: k) (r :: [(* -> *) -> * -> *])
       (deliver :: k) (query :: k) (s :: [(* -> *) -> * -> *])
       (r' :: [(* -> *) -> * -> *]) (s' :: [(* -> *) -> * -> *]).
(HasTxRouter check r 'QueryAndMempool,
 HasTxRouter deliver r 'Consensus, HasQueryRouter query s) =>
(forall a. Sem r a -> Sem r' a)
-> (forall a. Sem s a -> Sem s' a)
-> Application check deliver query r s
-> Application check deliver query r' s'
hoistApplication (Proxy core
-> ModuleList ms (Effs ms core)
-> forall a.
   Sem (Effs ms core) a -> Sem (TxEffs :& BaseAppEffs core) a
forall (ms :: [[(* -> *) -> * -> *] -> *])
       (core :: [(* -> *) -> * -> *]) (proxy :: [(* -> *) -> * -> *] -> *)
       (r :: [(* -> *) -> * -> *]).
Eval ms core =>
proxy core
-> ModuleList ms r
-> forall a.
   Sem (Effs ms core) a -> Sem (TxEffs :& BaseAppEffs core) a
eval @ms @core Proxy core
p ModuleList ms (Effs ms core)
ms) (Sem
  (Output Event
     : GasMeter : WriteStore : ReadStore : Error AppError
     : Tagged 'Consensus ReadStore : Tagged 'QueryAndMempool ReadStore
     : Tagged 'Consensus WriteStore : Transaction : CommitBlock
     : Metrics : Logger : Resource : Error AppError : core)
  a
-> Sem
     (ReadStore
        : Error AppError : Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     a
forall (r :: [(* -> *) -> * -> *]) a.
Sem (TxEffs :& r) a -> Sem (ReadStore : Error AppError : r) a
T.evalReadOnly (Sem
   (Output Event
      : GasMeter : WriteStore : ReadStore : Error AppError
      : Tagged 'Consensus ReadStore : Tagged 'QueryAndMempool ReadStore
      : Tagged 'Consensus WriteStore : Transaction : CommitBlock
      : Metrics : Logger : Resource : Error AppError : core)
   a
 -> Sem
      (ReadStore
         : Error AppError : Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      a)
-> (Sem (Effs ms core) a
    -> Sem
         (Output Event
            : GasMeter : WriteStore : ReadStore : Error AppError
            : Tagged 'Consensus ReadStore : Tagged 'QueryAndMempool ReadStore
            : Tagged 'Consensus WriteStore : Transaction : CommitBlock
            : Metrics : Logger : Resource : Error AppError : core)
         a)
-> Sem (Effs ms core) a
-> Sem
     (ReadStore
        : Error AppError : Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy core
-> ModuleList ms (Effs ms core)
-> forall a.
   Sem (Effs ms core) a -> Sem (TxEffs :& BaseAppEffs core) a
forall (ms :: [[(* -> *) -> * -> *] -> *])
       (core :: [(* -> *) -> * -> *]) (proxy :: [(* -> *) -> * -> *] -> *)
       (r :: [(* -> *) -> * -> *]).
Eval ms core =>
proxy core
-> ModuleList ms r
-> forall a.
   Sem (Effs ms core) a -> Sem (TxEffs :& BaseAppEffs core) a
eval @ms @core Proxy core
p ModuleList ms (Effs ms core)
ms) (Application
  (ApplicationC ms)
  (ApplicationD ms)
  (ApplicationQ ms)
  (Effs ms core)
  (Effs ms core)
app{applicationBeginBlocker :: BeginBlock -> Sem (Effs ms core) ()
applicationBeginBlocker = BeginBlock -> Sem (Effs ms core) ()
beginBlocker, applicationEndBlocker :: EndBlock -> Sem (Effs ms core) EndBlockResult
applicationEndBlocker = EndBlock -> Sem (Effs ms core) EndBlockResult
endBlocker})

applyAnteHandler
  :: T.HasTxRouter check r 'QueryAndMempool
  => T.HasTxRouter deliver r 'Consensus
  => T.AnteHandler r
  -> Application check deliver query r s
  -> Application check deliver query r s
applyAnteHandler :: AnteHandler r
-> Application check deliver query r s
-> Application check deliver query r s
applyAnteHandler ah :: AnteHandler r
ah (Application check deliver query r s
app ::  Application check deliver query r s) =
  Application check deliver query r s
app { applicationTxChecker :: RouteTx check r
applicationTxChecker = Proxy check
-> Proxy r
-> Proxy 'QueryAndMempool
-> AnteHandler r
-> RouteTx check r
-> RouteTx check r
forall k (layout :: k) (r :: [(* -> *) -> * -> *])
       (scope :: Scope).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx layout r
-> RouteTx layout r
T.applyAnteHandler (Proxy check
forall k (t :: k). Proxy t
Proxy @check) (Proxy r
forall k (t :: k). Proxy t
Proxy @r) (Proxy 'QueryAndMempool
forall k (t :: k). Proxy t
Proxy @'QueryAndMempool) AnteHandler r
ah (RouteTx check r -> RouteTx check r)
-> RouteTx check r -> RouteTx check r
forall a b. (a -> b) -> a -> b
$
          Application check deliver query r s -> RouteTx check r
forall k (check :: k) k (deliver :: k) k (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
Application check deliver query r s -> RouteTx check r
applicationTxChecker Application check deliver query r s
app
      , applicationTxDeliverer :: RouteTx deliver r
applicationTxDeliverer = Proxy deliver
-> Proxy r
-> Proxy 'Consensus
-> AnteHandler r
-> RouteTx deliver r
-> RouteTx deliver r
forall k (layout :: k) (r :: [(* -> *) -> * -> *])
       (scope :: Scope).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx layout r
-> RouteTx layout r
T.applyAnteHandler (Proxy deliver
forall k (t :: k). Proxy t
Proxy @deliver) (Proxy r
forall k (t :: k). Proxy t
Proxy @r) (Proxy 'Consensus
forall k (t :: k). Proxy t
Proxy @'Consensus) AnteHandler r
ah (RouteTx deliver r -> RouteTx deliver r)
-> RouteTx deliver r -> RouteTx deliver r
forall a b. (a -> b) -> a -> b
$
          Application check deliver query r s -> RouteTx deliver r
forall k (check :: k) k (deliver :: k) k (query :: k)
       (r :: [(* -> *) -> * -> *]) (s :: [(* -> *) -> * -> *]).
Application check deliver query r s -> RouteTx deliver r
applicationTxDeliverer Application check deliver query r s
app
      }