Compare commits

..

9 commits

Author SHA1 Message Date
f309864671
fix: chain rewind on data store 2024-10-16 16:01:45 -05:00
13c24ca528
feat(tui): implement shielding command 2024-10-16 08:48:54 -05:00
6be3630fbc
fix: chain re-org detection 2024-10-16 08:48:22 -05:00
cd4054e052
Merge branch 'rvv001' into rav001 2024-10-15 14:45:58 -05:00
57ab57554b
libs: update zcash-haskell 2024-10-15 10:36:36 -05:00
53eac75aa5 rvv001 - Shield / Deshield Forms
-  Shield form created
	 -  Deshield form created
	 Both forms have the 'Process' button de-activated. Must be linked
	 to the appropiate funciton
2024-10-14 19:42:09 -04:00
324ed663c3 rvv001 - Shield - Deshield process
DeShield form  -  Cancel button moved  to the right of process button
2024-10-11 21:01:50 -04:00
9acf18c503 rvv001 - Shield Zec form updated 2024-10-11 20:12:15 -04:00
54d9f20fdd rvv001 - Shield / De-Shield
GUI - Forms for Shielding and De-shielding created
	 TUI - Form to deshield  is not implemented
2024-10-09 21:02:35 -04:00
4 changed files with 526 additions and 60 deletions

View file

@ -2,6 +2,7 @@
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
module Zenith.CLI where module Zenith.CLI where
@ -62,14 +63,14 @@ import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.ProgressBar as P import qualified Brick.Widgets.ProgressBar as P
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (throw, throwIO, try) import Control.Exception (throw, throwIO, try)
import Control.Monad (forever, unless, void, when) import Control.Monad (forM_, forever, unless, void, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger
( LoggingT ( LoggingT
, NoLoggingT , NoLoggingT
, logDebugN , logDebugN
, runFileLoggingT
, runNoLoggingT , runNoLoggingT
, runStderrLoggingT
) )
import Data.Aeson import Data.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
@ -94,7 +95,10 @@ import ZcashHaskell.Orchard
, isValidUnifiedAddress , isValidUnifiedAddress
, parseAddress , parseAddress
) )
import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Transparent
( decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
@ -169,11 +173,8 @@ data AdrBookEntry = AdrBookEntry
makeLenses ''AdrBookEntry makeLenses ''AdrBookEntry
data ShDshEntry = ShDshEntry newtype ShDshEntry = ShDshEntry
{ _totalTransparent :: !Float { _shAmt :: Float
, _totalShielded :: !Float
, _shieldOp :: !ShieldDeshieldOp
, _shAmt :: !Float
} deriving (Show) } deriving (Show)
makeLenses ''ShDshEntry makeLenses ''ShDshEntry
@ -190,7 +191,8 @@ data DialogType
| AdrBookForm | AdrBookForm
| AdrBookUpdForm | AdrBookUpdForm
| AdrBookDelForm | AdrBookDelForm
| ShieldDeshieldForm | DeshieldForm
| ShieldForm
data DisplayType data DisplayType
= AddrDisplay = AddrDisplay
@ -239,7 +241,9 @@ data State = State
, _abCurAdrs :: !T.Text -- used for address book CRUD operations , _abCurAdrs :: !T.Text -- used for address book CRUD operations
, _sentTx :: !(Maybe HexString) , _sentTx :: !(Maybe HexString)
, _unconfBalance :: !Integer , _unconfBalance :: !Integer
, _shdshForm :: !(Form ShDshEntry () Name) , _deshieldForm :: !(Form ShDshEntry () Name)
, _tBalance :: !Integer
, _sBalance :: !Integer
} }
makeLenses ''State makeLenses ''State
@ -256,11 +260,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(" Zenith - " <> (" Zenith - " <>
show (st ^. network) <> show (st ^. network) <>
" - " <> " - " <>
(T.unpack T.unpack
(maybe (maybe
"(None)" "(None)"
(\(_, w) -> zcashWalletName $ entityVal w) (\(_, w) -> zcashWalletName $ entityVal w)
(L.listSelectedElement (st ^. wallets)))) ++ (L.listSelectedElement (st ^. wallets))) ++
" ")) " "))
(C.hCenter (C.hCenter
(str (str
@ -298,7 +302,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
, C.hCenter , C.hCenter
(hBox (hBox
[ capCommand2 "Address " "B" "ook" [ capCommand2 "Address " "B" "ook"
, capCommand2 "Shield/" "D" "eshield" , capCommand2 "s" "H" "ield"
, capCommand "D" "e-shield"
, capCommand "Q" "uit" , capCommand "Q" "uit"
, capCommand "?" " Help" , capCommand "?" " Help"
, str $ show (st ^. timer) , str $ show (st ^. timer)
@ -427,10 +432,35 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(renderForm (st ^. txForm) <=> (renderForm (st ^. txForm) <=>
C.hCenter C.hCenter
(hBox [capCommand "" "Send", capCommand "<esc> " "Cancel"])) (hBox [capCommand "" "Send", capCommand "<esc> " "Cancel"]))
ShieldDeshieldForm -> DeshieldForm ->
D.renderDialog D.renderDialog
(D.dialog (Just (str " Shield / De-Shield ")) Nothing 50) (D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
(renderForm (st ^. shdshForm) <=> (C.hCenter
(padAll 1 $
vBox
[ str $
"Transparent Bal.: " ++
if st ^. network == MainNet
then displayZec (st ^. tBalance)
else displayTaz (st ^. tBalance)
, str $
"Shielded Bal.: " ++
if st ^. network == MainNet
then displayZec (st ^. sBalance)
else displayTaz (st ^. sBalance)
]) <=>
renderForm (st ^. deshieldForm) <=>
C.hCenter
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
ShieldForm ->
D.renderDialog
(D.dialog (Just (str " Shield ZEC ")) Nothing 50)
(C.hCenter
(str $
"Shield " ++
if st ^. network == MainNet
then displayZec (st ^. tBalance)
else displayTaz (st ^. tBalance) ++ "?") <=>
C.hCenter C.hCenter
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"])) (hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
Blank -> emptyWidget Blank -> emptyWidget
@ -676,27 +706,11 @@ mkSendForm bal =
label s w = label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
mkshieldDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
mkshieldDeshieldForm bal = mkDeshieldForm tbal =
newForm newForm
[ label "Total Transp. : " @@= [ label "Amount: " @@=
editShowableFieldWithValidate editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
totalTransparent
TotalTranspField
(isAmountValid bal)
, label "Total Shielded : " @@=
editShowableFieldWithValidate
totalShielded
TotalShieldedField
(isAmountValid bal)
, label "Select :" @@=
radioField
shieldOp
[ (Shield, ShieldField, "Shield")
, (Deshield, DeshieldField, "De-Shield")
]
, label "Amount: " @@=
editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
] ]
where where
isAmountValid :: Integer -> Float -> Bool isAmountValid :: Integer -> Float -> Bool
@ -812,7 +826,7 @@ scanZebra ::
-> Int -> Int
-> BC.BChan Tick -> BC.BChan Tick
-> ZcashNet -> ZcashNet
-> NoLoggingT IO () -> LoggingT IO ()
scanZebra dbP zHost zPort b eChan znet = do 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
@ -844,7 +858,7 @@ scanZebra dbP zHost zPort b eChan znet = do
_ <- liftIO $ startSync pool _ <- liftIO $ startSync pool
mapM_ (liftIO . processBlock pool step) bList mapM_ (liftIO . processBlock pool step) bList
confUp <- confUp <-
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
IO IO
(Either IOError ()) (Either IOError ())
case confUp of case confUp of
@ -949,11 +963,11 @@ appEvent (BT.AppEvent t) = do
"pwd" "pwd"
8080) 8080)
selWallet selWallet
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0
updatedState <- BT.get updatedState <- BT.get
ns <- liftIO $ refreshWallet updatedState ns <- liftIO $ refreshWallet updatedState
BT.put ns BT.put ns
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue) else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
BlankDisplay -> do BlankDisplay -> do
case s ^. dialogBox of case s ^. dialogBox of
@ -967,7 +981,8 @@ appEvent (BT.AppEvent t) = do
AdrBookForm -> return () AdrBookForm -> return ()
AdrBookUpdForm -> return () AdrBookUpdForm -> return ()
AdrBookDelForm -> return () AdrBookDelForm -> return ()
ShieldDeshieldForm -> return () DeshieldForm -> return ()
ShieldForm -> return ()
Blank -> do Blank -> do
if s ^. timer == 90 if s ^. timer == 90
then do then do
@ -977,7 +992,7 @@ appEvent (BT.AppEvent t) = do
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
runNoLoggingT $ runStderrLoggingT $
scanZebra scanZebra
(s ^. dbPath) (s ^. dbPath)
(s ^. zebraHost) (s ^. zebraHost)
@ -1219,11 +1234,98 @@ appEvent (BT.VtyEvent e) = do
(fs ^. policyField) (fs ^. policyField)
(fs ^. sendTo)) (fs ^. sendTo))
RecField RecField
ShieldDeshieldForm -> do DeshieldForm -> do
case e of case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank 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 -> ev ->
BT.zoom shdshForm $ do handleFormEvent (BT.VtyEvent ev) BT.zoom deshieldForm $ do
handleFormEvent (BT.VtyEvent ev)
AdrBook -> do AdrBook -> do
case e of case e of
V.EvKey (V.KChar 'x') [] -> V.EvKey (V.KChar 'x') [] ->
@ -1407,6 +1509,53 @@ appEvent (BT.VtyEvent e) = do
BT.put s' BT.put s'
BT.modify $ set dialogBox AdrBook BT.modify $ set dialogBox AdrBook
ev -> BT.modify $ set dialogBox AdrBookDelForm ev -> BT.modify $ set dialogBox AdrBookDelForm
ShieldForm -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey (V.KChar 'p') [] -> 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 account"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
bl <- liftIO $ getLastSyncBlock pool $ entityKey selWal
_ <-
liftIO $
forkIO $
shieldTransaction
pool
(s ^. eventDispatch)
(s ^. zebraHost)
(s ^. zebraPort)
(s ^. network)
(entityKey selAcc)
bl
BT.modify $ set msg "Preparing transaction..."
BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank
ev ->
BT.zoom deshieldForm $ do
handleFormEvent (BT.VtyEvent ev)
-- Process any other event -- Process any other event
Blank -> do Blank -> do
case e of case e of
@ -1444,11 +1593,46 @@ appEvent (BT.VtyEvent e) = do
case fAcc of case fAcc of
Nothing -> Nothing ->
throw $ throw $
userError "Failed to select wallet" userError "Failed to select account"
Just (_j, w1) -> return w1 Just (_j, w1) -> return w1
Just (_k, w) -> return w Just (_k, w) -> return w
c <- liftIO $ getPoolBalance pool $ entityKey selAcc tBal <-
BT.modify $ set dialogBox ShieldDeshieldForm liftIO $
getTransparentBalance pool $ entityKey selAcc
sBal <-
liftIO $ getShieldedBalance pool $ entityKey selAcc
BT.modify $ set tBalance tBal
BT.modify $ set sBalance sBal
BT.modify $
set deshieldForm $
mkDeshieldForm sBal (ShDshEntry 0.0)
BT.modify $ set dialogBox DeshieldForm
V.EvKey (V.KChar 'h') [] -> do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
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 account"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
tBal <-
liftIO $
getTransparentBalance pool $ entityKey selAcc
BT.modify $ set tBalance tBal
if tBal > 20000
then BT.modify $ set dialogBox ShieldForm
else do
BT.modify $
set
msg
"Not enough transparent funds in this account"
BT.modify $ set displayBox MsgDisplay
ev -> ev ->
case r of case r of
Just AList -> Just AList ->
@ -1547,6 +1731,14 @@ runZenithTUI config = do
if not (null accList) if not (null accList)
then getUnconfirmedBalance pool $ entityKey $ head accList then getUnconfirmedBalance pool $ entityKey $ head accList
else return 0 else return 0
tBal <-
if not (null accList)
then getTransparentBalance pool $ entityKey $ head accList
else return 0
sBal <-
if not (null accList)
then getShieldedBalance pool $ entityKey $ head accList
else return 0
eventChan <- BC.newBChan 10 eventChan <- BC.newBChan 10
_ <- _ <-
forkIO $ forkIO $
@ -1560,7 +1752,7 @@ runZenithTUI config = do
State State
(zgb_net chainInfo) (zgb_net chainInfo)
(L.list WList (Vec.fromList walList) 1) (L.list WList (Vec.fromList walList) 1)
(L.list AcList (Vec.fromList accList) 0) (L.list AcList (Vec.fromList accList) 1)
(L.list AList (Vec.fromList addrList) 1) (L.list AList (Vec.fromList addrList) 1)
(L.list TList (Vec.fromList txList) 1) (L.list TList (Vec.fromList txList) 1)
("Start up Ok! Connected to Zebra " ++ ("Start up Ok! Connected to Zebra " ++
@ -1589,7 +1781,9 @@ runZenithTUI config = do
"" ""
Nothing Nothing
uBal uBal
(mkshieldDeshieldForm 0 (ShDshEntry 0 0 Shield 0.0)) (mkDeshieldForm 0 (ShDshEntry 0.0))
tBal
sBal
Left _e -> do Left _e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>
@ -1609,7 +1803,7 @@ refreshWallet s = do
Just (j, w1) -> return (j, w1) Just (j, w1) -> return (j, w1)
Just (k, w) -> return (k, w) Just (k, w) -> return (k, w)
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
let bl = zcashWalletLastSync $ entityVal selWallet let bl = zcashWalletLastSync $ entityVal $ walList !! ix
addrL <- addrL <-
if not (null aL) if not (null aL)
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
@ -1840,3 +2034,56 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
case resp of case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1 Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId Right txId -> BC.writeBChan chan $ TickTx txId
shieldTransaction ::
ConnectionPool
-> BC.BChan Tick
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> IO ()
shieldTransaction pool chan zHost zPort znet accId bl = do
BC.writeBChan chan $ TickMsg "Preparing shielding transaction..."
res <- runNoLoggingT $ shieldTransparentNotes pool zHost zPort znet accId bl
forM_ res $ \case
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
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

View file

@ -2030,6 +2030,51 @@ getUnconfPoolBalance pool za = do
let oBal = sum oAmts let oBal = sum oAmts
return $ AccountBalance tBal sBal oBal return $ AccountBalance tBal sBal oBal
rewindWalletTransactions :: ConnectionPool -> Int -> IO ()
rewindWalletTransactions pool b = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ 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
return ()
update $ \w -> do
set w [ZcashWalletLastSync =. val b]
clearWalletTransactions :: ConnectionPool -> IO () clearWalletTransactions :: ConnectionPool -> IO ()
clearWalletTransactions pool = do clearWalletTransactions pool = do
runNoLoggingT $ runNoLoggingT $
@ -2578,10 +2623,40 @@ completeSync pool st = do
-- | Rewind the data store to a given block height -- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> IO () rewindWalletData :: ConnectionPool -> Int -> IO ()
rewindWalletData pool b = do rewindWalletData pool b = do
rewindWalletTransactions pool b
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ flip PS.runSqlPool pool $ do
delete $ do oldBlocks <-
blk <- from $ table @ZcashBlock select $ do
where_ $ blk ^. ZcashBlockHeight >=. val b blk <- from $ table @ZcashBlock
clearWalletTransactions pool 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

View file

@ -126,6 +126,10 @@ data AppEvent
| DeleteABEntry !T.Text | DeleteABEntry !T.Text
| UpdateABDescrip !T.Text !T.Text | UpdateABDescrip !T.Text !T.Text
| ResetRecipientValid | ResetRecipientValid
| ShowShield
| CloseShield
| ShowDeShield
| CloseDeShield
deriving (Eq, Show) deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
@ -179,6 +183,12 @@ data AppModel = AppModel
, _showABAddress :: !Bool , _showABAddress :: !Bool
, _updateABAddress :: !Bool , _updateABAddress :: !Bool
, _privacyChoice :: !PrivacyPolicy , _privacyChoice :: !PrivacyPolicy
, _shieldZec :: !Bool
, _deShieldZec :: !Bool
, _tBalance :: !Integer
, _tBalanceValid :: !Bool
, _sBalance :: !Integer
, _sBalanceValid :: !Bool
} deriving (Eq, Show) } deriving (Eq, Show)
makeLenses ''AppModel makeLenses ''AppModel
@ -228,6 +238,8 @@ buildUI wenv model = widgetTree
, updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible` , updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible`
model ^. model ^.
updateABAddress updateABAddress
, shieldOverlay `nodeVisible` model ^. shieldZec
, deShieldOverlay `nodeVisible` model ^. deShieldZec
, msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB) , msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
] ]
mainWindow = mainWindow =
@ -293,6 +305,10 @@ buildUI wenv model = widgetTree
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowAdrBook] (label "Address Book") `styleBasic` , box_ [alignLeft, onClick ShowAdrBook] (label "Address Book") `styleBasic`
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowShield] (label "Shield ZEC") `styleBasic`
[bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowDeShield] (label "De-Shield ZEC") `styleBasic`
[bgColor white, borderB 1 gray, padding 3]
]) `styleBasic` ]) `styleBasic`
[bgColor btnColor, padding 3] [bgColor btnColor, padding 3]
newBox = newBox =
@ -958,7 +974,125 @@ buildUI wenv model = widgetTree
, label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline] , label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
, filler , filler
] ]
shieldOverlay =
box
(vstack
[ filler
, hstack
[ filler
, box_
[]
(vstack
[ box_
[alignMiddle]
(label "Shield Zcash" `styleBasic`
[textFont "Bold", textSize 12])
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, hstack
[ filler
, label ("Amount : " ) `styleBasic`
[width 50, textFont "Bold"]
, spacer
, label (displayAmount (model ^. network) 100 ) `styleBasic`
[width 50, textFont "Bold"]
, filler
-- , spacer
-- , numericField_
-- sendAmount
-- [ decimals 8
-- , minValue 0.0
-- , maxValue
-- (fromIntegral (model ^. tBalance) / 100000000.0)
-- , validInput tBalanceValid
-- , onChange CheckAmount
-- ] `styleBasic`
-- [ width 150
-- , styleIf
-- (not $ model ^. tBalanceValid)
-- (textColor red)
-- ]
]
, spacer
, box_
[alignMiddle]
(hstack
[ filler
, mainButton "Proceed" NotImplemented `nodeEnabled` True
-- (model ^. amountValid && model ^. recipientValid)
, spacer
, mainButton "Cancel" CloseShield `nodeEnabled` True
, filler
])
]) `styleBasic`
[radius 4, border 2 btnColor, bgColor white, padding 4]
, filler
]
, filler
]) `styleBasic`
[bgColor (white & L.a .~ 0.5)]
deShieldOverlay =
box
(vstack
[ filler
, hstack
[ filler
, box_
[]
(vstack
[ box_
[alignMiddle]
(label "De-Shield Zcash" `styleBasic`
[textFont "Bold", textSize 12])
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, hstack
[ (label "Total Transparent : " `styleBasic` [ textFont "Bold" ])
, (label "0.00" )
]
, spacer
, hstack
[ (label "Total Shielded : " `styleBasic` [ textFont "Bold" ])
, (label "0.00" )
]
, spacer
, hstack
[ label "Amount:" `styleBasic`
[width 50, textFont "Bold"]
, spacer
, numericField_
sendAmount
[ decimals 8
, minValue 0.0
, maxValue
(fromIntegral (model ^. sBalance) / 100000000.0)
, validInput sBalanceValid
, onChange CheckAmount
] `styleBasic`
[ width 150
, styleIf
(not $ model ^. sBalanceValid)
(textColor red)
]
]
, spacer
, box_
[alignMiddle]
(hstack
[ filler
, mainButton "Proceed" NotImplemented `nodeEnabled` True
-- (model ^. amountValid && model ^. recipientValid)
, spacer
, mainButton "Cancel" CloseDeShield `nodeEnabled` True
, filler
])
]) `styleBasic`
[radius 4, border 2 btnColor, bgColor white, padding 4]
, filler
]
, filler
]) `styleBasic`
[bgColor (white & L.a .~ 0.5)]
notImplemented = NotImplemented notImplemented = NotImplemented
generateQRCodes :: Config -> IO () generateQRCodes :: Config -> IO ()
@ -1348,6 +1482,10 @@ handleEvent wenv node model evt =
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
] ]
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False] CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
ShowShield -> [ Model $ model & shieldZec .~ True & menuPopup .~ False ]
CloseShield -> [Model $ model & shieldZec .~ False]
ShowDeShield -> [ Model $ model & deShieldZec .~ True & menuPopup .~ False ]
CloseDeShield -> [Model $ model & deShieldZec .~ False]
LoadAbList a -> [Model $ model & abaddressList .~ a] LoadAbList a -> [Model $ model & abaddressList .~ a]
UpdateABDescrip d a -> UpdateABDescrip d a ->
[ Task $ updAddrBookDescrip (model ^. configuration) d a [ Task $ updAddrBookDescrip (model ^. configuration) d a
@ -1724,6 +1862,12 @@ runZenithGUI config = do
False False
False False
Full Full
False
False
0
False
0
False
startApp model handleEvent buildUI (params hD) startApp model handleEvent buildUI (params hD)
Left _e -> print "Zebra not available" Left _e -> print "Zebra not available"
where where

@ -1 +1 @@
Subproject commit 003293cc3f978c146824d0695c5c458cf2cc9bb5 Subproject commit 396f15140a00fd9a00f06c89910f76a22354e8d8