module Tendermint.Utils.TxClient.Types where

import           Control.Lens                           ((^.))
import           Crypto.Hash                            (Digest)
import           Crypto.Hash.Algorithms                 (SHA256)
import           Data.Bifunctor                         (first)
import qualified Data.ByteArray.Base64String            as Base64
import           Data.Int                               (Int64)
import           Data.Proxy
import           Data.Text                              (Text)
import           Network.ABCI.Types.Messages.FieldTypes (Event)
import qualified Network.ABCI.Types.Messages.Response   as Response
import qualified Network.Tendermint.Client              as RPC
import           Tendermint.SDK.BaseApp.Errors          (AppError,
                                                         txResultAppError)
import qualified Tendermint.SDK.BaseApp.Transaction     as T
import           Tendermint.SDK.Codec                   (HasCodec (..))
import           Tendermint.SDK.Crypto                  (RecoverableSignatureSchema (..),
                                                         SignatureSchema (..))
import           Tendermint.SDK.Types.Address           (Address)
import           Tendermint.SDK.Types.Transaction       (RawTransaction (..),
                                                         signRawTransaction)
import           Tendermint.SDK.Types.TxResult          (checkTxTxResult,
                                                         deliverTxTxResult)

data TxOpts = TxOpts
  { TxOpts -> Int64
txOptsGas    :: Int64
  , TxOpts -> Signer
txOptsSigner :: Signer
  }

data Signer = Signer
  { Signer -> Address
signerAddress :: Address
  , Signer -> RawTransaction -> RawTransaction
signerSign    :: RawTransaction -> RawTransaction
  }

makeSignerFromKey
  :: RecoverableSignatureSchema alg
  => Message alg ~ Digest SHA256
  => Proxy alg
  -> PrivateKey alg
  -> Signer
makeSignerFromKey :: Proxy alg -> PrivateKey alg -> Signer
makeSignerFromKey pa :: Proxy alg
pa privKey :: PrivateKey alg
privKey = Address -> (RawTransaction -> RawTransaction) -> Signer
Signer (Proxy alg -> PubKey alg -> Address
forall k (alg :: k).
SignatureSchema alg =>
Proxy alg -> PubKey alg -> Address
addressFromPubKey Proxy alg
pa (PubKey alg -> Address)
-> (PrivateKey alg -> PubKey alg) -> PrivateKey alg -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy alg -> PrivateKey alg -> PubKey alg
forall k (alg :: k).
SignatureSchema alg =>
Proxy alg -> PrivateKey alg -> PubKey alg
derivePubKey Proxy alg
pa (PrivateKey alg -> Address) -> PrivateKey alg -> Address
forall a b. (a -> b) -> a -> b
$ PrivateKey alg
privKey) ((RawTransaction -> RawTransaction) -> Signer)
-> (RawTransaction -> RawTransaction) -> Signer
forall a b. (a -> b) -> a -> b
$ \r :: RawTransaction
r ->
  let sig :: ByteString
sig = Proxy alg -> RecoverableSignature alg -> ByteString
forall k (alg :: k).
RecoverableSignatureSchema alg =>
Proxy alg -> RecoverableSignature alg -> ByteString
serializeRecoverableSignature Proxy alg
pa (RecoverableSignature alg -> ByteString)
-> RecoverableSignature alg -> ByteString
forall a b. (a -> b) -> a -> b
$
         Proxy alg
-> PrivateKey alg -> RawTransaction -> RecoverableSignature alg
forall k (alg :: k).
(RecoverableSignatureSchema alg, Message alg ~ Digest SHA256) =>
Proxy alg
-> PrivateKey alg -> RawTransaction -> RecoverableSignature alg
signRawTransaction Proxy alg
pa PrivateKey alg
privKey (RawTransaction -> RecoverableSignature alg)
-> RawTransaction -> RecoverableSignature alg
forall a b. (a -> b) -> a -> b
$ RawTransaction
r {rawTransactionSignature :: ByteString
rawTransactionSignature = ""}
  in RawTransaction
r {rawTransactionSignature :: ByteString
rawTransactionSignature = ByteString
sig}

data TxResponse a =
    TxResponse
      { TxResponse a -> a
txResponseResult :: a
      , TxResponse a -> [Event]
txResponseEvents :: [Event]
      }
  | TxError AppError
  deriving (TxResponse a -> TxResponse a -> Bool
(TxResponse a -> TxResponse a -> Bool)
-> (TxResponse a -> TxResponse a -> Bool) -> Eq (TxResponse a)
forall a. Eq a => TxResponse a -> TxResponse a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxResponse a -> TxResponse a -> Bool
$c/= :: forall a. Eq a => TxResponse a -> TxResponse a -> Bool
== :: TxResponse a -> TxResponse a -> Bool
$c== :: forall a. Eq a => TxResponse a -> TxResponse a -> Bool
Eq, Int -> TxResponse a -> ShowS
[TxResponse a] -> ShowS
TxResponse a -> String
(Int -> TxResponse a -> ShowS)
-> (TxResponse a -> String)
-> ([TxResponse a] -> ShowS)
-> Show (TxResponse a)
forall a. Show a => Int -> TxResponse a -> ShowS
forall a. Show a => [TxResponse a] -> ShowS
forall a. Show a => TxResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxResponse a] -> ShowS
$cshowList :: forall a. Show a => [TxResponse a] -> ShowS
show :: TxResponse a -> String
$cshow :: forall a. Show a => TxResponse a -> String
showsPrec :: Int -> TxResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TxResponse a -> ShowS
Show)

data SynchronousResponse c d = SynchronousResponse
  { SynchronousResponse c d -> TxResponse c
checkTxResponse   :: TxResponse c
  , SynchronousResponse c d -> TxResponse d
deliverTxResponse :: TxResponse d
  } deriving (SynchronousResponse c d -> SynchronousResponse c d -> Bool
(SynchronousResponse c d -> SynchronousResponse c d -> Bool)
-> (SynchronousResponse c d -> SynchronousResponse c d -> Bool)
-> Eq (SynchronousResponse c d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c d.
(Eq c, Eq d) =>
SynchronousResponse c d -> SynchronousResponse c d -> Bool
/= :: SynchronousResponse c d -> SynchronousResponse c d -> Bool
$c/= :: forall c d.
(Eq c, Eq d) =>
SynchronousResponse c d -> SynchronousResponse c d -> Bool
== :: SynchronousResponse c d -> SynchronousResponse c d -> Bool
$c== :: forall c d.
(Eq c, Eq d) =>
SynchronousResponse c d -> SynchronousResponse c d -> Bool
Eq, Int -> SynchronousResponse c d -> ShowS
[SynchronousResponse c d] -> ShowS
SynchronousResponse c d -> String
(Int -> SynchronousResponse c d -> ShowS)
-> (SynchronousResponse c d -> String)
-> ([SynchronousResponse c d] -> ShowS)
-> Show (SynchronousResponse c d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c d.
(Show c, Show d) =>
Int -> SynchronousResponse c d -> ShowS
forall c d. (Show c, Show d) => [SynchronousResponse c d] -> ShowS
forall c d. (Show c, Show d) => SynchronousResponse c d -> String
showList :: [SynchronousResponse c d] -> ShowS
$cshowList :: forall c d. (Show c, Show d) => [SynchronousResponse c d] -> ShowS
show :: SynchronousResponse c d -> String
$cshow :: forall c d. (Show c, Show d) => SynchronousResponse c d -> String
showsPrec :: Int -> SynchronousResponse c d -> ShowS
$cshowsPrec :: forall c d.
(Show c, Show d) =>
Int -> SynchronousResponse c d -> ShowS
Show)

data TxClientResponse c d =
    RPCError Text
  | ParseError T.RouteContext Text
  | Response (SynchronousResponse c d)
  deriving (TxClientResponse c d -> TxClientResponse c d -> Bool
(TxClientResponse c d -> TxClientResponse c d -> Bool)
-> (TxClientResponse c d -> TxClientResponse c d -> Bool)
-> Eq (TxClientResponse c d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c d.
(Eq c, Eq d) =>
TxClientResponse c d -> TxClientResponse c d -> Bool
/= :: TxClientResponse c d -> TxClientResponse c d -> Bool
$c/= :: forall c d.
(Eq c, Eq d) =>
TxClientResponse c d -> TxClientResponse c d -> Bool
== :: TxClientResponse c d -> TxClientResponse c d -> Bool
$c== :: forall c d.
(Eq c, Eq d) =>
TxClientResponse c d -> TxClientResponse c d -> Bool
Eq, Int -> TxClientResponse c d -> ShowS
[TxClientResponse c d] -> ShowS
TxClientResponse c d -> String
(Int -> TxClientResponse c d -> ShowS)
-> (TxClientResponse c d -> String)
-> ([TxClientResponse c d] -> ShowS)
-> Show (TxClientResponse c d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c d.
(Show c, Show d) =>
Int -> TxClientResponse c d -> ShowS
forall c d. (Show c, Show d) => [TxClientResponse c d] -> ShowS
forall c d. (Show c, Show d) => TxClientResponse c d -> String
showList :: [TxClientResponse c d] -> ShowS
$cshowList :: forall c d. (Show c, Show d) => [TxClientResponse c d] -> ShowS
show :: TxClientResponse c d -> String
$cshow :: forall c d. (Show c, Show d) => TxClientResponse c d -> String
showsPrec :: Int -> TxClientResponse c d -> ShowS
$cshowsPrec :: forall c d.
(Show c, Show d) =>
Int -> TxClientResponse c d -> ShowS
Show)

parseRPCResponse
  :: forall check deliver.
     HasCodec check
  => HasCodec deliver
  => RPC.ResultBroadcastTxCommit
  -> TxClientResponse check deliver
parseRPCResponse :: ResultBroadcastTxCommit -> TxClientResponse check deliver
parseRPCResponse RPC.ResultBroadcastTxCommit{..} =
      let
          makeCheckResp :: CheckTx -> Either Text (TxResponse a)
makeCheckResp r :: CheckTx
r@Response.CheckTx{..} = case Word32
checkTxCode of
              0 -> do
                a
resp <- ByteString -> Either Text a
forall a. HasCodec a => ByteString -> Either Text a
decode (ByteString -> Either Text a) -> ByteString -> Either Text a
forall a b. (a -> b) -> a -> b
$ Base64String -> ByteString
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes Base64String
checkTxData
                TxResponse a -> Either Text (TxResponse a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxResponse a -> Either Text (TxResponse a))
-> TxResponse a -> Either Text (TxResponse a)
forall a b. (a -> b) -> a -> b
$ a -> [Event] -> TxResponse a
forall a. a -> [Event] -> TxResponse a
TxResponse a
resp ([Event] -> TxResponse a) -> [Event] -> TxResponse a
forall a b. (a -> b) -> a -> b
$ [Event]
checkTxEvents
              _ -> TxResponse a -> Either Text (TxResponse a)
forall a b. b -> Either a b
Right (TxResponse a -> Either Text (TxResponse a))
-> (AppError -> TxResponse a)
-> AppError
-> Either Text (TxResponse a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppError -> TxResponse a
forall a. AppError -> TxResponse a
TxError (AppError -> Either Text (TxResponse a))
-> AppError -> Either Text (TxResponse a)
forall a b. (a -> b) -> a -> b
$ CheckTx
r CheckTx -> Getting AppError CheckTx AppError -> AppError
forall s a. s -> Getting a s a -> a
^. (TxResult -> Const AppError TxResult)
-> CheckTx -> Const AppError CheckTx
Iso' CheckTx TxResult
checkTxTxResult ((TxResult -> Const AppError TxResult)
 -> CheckTx -> Const AppError CheckTx)
-> ((AppError -> Const AppError AppError)
    -> TxResult -> Const AppError TxResult)
-> Getting AppError CheckTx AppError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AppError -> Const AppError AppError)
-> TxResult -> Const AppError TxResult
Lens' TxResult AppError
txResultAppError

          makeDeliverResp :: DeliverTx -> Either Text (TxResponse a)
makeDeliverResp r :: DeliverTx
r@Response.DeliverTx{..} = case Word32
deliverTxCode of
              0 -> do
                a
resp <- ByteString -> Either Text a
forall a. HasCodec a => ByteString -> Either Text a
decode (ByteString -> Either Text a) -> ByteString -> Either Text a
forall a b. (a -> b) -> a -> b
$ Base64String -> ByteString
forall ba. ByteArray ba => Base64String -> ba
Base64.toBytes Base64String
deliverTxData
                TxResponse a -> Either Text (TxResponse a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxResponse a -> Either Text (TxResponse a))
-> TxResponse a -> Either Text (TxResponse a)
forall a b. (a -> b) -> a -> b
$ a -> [Event] -> TxResponse a
forall a. a -> [Event] -> TxResponse a
TxResponse a
resp ([Event] -> TxResponse a) -> [Event] -> TxResponse a
forall a b. (a -> b) -> a -> b
$ [Event]
deliverTxEvents
              _ -> TxResponse a -> Either Text (TxResponse a)
forall a b. b -> Either a b
Right (TxResponse a -> Either Text (TxResponse a))
-> (AppError -> TxResponse a)
-> AppError
-> Either Text (TxResponse a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppError -> TxResponse a
forall a. AppError -> TxResponse a
TxError (AppError -> Either Text (TxResponse a))
-> AppError -> Either Text (TxResponse a)
forall a b. (a -> b) -> a -> b
$ DeliverTx
r DeliverTx -> Getting AppError DeliverTx AppError -> AppError
forall s a. s -> Getting a s a -> a
^. (TxResult -> Const AppError TxResult)
-> DeliverTx -> Const AppError DeliverTx
Iso' DeliverTx TxResult
deliverTxTxResult ((TxResult -> Const AppError TxResult)
 -> DeliverTx -> Const AppError DeliverTx)
-> ((AppError -> Const AppError AppError)
    -> TxResult -> Const AppError TxResult)
-> Getting AppError DeliverTx AppError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AppError -> Const AppError AppError)
-> TxResult -> Const AppError TxResult
Lens' TxResult AppError
txResultAppError

          eResponses :: Either
  (TxClientResponse check deliver)
  (TxResponse check, TxResponse deliver)
eResponses = do
            TxResponse check
checkResp <- (Text -> TxClientResponse check deliver)
-> Either Text (TxResponse check)
-> Either (TxClientResponse check deliver) (TxResponse check)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (RouteContext -> Text -> TxClientResponse check deliver
forall c d. RouteContext -> Text -> TxClientResponse c d
ParseError RouteContext
T.CheckTx) (Either Text (TxResponse check)
 -> Either (TxClientResponse check deliver) (TxResponse check))
-> Either Text (TxResponse check)
-> Either (TxClientResponse check deliver) (TxResponse check)
forall a b. (a -> b) -> a -> b
$
              CheckTx -> Either Text (TxResponse check)
forall a. HasCodec a => CheckTx -> Either Text (TxResponse a)
makeCheckResp CheckTx
resultBroadcastTxCommitCheckTx
            TxResponse deliver
deliverResp <- (Text -> TxClientResponse check deliver)
-> Either Text (TxResponse deliver)
-> Either (TxClientResponse check deliver) (TxResponse deliver)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (RouteContext -> Text -> TxClientResponse check deliver
forall c d. RouteContext -> Text -> TxClientResponse c d
ParseError RouteContext
T.DeliverTx) (Either Text (TxResponse deliver)
 -> Either (TxClientResponse check deliver) (TxResponse deliver))
-> Either Text (TxResponse deliver)
-> Either (TxClientResponse check deliver) (TxResponse deliver)
forall a b. (a -> b) -> a -> b
$
              DeliverTx -> Either Text (TxResponse deliver)
forall a. HasCodec a => DeliverTx -> Either Text (TxResponse a)
makeDeliverResp DeliverTx
resultBroadcastTxCommitDeliverTx
            (TxResponse check, TxResponse deliver)
-> Either
     (TxClientResponse check deliver)
     (TxResponse check, TxResponse deliver)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxResponse check
checkResp, TxResponse deliver
deliverResp)

      in case Either
  (TxClientResponse check deliver)
  (TxResponse check, TxResponse deliver)
eResponses of
          Left e :: TxClientResponse check deliver
e -> TxClientResponse check deliver
e
          Right (check :: TxResponse check
check, deliver :: TxResponse deliver
deliver) -> SynchronousResponse check deliver -> TxClientResponse check deliver
forall c d. SynchronousResponse c d -> TxClientResponse c d
Response (SynchronousResponse check deliver
 -> TxClientResponse check deliver)
-> SynchronousResponse check deliver
-> TxClientResponse check deliver
forall a b. (a -> b) -> a -> b
$ TxResponse check
-> TxResponse deliver -> SynchronousResponse check deliver
forall c d. TxResponse c -> TxResponse d -> SynchronousResponse c d
SynchronousResponse TxResponse check
check TxResponse deliver
deliver