Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 6 Packages Wiki Activity

RPC Server #103

Merged
pitmutt merged 129 commits from rav001 into milestone3 2024-11-21 15:30:22 +00:00
Conversation 0 Commits 129 Files changed 22 +53 -30
6 changed files with 53 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files
Showing only changes of commit 183b4adf91 - Show all commits

5
src/Zenith/CLI.hs
View file

@ -832,7 +832,7 @@ scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- liftIO $ runNoLoggingT $ initPool dbP pool <- liftIO $ runNoLoggingT $ initPool dbP
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1 chkBlock <- liftIO $ checkIntegrity dbP zHost zPort znet dbBlock 1
syncChk <- liftIO $ isSyncing pool syncChk <- liftIO $ isSyncing pool
if syncChk if syncChk
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress" then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
@ -844,7 +844,8 @@ scanZebra dbP zHost zPort b eChan znet = do
if chkBlock == dbBlock if chkBlock == dbBlock
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
when (chkBlock /= dbBlock && chkBlock /= 1) $ rewindWalletData pool sb when (chkBlock /= dbBlock && chkBlock /= 1) $
rewindWalletData pool sb $ ZcashNetDB znet
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then do then do
liftIO $ liftIO $

12
src/Zenith/Core.hs
View file

@ -119,10 +119,11 @@ getCommitmentTrees ::
ConnectionPool ConnectionPool
-> T.Text -- ^ Host where `zebrad` is avaiable -> T.Text -- ^ Host where `zebrad` is avaiable
-> Int -- ^ Port where `zebrad` is available -> Int -- ^ Port where `zebrad` is available
-> ZcashNetDB
-> Int -- ^ Block height -> Int -- ^ Block height
-> IO ZebraTreeInfo -> IO ZebraTreeInfo
getCommitmentTrees pool nodeHost nodePort block = do getCommitmentTrees pool nodeHost nodePort znet block = do
bh' <- getBlockHash pool block bh' <- getBlockHash pool block znet
case bh' of case bh' of
Nothing -> throwIO $ userError "couldn't get block hash" Nothing -> throwIO $ userError "couldn't get block hash"
Just bh -> do Just bh -> do
@ -293,7 +294,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 pool zebraHost zebraPort (b - 1) trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort znet (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
@ -400,7 +401,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 pool zebraHost zebraPort (b - 1) trees <- getCommitmentTrees pool zebraHost zebraPort znet (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"
@ -560,7 +561,8 @@ 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 pool zebraHost zebraPort bh trees <-
liftIO $ getCommitmentTrees pool zebraHost zebraPort (ZcashNetDB zn) 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

49
src/Zenith/DB.hs
View file

@ -705,25 +705,30 @@ saveBlock pool b =
runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b
-- | Read a block by height -- | Read a block by height
getBlock :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashBlock)) getBlock ::
getBlock pool b = ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe (Entity ZcashBlock))
getBlock pool b znet =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
selectOne $ do selectOne $ do
bl <- from $ table @ZcashBlock bl <- from $ table @ZcashBlock
where_ $ bl ^. ZcashBlockHeight ==. val b where_ $
bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
val znet
pure bl pure bl
getBlockHash :: ConnectionPool -> Int -> IO (Maybe HexString) getBlockHash :: ConnectionPool -> Int -> ZcashNetDB -> IO (Maybe HexString)
getBlockHash pool b = do getBlockHash pool b znet = do
r <- r <-
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
selectOne $ do selectOne $ do
bl <- from $ table @ZcashBlock bl <- from $ table @ZcashBlock
where_ $ bl ^. ZcashBlockHeight ==. val b where_ $
bl ^. ZcashBlockHeight ==. val b &&. bl ^. ZcashBlockNetwork ==.
val znet
pure $ bl ^. ZcashBlockHash pure $ bl ^. ZcashBlockHash
case r of case r of
Nothing -> return Nothing Nothing -> return Nothing
@ -2663,8 +2668,8 @@ completeSync pool st = do
return () return ()
-- | Rewind the data store to a given block height -- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> LoggingT IO () rewindWalletData :: ConnectionPool -> Int -> ZcashNetDB -> LoggingT IO ()
rewindWalletData pool b = do rewindWalletData pool b net = do
logDebugN "Starting transaction rewind" logDebugN "Starting transaction rewind"
liftIO $ clearWalletTransactions pool liftIO $ clearWalletTransactions pool
logDebugN "Completed transaction rewind" logDebugN "Completed transaction rewind"
@ -2676,7 +2681,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2696,7 +2703,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2716,7 +2725,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2736,7 +2747,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2756,7 +2769,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2776,7 +2791,9 @@ rewindWalletData pool b = do
oldBlocks <- oldBlocks <-
select $ do select $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
pure blk pure blk
let oldBlkKeys = map entityKey oldBlocks let oldBlkKeys = map entityKey oldBlocks
oldTxs <- oldTxs <-
@ -2795,5 +2812,7 @@ rewindWalletData pool b = do
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
delete $ do delete $ do
blk <- from $ table @ZcashBlock blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b where_
(blk ^. ZcashBlockHeight >. val b &&. blk ^. ZcashBlockNetwork ==.
val net)
logDebugN "Completed data store rewind" logDebugN "Completed data store rewind"

4
src/Zenith/GUI.hs
View file

@ -1627,7 +1627,7 @@ scanZebra dbPath zHost zPort net sendMsg = do
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
b <- liftIO $ getMinBirthdayHeight pool b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1 chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
syncChk <- isSyncing pool syncChk <- isSyncing pool
if syncChk if syncChk
then sendMsg (ShowError "Sync already in progress") then sendMsg (ShowError "Sync already in progress")
@ -1637,7 +1637,7 @@ scanZebra dbPath zHost zPort net sendMsg = do
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $ unless (chkBlock == dbBlock || chkBlock == 1) $
runStderrLoggingT $ rewindWalletData pool sb runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then sendMsg (ShowError "Invalid starting block for scan") then sendMsg (ShowError "Invalid starting block for scan")
else do else do

4
src/Zenith/RPC.hs
View file

@ -889,7 +889,7 @@ scanZebra dbPath zHost zPort net = do
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
b <- getMinBirthdayHeight pool b <- getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1 chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
syncChk <- isSyncing pool syncChk <- isSyncing pool
unless syncChk $ do unless syncChk $ do
let sb = let sb =
@ -897,7 +897,7 @@ scanZebra dbPath zHost zPort net = do
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $ unless (chkBlock == dbBlock || chkBlock == 1) $
runStderrLoggingT $ rewindWalletData pool sb runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
unless (sb > zgb_blocks bStatus || sb < 1) $ do unless (sb > zgb_blocks bStatus || sb < 1) $ do
let bList = [(sb + 1) .. (zgb_blocks bStatus)] let bList = [(sb + 1) .. (zgb_blocks bStatus)]
unless (null bList) $ do unless (null bList) $ do

9
src/Zenith/Scanner.hs
View file

@ -246,10 +246,11 @@ checkIntegrity ::
T.Text -- ^ Database path T.Text -- ^ Database path
-> T.Text -- ^ Zebra host -> T.Text -- ^ Zebra host
-> Int -- ^ Zebra port -> Int -- ^ Zebra port
-> ZcashNet -- ^ the network to scan
-> Int -- ^ The block to start the check -> Int -- ^ The block to start the check
-> Int -- ^ depth -> Int -- ^ depth
-> IO Int -> IO Int
checkIntegrity dbP zHost zPort b d = checkIntegrity dbP zHost zPort znet b d =
if b < 1 if b < 1
then return 1 then return 1
else do else do
@ -263,10 +264,10 @@ checkIntegrity dbP zHost zPort b d =
Left e -> throwIO $ userError e Left e -> throwIO $ userError e
Right blk -> do Right blk -> do
pool <- runNoLoggingT $ initPool dbP pool <- runNoLoggingT $ initPool dbP
dbBlk <- getBlock pool b dbBlk <- getBlock pool b $ ZcashNetDB znet
case dbBlk of case dbBlk of
Nothing -> throwIO $ userError "Block mismatch, rescan needed" Nothing -> return 1
Just dbBlk' -> Just dbBlk' ->
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk') if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
then return b then return b
else checkIntegrity dbP zHost zPort (b - 5 * d) (d + 1) else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1)