From e7050f03c0423a3f0682aa2d26bbb06683630d67 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 20 Mar 2024 11:13:02 -0500
Subject: [PATCH] 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 <https://git.vergara.tech/Vergara_Tech/zcash-haskell#readme>
 category:       Blockchain
@@ -53,6 +53,7 @@ library
     , generics-sop
     , hexstring >=0.12.1
     , http-conduit
+    , http-client
     , memory
     , text
     , haskoin-core
-- 
2.34.1