feat: implement Scientific

This commit is contained in:
Rene Vergara 2024-10-23 15:51:05 -05:00
parent d72f355981
commit 9d1416dd9d
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
3 changed files with 52 additions and 17 deletions

View file

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

View file

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

View file

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