From c522c4c3a23cbac7bbb836cc2353ef89c1abdd36 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Fri, 1 Mar 2024 14:57:13 -0600 Subject: [PATCH] Implement Account creation --- src/Zenith/CLI.hs | 58 +++++++++++++++++++++++++++++++++++----------- src/Zenith/Core.hs | 17 ++++++++++++-- src/Zenith/DB.hs | 15 +++++++----- 3 files changed, 69 insertions(+), 21 deletions(-) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index f3caae1..447383e 100644 --- a/src/Zenith/CLI.hs +++ b/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 $ - "Creating new account " <> T.unpack (fs ^. dialogInput) + na <- liftIO $ addNewAccount (fs ^. dialogInput) s + 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 & wallets .~ L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets)) & - msg .~ - "Wallet already exists: " ++ - T.unpack n + return $ s & 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 diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index f261373..7d6a4e7 100644 --- a/src/Zenith/Core.hs +++ b/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 -saveAccount dbFp a = runSqlite dbFp $ insert a + -> IO (Maybe (Entity ZcashAccount)) +saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a -- | Returns a list of addresses associated with the given account getAddresses :: diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 260e8a2..ef6b324 100644 --- a/src/Zenith/DB.hs +++ b/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]