2105 lines
81 KiB
Haskell
2105 lines
81 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Zenith.CLI where
|
|
|
|
import qualified Brick.AttrMap as A
|
|
import qualified Brick.BChan as BC
|
|
import qualified Brick.Focus as F
|
|
import Brick.Forms
|
|
( Form(..)
|
|
, (@@=)
|
|
, allFieldsValid
|
|
, editShowableFieldWithValidate
|
|
, editTextField
|
|
, focusedFormInputAttr
|
|
, handleFormEvent
|
|
, invalidFormInputAttr
|
|
, newForm
|
|
, radioField
|
|
, renderForm
|
|
, setFieldValid
|
|
, updateFormState
|
|
)
|
|
import qualified Brick.Main as M
|
|
import qualified Brick.Types as BT
|
|
import Brick.Types (Widget)
|
|
import Brick.Util (bg, fg, on, style)
|
|
import qualified Brick.Widgets.Border as B
|
|
import Brick.Widgets.Border.Style (unicode, unicodeBold)
|
|
import qualified Brick.Widgets.Center as C
|
|
import Brick.Widgets.Core
|
|
( Padding(..)
|
|
, (<+>)
|
|
, (<=>)
|
|
, emptyWidget
|
|
, fill
|
|
, hBox
|
|
, hLimit
|
|
, joinBorders
|
|
, padAll
|
|
, padBottom
|
|
, padTop
|
|
, setAvailableSize
|
|
, str
|
|
, strWrap
|
|
, strWrapWith
|
|
, txt
|
|
, txtWrap
|
|
, txtWrapWith
|
|
, updateAttrMap
|
|
, vBox
|
|
, vLimit
|
|
, viewport
|
|
, withAttr
|
|
, withBorderStyle
|
|
)
|
|
import qualified Brick.Widgets.Dialog as D
|
|
import qualified Brick.Widgets.Edit as E
|
|
import qualified Brick.Widgets.List as L
|
|
import qualified Brick.Widgets.ProgressBar as P
|
|
import Control.Concurrent (forkIO, threadDelay)
|
|
import Control.Exception (throw, throwIO, try)
|
|
import Control.Monad (forM_, forever, unless, void, when)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Control.Monad.Logger
|
|
( LoggingT
|
|
, NoLoggingT
|
|
, logDebugN
|
|
, runNoLoggingT
|
|
, runStderrLoggingT
|
|
)
|
|
import Data.Aeson
|
|
import Data.HexString (HexString(..), toText)
|
|
import Data.Maybe
|
|
import Data.Scientific (Scientific, scientific)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as E
|
|
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
|
import qualified Data.Vector as Vec
|
|
import Database.Persist
|
|
import Database.Persist.Sqlite
|
|
import qualified Graphics.Vty as V
|
|
import qualified Graphics.Vty.CrossPlatform as VC
|
|
import Lens.Micro ((&), (.~), (^.), set)
|
|
import Lens.Micro.Mtl
|
|
import Lens.Micro.TH
|
|
import System.Hclip
|
|
import Text.Printf
|
|
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
|
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
|
import ZcashHaskell.Orchard
|
|
( getSaplingFromUA
|
|
, isValidUnifiedAddress
|
|
, parseAddress
|
|
)
|
|
import ZcashHaskell.Transparent
|
|
( decodeTransparentAddress
|
|
, encodeTransparentReceiver
|
|
)
|
|
import ZcashHaskell.Types
|
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
|
import Zenith.Core
|
|
import Zenith.DB
|
|
import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
|
|
import Zenith.Types
|
|
( Config(..)
|
|
, HexStringDB(..)
|
|
, PhraseDB(..)
|
|
, PrivacyPolicy(..)
|
|
, ProposedNote(..)
|
|
, ShieldDeshieldOp(..)
|
|
, UnifiedAddressDB(..)
|
|
, ValidAddressAPI(..)
|
|
, ZcashNetDB(..)
|
|
, ZenithStatus(..)
|
|
)
|
|
import Zenith.Utils
|
|
( displayTaz
|
|
, displayZec
|
|
, getChainTip
|
|
, isRecipientValid
|
|
, isRecipientValidGUI
|
|
, jsonNumber
|
|
, showAddress
|
|
, validBarValue
|
|
)
|
|
|
|
data Name
|
|
= WList
|
|
| AList
|
|
| AcList
|
|
| TList
|
|
| HelpDialog
|
|
| DialogInputField
|
|
| RecField
|
|
| AmtField
|
|
| MemoField
|
|
| ABViewport
|
|
| ABList
|
|
| DescripField
|
|
| AddressField
|
|
| PrivacyNoneField
|
|
| PrivacyLowField
|
|
| PrivacyMediumField
|
|
| PrivacyFullField
|
|
| ShieldField
|
|
| DeshieldField
|
|
| TotalTranspField
|
|
| TotalShieldedField
|
|
deriving (Eq, Show, Ord)
|
|
|
|
data DialogInput = DialogInput
|
|
{ _dialogInput :: !T.Text
|
|
} deriving (Show)
|
|
|
|
makeLenses ''DialogInput
|
|
|
|
data SendInput = SendInput
|
|
{ _sendTo :: !T.Text
|
|
, _sendAmt :: !Scientific
|
|
, _sendMemo :: !T.Text
|
|
, _policyField :: !PrivacyPolicy
|
|
} deriving (Show)
|
|
|
|
makeLenses ''SendInput
|
|
|
|
data AdrBookEntry = AdrBookEntry
|
|
{ _descrip :: !T.Text
|
|
, _address :: !T.Text
|
|
} deriving (Show)
|
|
|
|
makeLenses ''AdrBookEntry
|
|
|
|
newtype ShDshEntry = ShDshEntry
|
|
{ _shAmt :: Scientific
|
|
} deriving (Show)
|
|
|
|
makeLenses ''ShDshEntry
|
|
|
|
data DialogType
|
|
= WName
|
|
| AName
|
|
| AdName
|
|
| WSelect
|
|
| ASelect
|
|
| SendTx
|
|
| Blank
|
|
| AdrBook
|
|
| AdrBookForm
|
|
| AdrBookUpdForm
|
|
| AdrBookDelForm
|
|
| DeshieldForm
|
|
| ShieldForm
|
|
|
|
data DisplayType
|
|
= AddrDisplay
|
|
| MsgDisplay
|
|
| PhraseDisplay
|
|
| TxDisplay
|
|
| TxIdDisplay
|
|
| SyncDisplay
|
|
| SendDisplay
|
|
| AdrBookEntryDisplay
|
|
| BlankDisplay
|
|
|
|
data Tick
|
|
= TickVal !Float
|
|
| TickMsg !String
|
|
| TickTx !HexString
|
|
|
|
data DropDownItem =
|
|
DropdownItem String
|
|
|
|
data State = State
|
|
{ _network :: !ZcashNet
|
|
, _wallets :: !(L.List Name (Entity ZcashWallet))
|
|
, _accounts :: !(L.List Name (Entity ZcashAccount))
|
|
, _addresses :: !(L.List Name (Entity WalletAddress))
|
|
, _transactions :: !(L.List Name (Entity UserTx))
|
|
, _msg :: !String
|
|
, _helpBox :: !Bool
|
|
, _dialogBox :: !DialogType
|
|
, _splashBox :: !Bool
|
|
, _inputForm :: !(Form DialogInput () Name)
|
|
, _focusRing :: !(F.FocusRing Name)
|
|
, _startBlock :: !Int
|
|
, _dbPath :: !T.Text
|
|
, _zebraHost :: !T.Text
|
|
, _zebraPort :: !Int
|
|
, _displayBox :: !DisplayType
|
|
, _syncBlock :: !Int
|
|
, _balance :: !Integer
|
|
, _barValue :: !Float
|
|
, _eventDispatch :: !(BC.BChan Tick)
|
|
, _timer :: !Int
|
|
, _txForm :: !(Form SendInput () Name)
|
|
, _abAddresses :: !(L.List Name (Entity AddressBook))
|
|
, _abForm :: !(Form AdrBookEntry () Name)
|
|
, _abCurAdrs :: !T.Text -- used for address book CRUD operations
|
|
, _sentTx :: !(Maybe HexString)
|
|
, _unconfBalance :: !Integer
|
|
, _deshieldForm :: !(Form ShDshEntry () Name)
|
|
, _tBalance :: !Integer
|
|
, _sBalance :: !Integer
|
|
}
|
|
|
|
makeLenses ''State
|
|
|
|
drawUI :: State -> [Widget Name]
|
|
drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|
where
|
|
ui :: State -> Widget Name
|
|
ui st =
|
|
joinBorders $
|
|
withBorderStyle unicode $
|
|
B.borderWithLabel
|
|
(str
|
|
(" Zenith - " <>
|
|
show (st ^. network) <>
|
|
" - " <>
|
|
T.unpack
|
|
(maybe
|
|
"(None)"
|
|
(\(_, w) -> zcashWalletName $ entityVal w)
|
|
(L.listSelectedElement (st ^. wallets))) ++
|
|
" "))
|
|
(C.hCenter
|
|
(str
|
|
("Account: " ++
|
|
T.unpack
|
|
(maybe
|
|
"(None)"
|
|
(\(_, a) -> zcashAccountName $ entityVal a)
|
|
(L.listSelectedElement (st ^. accounts))))) <=>
|
|
C.hCenter
|
|
(str
|
|
("Balance: " ++
|
|
if st ^. network == MainNet
|
|
then displayZec (st ^. balance)
|
|
else displayTaz (st ^. balance))) <=>
|
|
C.hCenter
|
|
(str
|
|
("Unconf: " ++
|
|
if st ^. network == MainNet
|
|
then displayZec (st ^. unconfBalance)
|
|
else displayTaz (st ^. unconfBalance))) <=>
|
|
listAddressBox "Addresses" (st ^. addresses) <+>
|
|
B.vBorder <+>
|
|
(C.hCenter
|
|
(str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
|
|
listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
|
|
(vBox
|
|
[ C.hCenter
|
|
(hBox
|
|
[ capCommand "W" "allets"
|
|
, capCommand "A" "ccounts"
|
|
, capCommand "V" "iew address"
|
|
, capCommand3 "" "S" "end Tx"
|
|
])
|
|
, C.hCenter
|
|
(hBox
|
|
[ capCommand2 "Address " "B" "ook"
|
|
, capCommand2 "s" "H" "ield"
|
|
, capCommand "D" "e-shield"
|
|
, capCommand "Q" "uit"
|
|
, capCommand "?" " Help"
|
|
, str $ show (st ^. timer)
|
|
])
|
|
])
|
|
listBox :: Show e => String -> L.List Name e -> Widget Name
|
|
listBox titleLabel l =
|
|
C.vCenter $
|
|
vBox
|
|
[ C.hCenter
|
|
(B.borderWithLabel (str titleLabel) $
|
|
hLimit 25 $ vLimit 15 $ L.renderList listDrawElement True l)
|
|
, str " "
|
|
, C.hCenter $ str "Select "
|
|
]
|
|
selectListBox ::
|
|
Show e
|
|
=> String
|
|
-> L.List Name e
|
|
-> (Bool -> e -> Widget Name)
|
|
-> Widget Name
|
|
selectListBox titleLabel l drawF =
|
|
vBox
|
|
[ C.hCenter
|
|
(B.borderWithLabel (str titleLabel) $
|
|
hLimit 25 $ vLimit 15 $ L.renderList drawF True l)
|
|
, str " "
|
|
]
|
|
listAddressBox ::
|
|
String -> L.List Name (Entity WalletAddress) -> Widget Name
|
|
listAddressBox titleLabel a =
|
|
C.vCenter $
|
|
vBox
|
|
[ C.hCenter
|
|
(B.borderWithLabel (str titleLabel) $
|
|
hLimit 40 $ vLimit 15 $ L.renderList listDrawAddress True a)
|
|
, str " "
|
|
, C.hCenter
|
|
(hBox
|
|
[ capCommand "↑↓ " "move"
|
|
, capCommand "↲ " "select"
|
|
, capCommand3 "" "Tab" " ->"
|
|
])
|
|
]
|
|
listTxBox ::
|
|
String -> ZcashNet -> L.List Name (Entity UserTx) -> Widget Name
|
|
listTxBox titleLabel znet tx =
|
|
C.vCenter $
|
|
vBox
|
|
[ C.hCenter
|
|
(B.borderWithLabel (str titleLabel) $
|
|
hLimit 50 $ vLimit 15 $ L.renderList (listDrawTx znet) True tx)
|
|
, str " "
|
|
, C.hCenter
|
|
(hBox
|
|
[ capCommand "↑↓ " "move"
|
|
, capCommand "T" "x Display"
|
|
, capCommand3 "" "Tab" " <-"
|
|
])
|
|
]
|
|
helpDialog :: State -> Widget Name
|
|
helpDialog st =
|
|
if st ^. helpBox
|
|
then D.renderDialog
|
|
(D.dialog (Just (str " Commands ")) Nothing 55)
|
|
(vBox ([C.hCenter $ str "Key", B.hBorder] <> keyList) <+>
|
|
vBox ([str "Actions", B.hBorder] <> actionList))
|
|
else emptyWidget
|
|
where
|
|
keyList =
|
|
map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "d", "q"]
|
|
actionList =
|
|
map
|
|
(hLimit 40 . str)
|
|
[ "Open help"
|
|
, "Close dialog"
|
|
, "Switch wallets"
|
|
, "Switch accounts"
|
|
, "View address"
|
|
, "Send Tx"
|
|
, "Address Book"
|
|
, "Shield/De-Shield"
|
|
, "Quit"
|
|
]
|
|
inputDialog :: State -> Widget Name
|
|
inputDialog st =
|
|
case st ^. dialogBox of
|
|
WName ->
|
|
D.renderDialog
|
|
(D.dialog (Just (str " Create Wallet ")) Nothing 50)
|
|
(renderForm $ st ^. inputForm)
|
|
AName ->
|
|
D.renderDialog
|
|
(D.dialog (Just (str " Create Account ")) Nothing 50)
|
|
(renderForm $ st ^. inputForm)
|
|
AdName ->
|
|
D.renderDialog
|
|
(D.dialog (Just (str " Create Address ")) Nothing 50)
|
|
(renderForm $ st ^. inputForm)
|
|
WSelect ->
|
|
D.renderDialog
|
|
(D.dialog (Just (str " Select Wallet ")) Nothing 50)
|
|
(selectListBox " Wallets " (st ^. wallets) listDrawWallet <=>
|
|
C.hCenter
|
|
(hBox
|
|
[ capCommand "↑↓ " "move"
|
|
, capCommand "↲ " "select"
|
|
, capCommand "N" "ew"
|
|
, capCommand "S" "how phrase"
|
|
, xCommand
|
|
]))
|
|
ASelect ->
|
|
D.renderDialog
|
|
(D.dialog (Just (str " Select Account ")) Nothing 50)
|
|
(selectListBox " Accounts " (st ^. accounts) listDrawAccount <=>
|
|
C.hCenter
|
|
(hBox
|
|
[ capCommand "↑↓ " "move"
|
|
, capCommand "↲ " "select"
|
|
, capCommand "N" "ew"
|
|
, xCommand
|
|
]))
|
|
SendTx ->
|
|
D.renderDialog
|
|
(D.dialog (Just (str " Send Transaction ")) Nothing 50)
|
|
(renderForm (st ^. txForm) <=>
|
|
C.hCenter
|
|
(hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
|
|
DeshieldForm ->
|
|
D.renderDialog
|
|
(D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
|
|
(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
|
|
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
|
|
Blank -> emptyWidget
|
|
-- Address Book List
|
|
AdrBook ->
|
|
D.renderDialog
|
|
(D.dialog (Just $ str " Address Book ") Nothing 60)
|
|
(withAttr abDefAttr $
|
|
setAvailableSize (50, 20) $
|
|
viewport ABViewport BT.Vertical $
|
|
vLimit 20 $
|
|
hLimit 50 $
|
|
vBox
|
|
[ vLimit 16 $
|
|
hLimit 50 $
|
|
vBox $ [L.renderList listDrawAB True (s ^. abAddresses)]
|
|
, padTop Max $
|
|
vLimit 4 $
|
|
hLimit 50 $
|
|
withAttr abMBarAttr $
|
|
vBox $
|
|
[ C.hCenter $
|
|
(capCommand "N" "ew Address" <+>
|
|
capCommand "E" "dit Address" <+>
|
|
capCommand3 "" "C" "opy Address")
|
|
, C.hCenter $
|
|
(capCommand "D" "elete Address" <+>
|
|
capCommand "S" "end Zcash" <+> capCommand3 "E" "x" "it")
|
|
]
|
|
])
|
|
-- Address Book new entry form
|
|
AdrBookForm ->
|
|
D.renderDialog
|
|
(D.dialog (Just $ str " New Address Book Entry ") Nothing 50)
|
|
(renderForm (st ^. abForm) <=>
|
|
C.hCenter
|
|
(hBox [capCommand "↲" " Save", capCommand3 "" "<Esc>" " Cancel"]))
|
|
-- Address Book edit/update entry form
|
|
AdrBookUpdForm ->
|
|
D.renderDialog
|
|
(D.dialog (Just $ str " Edit Address Book Entry ") Nothing 50)
|
|
(renderForm (st ^. abForm) <=>
|
|
C.hCenter
|
|
(hBox [capCommand "↲" " Save", capCommand3 "" "<Esc>" " Cancel"]))
|
|
-- Address Book edit/update entry form
|
|
AdrBookDelForm ->
|
|
D.renderDialog
|
|
(D.dialog (Just $ str " Delete Address Book Entry ") Nothing 50)
|
|
(renderForm (st ^. abForm) <=>
|
|
C.hCenter
|
|
(hBox
|
|
[ capCommand "C" "onfirm delete"
|
|
, capCommand3 "" "<Esc>" " Cancel"
|
|
]))
|
|
--
|
|
splashDialog :: State -> Widget Name
|
|
splashDialog st =
|
|
if st ^. splashBox
|
|
then withBorderStyle unicodeBold $
|
|
D.renderDialog
|
|
(D.dialog Nothing Nothing 30)
|
|
(withAttr
|
|
titleAttr
|
|
(str
|
|
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
|
|
C.hCenter
|
|
(withAttr titleAttr (str "Zcash Wallet v0.7.0.0-beta")) <=>
|
|
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
|
|
else emptyWidget
|
|
capCommand3 :: String -> String -> String -> Widget Name
|
|
capCommand3 l h e = hBox [str l, withAttr titleAttr (str h), str e]
|
|
capCommand2 :: String -> String -> String -> Widget Name
|
|
capCommand2 l h e =
|
|
hBox [str l, withAttr titleAttr (str h), str e, str " | "]
|
|
capCommand :: String -> String -> Widget Name
|
|
capCommand k comm = hBox [withAttr titleAttr (str k), str comm, str " | "]
|
|
xCommand :: Widget Name
|
|
xCommand = hBox [str "E", withAttr titleAttr (str "x"), str "it"]
|
|
displayDialog :: State -> Widget Name
|
|
displayDialog st =
|
|
case st ^. displayBox of
|
|
AddrDisplay ->
|
|
case L.listSelectedElement $ st ^. addresses of
|
|
Just (_, a) ->
|
|
withBorderStyle unicodeBold $
|
|
D.renderDialog
|
|
(D.dialog
|
|
(Just $ txt ("Address: " <> walletAddressName (entityVal a)))
|
|
Nothing
|
|
60)
|
|
(padAll 1 $
|
|
B.borderWithLabel
|
|
(str "Unified")
|
|
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
|
getUA $ walletAddressUAddress $ entityVal a) <=>
|
|
B.borderWithLabel
|
|
(str "Legacy Shielded")
|
|
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
|
fromMaybe "None" $
|
|
(getSaplingFromUA .
|
|
E.encodeUtf8 . getUA . walletAddressUAddress)
|
|
(entityVal a)) <=>
|
|
B.borderWithLabel
|
|
(str "Transparent")
|
|
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
|
maybe "None" (encodeTransparentReceiver (st ^. network)) $
|
|
t_rec =<<
|
|
(isValidUnifiedAddress .
|
|
E.encodeUtf8 . getUA . walletAddressUAddress)
|
|
(entityVal a)) <=>
|
|
C.hCenter
|
|
(hBox
|
|
[ str "Copy: "
|
|
, capCommand "U" "nified"
|
|
, capCommand "S" "apling"
|
|
, capCommand "T" "ransparent"
|
|
]) <=>
|
|
C.hCenter xCommand)
|
|
Nothing -> emptyWidget
|
|
PhraseDisplay ->
|
|
case L.listSelectedElement $ st ^. wallets of
|
|
Just (_, w) ->
|
|
withBorderStyle unicodeBold $
|
|
D.renderDialog
|
|
(D.dialog (Just $ txt " Seed Phrase ") Nothing 50)
|
|
(padAll 1 $
|
|
txtWrap $
|
|
E.decodeUtf8Lenient $
|
|
getBytes $ getPhrase $ zcashWalletSeedPhrase $ entityVal w)
|
|
Nothing -> emptyWidget
|
|
MsgDisplay ->
|
|
withBorderStyle unicodeBold $
|
|
D.renderDialog
|
|
(D.dialog (Just $ txt " Message ") Nothing 50)
|
|
(padAll 1 $ strWrap $ st ^. msg)
|
|
TxIdDisplay ->
|
|
withBorderStyle unicodeBold $
|
|
D.renderDialog
|
|
(D.dialog (Just $ txt " Success ") Nothing 50)
|
|
(padAll 1 $
|
|
(txt "Tx ID: " <+>
|
|
txtWrapWith
|
|
(WrapSettings False True NoFill FillAfterFirst)
|
|
(maybe "None" toText (st ^. sentTx))) <=>
|
|
C.hCenter (hBox [capCommand "C" "opy", xCommand]))
|
|
TxDisplay ->
|
|
case L.listSelectedElement $ st ^. transactions of
|
|
Nothing -> emptyWidget
|
|
Just (_, tx) ->
|
|
withBorderStyle unicodeBold $
|
|
D.renderDialog
|
|
(D.dialog (Just $ txt " Transaction ") Nothing 50)
|
|
(padAll
|
|
1
|
|
(str
|
|
("Date: " ++
|
|
show
|
|
(posixSecondsToUTCTime
|
|
(fromIntegral (userTxTime $ entityVal tx)))) <=>
|
|
(str "Tx ID: " <+>
|
|
strWrapWith
|
|
(WrapSettings False True NoFill FillAfterFirst)
|
|
(show (userTxHex $ entityVal tx))) <=>
|
|
str
|
|
("Amount: " ++
|
|
if st ^. network == MainNet
|
|
then displayZec
|
|
(fromIntegral $ userTxAmount $ entityVal tx)
|
|
else displayTaz
|
|
(fromIntegral $ userTxAmount $ entityVal tx)) <=>
|
|
(txt "Memo: " <+>
|
|
txtWrapWith
|
|
(WrapSettings False True NoFill FillAfterFirst)
|
|
(userTxMemo (entityVal tx)))))
|
|
SyncDisplay ->
|
|
withBorderStyle unicodeBold $
|
|
D.renderDialog
|
|
(D.dialog (Just $ txt " Sync ") Nothing 50)
|
|
(padAll
|
|
1
|
|
(updateAttrMap
|
|
(A.mapAttrNames
|
|
[ (barDoneAttr, P.progressCompleteAttr)
|
|
, (barToDoAttr, P.progressIncompleteAttr)
|
|
])
|
|
(P.progressBar
|
|
(Just $ printf "%.2f%%" (st ^. barValue * 100))
|
|
(_barValue st))))
|
|
SendDisplay ->
|
|
withBorderStyle unicodeBold $
|
|
D.renderDialog
|
|
(D.dialog (Just $ txt " Sending Transaction ") Nothing 50)
|
|
(padAll
|
|
1
|
|
(strWrapWith
|
|
(WrapSettings False True NoFill FillAfterFirst)
|
|
(st ^. msg)))
|
|
AdrBookEntryDisplay -> do
|
|
case L.listSelectedElement $ st ^. abAddresses of
|
|
Just (_, a) -> do
|
|
let abentry =
|
|
T.pack $
|
|
" Descr: " ++
|
|
T.unpack (addressBookAbdescrip (entityVal a)) ++
|
|
"\n Address: " ++
|
|
T.unpack (addressBookAbaddress (entityVal a))
|
|
withBorderStyle unicodeBold $
|
|
D.renderDialog
|
|
(D.dialog (Just $ txt " Address Book Entry ") Nothing 60)
|
|
(padAll 1 $
|
|
txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
|
abentry)
|
|
_ -> emptyWidget
|
|
BlankDisplay -> emptyWidget
|
|
|
|
mkInputForm :: DialogInput -> Form DialogInput e Name
|
|
mkInputForm =
|
|
newForm
|
|
[label "Name: " @@= editTextField dialogInput DialogInputField (Just 1)]
|
|
where
|
|
label s w =
|
|
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
|
|
|
mkSendForm :: Integer -> SendInput -> Form SendInput e Name
|
|
mkSendForm bal =
|
|
newForm
|
|
[ label "Privacy Level :" @@=
|
|
radioField
|
|
policyField
|
|
[ (Full, PrivacyFullField, "Full")
|
|
, (Medium, PrivacyMediumField, "Medium")
|
|
, (Low, PrivacyLowField, "Low")
|
|
, (None, PrivacyNoneField, "None")
|
|
]
|
|
, label "To: " @@= editTextField sendTo RecField (Just 1)
|
|
, label "Amount: " @@=
|
|
editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
|
|
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
|
|
]
|
|
where
|
|
isAmountValid :: Integer -> Scientific -> Bool
|
|
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
|
label s w =
|
|
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
|
|
|
mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
|
|
mkDeshieldForm tbal =
|
|
newForm
|
|
[ label "Amount: " @@=
|
|
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
|
|
]
|
|
where
|
|
isAmountValid :: Integer -> Scientific -> Bool
|
|
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
|
label s w =
|
|
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
|
|
|
mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name
|
|
mkNewABForm =
|
|
newForm
|
|
[ label "Descrip: " @@= editTextField descrip DescripField (Just 1)
|
|
, label "Address: " @@= editTextField address AddressField (Just 1)
|
|
]
|
|
where
|
|
label s w =
|
|
padBottom (Pad 1) $ vLimit 1 (hLimit 10 $ str s <+> fill ' ') <+> w
|
|
|
|
listDrawElement :: (Show a) => Bool -> a -> Widget Name
|
|
listDrawElement sel a =
|
|
let selStr s =
|
|
if sel
|
|
then withAttr customAttr (str $ "<" <> s <> ">")
|
|
else str s
|
|
in C.hCenter $ selStr $ show a
|
|
|
|
listDrawWallet :: Bool -> Entity ZcashWallet -> Widget Name
|
|
listDrawWallet sel w =
|
|
let selStr s =
|
|
if sel
|
|
then withAttr customAttr (txt $ "<" <> s <> ">")
|
|
else txt s
|
|
in C.hCenter $ selStr $ zcashWalletName (entityVal w)
|
|
|
|
listDrawAccount :: Bool -> Entity ZcashAccount -> Widget Name
|
|
listDrawAccount sel w =
|
|
let selStr s =
|
|
if sel
|
|
then withAttr customAttr (txt $ "<" <> s <> ">")
|
|
else txt s
|
|
in C.hCenter $ selStr $ zcashAccountName (entityVal w)
|
|
|
|
listDrawAddress :: Bool -> Entity WalletAddress -> Widget Name
|
|
listDrawAddress sel w =
|
|
let selStr s =
|
|
if sel
|
|
then withAttr customAttr (txt $ "<" <> s <> ">")
|
|
else txt s
|
|
in C.hCenter $
|
|
selStr $
|
|
walletAddressName (entityVal w) <>
|
|
": " <> showAddress (walletAddressUAddress (entityVal w))
|
|
|
|
listDrawTx :: ZcashNet -> Bool -> Entity UserTx -> Widget Name
|
|
listDrawTx znet sel tx =
|
|
selStr $
|
|
T.pack
|
|
(show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <>
|
|
" " <> T.pack fmtAmt
|
|
where
|
|
amt = fromIntegral $ userTxAmount $ entityVal tx
|
|
dispAmount =
|
|
if znet == MainNet
|
|
then displayZec amt
|
|
else displayTaz amt
|
|
fmtAmt =
|
|
if amt > 0
|
|
then "↘" <> dispAmount <> " "
|
|
else " " <> dispAmount <> "↗"
|
|
selStr s =
|
|
if sel
|
|
then withAttr customAttr (txt $ "> " <> s)
|
|
else txt $ " " <> s
|
|
|
|
listDrawAB :: Bool -> Entity AddressBook -> Widget Name
|
|
listDrawAB sel ab =
|
|
let selStr s =
|
|
if sel
|
|
then withAttr abSelAttr (txt $ " " <> s)
|
|
else txt $ " " <> s
|
|
in selStr $ addressBookAbdescrip (entityVal ab)
|
|
|
|
customAttr :: A.AttrName
|
|
customAttr = L.listSelectedAttr <> A.attrName "custom"
|
|
|
|
titleAttr :: A.AttrName
|
|
titleAttr = A.attrName "title"
|
|
|
|
blinkAttr :: A.AttrName
|
|
blinkAttr = A.attrName "blink"
|
|
|
|
baseAttr :: A.AttrName
|
|
baseAttr = A.attrName "base"
|
|
|
|
barDoneAttr :: A.AttrName
|
|
barDoneAttr = A.attrName "done"
|
|
|
|
barToDoAttr :: A.AttrName
|
|
barToDoAttr = A.attrName "remaining"
|
|
|
|
abDefAttr :: A.AttrName
|
|
abDefAttr = A.attrName "abdefault"
|
|
|
|
abSelAttr :: A.AttrName
|
|
abSelAttr = A.attrName "abselected"
|
|
|
|
abMBarAttr :: A.AttrName
|
|
abMBarAttr = A.attrName "menubar"
|
|
|
|
scanZebra ::
|
|
T.Text
|
|
-> T.Text
|
|
-> Int
|
|
-> Int
|
|
-> BC.BChan Tick
|
|
-> ZcashNet
|
|
-> NoLoggingT IO ()
|
|
scanZebra dbP zHost zPort b eChan znet = do
|
|
bStatus <- liftIO $ checkBlockChain zHost zPort
|
|
pool <- liftIO $ runNoLoggingT $ initPool dbP
|
|
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
|
|
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort znet dbBlock 1
|
|
syncChk <- liftIO $ isSyncing pool
|
|
if syncChk
|
|
then liftIO $ BC.writeBChan eChan $ TickMsg "Sync alread in progress"
|
|
else do
|
|
logDebugN $
|
|
"dbBlock: " <>
|
|
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
|
|
let sb =
|
|
if chkBlock == dbBlock
|
|
then max dbBlock b
|
|
else max chkBlock b
|
|
when (chkBlock /= dbBlock && chkBlock /= 1) $
|
|
rewindWalletData pool sb $ ZcashNetDB znet
|
|
if sb > zgb_blocks bStatus || sb < 1
|
|
then do
|
|
liftIO $
|
|
BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
|
|
else do
|
|
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
|
if not (null bList)
|
|
then do
|
|
let step =
|
|
(1.0 :: Float) /
|
|
fromIntegral (zgb_blocks bStatus - (sb + 1))
|
|
_ <- liftIO $ startSync pool
|
|
mapM_ (liftIO . processBlock pool step) bList
|
|
confUp <-
|
|
liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
|
|
IO
|
|
(Either IOError ())
|
|
case confUp of
|
|
Left _e0 -> do
|
|
_ <- liftIO $ completeSync pool Failed
|
|
liftIO $
|
|
BC.writeBChan eChan $
|
|
TickMsg "Failed to update unconfirmed transactions"
|
|
Right _ -> do
|
|
logDebugN "Updated confirmations"
|
|
logDebugN "Starting commitment tree update"
|
|
_ <- updateCommitmentTrees pool zHost zPort (ZcashNetDB znet)
|
|
logDebugN "Finished tree update"
|
|
_ <- liftIO $ completeSync pool Successful
|
|
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
|
|
return ()
|
|
else do
|
|
liftIO $ BC.writeBChan eChan $ TickMsg "startSync"
|
|
where
|
|
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
|
processBlock pool step bl = do
|
|
r <-
|
|
liftIO $
|
|
makeZebraCall
|
|
zHost
|
|
zPort
|
|
"getblock"
|
|
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
|
|
case r of
|
|
Left e1 -> do
|
|
_ <- liftIO $ completeSync pool Failed
|
|
liftIO $ BC.writeBChan eChan $ TickMsg e1
|
|
Right blk -> do
|
|
r2 <-
|
|
liftIO $
|
|
makeZebraCall
|
|
zHost
|
|
zPort
|
|
"getblock"
|
|
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
|
|
case r2 of
|
|
Left e2 -> do
|
|
_ <- liftIO $ completeSync pool Failed
|
|
liftIO $ BC.writeBChan eChan $ TickMsg e2
|
|
Right hb -> do
|
|
let blockTime = getBlockTime hb
|
|
bi <-
|
|
saveBlock pool $
|
|
ZcashBlock
|
|
(fromIntegral $ bl_height blk)
|
|
(HexStringDB $ bl_hash blk)
|
|
(fromIntegral $ bl_confirmations blk)
|
|
blockTime
|
|
(ZcashNetDB znet)
|
|
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
|
liftIO $ BC.writeBChan eChan $ TickVal step
|
|
|
|
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
|
|
appEvent (BT.AppEvent t) = do
|
|
s <- BT.get
|
|
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
|
case t of
|
|
TickMsg m -> do
|
|
case s ^. displayBox of
|
|
AddrDisplay -> return ()
|
|
MsgDisplay -> do
|
|
when (m == "startSync") $ do
|
|
selWallet <-
|
|
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
|
|
_ <-
|
|
liftIO $
|
|
runNoLoggingT $
|
|
syncWallet
|
|
(Config
|
|
(s ^. dbPath)
|
|
(s ^. zebraHost)
|
|
(s ^. zebraPort)
|
|
"user"
|
|
"pwd"
|
|
8080)
|
|
selWallet
|
|
updatedState <- BT.get
|
|
ns <- liftIO $ refreshWallet updatedState
|
|
BT.put ns
|
|
BT.modify $ set msg ""
|
|
BT.modify $ set displayBox BlankDisplay
|
|
PhraseDisplay -> return ()
|
|
TxDisplay -> return ()
|
|
TxIdDisplay -> return ()
|
|
SyncDisplay -> return ()
|
|
SendDisplay -> BT.modify $ set msg m
|
|
AdrBookEntryDisplay -> return ()
|
|
BlankDisplay -> return ()
|
|
TickTx txid -> do
|
|
BT.modify $ set sentTx (Just txid)
|
|
BT.modify $ set displayBox TxIdDisplay
|
|
TickVal v -> do
|
|
case s ^. displayBox of
|
|
AddrDisplay -> return ()
|
|
MsgDisplay -> return ()
|
|
PhraseDisplay -> return ()
|
|
TxDisplay -> return ()
|
|
TxIdDisplay -> return ()
|
|
SendDisplay -> return ()
|
|
AdrBookEntryDisplay -> return ()
|
|
SyncDisplay -> do
|
|
if s ^. barValue == 1.0
|
|
then do
|
|
BT.modify $ set msg "Decoding, please wait..."
|
|
BT.modify $ set barValue 0.0
|
|
BT.modify $ set displayBox MsgDisplay
|
|
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
|
|
BlankDisplay -> do
|
|
case s ^. dialogBox of
|
|
AName -> return ()
|
|
AdName -> return ()
|
|
WName -> return ()
|
|
WSelect -> return ()
|
|
ASelect -> return ()
|
|
SendTx -> return ()
|
|
AdrBook -> return ()
|
|
AdrBookForm -> return ()
|
|
AdrBookUpdForm -> return ()
|
|
AdrBookDelForm -> return ()
|
|
DeshieldForm -> return ()
|
|
ShieldForm -> return ()
|
|
Blank -> do
|
|
if s ^. timer == 90
|
|
then do
|
|
BT.modify $ set barValue 0.0
|
|
BT.modify $ set displayBox SyncDisplay
|
|
sBlock <-
|
|
liftIO $
|
|
getMinBirthdayHeight pool (ZcashNetDB $ s ^. network)
|
|
_ <-
|
|
liftIO $
|
|
forkIO $
|
|
runNoLoggingT $
|
|
scanZebra
|
|
(s ^. dbPath)
|
|
(s ^. zebraHost)
|
|
(s ^. zebraPort)
|
|
sBlock
|
|
(s ^. eventDispatch)
|
|
(s ^. network)
|
|
BT.modify $ set timer 0
|
|
return ()
|
|
else BT.modify $ set timer $ 1 + s ^. timer
|
|
appEvent (BT.VtyEvent e) = do
|
|
r <- F.focusGetCurrent <$> use focusRing
|
|
s <- BT.get
|
|
if s ^. splashBox
|
|
then BT.modify $ set splashBox False
|
|
else if s ^. helpBox
|
|
then do
|
|
case e of
|
|
V.EvKey V.KEsc [] -> BT.modify $ set helpBox False
|
|
_ev -> return ()
|
|
else do
|
|
case s ^. displayBox of
|
|
AddrDisplay -> do
|
|
case e of
|
|
V.EvKey (V.KChar 'x') [] ->
|
|
BT.modify $ set displayBox BlankDisplay
|
|
V.EvKey (V.KChar 'u') [] -> do
|
|
case L.listSelectedElement $ s ^. addresses of
|
|
Just (_, a) -> do
|
|
liftIO $
|
|
setClipboard $
|
|
T.unpack $
|
|
getUA $ walletAddressUAddress $ entityVal a
|
|
BT.modify $
|
|
set msg $
|
|
"Copied Unified Address <" ++
|
|
T.unpack (walletAddressName (entityVal a)) ++ ">!"
|
|
BT.modify $ set displayBox MsgDisplay
|
|
Nothing -> return ()
|
|
V.EvKey (V.KChar 's') [] -> do
|
|
case L.listSelectedElement $ s ^. addresses of
|
|
Just (_, a) -> do
|
|
liftIO $
|
|
setClipboard $
|
|
maybe "None" T.unpack $
|
|
getSaplingFromUA $
|
|
E.encodeUtf8 $
|
|
getUA $ walletAddressUAddress $ entityVal a
|
|
BT.modify $
|
|
set msg $
|
|
"Copied Sapling Address <" ++
|
|
T.unpack (walletAddressName (entityVal a)) ++ ">!"
|
|
BT.modify $ set displayBox MsgDisplay
|
|
Nothing -> return ()
|
|
V.EvKey (V.KChar 't') [] -> do
|
|
case L.listSelectedElement $ s ^. addresses of
|
|
Just (_, a) -> do
|
|
liftIO $
|
|
setClipboard $
|
|
T.unpack $
|
|
maybe
|
|
"None"
|
|
(encodeTransparentReceiver (s ^. network)) $
|
|
t_rec =<<
|
|
(isValidUnifiedAddress .
|
|
E.encodeUtf8 . getUA . walletAddressUAddress)
|
|
(entityVal a)
|
|
BT.modify $
|
|
set msg $
|
|
"Copied Transparent Address <" ++
|
|
T.unpack (walletAddressName (entityVal a)) ++ ">!"
|
|
BT.modify $ set displayBox MsgDisplay
|
|
Nothing -> return ()
|
|
_ev -> return ()
|
|
MsgDisplay -> BT.modify $ set displayBox BlankDisplay
|
|
PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
|
|
TxDisplay -> BT.modify $ set displayBox BlankDisplay
|
|
TxIdDisplay -> do
|
|
case e of
|
|
V.EvKey (V.KChar 'x') [] ->
|
|
BT.modify $ set displayBox BlankDisplay
|
|
V.EvKey (V.KChar 'c') [] -> do
|
|
liftIO $
|
|
setClipboard $
|
|
T.unpack $ maybe "None" toText (s ^. sentTx)
|
|
BT.modify $ set msg "Copied transaction ID!"
|
|
_ev -> return ()
|
|
SendDisplay -> BT.modify $ set displayBox BlankDisplay
|
|
SyncDisplay -> BT.modify $ set displayBox BlankDisplay
|
|
AdrBookEntryDisplay -> BT.modify $ set displayBox BlankDisplay
|
|
BlankDisplay -> do
|
|
case s ^. dialogBox of
|
|
WName -> do
|
|
case e of
|
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
|
V.EvKey V.KEnter [] -> do
|
|
fs <- BT.zoom inputForm $ BT.gets formState
|
|
nw <- liftIO $ addNewWallet (fs ^. dialogInput) s
|
|
ns <- liftIO $ refreshWallet nw
|
|
BT.put ns
|
|
aL <- use accounts
|
|
BT.modify $ set displayBox MsgDisplay
|
|
BT.modify $
|
|
set dialogBox $
|
|
if not (null $ L.listElements aL)
|
|
then Blank
|
|
else AName
|
|
ev ->
|
|
BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
|
AName -> do
|
|
case e of
|
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
|
V.EvKey V.KEnter [] -> do
|
|
fs <- BT.zoom inputForm $ BT.gets formState
|
|
ns <-
|
|
liftIO $
|
|
refreshAccount =<<
|
|
addNewAddress "Change" Internal =<<
|
|
addNewAccount (fs ^. dialogInput) s
|
|
BT.put ns
|
|
addrL <- use addresses
|
|
BT.modify $ set displayBox MsgDisplay
|
|
BT.modify $
|
|
set dialogBox $
|
|
if not (null $ L.listElements addrL)
|
|
then Blank
|
|
else AdName
|
|
ev ->
|
|
BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
|
AdName -> do
|
|
case e of
|
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
|
V.EvKey V.KEnter [] -> do
|
|
fs <- BT.zoom inputForm $ BT.gets formState
|
|
nAddr <-
|
|
liftIO $ addNewAddress (fs ^. dialogInput) External s
|
|
BT.put nAddr
|
|
BT.modify $ set displayBox MsgDisplay
|
|
BT.modify $ set dialogBox Blank
|
|
ev ->
|
|
BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
|
WSelect -> do
|
|
case e of
|
|
V.EvKey (V.KChar 'x') [] ->
|
|
BT.modify $ set dialogBox Blank
|
|
V.EvKey V.KEnter [] -> do
|
|
ns <- liftIO $ refreshWallet s
|
|
BT.put ns
|
|
BT.modify $ set dialogBox Blank
|
|
V.EvKey (V.KChar 'n') [] -> do
|
|
BT.modify $
|
|
set inputForm $
|
|
updateFormState (DialogInput " New Wallet ") $
|
|
s ^. inputForm
|
|
BT.modify $ set dialogBox WName
|
|
V.EvKey (V.KChar 's') [] ->
|
|
BT.modify $ set displayBox PhraseDisplay
|
|
ev -> BT.zoom wallets $ L.handleListEvent ev
|
|
ASelect -> do
|
|
case e of
|
|
V.EvKey (V.KChar 'x') [] ->
|
|
BT.modify $ set dialogBox Blank
|
|
V.EvKey V.KEnter [] -> do
|
|
ns <- liftIO $ refreshAccount s
|
|
BT.put ns
|
|
BT.modify $ set dialogBox Blank
|
|
V.EvKey (V.KChar 'n') [] -> do
|
|
BT.modify $
|
|
set inputForm $
|
|
updateFormState (DialogInput " New Account ") $
|
|
s ^. inputForm
|
|
BT.modify $ set dialogBox AName
|
|
ev -> BT.zoom accounts $ L.handleListEvent ev
|
|
SendTx -> do
|
|
case e of
|
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
|
V.EvKey V.KEnter [] -> do
|
|
if allFieldsValid (s ^. txForm)
|
|
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
|
|
fs1 <- BT.zoom txForm $ BT.gets formState
|
|
bl <-
|
|
liftIO $
|
|
getChainTip (s ^. zebraHost) (s ^. zebraPort)
|
|
_ <-
|
|
liftIO $
|
|
forkIO $
|
|
sendTransaction
|
|
pool
|
|
(s ^. eventDispatch)
|
|
(s ^. zebraHost)
|
|
(s ^. zebraPort)
|
|
(s ^. network)
|
|
(entityKey selAcc)
|
|
bl
|
|
(fs1 ^. sendAmt)
|
|
(fs1 ^. sendTo)
|
|
(fs1 ^. sendMemo)
|
|
(fs1 ^. policyField)
|
|
BT.modify $ set msg "Preparing transaction..."
|
|
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 txForm $ do
|
|
handleFormEvent (BT.VtyEvent ev)
|
|
fs <- BT.gets formState
|
|
BT.modify $
|
|
setFieldValid
|
|
(isRecipientValidGUI
|
|
(fs ^. policyField)
|
|
(fs ^. sendTo))
|
|
RecField
|
|
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 $
|
|
getChainTip (s ^. zebraHost) (s ^. zebraPort)
|
|
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)
|
|
AdrBook -> do
|
|
case e of
|
|
V.EvKey (V.KChar 'x') [] ->
|
|
BT.modify $ set dialogBox Blank
|
|
V.EvKey (V.KChar 'c') []
|
|
-- Copy Address to Clipboard
|
|
-> do
|
|
case L.listSelectedElement $ s ^. abAddresses of
|
|
Just (_, a) -> do
|
|
liftIO $
|
|
setClipboard $
|
|
T.unpack $ addressBookAbaddress (entityVal a)
|
|
BT.modify $
|
|
set msg $
|
|
"Address copied to Clipboard from >>\n" ++
|
|
T.unpack (addressBookAbdescrip (entityVal a))
|
|
BT.modify $ set displayBox MsgDisplay
|
|
_any -> do
|
|
BT.modify $
|
|
set msg "Error while copying the address!!"
|
|
BT.modify $ set displayBox MsgDisplay
|
|
-- Send Zcash transaction
|
|
V.EvKey (V.KChar 's') [] -> do
|
|
case L.listSelectedElement $ s ^. abAddresses of
|
|
Just (_, a) -> do
|
|
BT.modify $
|
|
set txForm $
|
|
mkSendForm
|
|
(s ^. balance)
|
|
(SendInput
|
|
(addressBookAbaddress (entityVal a))
|
|
0.0
|
|
""
|
|
Full)
|
|
BT.modify $ set dialogBox SendTx
|
|
_ -> do
|
|
BT.modify $
|
|
set msg "No receiver address available!!"
|
|
BT.modify $ set displayBox MsgDisplay
|
|
-- Edit an entry in Address Book
|
|
V.EvKey (V.KChar 'e') [] -> do
|
|
case L.listSelectedElement $ s ^. abAddresses of
|
|
Just (_, a) -> do
|
|
BT.modify $
|
|
set
|
|
abCurAdrs
|
|
(addressBookAbaddress (entityVal a))
|
|
BT.modify $
|
|
set abForm $
|
|
mkNewABForm
|
|
(AdrBookEntry
|
|
(addressBookAbdescrip (entityVal a))
|
|
(addressBookAbaddress (entityVal a)))
|
|
BT.modify $ set dialogBox AdrBookUpdForm
|
|
_ -> do
|
|
BT.modify $ set dialogBox Blank
|
|
-- Delete an entry from Address Book
|
|
V.EvKey (V.KChar 'd') [] -> do
|
|
case L.listSelectedElement $ s ^. abAddresses of
|
|
Just (_, a) -> do
|
|
BT.modify $
|
|
set
|
|
abCurAdrs
|
|
(addressBookAbaddress (entityVal a))
|
|
BT.modify $
|
|
set abForm $
|
|
mkNewABForm
|
|
(AdrBookEntry
|
|
(addressBookAbdescrip (entityVal a))
|
|
(addressBookAbaddress (entityVal a)))
|
|
BT.modify $ set dialogBox AdrBookDelForm
|
|
_ -> do
|
|
BT.modify $ set dialogBox Blank
|
|
-- Create a new entry in Address Book
|
|
V.EvKey (V.KChar 'n') [] -> do
|
|
BT.modify $
|
|
set abForm $ mkNewABForm (AdrBookEntry "" "")
|
|
BT.modify $ set dialogBox AdrBookForm
|
|
-- Show AddressBook entry data
|
|
V.EvKey V.KEnter [] -> do
|
|
BT.modify $ set displayBox AdrBookEntryDisplay
|
|
-- Process any other event
|
|
ev -> BT.zoom abAddresses $ L.handleListEvent ev
|
|
-- Process new address book entry
|
|
AdrBookForm -> do
|
|
case e of
|
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook
|
|
V.EvKey V.KEnter [] -> do
|
|
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
|
fs <- BT.zoom abForm $ BT.gets formState
|
|
let idescr = T.unpack $ T.strip (fs ^. descrip)
|
|
let iabadr = fs ^. address
|
|
if not (null idescr) && isRecipientValid iabadr
|
|
then do
|
|
res <-
|
|
liftIO $
|
|
saveAdrsInAdrBook pool $
|
|
AddressBook
|
|
(ZcashNetDB (s ^. network))
|
|
(fs ^. descrip)
|
|
(fs ^. address)
|
|
case res of
|
|
Nothing -> do
|
|
BT.modify $
|
|
set
|
|
msg
|
|
("AddressBook Entry already exists: " ++
|
|
T.unpack (fs ^. address))
|
|
BT.modify $ set displayBox MsgDisplay
|
|
Just _ -> do
|
|
BT.modify $
|
|
set
|
|
msg
|
|
("New AddressBook entry created!!\n" ++
|
|
T.unpack (fs ^. address))
|
|
BT.modify $ set displayBox MsgDisplay
|
|
-- case end
|
|
s' <- liftIO $ refreshAddressBook s
|
|
BT.put s'
|
|
BT.modify $ set dialogBox AdrBook
|
|
else do
|
|
BT.modify $ set msg "Invalid or missing data!!: "
|
|
BT.modify $ set displayBox MsgDisplay
|
|
BT.modify $ set dialogBox AdrBookForm
|
|
ev ->
|
|
BT.zoom abForm $ do
|
|
handleFormEvent (BT.VtyEvent ev)
|
|
fs <- BT.gets formState
|
|
BT.modify $
|
|
setFieldValid
|
|
(isRecipientValid (fs ^. address))
|
|
AddressField
|
|
AdrBookUpdForm -> do
|
|
case e of
|
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook
|
|
V.EvKey V.KEnter [] -> do
|
|
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
|
fs <- BT.zoom abForm $ BT.gets formState
|
|
let idescr = T.unpack $ T.strip (fs ^. descrip)
|
|
let iabadr = fs ^. address
|
|
if not (null idescr) && isRecipientValid iabadr
|
|
then do
|
|
res <-
|
|
liftIO $
|
|
updateAdrsInAdrBook
|
|
pool
|
|
(fs ^. descrip)
|
|
(fs ^. address)
|
|
(s ^. abCurAdrs)
|
|
BT.modify $
|
|
set
|
|
msg
|
|
("AddressBook entry modified!!\n" ++
|
|
T.unpack (fs ^. address))
|
|
BT.modify $ set displayBox MsgDisplay
|
|
-- case end
|
|
s' <- liftIO $ refreshAddressBook s
|
|
BT.put s'
|
|
BT.modify $ set dialogBox AdrBook
|
|
else do
|
|
BT.modify $ set msg "Invalid or missing data!!: "
|
|
BT.modify $ set displayBox MsgDisplay
|
|
BT.modify $ set dialogBox AdrBookForm
|
|
ev ->
|
|
BT.zoom abForm $ do
|
|
handleFormEvent (BT.VtyEvent ev)
|
|
fs <- BT.gets formState
|
|
BT.modify $
|
|
setFieldValid
|
|
(isRecipientValid (fs ^. address))
|
|
AddressField
|
|
-- Process delete AddresBook entry
|
|
AdrBookDelForm -> do
|
|
case e of
|
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook
|
|
V.EvKey (V.KChar 'c') [] -> do
|
|
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
|
fs <- BT.zoom abForm $ BT.gets formState
|
|
res <- liftIO $ deleteAdrsFromAB pool (fs ^. address)
|
|
s' <- liftIO $ refreshAddressBook s
|
|
BT.put s'
|
|
BT.modify $ set dialogBox AdrBook
|
|
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
|
|
Blank -> do
|
|
case e of
|
|
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
|
|
V.EvKey V.KEnter [] -> do
|
|
ns <- liftIO $ refreshTxs s
|
|
BT.put ns
|
|
V.EvKey (V.KChar 'q') [] -> M.halt
|
|
V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True
|
|
V.EvKey (V.KChar 'n') [] ->
|
|
BT.modify $ set dialogBox AdName
|
|
V.EvKey (V.KChar 'v') [] ->
|
|
BT.modify $ set displayBox AddrDisplay
|
|
V.EvKey (V.KChar 'w') [] ->
|
|
BT.modify $ set dialogBox WSelect
|
|
V.EvKey (V.KChar 't') [] ->
|
|
BT.modify $ set displayBox TxDisplay
|
|
V.EvKey (V.KChar 'a') [] ->
|
|
BT.modify $ set dialogBox ASelect
|
|
V.EvKey (V.KChar 's') [] -> do
|
|
BT.modify $
|
|
set txForm $
|
|
mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
|
|
BT.modify $ set dialogBox SendTx
|
|
V.EvKey (V.KChar 'b') [] ->
|
|
BT.modify $ set dialogBox AdrBook
|
|
V.EvKey (V.KChar 'd') [] -> 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
|
|
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 ->
|
|
case r of
|
|
Just AList ->
|
|
BT.zoom addresses $ L.handleListEvent ev
|
|
Just TList ->
|
|
BT.zoom transactions $ L.handleListEvent ev
|
|
Just ABList ->
|
|
BT.zoom abAddresses $ L.handleListEvent ev
|
|
_anyName -> return ()
|
|
where
|
|
printMsg :: String -> BT.EventM Name State ()
|
|
printMsg s = BT.modify $ updateMsg s
|
|
updateMsg :: String -> State -> State
|
|
updateMsg = set msg
|
|
-- fs <- BT.gets formState
|
|
-- ev -> BT.zoom shdshForm $ L.handleListEvent ev
|
|
appEvent _ = return ()
|
|
|
|
theMap :: A.AttrMap
|
|
theMap =
|
|
A.attrMap
|
|
V.defAttr
|
|
[ (L.listAttr, V.white `on` V.blue)
|
|
, (L.listSelectedAttr, V.blue `on` V.white)
|
|
, (customAttr, fg V.black)
|
|
, (titleAttr, V.withStyle (fg V.brightGreen) V.bold)
|
|
, (blinkAttr, style V.blink)
|
|
, (focusedFormInputAttr, V.white `on` V.blue)
|
|
, (invalidFormInputAttr, V.red `on` V.black)
|
|
, (E.editAttr, V.white `on` V.black)
|
|
, (E.editFocusedAttr, V.black `on` V.white)
|
|
, (baseAttr, bg V.brightBlack)
|
|
, (barDoneAttr, V.white `on` V.blue)
|
|
, (barToDoAttr, V.white `on` V.black)
|
|
, (abDefAttr, V.white `on` V.blue)
|
|
, (abSelAttr, V.black `on` V.white)
|
|
, (abMBarAttr, V.white `on` V.black)
|
|
]
|
|
|
|
theApp :: M.App State Tick Name
|
|
theApp =
|
|
M.App
|
|
{ M.appDraw = drawUI
|
|
, M.appChooseCursor = M.showFirstCursor
|
|
, M.appHandleEvent = appEvent
|
|
, M.appStartEvent = return ()
|
|
, M.appAttrMap = const theMap
|
|
}
|
|
|
|
runZenithTUI :: Config -> IO ()
|
|
runZenithTUI config = do
|
|
let host = c_zebraHost config
|
|
let port = c_zebraPort config
|
|
let dbFilePath = c_dbPath config
|
|
pool <- runNoLoggingT $ initPool dbFilePath
|
|
w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
|
|
case w of
|
|
Right zebra -> do
|
|
bc <-
|
|
try $ checkBlockChain host port :: IO
|
|
(Either IOError ZebraGetBlockChainInfo)
|
|
case bc of
|
|
Left e1 -> throwIO e1
|
|
Right chainInfo -> do
|
|
x <- initDb dbFilePath
|
|
_ <- upgradeQrTable pool
|
|
case x of
|
|
Left e2 -> throwIO $ userError e2
|
|
Right x' -> do
|
|
when x' $ rescanZebra host port dbFilePath
|
|
walList <- getWallets pool $ zgb_net chainInfo
|
|
accList <-
|
|
if not (null walList)
|
|
then runNoLoggingT $
|
|
getAccounts pool $ entityKey $ head walList
|
|
else return []
|
|
addrList <-
|
|
if not (null accList)
|
|
then runNoLoggingT $
|
|
getAddresses pool $ entityKey $ head accList
|
|
else return []
|
|
txList <-
|
|
if not (null addrList)
|
|
then getUserTx pool $ entityKey $ head addrList
|
|
else return []
|
|
let block =
|
|
if not (null walList)
|
|
then zcashWalletLastSync $ entityVal $ head walList
|
|
else 0
|
|
abookList <- getAdrBook pool $ zgb_net chainInfo
|
|
bal <-
|
|
if not (null accList)
|
|
then getBalance pool $ entityKey $ head accList
|
|
else return 0
|
|
uBal <-
|
|
if not (null accList)
|
|
then getUnconfirmedBalance pool $ entityKey $ head accList
|
|
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
|
|
_ <-
|
|
forkIO $
|
|
forever $ do
|
|
BC.writeBChan eventChan (TickVal 0.0)
|
|
threadDelay 1000000
|
|
let buildVty = VC.mkVty V.defaultConfig
|
|
initialVty <- buildVty
|
|
void $
|
|
M.customMain initialVty buildVty (Just eventChan) theApp $
|
|
State
|
|
(zgb_net chainInfo)
|
|
(L.list WList (Vec.fromList walList) 1)
|
|
(L.list AcList (Vec.fromList accList) 1)
|
|
(L.list AList (Vec.fromList addrList) 1)
|
|
(L.list TList (Vec.fromList txList) 1)
|
|
("Start up Ok! Connected to Zebra " ++
|
|
(T.unpack . zgi_build) zebra ++
|
|
" on port " ++ show port ++ ".")
|
|
False
|
|
(if null walList
|
|
then WName
|
|
else Blank)
|
|
True
|
|
(mkInputForm $ DialogInput "Main")
|
|
(F.focusRing [AList, TList])
|
|
(zgb_blocks chainInfo)
|
|
dbFilePath
|
|
host
|
|
port
|
|
MsgDisplay
|
|
block
|
|
bal
|
|
1.0
|
|
eventChan
|
|
0
|
|
(mkSendForm 0 $ SendInput "" 0.0 "" Full)
|
|
(L.list ABList (Vec.fromList abookList) 1)
|
|
(mkNewABForm (AdrBookEntry "" ""))
|
|
""
|
|
Nothing
|
|
uBal
|
|
(mkDeshieldForm 0 (ShDshEntry 0.0))
|
|
tBal
|
|
sBal
|
|
Left _e -> do
|
|
print $
|
|
"No Zebra node available on port " <>
|
|
show port <> ". Check your configuration."
|
|
|
|
refreshWallet :: State -> IO State
|
|
refreshWallet s = do
|
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
|
walList <- getWallets pool $ s ^. network
|
|
(ix, selWallet) <-
|
|
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 (j, w1)
|
|
Just (k, w) -> return (k, w)
|
|
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
|
|
let bl = zcashWalletLastSync $ entityVal $ walList !! ix
|
|
addrL <-
|
|
if not (null aL)
|
|
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
|
|
else return []
|
|
bal <-
|
|
if not (null aL)
|
|
then getBalance pool $ entityKey $ head aL
|
|
else return 0
|
|
uBal <-
|
|
if not (null aL)
|
|
then getUnconfirmedBalance pool $ entityKey $ head aL
|
|
else return 0
|
|
txL <-
|
|
if not (null addrL)
|
|
then getUserTx pool $ entityKey $ head addrL
|
|
else return []
|
|
let wL = L.listReplace (Vec.fromList walList) (Just ix) (s ^. wallets)
|
|
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
|
|
let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
|
let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions)
|
|
return $
|
|
s & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal &
|
|
unconfBalance .~
|
|
uBal &
|
|
addresses .~
|
|
addrL' &
|
|
transactions .~
|
|
txL' &
|
|
msg .~
|
|
"Switched to wallet: " ++
|
|
T.unpack (zcashWalletName $ entityVal selWallet)
|
|
|
|
addNewWallet :: T.Text -> State -> IO State
|
|
addNewWallet n s = do
|
|
sP <- generateWalletSeedPhrase
|
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
|
let bH = s ^. startBlock
|
|
let netName = s ^. network
|
|
r <- saveWallet pool $ ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
|
|
case r of
|
|
Nothing -> return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
|
|
Just _ -> do
|
|
wL <- getWallets pool netName
|
|
let aL =
|
|
L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $
|
|
L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets)
|
|
return $ s & wallets .~ aL & msg .~ "Created new wallet: " ++ T.unpack n
|
|
|
|
addNewAccount :: T.Text -> State -> IO State
|
|
addNewAccount n s = do
|
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
|
selWallet <-
|
|
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
|
|
aL' <- getMaxAccount pool (entityKey selWallet)
|
|
zA <-
|
|
try $ createZcashAccount n (aL' + 1) selWallet :: IO
|
|
(Either IOError ZcashAccount)
|
|
case zA of
|
|
Left e -> return $ s & msg .~ "Error: " ++ show e
|
|
Right zA' -> do
|
|
r <- saveAccount pool zA'
|
|
case r of
|
|
Nothing -> return $ s & msg .~ "Account already exists: " ++ T.unpack n
|
|
Just x -> do
|
|
aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet)
|
|
let nL =
|
|
L.listMoveToElement x $
|
|
L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
|
|
return $
|
|
s & accounts .~ nL & msg .~ "Created new account: " ++ T.unpack n
|
|
|
|
refreshAccount :: State -> IO State
|
|
refreshAccount s = do
|
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
|
selAccount <-
|
|
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
|
|
aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount
|
|
bal <- getBalance pool $ entityKey selAccount
|
|
uBal <- getUnconfirmedBalance pool $ entityKey selAccount
|
|
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
|
|
selAddress <-
|
|
do case L.listSelectedElement aL' of
|
|
Nothing -> do
|
|
let fAdd = L.listSelectedElement $ L.listMoveToBeginning aL'
|
|
return fAdd
|
|
Just a2 -> return $ Just a2
|
|
case selAddress of
|
|
Nothing ->
|
|
return $
|
|
s & balance .~ bal & unconfBalance .~ uBal & addresses .~ aL' & msg .~
|
|
"Switched to account: " ++
|
|
T.unpack (zcashAccountName $ entityVal selAccount)
|
|
Just (_i, a) -> do
|
|
tList <- getUserTx pool $ entityKey a
|
|
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
|
|
return $
|
|
s & balance .~ bal & unconfBalance .~ uBal & addresses .~ aL' &
|
|
transactions .~
|
|
tL' &
|
|
msg .~
|
|
"Switched to account: " ++
|
|
T.unpack (zcashAccountName $ entityVal selAccount)
|
|
|
|
refreshTxs :: State -> IO State
|
|
refreshTxs s = do
|
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
|
selAddress <-
|
|
do case L.listSelectedElement $ s ^. addresses of
|
|
Nothing -> do
|
|
let fAdd =
|
|
L.listSelectedElement $ L.listMoveToBeginning $ s ^. addresses
|
|
return fAdd
|
|
Just a2 -> return $ Just a2
|
|
case selAddress of
|
|
Nothing -> return s
|
|
Just (_i, a) -> do
|
|
tList <- getUserTx pool $ entityKey a
|
|
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
|
|
return $ s & transactions .~ tL'
|
|
|
|
refreshAddressBook :: State -> IO State
|
|
refreshAddressBook s = do
|
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
|
selAddress <-
|
|
do case L.listSelectedElement $ s ^. abAddresses of
|
|
Nothing -> do
|
|
let fAdd =
|
|
L.listSelectedElement $
|
|
L.listMoveToBeginning $ s ^. abAddresses
|
|
return fAdd
|
|
Just a2 -> return $ Just a2
|
|
abookList <- getAdrBook pool (s ^. network)
|
|
let tL' = L.listReplace (Vec.fromList abookList) (Just 0) (s ^. abAddresses)
|
|
return $ s & abAddresses .~ tL'
|
|
|
|
addNewAddress :: T.Text -> Scope -> State -> IO State
|
|
addNewAddress n scope s = do
|
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
|
selAccount <-
|
|
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, a1) -> return a1
|
|
Just (_k, a) -> return a
|
|
maxAddr <- getMaxAddress pool (entityKey selAccount) scope
|
|
uA <-
|
|
try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO
|
|
(Either IOError WalletAddress)
|
|
case uA of
|
|
Left e -> return $ s & msg .~ "Error: " ++ show e
|
|
Right uA' -> do
|
|
nAddr <- saveAddress pool uA'
|
|
case nAddr of
|
|
Nothing -> return $ s & msg .~ "Address already exists: " ++ T.unpack n
|
|
Just x -> do
|
|
addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount)
|
|
let nL =
|
|
L.listMoveToElement x $
|
|
L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
|
return $
|
|
s & addresses .~ nL & msg .~ "Created new address: " ++
|
|
T.unpack n ++
|
|
"(" ++
|
|
T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")"
|
|
|
|
sendTransaction ::
|
|
ConnectionPool
|
|
-> BC.BChan Tick
|
|
-> T.Text
|
|
-> Int
|
|
-> ZcashNet
|
|
-> ZcashAccountId
|
|
-> Int
|
|
-> Scientific
|
|
-> T.Text
|
|
-> T.Text
|
|
-> PrivacyPolicy
|
|
-> IO ()
|
|
sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
|
|
BC.writeBChan chan $ TickMsg "Preparing transaction..."
|
|
case parseAddress (E.encodeUtf8 ua) of
|
|
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
|
|
Just outUA -> do
|
|
res <-
|
|
runNoLoggingT $
|
|
prepareTxV2
|
|
pool
|
|
zHost
|
|
zPort
|
|
znet
|
|
accId
|
|
bl
|
|
[ ProposedNote
|
|
(ValidAddressAPI outUA)
|
|
amt
|
|
(if memo == ""
|
|
then Nothing
|
|
else Just memo)
|
|
]
|
|
policy
|
|
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
|
|
|
|
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
|