module Tendermint.Utils.ClientUtils where

import           Control.Monad                          (unless)
import           Data.Aeson                             (ToJSON)
import           Data.Aeson.Encode.Pretty               (encodePretty)
import           Data.Proxy
import           Data.String.Conversions                (cs)
import           Data.Word                              (Word32)
import           Network.ABCI.Types.Messages.FieldTypes (Event (..))
import qualified Network.Tendermint.Client              as RPC
import           Tendermint.SDK.BaseApp.Errors          (AppError (..))
import           Tendermint.SDK.BaseApp.Query           (QueryResult (..))
import           Tendermint.Utils.Client                (QueryClientResponse (..),
                                                         SynchronousResponse (..),
                                                         TxClientResponse (..),
                                                         TxResponse (..))

--------------------------------------------------------------------------------
-- | Tx helpers
--------------------------------------------------------------------------------

assertTx
 :: Monad m
 => MonadFail m
 => m (TxClientResponse a b)
 -> m (SynchronousResponse a b)
assertTx :: m (TxClientResponse a b) -> m (SynchronousResponse a b)
assertTx m :: m (TxClientResponse a b)
m = do
  TxClientResponse a b
resp <- m (TxClientResponse a b)
m
  case TxClientResponse a b
resp of
    Response r :: SynchronousResponse a b
r -> SynchronousResponse a b -> m (SynchronousResponse a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SynchronousResponse a b
r
    RPCError err :: Text
err        -> String -> m (SynchronousResponse a b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (SynchronousResponse a b))
-> String -> m (SynchronousResponse a b)
forall a b. (a -> b) -> a -> b
$ "Expected Response, got RPCError " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
err
    ParseError ctx :: RouteContext
ctx err :: Text
err -> String -> m (SynchronousResponse a b)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (SynchronousResponse a b))
-> String -> m (SynchronousResponse a b)
forall a b. (a -> b) -> a -> b
$ "Expected Response, got ParseError in context " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RouteContext -> String
forall a. Show a => a -> String
show RouteContext
ctx
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
err

-- get the logged events from a deliver response,
deliverTxEvents
  :: Monad m
  => MonadFail m
  => Proxy e
  -> SynchronousResponse a b
  -> m [Event]
deliverTxEvents :: Proxy e -> SynchronousResponse a b -> m [Event]
deliverTxEvents _ SynchronousResponse{TxResponse b
deliverTxResponse :: forall c d. SynchronousResponse c d -> TxResponse d
deliverTxResponse :: TxResponse b
deliverTxResponse} =
  case TxResponse b
deliverTxResponse of
    TxResponse {[Event]
txResponseEvents :: forall a. TxResponse a -> [Event]
txResponseEvents :: [Event]
txResponseEvents} -> do
      [Event] -> m [Event]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Event]
txResponseEvents
    TxError appError :: AppError
appError -> String -> m [Event]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (AppError -> String
forall a. Show a => a -> String
show AppError
appError)

-- check for a specific check response code
ensureCheckResponseCode
  :: MonadFail m
  => Word32
  -> SynchronousResponse a b
  -> m ()
ensureCheckResponseCode :: Word32 -> SynchronousResponse a b -> m ()
ensureCheckResponseCode code :: Word32
code SynchronousResponse{TxResponse a
checkTxResponse :: forall c d. SynchronousResponse c d -> TxResponse c
checkTxResponse :: TxResponse a
checkTxResponse} =
   case TxResponse a
checkTxResponse of
     TxResponse _ _ ->
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
code Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "Couldn't match found checkTx response code 0 with expected code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
code String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "."
     TxError appError :: AppError
appError ->
       let errCode :: Word32
errCode = AppError -> Word32
appErrorCode AppError
appError
       in Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
errCode Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
code) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "Couldn't match found checkTx response code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
errCode String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
              " with expected code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
code String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "."

-- check for a specific check response code
ensureDeliverResponseCode
  :: Monad m
  => MonadFail m
  => Word32
  -> SynchronousResponse a b
  -> m ()
ensureDeliverResponseCode :: Word32 -> SynchronousResponse a b -> m ()
ensureDeliverResponseCode code :: Word32
code SynchronousResponse{TxResponse b
deliverTxResponse :: TxResponse b
deliverTxResponse :: forall c d. SynchronousResponse c d -> TxResponse d
deliverTxResponse} =
  case TxResponse b
deliverTxResponse of
    TxResponse _ _ ->
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
code Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "Couldn't match found deliverTx response code 0 with expected code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
code String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "."
    TxError appError :: AppError
appError ->
      let errCode :: Word32
errCode = AppError -> Word32
appErrorCode AppError
appError
      in Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
errCode Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
code) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
           String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "Couldn't match found deliverTx response code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
errCode String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
             " with expected code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
code String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "."

ensureResponseCodes
  :: MonadFail m
  => (Word32, Word32)
  -> SynchronousResponse a b
  -> m ()
ensureResponseCodes :: (Word32, Word32) -> SynchronousResponse a b -> m ()
ensureResponseCodes (checkCode :: Word32
checkCode, deliverCode :: Word32
deliverCode) resp :: SynchronousResponse a b
resp = do
    Word32 -> SynchronousResponse a b -> m ()
forall (m :: * -> *) a b.
MonadFail m =>
Word32 -> SynchronousResponse a b -> m ()
ensureCheckResponseCode Word32
checkCode SynchronousResponse a b
resp
    Word32 -> SynchronousResponse a b -> m ()
forall (m :: * -> *) a b.
(Monad m, MonadFail m) =>
Word32 -> SynchronousResponse a b -> m ()
ensureDeliverResponseCode Word32
deliverCode SynchronousResponse a b
resp

--------------------------------------------------------------------------------
-- | Query helpers
--------------------------------------------------------------------------------

assertQuery
  :: Monad m
  => MonadFail m
  => m (QueryClientResponse a)
  -> m (QueryResult a)
assertQuery :: m (QueryClientResponse a) -> m (QueryResult a)
assertQuery m :: m (QueryClientResponse a)
m = do
  QueryClientResponse a
resp <- m (QueryClientResponse a)
m
  case QueryClientResponse a
resp of
      QueryResponse r :: QueryResult a
r -> QueryResult a -> m (QueryResult a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryResult a
r
      QueryError err :: AppError
err  -> String -> m (QueryResult a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (QueryResult a)) -> String -> m (QueryResult a)
forall a b. (a -> b) -> a -> b
$ AppError -> String
forall a. Show a => a -> String
show AppError
err

ensureQueryResponseCode
  :: Monad m
  => MonadFail m
  => Word32
  -> QueryClientResponse a
  -> m ()
ensureQueryResponseCode :: Word32 -> QueryClientResponse a -> m ()
ensureQueryResponseCode code :: Word32
code resp :: QueryClientResponse a
resp = case QueryClientResponse a
resp of
  QueryResponse _ ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
code Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "Couldn't match found query response code 0 with expected code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
code String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "."
  QueryError AppError{Word32
appErrorCode :: Word32
appErrorCode :: AppError -> Word32
appErrorCode} ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
appErrorCode Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
code) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "Couldn't match found query response code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
appErrorCode String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
        " with expected code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
code String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "."

--------------------------------------------------------------------------------

rpcConfig :: RPC.Config
rpcConfig :: Config
rpcConfig =
  let RPC.Config baseReq :: Request
baseReq _ _ host :: ByteString
host port :: Int
port tls :: Bool
tls = ByteString -> Int -> Bool -> Config
RPC.defaultConfig "localhost" 26657 Bool
False
      prettyPrint :: forall b. ToJSON b => String -> b -> IO ()
      prettyPrint :: String -> b -> IO ()
prettyPrint prefix :: String
prefix a :: b
a = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> String) -> (b -> ByteString) -> b -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (b -> String) -> b -> String
forall a b. (a -> b) -> a -> b
$ b
a)
  in Request
-> (Request -> IO ())
-> (Response -> IO ())
-> ByteString
-> Int
-> Bool
-> Config
RPC.Config Request
baseReq (String -> Request -> IO ()
forall b. ToJSON b => String -> b -> IO ()
prettyPrint "RPC Request") (String -> Response -> IO ()
forall b. ToJSON b => String -> b -> IO ()
prettyPrint "RPC Response") ByteString
host Int
port Bool
tls