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

fix: chain rewind on data store

Browse source
This commit is contained in:
Rene Vergara 2024-10-16 16:01:45 -05:00
parent 13c24ca528
commit f309864671
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
2 changed files with 187 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

130
src/Zenith/CLI.hs
View file

@ -95,7 +95,10 @@ import ZcashHaskell.Orchard
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Transparent
( decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
@ -823,7 +826,7 @@ scanZebra ::
-> Int
-> BC.BChan Tick
-> ZcashNet
-> NoLoggingT IO ()
-> LoggingT IO ()
scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- liftIO $ runNoLoggingT $ initPool dbP
@ -855,7 +858,7 @@ scanZebra dbP zHost zPort b eChan znet = do
_ <- liftIO $ startSync pool
mapM_ (liftIO . processBlock pool step) bList
confUp <-
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
IO
(Either IOError ())
case confUp of
@ -960,11 +963,11 @@ appEvent (BT.AppEvent t) = do
"pwd"
8080)
selWallet
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0
updatedState <- BT.get
ns <- liftIO $ refreshWallet updatedState
BT.put ns
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
BlankDisplay -> do
case s ^. dialogBox of
@ -989,7 +992,7 @@ appEvent (BT.AppEvent t) = do
_ <-
liftIO $
forkIO $
runNoLoggingT $
runStderrLoggingT $
scanZebra
(s ^. dbPath)
(s ^. zebraHost)
@ -1234,6 +1237,92 @@ appEvent (BT.VtyEvent e) = do
DeshieldForm -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey (V.KChar 'p') [] -> do
if allFieldsValid (s ^. deshieldForm)
then do
pool <-
liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selWal <-
do case L.listSelectedElement $ s ^. wallets of
Nothing -> do
let fWall =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. wallets
case fWall of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
selAcc <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
let fAcc =
L.listSelectedElement $
L.listMoveToBeginning $
s ^. accounts
case fAcc of
Nothing ->
throw $
userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
selAddr <-
do case L.listSelectedElement $ s ^. addresses of
Nothing -> do
let fAddr =
L.listSelectedElement $
L.listMoveToBeginning $
s ^. addresses
case fAddr of
Nothing ->
throw $
userError "Failed to select address"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
fs1 <- BT.zoom deshieldForm $ BT.gets formState
let tAddrMaybe =
Transparent <$>
((decodeTransparentAddress .
E.encodeUtf8 .
encodeTransparentReceiver (s ^. network)) =<<
(t_rec =<<
(isValidUnifiedAddress .
E.encodeUtf8 .
getUA . walletAddressUAddress)
(entityVal selAddr)))
bl <-
liftIO $ getLastSyncBlock pool $ entityKey selWal
case tAddrMaybe of
Nothing -> do
BT.modify $
set
msg
"Failed to obtain transparent address"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
Just tAddr -> do
_ <-
liftIO $
forkIO $
deshieldTransaction
pool
(s ^. eventDispatch)
(s ^. zebraHost)
(s ^. zebraPort)
(s ^. network)
(entityKey selAcc)
bl
(ProposedNote
(ValidAddressAPI tAddr)
(fs1 ^. shAmt)
Nothing)
BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank
else do
BT.modify $ set msg "Invalid inputs"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
ev ->
BT.zoom deshieldForm $ do
handleFormEvent (BT.VtyEvent ev)
@ -1714,7 +1803,7 @@ refreshWallet s = do
Just (j, w1) -> return (j, w1)
Just (k, w) -> return (k, w)
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
let bl = zcashWalletLastSync $ entityVal selWallet
let bl = zcashWalletLastSync $ entityVal $ walList !! ix
addrL <-
if not (null aL)
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
@ -1971,3 +2060,30 @@ shieldTransaction pool chan zHost zPort znet accId bl = do
case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId
deshieldTransaction ::
ConnectionPool
-> BC.BChan Tick
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> ProposedNote
-> IO ()
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
BC.writeBChan chan $ TickMsg "Deshielding funds..."
res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId

64
src/Zenith/DB.hs
View file

@ -2038,6 +2038,36 @@ rewindWalletTransactions pool b = do
delete $ do
_ <- from $ table @UserTx
return ()
oldTxs <-
select $ do
txs <- from $ table @WalletTransaction
where_ $ txs ^. WalletTransactionBlock >. val b
pure txs
let oldKeys = map entityKey oldTxs
delete $ do
x <- from $ table @WalletOrchSpend
where_ $ x ^. WalletOrchSpendTx `in_` valList oldKeys
return ()
delete $ do
x <- from $ table @WalletOrchNote
where_ $ x ^. WalletOrchNoteTx `in_` valList oldKeys
return ()
delete $ do
x <- from $ table @WalletSapNote
where_ $ x ^. WalletSapNoteTx `in_` valList oldKeys
return ()
delete $ do
x <- from $ table @WalletSapSpend
where_ $ x ^. WalletSapSpendTx `in_` valList oldKeys
return ()
delete $ do
x <- from $ table @WalletTrNote
where_ $ x ^. WalletTrNoteTx `in_` valList oldKeys
return ()
delete $ do
x <- from $ table @WalletTrSpend
where_ $ x ^. WalletTrSpendTx `in_` valList oldKeys
return ()
delete $ do
txs <- from $ table @WalletTransaction
where_ $ txs ^. WalletTransactionBlock >. val b
@ -2596,7 +2626,37 @@ rewindWalletData pool b = do
rewindWalletTransactions pool b
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $
flip PS.runSqlPool pool $ do
oldBlocks <-
select $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >. val b
pure blk
let oldBlkKeys = map entityKey oldBlocks
oldTxs <-
select $ do
txs <- from $ table @ZcashTransaction
where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys
pure txs
let oldTxKeys = map entityKey oldTxs
delete $ do
x <- from $ table @TransparentNote
where_ $ x ^. TransparentNoteTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @TransparentSpend
where_ $ x ^. TransparentSpendTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @ShieldOutput
where_ $ x ^. ShieldOutputTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @ShieldSpend
where_ $ x ^. ShieldSpendTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @OrchAction
where_ $ x ^. OrchActionTx `in_` valList oldTxKeys
delete $ do
x <- from $ table @ZcashTransaction
where_ $ x ^. ZcashTransactionId `in_` valList oldTxKeys
delete $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >=. val b
where_ $ blk ^. ZcashBlockHeight >. val b