Implement creating new addresses

CHANGELOG.md

@@ -15,6 +15,7 @@ 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 add new address
 
 
 ## [0.5.3.0-beta]

cabal.project.freeze

@@ -233,6 +233,8 @@ constraints: any.Cabal ==3.8.1.0,
              any.psqueues ==0.2.8.0,
              any.pureMD5 ==2.1.4,
              pureMD5 -test,
+             any.qrcode-core ==0.9.9,
+             any.qrcode-juicypixels ==0.8.5,
              any.quickcheck-io ==0.2.0,
              any.quickcheck-transformer ==0.3.1.2,
              any.random ==1.2.1.2,

src/Zenith/GUI.hs

@@ -26,7 +26,10 @@ import TextShow
 import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
 import ZcashHaskell.Transparent (encodeTransparentReceiver)
 import ZcashHaskell.Types
-  ( UnifiedAddress(..)
+  ( Phrase(..)
+  , Scope(..)
+  , ToBytes(..)
+  , UnifiedAddress(..)
   , ZcashNet(..)
   , ZebraGetBlockChainInfo(..)
   , ZebraGetInfo(..)
@@ -34,7 +37,7 @@ import ZcashHaskell.Types
 import Zenith.Core
 import Zenith.DB
 import Zenith.GUI.Theme
-import Zenith.Types hiding (ZcashAddress)
+import Zenith.Types hiding (ZcashAddress(..))
 import Zenith.Utils (displayAmount, showAddress)
 
 data AppEvent
@@ -62,6 +65,9 @@ data AppEvent
   | SaveAddress
   | SaveAccount
   | SaveWallet
+  | CloseSeed
+  | ShowSeed
+  | CopySeed !T.Text
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -91,6 +97,7 @@ data AppModel = AppModel
   , _confirmCancel :: !T.Text
   , _confirmEvent :: !AppEvent
   , _inError :: !Bool
+  , _showSeed :: !Bool
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -126,6 +133,7 @@ buildUI wenv model = widgetTree
       zstack
         [ mainWindow
         , confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
+        , seedOverlay `nodeVisible` model ^. showSeed
         , msgOverlay `nodeVisible` isJust (model ^. msg)
         ]
     mainWindow =
@@ -187,7 +195,7 @@ buildUI wenv model = widgetTree
                   , widgetIf (model ^. newPopup) $ animSlideIn newBox
                   ]) `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
-           , box_ [alignLeft] (label "Backup Wallet") `styleBasic`
+           , box_ [alignLeft, onClick ShowSeed] (label "Backup Wallet") `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
            ]) `styleBasic`
       [bgColor btnColor, padding 3]
@@ -252,7 +260,10 @@ buildUI wenv model = widgetTree
       , styleIf (model ^. selAcc == idx) (borderL 2 btnHiLite)
       , styleIf (model ^. selAcc == idx) (borderR 2 btnHiLite)
       ]
-    mainPane = box_ [alignMiddle] $ hstack [addressBox, txBox]
+    mainPane =
+      box_ [alignMiddle] $
+      hstack
+        [addressBox, txBox `nodeVisible` not (null $ model ^. transactions)]
     balanceBox =
       hstack
         [ filler
@@ -450,9 +461,10 @@ buildUI wenv model = widgetTree
       alert CloseMsg $
       hstack
         [ filler
-        , image_ "./assets/1F616_color.png" [fitHeight] `styleBasic`
+        , remixIcon remixErrorWarningFill `styleBasic`
-          [height 44, width 44] `nodeVisible`
+          [textSize 32, textColor btnColor] `nodeVisible`
           (model ^. inError)
+        , spacer
         , label $ fromMaybe "" (model ^. msg)
         , filler
         ]
@@ -465,6 +477,44 @@ buildUI wenv model = widgetTree
         , cancelCaption $ model ^. confirmCancel
         ]
         (hstack [label "Name:", filler, textField_ mainInput [maxLength 25]])
+    seedOverlay =
+      alert CloseSeed $
+      vstack
+        [ box_
+            []
+            (label "Seed Phrase" `styleBasic`
+             [textFont "Bold", textSize 12, textColor white]) `styleBasic`
+          [bgColor btnColor, radius 2, padding 3]
+        , spacer
+        , textAreaV_
+            (maybe
+               "None"
+               (E.decodeUtf8Lenient .
+                getBytes . getPhrase . zcashWalletSeedPhrase . entityVal)
+               currentWallet)
+            (const CloseSeed)
+            [readOnly, maxLines 2] `styleBasic`
+          [textSize 8]
+        , spacer
+        , hstack
+            [ filler
+            , box_
+                [ onClick $
+                  CopySeed $
+                  maybe
+                    "None"
+                    (E.decodeUtf8Lenient .
+                     getBytes . getPhrase . zcashWalletSeedPhrase . entityVal)
+                    currentWallet
+                ]
+                (hstack
+                   [ label "Copy" `styleBasic` [textColor white]
+                   , remixIcon remixFileCopyLine `styleBasic` [textColor white]
+                   ]) `styleBasic`
+              [cursorHand, bgColor btnColor, radius 2, padding 3]
+            , filler
+            ]
+        ]
 
 generateQRCodes :: Config -> IO ()
 generateQRCodes config = do
@@ -581,12 +631,13 @@ handleEvent wenv node model evt =
         False
       ]
     ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
+    ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
     SaveAddress ->
-      [ if T.length (model ^. mainInput) > 1
+      if T.length (model ^. mainInput) > 1
-          then Event $ ShowMsg $ "You saved address: " <> model ^. mainInput
+        then [ Task $ addNewAddress (model ^. mainInput) External currentAccount
-          else Event $ ShowError "Invalid input"
              , Event ConfirmCancel
              ]
+        else [Event $ ShowError "Invalid input", Event ConfirmCancel]
     SaveAccount ->
       [ if T.length (model ^. mainInput) > 1
           then Event $ ShowMsg $ "You saved account: " <> model ^. mainInput
@@ -654,10 +705,15 @@ handleEvent wenv node model evt =
             a
       , Event $ ShowMsg "Copied address!"
       ]
+    CopySeed s ->
+      [ setClipboardData $ ClipboardText s
+      , 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]
     CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
+    CloseSeed -> [Model $ model & showSeed .~ False]
   where
     currentWallet =
       if null (model ^. wallets)
@@ -679,6 +735,27 @@ handleEvent wenv node model evt =
       if null (model ^. addresses)
         then Nothing
         else Just ((model ^. addresses) !! (model ^. selAddr))
+    addNewAddress ::
+         T.Text -> Scope -> Maybe (Entity ZcashAccount) -> IO AppEvent
+    addNewAddress n scope acc = do
+      case acc of
+        Nothing -> return $ ShowError "No account available"
+        Just a -> do
+          pool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
+          maxAddr <- getMaxAddress pool (entityKey a) scope
+          uA <-
+            try $ createWalletAddress n (maxAddr + 1) (model ^. network) scope a :: IO
+              (Either IOError WalletAddress)
+          case uA of
+            Left e -> return $ ShowError $ "Error: " <> T.pack (show e)
+            Right uA' -> do
+              nAddr <- saveAddress pool uA'
+              case nAddr of
+                Nothing -> return $ ShowError $ "Address already exists: " <> n
+                Just _x -> do
+                  generateQRCodes $ model ^. configuration
+                  addrL <- runNoLoggingT $ getAddresses pool $ entityKey a
+                  return $ LoadAddrs addrL
 
 runZenithGUI :: Config -> IO ()
 runZenithGUI config = do
@@ -742,6 +819,7 @@ runZenithGUI config = do
                   ""
                   SaveAddress
                   False
+                  False
           startApp model handleEvent buildUI params
     Left e -> do
       initDb dbFilePath
@@ -775,6 +853,7 @@ runZenithGUI config = do
               ""
               SaveAddress
               False
+              False
       startApp model handleEvent buildUI params
   where
     params =