Merge pull request 'Implement Account creation' (#68) from rav001 into dev041

Reviewed-on: #68

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
@@ -60,6 +61,7 @@ import Zenith.DB
 data Name
   = WList
   | AList
+  | AcList
   | TList
   | HelpDialog
   | DialogInputField
@@ -79,6 +81,7 @@ data DialogType
 data State = State
   { _network :: !String
   , _wallets :: !(L.List Name (Entity ZcashWallet))
+  , _accounts :: !(L.List Name (Entity ZcashAccount))
   , _addresses :: !(L.List Name String)
   , _transactions :: !(L.List Name String)
   , _msg :: !String
@@ -110,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
@@ -212,19 +223,22 @@ appEvent (BT.VtyEvent e) = do
                    V.EvKey V.KEnter [] -> do
                      fs <- BT.zoom inputForm $ BT.gets formState
                      nw <- liftIO $ addNewWallet (fs ^. dialogInput) s
-                     BT.modify $ set wallets nw
+                     BT.put nw
-                     printMsg $
+                     aL <- use accounts
-                       "Creating new wallet " <> T.unpack (fs ^. dialogInput)
+                     BT.modify $
-                     BT.modify $ set dialogBox Blank
+                       set dialogBox $
+                       if not (null $ L.listElements aL)
+                         then Blank
+                         else AName
                    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
-                     BT.modify $ set dialogBox Blank
                      fs <- BT.zoom inputForm $ BT.gets formState
-                     printMsg $
+                     na <- liftIO $ addNewAccount (fs ^. dialogInput) s
-                       "Creating new address " <> 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
@@ -288,12 +302,17 @@ runZenithCLI host port dbFilePath = do
         Just chainInfo -> do
           initDb dbFilePath
           walList <- getWallets dbFilePath $ zgb_net chainInfo
+          accList <-
+            if not (null walList)
+              then getAccounts dbFilePath $ entityKey $ head walList
+              else return []
           void $
             M.defaultMain theApp $
             State
               ((show . zgb_net) chainInfo)
               (L.list WList (Vec.fromList walList) 1)
-              (L.list AList (Vec.fromList ["addr1", "addr2"]) 1)
+              (L.list AcList (Vec.fromList accList) 0)
+              (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 ++ ".")
@@ -311,12 +330,49 @@ runZenithCLI host port dbFilePath = do
         "No Zebra node available on port " <>
         show port <> ". Check your configuration"
 
-addNewWallet ::
+addNewWallet :: T.Text -> State -> IO State
-     T.Text -> State -> IO (L.GenericList Name Vec.Vector (Entity ZcashWallet))
 addNewWallet n s = do
   sP <- generateWalletSeedPhrase
   let bH = s ^. startBlock
   let netName = read $ s ^. network
-  _ <- saveWallet (s ^. dbPath) $ ZcashWallet sP bH n netName
+  r <- saveWallet (s ^. dbPath) $ ZcashWallet n netName sP bH
+  case r of
+    Nothing -> do
+      return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
+    Just _ -> do
       wL <- getWallets (s ^. dbPath) netName
-  return $ L.listReplace (Vec.fromList wL) (Just 0) $ s ^. wallets
+      let aL =
+            L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $
+            L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets)
+      return $ (s & wallets .~ aL) & msg .~ "Created new wallet: " ++ T.unpack n
+
+addNewAccount :: T.Text -> State -> IO State
+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

@@ -24,8 +24,8 @@ initDb dbName = do
 saveWallet ::
      T.Text -- ^ The database path to use
   -> ZcashWallet -- ^ The wallet to add to the database
-  -> IO ZcashWalletId
+  -> IO (Maybe (Entity ZcashWallet))
-saveWallet dbFp w = runSqlite dbFp $ insert w
+saveWallet dbFp w = runSqlite dbFp $ insertUniqueEntity w
 
 -- | Returns a list of accounts associated with the given wallet
 getAccounts ::
@@ -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,18 +31,21 @@ share
   [mkPersist sqlSettings, mkMigrate "migrateAll"]
   [persistLowerCase|
   ZcashWallet
-    seedPhrase Phrase
-    birthdayHeight Int
     name T.Text
     network ZcashNet
-    deriving Show
+    seedPhrase Phrase
+    birthdayHeight Int
+    UniqueWallet name network
+    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
@@ -49,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]