262 lines
8 KiB
Haskell
262 lines
8 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Zenith.CLI where
|
|
|
|
import Control.Monad (void)
|
|
import qualified Data.Text as T
|
|
import qualified Graphics.Vty as V
|
|
import Lens.Micro ((&), (.~), (^.), set)
|
|
import Lens.Micro.Mtl
|
|
import Lens.Micro.TH
|
|
|
|
import qualified Brick.AttrMap as A
|
|
import qualified Brick.Focus as F
|
|
import Brick.Forms
|
|
( Form(..)
|
|
, (@@=)
|
|
, editTextField
|
|
, focusedFormInputAttr
|
|
, handleFormEvent
|
|
, newForm
|
|
, renderForm
|
|
)
|
|
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
|
|
, hLimit
|
|
, joinBorders
|
|
, padAll
|
|
, padBottom
|
|
, padRight
|
|
, str
|
|
, vBox
|
|
, vLimit
|
|
, withAttr
|
|
, withBorderStyle
|
|
)
|
|
import qualified Brick.Widgets.Dialog as D
|
|
import qualified Brick.Widgets.List as L
|
|
import qualified Data.Vector as Vec
|
|
import Database.Persist
|
|
import Network.HTTP.Simple
|
|
import ZcashHaskell.Types
|
|
import Zenith.Core
|
|
import Zenith.DB
|
|
|
|
data Name
|
|
= WList
|
|
| AList
|
|
| TList
|
|
| HelpDialog
|
|
| WalNameField
|
|
deriving (Eq, Show, Ord)
|
|
|
|
data WalletName = WalletName
|
|
{ _walName :: !T.Text
|
|
} deriving (Show)
|
|
|
|
makeLenses ''WalletName
|
|
|
|
data State = State
|
|
{ _network :: !String
|
|
, _wallets :: !(L.List Name (Entity ZcashWallet))
|
|
, _addresses :: !(L.List Name String)
|
|
, _transactions :: !(L.List Name String)
|
|
, _msg :: !String
|
|
, _helpBox :: !Bool
|
|
, _walletBox :: !Bool
|
|
, _splashBox :: !Bool
|
|
, _walletForm :: !(Form WalletName () Name)
|
|
, _focusRing :: !(F.FocusRing Name)
|
|
}
|
|
|
|
makeLenses ''State
|
|
|
|
drawUI :: State -> [Widget Name]
|
|
drawUI s = [splashDialog s, helpDialog s, walletDialog s, ui s]
|
|
where
|
|
ui :: State -> Widget Name
|
|
ui st =
|
|
joinBorders $
|
|
withBorderStyle unicode $
|
|
B.borderWithLabel (str $ "Zenith - " <> st ^. network) $
|
|
(C.center (listBox "Addresses" (st ^. addresses)) <+>
|
|
B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=>
|
|
msgBox (st ^. msg)
|
|
listBox :: String -> L.List Name String -> 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 "
|
|
]
|
|
msgBox :: String -> Widget Name
|
|
msgBox m =
|
|
vBox
|
|
[B.hBorderWithLabel (str "Messages"), hLimit 70 $ padRight Max $ str m]
|
|
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", "c", "q"]
|
|
actionList =
|
|
map
|
|
(hLimit 40 . str)
|
|
["Open help", "Close dialog", "Create Wallet", "Quit"]
|
|
walletDialog :: State -> Widget Name
|
|
walletDialog st =
|
|
if st ^. walletBox
|
|
then D.renderDialog
|
|
(D.dialog (Just (str "Create Wallet")) Nothing 50)
|
|
(renderForm $ st ^. walletForm)
|
|
else 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.1")) <=>
|
|
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
|
|
else emptyWidget
|
|
|
|
mkWalletForm :: WalletName -> Form WalletName e Name
|
|
mkWalletForm =
|
|
newForm [label "Name: " @@= editTextField walName WalNameField (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
|
|
|
|
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
|
|
if s ^. walletBox
|
|
then do
|
|
case e of
|
|
V.EvKey V.KEsc [] -> BT.modify $ set walletBox False
|
|
V.EvKey V.KEnter [] -> do
|
|
BT.modify $ set walletBox False
|
|
fs <- BT.zoom walletForm $ BT.gets formState
|
|
printMsg $
|
|
"Creating new wallet " <> T.unpack (fs ^. walName)
|
|
ev -> BT.zoom walletForm $ handleFormEvent (BT.VtyEvent ev)
|
|
else 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 'c') [] -> BT.modify $ set walletBox True
|
|
V.EvKey (V.KChar 's') [] -> printMsg "You pressed S!"
|
|
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 -> print "Unable to determine blockchain status"
|
|
Just chainInfo -> do
|
|
walList <- getWallets dbFilePath $ zgb_net chainInfo
|
|
void $
|
|
M.defaultMain theApp $
|
|
State
|
|
((show . zgb_net) chainInfo)
|
|
(L.list WList (Vec.fromList walList) 1)
|
|
(L.list AList (Vec.fromList ["addr1", "addr2"]) 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
|
|
(null walList)
|
|
True
|
|
(mkWalletForm $ WalletName "Main")
|
|
(F.focusRing [AList, TList])
|
|
Nothing -> do
|
|
print $
|
|
"No Zebra node available on port " <>
|
|
show port <> ". Check your configuration"
|