module Tendermint.SDK.Application.Handlers
  ( Handler
  , HandlersContext(..)
  , makeApp
  ) where

import           Control.Lens                             (from, to, (&), (.~),
                                                           (^.))
import           Crypto.Hash                              (Digest)
import           Crypto.Hash.Algorithms                   (SHA256)
import qualified Data.Aeson                               as A
import qualified Data.ByteArray.Base64String              as Base64
import           Data.Default.Class                       (Default (..))
import           Data.Proxy
import           Data.String.Conversions                  (cs)
import           Network.ABCI.Server.App                  (App (..),
                                                           MessageType (..),
                                                           Request (..),
                                                           Response (..),
                                                           transformApp)
import qualified Network.ABCI.Types.Messages.Request      as Req
import qualified Network.ABCI.Types.Messages.Response     as Resp
import           Polysemy
import           Polysemy.Error                           (catch)
import qualified Tendermint.SDK.Application.Module        as M
import qualified Tendermint.SDK.BaseApp                   as BA
import           Tendermint.SDK.BaseApp.Block             (EndBlockResult,
                                                           evalBeginBlockHandler,
                                                           evalEndBlockHandler)
import           Tendermint.SDK.BaseApp.Errors            (SDKError (..),
                                                           queryAppError,
                                                           throwSDKError,
                                                           txResultAppError)
import qualified Tendermint.SDK.BaseApp.Query             as Q
import qualified Tendermint.SDK.BaseApp.Store             as Store
import           Tendermint.SDK.BaseApp.Transaction       as T
import           Tendermint.SDK.BaseApp.Transaction.Cache (writeCache)
import           Tendermint.SDK.Crypto                    (RecoverableSignatureSchema,
                                                           SignatureSchema (..))
import           Tendermint.SDK.Types.Transaction         (parseTx)
import           Tendermint.SDK.Types.TxResult            (checkTxTxResult,
                                                           deliverTxTxResult)

type Handler mt r = Request mt -> Sem r (Response mt)

data Handlers r = Handlers
  { Handlers r -> Handler 'MTInfo r
info       :: Handler 'MTInfo r
  , Handlers r -> Handler 'MTSetOption r
setOption  :: Handler 'MTSetOption r
  , Handlers r -> Handler 'MTInitChain r
initChain  :: Handler 'MTInitChain r
  , Handlers r -> Handler 'MTQuery r
query      :: Handler 'MTQuery r
  , Handlers r -> Handler 'MTCheckTx r
checkTx    :: Handler 'MTCheckTx r
  , Handlers r -> Handler 'MTBeginBlock r
beginBlock :: Handler 'MTBeginBlock r
  , Handlers r -> Handler 'MTDeliverTx r
deliverTx  :: Handler 'MTDeliverTx r
  , Handlers r -> Handler 'MTEndBlock r
endBlock   :: Handler 'MTEndBlock r
  , Handlers r -> Handler 'MTCommit r
commit     :: Handler 'MTCommit r
  }

defaultHandlers :: forall r. Handlers r
defaultHandlers :: Handlers r
defaultHandlers = Handlers :: forall (r :: EffectRow).
Handler 'MTInfo r
-> Handler 'MTSetOption r
-> Handler 'MTInitChain r
-> Handler 'MTQuery r
-> Handler 'MTCheckTx r
-> Handler 'MTBeginBlock r
-> Handler 'MTDeliverTx r
-> Handler 'MTEndBlock r
-> Handler 'MTCommit r
-> Handlers r
Handlers
  { info :: Handler 'MTInfo r
info = Handler 'MTInfo r
forall a (m :: * -> *) b. (Default a, Applicative m) => b -> m a
defaultHandler
  , setOption :: Handler 'MTSetOption r
setOption = Handler 'MTSetOption r
forall a (m :: * -> *) b. (Default a, Applicative m) => b -> m a
defaultHandler
  , initChain :: Handler 'MTInitChain r
initChain = Handler 'MTInitChain r
forall a (m :: * -> *) b. (Default a, Applicative m) => b -> m a
defaultHandler
  , query :: Handler 'MTQuery r
query = Handler 'MTQuery r
forall a (m :: * -> *) b. (Default a, Applicative m) => b -> m a
defaultHandler
  , checkTx :: Handler 'MTCheckTx r
checkTx = Handler 'MTCheckTx r
forall a (m :: * -> *) b. (Default a, Applicative m) => b -> m a
defaultHandler
  , beginBlock :: Handler 'MTBeginBlock r
beginBlock = Handler 'MTBeginBlock r
forall a (m :: * -> *) b. (Default a, Applicative m) => b -> m a
defaultHandler
  , deliverTx :: Handler 'MTDeliverTx r
deliverTx = Handler 'MTDeliverTx r
forall a (m :: * -> *) b. (Default a, Applicative m) => b -> m a
defaultHandler
  , endBlock :: Handler 'MTEndBlock r
endBlock = Handler 'MTEndBlock r
forall a (m :: * -> *) b. (Default a, Applicative m) => b -> m a
defaultHandler
  , commit :: Handler 'MTCommit r
commit = Handler 'MTCommit r
forall a (m :: * -> *) b. (Default a, Applicative m) => b -> m a
defaultHandler
  }
  where
    defaultHandler
      :: Default a
      => Applicative m
      => b
      -> m a
    defaultHandler :: b -> m a
defaultHandler = m a -> b -> m a
forall a b. a -> b -> a
const (m a -> b -> m a) -> m a -> b -> m a
forall a b. (a -> b) -> a -> b
$ a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Default a => a
def


data HandlersContext alg ms core = HandlersContext
    { HandlersContext alg ms core -> Proxy alg
signatureAlgP :: Proxy alg
    , HandlersContext alg ms core -> ModuleList ms (Effs ms core)
modules       :: M.ModuleList ms (M.Effs ms core)
    , HandlersContext alg ms core -> BeginBlock -> Sem (Effs ms core) ()
beginBlocker  :: Req.BeginBlock -> Sem (M.Effs ms core) ()
    , HandlersContext alg ms core
-> EndBlock -> Sem (Effs ms core) EndBlockResult
endBlocker    :: Req.EndBlock -> Sem (M.Effs ms core) EndBlockResult
    , HandlersContext alg ms core
-> forall msg a. Endo (RoutingTx msg -> Sem (Effs ms core) a)
anteHandler   :: BA.AnteHandler (M.Effs ms core)
    , HandlersContext alg ms core
-> forall a. Sem (BaseAppEffs core) a -> Sem core a
compileToCore :: forall a . Sem (BA.BaseAppEffs core) a -> Sem core a
    }

-- Common function between checkTx and deliverTx
makeHandlers
  :: forall alg ms core.
     RecoverableSignatureSchema alg
  => Message alg ~ Digest SHA256
  => Member (Embed IO) core
  => M.ToApplication ms (M.Effs ms core)
  => T.HasTxRouter (M.ApplicationC ms) (M.Effs ms core) 'Store.QueryAndMempool
  => T.HasTxRouter (M.ApplicationC ms) (BA.BaseAppEffs core) 'Store.QueryAndMempool
  => T.HasTxRouter (M.ApplicationD ms) (M.Effs ms core) 'Store.Consensus
  => T.HasTxRouter (M.ApplicationD ms) (BA.BaseAppEffs core) 'Store.Consensus
  => Q.HasQueryRouter (M.ApplicationQ ms) (M.Effs ms core)
  => Q.HasQueryRouter (M.ApplicationQ ms) (BA.BaseAppEffs core)
  => M.Eval ms core
 -- => M.Effs ms core ~ (BA.AppEffs (M.ModulesEffs ms) core)
  => HandlersContext alg ms core
  -> Handlers (BA.BaseAppEffs core)
makeHandlers :: HandlersContext alg ms core -> Handlers (BaseAppEffs core)
makeHandlers (HandlersContext{..} :: HandlersContext alg ms core) =
  let

      cProxy :: Proxy core
      cProxy :: Proxy core
cProxy = Proxy core
forall k (t :: k). Proxy t
Proxy

      rProxy :: Proxy (BA.BaseAppEffs core)
      rProxy :: Proxy (BaseAppEffs core)
rProxy = Proxy (BaseAppEffs core)
forall k (t :: k). Proxy t
Proxy

      app :: M.Application (M.ApplicationC ms) (M.ApplicationD ms) (M.ApplicationQ ms)
               (T.TxEffs BA.:& BA.BaseAppEffs core) (Q.QueryEffs BA.:& BA.BaseAppEffs core)
      app :: Application
  (ApplicationC ms)
  (ApplicationD ms)
  (ApplicationQ ms)
  (TxEffs :& BaseAppEffs core)
  (QueryEffs :& BaseAppEffs core)
app = 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)
forall (ms :: [Component]) (core :: EffectRow).
(Eval ms core, ToApplication ms (Effs ms core),
 HasTxRouter (ApplicationC ms) (Effs ms core) 'QueryAndMempool,
 HasTxRouter (ApplicationD ms) (Effs ms core) 'Consensus,
 HasQueryRouter (ApplicationQ ms) (Effs ms core)) =>
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)
M.makeApplication Proxy core
cProxy AnteHandler (Effs ms core)
anteHandler ModuleList ms (Effs ms core)
modules BeginBlock -> Sem (Effs ms core) ()
beginBlocker EndBlock -> Sem (Effs ms core) EndBlockResult
endBlocker

      txParser :: ByteString
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (RoutingTx ByteString)
txParser bs :: ByteString
bs = case Proxy alg -> ByteString -> Either Text (Tx alg ByteString)
forall k (alg :: k).
(RecoverableSignatureSchema alg, Message alg ~ Digest SHA256) =>
Proxy alg -> ByteString -> Either Text (Tx alg ByteString)
parseTx Proxy alg
signatureAlgP ByteString
bs of
        Left err :: Text
err -> SDKError
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (RoutingTx ByteString)
forall (r :: EffectRow) a.
Member (Error AppError) r =>
SDKError -> Sem r a
throwSDKError (SDKError
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (RoutingTx ByteString))
-> SDKError
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (RoutingTx ByteString)
forall a b. (a -> b) -> a -> b
$ Text -> SDKError
ParseError Text
err
        Right tx :: Tx alg ByteString
tx -> RoutingTx ByteString
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (RoutingTx ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RoutingTx ByteString
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (RoutingTx ByteString))
-> RoutingTx ByteString
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (RoutingTx ByteString)
forall a b. (a -> b) -> a -> b
$ Tx alg ByteString -> RoutingTx ByteString
forall k (alg :: k) msg. Tx alg msg -> RoutingTx msg
T.RoutingTx Tx alg ByteString
tx

      checkServer :: T.TransactionApplication (Sem (BA.BaseAppEffs core))
      checkServer :: TransactionApplication (Sem (BaseAppEffs core))
checkServer =
        Proxy (ApplicationC ms)
-> Proxy
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
-> Proxy 'QueryAndMempool
-> RouteTx
     (ApplicationC ms)
     (TxEffs
      :& (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core))
-> TransactionApplication
     (Sem
        (Tagged 'Consensus ReadStore
           : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
           : Transaction : CommitBlock : Metrics : Logger : Resource
           : Error AppError : core))
forall k (layout :: k) (r :: EffectRow) (scope :: Scope).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> RouteTx layout (TxEffs :& r)
-> TransactionApplication (Sem r)
T.serveTxApplication (Proxy (ApplicationC ms)
forall k (t :: k). Proxy t
Proxy @(M.ApplicationC ms)) Proxy
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
Proxy (BaseAppEffs core)
rProxy (Proxy 'QueryAndMempool
forall k (t :: k). Proxy t
Proxy @'Store.QueryAndMempool) (RouteTx
   (ApplicationC ms)
   (TxEffs
    :& (Tagged 'Consensus ReadStore
          : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
          : Transaction : CommitBlock : Metrics : Logger : Resource
          : Error AppError : core))
 -> TransactionApplication (Sem (BaseAppEffs core)))
-> RouteTx
     (ApplicationC ms)
     (TxEffs
      :& (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core))
-> TransactionApplication (Sem (BaseAppEffs core))
forall a b. (a -> b) -> a -> b
$ 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)
-> RouteTx
     (ApplicationC 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)
forall k1 (check :: k1) k2 (deliver :: k2) k3 (query :: k3)
       (r :: EffectRow) (s :: EffectRow).
Application check deliver query r s -> RouteTx check r
M.applicationTxChecker 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)
Application
  (ApplicationC ms)
  (ApplicationD ms)
  (ApplicationQ ms)
  (TxEffs :& BaseAppEffs core)
  (QueryEffs :& BaseAppEffs core)
app

      deliverServer :: T.TransactionApplication (Sem (BA.BaseAppEffs core))
      deliverServer :: TransactionApplication (Sem (BaseAppEffs core))
deliverServer =
        Proxy (ApplicationD ms)
-> Proxy
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
-> Proxy 'Consensus
-> RouteTx
     (ApplicationD ms)
     (TxEffs
      :& (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core))
-> TransactionApplication
     (Sem
        (Tagged 'Consensus ReadStore
           : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
           : Transaction : CommitBlock : Metrics : Logger : Resource
           : Error AppError : core))
forall k (layout :: k) (r :: EffectRow) (scope :: Scope).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> RouteTx layout (TxEffs :& r)
-> TransactionApplication (Sem r)
T.serveTxApplication (Proxy (ApplicationD ms)
forall k (t :: k). Proxy t
Proxy @(M.ApplicationD ms)) Proxy
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
Proxy (BaseAppEffs core)
rProxy (Proxy 'Consensus
forall k (t :: k). Proxy t
Proxy @'Store.Consensus) (RouteTx
   (ApplicationD ms)
   (TxEffs
    :& (Tagged 'Consensus ReadStore
          : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
          : Transaction : CommitBlock : Metrics : Logger : Resource
          : Error AppError : core))
 -> TransactionApplication (Sem (BaseAppEffs core)))
-> RouteTx
     (ApplicationD ms)
     (TxEffs
      :& (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core))
-> TransactionApplication (Sem (BaseAppEffs core))
forall a b. (a -> b) -> a -> b
$ 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)
-> RouteTx
     (ApplicationD 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)
forall k1 (check :: k1) k2 (deliver :: k2) k3 (query :: k3)
       (r :: EffectRow) (s :: EffectRow).
Application check deliver query r s -> RouteTx deliver r
M.applicationTxDeliverer 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)
Application
  (ApplicationC ms)
  (ApplicationD ms)
  (ApplicationQ ms)
  (TxEffs :& BaseAppEffs core)
  (QueryEffs :& BaseAppEffs core)
app

      queryServer :: Q.QueryApplication (Sem (BA.BaseAppEffs core))
      queryServer :: QueryApplication (Sem (BaseAppEffs core))
queryServer = Proxy (ApplicationQ ms)
-> Proxy
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
-> RouteQ
     (ApplicationQ ms)
     (QueryEffs
      :& (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core))
-> QueryApplication
     (Sem
        (Tagged 'Consensus ReadStore
           : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
           : Transaction : CommitBlock : Metrics : Logger : Resource
           : Error AppError : core))
forall k (layout :: k) (r :: EffectRow).
HasQueryRouter layout r =>
Proxy layout
-> Proxy r
-> RouteQ layout (QueryEffs :& r)
-> QueryApplication (Sem r)
Q.serveQueryApplication (Proxy (ApplicationQ ms)
forall k (t :: k). Proxy t
Proxy @(M.ApplicationQ ms)) Proxy
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
Proxy (BaseAppEffs core)
rProxy (RouteQ
   (ApplicationQ ms)
   (QueryEffs
    :& (Tagged 'Consensus ReadStore
          : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
          : Transaction : CommitBlock : Metrics : Logger : Resource
          : Error AppError : core))
 -> QueryApplication (Sem (BaseAppEffs core)))
-> RouteQ
     (ApplicationQ ms)
     (QueryEffs
      :& (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core))
-> QueryApplication (Sem (BaseAppEffs core))
forall a b. (a -> b) -> a -> b
$ 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)
-> RouteQ
     (ApplicationQ ms)
     (ReadStore
        : Error AppError : Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
forall k1 (check :: k1) k2 (deliver :: k2) k3 (query :: k3)
       (r :: EffectRow) (s :: EffectRow).
Application check deliver query r s -> RouteQ query s
M.applicationQuerier 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)
Application
  (ApplicationC ms)
  (ApplicationD ms)
  (ApplicationQ ms)
  (TxEffs :& BaseAppEffs core)
  (QueryEffs :& BaseAppEffs core)
app

      query :: Request 'MTQuery
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTQuery)
query (RequestQuery q :: Query
q) =
        --Store.applyScope $
        Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
  (Response 'MTQuery)
-> (AppError
    -> Sem
         (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core)
         (Response 'MTQuery))
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTQuery)
forall e (r :: EffectRow) a.
MemberWithError (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
catch
          (do
            Query
queryResp <- QueryApplication (Sem (BaseAppEffs core))
queryServer Query
q
            Response 'MTQuery
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTQuery)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response 'MTQuery
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTQuery))
-> Response 'MTQuery
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTQuery)
forall a b. (a -> b) -> a -> b
$ Query -> Response 'MTQuery
ResponseQuery Query
queryResp
          )
          (\(AppError
err :: BA.AppError) ->
            Response 'MTQuery
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTQuery)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response 'MTQuery
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTQuery))
-> (Query -> Response 'MTQuery)
-> Query
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTQuery)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Response 'MTQuery
ResponseQuery (Query
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTQuery))
-> Query
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTQuery)
forall a b. (a -> b) -> a -> b
$ Query
forall a. Default a => a
def Query -> (Query -> Query) -> Query
forall a b. a -> (a -> b) -> b
& (AppError -> Identity AppError) -> Query -> Identity Query
Lens' Query AppError
queryAppError ((AppError -> Identity AppError) -> Query -> Identity Query)
-> AppError -> Query -> Query
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AppError
err
          )

      checkTx :: Request 'MTCheckTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCheckTx)
checkTx (RequestCheckTx _checkTx :: CheckTx
_checkTx) =  do
        TxResult
res <- Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
  TxResult
-> (AppError
    -> Sem
         (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core)
         TxResult)
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     TxResult
forall e (r :: EffectRow) a.
MemberWithError (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
catch
          ( let txBytes :: ByteString
txBytes =  CheckTx
_checkTx CheckTx -> Getting ByteString CheckTx ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. (Base64String -> Const ByteString Base64String)
-> CheckTx -> Const ByteString CheckTx
Iso' CheckTx Base64String
Req._checkTxTx ((Base64String -> Const ByteString Base64String)
 -> CheckTx -> Const ByteString CheckTx)
-> ((ByteString -> Const ByteString ByteString)
    -> Base64String -> Const ByteString Base64String)
-> Getting ByteString CheckTx ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base64String -> ByteString)
-> (ByteString -> Const ByteString ByteString)
-> Base64String
-> Const ByteString Base64String
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Base64String -> ByteString
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes
            in do
               (res :: TxResult
res, _) <- ByteString
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (RoutingTx ByteString)
txParser ByteString
txBytes Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
  (RoutingTx ByteString)
-> TransactionApplication
     (Sem
        (Tagged 'Consensus ReadStore
           : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
           : Transaction : CommitBlock : Metrics : Logger : Resource
           : Error AppError : core))
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (TxResult, Maybe Cache)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TransactionApplication
  (Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core))
TransactionApplication (Sem (BaseAppEffs core))
checkServer
               TxResult
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     TxResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxResult
res
          )
          (\(AppError
err :: BA.AppError) ->
            TxResult
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     TxResult
forall (m :: * -> *) a. Monad m => a -> m a
return (TxResult
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      TxResult)
-> TxResult
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     TxResult
forall a b. (a -> b) -> a -> b
$ TxResult
forall a. Default a => a
def TxResult -> (TxResult -> TxResult) -> TxResult
forall a b. a -> (a -> b) -> b
& (AppError -> Identity AppError) -> TxResult -> Identity TxResult
Lens' TxResult AppError
txResultAppError ((AppError -> Identity AppError) -> TxResult -> Identity TxResult)
-> AppError -> TxResult -> TxResult
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AppError
err
          )
        Response 'MTCheckTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCheckTx)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response 'MTCheckTx
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTCheckTx))
-> (CheckTx -> Response 'MTCheckTx)
-> CheckTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCheckTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckTx -> Response 'MTCheckTx
ResponseCheckTx (CheckTx
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTCheckTx))
-> CheckTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCheckTx)
forall a b. (a -> b) -> a -> b
$ TxResult
res TxResult -> Getting CheckTx TxResult CheckTx -> CheckTx
forall s a. s -> Getting a s a -> a
^. AnIso CheckTx CheckTx TxResult TxResult
-> Iso TxResult TxResult CheckTx CheckTx
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso CheckTx CheckTx TxResult TxResult
Iso' CheckTx TxResult
checkTxTxResult

      deliverTx :: Request 'MTDeliverTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTDeliverTx)
deliverTx (RequestDeliverTx _deliverTx :: DeliverTx
_deliverTx) = do
        TxResult
res <- Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
  TxResult
-> (AppError
    -> Sem
         (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core)
         TxResult)
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     TxResult
forall e (r :: EffectRow) a.
MemberWithError (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
catch @BA.AppError
          ( let txBytes :: ByteString
txBytes = DeliverTx
_deliverTx DeliverTx -> Getting ByteString DeliverTx ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. (Base64String -> Const ByteString Base64String)
-> DeliverTx -> Const ByteString DeliverTx
Iso' DeliverTx Base64String
Req._deliverTxTx ((Base64String -> Const ByteString Base64String)
 -> DeliverTx -> Const ByteString DeliverTx)
-> ((ByteString -> Const ByteString ByteString)
    -> Base64String -> Const ByteString Base64String)
-> Getting ByteString DeliverTx ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Base64String -> ByteString)
-> (ByteString -> Const ByteString ByteString)
-> Base64String
-> Const ByteString Base64String
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Base64String -> ByteString
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes
            in do
               (res :: TxResult
res, cache :: Maybe Cache
cache) <- ByteString
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (RoutingTx ByteString)
txParser ByteString
txBytes Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
  (RoutingTx ByteString)
-> TransactionApplication
     (Sem
        (Tagged 'Consensus ReadStore
           : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
           : Transaction : CommitBlock : Metrics : Logger : Resource
           : Error AppError : core))
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (TxResult, Maybe Cache)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TransactionApplication
  (Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core))
TransactionApplication (Sem (BaseAppEffs core))
deliverServer
               Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
  ()
-> (Cache
    -> Sem
         (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core)
         ())
-> Maybe Cache
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (()
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Cache
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     ()
forall (r :: EffectRow).
Member (Tagged 'Consensus WriteStore) r =>
Cache -> Sem r ()
writeCache Maybe Cache
cache
               TxResult
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     TxResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxResult
res
          )
          (\(AppError
err :: BA.AppError) ->
            TxResult
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     TxResult
forall (m :: * -> *) a. Monad m => a -> m a
return (TxResult
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      TxResult)
-> TxResult
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     TxResult
forall a b. (a -> b) -> a -> b
$ TxResult
forall a. Default a => a
def TxResult -> (TxResult -> TxResult) -> TxResult
forall a b. a -> (a -> b) -> b
& (AppError -> Identity AppError) -> TxResult -> Identity TxResult
Lens' TxResult AppError
txResultAppError ((AppError -> Identity AppError) -> TxResult -> Identity TxResult)
-> AppError -> TxResult -> TxResult
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AppError
err
          )
        Response 'MTDeliverTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTDeliverTx)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response 'MTDeliverTx
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTDeliverTx))
-> (DeliverTx -> Response 'MTDeliverTx)
-> DeliverTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTDeliverTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeliverTx -> Response 'MTDeliverTx
ResponseDeliverTx (DeliverTx
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTDeliverTx))
-> DeliverTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTDeliverTx)
forall a b. (a -> b) -> a -> b
$ TxResult
res TxResult -> Getting DeliverTx TxResult DeliverTx -> DeliverTx
forall s a. s -> Getting a s a -> a
^. AnIso DeliverTx DeliverTx TxResult TxResult
-> Iso TxResult TxResult DeliverTx DeliverTx
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso DeliverTx DeliverTx TxResult TxResult
Iso' DeliverTx TxResult
deliverTxTxResult

      commit :: Handler 'MTCommit (BA.BaseAppEffs core)
      commit :: Handler 'MTCommit (BaseAppEffs core)
commit _ = do
        CommitResponse
_ <- Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
  CommitResponse
forall (r :: EffectRow).
MemberWithError Transaction r =>
Sem r CommitResponse
Store.commit
        Base64String
rootHash <- Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
  Base64String
forall (r :: EffectRow).
MemberWithError CommitBlock r =>
Sem r Base64String
Store.commitBlock
        Response 'MTCommit
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCommit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response 'MTCommit
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTCommit))
-> (Commit -> Response 'MTCommit)
-> Commit
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCommit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Commit -> Response 'MTCommit
ResponseCommit (Commit
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTCommit))
-> Commit
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCommit)
forall a b. (a -> b) -> a -> b
$ Commit
forall a. Default a => a
def
          Commit -> (Commit -> Commit) -> Commit
forall a b. a -> (a -> b) -> b
& (Base64String -> Identity Base64String)
-> Commit -> Identity Commit
Iso' Commit Base64String
Resp._commitData ((Base64String -> Identity Base64String)
 -> Commit -> Identity Commit)
-> Base64String -> Commit -> Commit
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Base64String -> Base64String
forall ba. ByteArrayAccess ba => ba -> Base64String
Base64.fromBytes Base64String
rootHash

      beginBlock :: Handler 'MTBeginBlock (BA.BaseAppEffs core)
      beginBlock :: Handler 'MTBeginBlock (BaseAppEffs core)
beginBlock (RequestBeginBlock bb :: BeginBlock
bb) = do
        Either AppError BeginBlock
res <- Sem
  (TxEffs
   :& (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core))
  ()
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Either AppError BeginBlock)
forall (r :: EffectRow).
Members
  '[Embed IO, Tagged 'Consensus ReadStore,
    Tagged 'Consensus WriteStore]
  r =>
Sem (TxEffs :& r) () -> Sem r (Either AppError BeginBlock)
evalBeginBlockHandler (Sem
   (TxEffs
    :& (Tagged 'Consensus ReadStore
          : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
          : Transaction : CommitBlock : Metrics : Logger : Resource
          : Error AppError : core))
   ()
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Either AppError BeginBlock))
-> Sem
     (TxEffs
      :& (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core))
     ()
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Either AppError BeginBlock)
forall a b. (a -> b) -> a -> b
$ 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)
-> BeginBlock
-> 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)
     ()
forall k1 (check :: k1) k2 (deliver :: k2) k3 (query :: k3)
       (r :: EffectRow) (s :: EffectRow).
Application check deliver query r s -> BeginBlock -> Sem r ()
M.applicationBeginBlocker 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)
Application
  (ApplicationC ms)
  (ApplicationD ms)
  (ApplicationQ ms)
  (TxEffs :& BaseAppEffs core)
  (QueryEffs :& BaseAppEffs core)
app BeginBlock
bb
        case Either AppError BeginBlock
res of
          Right bbr :: BeginBlock
bbr ->
            Response 'MTBeginBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTBeginBlock)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response 'MTBeginBlock
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTBeginBlock))
-> (BeginBlock -> Response 'MTBeginBlock)
-> BeginBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTBeginBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeginBlock -> Response 'MTBeginBlock
ResponseBeginBlock (BeginBlock
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTBeginBlock))
-> BeginBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTBeginBlock)
forall a b. (a -> b) -> a -> b
$ BeginBlock
bbr
          Left e :: AppError
e ->
            Response 'MTBeginBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTBeginBlock)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response 'MTBeginBlock
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTBeginBlock))
-> (AppError -> Response 'MTBeginBlock)
-> AppError
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTBeginBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exception -> Response 'MTBeginBlock
forall (m :: MessageType). Exception -> Response m
ResponseException (Exception -> Response 'MTBeginBlock)
-> (AppError -> Exception) -> AppError -> Response 'MTBeginBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Exception
Resp.Exception (Text -> Exception) -> (AppError -> Text) -> AppError -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text)
-> (AppError -> ByteString) -> AppError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppError -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (AppError
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTBeginBlock))
-> AppError
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTBeginBlock)
forall a b. (a -> b) -> a -> b
$ AppError
e

      endBlock :: Handler 'MTEndBlock (BA.BaseAppEffs core)
      endBlock :: Handler 'MTEndBlock (BaseAppEffs core)
endBlock (RequestEndBlock eb :: EndBlock
eb) = do
        Either AppError EndBlock
res <- Sem
  (TxEffs
   :& (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core))
  EndBlockResult
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Either AppError EndBlock)
forall (r :: EffectRow).
Members
  '[Embed IO, Tagged 'Consensus ReadStore,
    Tagged 'Consensus WriteStore]
  r =>
Sem (TxEffs :& r) EndBlockResult
-> Sem r (Either AppError EndBlock)
evalEndBlockHandler (Sem
   (TxEffs
    :& (Tagged 'Consensus ReadStore
          : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
          : Transaction : CommitBlock : Metrics : Logger : Resource
          : Error AppError : core))
   EndBlockResult
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Either AppError EndBlock))
-> Sem
     (TxEffs
      :& (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core))
     EndBlockResult
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Either AppError EndBlock)
forall a b. (a -> b) -> a -> b
$ 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)
-> EndBlock
-> 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)
     EndBlockResult
forall k1 (check :: k1) k2 (deliver :: k2) k3 (query :: k3)
       (r :: EffectRow) (s :: EffectRow).
Application check deliver query r s
-> EndBlock -> Sem r EndBlockResult
M.applicationEndBlocker 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)
Application
  (ApplicationC ms)
  (ApplicationD ms)
  (ApplicationQ ms)
  (TxEffs :& BaseAppEffs core)
  (QueryEffs :& BaseAppEffs core)
app EndBlock
eb
        case Either AppError EndBlock
res of
          Right ebr :: EndBlock
ebr ->
            Response 'MTEndBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTEndBlock)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response 'MTEndBlock
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTEndBlock))
-> (EndBlock -> Response 'MTEndBlock)
-> EndBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTEndBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndBlock -> Response 'MTEndBlock
ResponseEndBlock (EndBlock
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTEndBlock))
-> EndBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTEndBlock)
forall a b. (a -> b) -> a -> b
$ EndBlock
ebr
          Left e :: AppError
e ->
            Response 'MTEndBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTEndBlock)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response 'MTEndBlock
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTEndBlock))
-> (AppError -> Response 'MTEndBlock)
-> AppError
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTEndBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exception -> Response 'MTEndBlock
forall (m :: MessageType). Exception -> Response m
ResponseException (Exception -> Response 'MTEndBlock)
-> (AppError -> Exception) -> AppError -> Response 'MTEndBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Exception
Resp.Exception (Text -> Exception) -> (AppError -> Text) -> AppError -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text)
-> (AppError -> ByteString) -> AppError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppError -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (AppError
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTEndBlock))
-> AppError
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTEndBlock)
forall a b. (a -> b) -> a -> b
$ AppError
e



  in Handlers
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
forall (r :: EffectRow). Handlers r
defaultHandlers
       { Request 'MTQuery
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTQuery)
query :: Request 'MTQuery
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTQuery)
query :: Request 'MTQuery
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTQuery)
query
       , Request 'MTCheckTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCheckTx)
checkTx :: Request 'MTCheckTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCheckTx)
checkTx :: Request 'MTCheckTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCheckTx)
checkTx
       , Request 'MTDeliverTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTDeliverTx)
deliverTx :: Request 'MTDeliverTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTDeliverTx)
deliverTx :: Request 'MTDeliverTx
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTDeliverTx)
deliverTx
       , Request 'MTCommit
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCommit)
Handler 'MTCommit (BaseAppEffs core)
commit :: Handler 'MTCommit (BaseAppEffs core)
commit :: Request 'MTCommit
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTCommit)
commit
       , Request 'MTBeginBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTBeginBlock)
Handler 'MTBeginBlock (BaseAppEffs core)
beginBlock :: Handler 'MTBeginBlock (BaseAppEffs core)
beginBlock :: Request 'MTBeginBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTBeginBlock)
beginBlock
       , Request 'MTEndBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTEndBlock)
Handler 'MTEndBlock (BaseAppEffs core)
endBlock :: Handler 'MTEndBlock (BaseAppEffs core)
endBlock :: Request 'MTEndBlock
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTEndBlock)
endBlock
       }

makeApp
  :: forall alg ms core.

     RecoverableSignatureSchema alg
  => Message alg ~ Digest SHA256
  => Member (Embed IO) core
  => M.ToApplication ms (M.Effs ms core)
  => T.HasTxRouter (M.ApplicationC ms) (M.Effs ms core) 'Store.QueryAndMempool
  => T.HasTxRouter (M.ApplicationC ms) (BA.BaseAppEffs core) 'Store.QueryAndMempool
  => T.HasTxRouter (M.ApplicationD ms) (M.Effs ms core) 'Store.Consensus
  => T.HasTxRouter (M.ApplicationD ms) (BA.BaseAppEffs core) 'Store.Consensus
  => Q.HasQueryRouter (M.ApplicationQ ms) (M.Effs ms core)
  => Q.HasQueryRouter (M.ApplicationQ ms) (BA.BaseAppEffs core)
  => M.Eval ms core
  -- => M.Effs ms (BA.BaseAppEffs core) ~ (BA.AppEffs (M.ModulesEffs ms) core)
  => HandlersContext alg ms core
  -> App (Sem core)
makeApp :: HandlersContext alg ms core -> App (Sem core)
makeApp handlersContext :: HandlersContext alg ms core
handlersContext@HandlersContext{forall a. Sem (BaseAppEffs core) a -> Sem core a
compileToCore :: forall a. Sem (BaseAppEffs core) a -> Sem core a
compileToCore :: forall k (alg :: k) (ms :: [Component]) (core :: EffectRow).
HandlersContext alg ms core
-> forall a. Sem (BaseAppEffs core) a -> Sem core a
compileToCore} =
  let Handlers{..} = HandlersContext alg ms core -> Handlers (BaseAppEffs core)
forall k (alg :: k) (ms :: [Component]) (core :: EffectRow).
(RecoverableSignatureSchema alg, Message alg ~ Digest SHA256,
 Member (Embed IO) core, ToApplication ms (Effs ms core),
 HasTxRouter (ApplicationC ms) (Effs ms core) 'QueryAndMempool,
 HasTxRouter (ApplicationC ms) (BaseAppEffs core) 'QueryAndMempool,
 HasTxRouter (ApplicationD ms) (Effs ms core) 'Consensus,
 HasTxRouter (ApplicationD ms) (BaseAppEffs core) 'Consensus,
 HasQueryRouter (ApplicationQ ms) (Effs ms core),
 HasQueryRouter (ApplicationQ ms) (BaseAppEffs core),
 Eval ms core) =>
HandlersContext alg ms core -> Handlers (BaseAppEffs core)
makeHandlers HandlersContext alg ms core
handlersContext :: Handlers (BA.BaseAppEffs core)
  in (forall (t :: MessageType).
 Sem
   (Tagged 'Consensus ReadStore
      : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
      : Transaction : CommitBlock : Metrics : Logger : Resource
      : Error AppError : core)
   (Response t)
 -> Sem core (Response t))
-> App
     (Sem
        (Tagged 'Consensus ReadStore
           : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
           : Transaction : CommitBlock : Metrics : Logger : Resource
           : Error AppError : core))
-> App (Sem core)
forall (m :: * -> *) (g :: * -> *).
(forall (t :: MessageType). m (Response t) -> g (Response t))
-> App m -> App g
transformApp forall a. Sem (BaseAppEffs core) a -> Sem core a
forall (t :: MessageType).
Sem
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
  (Response t)
-> Sem core (Response t)
compileToCore (App
   (Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core))
 -> App (Sem core))
-> App
     (Sem
        (Tagged 'Consensus ReadStore
           : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
           : Transaction : CommitBlock : Metrics : Logger : Resource
           : Error AppError : core))
-> App (Sem core)
forall a b. (a -> b) -> a -> b
$ (forall (t :: MessageType).
 Request t
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response t))
-> App
     (Sem
        (Tagged 'Consensus ReadStore
           : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
           : Transaction : CommitBlock : Metrics : Logger : Resource
           : Error AppError : core))
forall (m :: * -> *).
(forall (t :: MessageType). Request t -> m (Response t)) -> App m
App ((forall (t :: MessageType).
  Request t
  -> Sem
       (Tagged 'Consensus ReadStore
          : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
          : Transaction : CommitBlock : Metrics : Logger : Resource
          : Error AppError : core)
       (Response t))
 -> App
      (Sem
         (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core)))
-> (forall (t :: MessageType).
    Request t
    -> Sem
         (Tagged 'Consensus ReadStore
            : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
            : Transaction : CommitBlock : Metrics : Logger : Resource
            : Error AppError : core)
         (Response t))
-> App
     (Sem
        (Tagged 'Consensus ReadStore
           : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
           : Transaction : CommitBlock : Metrics : Logger : Resource
           : Error AppError : core))
forall a b. (a -> b) -> a -> b
$ \case
       RequestEcho echo :: Echo
echo ->
         Response 'MTEcho
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTEcho)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response 'MTEcho
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response 'MTEcho))
-> (Echo -> Response 'MTEcho)
-> Echo
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response 'MTEcho)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Echo -> Response 'MTEcho
ResponseEcho (Echo
 -> Sem
      (Tagged 'Consensus ReadStore
         : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
         : Transaction : CommitBlock : Metrics : Logger : Resource
         : Error AppError : core)
      (Response t))
-> Echo
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response t)
forall a b. (a -> b) -> a -> b
$ Echo
forall a. Default a => a
def
           Echo -> (Echo -> Echo) -> Echo
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> Echo -> Identity Echo
Iso' Echo Text
Resp._echoMessage ((Text -> Identity Text) -> Echo -> Identity Echo)
-> Text -> Echo -> Echo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Echo
echo Echo -> Getting Text Echo Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Echo Text
Iso' Echo Text
Req._echoMessage
       RequestFlush _ -> Response t
-> Sem
     (Tagged 'Consensus ReadStore
        : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
        : Transaction : CommitBlock : Metrics : Logger : Resource
        : Error AppError : core)
     (Response t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response t
forall a. Default a => a
def
       msg :: Request t
msg@(RequestInfo _) -> Handler
  'MTInfo
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
info Request t
Request 'MTInfo
msg
       msg :: Request t
msg@(RequestSetOption _) -> Handler
  'MTSetOption
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
setOption Request t
Request 'MTSetOption
msg
       msg :: Request t
msg@(RequestInitChain _) -> Handler
  'MTInitChain
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
initChain Request t
Request 'MTInitChain
msg
       msg :: Request t
msg@(RequestQuery _) -> Handler
  'MTQuery
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
query Request t
Request 'MTQuery
msg
       msg :: Request t
msg@(RequestBeginBlock _) -> Handler
  'MTBeginBlock
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
beginBlock Request t
Request 'MTBeginBlock
msg
       msg :: Request t
msg@(RequestCheckTx _) ->  Handler
  'MTCheckTx
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
checkTx Request t
Request 'MTCheckTx
msg
       msg :: Request t
msg@(RequestDeliverTx _) -> Handler
  'MTDeliverTx
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
deliverTx Request t
Request 'MTDeliverTx
msg
       msg :: Request t
msg@(RequestEndBlock _) -> Handler
  'MTEndBlock
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
endBlock Request t
Request 'MTEndBlock
msg
       msg :: Request t
msg@(RequestCommit _) -> Handler
  'MTCommit
  (Tagged 'Consensus ReadStore
     : Tagged 'QueryAndMempool ReadStore : Tagged 'Consensus WriteStore
     : Transaction : CommitBlock : Metrics : Logger : Resource
     : Error AppError : core)
commit Request t
Request 'MTCommit
msg