zenith/src/Zenith/CLI.hs

658 lines
23 KiB
Haskell

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Zenith.CLI where
import qualified Brick.AttrMap as A
import qualified Brick.Focus as F
import Brick.Forms
( Form(..)
, (@@=)
, editTextField
, focusedFormInputAttr
, handleFormEvent
, newForm
, renderForm
, updateFormState
)
import qualified Brick.Main as M
import qualified Brick.Types as BT
import Brick.Types (Widget)
import Brick.Util (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
, txt
, txtWrap
, txtWrapWith
, vBox
, vLimit
, withAttr
, withBorderStyle
)
import qualified Brick.Widgets.Dialog as D
import qualified Brick.Widgets.List as L
import Control.Exception (throw, throwIO, try)
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Vector as Vec
import Database.Persist
import qualified Graphics.Vty as V
import Lens.Micro ((&), (.~), (^.), set)
import Lens.Micro.Mtl
import Lens.Micro.TH
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Types
import Zenith.Core
import Zenith.DB
import Zenith.Types (PhraseDB(..), UnifiedAddressDB(..), ZcashNetDB(..))
import Zenith.Utils (showAddress)
data Name
= WList
| AList
| AcList
| TList
| HelpDialog
| DialogInputField
deriving (Eq, Show, Ord)
data DialogInput = DialogInput
{ _dialogInput :: !T.Text
} deriving (Show)
makeLenses ''DialogInput
data DialogType
= WName
| AName
| AdName
| WSelect
| ASelect
| Blank
data DisplayType
= AddrDisplay
| MsgDisplay
| PhraseDisplay
| BlankDisplay
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 String)
, _msg :: !String
, _helpBox :: !Bool
, _dialogBox :: !DialogType
, _splashBox :: !Bool
, _inputForm :: !(Form DialogInput () Name)
, _focusRing :: !(F.FocusRing Name)
, _startBlock :: !Int
, _dbPath :: !T.Text
, _displayBox :: !DisplayType
}
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))))) <=>
listAddressBox "Addresses" (st ^. addresses) <+>
B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=>
C.hCenter
(hBox
[ capCommand "W" "allets"
, capCommand "A" "ccounts"
, capCommand "V" "iew address"
, capCommand "Q" "uit"
])
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 $ str "Use arrows to select"
]
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", "q"]
actionList =
map
(hLimit 40 . str)
[ "Open help"
, "Close dialog"
, "Switch wallets"
, "Switch accounts"
, "View address"
, "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
]))
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.4.4.0")) <=>
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
else emptyWidget
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 $
txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
getUA $ walletAddressUAddress $ entityVal a)
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)
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
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))
customAttr :: A.AttrName
customAttr = L.listSelectedAttr <> A.attrName "custom"
titleAttr :: A.AttrName
titleAttr = A.attrName "title"
blinkAttr :: A.AttrName
blinkAttr = A.attrName "blink"
appEvent :: BT.BrickEvent Name e -> BT.EventM Name State ()
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 -> BT.modify $ set displayBox BlankDisplay
MsgDisplay -> BT.modify $ set displayBox BlankDisplay
PhraseDisplay -> 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
Blank -> do
case e of
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
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 'a') [] ->
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)
]
theApp :: M.App State e Name
theApp =
M.App
{ M.appDraw = drawUI
, M.appChooseCursor = M.showFirstCursor
, M.appHandleEvent = appEvent
, M.appStartEvent = return ()
, M.appAttrMap = const theMap
}
runZenithCLI :: T.Text -> Int -> T.Text -> IO ()
runZenithCLI host port dbFilePath = do
w <- checkZebra host port
case (w :: Maybe ZebraGetInfo) of
Just zebra -> do
bc <- checkBlockChain host port
case (bc :: Maybe ZebraGetBlockChainInfo) of
Nothing -> throwIO $ userError "Unable to determine blockchain status"
Just chainInfo -> do
initDb dbFilePath
walList <- getWallets dbFilePath $ zgb_net chainInfo
accList <-
if not (null walList)
then getAccounts dbFilePath $ entityKey $ head walList
else return []
addrList <-
if not (null accList)
then getAddresses dbFilePath $ entityKey $ head accList
else return []
void $
M.defaultMain 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 ["tx1", "tx2", "tx3"]) 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
MsgDisplay
Nothing -> do
print $
"No Zebra node available on port " <>
show port <> ". Check your configuration"
refreshWallet :: State -> IO State
refreshWallet s = 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
aL <- getAccounts (s ^. dbPath) $ entityKey selWallet
addrL <-
if not (null aL)
then getAddresses (s ^. dbPath) $ entityKey $ head aL
else return []
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
return $
(s & accounts .~ aL') & addresses .~ addrL' & msg .~ "Switched to wallet: " ++
T.unpack (zcashWalletName $ entityVal selWallet)
addNewWallet :: T.Text -> State -> IO State
addNewWallet n s = do
sP <- generateWalletSeedPhrase
let bH = s ^. startBlock
let netName = s ^. network
r <-
saveWallet (s ^. dbPath) $
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH
case r of
Nothing -> do
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
Just _ -> do
wL <- getWallets (s ^. dbPath) 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
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 (s ^. dbPath) (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 (s ^. dbPath) zA'
case r of
Nothing ->
return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
Just x -> do
aL <- getAccounts (s ^. dbPath) (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
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 <- getAddresses (s ^. dbPath) $ entityKey selAccount
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
return $
s & addresses .~ aL' & msg .~ "Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
addNewAddress :: T.Text -> Scope -> State -> IO State
addNewAddress n scope s = do
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 (s ^. dbPath) (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 (s ^. dbPath) uA'
case nAddr of
Nothing ->
return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
Just x -> do
addrL <- getAddresses (s ^. dbPath) (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) ++ ")"