Milestone 3: RPC server, ZIP-320 #104
3 changed files with 52 additions and 17 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
17
test/Spec.hs
17
test/Spec.hs
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue