From e7050f03c0423a3f0682aa2d26bbb06683630d67 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 20 Mar 2024 11:13:02 -0500 Subject: [PATCH 1/5] Upgrade Zebra call --- CHANGELOG.md | 7 ++++++- src/ZcashHaskell/Sapling.hs | 2 +- src/ZcashHaskell/Types.hs | 6 +++--- src/ZcashHaskell/Utils.hs | 20 +++++++++++++++++--- zcash-haskell.cabal | 3 ++- 5 files changed, 29 insertions(+), 9 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 31c81c2..ad3ee7b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,8 +5,13 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.5.1.0] -## [Unreleased] +### Changed + +- Modified the `makeZebraCall` function to handle errors explicitly + +## [0.5.0.1] ### Added diff --git a/src/ZcashHaskell/Sapling.hs b/src/ZcashHaskell/Sapling.hs index c744516..fb1c459 100644 --- a/src/ZcashHaskell/Sapling.hs +++ b/src/ZcashHaskell/Sapling.hs @@ -126,7 +126,7 @@ genSaplingPaymentAddress i extspk = -- | Generate an internal Sapling address genSaplingInternalAddress :: SaplingSpendingKey -> Maybe SaplingReceiver genSaplingInternalAddress sk = - if BS.length res > 0 + if BS.length res == 43 then Just $ SaplingReceiver res else Nothing where diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index 091d661..32f4e57 100644 --- a/src/ZcashHaskell/Types.hs +++ b/src/ZcashHaskell/Types.hs @@ -44,7 +44,7 @@ import Haskoin.Crypto.Keys.Extended (XPrvKey) -- -- | A seed for generating private keys newtype Seed = - Seed C.ByteString + Seed BS.ByteString deriving stock (Eq, Prelude.Show, GHC.Generic) deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) deriving anyclass (Data.Structured.Show) @@ -55,7 +55,7 @@ instance ToBytes Seed where -- | A mnemonic phrase used to derive seeds newtype Phrase = - Phrase BS.ByteString + Phrase C.ByteString deriving stock (Eq, Prelude.Show, GHC.Generic, Read) deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) deriving anyclass (Data.Structured.Show) @@ -191,7 +191,7 @@ 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_txs :: ![HexString] -- ^ List of transaction IDs in the block } deriving (Prelude.Show, Eq) instance FromJSON BlockResponse where diff --git a/src/ZcashHaskell/Utils.hs b/src/ZcashHaskell/Utils.hs index f6f1ceb..702e453 100644 --- a/src/ZcashHaskell/Utils.hs +++ b/src/ZcashHaskell/Utils.hs @@ -23,12 +23,14 @@ import C.Zcash , rustWrapperF4Jumble , rustWrapperF4UnJumble ) +import Control.Exception (try) import Control.Monad.IO.Class import Data.Aeson import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.Encoding as E import Foreign.Rust.Marshall.Variable +import Network.HTTP.Client (HttpException(..)) import Network.HTTP.Simple import ZcashHaskell.Types @@ -74,12 +76,12 @@ makeZcashCall username password m p = do -- | Make a Zebra RPC call makeZebraCall :: - (MonadIO m, FromJSON a) + FromJSON a => T.Text -- ^ Hostname for `zebrad` -> Int -- ^ Port for `zebrad` -> T.Text -- ^ RPC method to call -> [Data.Aeson.Value] -- ^ List of parameters - -> m (Response a) + -> IO (Either String a) makeZebraCall host port m params = do let payload = RpcCall "2.0" "zh" m params let myRequest = @@ -87,4 +89,16 @@ makeZebraCall host port m params = do setRequestPort port $ setRequestHost (E.encodeUtf8 host) $ setRequestMethod "POST" defaultRequest - httpJSON myRequest + r <- + try $ httpJSON myRequest :: FromJSON a1 => + IO (Either HttpException (Response (RpcResponse a1))) + case r of + Left ex -> return $ Left $ show ex + Right res -> do + let zebraResp = getResponseBody res + case err zebraResp of + Just zErr -> return $ Left $ T.unpack $ emessage zErr + Nothing -> + case result zebraResp of + Nothing -> return $ Left "Empty response from Zebra" + Just zR -> return $ Right zR diff --git a/zcash-haskell.cabal b/zcash-haskell.cabal index 646d810..05ac71b 100644 --- a/zcash-haskell.cabal +++ b/zcash-haskell.cabal @@ -5,7 +5,7 @@ cabal-version: 3.0 -- see: https://github.com/sol/hpack name: zcash-haskell -version: 0.5.0.1 +version: 0.5.1.0 synopsis: Utilities to interact with the Zcash blockchain description: Please see the README on the repo at category: Blockchain @@ -53,6 +53,7 @@ library , generics-sop , hexstring >=0.12.1 , http-conduit + , http-client , memory , text , haskoin-core -- 2.34.1 From 517b736c9a67a9f54546cce04f589b0fdfa9c8d0 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 20 Mar 2024 14:16:12 -0500 Subject: [PATCH 2/5] Allow for missing `result` in RPC response --- CHANGELOG.md | 1 + src/ZcashHaskell/Types.hs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index ad3ee7b..fef5e74 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Modified the `makeZebraCall` function to handle errors explicitly +- Modified the RPC response to handle missing `result` field ## [0.5.0.1] diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index 32f4e57..182ddc1 100644 --- a/src/ZcashHaskell/Types.hs +++ b/src/ZcashHaskell/Types.hs @@ -168,7 +168,7 @@ instance (FromJSON r) => FromJSON (RpcResponse r) where withObject "RpcResponse" $ \obj -> do e <- obj .:? "error" i <- obj .: "id" - r <- obj .: "result" + r <- obj .:? "result" pure $ MakeRpcResponse e i r -- | A type to model the errors from the Zcash RPC -- 2.34.1 From 69bce58345bfb9b0bf2a30d1cae0b834a769d66f Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 21 Mar 2024 12:52:45 -0500 Subject: [PATCH 3/5] Improve exception handling of Zebra calls --- src/ZcashHaskell/Utils.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ZcashHaskell/Utils.hs b/src/ZcashHaskell/Utils.hs index 702e453..39296e9 100644 --- a/src/ZcashHaskell/Utils.hs +++ b/src/ZcashHaskell/Utils.hs @@ -23,7 +23,7 @@ import C.Zcash , rustWrapperF4Jumble , rustWrapperF4UnJumble ) -import Control.Exception (try) +import Control.Exception (SomeException(..), try) import Control.Monad.IO.Class import Data.Aeson import qualified Data.ByteString as BS @@ -91,7 +91,7 @@ makeZebraCall host port m params = do setRequestMethod "POST" defaultRequest r <- try $ httpJSON myRequest :: FromJSON a1 => - IO (Either HttpException (Response (RpcResponse a1))) + IO (Either SomeException (Response (RpcResponse a1))) case r of Left ex -> return $ Left $ show ex Right res -> do -- 2.34.1 From 9c8a851eadb860ee71092c5af3c77945109bf58f Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 21 Mar 2024 15:12:22 -0500 Subject: [PATCH 4/5] Implement Sapling spends --- CHANGELOG.md | 4 ++++ src/ZcashHaskell/Sapling.hs | 6 ++++-- src/ZcashHaskell/Types.hs | 25 +++++++++++++++++++++++++ 3 files changed, 33 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fef5e74..999e019 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [0.5.1.0] +### Added + +- Functionality to capture Sapling Spends + ### Changed - Modified the `makeZebraCall` function to handle errors explicitly diff --git a/src/ZcashHaskell/Sapling.hs b/src/ZcashHaskell/Sapling.hs index fb1c459..2dc7f49 100644 --- a/src/ZcashHaskell/Sapling.hs +++ b/src/ZcashHaskell/Sapling.hs @@ -90,11 +90,13 @@ instance FromJSON RawTxResponse where ht <- obj .: "height" c <- obj .: "confirmations" b <- obj .: "blocktime" + sSpend <- obj .: "vShieldedSpend" case o of - Nothing -> pure $ RawTxResponse i h (getShieldedOutputs h) [] ht c b + Nothing -> + pure $ RawTxResponse i h sSpend (getShieldedOutputs h) [] ht c b Just o' -> do a <- o' .: "actions" - pure $ RawTxResponse i h (getShieldedOutputs h) a ht c b + pure $ RawTxResponse i h sSpend (getShieldedOutputs h) a ht c b -- | Attempts to obtain a sapling SpendingKey using a HDSeed genSaplingSpendingKey :: Seed -> CoinType -> Int -> Maybe SaplingSpendingKey diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index 182ddc1..e7f68b3 100644 --- a/src/ZcashHaskell/Types.hs +++ b/src/ZcashHaskell/Types.hs @@ -207,6 +207,7 @@ instance FromJSON BlockResponse where data RawTxResponse = RawTxResponse { rt_id :: !HexString , rt_hex :: !HexString + , rt_shieldedSpends :: ![ShieldedSpend] , rt_shieldedOutputs :: ![BS.ByteString] , rt_orchardActions :: ![OrchardAction] , rt_blockheight :: !Integer @@ -283,6 +284,30 @@ newtype SaplingReceiver = instance ToBytes SaplingReceiver where getBytes (SaplingReceiver s) = s +-- | Type to represent a Sapling Shielded Spend as provided by the @getrawtransaction@ RPC method +data ShieldedSpend = ShieldedSpend + { sp_cv :: !HexString + , sp_anchor :: !HexString + , sp_nullifier :: !HexString + , sp_rk :: !HexString + , sp_proof :: !HexString + , sp_auth :: !HexString + } deriving stock (Eq, Prelude.Show, GHC.Generic, Read) + deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) + deriving anyclass (Data.Structured.Show) + deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct ShieldedSpend + +instance FromJSON ShieldedSpend where + parseJSON = + withObject "ShieldedSpend" $ \obj -> do + cv <- obj .: "cv" + anchor <- obj .: "anchor" + nullifier <- obj .: "nullifier" + rk <- obj .: "rk" + p <- obj .: "proof" + sig <- obj .: "spendAuthSig" + pure $ ShieldedSpend cv anchor nullifier rk p sig + -- | Type to represent a Sapling Shielded Output as provided by the @getrawtransaction@ RPC method of @zcashd@. data ShieldedOutput = ShieldedOutput { s_cv :: !HexString -- ^ Value commitment to the input note -- 2.34.1 From 5b6ce3f29b718cb7ff63f768ab67201cfda48677 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 21 Mar 2024 19:27:09 -0500 Subject: [PATCH 5/5] Account for missing block time field --- src/ZcashHaskell/Types.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs index e7f68b3..612410e 100644 --- a/src/ZcashHaskell/Types.hs +++ b/src/ZcashHaskell/Types.hs @@ -7,7 +7,7 @@ -- Copyright : 2022-2024 Vergara Technologies -- License : MIT -- --- Maintainer : pitmut@vergara.tech +-- Maintainer : pitmutt@vergara.tech -- Stability : experimental -- Portability : unknown -- @@ -31,6 +31,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C import Data.HexString import Data.Int +import Data.Maybe (fromMaybe) import Data.Structured import qualified Data.Text as T import qualified Data.Text.Encoding as E @@ -199,9 +200,9 @@ instance FromJSON BlockResponse where withObject "BlockResponse" $ \obj -> do c <- obj .: "confirmations" h <- obj .: "height" - t <- obj .: "time" + t <- obj .:? "time" txs <- obj .: "tx" - pure $ BlockResponse c h t txs + pure $ BlockResponse c h (fromMaybe 0 t) txs -- | Type to represent response from the `zcashd` RPC `getrawtransaction` data RawTxResponse = RawTxResponse -- 2.34.1