Implement Zebra RPC calling functions
This commit is contained in:
parent
c4f345b1de
commit
75c95b03dc
2 changed files with 79 additions and 27 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue