{-# LANGUAGE UndecidableInstances #-}

module Tendermint.Utils.TxClient.Class
  ( ClientConfig(..)
  , RunTxClient(..)
  , HasTxClient(..)
  , EmptyTxClient(..)
  , defaultClientTxOpts
  ) where

import           Control.Monad.IO.Class             (liftIO)
import           Control.Monad.Reader               (ReaderT, ask)
import qualified Data.ByteArray.Base64String        as Base64
import           Data.Kind                          (Type)
import           Data.Proxy
import           Data.String.Conversions            (cs)
import           Data.Text                          (Text)
import           Data.Word                          (Word64)
import           GHC.TypeLits                       (KnownSymbol, symbolVal)
import qualified Network.Tendermint.Client          as RPC
import           Servant.API                        ((:<|>) (..), (:>))
import qualified Tendermint.SDK.BaseApp.Transaction as T
import           Tendermint.SDK.Codec               (HasCodec (..))
import           Tendermint.SDK.Types.Address       (Address)
import           Tendermint.SDK.Types.Message       (HasMessageType (..),
                                                     TypedMessage (..))
import           Tendermint.SDK.Types.Transaction   (RawTransaction (..))
import           Tendermint.Utils.TxClient.Types

class Monad m => RunTxClient m where
    -- | How to make a request.
    runTx :: RawTransaction -> m RPC.ResultBroadcastTxCommit
    getNonce :: Address -> m Word64

data ClientConfig = ClientConfig
  { ClientConfig -> Config
clientRPC      :: RPC.Config
  , ClientConfig -> Address -> IO Word64
clientGetNonce :: Address -> IO Word64
  }


instance RunTxClient (ReaderT ClientConfig IO) where
    getNonce :: Address -> ReaderT ClientConfig IO Word64
getNonce addr :: Address
addr = do
      Address -> IO Word64
nonceGetter <- ClientConfig -> Address -> IO Word64
clientGetNonce (ClientConfig -> Address -> IO Word64)
-> ReaderT ClientConfig IO ClientConfig
-> ReaderT ClientConfig IO (Address -> IO Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ClientConfig IO ClientConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      IO Word64 -> ReaderT ClientConfig IO Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> ReaderT ClientConfig IO Word64)
-> IO Word64 -> ReaderT ClientConfig IO Word64
forall a b. (a -> b) -> a -> b
$ Address -> IO Word64
nonceGetter Address
addr
    runTx :: RawTransaction -> ReaderT ClientConfig IO ResultBroadcastTxCommit
runTx tx :: RawTransaction
tx = do
      let txReq :: TendermintM ResultBroadcastTxCommit
txReq = RequestBroadcastTxCommit -> TendermintM ResultBroadcastTxCommit
RPC.broadcastTxCommit (RequestBroadcastTxCommit -> TendermintM ResultBroadcastTxCommit)
-> (RawTransaction -> RequestBroadcastTxCommit)
-> RawTransaction
-> TendermintM ResultBroadcastTxCommit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> RequestBroadcastTxCommit
RPC.RequestBroadcastTxCommit (Tx -> RequestBroadcastTxCommit)
-> (RawTransaction -> Tx)
-> RawTransaction
-> RequestBroadcastTxCommit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Tx
forall ba. ByteArrayAccess ba => ba -> Tx
Base64.fromBytes (ByteString -> Tx)
-> (RawTransaction -> ByteString) -> RawTransaction -> Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawTransaction -> ByteString
forall a. HasCodec a => a -> ByteString
encode (RawTransaction -> TendermintM ResultBroadcastTxCommit)
-> RawTransaction -> TendermintM ResultBroadcastTxCommit
forall a b. (a -> b) -> a -> b
$ RawTransaction
tx
      Config
rpc <- ClientConfig -> Config
clientRPC (ClientConfig -> Config)
-> ReaderT ClientConfig IO ClientConfig
-> ReaderT ClientConfig IO Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ClientConfig IO ClientConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
      IO ResultBroadcastTxCommit
-> ReaderT ClientConfig IO ResultBroadcastTxCommit
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ResultBroadcastTxCommit
 -> ReaderT ClientConfig IO ResultBroadcastTxCommit)
-> (TendermintM ResultBroadcastTxCommit
    -> IO ResultBroadcastTxCommit)
-> TendermintM ResultBroadcastTxCommit
-> ReaderT ClientConfig IO ResultBroadcastTxCommit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config
-> TendermintM ResultBroadcastTxCommit
-> IO ResultBroadcastTxCommit
forall a. Config -> TendermintM a -> IO a
RPC.runTendermintM Config
rpc (TendermintM ResultBroadcastTxCommit
 -> ReaderT ClientConfig IO ResultBroadcastTxCommit)
-> TendermintM ResultBroadcastTxCommit
-> ReaderT ClientConfig IO ResultBroadcastTxCommit
forall a b. (a -> b) -> a -> b
$ TendermintM ResultBroadcastTxCommit
txReq

data ClientTxOpts = ClientTxOpts
  { ClientTxOpts -> Text
clientTxOptsRoute :: Text
  , ClientTxOpts -> Word64
clientTxOptsNonce :: Word64
  }

defaultClientTxOpts :: ClientTxOpts
defaultClientTxOpts :: ClientTxOpts
defaultClientTxOpts = Text -> Word64 -> ClientTxOpts
ClientTxOpts "" 0

class HasTxClient m layoutC layoutD where

    type ClientT (m :: Type -> Type) layoutC layoutD :: Type
    genClientT :: Proxy m -> Proxy layoutC -> Proxy layoutD -> ClientTxOpts -> ClientT m layoutC layoutD

instance (HasTxClient m a c, HasTxClient m b d) => HasTxClient m (a :<|> b) (c :<|> d) where
    type ClientT m (a :<|> b) (c :<|> d) = ClientT m a c :<|> ClientT m b d
    genClientT :: Proxy m
-> Proxy (a :<|> b)
-> Proxy (c :<|> d)
-> ClientTxOpts
-> ClientT m (a :<|> b) (c :<|> d)
genClientT pm :: Proxy m
pm _ _ opts :: ClientTxOpts
opts = Proxy m -> Proxy a -> Proxy c -> ClientTxOpts -> ClientT m a c
forall (m :: * -> *) layoutC layoutD.
HasTxClient m layoutC layoutD =>
Proxy m
-> Proxy layoutC
-> Proxy layoutD
-> ClientTxOpts
-> ClientT m layoutC layoutD
genClientT Proxy m
pm (Proxy a
forall k (t :: k). Proxy t
Proxy @a) (Proxy c
forall k (t :: k). Proxy t
Proxy @c) ClientTxOpts
opts ClientT m a c -> ClientT m b d -> ClientT m a c :<|> ClientT m b d
forall a b. a -> b -> a :<|> b
:<|>
                           Proxy m -> Proxy b -> Proxy d -> ClientTxOpts -> ClientT m b d
forall (m :: * -> *) layoutC layoutD.
HasTxClient m layoutC layoutD =>
Proxy m
-> Proxy layoutC
-> Proxy layoutD
-> ClientTxOpts
-> ClientT m layoutC layoutD
genClientT Proxy m
pm (Proxy b
forall k (t :: k). Proxy t
Proxy @b) (Proxy d
forall k (t :: k). Proxy t
Proxy @d) ClientTxOpts
opts

instance (KnownSymbol path, HasTxClient m a b) => HasTxClient m (path :> a) (path :> b) where
    type ClientT m (path :> a) (path :> b) = ClientT m a b
    genClientT :: Proxy m
-> Proxy (path :> a)
-> Proxy (path :> b)
-> ClientTxOpts
-> ClientT m (path :> a) (path :> b)
genClientT pm :: Proxy m
pm _ _ clientOpts :: ClientTxOpts
clientOpts =
      let clientOpts' :: ClientTxOpts
clientOpts' = ClientTxOpts
clientOpts { clientTxOptsRoute :: Text
clientTxOptsRoute = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy path -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy path
forall k (t :: k). Proxy t
Proxy @path) }
      in  Proxy m -> Proxy a -> Proxy b -> ClientTxOpts -> ClientT m a b
forall (m :: * -> *) layoutC layoutD.
HasTxClient m layoutC layoutD =>
Proxy m
-> Proxy layoutC
-> Proxy layoutD
-> ClientTxOpts
-> ClientT m layoutC layoutD
genClientT Proxy m
pm (Proxy a
forall k (t :: k). Proxy t
Proxy @a) (Proxy b
forall k (t :: k). Proxy t
Proxy @b) ClientTxOpts
clientOpts'

makeRawTxForSigning
  :: forall msg.
     HasMessageType msg
  => HasCodec msg
  => ClientTxOpts
  -> TxOpts
  -> msg
  -> RawTransaction
makeRawTxForSigning :: ClientTxOpts -> TxOpts -> msg -> RawTransaction
makeRawTxForSigning ClientTxOpts{..} TxOpts{..} msg :: msg
msg =
  RawTransaction :: TypedMessage
-> Int64 -> Text -> ByteString -> Word64 -> RawTransaction
RawTransaction
    { rawTransactionData :: TypedMessage
rawTransactionData = ByteString -> Text -> TypedMessage
TypedMessage (msg -> ByteString
forall a. HasCodec a => a -> ByteString
encode msg
msg) (Proxy msg -> Text
forall k (msg :: k). HasMessageType msg => Proxy msg -> Text
messageType (Proxy msg -> Text) -> Proxy msg -> Text
forall a b. (a -> b) -> a -> b
$ Proxy msg
forall k (t :: k). Proxy t
Proxy @msg)
    , rawTransactionGas :: Int64
rawTransactionGas = Int64
txOptsGas
    , rawTransactionNonce :: Word64
rawTransactionNonce = Word64
clientTxOptsNonce
    , rawTransactionRoute :: Text
rawTransactionRoute = Text
clientTxOptsRoute
    , rawTransactionSignature :: ByteString
rawTransactionSignature = ""
    }

instance ( HasMessageType msg, HasCodec msg
         , HasCodec check, HasCodec deliver
         , RunTxClient m
         ) => HasTxClient m (T.TypedMessage msg T.:~> T.Return check) (T.TypedMessage msg T.:~> T.Return deliver) where
    type ClientT m (T.TypedMessage msg T.:~> T.Return check) (T.TypedMessage msg T.:~> T.Return deliver) =
           TxOpts -> msg -> m (TxClientResponse check deliver)

    genClientT :: Proxy m
-> Proxy (TypedMessage msg :~> Return check)
-> Proxy (TypedMessage msg :~> Return deliver)
-> ClientTxOpts
-> ClientT
     m
     (TypedMessage msg :~> Return check)
     (TypedMessage msg :~> Return deliver)
genClientT _ _ _ clientOpts :: ClientTxOpts
clientOpts opts :: TxOpts
opts msg :: msg
msg = do
      let Signer signerAddress :: Address
signerAddress signer :: RawTransaction -> RawTransaction
signer = TxOpts -> Signer
txOptsSigner TxOpts
opts
      Word64
nonce <- Address -> m Word64
forall (m :: * -> *). RunTxClient m => Address -> m Word64
getNonce Address
signerAddress
      let clientOpts' :: ClientTxOpts
clientOpts' = ClientTxOpts
clientOpts {clientTxOptsNonce :: Word64
clientTxOptsNonce = Word64
nonce}
          rawTxForSigning :: RawTransaction
rawTxForSigning = ClientTxOpts -> TxOpts -> msg -> RawTransaction
forall msg.
(HasMessageType msg, HasCodec msg) =>
ClientTxOpts -> TxOpts -> msg -> RawTransaction
makeRawTxForSigning ClientTxOpts
clientOpts' TxOpts
opts msg
msg
          rawTxWithSig :: RawTransaction
rawTxWithSig = RawTransaction -> RawTransaction
signer RawTransaction
rawTxForSigning
      ResultBroadcastTxCommit
txRes <- RawTransaction -> m ResultBroadcastTxCommit
forall (m :: * -> *).
RunTxClient m =>
RawTransaction -> m ResultBroadcastTxCommit
runTx RawTransaction
rawTxWithSig
      TxClientResponse check deliver
-> m (TxClientResponse check deliver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxClientResponse check deliver
 -> m (TxClientResponse check deliver))
-> TxClientResponse check deliver
-> m (TxClientResponse check deliver)
forall a b. (a -> b) -> a -> b
$ ResultBroadcastTxCommit -> TxClientResponse check deliver
forall check deliver.
(HasCodec check, HasCodec deliver) =>
ResultBroadcastTxCommit -> TxClientResponse check deliver
parseRPCResponse ResultBroadcastTxCommit
txRes


-- | Singleton type representing a client for an empty API.
data EmptyTxClient = EmptyTxClient deriving (EmptyTxClient -> EmptyTxClient -> Bool
(EmptyTxClient -> EmptyTxClient -> Bool)
-> (EmptyTxClient -> EmptyTxClient -> Bool) -> Eq EmptyTxClient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyTxClient -> EmptyTxClient -> Bool
$c/= :: EmptyTxClient -> EmptyTxClient -> Bool
== :: EmptyTxClient -> EmptyTxClient -> Bool
$c== :: EmptyTxClient -> EmptyTxClient -> Bool
Eq, Int -> EmptyTxClient -> ShowS
[EmptyTxClient] -> ShowS
EmptyTxClient -> String
(Int -> EmptyTxClient -> ShowS)
-> (EmptyTxClient -> String)
-> ([EmptyTxClient] -> ShowS)
-> Show EmptyTxClient
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyTxClient] -> ShowS
$cshowList :: [EmptyTxClient] -> ShowS
show :: EmptyTxClient -> String
$cshow :: EmptyTxClient -> String
showsPrec :: Int -> EmptyTxClient -> ShowS
$cshowsPrec :: Int -> EmptyTxClient -> ShowS
Show, EmptyTxClient
EmptyTxClient -> EmptyTxClient -> Bounded EmptyTxClient
forall a. a -> a -> Bounded a
maxBound :: EmptyTxClient
$cmaxBound :: EmptyTxClient
minBound :: EmptyTxClient
$cminBound :: EmptyTxClient
Bounded, Int -> EmptyTxClient
EmptyTxClient -> Int
EmptyTxClient -> [EmptyTxClient]
EmptyTxClient -> EmptyTxClient
EmptyTxClient -> EmptyTxClient -> [EmptyTxClient]
EmptyTxClient -> EmptyTxClient -> EmptyTxClient -> [EmptyTxClient]
(EmptyTxClient -> EmptyTxClient)
-> (EmptyTxClient -> EmptyTxClient)
-> (Int -> EmptyTxClient)
-> (EmptyTxClient -> Int)
-> (EmptyTxClient -> [EmptyTxClient])
-> (EmptyTxClient -> EmptyTxClient -> [EmptyTxClient])
-> (EmptyTxClient -> EmptyTxClient -> [EmptyTxClient])
-> (EmptyTxClient
    -> EmptyTxClient -> EmptyTxClient -> [EmptyTxClient])
-> Enum EmptyTxClient
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EmptyTxClient -> EmptyTxClient -> EmptyTxClient -> [EmptyTxClient]
$cenumFromThenTo :: EmptyTxClient -> EmptyTxClient -> EmptyTxClient -> [EmptyTxClient]
enumFromTo :: EmptyTxClient -> EmptyTxClient -> [EmptyTxClient]
$cenumFromTo :: EmptyTxClient -> EmptyTxClient -> [EmptyTxClient]
enumFromThen :: EmptyTxClient -> EmptyTxClient -> [EmptyTxClient]
$cenumFromThen :: EmptyTxClient -> EmptyTxClient -> [EmptyTxClient]
enumFrom :: EmptyTxClient -> [EmptyTxClient]
$cenumFrom :: EmptyTxClient -> [EmptyTxClient]
fromEnum :: EmptyTxClient -> Int
$cfromEnum :: EmptyTxClient -> Int
toEnum :: Int -> EmptyTxClient
$ctoEnum :: Int -> EmptyTxClient
pred :: EmptyTxClient -> EmptyTxClient
$cpred :: EmptyTxClient -> EmptyTxClient
succ :: EmptyTxClient -> EmptyTxClient
$csucc :: EmptyTxClient -> EmptyTxClient
Enum)

instance HasTxClient m T.EmptyTxServer T.EmptyTxServer where
  type ClientT m T.EmptyTxServer T.EmptyTxServer = EmptyTxClient

  genClientT :: Proxy m
-> Proxy EmptyTxServer
-> Proxy EmptyTxServer
-> ClientTxOpts
-> ClientT m EmptyTxServer EmptyTxServer
genClientT _ _ _ _  = EmptyTxClient
ClientT m EmptyTxServer EmptyTxServer
EmptyTxClient