zenith/src/Zenith/CLI.hs
2024-02-27 08:41:43 -06:00

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"