module Network.Tendermint.Client
( module Network.Tendermint.Client
, RPC.Config(..)
, RPC.JsonRpcException(..)
, RPC.RpcError(..)
)
where
import Control.Monad.Reader (ReaderT,
runReaderT)
import Data.Aeson (FromJSON (..),
ToJSON (..),
genericParseJSON,
genericToJSON)
import qualified Data.Aeson as Aeson
import Data.Aeson.Casing (aesonDrop,
snakeCase)
import qualified Data.ByteArray.Base64String as Base64
import Data.ByteArray.HexString (HexString)
import Data.ByteString (ByteString)
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
runTendermintM :: RPC.Config -> TendermintM a -> IO a
runTendermintM = flip runReaderT
defaultConfig
:: ByteString
-> Int
-> RPC.Config
defaultConfig host port =
let baseReq =
HTTP.setRequestHost host
$ HTTP.setRequestPort port
$ HTTP.defaultRequest
in RPC.Config baseReq mempty mempty
abciQuery :: RequestABCIQuery -> TendermintM ResultABCIQuery
abciQuery = RPC.remote (RPC.MethodName "abci_query")
data RequestABCIQuery = RequestABCIQuery
{ requestABCIQueryPath :: Maybe Text
, requestABCIQueryData :: HexString
, requestABCIQueryHeight :: Maybe (FieldTypes.WrappedVal Int64)
, requestABCIQueryProve :: Bool
} deriving (Eq, Show, Generic)
instance ToJSON RequestABCIQuery where
toJSON = genericToJSON $ defaultRPCOptions "requestABCIQuery"
instance Default RequestABCIQuery where
def = RequestABCIQuery { requestABCIQueryPath = Nothing
, requestABCIQueryData = ""
, requestABCIQueryHeight = Nothing
, requestABCIQueryProve = False
}
data ResultABCIQuery = ResultABCIQuery
{ resultABCIQueryResponse :: Response.Query
} deriving (Eq, Show, Generic)
instance FromJSON ResultABCIQuery where
parseJSON = genericParseJSON $ defaultRPCOptions "resultABCIQuery"
block :: RequestBlock -> TendermintM ResultBlock
block = RPC.remote (RPC.MethodName "block")
data RequestBlock = RequestBlock
{ requestBlockHeightPtr :: Maybe (FieldTypes.WrappedVal Int64)
} deriving (Eq, Show, Generic)
instance ToJSON RequestBlock where
toJSON = genericToJSON $ defaultRPCOptions "requestBlock"
instance Default RequestBlock where
def = RequestBlock { requestBlockHeightPtr = Nothing }
data ResultBlock = ResultBlock
{ resultBlockBlockMeta :: BlockMeta
, resultBlockBlock :: Block
} deriving (Eq, Show, Generic)
instance FromJSON ResultBlock where
parseJSON = genericParseJSON $ defaultRPCOptions "resultBlock"
tx :: RequestTx -> TendermintM ResultTx
tx = RPC.remote (RPC.MethodName "tx")
data RequestTx = RequestTx
{ requestTxHash :: Maybe Tx
, requestTxProve :: Bool
} deriving (Eq, Show, Generic)
instance ToJSON RequestTx where
toJSON = genericToJSON $ defaultRPCOptions "requestTx"
instance Default RequestTx where
def = RequestTx { requestTxHash = Nothing, requestTxProve = False }
data ResultTx = ResultTx
{ resultTxHash :: HexString
, resultTxHeight :: FieldTypes.WrappedVal Int64
, resultTxIndex :: Word32
, resultTxTxResult :: Response.DeliverTx
, resultTxTx :: Tx
, resultTxProof :: Maybe TxProof
} deriving (Eq, Show, Generic)
instance FromJSON ResultTx where
parseJSON = genericParseJSON $ defaultRPCOptions "resultTx"
broadcastTxAsync :: RequestBroadcastTxAsync -> TendermintM ResultBroadcastTx
broadcastTxAsync = RPC.remote (RPC.MethodName "broadcast_tx_async")
data RequestBroadcastTxAsync = RequestBroadcastTxAsync
{ requestBroadcastTxAsyncTx :: Tx
} deriving (Eq, Show, Generic)
instance ToJSON RequestBroadcastTxAsync where
toJSON = genericToJSON $ defaultRPCOptions "requestBroadcastTxAsync"
broadcastTxSync :: RequestBroadcastTxSync -> TendermintM ResultBroadcastTx
broadcastTxSync = RPC.remote (RPC.MethodName "broadcast_tx_sync")
data RequestBroadcastTxSync = RequestBroadcastTxSync
{ requestBroadcastTxSyncTx :: Tx
} deriving (Eq, Show, Generic)
instance ToJSON RequestBroadcastTxSync where
toJSON = genericToJSON $ defaultRPCOptions "requestBroadcastTxSync"
broadcastTxCommit
:: RequestBroadcastTxCommit -> TendermintM ResultBroadcastTxCommit
broadcastTxCommit = RPC.remote (RPC.MethodName "broadcast_tx_commit")
data RequestBroadcastTxCommit = RequestBroadcastTxCommit
{ requestBroadcastTxCommitTx :: Tx
} deriving (Eq, Show, Generic)
instance ToJSON RequestBroadcastTxCommit where
toJSON = genericToJSON $ defaultRPCOptions "requestBroadcastTxCommit"
data ResultBroadcastTxCommit = ResultBroadcastTxCommit
{ resultBroadcastTxCommitCheckTx :: Response.CheckTx
, resultBroadcastTxCommitDeliverTx :: Response.DeliverTx
, resultBroadcastTxCommitHash :: HexString
, resultBroadcastTxCommitHeight :: FieldTypes.WrappedVal Int64
} deriving (Eq, Show, Generic)
instance FromJSON ResultBroadcastTxCommit where
parseJSON = genericParseJSON $ defaultRPCOptions "resultBroadcastTxCommit"
health :: TendermintM ResultHealth
health = RPC.remote (RPC.MethodName "health") ()
data ResultHealth = ResultHealth deriving (Eq, Show)
instance FromJSON ResultHealth where
parseJSON = Aeson.withObject "Expected emptyObject" $ \_ -> pure ResultHealth
abciInfo :: TendermintM ResultABCIInfo
abciInfo = RPC.remote (RPC.MethodName "abci_info") ()
data ResultABCIInfo = ResultABCIInfo
{ resultABCIInfoResponse :: Response.Info
} deriving (Eq, Show, Generic)
instance FromJSON ResultABCIInfo where
parseJSON = genericParseJSON $ defaultRPCOptions "resultABCIInfo"
data ResultBroadcastTx = ResultBroadcastTx
{ resultBroadcastTxCode :: Word32
, resultBroadcastTxData :: HexString
, resultBroadcastTxLog :: Text
, resultBroadcastTxHash :: HexString
} deriving (Eq, Show, Generic)
instance FromJSON ResultBroadcastTx where
parseJSON = genericParseJSON $ defaultRPCOptions "resultBroadcastTx"
data TxProof = TxProof
{ txProofRootHash :: HexString
, txProofData :: Tx
, txProofProof :: SimpleProof
} deriving (Eq, Show, Generic)
instance FromJSON TxProof where
parseJSON = genericParseJSON $ defaultRPCOptions "txProof"
data SimpleProof = SimpleProof
{ simpleProofTotal :: FieldTypes.WrappedVal Int64
, simpleProofIndex :: FieldTypes.WrappedVal Int64
, simpleProofLeafHash :: Tx
, simpleProofAunts :: [Tx]
} deriving (Eq, Show, Generic)
instance FromJSON SimpleProof where
parseJSON = genericParseJSON $ defaultRPCOptions "simpleProof"
data BlockMeta = BlockMeta
{ blockMetaBlockId :: FieldTypes.BlockID
, blockMetaHeader :: FieldTypes.Header
} deriving (Eq, Show, Generic)
instance FromJSON BlockMeta where
parseJSON = genericParseJSON $ defaultRPCOptions "blockMeta"
data Block = Block
{ blockHeader :: FieldTypes.Header
, blockData :: Data
, blockEvidence :: EvidenceData
, blockLastCommit :: Maybe Commit
} deriving (Eq, Show, Generic)
instance FromJSON Block where
parseJSON = genericParseJSON $ defaultRPCOptions "block"
data Data = Data
{ dataTxs :: FieldTypes.WrappedVal [Tx]
} deriving (Eq, Show, Generic)
instance FromJSON Data where
parseJSON = genericParseJSON $ defaultRPCOptions "data"
data EvidenceData = EvidenceData
{ evidenceDataEvidence :: EvidenceList
} deriving (Eq, Show, Generic)
instance FromJSON EvidenceData where
parseJSON = genericParseJSON $ defaultRPCOptions "evidenceData"
type EvidenceList = FieldTypes.WrappedVal [FieldTypes.Evidence]
data Commit = Commit
{ commitBlockId :: FieldTypes.BlockID
, commitPrecommits :: [Vote]
} deriving (Eq, Show, Generic)
instance FromJSON Commit where
parseJSON = genericParseJSON $ defaultRPCOptions "commit"
data Vote = Vote
{ voteType :: SignedMsgType
, voteHeight :: FieldTypes.WrappedVal Int64
, voteRound :: FieldTypes.WrappedVal Int
, voteBlockId :: FieldTypes.BlockID
, voteTimestamp :: FieldTypes.Timestamp
, voteValidatorAddress :: HexString
, voteValidatorIndex :: FieldTypes.WrappedVal Int
, voteSignature :: Tx
} deriving (Eq, Show, Generic)
instance FromJSON Vote where
parseJSON = genericParseJSON $ defaultRPCOptions "vote"
type Tx = Base64.Base64String
data SignedMsgType
= PrevoteType
| PrecommitType
| ProposalType
deriving (Eq, Show, Generic)
instance FromJSON SignedMsgType where
parseJSON = Aeson.withScientific "SignedMsgType" $ \n -> case n of
1 -> pure PrevoteType
2 -> pure PrecommitType
32 -> pure ProposalType
_ -> fail $ "invalid SignedMsg code: " <> show n
defaultRPCOptions :: String -> Aeson.Options
defaultRPCOptions prefix = aesonDrop (length prefix) snakeCase