module Network.Tendermint.Client
  ( module Network.Tendermint.Client

  -- * ReExports
  , RPC.Config(..)
  , RPC.JsonRpcException(..)
  , RPC.RpcError(..)
  )
where

import           Control.Concurrent                           (forkIO,
                                                               killThread)
import           Control.Concurrent.STM.TQueue                (newTQueueIO,
                                                               writeTQueue)
import           Control.Lens                                 ((^?))
import           Control.Monad.Catch                          (throwM)
import           Control.Monad.IO.Class                       (liftIO)
import           Control.Monad.Reader                         (ReaderT, ask,
                                                               runReaderT)
import           Control.Monad.STM                            (atomically)
import           Control.Monad.Trans.Resource                 (ResourceT)
import           Data.Aeson                                   (FromJSON (..),
                                                               ToJSON (..),
                                                               genericParseJSON,
                                                               genericToJSON)
import qualified Data.Aeson                                   as Aeson
import           Data.Aeson.Casing                            (aesonDrop,
                                                               snakeCase)
import qualified Data.Aeson.Lens                              as AL
import qualified Data.ByteArray.Base64String                  as Base64
import           Data.ByteArray.HexString                     (HexString)
import           Data.ByteString                              (ByteString)
import           Data.Conduit                                 (ConduitT,
                                                               bracketP)
import           Data.Conduit.TQueue                          (sourceTQueue)
import           Data.Default.Class                           (Default (..))
import           Data.Int                                     (Int64)
import           Data.Text                                    (Text)
import           Data.Word                                    (Word32)
import           GHC.Generics                                 (Generic)
import qualified Network.ABCI.Types.Messages.FieldTypes       as FieldTypes
import qualified Network.ABCI.Types.Messages.Response         as Response
import qualified Network.HTTP.Simple                          as HTTP
import qualified Network.Tendermint.Client.Internal.RPCClient as RPC



type TendermintM = ReaderT RPC.Config IO

-- | Execute an RPC request with the given configuration.
runTendermintM :: RPC.Config -> TendermintM a -> IO a
runTendermintM :: Config -> TendermintM a -> IO a
runTendermintM = (TendermintM a -> Config -> IO a)
-> Config -> TendermintM a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip TendermintM a -> Config -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT

defaultConfig
  :: ByteString
  -- ^ Hostname or IP (e.g. "localhost", "127.0.0.1", "151.101.208.68")
  -> Int
  -- ^ Port
  -> Bool
  -- ^ TLS True/False
  -> RPC.Config
defaultConfig :: ByteString -> Int -> Bool -> Config
defaultConfig host :: ByteString
host port :: Int
port tls :: Bool
tls =
  let baseReq :: Request
baseReq =
          ByteString -> Request -> Request
HTTP.setRequestHost ByteString
host
            (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
HTTP.setRequestPort Int
port
            (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Request
HTTP.defaultRequest
  in  Request
-> (Request -> IO ())
-> (Response -> IO ())
-> ByteString
-> Int
-> Bool
-> Config
RPC.Config Request
baseReq Request -> IO ()
forall a. Monoid a => a
mempty Response -> IO ()
forall a. Monoid a => a
mempty ByteString
host Int
port Bool
tls

--------------------------------------------------------------------------------
-- ABCI Query
--------------------------------------------------------------------------------

-- | invokes [/abci_query](https://tendermint.com/rpc/#abciquery) rpc call
-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/abci.go#L56
abciQuery :: RequestABCIQuery -> TendermintM ResultABCIQuery
abciQuery :: RequestABCIQuery -> TendermintM ResultABCIQuery
abciQuery = MethodName -> RequestABCIQuery -> TendermintM ResultABCIQuery
forall (m :: * -> *) output input.
(MonadIO m, MonadReader Config m, FromJSON output, ToJSON input) =>
MethodName -> input -> m output
RPC.remote (Text -> MethodName
RPC.MethodName "abci_query")

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/abci.go#L56
data RequestABCIQuery = RequestABCIQuery
  { RequestABCIQuery -> Maybe Text
requestABCIQueryPath   :: Maybe Text
  , RequestABCIQuery -> HexString
requestABCIQueryData   :: HexString
  , RequestABCIQuery -> Maybe (WrappedVal Int64)
requestABCIQueryHeight :: Maybe (FieldTypes.WrappedVal Int64)
  , RequestABCIQuery -> Bool
requestABCIQueryProve  :: Bool
  } deriving (RequestABCIQuery -> RequestABCIQuery -> Bool
(RequestABCIQuery -> RequestABCIQuery -> Bool)
-> (RequestABCIQuery -> RequestABCIQuery -> Bool)
-> Eq RequestABCIQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestABCIQuery -> RequestABCIQuery -> Bool
$c/= :: RequestABCIQuery -> RequestABCIQuery -> Bool
== :: RequestABCIQuery -> RequestABCIQuery -> Bool
$c== :: RequestABCIQuery -> RequestABCIQuery -> Bool
Eq, Int -> RequestABCIQuery -> ShowS
[RequestABCIQuery] -> ShowS
RequestABCIQuery -> String
(Int -> RequestABCIQuery -> ShowS)
-> (RequestABCIQuery -> String)
-> ([RequestABCIQuery] -> ShowS)
-> Show RequestABCIQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestABCIQuery] -> ShowS
$cshowList :: [RequestABCIQuery] -> ShowS
show :: RequestABCIQuery -> String
$cshow :: RequestABCIQuery -> String
showsPrec :: Int -> RequestABCIQuery -> ShowS
$cshowsPrec :: Int -> RequestABCIQuery -> ShowS
Show, (forall x. RequestABCIQuery -> Rep RequestABCIQuery x)
-> (forall x. Rep RequestABCIQuery x -> RequestABCIQuery)
-> Generic RequestABCIQuery
forall x. Rep RequestABCIQuery x -> RequestABCIQuery
forall x. RequestABCIQuery -> Rep RequestABCIQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestABCIQuery x -> RequestABCIQuery
$cfrom :: forall x. RequestABCIQuery -> Rep RequestABCIQuery x
Generic)
instance ToJSON RequestABCIQuery where
  toJSON :: RequestABCIQuery -> Value
toJSON = Options -> RequestABCIQuery -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> RequestABCIQuery -> Value)
-> Options -> RequestABCIQuery -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "requestABCIQuery"

instance Default RequestABCIQuery where
  def :: RequestABCIQuery
def = RequestABCIQuery :: Maybe Text
-> HexString
-> Maybe (WrappedVal Int64)
-> Bool
-> RequestABCIQuery
RequestABCIQuery { requestABCIQueryPath :: Maybe Text
requestABCIQueryPath   = Maybe Text
forall a. Maybe a
Nothing
                         , requestABCIQueryData :: HexString
requestABCIQueryData   = ""
                         , requestABCIQueryHeight :: Maybe (WrappedVal Int64)
requestABCIQueryHeight = Maybe (WrappedVal Int64)
forall a. Maybe a
Nothing
                         , requestABCIQueryProve :: Bool
requestABCIQueryProve  = Bool
False
                         }

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/types/responses.go#L193
data ResultABCIQuery = ResultABCIQuery
  { ResultABCIQuery -> Query
resultABCIQueryResponse :: Response.Query
  } deriving (ResultABCIQuery -> ResultABCIQuery -> Bool
(ResultABCIQuery -> ResultABCIQuery -> Bool)
-> (ResultABCIQuery -> ResultABCIQuery -> Bool)
-> Eq ResultABCIQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultABCIQuery -> ResultABCIQuery -> Bool
$c/= :: ResultABCIQuery -> ResultABCIQuery -> Bool
== :: ResultABCIQuery -> ResultABCIQuery -> Bool
$c== :: ResultABCIQuery -> ResultABCIQuery -> Bool
Eq, Int -> ResultABCIQuery -> ShowS
[ResultABCIQuery] -> ShowS
ResultABCIQuery -> String
(Int -> ResultABCIQuery -> ShowS)
-> (ResultABCIQuery -> String)
-> ([ResultABCIQuery] -> ShowS)
-> Show ResultABCIQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultABCIQuery] -> ShowS
$cshowList :: [ResultABCIQuery] -> ShowS
show :: ResultABCIQuery -> String
$cshow :: ResultABCIQuery -> String
showsPrec :: Int -> ResultABCIQuery -> ShowS
$cshowsPrec :: Int -> ResultABCIQuery -> ShowS
Show, (forall x. ResultABCIQuery -> Rep ResultABCIQuery x)
-> (forall x. Rep ResultABCIQuery x -> ResultABCIQuery)
-> Generic ResultABCIQuery
forall x. Rep ResultABCIQuery x -> ResultABCIQuery
forall x. ResultABCIQuery -> Rep ResultABCIQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResultABCIQuery x -> ResultABCIQuery
$cfrom :: forall x. ResultABCIQuery -> Rep ResultABCIQuery x
Generic)
instance FromJSON ResultABCIQuery where
  parseJSON :: Value -> Parser ResultABCIQuery
parseJSON = Options -> Value -> Parser ResultABCIQuery
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ResultABCIQuery)
-> Options -> Value -> Parser ResultABCIQuery
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "resultABCIQuery"

--------------------------------------------------------------------------------
-- Block
--------------------------------------------------------------------------------

-- | invokes [/block](https://tendermint.com/rpc/#block) rpc call
-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/blocks.go#L72
block :: RequestBlock -> TendermintM ResultBlock
block :: RequestBlock -> TendermintM ResultBlock
block = MethodName -> RequestBlock -> TendermintM ResultBlock
forall (m :: * -> *) output input.
(MonadIO m, MonadReader Config m, FromJSON output, ToJSON input) =>
MethodName -> input -> m output
RPC.remote (Text -> MethodName
RPC.MethodName "block")

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/blocks.go#L72
data RequestBlock = RequestBlock
  { RequestBlock -> Maybe (WrappedVal Int64)
requestBlockHeightPtr :: Maybe (FieldTypes.WrappedVal Int64)
  } deriving (RequestBlock -> RequestBlock -> Bool
(RequestBlock -> RequestBlock -> Bool)
-> (RequestBlock -> RequestBlock -> Bool) -> Eq RequestBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestBlock -> RequestBlock -> Bool
$c/= :: RequestBlock -> RequestBlock -> Bool
== :: RequestBlock -> RequestBlock -> Bool
$c== :: RequestBlock -> RequestBlock -> Bool
Eq, Int -> RequestBlock -> ShowS
[RequestBlock] -> ShowS
RequestBlock -> String
(Int -> RequestBlock -> ShowS)
-> (RequestBlock -> String)
-> ([RequestBlock] -> ShowS)
-> Show RequestBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestBlock] -> ShowS
$cshowList :: [RequestBlock] -> ShowS
show :: RequestBlock -> String
$cshow :: RequestBlock -> String
showsPrec :: Int -> RequestBlock -> ShowS
$cshowsPrec :: Int -> RequestBlock -> ShowS
Show, (forall x. RequestBlock -> Rep RequestBlock x)
-> (forall x. Rep RequestBlock x -> RequestBlock)
-> Generic RequestBlock
forall x. Rep RequestBlock x -> RequestBlock
forall x. RequestBlock -> Rep RequestBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestBlock x -> RequestBlock
$cfrom :: forall x. RequestBlock -> Rep RequestBlock x
Generic)
instance ToJSON RequestBlock where
  toJSON :: RequestBlock -> Value
toJSON = Options -> RequestBlock -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> RequestBlock -> Value)
-> Options -> RequestBlock -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "requestBlock"

instance Default RequestBlock where
  def :: RequestBlock
def = RequestBlock :: Maybe (WrappedVal Int64) -> RequestBlock
RequestBlock { requestBlockHeightPtr :: Maybe (WrappedVal Int64)
requestBlockHeightPtr = Maybe (WrappedVal Int64)
forall a. Maybe a
Nothing }

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/types/responses.go#L28
data ResultBlock = ResultBlock
  { ResultBlock -> BlockMeta
resultBlockBlockMeta :: BlockMeta
  , ResultBlock -> Block
resultBlockBlock     :: Block
  } deriving (ResultBlock -> ResultBlock -> Bool
(ResultBlock -> ResultBlock -> Bool)
-> (ResultBlock -> ResultBlock -> Bool) -> Eq ResultBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultBlock -> ResultBlock -> Bool
$c/= :: ResultBlock -> ResultBlock -> Bool
== :: ResultBlock -> ResultBlock -> Bool
$c== :: ResultBlock -> ResultBlock -> Bool
Eq, Int -> ResultBlock -> ShowS
[ResultBlock] -> ShowS
ResultBlock -> String
(Int -> ResultBlock -> ShowS)
-> (ResultBlock -> String)
-> ([ResultBlock] -> ShowS)
-> Show ResultBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultBlock] -> ShowS
$cshowList :: [ResultBlock] -> ShowS
show :: ResultBlock -> String
$cshow :: ResultBlock -> String
showsPrec :: Int -> ResultBlock -> ShowS
$cshowsPrec :: Int -> ResultBlock -> ShowS
Show, (forall x. ResultBlock -> Rep ResultBlock x)
-> (forall x. Rep ResultBlock x -> ResultBlock)
-> Generic ResultBlock
forall x. Rep ResultBlock x -> ResultBlock
forall x. ResultBlock -> Rep ResultBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResultBlock x -> ResultBlock
$cfrom :: forall x. ResultBlock -> Rep ResultBlock x
Generic)
instance FromJSON ResultBlock where
  parseJSON :: Value -> Parser ResultBlock
parseJSON = Options -> Value -> Parser ResultBlock
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ResultBlock)
-> Options -> Value -> Parser ResultBlock
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "resultBlock"


--------------------------------------------------------------------------------
-- Tx
--------------------------------------------------------------------------------

-- | invokes [/tx](https://tendermint.com/rpc/#tx) rpc call
-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/tx.go#L81
tx :: RequestTx -> TendermintM ResultTx
tx :: RequestTx -> TendermintM ResultTx
tx = MethodName -> RequestTx -> TendermintM ResultTx
forall (m :: * -> *) output input.
(MonadIO m, MonadReader Config m, FromJSON output, ToJSON input) =>
MethodName -> input -> m output
RPC.remote (Text -> MethodName
RPC.MethodName "tx")

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/tx.go#L81
data RequestTx = RequestTx
  { RequestTx -> Maybe Tx
requestTxHash  :: Maybe Tx
  , RequestTx -> Bool
requestTxProve :: Bool
  } deriving (RequestTx -> RequestTx -> Bool
(RequestTx -> RequestTx -> Bool)
-> (RequestTx -> RequestTx -> Bool) -> Eq RequestTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestTx -> RequestTx -> Bool
$c/= :: RequestTx -> RequestTx -> Bool
== :: RequestTx -> RequestTx -> Bool
$c== :: RequestTx -> RequestTx -> Bool
Eq, Int -> RequestTx -> ShowS
[RequestTx] -> ShowS
RequestTx -> String
(Int -> RequestTx -> ShowS)
-> (RequestTx -> String)
-> ([RequestTx] -> ShowS)
-> Show RequestTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestTx] -> ShowS
$cshowList :: [RequestTx] -> ShowS
show :: RequestTx -> String
$cshow :: RequestTx -> String
showsPrec :: Int -> RequestTx -> ShowS
$cshowsPrec :: Int -> RequestTx -> ShowS
Show, (forall x. RequestTx -> Rep RequestTx x)
-> (forall x. Rep RequestTx x -> RequestTx) -> Generic RequestTx
forall x. Rep RequestTx x -> RequestTx
forall x. RequestTx -> Rep RequestTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestTx x -> RequestTx
$cfrom :: forall x. RequestTx -> Rep RequestTx x
Generic)
instance ToJSON RequestTx where
  toJSON :: RequestTx -> Value
toJSON = Options -> RequestTx -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> RequestTx -> Value) -> Options -> RequestTx -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "requestTx"

instance Default RequestTx where
  def :: RequestTx
def = RequestTx :: Maybe Tx -> Bool -> RequestTx
RequestTx { requestTxHash :: Maybe Tx
requestTxHash = Maybe Tx
forall a. Maybe a
Nothing, requestTxProve :: Bool
requestTxProve = Bool
False }

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/types/responses.go#L164
data ResultTx = ResultTx
  { ResultTx -> HexString
resultTxHash     :: HexString
  , ResultTx -> WrappedVal Int64
resultTxHeight   :: FieldTypes.WrappedVal Int64
  , ResultTx -> Word32
resultTxIndex    :: Word32
  , ResultTx -> DeliverTx
resultTxTxResult :: Response.DeliverTx
  , ResultTx -> Tx
resultTxTx       :: Tx
  , ResultTx -> Maybe TxProof
resultTxProof    :: Maybe TxProof
  } deriving (ResultTx -> ResultTx -> Bool
(ResultTx -> ResultTx -> Bool)
-> (ResultTx -> ResultTx -> Bool) -> Eq ResultTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultTx -> ResultTx -> Bool
$c/= :: ResultTx -> ResultTx -> Bool
== :: ResultTx -> ResultTx -> Bool
$c== :: ResultTx -> ResultTx -> Bool
Eq, Int -> ResultTx -> ShowS
[ResultTx] -> ShowS
ResultTx -> String
(Int -> ResultTx -> ShowS)
-> (ResultTx -> String) -> ([ResultTx] -> ShowS) -> Show ResultTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultTx] -> ShowS
$cshowList :: [ResultTx] -> ShowS
show :: ResultTx -> String
$cshow :: ResultTx -> String
showsPrec :: Int -> ResultTx -> ShowS
$cshowsPrec :: Int -> ResultTx -> ShowS
Show, (forall x. ResultTx -> Rep ResultTx x)
-> (forall x. Rep ResultTx x -> ResultTx) -> Generic ResultTx
forall x. Rep ResultTx x -> ResultTx
forall x. ResultTx -> Rep ResultTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResultTx x -> ResultTx
$cfrom :: forall x. ResultTx -> Rep ResultTx x
Generic)

instance FromJSON ResultTx where
  parseJSON :: Value -> Parser ResultTx
parseJSON = Options -> Value -> Parser ResultTx
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ResultTx)
-> Options -> Value -> Parser ResultTx
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "resultTx"

--------------------------------------------------------------------------------
-- BroadcastTxAsync
--------------------------------------------------------------------------------

-- | invokes [/broadcast_tx_async](https://tendermint.com/rpc/#broadcasttxasync) rpc call
-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/mempool.go#L75
broadcastTxAsync :: RequestBroadcastTxAsync -> TendermintM ResultBroadcastTx
broadcastTxAsync :: RequestBroadcastTxAsync -> TendermintM ResultBroadcastTx
broadcastTxAsync = MethodName
-> RequestBroadcastTxAsync -> TendermintM ResultBroadcastTx
forall (m :: * -> *) output input.
(MonadIO m, MonadReader Config m, FromJSON output, ToJSON input) =>
MethodName -> input -> m output
RPC.remote (Text -> MethodName
RPC.MethodName "broadcast_tx_async")

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/mempool.go#L75
data RequestBroadcastTxAsync = RequestBroadcastTxAsync
  { RequestBroadcastTxAsync -> Tx
requestBroadcastTxAsyncTx :: Tx
  } deriving (RequestBroadcastTxAsync -> RequestBroadcastTxAsync -> Bool
(RequestBroadcastTxAsync -> RequestBroadcastTxAsync -> Bool)
-> (RequestBroadcastTxAsync -> RequestBroadcastTxAsync -> Bool)
-> Eq RequestBroadcastTxAsync
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestBroadcastTxAsync -> RequestBroadcastTxAsync -> Bool
$c/= :: RequestBroadcastTxAsync -> RequestBroadcastTxAsync -> Bool
== :: RequestBroadcastTxAsync -> RequestBroadcastTxAsync -> Bool
$c== :: RequestBroadcastTxAsync -> RequestBroadcastTxAsync -> Bool
Eq, Int -> RequestBroadcastTxAsync -> ShowS
[RequestBroadcastTxAsync] -> ShowS
RequestBroadcastTxAsync -> String
(Int -> RequestBroadcastTxAsync -> ShowS)
-> (RequestBroadcastTxAsync -> String)
-> ([RequestBroadcastTxAsync] -> ShowS)
-> Show RequestBroadcastTxAsync
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestBroadcastTxAsync] -> ShowS
$cshowList :: [RequestBroadcastTxAsync] -> ShowS
show :: RequestBroadcastTxAsync -> String
$cshow :: RequestBroadcastTxAsync -> String
showsPrec :: Int -> RequestBroadcastTxAsync -> ShowS
$cshowsPrec :: Int -> RequestBroadcastTxAsync -> ShowS
Show, (forall x.
 RequestBroadcastTxAsync -> Rep RequestBroadcastTxAsync x)
-> (forall x.
    Rep RequestBroadcastTxAsync x -> RequestBroadcastTxAsync)
-> Generic RequestBroadcastTxAsync
forall x. Rep RequestBroadcastTxAsync x -> RequestBroadcastTxAsync
forall x. RequestBroadcastTxAsync -> Rep RequestBroadcastTxAsync x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestBroadcastTxAsync x -> RequestBroadcastTxAsync
$cfrom :: forall x. RequestBroadcastTxAsync -> Rep RequestBroadcastTxAsync x
Generic)
instance ToJSON RequestBroadcastTxAsync where
  toJSON :: RequestBroadcastTxAsync -> Value
toJSON = Options -> RequestBroadcastTxAsync -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> RequestBroadcastTxAsync -> Value)
-> Options -> RequestBroadcastTxAsync -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "requestBroadcastTxAsync"

--------------------------------------------------------------------------------
-- BroadcastTxSync
--------------------------------------------------------------------------------

-- | invokes [/broadcast_tx_sync](https://tendermint.com/rpc/#broadcasttxsync) rpc call
-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/mempool.go#L136
broadcastTxSync :: RequestBroadcastTxSync -> TendermintM ResultBroadcastTx
broadcastTxSync :: RequestBroadcastTxSync -> TendermintM ResultBroadcastTx
broadcastTxSync = MethodName
-> RequestBroadcastTxSync -> TendermintM ResultBroadcastTx
forall (m :: * -> *) output input.
(MonadIO m, MonadReader Config m, FromJSON output, ToJSON input) =>
MethodName -> input -> m output
RPC.remote (Text -> MethodName
RPC.MethodName "broadcast_tx_sync")

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/mempool.go#L136
data RequestBroadcastTxSync = RequestBroadcastTxSync
  { RequestBroadcastTxSync -> Tx
requestBroadcastTxSyncTx :: Tx
  } deriving (RequestBroadcastTxSync -> RequestBroadcastTxSync -> Bool
(RequestBroadcastTxSync -> RequestBroadcastTxSync -> Bool)
-> (RequestBroadcastTxSync -> RequestBroadcastTxSync -> Bool)
-> Eq RequestBroadcastTxSync
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestBroadcastTxSync -> RequestBroadcastTxSync -> Bool
$c/= :: RequestBroadcastTxSync -> RequestBroadcastTxSync -> Bool
== :: RequestBroadcastTxSync -> RequestBroadcastTxSync -> Bool
$c== :: RequestBroadcastTxSync -> RequestBroadcastTxSync -> Bool
Eq, Int -> RequestBroadcastTxSync -> ShowS
[RequestBroadcastTxSync] -> ShowS
RequestBroadcastTxSync -> String
(Int -> RequestBroadcastTxSync -> ShowS)
-> (RequestBroadcastTxSync -> String)
-> ([RequestBroadcastTxSync] -> ShowS)
-> Show RequestBroadcastTxSync
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestBroadcastTxSync] -> ShowS
$cshowList :: [RequestBroadcastTxSync] -> ShowS
show :: RequestBroadcastTxSync -> String
$cshow :: RequestBroadcastTxSync -> String
showsPrec :: Int -> RequestBroadcastTxSync -> ShowS
$cshowsPrec :: Int -> RequestBroadcastTxSync -> ShowS
Show, (forall x. RequestBroadcastTxSync -> Rep RequestBroadcastTxSync x)
-> (forall x.
    Rep RequestBroadcastTxSync x -> RequestBroadcastTxSync)
-> Generic RequestBroadcastTxSync
forall x. Rep RequestBroadcastTxSync x -> RequestBroadcastTxSync
forall x. RequestBroadcastTxSync -> Rep RequestBroadcastTxSync x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestBroadcastTxSync x -> RequestBroadcastTxSync
$cfrom :: forall x. RequestBroadcastTxSync -> Rep RequestBroadcastTxSync x
Generic)
instance ToJSON RequestBroadcastTxSync where
  toJSON :: RequestBroadcastTxSync -> Value
toJSON = Options -> RequestBroadcastTxSync -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> RequestBroadcastTxSync -> Value)
-> Options -> RequestBroadcastTxSync -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "requestBroadcastTxSync"

--------------------------------------------------------------------------------
-- BroadcastTxCommit
--------------------------------------------------------------------------------

-- | invokes [/broadcast_tx_commit](https://tendermint.com/rpc/#broadcasttxcommit) rpc call
-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/mempool.go#L215
broadcastTxCommit
  :: RequestBroadcastTxCommit -> TendermintM ResultBroadcastTxCommit
broadcastTxCommit :: RequestBroadcastTxCommit -> TendermintM ResultBroadcastTxCommit
broadcastTxCommit = MethodName
-> RequestBroadcastTxCommit -> TendermintM ResultBroadcastTxCommit
forall (m :: * -> *) output input.
(MonadIO m, MonadReader Config m, FromJSON output, ToJSON input) =>
MethodName -> input -> m output
RPC.remote (Text -> MethodName
RPC.MethodName "broadcast_tx_commit")

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/mempool.go#L215
data RequestBroadcastTxCommit = RequestBroadcastTxCommit
  { RequestBroadcastTxCommit -> Tx
requestBroadcastTxCommitTx :: Tx
  } deriving (RequestBroadcastTxCommit -> RequestBroadcastTxCommit -> Bool
(RequestBroadcastTxCommit -> RequestBroadcastTxCommit -> Bool)
-> (RequestBroadcastTxCommit -> RequestBroadcastTxCommit -> Bool)
-> Eq RequestBroadcastTxCommit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestBroadcastTxCommit -> RequestBroadcastTxCommit -> Bool
$c/= :: RequestBroadcastTxCommit -> RequestBroadcastTxCommit -> Bool
== :: RequestBroadcastTxCommit -> RequestBroadcastTxCommit -> Bool
$c== :: RequestBroadcastTxCommit -> RequestBroadcastTxCommit -> Bool
Eq, Int -> RequestBroadcastTxCommit -> ShowS
[RequestBroadcastTxCommit] -> ShowS
RequestBroadcastTxCommit -> String
(Int -> RequestBroadcastTxCommit -> ShowS)
-> (RequestBroadcastTxCommit -> String)
-> ([RequestBroadcastTxCommit] -> ShowS)
-> Show RequestBroadcastTxCommit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestBroadcastTxCommit] -> ShowS
$cshowList :: [RequestBroadcastTxCommit] -> ShowS
show :: RequestBroadcastTxCommit -> String
$cshow :: RequestBroadcastTxCommit -> String
showsPrec :: Int -> RequestBroadcastTxCommit -> ShowS
$cshowsPrec :: Int -> RequestBroadcastTxCommit -> ShowS
Show, (forall x.
 RequestBroadcastTxCommit -> Rep RequestBroadcastTxCommit x)
-> (forall x.
    Rep RequestBroadcastTxCommit x -> RequestBroadcastTxCommit)
-> Generic RequestBroadcastTxCommit
forall x.
Rep RequestBroadcastTxCommit x -> RequestBroadcastTxCommit
forall x.
RequestBroadcastTxCommit -> Rep RequestBroadcastTxCommit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RequestBroadcastTxCommit x -> RequestBroadcastTxCommit
$cfrom :: forall x.
RequestBroadcastTxCommit -> Rep RequestBroadcastTxCommit x
Generic)
instance ToJSON RequestBroadcastTxCommit where
  toJSON :: RequestBroadcastTxCommit -> Value
toJSON = Options -> RequestBroadcastTxCommit -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> RequestBroadcastTxCommit -> Value)
-> Options -> RequestBroadcastTxCommit -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "requestBroadcastTxCommit"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/types/responses.go#L156
data ResultBroadcastTxCommit = ResultBroadcastTxCommit
  { ResultBroadcastTxCommit -> CheckTx
resultBroadcastTxCommitCheckTx   :: Response.CheckTx
  , ResultBroadcastTxCommit -> DeliverTx
resultBroadcastTxCommitDeliverTx :: Response.DeliverTx
  , ResultBroadcastTxCommit -> HexString
resultBroadcastTxCommitHash      :: HexString
  , ResultBroadcastTxCommit -> WrappedVal Int64
resultBroadcastTxCommitHeight    :: FieldTypes.WrappedVal Int64
  } deriving (ResultBroadcastTxCommit -> ResultBroadcastTxCommit -> Bool
(ResultBroadcastTxCommit -> ResultBroadcastTxCommit -> Bool)
-> (ResultBroadcastTxCommit -> ResultBroadcastTxCommit -> Bool)
-> Eq ResultBroadcastTxCommit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultBroadcastTxCommit -> ResultBroadcastTxCommit -> Bool
$c/= :: ResultBroadcastTxCommit -> ResultBroadcastTxCommit -> Bool
== :: ResultBroadcastTxCommit -> ResultBroadcastTxCommit -> Bool
$c== :: ResultBroadcastTxCommit -> ResultBroadcastTxCommit -> Bool
Eq, Int -> ResultBroadcastTxCommit -> ShowS
[ResultBroadcastTxCommit] -> ShowS
ResultBroadcastTxCommit -> String
(Int -> ResultBroadcastTxCommit -> ShowS)
-> (ResultBroadcastTxCommit -> String)
-> ([ResultBroadcastTxCommit] -> ShowS)
-> Show ResultBroadcastTxCommit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultBroadcastTxCommit] -> ShowS
$cshowList :: [ResultBroadcastTxCommit] -> ShowS
show :: ResultBroadcastTxCommit -> String
$cshow :: ResultBroadcastTxCommit -> String
showsPrec :: Int -> ResultBroadcastTxCommit -> ShowS
$cshowsPrec :: Int -> ResultBroadcastTxCommit -> ShowS
Show, (forall x.
 ResultBroadcastTxCommit -> Rep ResultBroadcastTxCommit x)
-> (forall x.
    Rep ResultBroadcastTxCommit x -> ResultBroadcastTxCommit)
-> Generic ResultBroadcastTxCommit
forall x. Rep ResultBroadcastTxCommit x -> ResultBroadcastTxCommit
forall x. ResultBroadcastTxCommit -> Rep ResultBroadcastTxCommit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResultBroadcastTxCommit x -> ResultBroadcastTxCommit
$cfrom :: forall x. ResultBroadcastTxCommit -> Rep ResultBroadcastTxCommit x
Generic)
instance FromJSON ResultBroadcastTxCommit where
  parseJSON :: Value -> Parser ResultBroadcastTxCommit
parseJSON = Options -> Value -> Parser ResultBroadcastTxCommit
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ResultBroadcastTxCommit)
-> Options -> Value -> Parser ResultBroadcastTxCommit
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "resultBroadcastTxCommit"


--------------------------------------------------------------------------------
-- Health
--------------------------------------------------------------------------------

-- | invokes [/health](https://tendermint.com/rpc/#health) rpc call
-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/health.go#L35
health :: TendermintM ResultHealth
health :: TendermintM ResultHealth
health = MethodName -> () -> TendermintM ResultHealth
forall (m :: * -> *) output input.
(MonadIO m, MonadReader Config m, FromJSON output, ToJSON input) =>
MethodName -> input -> m output
RPC.remote (Text -> MethodName
RPC.MethodName "health") ()

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/types/responses.go#L208
data ResultHealth = ResultHealth deriving (ResultHealth -> ResultHealth -> Bool
(ResultHealth -> ResultHealth -> Bool)
-> (ResultHealth -> ResultHealth -> Bool) -> Eq ResultHealth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultHealth -> ResultHealth -> Bool
$c/= :: ResultHealth -> ResultHealth -> Bool
== :: ResultHealth -> ResultHealth -> Bool
$c== :: ResultHealth -> ResultHealth -> Bool
Eq, Int -> ResultHealth -> ShowS
[ResultHealth] -> ShowS
ResultHealth -> String
(Int -> ResultHealth -> ShowS)
-> (ResultHealth -> String)
-> ([ResultHealth] -> ShowS)
-> Show ResultHealth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultHealth] -> ShowS
$cshowList :: [ResultHealth] -> ShowS
show :: ResultHealth -> String
$cshow :: ResultHealth -> String
showsPrec :: Int -> ResultHealth -> ShowS
$cshowsPrec :: Int -> ResultHealth -> ShowS
Show)

instance FromJSON ResultHealth where
  parseJSON :: Value -> Parser ResultHealth
parseJSON = String
-> (Object -> Parser ResultHealth) -> Value -> Parser ResultHealth
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject "Expected emptyObject" ((Object -> Parser ResultHealth) -> Value -> Parser ResultHealth)
-> (Object -> Parser ResultHealth) -> Value -> Parser ResultHealth
forall a b. (a -> b) -> a -> b
$ \_ -> ResultHealth -> Parser ResultHealth
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultHealth
ResultHealth

--------------------------------------------------------------------------------
-- ABCIInfo
--------------------------------------------------------------------------------

-- | invokes [/abci_info](https://tendermint.com/rpc/#abciinfo) rpc call
-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/abci.go#L100
abciInfo :: TendermintM ResultABCIInfo
abciInfo :: TendermintM ResultABCIInfo
abciInfo = MethodName -> () -> TendermintM ResultABCIInfo
forall (m :: * -> *) output input.
(MonadIO m, MonadReader Config m, FromJSON output, ToJSON input) =>
MethodName -> input -> m output
RPC.remote (Text -> MethodName
RPC.MethodName "abci_info") ()

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/types/responses.go#L188
data ResultABCIInfo = ResultABCIInfo
  { ResultABCIInfo -> Info
resultABCIInfoResponse :: Response.Info
  } deriving (ResultABCIInfo -> ResultABCIInfo -> Bool
(ResultABCIInfo -> ResultABCIInfo -> Bool)
-> (ResultABCIInfo -> ResultABCIInfo -> Bool) -> Eq ResultABCIInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultABCIInfo -> ResultABCIInfo -> Bool
$c/= :: ResultABCIInfo -> ResultABCIInfo -> Bool
== :: ResultABCIInfo -> ResultABCIInfo -> Bool
$c== :: ResultABCIInfo -> ResultABCIInfo -> Bool
Eq, Int -> ResultABCIInfo -> ShowS
[ResultABCIInfo] -> ShowS
ResultABCIInfo -> String
(Int -> ResultABCIInfo -> ShowS)
-> (ResultABCIInfo -> String)
-> ([ResultABCIInfo] -> ShowS)
-> Show ResultABCIInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultABCIInfo] -> ShowS
$cshowList :: [ResultABCIInfo] -> ShowS
show :: ResultABCIInfo -> String
$cshow :: ResultABCIInfo -> String
showsPrec :: Int -> ResultABCIInfo -> ShowS
$cshowsPrec :: Int -> ResultABCIInfo -> ShowS
Show, (forall x. ResultABCIInfo -> Rep ResultABCIInfo x)
-> (forall x. Rep ResultABCIInfo x -> ResultABCIInfo)
-> Generic ResultABCIInfo
forall x. Rep ResultABCIInfo x -> ResultABCIInfo
forall x. ResultABCIInfo -> Rep ResultABCIInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResultABCIInfo x -> ResultABCIInfo
$cfrom :: forall x. ResultABCIInfo -> Rep ResultABCIInfo x
Generic)
instance FromJSON ResultABCIInfo where
  parseJSON :: Value -> Parser ResultABCIInfo
parseJSON = Options -> Value -> Parser ResultABCIInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ResultABCIInfo)
-> Options -> Value -> Parser ResultABCIInfo
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "resultABCIInfo"

--------------------------------------------------------------------------------
-- Subscribe
--------------------------------------------------------------------------------

data TxResultEvent a = TxEvent
  { TxResultEvent a -> WrappedVal Int64
txEventBlockHeight :: FieldTypes.WrappedVal Int64
  , TxResultEvent a -> Int64
txEventTxIndex     :: Int64
  , TxResultEvent a -> a
txEventEvents      :: a
  } deriving ((forall x. TxResultEvent a -> Rep (TxResultEvent a) x)
-> (forall x. Rep (TxResultEvent a) x -> TxResultEvent a)
-> Generic (TxResultEvent a)
forall x. Rep (TxResultEvent a) x -> TxResultEvent a
forall x. TxResultEvent a -> Rep (TxResultEvent a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TxResultEvent a) x -> TxResultEvent a
forall a x. TxResultEvent a -> Rep (TxResultEvent a) x
$cto :: forall a x. Rep (TxResultEvent a) x -> TxResultEvent a
$cfrom :: forall a x. TxResultEvent a -> Rep (TxResultEvent a) x
Generic)

instance FromJSON (TxResultEvent [FieldTypes.Event]) where
  parseJSON :: Value -> Parser (TxResultEvent [Event])
parseJSON val :: Value
val = do
    let mtxRes :: Maybe Object
mtxRes = Value
val Value -> Getting (First Object) Value Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
AL.key "result"
                      ((Value -> Const (First Object) Value)
 -> Value -> Const (First Object) Value)
-> Getting (First Object) Value Object
-> Getting (First Object) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
AL.key "data"
                      ((Value -> Const (First Object) Value)
 -> Value -> Const (First Object) Value)
-> Getting (First Object) Value Object
-> Getting (First Object) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
AL.key "value"
                      ((Value -> Const (First Object) Value)
 -> Value -> Const (First Object) Value)
-> Getting (First Object) Value Object
-> Getting (First Object) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
AL.key "TxResult"
                      ((Value -> Const (First Object) Value)
 -> Value -> Const (First Object) Value)
-> Getting (First Object) Value Object
-> Getting (First Object) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Object) Value Object
forall t. AsValue t => Prism' t Object
AL._Object
    Object
txRes <- Parser Object
-> (Object -> Parser Object) -> Maybe Object -> Parser Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Object
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "key not found: result.data.value.TxResult") Object -> Parser Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Object
mtxRes
    WrappedVal Int64
height <- Object
txRes Object -> Text -> Parser (WrappedVal Int64)
forall a. FromJSON a => Object -> Text -> Parser a
Aeson..: "height"
    Int64
idx <- Object
txRes Object -> Text -> Parser Int64
forall a. FromJSON a => Object -> Text -> Parser a
Aeson..: "index"
    Object
res' <- Object
txRes Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
Aeson..: "result"
    [Event]
es <- Object
res' Object -> Text -> Parser [Event]
forall a. FromJSON a => Object -> Text -> Parser a
Aeson..: "events"
    TxResultEvent [Event] -> Parser (TxResultEvent [Event])
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxEvent :: forall a. WrappedVal Int64 -> Int64 -> a -> TxResultEvent a
TxEvent
      { txEventBlockHeight :: WrappedVal Int64
txEventBlockHeight = WrappedVal Int64
height
      , txEventTxIndex :: Int64
txEventTxIndex = Int64
idx
      , txEventEvents :: [Event]
txEventEvents = [Event]
es
      }

-- | invokes [/subscribe](https://tendermint.com/rpc/#subscribe) rpc call
-- https://github.com/tendermint/tendermint/blob/master/rpc/core/events.go#L17
subscribe
  :: RequestSubscribe
  -> ConduitT () (TxResultEvent [FieldTypes.Event]) (ResourceT TendermintM) ()
subscribe :: RequestSubscribe
-> ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) ()
subscribe req :: RequestSubscribe
req = do
  TQueue (TxResultEvent [Event])
queue <- IO (TQueue (TxResultEvent [Event]))
-> ConduitT
     ()
     (TxResultEvent [Event])
     (ResourceT TendermintM)
     (TQueue (TxResultEvent [Event]))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TQueue (TxResultEvent [Event]))
forall a. IO (TQueue a)
newTQueueIO
  let handler :: Value -> IO ()
handler (Value
val :: Aeson.Value) =
        let isEmptyResult :: Bool
isEmptyResult = Value
val Value -> Getting (First Value) Value Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
AL.key "result" Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Object -> Value
Aeson.Object Object
forall a. Monoid a => a
mempty)
        in if Bool
isEmptyResult
             then () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
             else case ByteString -> Either String (TxResultEvent [Event])
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (ByteString -> Either String (TxResultEvent [Event]))
-> (Value -> ByteString)
-> Value
-> Either String (TxResultEvent [Event])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Value -> Either String (TxResultEvent [Event]))
-> Value -> Either String (TxResultEvent [Event])
forall a b. (a -> b) -> a -> b
$ Value
val of
               Left err :: String
err -> JsonRpcException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> JsonRpcException
RPC.ParsingException String
err)
               Right a :: TxResultEvent [Event]
a  -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue (TxResultEvent [Event]) -> TxResultEvent [Event] -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (TxResultEvent [Event])
queue TxResultEvent [Event]
a
  Config
cfg <- ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) Config
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO ThreadId
-> (ThreadId -> IO ())
-> (ThreadId
    -> ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) ())
-> ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) ()
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
    (IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Config
-> MethodName -> RequestSubscribe -> (Value -> IO ()) -> IO ()
forall output input.
(FromJSON output, ToJSON input) =>
Config -> MethodName -> input -> (output -> IO ()) -> IO ()
RPC.remoteWS Config
cfg (Text -> MethodName
RPC.MethodName "subscribe") RequestSubscribe
req Value -> IO ()
handler)
    ThreadId -> IO ()
killThread
    (ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) ()
-> ThreadId
-> ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) ()
forall a b. a -> b -> a
const (ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) ()
 -> ThreadId
 -> ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) ())
-> ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) ()
-> ThreadId
-> ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) ()
forall a b. (a -> b) -> a -> b
$ TQueue (TxResultEvent [Event])
-> ConduitT () (TxResultEvent [Event]) (ResourceT TendermintM) ()
forall (m :: * -> *) a z.
MonadIO m =>
TQueue a -> ConduitT z a m ()
sourceTQueue TQueue (TxResultEvent [Event])
queue)

newtype RequestSubscribe = RequestSubscribe
  { RequestSubscribe -> Text
requestSubscribeQuery   :: Text
  } deriving (RequestSubscribe -> RequestSubscribe -> Bool
(RequestSubscribe -> RequestSubscribe -> Bool)
-> (RequestSubscribe -> RequestSubscribe -> Bool)
-> Eq RequestSubscribe
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestSubscribe -> RequestSubscribe -> Bool
$c/= :: RequestSubscribe -> RequestSubscribe -> Bool
== :: RequestSubscribe -> RequestSubscribe -> Bool
$c== :: RequestSubscribe -> RequestSubscribe -> Bool
Eq, Int -> RequestSubscribe -> ShowS
[RequestSubscribe] -> ShowS
RequestSubscribe -> String
(Int -> RequestSubscribe -> ShowS)
-> (RequestSubscribe -> String)
-> ([RequestSubscribe] -> ShowS)
-> Show RequestSubscribe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestSubscribe] -> ShowS
$cshowList :: [RequestSubscribe] -> ShowS
show :: RequestSubscribe -> String
$cshow :: RequestSubscribe -> String
showsPrec :: Int -> RequestSubscribe -> ShowS
$cshowsPrec :: Int -> RequestSubscribe -> ShowS
Show, (forall x. RequestSubscribe -> Rep RequestSubscribe x)
-> (forall x. Rep RequestSubscribe x -> RequestSubscribe)
-> Generic RequestSubscribe
forall x. Rep RequestSubscribe x -> RequestSubscribe
forall x. RequestSubscribe -> Rep RequestSubscribe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestSubscribe x -> RequestSubscribe
$cfrom :: forall x. RequestSubscribe -> Rep RequestSubscribe x
Generic)
instance ToJSON RequestSubscribe where
  toJSON :: RequestSubscribe -> Value
toJSON = Options -> RequestSubscribe -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> RequestSubscribe -> Value)
-> Options -> RequestSubscribe -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "requestSubscribe"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/types/responses.go#L208
data ResultSubscribe = ResultSubscribe deriving (ResultSubscribe -> ResultSubscribe -> Bool
(ResultSubscribe -> ResultSubscribe -> Bool)
-> (ResultSubscribe -> ResultSubscribe -> Bool)
-> Eq ResultSubscribe
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultSubscribe -> ResultSubscribe -> Bool
$c/= :: ResultSubscribe -> ResultSubscribe -> Bool
== :: ResultSubscribe -> ResultSubscribe -> Bool
$c== :: ResultSubscribe -> ResultSubscribe -> Bool
Eq, Int -> ResultSubscribe -> ShowS
[ResultSubscribe] -> ShowS
ResultSubscribe -> String
(Int -> ResultSubscribe -> ShowS)
-> (ResultSubscribe -> String)
-> ([ResultSubscribe] -> ShowS)
-> Show ResultSubscribe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultSubscribe] -> ShowS
$cshowList :: [ResultSubscribe] -> ShowS
show :: ResultSubscribe -> String
$cshow :: ResultSubscribe -> String
showsPrec :: Int -> ResultSubscribe -> ShowS
$cshowsPrec :: Int -> ResultSubscribe -> ShowS
Show)

instance FromJSON ResultSubscribe where
  parseJSON :: Value -> Parser ResultSubscribe
parseJSON = String
-> (Object -> Parser ResultSubscribe)
-> Value
-> Parser ResultSubscribe
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject "Expected emptyObject" ((Object -> Parser ResultSubscribe)
 -> Value -> Parser ResultSubscribe)
-> (Object -> Parser ResultSubscribe)
-> Value
-> Parser ResultSubscribe
forall a b. (a -> b) -> a -> b
$ \_ -> ResultSubscribe -> Parser ResultSubscribe
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultSubscribe
ResultSubscribe

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

-- https://github.com/tendermint/tendermint/blob/v0.32.2/rpc/core/types/responses.go#L147
data ResultBroadcastTx = ResultBroadcastTx
  { ResultBroadcastTx -> Word32
resultBroadcastTxCode :: Word32
  , ResultBroadcastTx -> HexString
resultBroadcastTxData :: HexString
  , ResultBroadcastTx -> Text
resultBroadcastTxLog  :: Text
  , ResultBroadcastTx -> HexString
resultBroadcastTxHash :: HexString
  } deriving (ResultBroadcastTx -> ResultBroadcastTx -> Bool
(ResultBroadcastTx -> ResultBroadcastTx -> Bool)
-> (ResultBroadcastTx -> ResultBroadcastTx -> Bool)
-> Eq ResultBroadcastTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultBroadcastTx -> ResultBroadcastTx -> Bool
$c/= :: ResultBroadcastTx -> ResultBroadcastTx -> Bool
== :: ResultBroadcastTx -> ResultBroadcastTx -> Bool
$c== :: ResultBroadcastTx -> ResultBroadcastTx -> Bool
Eq, Int -> ResultBroadcastTx -> ShowS
[ResultBroadcastTx] -> ShowS
ResultBroadcastTx -> String
(Int -> ResultBroadcastTx -> ShowS)
-> (ResultBroadcastTx -> String)
-> ([ResultBroadcastTx] -> ShowS)
-> Show ResultBroadcastTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultBroadcastTx] -> ShowS
$cshowList :: [ResultBroadcastTx] -> ShowS
show :: ResultBroadcastTx -> String
$cshow :: ResultBroadcastTx -> String
showsPrec :: Int -> ResultBroadcastTx -> ShowS
$cshowsPrec :: Int -> ResultBroadcastTx -> ShowS
Show, (forall x. ResultBroadcastTx -> Rep ResultBroadcastTx x)
-> (forall x. Rep ResultBroadcastTx x -> ResultBroadcastTx)
-> Generic ResultBroadcastTx
forall x. Rep ResultBroadcastTx x -> ResultBroadcastTx
forall x. ResultBroadcastTx -> Rep ResultBroadcastTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResultBroadcastTx x -> ResultBroadcastTx
$cfrom :: forall x. ResultBroadcastTx -> Rep ResultBroadcastTx x
Generic)
instance FromJSON ResultBroadcastTx where
  parseJSON :: Value -> Parser ResultBroadcastTx
parseJSON = Options -> Value -> Parser ResultBroadcastTx
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ResultBroadcastTx)
-> Options -> Value -> Parser ResultBroadcastTx
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "resultBroadcastTx"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/types/tx.go#L85
data TxProof = TxProof
  { TxProof -> HexString
txProofRootHash :: HexString
  , TxProof -> Tx
txProofData     :: Tx
  , TxProof -> SimpleProof
txProofProof    :: SimpleProof
  } deriving (TxProof -> TxProof -> Bool
(TxProof -> TxProof -> Bool)
-> (TxProof -> TxProof -> Bool) -> Eq TxProof
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxProof -> TxProof -> Bool
$c/= :: TxProof -> TxProof -> Bool
== :: TxProof -> TxProof -> Bool
$c== :: TxProof -> TxProof -> Bool
Eq, Int -> TxProof -> ShowS
[TxProof] -> ShowS
TxProof -> String
(Int -> TxProof -> ShowS)
-> (TxProof -> String) -> ([TxProof] -> ShowS) -> Show TxProof
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxProof] -> ShowS
$cshowList :: [TxProof] -> ShowS
show :: TxProof -> String
$cshow :: TxProof -> String
showsPrec :: Int -> TxProof -> ShowS
$cshowsPrec :: Int -> TxProof -> ShowS
Show, (forall x. TxProof -> Rep TxProof x)
-> (forall x. Rep TxProof x -> TxProof) -> Generic TxProof
forall x. Rep TxProof x -> TxProof
forall x. TxProof -> Rep TxProof x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxProof x -> TxProof
$cfrom :: forall x. TxProof -> Rep TxProof x
Generic)
instance FromJSON TxProof where
  parseJSON :: Value -> Parser TxProof
parseJSON = Options -> Value -> Parser TxProof
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser TxProof)
-> Options -> Value -> Parser TxProof
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "txProof"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/crypto/merkle/simple_proof.go#L18
data SimpleProof = SimpleProof
  { SimpleProof -> WrappedVal Int64
simpleProofTotal    :: FieldTypes.WrappedVal Int64
  , SimpleProof -> WrappedVal Int64
simpleProofIndex    :: FieldTypes.WrappedVal Int64
  , SimpleProof -> Tx
simpleProofLeafHash :: Tx
  , SimpleProof -> [Tx]
simpleProofAunts    :: [Tx]
  } deriving (SimpleProof -> SimpleProof -> Bool
(SimpleProof -> SimpleProof -> Bool)
-> (SimpleProof -> SimpleProof -> Bool) -> Eq SimpleProof
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleProof -> SimpleProof -> Bool
$c/= :: SimpleProof -> SimpleProof -> Bool
== :: SimpleProof -> SimpleProof -> Bool
$c== :: SimpleProof -> SimpleProof -> Bool
Eq, Int -> SimpleProof -> ShowS
[SimpleProof] -> ShowS
SimpleProof -> String
(Int -> SimpleProof -> ShowS)
-> (SimpleProof -> String)
-> ([SimpleProof] -> ShowS)
-> Show SimpleProof
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleProof] -> ShowS
$cshowList :: [SimpleProof] -> ShowS
show :: SimpleProof -> String
$cshow :: SimpleProof -> String
showsPrec :: Int -> SimpleProof -> ShowS
$cshowsPrec :: Int -> SimpleProof -> ShowS
Show, (forall x. SimpleProof -> Rep SimpleProof x)
-> (forall x. Rep SimpleProof x -> SimpleProof)
-> Generic SimpleProof
forall x. Rep SimpleProof x -> SimpleProof
forall x. SimpleProof -> Rep SimpleProof x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimpleProof x -> SimpleProof
$cfrom :: forall x. SimpleProof -> Rep SimpleProof x
Generic)
instance FromJSON SimpleProof where
  parseJSON :: Value -> Parser SimpleProof
parseJSON = Options -> Value -> Parser SimpleProof
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser SimpleProof)
-> Options -> Value -> Parser SimpleProof
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "simpleProof"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/types/block_meta.go#L4
data BlockMeta = BlockMeta
  { BlockMeta -> BlockID
blockMetaBlockId :: FieldTypes.BlockID
  , BlockMeta -> Header
blockMetaHeader  :: FieldTypes.Header
  } deriving (BlockMeta -> BlockMeta -> Bool
(BlockMeta -> BlockMeta -> Bool)
-> (BlockMeta -> BlockMeta -> Bool) -> Eq BlockMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockMeta -> BlockMeta -> Bool
$c/= :: BlockMeta -> BlockMeta -> Bool
== :: BlockMeta -> BlockMeta -> Bool
$c== :: BlockMeta -> BlockMeta -> Bool
Eq, Int -> BlockMeta -> ShowS
[BlockMeta] -> ShowS
BlockMeta -> String
(Int -> BlockMeta -> ShowS)
-> (BlockMeta -> String)
-> ([BlockMeta] -> ShowS)
-> Show BlockMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockMeta] -> ShowS
$cshowList :: [BlockMeta] -> ShowS
show :: BlockMeta -> String
$cshow :: BlockMeta -> String
showsPrec :: Int -> BlockMeta -> ShowS
$cshowsPrec :: Int -> BlockMeta -> ShowS
Show, (forall x. BlockMeta -> Rep BlockMeta x)
-> (forall x. Rep BlockMeta x -> BlockMeta) -> Generic BlockMeta
forall x. Rep BlockMeta x -> BlockMeta
forall x. BlockMeta -> Rep BlockMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockMeta x -> BlockMeta
$cfrom :: forall x. BlockMeta -> Rep BlockMeta x
Generic)
instance FromJSON BlockMeta where
  parseJSON :: Value -> Parser BlockMeta
parseJSON = Options -> Value -> Parser BlockMeta
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser BlockMeta)
-> Options -> Value -> Parser BlockMeta
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "blockMeta"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/types/block.go#L36
data Block = Block
  { Block -> Header
blockHeader     :: FieldTypes.Header
  , Block -> Data
blockData       :: Data
  , Block -> EvidenceData
blockEvidence   :: EvidenceData
  , Block -> Maybe Commit
blockLastCommit :: Maybe Commit
  } deriving (Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Eq, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, (forall x. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic)
instance FromJSON Block where
  parseJSON :: Value -> Parser Block
parseJSON = Options -> Value -> Parser Block
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Block)
-> Options -> Value -> Parser Block
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "block"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/types/block.go#L774
data Data = Data
  { Data -> WrappedVal [Tx]
dataTxs :: FieldTypes.WrappedVal [Tx]
  } deriving (Data -> Data -> Bool
(Data -> Data -> Bool) -> (Data -> Data -> Bool) -> Eq Data
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Data -> Data -> Bool
$c/= :: Data -> Data -> Bool
== :: Data -> Data -> Bool
$c== :: Data -> Data -> Bool
Eq, Int -> Data -> ShowS
[Data] -> ShowS
Data -> String
(Int -> Data -> ShowS)
-> (Data -> String) -> ([Data] -> ShowS) -> Show Data
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Data] -> ShowS
$cshowList :: [Data] -> ShowS
show :: Data -> String
$cshow :: Data -> String
showsPrec :: Int -> Data -> ShowS
$cshowsPrec :: Int -> Data -> ShowS
Show, (forall x. Data -> Rep Data x)
-> (forall x. Rep Data x -> Data) -> Generic Data
forall x. Rep Data x -> Data
forall x. Data -> Rep Data x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Data x -> Data
$cfrom :: forall x. Data -> Rep Data x
Generic)
instance FromJSON Data where
  parseJSON :: Value -> Parser Data
parseJSON = Options -> Value -> Parser Data
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Data)
-> Options -> Value -> Parser Data
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "data"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/types/block.go#L819~
data EvidenceData = EvidenceData
  { EvidenceData -> EvidenceList
evidenceDataEvidence :: EvidenceList
  } deriving (EvidenceData -> EvidenceData -> Bool
(EvidenceData -> EvidenceData -> Bool)
-> (EvidenceData -> EvidenceData -> Bool) -> Eq EvidenceData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvidenceData -> EvidenceData -> Bool
$c/= :: EvidenceData -> EvidenceData -> Bool
== :: EvidenceData -> EvidenceData -> Bool
$c== :: EvidenceData -> EvidenceData -> Bool
Eq, Int -> EvidenceData -> ShowS
[EvidenceData] -> ShowS
EvidenceData -> String
(Int -> EvidenceData -> ShowS)
-> (EvidenceData -> String)
-> ([EvidenceData] -> ShowS)
-> Show EvidenceData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvidenceData] -> ShowS
$cshowList :: [EvidenceData] -> ShowS
show :: EvidenceData -> String
$cshow :: EvidenceData -> String
showsPrec :: Int -> EvidenceData -> ShowS
$cshowsPrec :: Int -> EvidenceData -> ShowS
Show, (forall x. EvidenceData -> Rep EvidenceData x)
-> (forall x. Rep EvidenceData x -> EvidenceData)
-> Generic EvidenceData
forall x. Rep EvidenceData x -> EvidenceData
forall x. EvidenceData -> Rep EvidenceData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EvidenceData x -> EvidenceData
$cfrom :: forall x. EvidenceData -> Rep EvidenceData x
Generic)
instance FromJSON EvidenceData where
  parseJSON :: Value -> Parser EvidenceData
parseJSON = Options -> Value -> Parser EvidenceData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser EvidenceData)
-> Options -> Value -> Parser EvidenceData
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "evidenceData"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/types/evidence.go#L278
type EvidenceList = FieldTypes.WrappedVal [FieldTypes.Evidence]

-- https://github.com/tendermint/tendermint/blob/v0.32.2/types/block.go#L488
data Commit = Commit
  { Commit -> BlockID
commitBlockId    :: FieldTypes.BlockID
  , Commit -> [Vote]
commitPrecommits :: [Vote]
  } deriving (Commit -> Commit -> Bool
(Commit -> Commit -> Bool)
-> (Commit -> Commit -> Bool) -> Eq Commit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Commit -> Commit -> Bool
$c/= :: Commit -> Commit -> Bool
== :: Commit -> Commit -> Bool
$c== :: Commit -> Commit -> Bool
Eq, Int -> Commit -> ShowS
[Commit] -> ShowS
Commit -> String
(Int -> Commit -> ShowS)
-> (Commit -> String) -> ([Commit] -> ShowS) -> Show Commit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Commit] -> ShowS
$cshowList :: [Commit] -> ShowS
show :: Commit -> String
$cshow :: Commit -> String
showsPrec :: Int -> Commit -> ShowS
$cshowsPrec :: Int -> Commit -> ShowS
Show, (forall x. Commit -> Rep Commit x)
-> (forall x. Rep Commit x -> Commit) -> Generic Commit
forall x. Rep Commit x -> Commit
forall x. Commit -> Rep Commit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Commit x -> Commit
$cfrom :: forall x. Commit -> Rep Commit x
Generic)
instance FromJSON Commit where
  parseJSON :: Value -> Parser Commit
parseJSON = Options -> Value -> Parser Commit
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Commit)
-> Options -> Value -> Parser Commit
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "commit"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/types/vote.go#L51
data Vote = Vote
  { Vote -> SignedMsgType
voteType             :: SignedMsgType
  , Vote -> WrappedVal Int64
voteHeight           :: FieldTypes.WrappedVal Int64
  , Vote -> WrappedVal Int
voteRound            :: FieldTypes.WrappedVal Int
  , Vote -> BlockID
voteBlockId          :: FieldTypes.BlockID
  , Vote -> Timestamp
voteTimestamp        :: FieldTypes.Timestamp
  , Vote -> HexString
voteValidatorAddress :: HexString
  , Vote -> WrappedVal Int
voteValidatorIndex   :: FieldTypes.WrappedVal Int
  , Vote -> Tx
voteSignature        :: Tx
  } deriving (Vote -> Vote -> Bool
(Vote -> Vote -> Bool) -> (Vote -> Vote -> Bool) -> Eq Vote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vote -> Vote -> Bool
$c/= :: Vote -> Vote -> Bool
== :: Vote -> Vote -> Bool
$c== :: Vote -> Vote -> Bool
Eq, Int -> Vote -> ShowS
[Vote] -> ShowS
Vote -> String
(Int -> Vote -> ShowS)
-> (Vote -> String) -> ([Vote] -> ShowS) -> Show Vote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vote] -> ShowS
$cshowList :: [Vote] -> ShowS
show :: Vote -> String
$cshow :: Vote -> String
showsPrec :: Int -> Vote -> ShowS
$cshowsPrec :: Int -> Vote -> ShowS
Show, (forall x. Vote -> Rep Vote x)
-> (forall x. Rep Vote x -> Vote) -> Generic Vote
forall x. Rep Vote x -> Vote
forall x. Vote -> Rep Vote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Vote x -> Vote
$cfrom :: forall x. Vote -> Rep Vote x
Generic)
instance FromJSON Vote where
  parseJSON :: Value -> Parser Vote
parseJSON = Options -> Value -> Parser Vote
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Vote)
-> Options -> Value -> Parser Vote
forall a b. (a -> b) -> a -> b
$ String -> Options
defaultRPCOptions "vote"

-- https://github.com/tendermint/tendermint/blob/v0.32.2/types/tx.go#L19
type Tx = Base64.Base64String

-- https://github.com/tendermint/tendermint/blob/v0.32.2/types/signed_msg_type.go#L4
data SignedMsgType
  = PrevoteType
  | PrecommitType
  | ProposalType
  deriving (SignedMsgType -> SignedMsgType -> Bool
(SignedMsgType -> SignedMsgType -> Bool)
-> (SignedMsgType -> SignedMsgType -> Bool) -> Eq SignedMsgType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignedMsgType -> SignedMsgType -> Bool
$c/= :: SignedMsgType -> SignedMsgType -> Bool
== :: SignedMsgType -> SignedMsgType -> Bool
$c== :: SignedMsgType -> SignedMsgType -> Bool
Eq, Int -> SignedMsgType -> ShowS
[SignedMsgType] -> ShowS
SignedMsgType -> String
(Int -> SignedMsgType -> ShowS)
-> (SignedMsgType -> String)
-> ([SignedMsgType] -> ShowS)
-> Show SignedMsgType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignedMsgType] -> ShowS
$cshowList :: [SignedMsgType] -> ShowS
show :: SignedMsgType -> String
$cshow :: SignedMsgType -> String
showsPrec :: Int -> SignedMsgType -> ShowS
$cshowsPrec :: Int -> SignedMsgType -> ShowS
Show, (forall x. SignedMsgType -> Rep SignedMsgType x)
-> (forall x. Rep SignedMsgType x -> SignedMsgType)
-> Generic SignedMsgType
forall x. Rep SignedMsgType x -> SignedMsgType
forall x. SignedMsgType -> Rep SignedMsgType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SignedMsgType x -> SignedMsgType
$cfrom :: forall x. SignedMsgType -> Rep SignedMsgType x
Generic)

instance FromJSON SignedMsgType where
  parseJSON :: Value -> Parser SignedMsgType
parseJSON = String
-> (Scientific -> Parser SignedMsgType)
-> Value
-> Parser SignedMsgType
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
Aeson.withScientific "SignedMsgType" ((Scientific -> Parser SignedMsgType)
 -> Value -> Parser SignedMsgType)
-> (Scientific -> Parser SignedMsgType)
-> Value
-> Parser SignedMsgType
forall a b. (a -> b) -> a -> b
$ \n :: Scientific
n -> case Scientific
n of
    1  -> SignedMsgType -> Parser SignedMsgType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignedMsgType
PrevoteType
    2  -> SignedMsgType -> Parser SignedMsgType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignedMsgType
PrecommitType
    32 -> SignedMsgType -> Parser SignedMsgType
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignedMsgType
ProposalType
    _  -> String -> Parser SignedMsgType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SignedMsgType) -> String -> Parser SignedMsgType
forall a b. (a -> b) -> a -> b
$ "invalid SignedMsg code: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
n

defaultRPCOptions :: String -> Aeson.Options
defaultRPCOptions :: String -> Options
defaultRPCOptions prefix :: String
prefix = Int -> ShowS -> Options
aesonDrop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix) ShowS
snakeCase