Compare commits
9 commits
f1daf576cc
...
f309864671
Author | SHA1 | Date | |
---|---|---|---|
f309864671 | |||
13c24ca528 | |||
6be3630fbc | |||
cd4054e052 | |||
57ab57554b | |||
53eac75aa5 | |||
324ed663c3 | |||
9acf18c503 | |||
54d9f20fdd |
4 changed files with 526 additions and 60 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
Loading…
Reference in a new issue