zenith/src/Zenith/CLI.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

module Zenith.CLI where

import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Data.Maybe (fromMaybe)
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 s =
      joinBorders $
      withBorderStyle unicode $
      B.borderWithLabel (str $ "Zenith - " <> s ^. network) $
      (C.center (listBox "Addresses" (s ^. addresses)) <+>
       B.vBorder <+> C.center (listBox "Transactions" (s ^. transactions))) <=>
      msgBox (s ^. 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 s =
      if s ^. 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 s =
      if s ^. walletBox
        then D.renderDialog
               (D.dialog (Just (str "Create Wallet")) Nothing 50)
               (renderForm $ s ^. walletForm)
        else emptyWidget
    splashDialog :: State -> Widget Name
    splashDialog s =
      if s ^. 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
                       Nothing -> return ()
  where
    printMsg :: String -> BT.EventM Name State ()
    printMsg s = BT.modify $ updateMsg s
    updateMsg :: String -> State -> State
    updateMsg = set msg

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 dbName = 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 $ 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"