fix: use network for distinguishing blocks
This commit is contained in:
parent
5f2859194b
commit
183b4adf91
6 changed files with 53 additions and 30 deletions
|
@ -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 $
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue