Implement Account creation

src/Zenith/CLI.hs

@@ -3,6 +3,7 @@
 
 module Zenith.CLI where
 
+import Control.Exception (throw)
 import Control.Monad (void)
 import Control.Monad.IO.Class (liftIO)
 import qualified Data.Text as T
@@ -112,7 +113,15 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
                  "(None)"
                  (\(_, w) -> zcashWalletName $ entityVal w)
                  (L.listSelectedElement (st ^. wallets))))) $
-      (C.center (listBox "Addresses" (st ^. addresses)) <+>
+      (C.hCenter
+         (str
+            ("Account: " ++
+             T.unpack
+               (maybe
+                  "(None)"
+                  (\(_, a) -> zcashAccountName $ entityVal a)
+                  (L.listSelectedElement (st ^. accounts))))) <=>
+       listBox "Addresses" (st ^. addresses) <+>
        B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=>
       msgBox (st ^. msg)
     listBox :: String -> L.List Name String -> Widget Name
@@ -226,10 +235,10 @@ appEvent (BT.VtyEvent e) = do
                  case e of
                    V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
                    V.EvKey V.KEnter [] -> do
-                     BT.modify $ set dialogBox Blank
                      fs <- BT.zoom inputForm $ BT.gets formState
-                     printMsg $
+                     na <- liftIO $ addNewAccount (fs ^. dialogInput) s
-                       "Creating new account " <> T.unpack (fs ^. dialogInput)
+                     BT.put na
+                     BT.modify $ set dialogBox Blank
                    ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
                Blank -> do
                  case e of
@@ -303,7 +312,7 @@ runZenithCLI host port dbFilePath = do
               ((show . zgb_net) chainInfo)
               (L.list WList (Vec.fromList walList) 1)
               (L.list AcList (Vec.fromList accList) 0)
-              (L.list AList (Vec.fromList ["addr1", "addr2"]) 1)
+              (L.list AList (Vec.fromList ["utest...hn8zg", "utest...qfex8"]) 1)
               (L.list TList (Vec.fromList ["tx1", "tx2", "tx3"]) 1)
               ("Start up Ok! Connected to Zebra " ++
                (T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
@@ -326,15 +335,10 @@ addNewWallet n s = do
   sP <- generateWalletSeedPhrase
   let bH = s ^. startBlock
   let netName = read $ s ^. network
-  r <- saveWallet (s ^. dbPath) $ ZcashWallet sP bH n netName
+  r <- saveWallet (s ^. dbPath) $ ZcashWallet n netName sP bH
   case r of
     Nothing -> do
-      wL <- getWallets (s ^. dbPath) netName
+      return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
-      return $
-        (s & wallets .~ L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets)) &
-        msg .~
-        "Wallet already exists: " ++
-        T.unpack n
     Just _ -> do
       wL <- getWallets (s ^. dbPath) netName
       let aL =
@@ -343,4 +347,32 @@ addNewWallet n s = do
       return $ (s & wallets .~ aL) & msg .~ "Created new wallet: " ++ T.unpack n
 
 addNewAccount :: T.Text -> State -> IO State
-addNewAccount n s = undefined
+addNewAccount n 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' <- getMaxAccount (s ^. dbPath) (entityKey selWallet)
+  r <-
+    saveAccount (s ^. dbPath) $
+    ZcashAccount
+      (aL' + 1)
+      (entityKey selWallet)
+      n
+      "fakeOrchKey"
+      "fakeSapKey"
+      "fakeTKey"
+  case r of
+    Nothing -> return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
+    Just x -> do
+      aL <- getAccounts (s ^. dbPath) (entityKey selWallet)
+      let nL =
+            L.listMoveToElement x $
+            L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
+      return $
+        (s & accounts .~ nL) & msg .~ "Created new account: " ++ T.unpack n

src/Zenith/Core.hs

@@ -34,12 +34,25 @@ getAccounts ::
   -> IO [Entity ZcashAccount]
 getAccounts dbFp w = runSqlite dbFp $ selectList [ZcashAccountWalletId ==. w] []
 
+-- | Returns the largest account index for the given wallet
+getMaxAccount ::
+     T.Text -- ^ The database path
+  -> ZcashWalletId -- ^ The wallet ID to check
+  -> IO Int
+getMaxAccount dbFp w = do
+  a <-
+    runSqlite dbFp $
+    selectFirst [ZcashAccountWalletId ==. w] [Desc ZcashAccountIndex]
+  case a of
+    Nothing -> return $ -1
+    Just x -> return $ zcashAccountIndex $ entityVal x
+
 -- | Save a new account to the database
 saveAccount ::
      T.Text -- ^ The database path
   -> ZcashAccount -- ^ The account to add to the database
-  -> IO ZcashAccountId
+  -> IO (Maybe (Entity ZcashAccount))
-saveAccount dbFp a = runSqlite dbFp $ insert a
+saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a
 
 -- | Returns a list of addresses associated with the given account
 getAddresses ::

src/Zenith/DB.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
@@ -30,19 +31,21 @@ share
   [mkPersist sqlSettings, mkMigrate "migrateAll"]
   [persistLowerCase|
   ZcashWallet
-    seedPhrase Phrase
-    birthdayHeight Int
     name T.Text
     network ZcashNet
+    seedPhrase Phrase
+    birthdayHeight Int
     UniqueWallet name network
-    deriving Show
+    deriving Show Eq
   ZcashAccount
-    walletId ZcashWalletId
     index Int
+    walletId ZcashWalletId
+    name T.Text
     orchSpendKey BS.ByteString
     sapSpendKey BS.ByteString
     tPrivateKey BS.ByteString
-    deriving Show
+    UniqueAccount index walletId
+    deriving Show Eq
   WalletAddress
     accId ZcashAccountId
     index Int
@@ -50,7 +53,7 @@ share
     sapRec BS.ByteString Maybe
     tRec BS.ByteString Maybe
     encoded T.Text
-    deriving Show
+    deriving Show Eq
     |]
 
 getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]