Implement wallet and account switching

src/Zenith/CLI.hs

@@ -44,7 +44,9 @@ import Brick.Widgets.Core
   , padBottom
   , padRight
   , str
+  , strWrap
   , txt
+  , txtWrap
   , vBox
   , vLimit
   , withAttr
@@ -55,7 +57,7 @@ import qualified Brick.Widgets.List as L
 import qualified Data.Vector as Vec
 import Database.Persist
 import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
-import ZcashHaskell.Orchard (genOrchardSpendingKey)
+import ZcashHaskell.Orchard (encodeUnifiedAddress, genOrchardSpendingKey)
 import ZcashHaskell.Types
 import Zenith.Core
 import Zenith.DB
@@ -80,8 +82,15 @@ data DialogType
   = WName
   | AName
   | AdName
+  | WSelect
+  | ASelect
   | Blank
 
+data DisplayType
+  = AddrDisplay
+  | MsgDisplay
+  | BlankDisplay
+
 data State = State
   { _network :: !ZcashNet
   , _wallets :: !(L.List Name (Entity ZcashWallet))
@@ -96,12 +105,13 @@ data State = State
   , _focusRing :: !(F.FocusRing Name)
   , _startBlock :: !Int
   , _dbPath :: !T.Text
+  , _displayBox :: !DisplayType
   }
 
 makeLenses ''State
 
 drawUI :: State -> [Widget Name]
-drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
+drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
   where
     ui :: State -> Widget Name
     ui st =
@@ -116,7 +126,7 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
               (maybe
                  "(None)"
                  (\(_, w) -> zcashWalletName $ entityVal w)
-                 (L.listSelectedElement (st ^. wallets))))) $
+                 (L.listSelectedElement (st ^. wallets)))))
         (C.hCenter
            (str
               ("Account: " ++
@@ -126,8 +136,7 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
                     (\(_, a) -> zcashAccountName $ entityVal a)
                     (L.listSelectedElement (st ^. accounts))))) <=>
          listAddressBox "Addresses" (st ^. addresses) <+>
-       B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=>
+         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 $
@@ -138,6 +147,20 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
         , 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 " "
+        , C.hCenter $ str "Select "
+        ]
     listAddressBox ::
          String -> L.List Name (Entity WalletAddress) -> Widget Name
     listAddressBox titleLabel a =
@@ -149,10 +172,6 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
         , 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
@@ -162,11 +181,17 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
                 vBox ([str "Actions", B.hBorder] <> actionList))
         else emptyWidget
       where
-        keyList = map (C.hCenter . str) ["?", "Esc", "c", "q"]
+        keyList = map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "q"]
         actionList =
           map
             (hLimit 40 . str)
-            ["Open help", "Close dialog", "Create Wallet", "Quit"]
+            [ "Open help"
+            , "Close dialog"
+            , "Switch wallets"
+            , "Switch accounts"
+            , "View address"
+            , "Quit"
+            ]
     inputDialog :: State -> Widget Name
     inputDialog st =
       case st ^. dialogBox of
@@ -182,6 +207,14 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
           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)
+        ASelect ->
+          D.renderDialog
+            (D.dialog (Just (str "Select Account")) Nothing 50)
+            (selectListBox "Accounts" (st ^. accounts) listDrawAccount)
         Blank -> emptyWidget
     splashDialog :: State -> Widget Name
     splashDialog st =
@@ -196,6 +229,28 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
                 C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.3.0")) <=>
                 C.hCenter (withAttr blinkAttr $ str "Press any key..."))
         else emptyWidget
+    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 $
+                 txtWrap $
+                 encodeUnifiedAddress $ walletAddressUAddress $ entityVal a)
+            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 =
@@ -262,6 +317,10 @@ appEvent (BT.VtyEvent e) = 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
+               BlankDisplay -> do
                  case s ^. dialogBox of
                    WName -> do
                      case e of
@@ -269,28 +328,34 @@ appEvent (BT.VtyEvent e) = do
                        V.EvKey V.KEnter [] -> do
                          fs <- BT.zoom inputForm $ BT.gets formState
                          nw <- liftIO $ addNewWallet (fs ^. dialogInput) s
-                     BT.put nw
+                         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)
+                       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
+                         ns <- liftIO $ refreshAccount na
+                         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)
+                       ev ->
+                         BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
                    AdName -> do
                      case e of
                        V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
@@ -298,29 +363,57 @@ appEvent (BT.VtyEvent e) = do
                          fs <- BT.zoom inputForm $ BT.gets formState
                          nAddr <- liftIO $ addNewAddress (fs ^. dialogInput) s
                          BT.put nAddr
+                         BT.modify $ set displayBox MsgDisplay
                          BT.modify $ set dialogBox Blank
-                   ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
+                       ev ->
-               Blank -> do
+                         BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
+                   WSelect -> do
                      case e of
-                   V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
+                       V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
-                   V.EvKey (V.KChar 'q') [] -> M.halt
+                       V.EvKey V.KEnter [] -> do
-                   V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True
+                         ns <- liftIO $ refreshWallet s
-                   V.EvKey (V.KChar 'w') [] -> do
+                         BT.put ns
+                         BT.modify $ set dialogBox Blank
+                       V.EvKey (V.KChar 'c') [] -> do
                          BT.modify $
                            set inputForm $
                            updateFormState (DialogInput "New Wallet") $
                            s ^. inputForm
                          BT.modify $ set dialogBox WName
-                   V.EvKey (V.KChar 'a') [] -> do
+                       ev -> BT.zoom wallets $ L.handleListEvent ev
+                   ASelect -> do
+                     case e of
+                       V.EvKey V.KEsc [] -> 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 'c') [] -> 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 AList ->
-                       Just TList -> BT.zoom transactions $ L.handleListEvent ev
+                             BT.zoom addresses $ L.handleListEvent ev
+                           Just TList ->
+                             BT.zoom transactions $ L.handleListEvent ev
                            _anyName -> return ()
   where
     printMsg :: String -> BT.EventM Name State ()
@@ -389,11 +482,34 @@ runZenithCLI host port dbFilePath = do
               (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
@@ -440,6 +556,23 @@ addNewAccount n s = do
           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 -> State -> IO State
 addNewAddress n s = do
   selAccount <-
@@ -452,19 +585,16 @@ addNewAddress n s = do
              Just (_j, a1) -> return a1
          Just (_k, a) -> return a
   maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount)
-  nAddr <-
+  uA <-
-    saveAddress (s ^. dbPath) $
+    try $ createWalletAddress n (maxAddr + 1) (s ^. network) selAccount :: IO
-    WalletAddress
+      (Either IOError WalletAddress)
-      (maxAddr + 1)
+  case uA of
-      (entityKey selAccount)
+    Left e -> return $ s & msg .~ ("Error: " ++ show e)
-      n
+    Right uA' -> do
-      (UnifiedAddress
+      nAddr <- saveAddress (s ^. dbPath) uA'
-         MainNet
-         "fakeBstring"
-         "fakeBString"
-         (Just $ TransparentAddress P2PKH MainNet "fakeBString"))
       case nAddr of
-    Nothing -> return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
+        Nothing ->
+          return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
         Just x -> do
           addrL <- getAddresses (s ^. dbPath) (entityKey selAccount)
           let nL =

src/Zenith/Core.hs

@@ -33,7 +33,7 @@ checkBlockChain ::
   -> IO (Maybe ZebraGetBlockChainInfo)
 checkBlockChain nodeHost nodePort = do
   let f = makeZebraCall nodeHost nodePort
-  result <$> (responseBody <$> f "getblockchaininfo" [])
+  result . responseBody <$> f "getblockchaininfo" []
 
 -- | Generic RPC call function
 connectZebra ::
@@ -71,3 +71,23 @@ createZcashAccount ::
 createZcashAccount n i zw = do
   orSk <- createOrchardSpendingKey (entityVal zw) i
   return $ ZcashAccount i (entityKey zw) n orSk "fakeSapKey" "fakeTkey"
+
+-- * Addresses
+-- | Create a unified address for the given account and index
+createWalletAddress ::
+     T.Text -- ^ The address nickname
+  -> Int -- ^ The address' index
+  -> ZcashNet -- ^ The network for this address
+  -> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
+  -> IO WalletAddress
+createWalletAddress n i zNet za = do
+  return $
+    WalletAddress
+      i
+      (entityKey za)
+      n
+      (UnifiedAddress
+         zNet
+         "fakeBString"
+         "fakeBString"
+         (Just $ TransparentAddress P2PKH zNet "fakeBString"))