Merge pull request 'Implement Account creation' (#68) from rav001 into dev041
Reviewed-on: #68
This commit is contained in:
commit
7794028b55
Signed by:
Vergara Technologies LLC
Vergara Technologies LLC
GPG Key ID:
99DB473BB4715618
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ::
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
Loading…
Reference in New Issue