Implement Zebra RPC calling functions

This commit is contained in:
Rene Vergara 2024-02-12 11:55:42 -06:00
parent c4f345b1de
commit 75c95b03dc
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
2 changed files with 79 additions and 27 deletions

View file

@ -47,20 +47,27 @@ type Phrase = BS.ByteString
-- | Type to represent data after Bech32 decoding -- | Type to represent data after Bech32 decoding
data RawData = RawData data RawData = RawData
{ hrp :: BS.ByteString -- ^ Human-readable part of the Bech32 encoding { hrp :: !BS.ByteString -- ^ Human-readable part of the Bech32 encoding
, bytes :: BS.ByteString -- ^ Decoded bytes , bytes :: !BS.ByteString -- ^ Decoded bytes
} deriving stock (Prelude.Show, GHC.Generic) } deriving stock (Prelude.Show, GHC.Generic)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving anyclass (Data.Structured.Show) deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct RawData deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct RawData
-- * `zcashd` RPC -- | Type for the different networks of the Zcash blockchain
data ZcashNet
= MainNet
| TestNet
| RegTestNet
deriving (Eq, Prelude.Show, Read)
-- * RPC
-- | A type to model Zcash RPC calls -- | A type to model Zcash RPC calls
data RpcCall = RpcCall data RpcCall = RpcCall
{ jsonrpc :: T.Text { jsonrpc :: !T.Text
, callId :: T.Text , callId :: !T.Text
, method :: T.Text , method :: !T.Text
, parameters :: [Data.Aeson.Value] , parameters :: ![Data.Aeson.Value]
} deriving stock (Prelude.Show, GHC.Generic) } deriving stock (Prelude.Show, GHC.Generic)
instance ToJSON RpcCall where instance ToJSON RpcCall where
@ -69,24 +76,24 @@ instance ToJSON RpcCall where
-- | A type to model the response of the Zcash RPC -- | A type to model the response of the Zcash RPC
data RpcResponse r = MakeRpcResponse data RpcResponse r = MakeRpcResponse
{ err :: Maybe RpcError { err :: !(Maybe RpcError)
, respId :: T.Text , respId :: !T.Text
, result :: Maybe r , result :: !(Maybe r)
} deriving stock (Prelude.Show, GHC.Generic) } deriving stock (Prelude.Show, GHC.Generic)
deriving anyclass (ToJSON) deriving anyclass (ToJSON)
instance (FromJSON r) => FromJSON (RpcResponse r) where instance (FromJSON r) => FromJSON (RpcResponse r) where
parseJSON = parseJSON =
withObject "RpcResponse" $ \obj -> do withObject "RpcResponse" $ \obj -> do
e <- obj .: "error" e <- obj .:? "error"
i <- obj .: "id" i <- obj .: "id"
r <- obj .: "result" r <- obj .: "result"
pure $ MakeRpcResponse e i r pure $ MakeRpcResponse e i r
-- | A type to model the errors from the Zcash RPC -- | A type to model the errors from the Zcash RPC
data RpcError = RpcError data RpcError = RpcError
{ ecode :: Double { ecode :: !Double
, emessage :: T.Text , emessage :: !T.Text
} deriving stock (Prelude.Show, GHC.Generic) } deriving stock (Prelude.Show, GHC.Generic)
deriving anyclass (ToJSON) deriving anyclass (ToJSON)
@ -97,12 +104,13 @@ instance FromJSON RpcError where
m <- obj .: "message" m <- obj .: "message"
pure $ RpcError c m pure $ RpcError c m
-- ** `zcashd`
-- | Type to represent response from the `zcashd` RPC `getblock` method -- | Type to represent response from the `zcashd` RPC `getblock` method
data BlockResponse = BlockResponse data BlockResponse = BlockResponse
{ bl_confirmations :: Integer -- ^ Block confirmations { bl_confirmations :: !Integer -- ^ Block confirmations
, bl_height :: Integer -- ^ Block height , bl_height :: !Integer -- ^ Block height
, bl_time :: Integer -- ^ Block time , bl_time :: !Integer -- ^ Block time
, bl_txs :: [T.Text] -- ^ List of transaction IDs in the block , bl_txs :: ![T.Text] -- ^ List of transaction IDs in the block
} deriving (Prelude.Show, Eq) } deriving (Prelude.Show, Eq)
instance FromJSON BlockResponse where instance FromJSON BlockResponse where
@ -118,18 +126,48 @@ instance FromJSON BlockResponse where
data RawTxResponse = RawTxResponse data RawTxResponse = RawTxResponse
{ rt_id :: !HexString { rt_id :: !HexString
, rt_hex :: !HexString , rt_hex :: !HexString
, rt_shieldedOutputs :: [BS.ByteString] , rt_shieldedOutputs :: ![BS.ByteString]
, rt_orchardActions :: [OrchardAction] , rt_orchardActions :: ![OrchardAction]
, rt_blockheight :: Integer , rt_blockheight :: !Integer
, rt_confirmations :: Integer , rt_confirmations :: !Integer
, rt_blocktime :: Integer , rt_blocktime :: !Integer
} deriving (Prelude.Show, Eq, Read) } deriving (Prelude.Show, Eq, Read)
data ZcashNet -- ** `zebrad`
= MainNet -- | Type for the response from the `zebrad` RPC method `getinfo`
| TestNet data ZebraGetInfo = ZebraGetInfo
| RegTestNet { zgi_build :: !T.Text
deriving (Eq, Prelude.Show, Read) , zgi_subversion :: !T.Text
} deriving (Prelude.Show, Eq)
instance FromJSON ZebraGetInfo where
parseJSON =
withObject "ZebraGetInfo" $ \obj -> do
b <- obj .: "build"
s <- obj .: "subversion"
pure $ ZebraGetInfo b s
-- | Type for the response from the `zebrad` RPC method `getblockchaininfo`
data ZebraGetBlockChainInfo = ZebraGetBlockChainInfo
{ zgb_best :: !HexString
, zgb_blocks :: !Integer
, zgb_net :: !ZcashNet
} deriving (Prelude.Show, Eq)
instance FromJSON ZebraGetBlockChainInfo where
parseJSON =
withObject "ZebraGetBlockChainInfo" $ \obj -> do
be <- obj .: "bestblockhash"
b <- obj .: "blocks"
c <- obj .: "chain"
pure $
ZebraGetBlockChainInfo
be
b
(case (c :: String) of
"main" -> MainNet
"test" -> TestNet
_ -> RegTestNet)
-- * Transparent -- * Transparent
-- | Type to represent the two kinds of transparent addresses -- | Type to represent the two kinds of transparent addresses

View file

@ -58,3 +58,17 @@ makeZcashCall username password m p = do
setRequestBasicAuth username password $ setRequestBasicAuth username password $
setRequestMethod "POST" defaultRequest setRequestMethod "POST" defaultRequest
httpJSON myRequest httpJSON myRequest
-- | Make a Zebra RPC call
makeZebraCall ::
(MonadIO m, FromJSON a)
=> Int -- ^ Port for `zebrad`
-> T.Text -- ^ RPC method to call
-> [Data.Aeson.Value] -- ^ List of parameters
-> m (Response a)
makeZebraCall port m params = do
let payload = RpcCall "2.0" "zh" m params
let myRequest =
setRequestBodyJSON payload $
setRequestPort port $ setRequestMethod "POST" defaultRequest
httpJSON myRequest