zenith/src/Zenith/CLI.hs

{-# 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) ++ ")"