Merge pull request 'CLI enhancements to manage lists of items' (#60) from rav001 into dev041

Reviewed-on: #60

CHANGELOG.md

@@ -5,6 +5,15 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
+## [Unreleased]
+
+## Added
+
+- `Core` module
+- `CLI` module
+- `DB` module
+- Command line arguments to switch to legacy version
+
 ## [0.4.1]
 
 ### Fixed

app/Main.hs

@@ -2,7 +2,6 @@
 
 module Main where
 
-import Brick (simpleMain)
 import Control.Monad (void)
 import Control.Monad.IO.Class (liftIO)
 import qualified Data.ByteString as B
@@ -200,6 +199,7 @@ main :: IO ()
 main = do
   config <- load ["zenith.cfg"]
   args <- getArgs
+  dbName <- require config "dbName"
   nodeUser <- require config "nodeUser"
   nodePwd <- require config "nodePwd"
   if not (null args)
@@ -215,7 +215,7 @@ main = do
                     "                         ______          _ _   _    \n                        |___  /         (_) | | |    \n                           / / ___ _ __  _| |_| |__  \n                          / / / _ \\ '_ \\| | __| '_ \\ \n                         / /_|  __/ | | | | |_| | | |\n                        /_____\\___|_| |_|_|\\__|_| |_|\n                         Zcash Full Node CLI v0.4.0"
                 }
               (root nodeUser nodePwd)
-        "cli" -> simpleMain ui
+        "cli" -> runZenithCLI dbName
         _ -> printUsage
     else printUsage
 

package.yaml

@@ -44,6 +44,11 @@ library:
   - persistent-sqlite
   - persistent-template
   - brick
+  - mtl
+  - microlens
+  - microlens-mtl
+  - microlens-th
+  - vty
   - zcash-haskell
 
 executables:

src/Zenith/CLI.hs

@@ -1,13 +1,122 @@
+{-# LANGUAGE TemplateHaskell #-}
+
 module Zenith.CLI where
 
-import Brick (Widget, (<+>), joinBorders, simpleMain, str, withBorderStyle)
-import Brick.Widgets.Border (borderWithLabel, vBorder)
-import Brick.Widgets.Border.Style (unicode)
-import Brick.Widgets.Center (center)
+import Control.Monad (void)
+import Control.Monad.State (modify)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import qualified Graphics.Vty as V
+import Lens.Micro ((^.))
+import Lens.Micro.Mtl
+import Lens.Micro.TH
 
-ui :: Widget ()
-ui =
+import qualified Brick.AttrMap as A
+import qualified Brick.Main as M
+import qualified Brick.Types as BT
+import Brick.Types (Widget)
+import Brick.Util (fg, on)
+import qualified Brick.Widgets.Border as B
+import Brick.Widgets.Border.Style (unicode)
+import qualified Brick.Widgets.Center as C
+import Brick.Widgets.Core
+  ( (<+>)
+  , hLimit
+  , joinBorders
+  , str
+  , vBox
+  , vLimit
+  , withAttr
+  , withBorderStyle
+  )
+import qualified Brick.Widgets.List as L
+import qualified Data.Vector as Vec
+import Zenith.Core
+
+data Name
+  = WList
+  | AList
+  | TList
+  deriving (Eq, Show, Ord)
+
+data State = State
+  { _network :: String
+  , _wallets :: L.List Name String
+  , _addresses :: L.List Name String
+  , _transactions :: L.List Name String
+  } deriving (Show)
+
+makeLenses ''State
+
+drawUI :: State -> [Widget Name]
+drawUI s = [ui s]
+  where
+    ui :: State -> Widget Name
+    ui s =
       joinBorders $
       withBorderStyle unicode $
-  borderWithLabel (str "Zenith") $
-  (center (str "Addresses") <+> vBorder <+> center (str "Transactions"))
+      B.borderWithLabel (str $ "Zenith - " <> s ^. network) $
+      (C.center (listBox "Addresses" (s ^. addresses)) <+>
+       B.vBorder <+> C.center (listBox "Transactions" (s ^. transactions)))
+    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 "
+        ]
+
+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
+
+initialState :: State
+initialState =
+  State
+    "Main"
+    (L.list WList (Vec.fromList ["wall1"]) 1)
+    (L.list AList (Vec.fromList ["addr1", "addr2"]) 1)
+    (L.list TList (Vec.fromList ["tx1", "tx2", "tx3"]) 1)
+
+customAttr :: A.AttrName
+customAttr = L.listSelectedAttr <> A.attrName "custom"
+
+appEvent :: BT.BrickEvent Name e -> BT.EventM Name State ()
+appEvent (BT.VtyEvent e) =
+  case e of
+    V.EvKey V.KEsc [] -> M.halt
+    ev -> BT.zoom addresses $ L.handleListEvent ev
+
+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.cyan)
+    ]
+
+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 -> IO ()
+runZenithCLI dbName = do
+  w <- checkWallets dbName
+  if (null w)
+    then void $ M.defaultMain theApp initialState
+    else do
+      print "No wallet found. Create one? Y/N"

src/Zenith/Core.hs

@@ -0,0 +1,12 @@
+module Zenith.Core where
+
+import qualified Data.Text as T
+import Database.Persist
+import Database.Persist.Sqlite
+import Zenith.DB
+
+checkWallets :: T.Text -> IO [Entity ZcashWallet]
+checkWallets dbName = do
+  runSqlite dbName $ do runMigration migrateAll
+  wallets <- runSqlite dbName $ selectList [ZcashWalletBirthdayHeight >. 0] []
+  return wallets

src/Zenith/DB.hs

@@ -21,7 +21,9 @@ import qualified Data.Text as T
 import Database.Persist
 import Database.Persist.Sqlite
 import Database.Persist.TH
-import ZcashHaskell.Types (Phrase)
+import ZcashHaskell.Types (Phrase, ZcashNet)
+
+derivePersistField "ZcashNet"
 
 share
   [mkPersist sqlSettings, mkMigrate "migrateAll"]
@@ -32,5 +34,6 @@ share
     tPrivateKey BS.ByteString
     birthdayHeight Int
     name T.Text
+    network ZcashNet
     deriving Show
     |]

stack.yaml

@@ -44,9 +44,9 @@ packages:
 # extra-deps: []
 extra-deps:
   - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: 6ea8698ccb5e44f9900ba0e61c6ffe6cba900139
+    commit: c4f345b1deb876e19a51c5f7ae1b4402fae14126
   - git: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
-    commit: fe2df6f7d63272ac147911c1573550bed1d38a37
+    commit: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d
   - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/well-typed/borsh.git

stack.yaml.lock

@@ -5,26 +5,26 @@
 
 packages:
 - completed:
-    commit: 6ea8698ccb5e44f9900ba0e61c6ffe6cba900139
+    commit: c4f345b1deb876e19a51c5f7ae1b4402fae14126
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
     name: zcash-haskell
     pantry-tree:
-      sha256: 0506f9f095dbb134a4e7b3ba73a60a21c6298cbea01409871141b31cd0cf9c46
+      sha256: 1bf709484bc488e51e18aa11001abdc06100ed7086b9bbd765d28c4a3d8e9113
       size: 1366
     version: 0.4.1
   original:
-    commit: 6ea8698ccb5e44f9900ba0e61c6ffe6cba900139
+    commit: c4f345b1deb876e19a51c5f7ae1b4402fae14126
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
 - completed:
-    commit: fe2df6f7d63272ac147911c1573550bed1d38a37
+    commit: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d
     git: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
     name: hexstring
     pantry-tree:
-      sha256: 71f12a60e85f7e1897b07bb2d4c77794faee50df250d68b0c47b3d343dd4625a
+      sha256: 05af6ec085b0c8ac00e0c3043652095a6a9c9d3bd2112ffdcb4c4e28206e0b1c
       size: 741
     version: 0.12.0
   original:
-    commit: fe2df6f7d63272ac147911c1573550bed1d38a37
+    commit: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d
     git: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
 - completed:
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05

zenith.cabal

@@ -26,6 +26,7 @@ source-repository head
 library
   exposed-modules:
       Zenith.CLI
+      Zenith.Core
       Zenith.DB
       Zenith.Types
       Zenith.Utils
@@ -44,6 +45,10 @@ library
     , bytestring
     , http-conduit
     , http-types
+    , microlens
+    , microlens-mtl
+    , microlens-th
+    , mtl
     , persistent
     , persistent-sqlite
     , persistent-template
@@ -54,6 +59,7 @@ library
     , scientific
     , text
     , vector
+    , vty
     , zcash-haskell
   default-language: Haskell2010
 

zenith.cfg

@@ -1,2 +1,3 @@
 nodeUser = "user"
 nodePwd = "superSecret"
+dbName = "zenith.db"