feat: implement Scientific

src/Zenith/Core.hs

@@ -23,7 +23,7 @@ import Data.Aeson
 import Data.Binary.Get hiding (getBytes)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
-import Data.HexString (HexString, toBytes)
+import Data.HexString (HexString, toBytes, toText)
 import Data.Int (Int64)
 import Data.List
 import Data.Maybe (fromJust, fromMaybe)
@@ -116,20 +116,25 @@ checkBlockChain nodeHost nodePort = do
 
 -- | Get commitment trees from Zebra
 getCommitmentTrees ::
-     T.Text -- ^ Host where `zebrad` is avaiable
+     ConnectionPool
+  -> T.Text -- ^ Host where `zebrad` is avaiable
   -> Int -- ^ Port where `zebrad` is available
   -> Int -- ^ Block height
   -> IO ZebraTreeInfo
-getCommitmentTrees nodeHost nodePort block = do
-  r <-
-    makeZebraCall
-      nodeHost
-      nodePort
-      "z_gettreestate"
-      [Data.Aeson.String $ T.pack $ show block]
-  case r of
-    Left e -> throwIO $ userError e
-    Right zti -> return zti
+getCommitmentTrees pool nodeHost nodePort block = do
+  bh' <- getBlockHash pool block
+  case bh' of
+    Nothing -> throwIO $ userError "couldn't get block hash"
+    Just bh -> do
+      r <-
+        makeZebraCall
+          nodeHost
+          nodePort
+          "z_gettreestate"
+          [Data.Aeson.String $ toText bh]
+      case r of
+        Left e -> throwIO $ userError e
+        Right zti -> return zti
 
 -- * Spending Keys
 -- | Create an Orchard Spending Key for the given wallet and account index
@@ -288,7 +293,7 @@ findSaplingOutputs config b znet za = do
   let zn = getNet znet
   pool <- liftIO $ runNoLoggingT $ initPool dbPath
   tList <- liftIO $ getShieldedOutputs pool b znet
-  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort (b - 1)
+  trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort (b - 1)
   logDebugN "getting Sapling frontier"
   let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
   case sT of
@@ -395,7 +400,7 @@ findOrchardActions config b znet za = do
   let zn = getNet znet
   pool <- runNoLoggingT $ initPool dbPath
   tList <- getOrchardActions pool b znet
-  trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
+  trees <- getCommitmentTrees pool zebraHost zebraPort (b - 1)
   let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees
   case sT of
     Nothing -> throwIO $ userError "Failed to read Orchard commitment tree"
@@ -555,7 +560,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
           Just r1 -> (4, getBytes r1)
   logDebugN $ T.pack $ show recipient
   logDebugN $ T.pack $ "Target block: " ++ show bh
-  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
+  trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort bh
   let sT = SaplingCommitmentTree $ ztiSapling trees
   let oT = OrchardCommitmentTree $ ztiOrchard trees
   case accRead of
@@ -1360,7 +1365,7 @@ syncWallet config w = do
   let startBlock =
         if lastBlock > 0
           then lastBlock
-          else zcashWalletBirthdayHeight $ entityVal w
+          else 1 + zcashWalletBirthdayHeight (entityVal w)
   logDebugN $ "start block: " <> T.pack (show startBlock)
   mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
   mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs

src/Zenith/DB.hs

@@ -698,6 +698,7 @@ saveAddress pool w =
   runNoLoggingT $
   PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
 
+-- * Block
 -- | Save a block to the database
 saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
 saveBlock pool b =
@@ -714,6 +715,20 @@ getBlock pool b =
       where_ $ bl ^. ZcashBlockHeight ==. val b
       pure bl
 
+getBlockHash :: ConnectionPool -> Int -> IO (Maybe HexString)
+getBlockHash pool b = do
+  r <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      selectOne $ do
+        bl <- from $ table @ZcashBlock
+        where_ $ bl ^. ZcashBlockHeight ==. val b
+        pure $ bl ^. ZcashBlockHash
+  case r of
+    Nothing -> return Nothing
+    Just (Value h) -> return $ Just $ getHex h
+
 -- | Save a transaction to the data model
 saveTransaction ::
      ConnectionPool -- ^ the database path

test/Spec.hs

@@ -2,6 +2,7 @@
 
 import Control.Monad (when)
 import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
+import Data.Aeson
 import Data.HexString
 import Data.Maybe (fromJust)
 import qualified Data.Text.Encoding as E
@@ -36,7 +37,7 @@ import ZcashHaskell.Types
   , ValidAddress(..)
   , ZcashNet(..)
   )
-import ZcashHaskell.Utils (readZebraTransaction)
+import ZcashHaskell.Utils (makeZebraCall, readZebraTransaction)
 import Zenith.Core
 import Zenith.DB
 import Zenith.Types
@@ -581,3 +582,17 @@ main = do
                 case tx of
                   Left e -> assertFailure $ show e
                   Right h -> h `shouldNotBe` (hexString "deadbeef")
+    describe "Quick tests" $ do
+      it "validate comm trees" $ do
+        blockTree <- getCommitmentTrees "localhost" 18232 3034848
+        hashTree <-
+          makeZebraCall
+            "localhost"
+            18232
+            "z_gettreestate"
+            [ Data.Aeson.String
+                "000f8a912c6c5caf476e70fa0616c17ab4e7e8c1f42e24bddeacda275d545473"
+            ]
+        case hashTree of
+          Left e -> assertFailure e
+          Right hT -> blockTree `shouldBe` hT