diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 522f866..9cdb015 100644 --- a/src/Zenith/Core.hs +++ b/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 diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 161ed5e..18882cc 100644 --- a/src/Zenith/DB.hs +++ b/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 diff --git a/test/Spec.hs b/test/Spec.hs index 5d548b4..fac84fd 100644 --- a/test/Spec.hs +++ b/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