Add account selector

src/Zenith/GUI.hs

@@ -46,8 +46,10 @@ data AppEvent
   | SetPool !ZcashPool
   | SwitchQr !(Maybe QrCode)
   | SwitchAddr !Int
+  | SwitchAcc !Int
   | CopyAddr !(Maybe (Entity WalletAddress))
   | LoadTxs ![Entity UserTx]
+  | LoadAddrs ![Entity WalletAddress]
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -67,6 +69,7 @@ data AppModel = AppModel
   , _unconfBalance :: !(Maybe Integer)
   , _selPool :: !ZcashPool
   , _qrCodeWidget :: !(Maybe QrCode)
+  , _accPopup :: !Bool
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -115,9 +118,12 @@ buildUI wenv model = widgetTree
         [ box_ [onClick WalletClicked, alignMiddle] walletButton `styleBasic`
           [cursorHand, height 25, padding 3] `styleHover`
           [bgColor btnHiLite]
-        , box_ [onClick AccountClicked, alignMiddle] accountButton `styleBasic`
+        , vstack
-          [cursorHand, height 25, padding 3] `styleHover`
+            [ box_ [onClick AccountClicked, alignMiddle] accountButton `styleBasic`
-          [bgColor btnHiLite]
+              [cursorHand, height 25, padding 3] `styleHover`
+              [bgColor btnHiLite]
+            , popup accPopup accListPopup
+            ]
         , filler
         , remixIcon remixErrorWarningFill `styleBasic` [textColor white]
         , label "Testnet" `styleBasic` [textColor white] `nodeVisible`
@@ -138,6 +144,20 @@ buildUI wenv model = widgetTree
           [textFont "Regular", textColor white]
         , remixIcon remixArrowRightWideLine `styleBasic` [textColor white]
         ]
+    accListPopup =
+      box_ [alignMiddle] dispAccList `styleBasic` [bgColor btnColor, padding 3]
+    dispAccList = vstack (zipWith accRow [0 ..] (model ^. accounts))
+    accRow :: Int -> Entity ZcashAccount -> WidgetNode AppModel AppEvent
+    accRow idx wAcc =
+      box_
+        [onClick $ SwitchAcc idx, alignLeft]
+        (label (zcashAccountName (entityVal wAcc))) `styleBasic`
+      [ padding 1
+      , borderB 1 gray
+      , bgColor white
+      , styleIf (model ^. selAcc == idx) (borderL 2 btnHiLite)
+      , styleIf (model ^. selAcc == idx) (borderR 2 btnHiLite)
+      ]
     mainPane = box_ [alignMiddle] $ hstack [addressBox, txBox]
     balanceBox =
       hstack
@@ -415,7 +435,7 @@ handleEvent wenv node model evt =
     AppInit -> []
     ShowMsg t -> [Model $ model & msg ?~ t]
     WalletClicked -> [Model $ model & msg ?~ "You clicked Wallet!"]
-    AccountClicked -> [Model $ model & msg ?~ "You clicked Account!"]
+    AccountClicked -> [Model $ model & accPopup .~ True]
     SetPool p ->
       [ Model $ model & selPool .~ p
       , Task $
@@ -433,6 +453,16 @@ handleEvent wenv node model evt =
       ]
     SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
     SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard]
+    SwitchAcc i ->
+      [ Model $ model & selAcc .~ i
+      , Task $
+        LoadAddrs <$> do
+          dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
+          case selectAccount i of
+            Nothing -> return []
+            Just acc -> runNoLoggingT $ getAddresses dbPool $ entityKey acc
+      , Event $ SetPool Orchard
+      ]
     CopyAddr a ->
       [ setClipboardData $
         ClipboardText $
@@ -453,6 +483,7 @@ handleEvent wenv node model evt =
       , Event $ ShowMsg "Copied address!"
       ]
     LoadTxs t -> [Model $ model & transactions .~ t]
+    LoadAddrs a -> [Model $ model & addresses .~ a, Event $ SetPool Orchard]
     CloseMsg -> [Model $ model & msg .~ Nothing]
   where
     currentWallet =
@@ -463,6 +494,10 @@ handleEvent wenv node model evt =
       if null (model ^. accounts)
         then Nothing
         else Just ((model ^. accounts) !! (model ^. selAcc))
+    selectAccount i =
+      if null (model ^. accounts)
+        then Nothing
+        else Just ((model ^. accounts) !! i)
     currentAddress =
       if null (model ^. addresses)
         then Nothing
@@ -520,6 +555,7 @@ runZenithGUI config = do
                   (Just 300000)
                   Orchard
                   qr
+                  False
           startApp model handleEvent buildUI params
     Left e -> do
       initDb dbFilePath
@@ -543,6 +579,7 @@ runZenithGUI config = do
               (Just 30000)
               Orchard
               Nothing
+              False
       startApp model handleEvent buildUI params
   where
     params =