RPC Server #103

Merged
pitmutt merged 129 commits from rav001 into milestone3 2024-11-21 15:30:22 +00:00
3 changed files with 52 additions and 17 deletions
Showing only changes of commit 9d1416dd9d - Show all commits

View file

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

View file

@ -698,6 +698,7 @@ saveAddress pool w =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
-- * Block
-- | Save a block to the database -- | Save a block to the database
saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock) saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
saveBlock pool b = saveBlock pool b =
@ -714,6 +715,20 @@ getBlock pool b =
where_ $ bl ^. ZcashBlockHeight ==. val b where_ $ bl ^. ZcashBlockHeight ==. val b
pure bl 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 -- | Save a transaction to the data model
saveTransaction :: saveTransaction ::
ConnectionPool -- ^ the database path ConnectionPool -- ^ the database path

View file

@ -2,6 +2,7 @@
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Data.Aeson
import Data.HexString import Data.HexString
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
@ -36,7 +37,7 @@ import ZcashHaskell.Types
, ValidAddress(..) , ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
import ZcashHaskell.Utils (readZebraTransaction) import ZcashHaskell.Utils (makeZebraCall, readZebraTransaction)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Types import Zenith.Types
@ -581,3 +582,17 @@ main = do
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef") 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