diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 106b1ae..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 @@ -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 - printMsg $ - "Creating new wallet " <> T.unpack (fs ^. dialogInput) - BT.modify $ set dialogBox Blank + BT.put nw + aL <- use accounts + BT.modify $ + 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 $ - "Creating new address " <> 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 @@ -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 :: - T.Text -> State -> IO (L.GenericList Name Vec.Vector (Entity ZcashWallet)) +addNewWallet :: T.Text -> State -> IO State addNewWallet n s = do sP <- generateWalletSeedPhrase let bH = s ^. startBlock let netName = read $ s ^. network - _ <- saveWallet (s ^. dbPath) $ ZcashWallet sP bH n netName - wL <- getWallets (s ^. dbPath) netName - return $ L.listReplace (Vec.fromList wL) (Just 0) $ s ^. wallets + 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 + 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 diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 40836f5..7d6a4e7 100644 --- a/src/Zenith/Core.hs +++ b/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 -saveWallet dbFp w = runSqlite dbFp $ insert w + -> IO (Maybe (Entity ZcashWallet)) +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 -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 8af8832..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,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]