Implement Zebra RPC calling functions #8

Merged
pitmutt merged 1 commit from fix080 into dev040 2024-02-12 18:01:07 +00:00
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
data RawData = RawData
{ hrp :: BS.ByteString -- ^ Human-readable part of the Bech32 encoding
, bytes :: BS.ByteString -- ^ Decoded bytes
{ hrp :: !BS.ByteString -- ^ Human-readable part of the Bech32 encoding
, bytes :: !BS.ByteString -- ^ Decoded bytes
} deriving stock (Prelude.Show, GHC.Generic)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving anyclass (Data.Structured.Show)
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
data RpcCall = RpcCall
{ jsonrpc :: T.Text
, callId :: T.Text
, method :: T.Text
, parameters :: [Data.Aeson.Value]
{ jsonrpc :: !T.Text
, callId :: !T.Text
, method :: !T.Text
, parameters :: ![Data.Aeson.Value]
} deriving stock (Prelude.Show, GHC.Generic)
instance ToJSON RpcCall where
@ -69,24 +76,24 @@ instance ToJSON RpcCall where
-- | A type to model the response of the Zcash RPC
data RpcResponse r = MakeRpcResponse
{ err :: Maybe RpcError
, respId :: T.Text
, result :: Maybe r
{ err :: !(Maybe RpcError)
, respId :: !T.Text
, result :: !(Maybe r)
} deriving stock (Prelude.Show, GHC.Generic)
deriving anyclass (ToJSON)
instance (FromJSON r) => FromJSON (RpcResponse r) where
parseJSON =
withObject "RpcResponse" $ \obj -> do
e <- obj .: "error"
e <- obj .:? "error"
i <- obj .: "id"
r <- obj .: "result"
pure $ MakeRpcResponse e i r
-- | A type to model the errors from the Zcash RPC
data RpcError = RpcError
{ ecode :: Double
, emessage :: T.Text
{ ecode :: !Double
, emessage :: !T.Text
} deriving stock (Prelude.Show, GHC.Generic)
deriving anyclass (ToJSON)
@ -97,12 +104,13 @@ instance FromJSON RpcError where
m <- obj .: "message"
pure $ RpcError c m
-- ** `zcashd`
-- | Type to represent response from the `zcashd` RPC `getblock` method
data BlockResponse = BlockResponse
{ bl_confirmations :: Integer -- ^ Block confirmations
, bl_height :: Integer -- ^ Block height
, bl_time :: Integer -- ^ Block time
, bl_txs :: [T.Text] -- ^ List of transaction IDs in the block
{ bl_confirmations :: !Integer -- ^ Block confirmations
, bl_height :: !Integer -- ^ Block height
, bl_time :: !Integer -- ^ Block time
, bl_txs :: ![T.Text] -- ^ List of transaction IDs in the block
} deriving (Prelude.Show, Eq)
instance FromJSON BlockResponse where
@ -118,18 +126,48 @@ instance FromJSON BlockResponse where
data RawTxResponse = RawTxResponse
{ rt_id :: !HexString
, rt_hex :: !HexString
, rt_shieldedOutputs :: [BS.ByteString]
, rt_orchardActions :: [OrchardAction]
, rt_blockheight :: Integer
, rt_confirmations :: Integer
, rt_blocktime :: Integer
, rt_shieldedOutputs :: ![BS.ByteString]
, rt_orchardActions :: ![OrchardAction]
, rt_blockheight :: !Integer
, rt_confirmations :: !Integer
, rt_blocktime :: !Integer
} deriving (Prelude.Show, Eq, Read)
data ZcashNet
= MainNet
| TestNet
| RegTestNet
deriving (Eq, Prelude.Show, Read)
-- ** `zebrad`
-- | Type for the response from the `zebrad` RPC method `getinfo`
data ZebraGetInfo = ZebraGetInfo
{ zgi_build :: !T.Text
, 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
-- | Type to represent the two kinds of transparent addresses

View file

@ -58,3 +58,17 @@ makeZcashCall username password m p = do
setRequestBasicAuth username password $
setRequestMethod "POST" defaultRequest
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