Implement Account creation
This commit is contained in:
parent
642908a0e0
commit
c522c4c3a2
3 changed files with 69 additions and 21 deletions
|
@ -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
|
||||
|
|
|
@ -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,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]
|
||||
|
|
Loading…
Reference in a new issue