module Tendermint.SDK.BaseApp.Transaction.Checker
  ( DefaultCheckTx(..)
  , VoidReturn
  ) where

import           Data.Kind                                (Type)
import           Data.Proxy
import qualified Data.Validation                          as V
import           Polysemy                                 (EffectRow, Member,
                                                           Sem)
import           Polysemy.Error                           (Error)
import           Servant.API                              ((:<|>) (..), (:>))
import           Tendermint.SDK.BaseApp.Errors            (AppError,
                                                           SDKError (..),
                                                           throwSDKError)
import           Tendermint.SDK.BaseApp.Transaction.Types
import           Tendermint.SDK.Types.Message             (ValidateMessage (..), formatMessageSemanticError)

defaultCheckTxHandler
  :: Member (Error AppError) r
  => ValidateMessage msg
  => RoutingTx msg
  -> Sem r ()
defaultCheckTxHandler :: RoutingTx msg -> Sem r ()
defaultCheckTxHandler(RoutingTx Tx{Msg msg
txMsg :: forall k (alg :: k) msg. Tx alg msg -> Msg msg
txMsg :: Msg msg
txMsg}) =
  case Msg msg -> Validation [MessageSemanticError] ()
forall msg.
ValidateMessage msg =>
Msg msg -> Validation [MessageSemanticError] ()
validateMessage Msg msg
txMsg of
    V.Failure err :: [MessageSemanticError]
err ->
      SDKError -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) a.
Member (Error AppError) r =>
SDKError -> Sem r a
throwSDKError (SDKError -> Sem r ())
-> ([MessageSemanticError] -> SDKError)
-> [MessageSemanticError]
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> SDKError
MessageValidation ([Text] -> SDKError)
-> ([MessageSemanticError] -> [Text])
-> [MessageSemanticError]
-> SDKError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MessageSemanticError -> Text) -> [MessageSemanticError] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MessageSemanticError -> Text
formatMessageSemanticError ([MessageSemanticError] -> Sem r ())
-> [MessageSemanticError] -> Sem r ()
forall a b. (a -> b) -> a -> b
$ [MessageSemanticError]
err
    V.Success _ -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

type family VoidReturn (api :: Type) :: Type where
  VoidReturn (a :<|> b) = VoidReturn a :<|> VoidReturn b
  VoidReturn (path :> a) = path :> VoidReturn a
  VoidReturn (TypedMessage msg :~> Return a) = TypedMessage msg :~> Return ()

class DefaultCheckTx api (r :: EffectRow) where
    type DefaultCheckTxT api r :: Type
    defaultCheckTx :: Proxy api -> Proxy r -> DefaultCheckTxT api r

instance (DefaultCheckTx a r, DefaultCheckTx b r) => DefaultCheckTx (a :<|> b) r where
    type DefaultCheckTxT (a :<|> b) r = DefaultCheckTxT a r :<|> DefaultCheckTxT b r

    defaultCheckTx :: Proxy (a :<|> b) -> Proxy r -> DefaultCheckTxT (a :<|> b) r
defaultCheckTx _ pr :: Proxy r
pr =
        Proxy a -> Proxy r -> DefaultCheckTxT a r
forall k (api :: k) (r :: [(* -> *) -> * -> *]).
DefaultCheckTx api r =>
Proxy api -> Proxy r -> DefaultCheckTxT api r
defaultCheckTx (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Proxy r
pr DefaultCheckTxT a r
-> DefaultCheckTxT b r
-> DefaultCheckTxT a r :<|> DefaultCheckTxT b r
forall a b. a -> b -> a :<|> b
:<|> Proxy b -> Proxy r -> DefaultCheckTxT b r
forall k (api :: k) (r :: [(* -> *) -> * -> *]).
DefaultCheckTx api r =>
Proxy api -> Proxy r -> DefaultCheckTxT api r
defaultCheckTx (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b) Proxy r
pr

instance DefaultCheckTx rest r => DefaultCheckTx (path :> rest) r where
    type DefaultCheckTxT (path :> rest) r = DefaultCheckTxT rest r

    defaultCheckTx :: Proxy (path :> rest) -> Proxy r -> DefaultCheckTxT (path :> rest) r
defaultCheckTx _ = Proxy rest -> Proxy r -> DefaultCheckTxT rest r
forall k (api :: k) (r :: [(* -> *) -> * -> *]).
DefaultCheckTx api r =>
Proxy api -> Proxy r -> DefaultCheckTxT api r
defaultCheckTx (Proxy rest
forall k (t :: k). Proxy t
Proxy :: Proxy rest)

instance (Member (Error AppError) r, ValidateMessage msg) =>  DefaultCheckTx (TypedMessage msg :~> Return a) r where
    type DefaultCheckTxT (TypedMessage msg :~> Return a) r = RoutingTx msg -> Sem r ()

    defaultCheckTx :: Proxy (TypedMessage msg :~> Return a)
-> Proxy r -> DefaultCheckTxT (TypedMessage msg :~> Return a) r
defaultCheckTx _ _ = DefaultCheckTxT (TypedMessage msg :~> Return a) r
forall (r :: [(* -> *) -> * -> *]) msg.
(Member (Error AppError) r, ValidateMessage msg) =>
RoutingTx msg -> Sem r ()
defaultCheckTxHandler

instance DefaultCheckTx EmptyTxServer r where
    type DefaultCheckTxT EmptyTxServer r = EmptyTxServer

    defaultCheckTx :: Proxy EmptyTxServer -> Proxy r -> DefaultCheckTxT EmptyTxServer r
defaultCheckTx _ _ = EmptyTxServer
DefaultCheckTxT EmptyTxServer r
EmptyTxServer