1299 lines
47 KiB
Haskell
1299 lines
47 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
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
|
|
, renderForm
|
|
, setFieldValid
|
|
, updateFormState
|
|
)
|
|
import qualified Brick.Main as M
|
|
import qualified Brick.Types as BT
|
|
import Brick.Types (Widget)
|
|
import Brick.Util (bg, clamp, 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
|
|
, str
|
|
, strWrap
|
|
, strWrapWith
|
|
, txt
|
|
, txtWrap
|
|
, txtWrapWith
|
|
, updateAttrMap
|
|
, vBox
|
|
, vLimit
|
|
, 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 (catch, throw, throwIO, try)
|
|
import Control.Monad (forever, void)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
|
|
import Data.Aeson
|
|
import Data.HexString (toText)
|
|
import Data.Maybe
|
|
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.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
|
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
|
|
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
|
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
|
import ZcashHaskell.Transparent
|
|
( decodeExchangeAddress
|
|
, decodeTransparentAddress
|
|
, encodeTransparentReceiver
|
|
)
|
|
import ZcashHaskell.Types
|
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
|
import Zenith.Core
|
|
import Zenith.DB
|
|
import Zenith.Scanner (processTx)
|
|
import Zenith.Types
|
|
( Config(..)
|
|
, PhraseDB(..)
|
|
, UnifiedAddressDB(..)
|
|
, ZcashNetDB(..)
|
|
)
|
|
import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress)
|
|
|
|
data Name
|
|
= WList
|
|
| AList
|
|
| AcList
|
|
| TList
|
|
| HelpDialog
|
|
| DialogInputField
|
|
| RecField
|
|
| AmtField
|
|
| MemoField
|
|
deriving (Eq, Show, Ord)
|
|
|
|
data DialogInput = DialogInput
|
|
{ _dialogInput :: !T.Text
|
|
} deriving (Show)
|
|
|
|
makeLenses ''DialogInput
|
|
|
|
data SendInput = SendInput
|
|
{ _sendTo :: !T.Text
|
|
, _sendAmt :: !Float
|
|
, _sendMemo :: !T.Text
|
|
} deriving (Show)
|
|
|
|
makeLenses ''SendInput
|
|
|
|
data DialogType
|
|
= WName
|
|
| AName
|
|
| AdName
|
|
| WSelect
|
|
| ASelect
|
|
| SendTx
|
|
| Blank
|
|
|
|
data DisplayType
|
|
= AddrDisplay
|
|
| MsgDisplay
|
|
| PhraseDisplay
|
|
| TxDisplay
|
|
| SyncDisplay
|
|
| SendDisplay
|
|
| BlankDisplay
|
|
|
|
data Tick
|
|
= TickVal !Float
|
|
| TickMsg !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)
|
|
}
|
|
|
|
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))) <=>
|
|
listAddressBox "Addresses" (st ^. addresses) <+>
|
|
B.vBorder <+>
|
|
(C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=>
|
|
listTxBox "Transactions" (st ^. network) (st ^. transactions))) <=>
|
|
C.hCenter
|
|
(hBox
|
|
[ capCommand "W" "allets"
|
|
, capCommand "A" "ccounts"
|
|
, capCommand "V" "iew address"
|
|
, capCommand "S" "end Tx"
|
|
, capCommand2 "Address " "B" "ook"
|
|
, 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"
|
|
, capCommand "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"
|
|
, capCommand "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", "q"]
|
|
actionList =
|
|
map
|
|
(hLimit 40 . str)
|
|
[ "Open help"
|
|
, "Close dialog"
|
|
, "Switch wallets"
|
|
, "Switch accounts"
|
|
, "View address"
|
|
, "Send Tx"
|
|
, "Address Book"
|
|
, "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"]))
|
|
Blank -> emptyWidget
|
|
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.5.2.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)
|
|
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 $ show (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)))
|
|
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 "To: " @@= editTextField sendTo RecField (Just 1)
|
|
, label "Amount: " @@=
|
|
editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
|
|
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
|
|
]
|
|
where
|
|
isAmountValid :: Integer -> Float -> Bool
|
|
isAmountValid b i = (fromIntegral b * 100000000.0) >= i
|
|
label s w =
|
|
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
|
|
|
isRecipientValid :: T.Text -> Bool
|
|
isRecipientValid a =
|
|
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
|
Just _a1 -> True
|
|
Nothing ->
|
|
isValidShieldedAddress (E.encodeUtf8 a) ||
|
|
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
|
Just _a3 -> True
|
|
Nothing ->
|
|
case decodeExchangeAddress a of
|
|
Just _a4 -> True
|
|
Nothing -> False)
|
|
|
|
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
|
|
|
|
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"
|
|
|
|
validBarValue :: Float -> Float
|
|
validBarValue = clamp 0 1
|
|
|
|
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
|
|
scanZebra dbP zHost zPort b eChan = do
|
|
_ <- liftIO $ initDb dbP
|
|
bStatus <- liftIO $ checkBlockChain zHost zPort
|
|
pool <- runNoLoggingT $ initPool dbP
|
|
dbBlock <- runNoLoggingT $ getMaxBlock pool
|
|
let sb = max dbBlock b
|
|
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)]
|
|
let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
|
|
mapM_ (processBlock pool step) bList
|
|
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 $ 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 $ BC.writeBChan eChan $ TickMsg e2
|
|
Right hb -> do
|
|
let blockTime = getBlockTime hb
|
|
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
|
|
bl_txs $ addTime blk blockTime
|
|
liftIO $ BC.writeBChan eChan $ TickVal step
|
|
addTime :: BlockResponse -> Int -> BlockResponse
|
|
addTime bl t =
|
|
BlockResponse
|
|
(bl_confirmations bl)
|
|
(bl_height bl)
|
|
(fromIntegral t)
|
|
(bl_txs bl)
|
|
|
|
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 -> return ()
|
|
PhraseDisplay -> return ()
|
|
TxDisplay -> return ()
|
|
SyncDisplay -> return ()
|
|
SendDisplay -> do
|
|
BT.modify $ set msg m
|
|
BlankDisplay -> return ()
|
|
TickVal v -> do
|
|
case s ^. displayBox of
|
|
AddrDisplay -> return ()
|
|
MsgDisplay -> return ()
|
|
PhraseDisplay -> return ()
|
|
TxDisplay -> return ()
|
|
SendDisplay -> return ()
|
|
SyncDisplay -> do
|
|
if s ^. barValue == 1.0
|
|
then 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 $
|
|
syncWallet
|
|
(Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort))
|
|
selWallet
|
|
BT.modify $ set displayBox BlankDisplay
|
|
BT.modify $ set barValue 0.0
|
|
updatedState <- BT.get
|
|
ns <- liftIO $ refreshWallet updatedState
|
|
BT.put ns
|
|
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 ()
|
|
Blank -> do
|
|
if s ^. timer == 90
|
|
then do
|
|
BT.modify $ set barValue 0.0
|
|
BT.modify $ set displayBox SyncDisplay
|
|
sBlock <- liftIO $ getMinBirthdayHeight pool
|
|
_ <-
|
|
liftIO $
|
|
forkIO $
|
|
scanZebra
|
|
(s ^. dbPath)
|
|
(s ^. zebraHost)
|
|
(s ^. zebraPort)
|
|
sBlock
|
|
(s ^. eventDispatch)
|
|
BT.modify $ set timer 0
|
|
return ()
|
|
else do
|
|
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 [] -> do
|
|
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
|
|
SendDisplay -> BT.modify $ set displayBox BlankDisplay
|
|
SyncDisplay -> 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 $ getLastSyncBlock pool $ entityKey selWal
|
|
_ <-
|
|
liftIO $
|
|
forkIO $
|
|
sendTransaction
|
|
pool
|
|
(s ^. eventDispatch)
|
|
(s ^. zebraHost)
|
|
(s ^. zebraPort)
|
|
(s ^. network)
|
|
(entityKey selAcc)
|
|
bl
|
|
(fs1 ^. sendAmt)
|
|
(fs1 ^. sendTo)
|
|
(fs1 ^. sendMemo)
|
|
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 -> do
|
|
BT.zoom txForm $ do
|
|
handleFormEvent (BT.VtyEvent ev)
|
|
fs <- BT.gets formState
|
|
BT.modify $
|
|
setFieldValid
|
|
(isRecipientValid (fs ^. sendTo))
|
|
RecField
|
|
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 "")
|
|
BT.modify $ set dialogBox SendTx
|
|
V.EvKey (V.KChar 'b') [] ->
|
|
BT.modify $ set dialogBox ASelect
|
|
ev ->
|
|
case r of
|
|
Just AList ->
|
|
BT.zoom addresses $ L.handleListEvent ev
|
|
Just TList ->
|
|
BT.zoom transactions $ 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
|
|
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.blue)
|
|
, (E.editFocusedAttr, V.blue `on` V.white)
|
|
, (baseAttr, bg V.brightBlack)
|
|
, (barDoneAttr, V.white `on` V.blue)
|
|
, (barToDoAttr, 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
|
|
}
|
|
|
|
runZenithCLI :: Config -> IO ()
|
|
runZenithCLI 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
|
|
initDb 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
|
|
bal <-
|
|
if not (null accList)
|
|
then getBalance 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) 0)
|
|
(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 "")
|
|
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 selWallet
|
|
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
|
|
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 &
|
|
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 -> do
|
|
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
|
|
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 & 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 & 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'
|
|
|
|
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
|
|
-> Float
|
|
-> T.Text
|
|
-> T.Text
|
|
-> IO ()
|
|
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
|
|
BC.writeBChan chan $ TickMsg "Preparing transaction..."
|
|
outUA <- parseAddress ua
|
|
res <-
|
|
runFileLoggingT "zenith.log" $
|
|
prepareTx pool zHost zPort znet accId bl amt outUA memo
|
|
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
|
case res of
|
|
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
|
Right rawTx -> do
|
|
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 $ TickMsg $ "Tx ID: " ++ txId
|
|
where
|
|
parseAddress :: T.Text -> IO UnifiedAddress
|
|
parseAddress a =
|
|
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
|
Just a1 -> return a1
|
|
Nothing ->
|
|
case decodeSaplingAddress (E.encodeUtf8 a) of
|
|
Just a2 ->
|
|
return $
|
|
UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
|
|
Nothing ->
|
|
case decodeTransparentAddress (E.encodeUtf8 a) of
|
|
Just a3 ->
|
|
return $
|
|
UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
|
|
Nothing -> throwIO $ userError "Incorrect address"
|