Merge pull request 'Implement Zebra RPC calling functions' (#8) from fix080 into dev040

Reviewed-on: #8

src/ZcashHaskell/Types.hs

@@ -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
+  { 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 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
+  { 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)
 
 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
+  { err :: !(Maybe RpcError)
-  , respId :: T.Text
+  , respId :: !T.Text
-  , result :: Maybe r
+  , 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
+  { ecode :: !Double
-  , emessage :: T.Text
+  , 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_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)
 
 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_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)
 
-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
 -- | Type to represent the two kinds of transparent addresses

src/ZcashHaskell/Utils.hs

@@ -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