Merge pull request 'Implement display of seed phrase' (#69) from rav001 into dev041

Reviewed-on: #69
This commit is contained in:
pitmutt 2024-03-18 17:27:16 +00:00 committed by Vergara Technologies LLC
commit 34cffa84bc
Signed by: Vergara Technologies LLC
GPG key ID: 99DB473BB4715618
9 changed files with 731 additions and 204 deletions

View file

@ -7,7 +7,7 @@ with-compiler: ghc-9.4.8
source-repository-package
type: git
location: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
tag: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d
tag: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7
source-repository-package
type: git

View file

@ -3,15 +3,6 @@
module Zenith.CLI where
import Control.Exception (throw)
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import qualified Graphics.Vty as V
import Lens.Micro ((&), (.~), (^.), set)
import Lens.Micro.Mtl
import Lens.Micro.TH
import qualified Brick.AttrMap as A
import qualified Brick.Focus as F
import Brick.Forms
@ -37,13 +28,16 @@ import Brick.Widgets.Core
, (<=>)
, emptyWidget
, fill
, hBox
, hLimit
, joinBorders
, padAll
, padBottom
, padRight
, str
, strWrap
, txt
, txtWrap
, txtWrapWith
, vBox
, vLimit
, withAttr
@ -51,12 +45,25 @@ import Brick.Widgets.Core
)
import qualified Brick.Widgets.Dialog as D
import qualified Brick.Widgets.List as L
import Control.Exception (throw, throwIO, try)
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Vector as Vec
import Database.Persist
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import qualified Graphics.Vty as V
import Lens.Micro ((&), (.~), (^.), set)
import Lens.Micro.Mtl
import Lens.Micro.TH
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Types
import Zenith.Core
import Zenith.DB
import Zenith.Types (PhraseDB(..), UnifiedAddressDB(..), ZcashNetDB(..))
import Zenith.Utils (showAddress)
data Name
= WList
@ -76,13 +83,22 @@ makeLenses ''DialogInput
data DialogType
= WName
| AName
| AdName
| WSelect
| ASelect
| Blank
data DisplayType
= AddrDisplay
| MsgDisplay
| PhraseDisplay
| BlankDisplay
data State = State
{ _network :: !String
{ _network :: !ZcashNet
, _wallets :: !(L.List Name (Entity ZcashWallet))
, _accounts :: !(L.List Name (Entity ZcashAccount))
, _addresses :: !(L.List Name String)
, _addresses :: !(L.List Name (Entity WalletAddress))
, _transactions :: !(L.List Name String)
, _msg :: !String
, _helpBox :: !Bool
@ -92,12 +108,13 @@ data State = State
, _focusRing :: !(F.FocusRing Name)
, _startBlock :: !Int
, _dbPath :: !T.Text
, _displayBox :: !DisplayType
}
makeLenses ''State
drawUI :: State -> [Widget Name]
drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
where
ui :: State -> Widget Name
ui st =
@ -106,25 +123,31 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
B.borderWithLabel
(str
("Zenith - " <>
st ^. network <>
show (st ^. network) <>
" - " <>
T.unpack
(maybe
"(None)"
(\(_, w) -> zcashWalletName $ entityVal w)
(L.listSelectedElement (st ^. wallets))))) $
(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
(L.listSelectedElement (st ^. wallets)))))
(C.hCenter
(str
("Account: " ++
T.unpack
(maybe
"(None)"
(\(_, a) -> zcashAccountName $ entityVal a)
(L.listSelectedElement (st ^. accounts))))) <=>
listAddressBox "Addresses" (st ^. addresses) <+>
B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=>
C.hCenter
(hBox
[ capCommand "W" "allets"
, capCommand "A" "ccounts"
, capCommand "V" "iew address"
, capCommand "Q" "uit"
])
listBox :: Show e => String -> L.List Name e -> Widget Name
listBox titleLabel l =
C.vCenter $
vBox
@ -134,10 +157,30 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
, str " "
, C.hCenter $ str "Select "
]
msgBox :: String -> Widget Name
msgBox m =
selectListBox ::
Show e
=> String
-> L.List Name e
-> (Bool -> e -> Widget Name)
-> Widget Name
selectListBox titleLabel l drawF =
vBox
[B.hBorderWithLabel (str "Messages"), hLimit 70 $ padRight Max $ str m]
[ C.hCenter
(B.borderWithLabel (str titleLabel) $
hLimit 25 $ vLimit 15 $ L.renderList drawF True l)
, str " "
]
listAddressBox ::
String -> L.List Name (Entity WalletAddress) -> Widget Name
listAddressBox titleLabel a =
C.vCenter $
vBox
[ C.hCenter
(B.borderWithLabel (str titleLabel) $
hLimit 40 $ vLimit 15 $ L.renderList listDrawAddress True a)
, str " "
, C.hCenter $ str "Use arrows to select"
]
helpDialog :: State -> Widget Name
helpDialog st =
if st ^. helpBox
@ -147,11 +190,17 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
vBox ([str "Actions", B.hBorder] <> actionList))
else emptyWidget
where
keyList = map (C.hCenter . str) ["?", "Esc", "c", "q"]
keyList = map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "q"]
actionList =
map
(hLimit 40 . str)
["Open help", "Close dialog", "Create Wallet", "Quit"]
[ "Open help"
, "Close dialog"
, "Switch wallets"
, "Switch accounts"
, "View address"
, "Quit"
]
inputDialog :: State -> Widget Name
inputDialog st =
case st ^. dialogBox of
@ -163,6 +212,33 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
D.renderDialog
(D.dialog (Just (str "Create Account")) Nothing 50)
(renderForm $ st ^. inputForm)
AdName ->
D.renderDialog
(D.dialog (Just (str "Create Address")) Nothing 50)
(renderForm $ st ^. inputForm)
WSelect ->
D.renderDialog
(D.dialog (Just (str "Select Wallet")) Nothing 50)
(selectListBox "Wallets" (st ^. wallets) listDrawWallet <=>
C.hCenter
(hBox
[ capCommand "↑↓ " "move"
, capCommand "" "select"
, capCommand "N" "ew"
, capCommand "S" "how phrase"
, xCommand
]))
ASelect ->
D.renderDialog
(D.dialog (Just (str "Select Account")) Nothing 50)
(selectListBox "Accounts" (st ^. accounts) listDrawAccount <=>
C.hCenter
(hBox
[ capCommand "↑↓ " "move"
, capCommand "" "select"
, capCommand "N" "ew"
, xCommand
]))
Blank -> emptyWidget
splashDialog :: State -> Widget Name
splashDialog st =
@ -174,9 +250,46 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
titleAttr
(str
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.3.0")) <=>
C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.4.0")) <=>
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
else emptyWidget
capCommand :: String -> String -> Widget Name
capCommand k comm = hBox [withAttr titleAttr (str k), str comm, str " | "]
xCommand :: Widget Name
xCommand = hBox [str "E", withAttr titleAttr (str "x"), str "it"]
displayDialog :: State -> Widget Name
displayDialog st =
case st ^. displayBox of
AddrDisplay ->
case L.listSelectedElement $ st ^. addresses of
Just (_, a) ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog
(Just $ txt ("Address: " <> walletAddressName (entityVal a)))
Nothing
60)
(padAll 1 $
txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
getUA $ walletAddressUAddress $ entityVal a)
Nothing -> emptyWidget
PhraseDisplay ->
case L.listSelectedElement $ st ^. wallets of
Just (_, w) ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt "Seed Phrase") Nothing 50)
(padAll 1 $
txtWrap $
E.decodeUtf8Lenient $
getBytes $ getPhrase $ zcashWalletSeedPhrase $ entityVal w)
Nothing -> emptyWidget
MsgDisplay ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt "Message") Nothing 50)
(padAll 1 $ strWrap $ st ^. msg)
BlankDisplay -> emptyWidget
mkInputForm :: DialogInput -> Form DialogInput e Name
mkInputForm =
@ -194,6 +307,33 @@ listDrawElement sel a =
else str s
in C.hCenter $ selStr $ show a
listDrawWallet :: Bool -> Entity ZcashWallet -> Widget Name
listDrawWallet sel w =
let selStr s =
if sel
then withAttr customAttr (txt $ "<" <> s <> ">")
else txt s
in C.hCenter $ selStr $ zcashWalletName (entityVal w)
listDrawAccount :: Bool -> Entity ZcashAccount -> Widget Name
listDrawAccount sel w =
let selStr s =
if sel
then withAttr customAttr (txt $ "<" <> s <> ">")
else txt s
in C.hCenter $ selStr $ zcashAccountName (entityVal w)
listDrawAddress :: Bool -> Entity WalletAddress -> Widget Name
listDrawAddress sel w =
let selStr s =
if sel
then withAttr customAttr (txt $ "<" <> s <> ">")
else txt s
in C.hCenter $
selStr $
walletAddressName (entityVal w) <>
": " <> showAddress (walletAddressUAddress (entityVal w))
customAttr :: A.AttrName
customAttr = L.listSelectedAttr <> A.attrName "custom"
@ -216,52 +356,113 @@ appEvent (BT.VtyEvent e) = do
BT.modify $ set helpBox False
_ev -> return ()
else do
case s ^. dialogBox of
WName -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey V.KEnter [] -> do
fs <- BT.zoom inputForm $ BT.gets formState
nw <- liftIO $ addNewWallet (fs ^. dialogInput) s
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
fs <- BT.zoom inputForm $ BT.gets formState
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
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
V.EvKey (V.KChar 'q') [] -> M.halt
V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True
V.EvKey (V.KChar 'w') [] -> do
BT.modify $
set inputForm $
updateFormState (DialogInput "New Wallet") $
s ^. inputForm
BT.modify $ set dialogBox WName
V.EvKey (V.KChar 'a') [] -> do
BT.modify $
set inputForm $
updateFormState (DialogInput "New Account") $
s ^. inputForm
BT.modify $ set dialogBox AName
ev ->
case r of
Just AList -> BT.zoom addresses $ L.handleListEvent ev
Just TList -> BT.zoom transactions $ L.handleListEvent ev
_anyName -> return ()
case s ^. displayBox of
AddrDisplay -> BT.modify $ set displayBox BlankDisplay
MsgDisplay -> BT.modify $ set displayBox BlankDisplay
PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
BlankDisplay -> do
case s ^. dialogBox of
WName -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey V.KEnter [] -> do
fs <- BT.zoom inputForm $ BT.gets formState
nw <- liftIO $ addNewWallet (fs ^. dialogInput) s
ns <- liftIO $ refreshWallet nw
BT.put ns
aL <- use accounts
BT.modify $ set displayBox MsgDisplay
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
fs <- BT.zoom inputForm $ BT.gets formState
ns <-
liftIO $
refreshAccount =<<
addNewAddress "Change" Internal =<<
addNewAccount (fs ^. dialogInput) s
BT.put ns
addrL <- use addresses
BT.modify $ set displayBox MsgDisplay
BT.modify $
set dialogBox $
if not (null $ L.listElements addrL)
then Blank
else AdName
ev ->
BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
AdName -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey V.KEnter [] -> do
fs <- BT.zoom inputForm $ BT.gets formState
nAddr <-
liftIO $ addNewAddress (fs ^. dialogInput) External s
BT.put nAddr
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
ev ->
BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
WSelect -> do
case e of
V.EvKey (V.KChar 'x') [] ->
BT.modify $ set dialogBox Blank
V.EvKey V.KEnter [] -> do
ns <- liftIO $ refreshWallet s
BT.put ns
BT.modify $ set dialogBox Blank
V.EvKey (V.KChar 'n') [] -> do
BT.modify $
set inputForm $
updateFormState (DialogInput "New Wallet") $
s ^. inputForm
BT.modify $ set dialogBox WName
V.EvKey (V.KChar 's') [] ->
BT.modify $ set displayBox PhraseDisplay
ev -> BT.zoom wallets $ L.handleListEvent ev
ASelect -> do
case e of
V.EvKey (V.KChar 'x') [] ->
BT.modify $ set dialogBox Blank
V.EvKey V.KEnter [] -> do
ns <- liftIO $ refreshAccount s
BT.put ns
BT.modify $ set dialogBox Blank
V.EvKey (V.KChar 'n') [] -> do
BT.modify $
set inputForm $
updateFormState (DialogInput "New Account") $
s ^. inputForm
BT.modify $ set dialogBox AName
ev -> BT.zoom accounts $ L.handleListEvent ev
Blank -> do
case e of
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
V.EvKey (V.KChar 'q') [] -> M.halt
V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True
V.EvKey (V.KChar 'n') [] ->
BT.modify $ set dialogBox AdName
V.EvKey (V.KChar 'v') [] ->
BT.modify $ set displayBox AddrDisplay
V.EvKey (V.KChar 'w') [] ->
BT.modify $ set dialogBox WSelect
V.EvKey (V.KChar 'a') [] ->
BT.modify $ set dialogBox ASelect
ev ->
case r of
Just AList ->
BT.zoom addresses $ L.handleListEvent ev
Just TList ->
BT.zoom transactions $ L.handleListEvent ev
_anyName -> return ()
where
printMsg :: String -> BT.EventM Name State ()
printMsg s = BT.modify $ updateMsg s
@ -298,7 +499,7 @@ runZenithCLI host port dbFilePath = do
Just zebra -> do
bc <- checkBlockChain host port
case (bc :: Maybe ZebraGetBlockChainInfo) of
Nothing -> print "Unable to determine blockchain status"
Nothing -> throwIO $ userError "Unable to determine blockchain status"
Just chainInfo -> do
initDb dbFilePath
walList <- getWallets dbFilePath $ zgb_net chainInfo
@ -306,13 +507,17 @@ runZenithCLI host port dbFilePath = do
if not (null walList)
then getAccounts dbFilePath $ entityKey $ head walList
else return []
addrList <-
if not (null accList)
then getAddresses dbFilePath $ entityKey $ head accList
else return []
void $
M.defaultMain theApp $
State
((show . zgb_net) chainInfo)
(zgb_net chainInfo)
(L.list WList (Vec.fromList walList) 1)
(L.list AcList (Vec.fromList accList) 0)
(L.list AList (Vec.fromList ["utest...hn8zg", "utest...qfex8"]) 1)
(L.list AList (Vec.fromList addrList) 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 ++ ".")
@ -325,17 +530,42 @@ runZenithCLI host port dbFilePath = do
(F.focusRing [AList, TList])
(zgb_blocks chainInfo)
dbFilePath
MsgDisplay
Nothing -> do
print $
"No Zebra node available on port " <>
show port <> ". Check your configuration"
refreshWallet :: State -> IO State
refreshWallet 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 <- getAccounts (s ^. dbPath) $ entityKey selWallet
addrL <-
if not (null aL)
then getAddresses (s ^. dbPath) $ entityKey $ head aL
else return []
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
return $
(s & accounts .~ aL') & addresses .~ addrL' & msg .~ "Switched to wallet: " ++
T.unpack (zcashWalletName $ entityVal selWallet)
addNewWallet :: T.Text -> State -> IO State
addNewWallet n s = do
sP <- generateWalletSeedPhrase
let bH = s ^. startBlock
let netName = read $ s ^. network
r <- saveWallet (s ^. dbPath) $ ZcashWallet n netName sP bH
let netName = s ^. network
r <-
saveWallet (s ^. dbPath) $
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH
case r of
Nothing -> do
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
@ -358,21 +588,70 @@ addNewAccount n s = do
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
zA <-
try $ createZcashAccount n (aL' + 1) selWallet :: IO
(Either IOError ZcashAccount)
case zA of
Left e -> return $ s & msg .~ ("Error: " ++ show e)
Right zA' -> do
r <- saveAccount (s ^. dbPath) zA'
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
refreshAccount :: State -> IO State
refreshAccount s = do
selAccount <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
let fAcc =
L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts
case fAcc of
Nothing -> throw $ userError "Failed to select account"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
return $
s & addresses .~ aL' & msg .~ "Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
addNewAddress :: T.Text -> Scope -> State -> IO State
addNewAddress n scope s = do
selAccount <-
do case L.listSelectedElement $ s ^. accounts of
Nothing -> do
let fAcc =
L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts
case fAcc of
Nothing -> throw $ userError "Failed to select account"
Just (_j, a1) -> return a1
Just (_k, a) -> return a
maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount) scope
uA <-
try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO
(Either IOError WalletAddress)
case uA of
Left e -> return $ s & msg .~ ("Error: " ++ show e)
Right uA' -> do
nAddr <- saveAddress (s ^. dbPath) uA'
case nAddr of
Nothing ->
return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
Just x -> do
addrL <- getAddresses (s ^. dbPath) (entityKey selAccount)
let nL =
L.listMoveToElement x $
L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
return $
(s & addresses .~ nL) & msg .~ "Created new address: " ++
T.unpack n ++
"(" ++
T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")"

View file

@ -3,63 +3,36 @@
-- Core wallet functionality for Zenith
module Zenith.Core where
import Control.Exception (throwIO)
import Data.Aeson
import Data.HexString (hexString)
import qualified Data.Text as T
import Database.Persist
import Database.Persist.Sqlite
import Network.HTTP.Client
import ZcashHaskell.Keys
import ZcashHaskell.Orchard
( encodeUnifiedAddress
, genOrchardReceiver
, genOrchardSpendingKey
)
import ZcashHaskell.Sapling
( genSaplingInternalAddress
, genSaplingPaymentAddress
, genSaplingSpendingKey
)
import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver)
import ZcashHaskell.Types
import ZcashHaskell.Utils
import Zenith.DB
-- * Database functions
-- | Initializes the database
initDb ::
T.Text -- ^ The database path to check
-> IO ()
initDb dbName = do
runSqlite dbName $ do runMigration migrateAll
-- | Save a new wallet to the database
saveWallet ::
T.Text -- ^ The database path to use
-> ZcashWallet -- ^ The wallet to add to the database
-> IO (Maybe (Entity ZcashWallet))
saveWallet dbFp w = runSqlite dbFp $ insertUniqueEntity w
-- | Returns a list of accounts associated with the given wallet
getAccounts ::
T.Text -- ^ The database path
-> ZcashWalletId -- ^ The wallet ID to check
-> 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 (Maybe (Entity ZcashAccount))
saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a
-- | Returns a list of addresses associated with the given account
getAddresses ::
T.Text -- ^ The database path
-> ZcashAccountId -- ^ The account ID to check
-> IO [Entity WalletAddress]
getAddresses dbFp a = runSqlite dbFp $ selectList [WalletAddressAccId ==. a] []
import Zenith.Types
( OrchardSpendingKeyDB(..)
, PhraseDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..)
, ZcashNetDB(..)
)
-- * Zebra Node interaction
-- | Checks the status of the `zebrad` node
@ -79,7 +52,7 @@ checkBlockChain ::
-> IO (Maybe ZebraGetBlockChainInfo)
checkBlockChain nodeHost nodePort = do
let f = makeZebraCall nodeHost nodePort
result <$> (responseBody <$> f "getblockchaininfo" [])
result . responseBody <$> f "getblockchaininfo" []
-- | Generic RPC call function
connectZebra ::
@ -88,3 +61,104 @@ connectZebra nodeHost nodePort m params = do
res <- makeZebraCall nodeHost nodePort m params
let body = responseBody res
return $ result body
-- * Spending Keys
-- | Create an Orchard Spending Key for the given wallet and account index
createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey
createOrchardSpendingKey zw i = do
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
case getNet $ zcashWalletNetwork zw of
MainNet -> MainNetCoin
TestNet -> TestNetCoin
RegTestNet -> RegTestNetCoin
let r = genOrchardSpendingKey s' coinType i
case r of
Nothing -> throwIO $ userError "Unable to generate Orchard spending key"
Just sk -> return sk
-- | Create a Sapling spending key for the given wallet and account index
createSaplingSpendingKey :: ZcashWallet -> Int -> IO SaplingSpendingKey
createSaplingSpendingKey zw i = do
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
case getNet $ zcashWalletNetwork zw of
MainNet -> MainNetCoin
TestNet -> TestNetCoin
RegTestNet -> RegTestNetCoin
let r = genSaplingSpendingKey s' coinType i
case r of
Nothing -> throwIO $ userError "Unable to generate Sapling spending key"
Just sk -> return sk
createTransparentSpendingKey :: ZcashWallet -> Int -> IO TransparentSpendingKey
createTransparentSpendingKey zw i = do
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
case getNet $ zcashWalletNetwork zw of
MainNet -> MainNetCoin
TestNet -> TestNetCoin
RegTestNet -> RegTestNetCoin
genTransparentPrvKey s' coinType i
-- * Accounts
-- | Create an account for the given wallet and account index
createZcashAccount ::
T.Text -- ^ The account's name
-> Int -- ^ The account's index
-> Entity ZcashWallet -- ^ The Zcash wallet that this account will be attached to
-> IO ZcashAccount
createZcashAccount n i zw = do
orSk <- createOrchardSpendingKey (entityVal zw) i
sapSk <- createSaplingSpendingKey (entityVal zw) i
tSk <- createTransparentSpendingKey (entityVal zw) i
return $
ZcashAccount
i
(entityKey zw)
n
(OrchardSpendingKeyDB orSk)
(SaplingSpendingKeyDB sapSk)
(TransparentSpendingKeyDB tSk)
-- * Addresses
-- | Create an external unified address for the given account and index
createWalletAddress ::
T.Text -- ^ The address nickname
-> Int -- ^ The address' index
-> ZcashNet -- ^ The network for this address
-> Scope -- ^ External or Internal
-> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
-> IO WalletAddress
createWalletAddress n i zNet scope za = do
let oRec =
genOrchardReceiver i scope $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal za
let sRec =
case scope of
External ->
genSaplingPaymentAddress i $
getSapSK $ zcashAccountSapSpendKey $ entityVal za
Internal ->
genSaplingInternalAddress $
getSapSK $ zcashAccountSapSpendKey $ entityVal za
tRec <-
genTransparentReceiver i scope $
getTranSK $ zcashAccountTPrivateKey $ entityVal za
return $
WalletAddress
i
(entityKey za)
n
(UnifiedAddressDB $
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
(ScopeDB scope)

View file

@ -23,17 +23,24 @@ import qualified Data.Text as T
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import ZcashHaskell.Types (Phrase, ZcashNet)
derivePersistField "ZcashNet"
import ZcashHaskell.Types (Scope(..), ZcashNet)
import Zenith.Types
( OrchardSpendingKeyDB(..)
, PhraseDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB
, UnifiedAddressDB(..)
, ZcashNetDB(..)
)
share
[mkPersist sqlSettings, mkMigrate "migrateAll"]
[persistLowerCase|
ZcashWallet
name T.Text
network ZcashNet
seedPhrase Phrase
network ZcashNetDB
seedPhrase PhraseDB
birthdayHeight Int
UniqueWallet name network
deriving Show Eq
@ -41,23 +48,100 @@ share
index Int
walletId ZcashWalletId
name T.Text
orchSpendKey BS.ByteString
sapSpendKey BS.ByteString
tPrivateKey BS.ByteString
orchSpendKey OrchardSpendingKeyDB
sapSpendKey SaplingSpendingKeyDB
tPrivateKey TransparentSpendingKeyDB
UniqueAccount index walletId
UniqueAccName walletId name
deriving Show Eq
WalletAddress
accId ZcashAccountId
index Int
orchRec BS.ByteString Maybe
sapRec BS.ByteString Maybe
tRec BS.ByteString Maybe
encoded T.Text
accId ZcashAccountId
name T.Text
uAddress UnifiedAddressDB
scope ScopeDB
UniqueAddress index scope accId
UniqueAddName accId name
deriving Show Eq
|]
-- * Database functions
-- | Initializes the database
initDb ::
T.Text -- ^ The database path to check
-> IO ()
initDb dbName = do
runSqlite dbName $ do runMigration migrateAll
-- | Get existing wallets from database
getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
getWallets dbFp n =
runSqlite dbFp $ do
s <- selectList [ZcashWalletNetwork ==. n] []
liftIO $ return s
runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] []
-- | Save a new wallet to the database
saveWallet ::
T.Text -- ^ The database path to use
-> ZcashWallet -- ^ The wallet to add to the database
-> IO (Maybe (Entity ZcashWallet))
saveWallet dbFp w = runSqlite dbFp $ insertUniqueEntity w
-- | Returns a list of accounts associated with the given wallet
getAccounts ::
T.Text -- ^ The database path
-> ZcashWalletId -- ^ The wallet ID to check
-> 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 (Maybe (Entity ZcashAccount))
saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a
-- | Returns a list of addresses associated with the given account
getAddresses ::
T.Text -- ^ The database path
-> ZcashAccountId -- ^ The account ID to check
-> IO [Entity WalletAddress]
getAddresses dbFp a =
runSqlite dbFp $
selectList
[WalletAddressAccId ==. a, WalletAddressScope ==. ScopeDB External]
[]
-- | Returns the largest address index for the given account
getMaxAddress ::
T.Text -- ^ The database path
-> ZcashAccountId -- ^ The account ID to check
-> Scope -- ^ The scope of the address
-> IO Int
getMaxAddress dbFp aw s = do
a <-
runSqlite dbFp $
selectFirst
[WalletAddressAccId ==. aw, WalletAddressScope ==. ScopeDB s]
[Desc WalletAddressIndex]
case a of
Nothing -> return $ -1
Just x -> return $ walletAddressIndex $ entityVal x
-- | Save a new address to the database
saveAddress ::
T.Text -- ^ the database path
-> WalletAddress -- ^ The wallet to add to the database
-> IO (Maybe (Entity WalletAddress))
saveAddress dbFp w = runSqlite dbFp $ insertUniqueEntity w

View file

@ -1,7 +1,11 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
module Zenith.Types where
@ -14,7 +18,58 @@ import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode)
import Database.Persist.TH
import GHC.Generics
import ZcashHaskell.Types
( OrchardSpendingKey(..)
, Phrase(..)
, SaplingSpendingKey(..)
, Scope(..)
, TransparentSpendingKey
, ZcashNet(..)
)
newtype ZcashNetDB = ZcashNetDB
{ getNet :: ZcashNet
} deriving newtype (Eq, Show, Read)
derivePersistField "ZcashNetDB"
newtype UnifiedAddressDB = UnifiedAddressDB
{ getUA :: T.Text
} deriving newtype (Eq, Show, Read)
derivePersistField "UnifiedAddressDB"
newtype PhraseDB = PhraseDB
{ getPhrase :: Phrase
} deriving newtype (Eq, Show, Read)
derivePersistField "PhraseDB"
newtype ScopeDB = ScopeDB
{ getScope :: Scope
} deriving newtype (Eq, Show, Read)
derivePersistField "ScopeDB"
newtype OrchardSpendingKeyDB = OrchardSpendingKeyDB
{ getOrchSK :: OrchardSpendingKey
} deriving newtype (Eq, Show, Read)
derivePersistField "OrchardSpendingKeyDB"
newtype SaplingSpendingKeyDB = SaplingSpendingKeyDB
{ getSapSK :: SaplingSpendingKey
} deriving newtype (Eq, Show, Read)
derivePersistField "SaplingSpendingKeyDB"
newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
{ getTranSK :: TransparentSpendingKey
} deriving newtype (Eq, Show, Read)
derivePersistField "TransparentSpendingKeyDB"
-- | A type to model Zcash RPC calls
data RpcCall = RpcCall

View file

@ -9,15 +9,13 @@ import Data.Functor (void)
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.IO as TIO
import System.Process (createProcess_, shell)
import Text.Read (readMaybe)
import Text.Regex.Posix
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
import ZcashHaskell.Sapling (isValidShieldedAddress)
import Zenith.Types
( AddressGroup(..)
, AddressSource(..)
, UnifiedAddressDB(..)
, ZcashAddress(..)
, ZcashPool(..)
)
@ -30,6 +28,12 @@ displayZec s
| s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
-- | Helper function to display abbreviated Unified Address
showAddress :: UnifiedAddressDB -> T.Text
showAddress u = T.take 20 t <> "..."
where
t = getUA u
-- | Helper function to extract addresses from AddressGroups
getAddresses :: AddressGroup -> [ZcashAddress]
getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag

View file

@ -5,9 +5,17 @@ import Database.Persist
import Database.Persist.Sqlite
import System.Directory
import Test.Hspec
import ZcashHaskell.Types (ZcashNet(..))
import Zenith.Core (getAccounts)
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Types
( OrchardSpendingKey(..)
, Phrase(..)
, SaplingSpendingKey(..)
, Scope(..)
, ZcashNet(..)
)
import Zenith.Core
import Zenith.DB
import Zenith.Types
main :: IO ()
main = do
@ -24,10 +32,12 @@ main = do
runSqlite "test.db" $ do
insert $
ZcashWallet
"one two three four five six seven eight nine ten eleven twelve"
2000000
"Main Wallet"
MainNet
(ZcashNetDB MainNet)
(PhraseDB $
Phrase
"one two three four five six seven eight nine ten eleven twelve")
2000000
fromSqlKey s `shouldBe` 1
it "read wallet record" $ do
s <-
@ -48,21 +58,43 @@ main = do
delete recId
get recId
"None" `shouldBe` maybe "None" zcashWalletName s
describe "Account table" $ do
it "insert account" $ do
describe "Wallet function tests:" $ do
it "Save Wallet:" $ do
zw <-
saveWallet "test.db" $
ZcashWallet
"Testing"
(ZcashNetDB MainNet)
(PhraseDB $
Phrase
"cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest")
2200000
zw `shouldNotBe` Nothing
it "Save Account:" $ do
s <-
runSqlite "test.db" $ do
insert $
ZcashWallet
"one two three four five six seven eight nine ten eleven twelve"
2000000
"Main Wallet"
MainNet
t <-
runSqlite "test.db" $ do
insert $ ZcashAccount s 0 "132465798" "987654321" "739182462"
fromSqlKey t `shouldBe` 1
it "read accounts for wallet" $ do
wList <- getWallets "test.db" MainNet
acc <- getAccounts "test.db" $ entityKey (head wList)
length acc `shouldBe` 1
selectList [ZcashWalletName ==. "Testing"] []
za <-
saveAccount "test.db" =<<
createZcashAccount "TestAccount" 0 (head s)
za `shouldNotBe` Nothing
it "Save address:" $ do
acList <-
runSqlite "test.db" $
selectList [ZcashAccountName ==. "TestAccount"] []
zAdd <-
saveAddress "test.db" =<<
createWalletAddress "Personal123" 0 MainNet External (head acList)
addList <-
runSqlite "test.db" $
selectList
[ WalletAddressName ==. "Personal123"
, WalletAddressScope ==. ScopeDB External
]
[]
getUA (walletAddressUAddress (entityVal $ head addList)) `shouldBe`
"u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m"
it "Address components are correct" $ do
let ua =
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
isValidUnifiedAddress ua `shouldNotBe` Nothing

@ -1 +1 @@
Subproject commit a52d2231f1a4f85a6504bfb9228a1475a0773088
Subproject commit f228eff367c776469455adc4d443102cc53e5538

View file

@ -1,10 +1,10 @@
cabal-version: 3.0
name: zenith
version: 0.4.3.0
version: 0.4.4.1
license: MIT
license-file: LICENSE
author: Rene Vergara
maintainer: pitmut@vergara.tech
maintainer: pitmutt@vergara.tech
copyright: (c) 2022-2024 Vergara Technologies LLC
build-type: Custom
category: Blockchain
@ -13,8 +13,6 @@ extra-doc-files:
CHANGELOG.md
zenith.cfg
common warnings
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wunused-imports
custom-setup
setup-depends:
@ -26,7 +24,6 @@ custom-setup
, regex-compat
library
import: warnings
ghc-options: -Wall -Wunused-imports
exposed-modules:
Zenith.CLI
@ -56,6 +53,7 @@ library
, persistent-sqlite
, persistent-template
, process
, hexstring
, regex-base
, regex-compat
, regex-posix
@ -63,12 +61,13 @@ library
, text
, vector
, vty
, word-wrap
, zcash-haskell
--pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010
executable zenith
import: warnings
ghc-options: -threaded -rtsopts -with-rtsopts=-N
main-is: Main.hs
hs-source-dirs:
app
@ -88,8 +87,8 @@ executable zenith
default-language: Haskell2010
test-suite zenith-tests
import: warnings
type: exitcode-stdio-1.0
ghc-options: -threaded -rtsopts -with-rtsopts=-N
main-is: Spec.hs
hs-source-dirs:
test