CHANGELOG.md

@@ -15,7 +15,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Balance display
 - Account selector
 - Menu for new addresses, accounts, wallets
+- Dialog to display and copy seed phrase
 - Dialog to add new address
+- Dialog to add new account
 
 
 ## [0.5.3.0-beta]

src/Zenith/GUI.hs

@@ -49,8 +49,8 @@ data AppEvent
   | AccountClicked
   | MenuClicked
   | NewClicked
-  | NewAddress
-  | NewAccount
+  | NewAddress !(Maybe (Entity ZcashAccount))
+  | NewAccount !(Maybe (Entity ZcashWallet))
   | NewWallet
   | SetPool !ZcashPool
   | SwitchQr !(Maybe QrCode)
@@ -62,8 +62,8 @@ data AppEvent
   | LoadAddrs ![Entity WalletAddress]
   | LoadAccs ![Entity ZcashAccount]
   | ConfirmCancel
-  | SaveAddress
-  | SaveAccount
+  | SaveAddress !(Maybe (Entity ZcashAccount))
+  | SaveAccount !(Maybe (Entity ZcashWallet))
   | SaveWallet
   | CloseSeed
   | ShowSeed
@@ -204,11 +204,11 @@ buildUI wenv model = widgetTree
         [alignMiddle]
         (vstack
            [ box_
-               [alignLeft, onClick NewAddress]
+               [alignLeft, onClick $ NewAddress currentAccount]
                (hstack [label "Address", filler]) `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
            , box_
-               [alignLeft, onClick NewAccount]
+               [alignLeft, onClick $ NewAccount currentWallet]
                (hstack [label "Account", filler]) `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
            , box_
@@ -600,23 +600,23 @@ handleEvent wenv node model evt =
     AccountClicked -> [Model $ model & accPopup .~ True]
     MenuClicked -> [Model $ model & menuPopup .~ True]
     NewClicked -> [Model $ model & newPopup .~ not (model ^. newPopup)]
-    NewAddress ->
+    NewAddress acc ->
       [ Model $
         model & confirmTitle ?~ "New Address" & confirmAccept .~ "Create" &
         confirmCancel .~
         "Cancel" &
         confirmEvent .~
-        SaveAddress &
+        SaveAddress acc &
         menuPopup .~
         False
       ]
-    NewAccount ->
+    NewAccount wal ->
       [ Model $
         model & confirmTitle ?~ "New Account" & confirmAccept .~ "Create" &
         confirmCancel .~
         "Cancel" &
         confirmEvent .~
-        SaveAccount &
+        SaveAccount wal &
         menuPopup .~
         False
       ]
@@ -632,18 +632,18 @@ handleEvent wenv node model evt =
       ]
     ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
     ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
-    SaveAddress ->
+    SaveAddress acc ->
       if T.length (model ^. mainInput) > 1
-        then [ Task $ addNewAddress (model ^. mainInput) External currentAccount
+        then [ Task $ addNewAddress (model ^. mainInput) External acc
              , Event ConfirmCancel
              ]
         else [Event $ ShowError "Invalid input", Event ConfirmCancel]
-    SaveAccount ->
-      [ if T.length (model ^. mainInput) > 1
-          then Event $ ShowMsg $ "You saved account: " <> model ^. mainInput
-          else Event $ ShowError "Invalid input"
+    SaveAccount wal ->
+      if T.length (model ^. mainInput) > 1
+        then [ Task $ addNewAccount (model ^. mainInput) wal
              , Event ConfirmCancel
              ]
+        else [Event $ ShowError "Invalid input", Event ConfirmCancel]
     SaveWallet ->
       [ if T.length (model ^. mainInput) > 1
           then Event $ ShowMsg $ "You saved wallet: " <> model ^. mainInput
@@ -710,8 +710,14 @@ handleEvent wenv node model evt =
       , Event $ ShowMsg "Copied seed phrase!"
       ]
     LoadTxs t -> [Model $ model & transactions .~ t]
-    LoadAddrs a -> [Model $ model & addresses .~ a, Event $ SetPool Orchard]
-    LoadAccs a -> [Model $ model & accounts .~ a, Event $ SwitchAcc 0]
+    LoadAddrs a ->
+      if not (null a)
+        then [Model $ model & addresses .~ a, Event $ SetPool Orchard]
+        else [Event $ NewAddress currentAccount]
+    LoadAccs a ->
+      if not (null a)
+        then [Model $ model & accounts .~ a, Event $ SwitchAcc 0]
+        else [Event $ NewAccount currentWallet]
     CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
     CloseSeed -> [Model $ model & showSeed .~ False]
   where
@@ -756,6 +762,25 @@ handleEvent wenv node model evt =
                   generateQRCodes $ model ^. configuration
                   addrL <- runNoLoggingT $ getAddresses pool $ entityKey a
                   return $ LoadAddrs addrL
+    addNewAccount :: T.Text -> Maybe (Entity ZcashWallet) -> IO AppEvent
+    addNewAccount n w = do
+      case w of
+        Nothing -> return $ ShowError "No wallet available"
+        Just w' -> do
+          pool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
+          accIx <- getMaxAccount pool $ entityKey w'
+          newAcc <-
+            try $ createZcashAccount n (accIx + 1) w' :: IO
+              (Either IOError ZcashAccount)
+          case newAcc of
+            Left e -> return $ ShowError "Failed to create account"
+            Right newAcc' -> do
+              r <- saveAccount pool newAcc'
+              case r of
+                Nothing -> return $ ShowError "Account already exists"
+                Just _x -> do
+                  aList <- runNoLoggingT $ getAccounts pool (entityKey w')
+                  return $ LoadAccs aList
 
 runZenithGUI :: Config -> IO ()
 runZenithGUI config = do
@@ -817,7 +842,10 @@ runZenithGUI config = do
                   Nothing
                   ""
                   ""
-                  SaveAddress
+                  (SaveAddress $
+                   if not (null accList)
+                     then Just (head accList)
+                     else Nothing)
                   False
                   False
           startApp model handleEvent buildUI params
@@ -851,7 +879,7 @@ runZenithGUI config = do
               Nothing
               ""
               ""
-              SaveAddress
+              (SaveAddress Nothing)
               False
               False
       startApp model handleEvent buildUI params