{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} module Zenith.CLI where import Control.Exception (throw) import Control.Monad (void) import Control.Monad.IO.Class (liftIO) 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 , 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 , hLimit , joinBorders , padAll , padBottom , padRight , str , txt , 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 ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Types import Zenith.Core import Zenith.DB 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 | Blank data State = State { _network :: !String , _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 } makeLenses ''State drawUI :: State -> [Widget Name] drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s] where ui :: State -> Widget Name ui st = joinBorders $ withBorderStyle unicode $ B.borderWithLabel (str ("Zenith - " <> 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))) <=> msgBox (st ^. msg) 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 " ] 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" ] 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"] 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) 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.3.0")) <=> C.hCenter (withAttr blinkAttr $ str "Press any key...")) else 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 ^. 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 BT.put nw aL <- use accounts 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 na <- liftIO $ addNewAccount (fs ^. dialogInput) s BT.put na addrL <- use addresses 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) s BT.put nAddr BT.modify $ set dialogBox Blank ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent 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 'w') [] -> do BT.modify $ set inputForm $ updateFormState (DialogInput "New Wallet") $ s ^. inputForm BT.modify $ set dialogBox WName V.EvKey (V.KChar 'a') [] -> do BT.modify $ set inputForm $ updateFormState (DialogInput "New Account") $ s ^. inputForm BT.modify $ set dialogBox AName 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 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 ((show . 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 Nothing -> do print $ "No Zebra node available on port " <> show port <> ". Check your configuration" addNewWallet :: T.Text -> State -> IO State addNewWallet n s = do sP <- generateWalletSeedPhrase let bH = s ^. startBlock let netName = read $ s ^. network r <- saveWallet (s ^. dbPath) $ ZcashWallet n netName 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) r <- saveAccount (s ^. dbPath) $ ZcashAccount (aL' + 1) (entityKey selWallet) n "fakeOrchKey" "fakeSapKey" "fakeTKey" 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 addNewAddress :: T.Text -> State -> IO State addNewAddress n 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) nAddr <- saveAddress (s ^. dbPath) $ WalletAddress (maxAddr + 1) (entityKey selAccount) n (UnifiedAddress MainNet "fakeBstring" "fakeBString" (Just $ TransparentAddress P2PKH MainNet "fakeBString")) 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) ++ ")"