{-# LANGUAGE UndecidableInstances #-}
module Tendermint.SDK.BaseApp.Transaction.Router
  ( HasTxRouter(..)
  , emptyTxServer
  ) where

import           Control.Monad.IO.Class                         (liftIO)
import           Data.ByteString                                (ByteString)
import           Data.Kind                                      (Type)
import           Data.Monoid
import           Data.Proxy
import           Data.String.Conversions                        (cs)
import           GHC.TypeLits                                   (KnownSymbol,
                                                                 symbolVal)
import           Polysemy                                       (EffectRow,
                                                                 Embed, Members,
                                                                 Sem)
import           Polysemy.Tagged                                (Tagged)
import           Servant.API
import qualified Tendermint.SDK.BaseApp.Router                  as R
import           Tendermint.SDK.BaseApp.Store                   (ReadStore,
                                                                 Scope)
import           Tendermint.SDK.BaseApp.Transaction.AnteHandler (AnteHandler)
import           Tendermint.SDK.BaseApp.Transaction.Cache       (Cache)
import           Tendermint.SDK.BaseApp.Transaction.Effect      (TxEffs, runTx)
import           Tendermint.SDK.BaseApp.Transaction.Types
import           Tendermint.SDK.Codec                           (HasCodec (..))
import           Tendermint.SDK.Types.Effects                   ((:&))
import           Tendermint.SDK.Types.Message                   (HasMessageType (..),
                                                                 Msg (..))
import           Tendermint.SDK.Types.TxResult                  (TxResult)
--------------------------------------------------------------------------------

class HasTxRouter layout (r :: EffectRow) (scope :: Scope) where
  type RouteTx layout (s :: EffectRow) :: Type
  routeTx
        :: Proxy layout
        -> Proxy r
        -> Proxy scope
        -> R.Delayed (Sem r) env (RoutingTx ByteString) (RouteTx layout (TxEffs :& r))
        -> R.Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)

  applyAnteHandler
    :: Proxy layout
    -> Proxy r
    -> Proxy scope
    -> AnteHandler r
    -> RouteTx layout r
    -> RouteTx layout r

  hoistTxRouter
    :: Proxy layout
    -> Proxy r
    -> Proxy scope
    -> (forall a. Sem s a -> Sem s' a)
    -> RouteTx layout s
    -> RouteTx layout s'

instance (HasTxRouter a r scope, HasTxRouter b r scope) => HasTxRouter (a :<|> b) r scope where
  type RouteTx (a :<|> b) s = RouteTx a s :<|> RouteTx b s

  routeTx :: Proxy (a :<|> b)
-> Proxy r
-> Proxy scope
-> Delayed
     (Sem r)
     env
     (RoutingTx ByteString)
     (RouteTx (a :<|> b) (TxEffs :& r))
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
routeTx _ pr :: Proxy r
pr ps :: Proxy scope
ps server :: Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RouteTx (a :<|> b) (TxEffs :& r))
server =
    Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
forall env a. Router' env a -> Router' env a -> Router' env a
R.choice (Proxy a
-> Proxy r
-> Proxy scope
-> Delayed
     (Sem r) env (RoutingTx ByteString) (RouteTx a (TxEffs :& r))
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
forall k (layout :: k) (r :: EffectRow) (scope :: Scope) env.
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> Delayed
     (Sem r) env (RoutingTx ByteString) (RouteTx layout (TxEffs :& r))
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
routeTx (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Proxy r
pr Proxy scope
ps ((\ (a :: RouteTx
  a
  (Output Event
     : GasMeter : WriteStore : ReadStore : Error AppError : r)
a :<|> _) -> RouteTx
  a
  (Output Event
     : GasMeter : WriteStore : ReadStore : Error AppError : r)
a) ((RouteTx
    a
    (Output Event
       : GasMeter : WriteStore : ReadStore : Error AppError : r)
  :<|> RouteTx
         b
         (Output Event
            : GasMeter : WriteStore : ReadStore : Error AppError : r))
 -> RouteTx
      a
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r))
-> Delayed
     (Sem r)
     env
     (RoutingTx ByteString)
     (RouteTx
        a
        (Output Event
           : GasMeter : WriteStore : ReadStore : Error AppError : r)
      :<|> RouteTx
             b
             (Output Event
                : GasMeter : WriteStore : ReadStore : Error AppError : r))
-> Delayed
     (Sem r)
     env
     (RoutingTx ByteString)
     (RouteTx
        a
        (Output Event
           : GasMeter : WriteStore : ReadStore : Error AppError : r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RouteTx
     a
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
   :<|> RouteTx
          b
          (Output Event
             : GasMeter : WriteStore : ReadStore : Error AppError : r))
Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RouteTx (a :<|> b) (TxEffs :& r))
server))
             (Proxy b
-> Proxy r
-> Proxy scope
-> Delayed
     (Sem r) env (RoutingTx ByteString) (RouteTx b (TxEffs :& r))
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
forall k (layout :: k) (r :: EffectRow) (scope :: Scope) env.
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> Delayed
     (Sem r) env (RoutingTx ByteString) (RouteTx layout (TxEffs :& r))
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
routeTx (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Proxy r
pr Proxy scope
ps ((\ (_ :<|> b :: RouteTx
  b
  (Output Event
     : GasMeter : WriteStore : ReadStore : Error AppError : r)
b) -> RouteTx
  b
  (Output Event
     : GasMeter : WriteStore : ReadStore : Error AppError : r)
b) ((RouteTx
    a
    (Output Event
       : GasMeter : WriteStore : ReadStore : Error AppError : r)
  :<|> RouteTx
         b
         (Output Event
            : GasMeter : WriteStore : ReadStore : Error AppError : r))
 -> RouteTx
      b
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r))
-> Delayed
     (Sem r)
     env
     (RoutingTx ByteString)
     (RouteTx
        a
        (Output Event
           : GasMeter : WriteStore : ReadStore : Error AppError : r)
      :<|> RouteTx
             b
             (Output Event
                : GasMeter : WriteStore : ReadStore : Error AppError : r))
-> Delayed
     (Sem r)
     env
     (RoutingTx ByteString)
     (RouteTx
        b
        (Output Event
           : GasMeter : WriteStore : ReadStore : Error AppError : r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RouteTx
     a
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
   :<|> RouteTx
          b
          (Output Event
             : GasMeter : WriteStore : ReadStore : Error AppError : r))
Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RouteTx (a :<|> b) (TxEffs :& r))
server))

  applyAnteHandler :: Proxy (a :<|> b)
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx (a :<|> b) r
-> RouteTx (a :<|> b) r
applyAnteHandler _ pr :: Proxy r
pr ps :: Proxy scope
ps ah :: AnteHandler r
ah (a :<|> b) =
    Proxy a
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx a r
-> RouteTx a r
forall k (layout :: k) (r :: EffectRow) (scope :: Scope).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx layout r
-> RouteTx layout r
applyAnteHandler (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Proxy r
pr Proxy scope
ps AnteHandler r
ah RouteTx a r
a RouteTx a r -> RouteTx b r -> RouteTx a r :<|> RouteTx b r
forall a b. a -> b -> a :<|> b
:<|>
    Proxy b
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx b r
-> RouteTx b r
forall k (layout :: k) (r :: EffectRow) (scope :: Scope).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx layout r
-> RouteTx layout r
applyAnteHandler (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Proxy r
pr Proxy scope
ps AnteHandler r
ah RouteTx b r
b

  hoistTxRouter :: Proxy (a :<|> b)
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx (a :<|> b) s
-> RouteTx (a :<|> b) s'
hoistTxRouter _ pr :: Proxy r
pr nat :: Proxy scope
nat ps :: forall a. Sem s a -> Sem s' a
ps (a :<|> b) =
    Proxy a
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx a s
-> RouteTx a s'
forall k (layout :: k) (r :: EffectRow) (scope :: Scope)
       (s :: EffectRow) (s' :: EffectRow).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx layout s
-> RouteTx layout s'
hoistTxRouter (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Proxy r
pr Proxy scope
nat forall a. Sem s a -> Sem s' a
ps RouteTx a s
a RouteTx a s' -> RouteTx b s' -> RouteTx a s' :<|> RouteTx b s'
forall a b. a -> b -> a :<|> b
:<|> Proxy b
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx b s
-> RouteTx b s'
forall k (layout :: k) (r :: EffectRow) (scope :: Scope)
       (s :: EffectRow) (s' :: EffectRow).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx layout s
-> RouteTx layout s'
hoistTxRouter (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Proxy r
pr Proxy scope
nat forall a. Sem s a -> Sem s' a
ps RouteTx b s
b

instance (HasTxRouter sublayout r scope, KnownSymbol path) => HasTxRouter (path :> sublayout) r scope where

  type RouteTx (path :> sublayout) s = RouteTx sublayout s

  routeTx :: Proxy (path :> sublayout)
-> Proxy r
-> Proxy scope
-> Delayed
     (Sem r)
     env
     (RoutingTx ByteString)
     (RouteTx (path :> sublayout) (TxEffs :& r))
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
routeTx _ pr :: Proxy r
pr ps :: Proxy scope
ps subserver :: Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RouteTx (path :> sublayout) (TxEffs :& r))
subserver =
    Text
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
forall env a. Text -> Router' env a -> Router' env a
R.pathRouter (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Proxy path -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy path
proxyPath)) (Proxy sublayout
-> Proxy r
-> Proxy scope
-> Delayed
     (Sem r)
     env
     (RoutingTx ByteString)
     (RouteTx sublayout (TxEffs :& r))
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
forall k (layout :: k) (r :: EffectRow) (scope :: Scope) env.
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> Delayed
     (Sem r) env (RoutingTx ByteString) (RouteTx layout (TxEffs :& r))
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
routeTx (Proxy sublayout
forall k (t :: k). Proxy t
Proxy @sublayout) Proxy r
pr Proxy scope
ps Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RouteTx sublayout (TxEffs :& r))
Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RouteTx (path :> sublayout) (TxEffs :& r))
subserver)
    where proxyPath :: Proxy path
proxyPath = Proxy path
forall k (t :: k). Proxy t
Proxy @path

  applyAnteHandler :: Proxy (path :> sublayout)
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx (path :> sublayout) r
-> RouteTx (path :> sublayout) r
applyAnteHandler _ pr :: Proxy r
pr ps :: Proxy scope
ps ah :: AnteHandler r
ah = Proxy sublayout
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx sublayout r
-> RouteTx sublayout r
forall k (layout :: k) (r :: EffectRow) (scope :: Scope).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx layout r
-> RouteTx layout r
applyAnteHandler (Proxy sublayout
forall k (t :: k). Proxy t
Proxy @sublayout) Proxy r
pr Proxy scope
ps AnteHandler r
ah

  hoistTxRouter :: Proxy (path :> sublayout)
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx (path :> sublayout) s
-> RouteTx (path :> sublayout) s'
hoistTxRouter _ pr :: Proxy r
pr ps :: Proxy scope
ps nat :: forall a. Sem s a -> Sem s' a
nat = Proxy sublayout
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx sublayout s
-> RouteTx sublayout s'
forall k (layout :: k) (r :: EffectRow) (scope :: Scope)
       (s :: EffectRow) (s' :: EffectRow).
HasTxRouter layout r scope =>
Proxy layout
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx layout s
-> RouteTx layout s'
hoistTxRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy @sublayout) Proxy r
pr Proxy scope
ps forall a. Sem s a -> Sem s' a
nat

methodRouter
  :: HasCodec a
  => Members [Embed IO, Tagged scope ReadStore] r
  => Proxy scope
  -> R.Delayed (Sem r) env (RoutingTx msg) (Sem (TxEffs :& r) a)
  -> R.Router env r (RoutingTx msg) (TxResult, Maybe Cache)
methodRouter :: Proxy scope
-> Delayed (Sem r) env (RoutingTx msg) (Sem (TxEffs :& r) a)
-> Router env r (RoutingTx msg) (TxResult, Maybe Cache)
methodRouter ps :: Proxy scope
ps action :: Delayed (Sem r) env (RoutingTx msg) (Sem (TxEffs :& r) a)
action =
  let route' :: env -> RoutingTx msg -> Sem r (RouteResult (TxResult, Maybe Cache))
route' env :: env
env tx :: RoutingTx msg
tx = do
        TransactionContext
ctx <- IO TransactionContext -> Sem r TransactionContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TransactionContext -> Sem r TransactionContext)
-> IO TransactionContext -> Sem r TransactionContext
forall a b. (a -> b) -> a -> b
$ Bool -> RoutingTx msg -> IO TransactionContext
forall msg. Bool -> RoutingTx msg -> IO TransactionContext
newTransactionContext Bool
True RoutingTx msg
tx
        let action' :: Delayed (Sem r) env (RoutingTx msg) (Sem r (TxResult, Maybe Cache))
action' = ((Maybe (a, Cache), TxResult) -> (TxResult, Maybe Cache))
-> Sem r (Maybe (a, Cache), TxResult)
-> Sem r (TxResult, Maybe Cache)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(rc :: Maybe (a, Cache)
rc,res :: TxResult
res) -> (TxResult
res,((a, Cache) -> Cache) -> Maybe (a, Cache) -> Maybe Cache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Cache) -> Cache
forall a b. (a, b) -> b
snd Maybe (a, Cache)
rc)) (Sem r (Maybe (a, Cache), TxResult)
 -> Sem r (TxResult, Maybe Cache))
-> (Sem
      (Output Event
         : GasMeter : WriteStore : ReadStore : Error AppError : r)
      a
    -> Sem r (Maybe (a, Cache), TxResult))
-> Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a
-> Sem r (TxResult, Maybe Cache)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy scope
-> TransactionContext
-> Sem (TxEffs :& r) a
-> Sem r (Maybe (a, Cache), TxResult)
forall k (scope :: k) (r :: EffectRow) a.
(Members '[Embed IO, Tagged scope ReadStore] r, HasCodec a) =>
Proxy scope
-> TransactionContext
-> Sem (TxEffs :& r) a
-> Sem r (Maybe (a, Cache), TxResult)
runTx Proxy scope
ps TransactionContext
ctx (Sem
   (Output Event
      : GasMeter : WriteStore : ReadStore : Error AppError : r)
   a
 -> Sem r (TxResult, Maybe Cache))
-> Delayed
     (Sem r)
     env
     (RoutingTx msg)
     (Sem
        (Output Event
           : GasMeter : WriteStore : ReadStore : Error AppError : r)
        a)
-> Delayed
     (Sem r) env (RoutingTx msg) (Sem r (TxResult, Maybe Cache))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed
  (Sem r)
  env
  (RoutingTx msg)
  (Sem
     (Output Event
        : GasMeter : WriteStore : ReadStore : Error AppError : r)
     a)
Delayed (Sem r) env (RoutingTx msg) (Sem (TxEffs :& r) a)
action
        Delayed (Sem r) env (RoutingTx msg) (Sem r (TxResult, Maybe Cache))
-> env
-> RoutingTx msg
-> ((TxResult, Maybe Cache)
    -> Sem r (RouteResult (TxResult, Maybe Cache)))
-> Sem r (RouteResult (TxResult, Maybe Cache))
forall (r :: EffectRow) env req a b.
Delayed (Sem r) env req (Sem r a)
-> env
-> req
-> (a -> Sem r (RouteResult b))
-> Sem r (RouteResult b)
R.runAction Delayed (Sem r) env (RoutingTx msg) (Sem r (TxResult, Maybe Cache))
action' env
env RoutingTx msg
tx (RouteResult (TxResult, Maybe Cache)
-> Sem r (RouteResult (TxResult, Maybe Cache))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RouteResult (TxResult, Maybe Cache)
 -> Sem r (RouteResult (TxResult, Maybe Cache)))
-> ((TxResult, Maybe Cache) -> RouteResult (TxResult, Maybe Cache))
-> (TxResult, Maybe Cache)
-> Sem r (RouteResult (TxResult, Maybe Cache))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxResult, Maybe Cache) -> RouteResult (TxResult, Maybe Cache)
forall a. a -> RouteResult a
R.Route)
  in (env
 -> RoutingTx msg -> Sem r (RouteResult (TxResult, Maybe Cache)))
-> Router env r (RoutingTx msg) (TxResult, Maybe Cache)
forall env a. (env -> a) -> Router' env a
R.leafRouter env -> RoutingTx msg -> Sem r (RouteResult (TxResult, Maybe Cache))
route'

instance ( HasMessageType msg, HasCodec msg
         , Members [Tagged scope ReadStore, Embed IO] r
         , HasCodec a
         ) => HasTxRouter (TypedMessage msg :~> Return a) r scope where

  type RouteTx (TypedMessage msg :~> Return a) r = RoutingTx msg -> Sem r a

  routeTx :: Proxy (TypedMessage msg :~> Return a)
-> Proxy r
-> Proxy scope
-> Delayed
     (Sem r)
     env
     (RoutingTx ByteString)
     (RouteTx (TypedMessage msg :~> Return a) (TxEffs :& r))
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
routeTx _ _ ps :: Proxy scope
ps subserver :: Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RouteTx (TypedMessage msg :~> Return a) (TxEffs :& r))
subserver =
    let f :: RoutingTx ByteString
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
f (RoutingTx tx :: Tx alg ByteString
tx@Tx{Msg ByteString
txMsg :: forall k (alg :: k) msg. Tx alg msg -> Msg msg
txMsg :: Msg ByteString
txMsg}) =
          if Msg ByteString -> Text
forall msg. Msg msg -> Text
msgType Msg ByteString
txMsg Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
mt
            then case ByteString -> Either Text msg
forall a. HasCodec a => ByteString -> Either Text a
decode (ByteString -> Either Text msg) -> ByteString -> Either Text msg
forall a b. (a -> b) -> a -> b
$ Msg ByteString -> ByteString
forall msg. Msg msg -> msg
msgData Msg ByteString
txMsg of
              Left e :: Text
e -> RouterError
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
forall (m :: * -> *) req a.
Monad m =>
RouterError -> DelayedM m req a
R.delayedFail (RouterError
 -> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg))
-> RouterError
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
forall a b. (a -> b) -> a -> b
$
                Text -> RouterError
R.InvalidRequest ("Failed to parse message of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".")
              Right a :: msg
a -> RoutingTx msg
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RoutingTx msg
 -> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg))
-> (Tx alg msg -> RoutingTx msg)
-> Tx alg msg
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx alg msg -> RoutingTx msg
forall k (alg :: k) msg. Tx alg msg -> RoutingTx msg
RoutingTx (Tx alg msg
 -> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg))
-> Tx alg msg
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
forall a b. (a -> b) -> a -> b
$ Tx alg ByteString
tx {txMsg :: Msg msg
txMsg = Msg ByteString
txMsg {msgData :: msg
msgData = msg
a}}
            else RouterError
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
forall (m :: * -> *) req a.
Monad m =>
RouterError -> DelayedM m req a
R.delayedFail RouterError
R.PathNotFound
    in Proxy scope
-> Delayed (Sem r) env (RoutingTx ByteString) (Sem (TxEffs :& r) a)
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
forall k a (scope :: k) (r :: EffectRow) env msg.
(HasCodec a, Members '[Embed IO, Tagged scope ReadStore] r) =>
Proxy scope
-> Delayed (Sem r) env (RoutingTx msg) (Sem (TxEffs :& r) a)
-> Router env r (RoutingTx msg) (TxResult, Maybe Cache)
methodRouter Proxy scope
ps (Delayed (Sem r) env (RoutingTx ByteString) (Sem (TxEffs :& r) a)
 -> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache))
-> Delayed (Sem r) env (RoutingTx ByteString) (Sem (TxEffs :& r) a)
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
forall a b. (a -> b) -> a -> b
$ Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RoutingTx msg
   -> Sem
        (Output Event
           : GasMeter : WriteStore : ReadStore : Error AppError : r)
        a)
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
-> Delayed
     (Sem r)
     env
     (RoutingTx ByteString)
     (Sem
        (Output Event
           : GasMeter : WriteStore : ReadStore : Error AppError : r)
        a)
forall (m :: * -> *) env req a b.
Monad m =>
Delayed m env req (a -> b)
-> DelayedM m req a -> Delayed m env req b
R.addBody Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RouteTx (TypedMessage msg :~> Return a) (TxEffs :& r))
Delayed
  (Sem r)
  env
  (RoutingTx ByteString)
  (RoutingTx msg
   -> Sem
        (Output Event
           : GasMeter : WriteStore : ReadStore : Error AppError : r)
        a)
subserver (DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
 -> Delayed
      (Sem r) env (RoutingTx ByteString) (Sem (TxEffs :& r) a))
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
-> Delayed (Sem r) env (RoutingTx ByteString) (Sem (TxEffs :& r) a)
forall a b. (a -> b) -> a -> b
$ (RoutingTx ByteString
 -> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg))
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
forall (m :: * -> *) req a.
Monad m =>
(req -> DelayedM m req a) -> DelayedM m req a
R.withRequest RoutingTx ByteString
-> DelayedM (Sem r) (RoutingTx ByteString) (RoutingTx msg)
f
      where mt :: Text
mt = Proxy msg -> Text
forall k (msg :: k). HasMessageType msg => Proxy msg -> Text
messageType (Proxy msg
forall k (t :: k). Proxy t
Proxy :: Proxy msg)

  applyAnteHandler :: Proxy (TypedMessage msg :~> Return a)
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx (TypedMessage msg :~> Return a) r
-> RouteTx (TypedMessage msg :~> Return a) r
applyAnteHandler _ _ _ ah :: AnteHandler r
ah f :: RouteTx (TypedMessage msg :~> Return a) r
f = Endo (RoutingTx msg -> Sem r a)
-> (RoutingTx msg -> Sem r a) -> RoutingTx msg -> Sem r a
forall a. Endo a -> a -> a
appEndo Endo (RoutingTx msg -> Sem r a)
AnteHandler r
ah RouteTx (TypedMessage msg :~> Return a) r
RoutingTx msg -> Sem r a
f

  hoistTxRouter :: Proxy (TypedMessage msg :~> Return a)
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx (TypedMessage msg :~> Return a) s
-> RouteTx (TypedMessage msg :~> Return a) s'
hoistTxRouter _ _ _ nat :: forall a. Sem s a -> Sem s' a
nat = (Sem s a -> Sem s' a)
-> (RoutingTx msg -> Sem s a) -> RoutingTx msg -> Sem s' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Sem s a -> Sem s' a
forall a. Sem s a -> Sem s' a
nat

emptyTxServer :: RouteTx EmptyTxServer r
emptyTxServer :: RouteTx EmptyTxServer r
emptyTxServer = EmptyTxServer
RouteTx EmptyTxServer r
EmptyTxServer

instance HasTxRouter EmptyTxServer r scope where
  type RouteTx EmptyTxServer r = EmptyTxServer
  routeTx :: Proxy EmptyTxServer
-> Proxy r
-> Proxy scope
-> Delayed
     (Sem r)
     env
     (RoutingTx ByteString)
     (RouteTx EmptyTxServer (TxEffs :& r))
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
routeTx _ _ _ _ = Map
  Text (Router env r (RoutingTx ByteString) (TxResult, Maybe Cache))
-> [env
    -> Application
         (Sem r) (RoutingTx ByteString) (TxResult, Maybe Cache)]
-> Router env r (RoutingTx ByteString) (TxResult, Maybe Cache)
forall env a.
Map Text (Router' env a) -> [env -> a] -> Router' env a
R.StaticRouter Map
  Text (Router env r (RoutingTx ByteString) (TxResult, Maybe Cache))
forall a. Monoid a => a
mempty [env
 -> Application
      (Sem r) (RoutingTx ByteString) (TxResult, Maybe Cache)]
forall a. Monoid a => a
mempty

  applyAnteHandler :: Proxy EmptyTxServer
-> Proxy r
-> Proxy scope
-> AnteHandler r
-> RouteTx EmptyTxServer r
-> RouteTx EmptyTxServer r
applyAnteHandler _ _ _ _ = RouteTx EmptyTxServer r -> RouteTx EmptyTxServer r
forall a. a -> a
id

  hoistTxRouter :: Proxy EmptyTxServer
-> Proxy r
-> Proxy scope
-> (forall a. Sem s a -> Sem s' a)
-> RouteTx EmptyTxServer s
-> RouteTx EmptyTxServer s'
hoistTxRouter _ _ _ _ = RouteTx EmptyTxServer s -> RouteTx EmptyTxServer s'
forall a. a -> a
id