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

Reviewed-on: #68
This commit is contained in:
pitmutt 2024-03-01 20:59:57 +00:00 committed by Vergara Technologies LLC
commit 7794028b55
Signed by: Vergara Technologies LLC
GPG key ID: 99DB473BB4715618
3 changed files with 97 additions and 24 deletions

View file

@ -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

View file

@ -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 ::

View file

@ -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]