RPC Server #103
3 changed files with 52 additions and 17 deletions
|
@ -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,17 +116,22 @@ 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
|
||||
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 $ T.pack $ show block]
|
||||
[Data.Aeson.String $ toText bh]
|
||||
case r of
|
||||
Left e -> throwIO $ userError e
|
||||
Right zti -> return zti
|
||||
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
17
test/Spec.hs
17
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
|
||||
|
|
Loading…
Reference in a new issue