Merge pull request 'Include display of balance and transactions' (#76) from rav001 into dev041

Reviewed-on: #76
This commit is contained in:
pitmutt 2024-04-25 19:24:59 +00:00 committed by Vergara Technologies LLC
commit 8ec2fe31a4
Signed by: Vergara Technologies LLC
GPG Key ID: 99DB473BB4715618
11 changed files with 1429 additions and 100 deletions

View File

@ -5,6 +5,31 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [0.4.6.0]
### Added
- Display of account balance
- Functions to identify spends
- Functions to display transactions per address
### Changed
- Update `zcash-haskell`
## [0.4.5.0]
### Added
- Functions to scan relevant transparent notes
- Functions to scan relevant Sapling notes
- Functions to scan relevant Orchard notes
- Function to query `zebrad` for commitment trees
### Changed
- Update `zcash-haskell`
## [0.4.4.3] ## [0.4.4.3]
### Added ### Added

View File

@ -16,8 +16,10 @@ import System.Environment (getArgs)
import System.Exit import System.Exit
import System.IO import System.IO
import Text.Read (readMaybe) import Text.Read (readMaybe)
import ZcashHaskell.Types
import Zenith.CLI import Zenith.CLI
import Zenith.Types (ZcashAddress(..), ZcashPool(..), ZcashTx(..)) import Zenith.Core (clearSync, testSync)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils import Zenith.Utils
import Zenith.Zcashd import Zenith.Zcashd
@ -204,6 +206,7 @@ main = do
nodePwd <- require config "nodePwd" nodePwd <- require config "nodePwd"
zebraPort <- require config "zebraPort" zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost" zebraHost <- require config "zebraHost"
let myConfig = Config dbFilePath zebraHost zebraPort
if not (null args) if not (null args)
then do then do
case head args of case head args of
@ -217,7 +220,9 @@ main = do
" ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0" " ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0"
} }
(root nodeUser nodePwd) (root nodeUser nodePwd)
"cli" -> runZenithCLI zebraHost zebraPort dbFilePath "cli" -> runZenithCLI myConfig
"sync" -> testSync myConfig
"rescan" -> clearSync myConfig
_ -> printUsage _ -> printUsage
else printUsage else printUsage

View File

@ -37,6 +37,7 @@ import Brick.Widgets.Core
, padBottom , padBottom
, str , str
, strWrap , strWrap
, strWrapWith
, txt , txt
, txtWrap , txtWrap
, txtWrapWith , txtWrapWith
@ -53,6 +54,7 @@ import Control.Monad.IO.Class (liftIO)
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified Data.Vector as Vec import qualified Data.Vector as Vec
import Database.Persist import Database.Persist
import qualified Graphics.Vty as V import qualified Graphics.Vty as V
@ -61,13 +63,18 @@ import Lens.Micro.Mtl
import Lens.Micro.TH import Lens.Micro.TH
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard (isValidUnifiedAddress) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparent) import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types import ZcashHaskell.Types
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Types (PhraseDB(..), UnifiedAddressDB(..), ZcashNetDB(..)) import Zenith.Types
import Zenith.Utils (showAddress) ( Config(..)
, PhraseDB(..)
, UnifiedAddressDB(..)
, ZcashNetDB(..)
)
import Zenith.Utils (displayTaz, displayZec, showAddress)
data Name data Name
= WList = WList
@ -96,6 +103,7 @@ data DisplayType
= AddrDisplay = AddrDisplay
| MsgDisplay | MsgDisplay
| PhraseDisplay | PhraseDisplay
| TxDisplay
| BlankDisplay | BlankDisplay
data State = State data State = State
@ -103,7 +111,7 @@ data State = State
, _wallets :: !(L.List Name (Entity ZcashWallet)) , _wallets :: !(L.List Name (Entity ZcashWallet))
, _accounts :: !(L.List Name (Entity ZcashAccount)) , _accounts :: !(L.List Name (Entity ZcashAccount))
, _addresses :: !(L.List Name (Entity WalletAddress)) , _addresses :: !(L.List Name (Entity WalletAddress))
, _transactions :: !(L.List Name String) , _transactions :: !(L.List Name (Entity UserTx))
, _msg :: !String , _msg :: !String
, _helpBox :: !Bool , _helpBox :: !Bool
, _dialogBox :: !DialogType , _dialogBox :: !DialogType
@ -113,6 +121,8 @@ data State = State
, _startBlock :: !Int , _startBlock :: !Int
, _dbPath :: !T.Text , _dbPath :: !T.Text
, _displayBox :: !DisplayType , _displayBox :: !DisplayType
, _syncBlock :: !Int
, _balance :: !Integer
} }
makeLenses ''State makeLenses ''State
@ -142,8 +152,16 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
"(None)" "(None)"
(\(_, a) -> zcashAccountName $ entityVal a) (\(_, a) -> zcashAccountName $ entityVal a)
(L.listSelectedElement (st ^. accounts))))) <=> (L.listSelectedElement (st ^. accounts))))) <=>
C.hCenter
(str
("Balance: " ++
if st ^. network == MainNet
then displayZec (st ^. balance)
else displayTaz (st ^. balance))) <=>
listAddressBox "Addresses" (st ^. addresses) <+> listAddressBox "Addresses" (st ^. addresses) <+>
B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=> B.vBorder <+>
(C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=>
listTxBox "Transactions" (st ^. transactions))) <=>
C.hCenter C.hCenter
(hBox (hBox
[ capCommand "W" "allets" [ capCommand "W" "allets"
@ -185,6 +203,16 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
, str " " , str " "
, C.hCenter $ str "Use arrows to select" , C.hCenter $ str "Use arrows to select"
] ]
listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name
listTxBox titleLabel tx =
C.vCenter $
vBox
[ C.hCenter
(B.borderWithLabel (str titleLabel) $
hLimit 40 $ vLimit 15 $ L.renderList listDrawTx True tx)
, str " "
, C.hCenter $ str "Use arrows to select"
]
helpDialog :: State -> Widget Name helpDialog :: State -> Widget Name
helpDialog st = helpDialog st =
if st ^. helpBox if st ^. helpBox
@ -254,7 +282,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
titleAttr titleAttr
(str (str
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.4.0")) <=> C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.6.0")) <=>
C.hCenter (withAttr blinkAttr $ str "Press any key...")) C.hCenter (withAttr blinkAttr $ str "Press any key..."))
else emptyWidget else emptyWidget
capCommand :: String -> String -> Widget Name capCommand :: String -> String -> Widget Name
@ -280,13 +308,15 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
getUA $ walletAddressUAddress $ entityVal a) <=> getUA $ walletAddressUAddress $ entityVal a) <=>
B.borderWithLabel B.borderWithLabel
(str "Legacy Shielded") (str "Legacy Shielded")
(txtWrapWith (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
(WrapSettings False True NoFill FillAfterFirst) fromMaybe "None" $
"Pending") <=> (getSaplingFromUA .
E.encodeUtf8 . getUA . walletAddressUAddress)
(entityVal a)) <=>
B.borderWithLabel B.borderWithLabel
(str "Transparent") (str "Transparent")
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
maybe "Pending" (encodeTransparent (st ^. network)) $ maybe "None" (encodeTransparentReceiver (st ^. network)) $
t_rec =<< t_rec =<<
(isValidUnifiedAddress . (isValidUnifiedAddress .
E.encodeUtf8 . getUA . walletAddressUAddress) E.encodeUtf8 . getUA . walletAddressUAddress)
@ -308,6 +338,35 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
D.renderDialog D.renderDialog
(D.dialog (Just $ txt "Message") Nothing 50) (D.dialog (Just $ txt "Message") Nothing 50)
(padAll 1 $ strWrap $ st ^. msg) (padAll 1 $ strWrap $ st ^. msg)
TxDisplay ->
case L.listSelectedElement $ st ^. transactions of
Nothing -> emptyWidget
Just (_, tx) ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt "Transaction") Nothing 50)
(padAll
1
(str
("Date: " ++
show
(posixSecondsToUTCTime
(fromIntegral (userTxTime $ entityVal tx)))) <=>
(str "Tx ID: " <+>
strWrapWith
(WrapSettings False True NoFill FillAfterFirst)
(show (userTxHex $ entityVal tx))) <=>
str
("Amount: " ++
if st ^. network == MainNet
then displayZec
(fromIntegral $ userTxAmount $ entityVal tx)
else displayTaz
(fromIntegral $ userTxAmount $ entityVal tx)) <=>
(txt "Memo: " <+>
txtWrapWith
(WrapSettings False True NoFill FillAfterFirst)
(userTxMemo (entityVal tx)))))
BlankDisplay -> emptyWidget BlankDisplay -> emptyWidget
mkInputForm :: DialogInput -> Form DialogInput e Name mkInputForm :: DialogInput -> Form DialogInput e Name
@ -353,6 +412,23 @@ listDrawAddress sel w =
walletAddressName (entityVal w) <> walletAddressName (entityVal w) <>
": " <> showAddress (walletAddressUAddress (entityVal w)) ": " <> showAddress (walletAddressUAddress (entityVal w))
listDrawTx :: Bool -> Entity UserTx -> Widget Name
listDrawTx sel tx =
selStr $
T.pack
(show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <>
" " <> fmtAmt
where
amt = fromIntegral (userTxAmount $ entityVal tx) / 100000000
fmtAmt =
if amt > 0
then "" <> T.pack (show amt) <> " "
else " " <> T.pack (show amt) <> ""
selStr s =
if sel
then withAttr customAttr (txt $ "> " <> s)
else txt $ " " <> s
customAttr :: A.AttrName customAttr :: A.AttrName
customAttr = L.listSelectedAttr <> A.attrName "custom" customAttr = L.listSelectedAttr <> A.attrName "custom"
@ -379,6 +455,7 @@ appEvent (BT.VtyEvent e) = do
AddrDisplay -> BT.modify $ set displayBox BlankDisplay AddrDisplay -> BT.modify $ set displayBox BlankDisplay
MsgDisplay -> BT.modify $ set displayBox BlankDisplay MsgDisplay -> BT.modify $ set displayBox BlankDisplay
PhraseDisplay -> BT.modify $ set displayBox BlankDisplay PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
TxDisplay -> BT.modify $ set displayBox BlankDisplay
BlankDisplay -> do BlankDisplay -> do
case s ^. dialogBox of case s ^. dialogBox of
WName -> do WName -> do
@ -465,6 +542,9 @@ appEvent (BT.VtyEvent e) = do
Blank -> do Blank -> do
case e of case e of
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
V.EvKey V.KEnter [] -> do
ns <- liftIO $ refreshTxs s
BT.put ns
V.EvKey (V.KChar 'q') [] -> M.halt V.EvKey (V.KChar 'q') [] -> M.halt
V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True
V.EvKey (V.KChar 'n') [] -> V.EvKey (V.KChar 'n') [] ->
@ -473,6 +553,8 @@ appEvent (BT.VtyEvent e) = do
BT.modify $ set displayBox AddrDisplay BT.modify $ set displayBox AddrDisplay
V.EvKey (V.KChar 'w') [] -> V.EvKey (V.KChar 'w') [] ->
BT.modify $ set dialogBox WSelect BT.modify $ set dialogBox WSelect
V.EvKey (V.KChar 't') [] ->
BT.modify $ set displayBox TxDisplay
V.EvKey (V.KChar 'a') [] -> V.EvKey (V.KChar 'a') [] ->
BT.modify $ set dialogBox ASelect BT.modify $ set dialogBox ASelect
ev -> ev ->
@ -511,8 +593,11 @@ theApp =
, M.appAttrMap = const theMap , M.appAttrMap = const theMap
} }
runZenithCLI :: T.Text -> Int -> T.Text -> IO () runZenithCLI :: Config -> IO ()
runZenithCLI host port dbFilePath = do runZenithCLI config = do
let host = c_zebraHost config
let port = c_zebraPort config
let dbFilePath = c_dbPath config
w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo) w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
case w of case w of
Right zebra -> do Right zebra -> do
@ -532,6 +617,18 @@ runZenithCLI host port dbFilePath = do
if not (null accList) if not (null accList)
then getAddresses dbFilePath $ entityKey $ head accList then getAddresses dbFilePath $ entityKey $ head accList
else return [] else return []
txList <-
if not (null addrList)
then getUserTx dbFilePath $ entityKey $ head addrList
else return []
let block =
if not (null walList)
then zcashWalletLastSync $ entityVal $ head walList
else 0
bal <-
if not (null accList)
then getBalance dbFilePath $ entityKey $ head accList
else return 0
void $ void $
M.defaultMain theApp $ M.defaultMain theApp $
State State
@ -539,7 +636,7 @@ runZenithCLI host port dbFilePath = do
(L.list WList (Vec.fromList walList) 1) (L.list WList (Vec.fromList walList) 1)
(L.list AcList (Vec.fromList accList) 0) (L.list AcList (Vec.fromList accList) 0)
(L.list AList (Vec.fromList addrList) 1) (L.list AList (Vec.fromList addrList) 1)
(L.list TList (Vec.fromList ["tx1", "tx2", "tx3"]) 1) (L.list TList (Vec.fromList txList) 1)
("Start up Ok! Connected to Zebra " ++ ("Start up Ok! Connected to Zebra " ++
(T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".") (T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
False False
@ -552,6 +649,8 @@ runZenithCLI host port dbFilePath = do
(zgb_blocks chainInfo) (zgb_blocks chainInfo)
dbFilePath dbFilePath
MsgDisplay MsgDisplay
block
bal
Left e -> do Left e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>
@ -569,14 +668,29 @@ refreshWallet s = do
Just (_j, w1) -> return w1 Just (_j, w1) -> return w1
Just (_k, w) -> return w Just (_k, w) -> return w
aL <- getAccounts (s ^. dbPath) $ entityKey selWallet aL <- getAccounts (s ^. dbPath) $ entityKey selWallet
let bl = zcashWalletLastSync $ entityVal selWallet
addrL <- addrL <-
if not (null aL) if not (null aL)
then getAddresses (s ^. dbPath) $ entityKey $ head aL then getAddresses (s ^. dbPath) $ entityKey $ head aL
else return [] else return []
bal <-
if not (null aL)
then getBalance (s ^. dbPath) $ entityKey $ head aL
else return 0
txL <-
if not (null addrL)
then getUserTx (s ^. dbPath) $ entityKey $ head addrL
else return []
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts) let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses) let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions)
return $ return $
(s & accounts .~ aL') & addresses .~ addrL' & msg .~ "Switched to wallet: " ++ (s & accounts .~ aL') & syncBlock .~ bl & balance .~ bal & addresses .~
addrL' &
transactions .~
txL' &
msg .~
"Switched to wallet: " ++
T.unpack (zcashWalletName $ entityVal selWallet) T.unpack (zcashWalletName $ entityVal selWallet)
addNewWallet :: T.Text -> State -> IO State addNewWallet :: T.Text -> State -> IO State
@ -586,7 +700,7 @@ addNewWallet n s = do
let netName = s ^. network let netName = s ^. network
r <- r <-
saveWallet (s ^. dbPath) $ saveWallet (s ^. dbPath) $
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
case r of case r of
Nothing -> do Nothing -> do
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n) return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
@ -639,10 +753,42 @@ refreshAccount s = do
Just (_j, w1) -> return w1 Just (_j, w1) -> return w1
Just (_k, w) -> return w Just (_k, w) -> return w
aL <- getAddresses (s ^. dbPath) $ entityKey selAccount aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
bal <- getBalance (s ^. dbPath) $ entityKey selAccount
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses) let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
return $ selAddress <-
s & addresses .~ aL' & msg .~ "Switched to account: " ++ do case L.listSelectedElement aL' of
T.unpack (zcashAccountName $ entityVal selAccount) Nothing -> do
let fAdd = L.listSelectedElement $ L.listMoveToBeginning aL'
return fAdd
Just a2 -> return $ Just a2
case selAddress of
Nothing ->
return $
s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
Just (_i, a) -> do
tList <- getUserTx (s ^. dbPath) $ entityKey a
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
return $
s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~
"Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
refreshTxs :: State -> IO State
refreshTxs s = do
selAddress <-
do case L.listSelectedElement $ s ^. addresses of
Nothing -> do
let fAdd =
L.listSelectedElement $ L.listMoveToBeginning $ s ^. addresses
return fAdd
Just a2 -> return $ Just a2
case selAddress of
Nothing -> return s
Just (_i, a) -> do
tList <- getUserTx (s ^. dbPath) $ entityKey a
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
return $ s & transactions .~ tL'
addNewAddress :: T.Text -> Scope -> State -> IO State addNewAddress :: T.Text -> Scope -> State -> IO State
addNewAddress n scope s = do addNewAddress n scope s = do

View File

@ -3,35 +3,49 @@
-- | Core wallet functionality for Zenith -- | Core wallet functionality for Zenith
module Zenith.Core where module Zenith.Core where
import Control.Exception (throwIO) import Control.Exception (throwIO, try)
import Data.Aeson import Data.Aeson
import Data.HexString (hexString) import Data.HexString (hexString)
import Data.Maybe (fromJust)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Database.Persist import Database.Persist
import Database.Persist.Sqlite
import Network.HTTP.Client import Network.HTTP.Client
import ZcashHaskell.Keys import ZcashHaskell.Keys
import ZcashHaskell.Orchard import ZcashHaskell.Orchard
( encodeUnifiedAddress ( decryptOrchardActionSK
, encodeUnifiedAddress
, genOrchardReceiver , genOrchardReceiver
, genOrchardSpendingKey , genOrchardSpendingKey
, getOrchardNotePosition
, getOrchardWitness
, updateOrchardCommitmentTree
) )
import ZcashHaskell.Sapling import ZcashHaskell.Sapling
( genSaplingInternalAddress ( decodeSaplingOutputEsk
, genSaplingInternalAddress
, genSaplingPaymentAddress , genSaplingPaymentAddress
, genSaplingSpendingKey , genSaplingSpendingKey
, getSaplingNotePosition
, getSaplingWitness
, updateSaplingCommitmentTree
) )
import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver) import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver)
import ZcashHaskell.Types import ZcashHaskell.Types
import ZcashHaskell.Utils import ZcashHaskell.Utils
import Zenith.DB import Zenith.DB
import Zenith.Types import Zenith.Types
( OrchardSpendingKeyDB(..) ( Config(..)
, HexStringDB(..)
, OrchardSpendingKeyDB(..)
, PhraseDB(..) , PhraseDB(..)
, SaplingSpendingKeyDB(..) , SaplingSpendingKeyDB(..)
, ScopeDB(..) , ScopeDB(..)
, TransparentSpendingKeyDB(..) , TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZebraTreeInfo(..)
) )
-- * Zebra Node interaction -- * Zebra Node interaction
@ -57,6 +71,23 @@ checkBlockChain nodeHost nodePort = do
Left e -> throwIO $ userError e Left e -> throwIO $ userError e
Right bci -> return bci Right bci -> return bci
-- | Get commitment trees from Zebra
getCommitmentTrees ::
T.Text -- ^ Host where `zebrad` is avaiable
-> Int -- ^ Port where `zebrad` is available
-> Int -- ^ Block height
-> IO ZebraTreeInfo
getCommitmentTrees nodeHost nodePort block = do
r <-
makeZebraCall
nodeHost
nodePort
"z_gettreestate"
[Data.Aeson.String $ T.pack $ show block]
case r of
Left e -> throwIO $ userError e
Right zti -> return zti
-- * Spending Keys -- * Spending Keys
-- | Create an Orchard Spending Key for the given wallet and account index -- | Create an Orchard Spending Key for the given wallet and account index
createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey
@ -159,9 +190,233 @@ createWalletAddress n i zNet scope za = do
(ScopeDB scope) (ScopeDB scope)
-- * Wallet -- * Wallet
-- | Find the Sapling notes that match the given spending key
findSaplingOutputs ::
Config -- ^ the configuration parameters
-> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network
-> Entity ZcashAccount -- ^ The account to use
-> IO ()
findSaplingOutputs config b znet za = do
let dbPath = c_dbPath config
let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config
let zn = getNet znet
tList <- getShieldedOutputs dbPath b
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = SaplingCommitmentTree $ ztiSapling trees
decryptNotes sT zn tList
sapNotes <- getWalletSapNotes dbPath (entityKey za)
findSapSpends dbPath (entityKey za) sapNotes
where
sk :: SaplingSpendingKeyDB
sk = zcashAccountSapSpendKey $ entityVal za
decryptNotes ::
SaplingCommitmentTree
-> ZcashNet
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
-> IO ()
decryptNotes _ _ [] = return ()
decryptNotes st n ((zt, o):txs) = do
let updatedTree =
updateSaplingCommitmentTree
st
(getHex $ shieldOutputCmu $ entityVal o)
case updatedTree of
Nothing -> throwIO $ userError "Failed to update commitment tree"
Just uT -> do
let noteWitness = getSaplingWitness uT
let notePos = getSaplingNotePosition <$> noteWitness
case notePos of
Nothing -> throwIO $ userError "Failed to obtain note position"
Just nP -> do
case decodeShOut External n nP o of
Nothing -> do
case decodeShOut Internal n nP o of
Nothing -> do
decryptNotes uT n txs
Just dn1 -> do
print dn1
wId <-
saveWalletTransaction
(c_dbPath config)
(entityKey za)
zt
saveWalletSapNote
(c_dbPath config)
wId
nP
(fromJust noteWitness)
True
(entityKey za)
dn1
decryptNotes uT n txs
Just dn0 -> do
print dn0
wId <-
saveWalletTransaction (c_dbPath config) (entityKey za) zt
saveWalletSapNote
(c_dbPath config)
wId
nP
(fromJust noteWitness)
False
(entityKey za)
dn0
decryptNotes uT n txs
decodeShOut ::
Scope
-> ZcashNet
-> Integer
-> Entity ShieldOutput
-> Maybe DecodedNote
decodeShOut scope n pos s = do
decodeSaplingOutputEsk
(getSapSK sk)
(ShieldedOutput
(getHex $ shieldOutputCv $ entityVal s)
(getHex $ shieldOutputCmu $ entityVal s)
(getHex $ shieldOutputEphKey $ entityVal s)
(getHex $ shieldOutputEncCipher $ entityVal s)
(getHex $ shieldOutputOutCipher $ entityVal s)
(getHex $ shieldOutputProof $ entityVal s))
n
scope
pos
-- | Get Orchard actions
findOrchardActions ::
Config -- ^ the configuration parameters
-> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network
-> Entity ZcashAccount -- ^ The account to use
-> IO ()
findOrchardActions config b znet za = do
let dbPath = c_dbPath config
let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config
let zn = getNet znet
tList <- getOrchardActions dbPath b
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = OrchardCommitmentTree $ ztiOrchard trees
decryptNotes sT zn tList
orchNotes <- getWalletOrchNotes dbPath (entityKey za)
findOrchSpends dbPath (entityKey za) orchNotes
where
decryptNotes ::
OrchardCommitmentTree
-> ZcashNet
-> [(Entity ZcashTransaction, Entity OrchAction)]
-> IO ()
decryptNotes _ _ [] = return ()
decryptNotes ot n ((zt, o):txs) = do
let updatedTree =
updateOrchardCommitmentTree
ot
(getHex $ orchActionCmx $ entityVal o)
case updatedTree of
Nothing -> throwIO $ userError "Failed to update commitment tree"
Just uT -> do
let noteWitness = getOrchardWitness uT
let notePos = getOrchardNotePosition <$> noteWitness
case notePos of
Nothing -> throwIO $ userError "Failed to obtain note position"
Just nP ->
case decodeOrchAction External nP o of
Nothing ->
case decodeOrchAction Internal nP o of
Nothing -> decryptNotes uT n txs
Just dn1 -> do
print dn1
wId <-
saveWalletTransaction
(c_dbPath config)
(entityKey za)
zt
saveWalletOrchNote
(c_dbPath config)
wId
nP
(fromJust noteWitness)
True
(entityKey za)
dn1
decryptNotes uT n txs
Just dn -> do
print dn
wId <-
saveWalletTransaction (c_dbPath config) (entityKey za) zt
saveWalletOrchNote
(c_dbPath config)
wId
nP
(fromJust noteWitness)
False
(entityKey za)
dn
decryptNotes uT n txs
sk :: OrchardSpendingKeyDB
sk = zcashAccountOrchSpendKey $ entityVal za
decodeOrchAction ::
Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote
decodeOrchAction scope pos o =
decryptOrchardActionSK (getOrchSK sk) scope $
OrchardAction
(getHex $ orchActionNf $ entityVal o)
(getHex $ orchActionRk $ entityVal o)
(getHex $ orchActionCmx $ entityVal o)
(getHex $ orchActionEphKey $ entityVal o)
(getHex $ orchActionEncCipher $ entityVal o)
(getHex $ orchActionOutCipher $ entityVal o)
(getHex $ orchActionCv $ entityVal o)
(getHex $ orchActionAuth $ entityVal o)
-- | Sync the wallet with the data store -- | Sync the wallet with the data store
syncWallet :: syncWallet ::
T.Text -- ^ The database path Config -- ^ configuration parameters
-> Entity ZcashWallet -> Entity ZcashWallet
-> IO () -> IO String
syncWallet walletDb w = undefined syncWallet config w = do
let walletDb = c_dbPath config
accs <- getAccounts walletDb $ entityKey w
addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
intAddrs <- concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
chainTip <- getMaxBlock walletDb
let lastBlock = zcashWalletLastSync $ entityVal w
let startBlock =
if lastBlock > 0
then lastBlock
else zcashWalletBirthdayHeight $ entityVal w
mapM_ (findTransparentNotes walletDb startBlock) addrs
mapM_ (findTransparentNotes walletDb startBlock) intAddrs
mapM_ (findTransparentSpends walletDb . entityKey) accs
sapNotes <-
mapM
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
accs
orchNotes <-
mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
accs
updateWalletSync walletDb chainTip (entityKey w)
mapM_ (getWalletTransactions walletDb) addrs
return "Testing"
testSync :: Config -> IO ()
testSync config = do
let dbPath = c_dbPath config
_ <- initDb dbPath
w <- getWallets dbPath TestNet
r <- mapM (syncWallet config) w
print r
clearSync :: Config -> IO ()
clearSync config = do
let dbPath = c_dbPath config
_ <- initDb dbPath
_ <- clearWalletTransactions dbPath
w <- getWallets dbPath TestNet
mapM_ (updateWalletSync dbPath 0 . entityKey) w
w' <- getWallets dbPath TestNet
r <- mapM (syncWallet config) w'
print r

File diff suppressed because it is too large Load Diff

View File

@ -44,7 +44,10 @@ scanZebra b host port dbFilePath = do
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then throwIO $ userError "Invalid starting block for scan" then throwIO $ userError "Invalid starting block for scan"
else do else do
let bList = [sb .. (zgb_blocks bStatus)] print $
"Scanning from " ++
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
displayConsoleRegions $ do displayConsoleRegions $ do
pg <- newProgressBar def {pgTotal = fromIntegral $ length bList} pg <- newProgressBar def {pgTotal = fromIntegral $ length bList}
txList <- txList <-

View File

@ -10,7 +10,6 @@
module Zenith.Types where module Zenith.Types where
import Data.Aeson import Data.Aeson
import Data.Aeson.Types (prependFailure, typeMismatch)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Char8 as C
@ -30,6 +29,7 @@ import ZcashHaskell.Types
, ZcashNet(..) , ZcashNet(..)
) )
-- * UI
-- * Database field type wrappers -- * Database field type wrappers
newtype HexStringDB = HexStringDB newtype HexStringDB = HexStringDB
{ getHex :: HexString { getHex :: HexString
@ -80,6 +80,36 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
derivePersistField "TransparentSpendingKeyDB" derivePersistField "TransparentSpendingKeyDB"
-- * RPC -- * RPC
-- | Type for Configuration parameters
data Config = Config
{ c_dbPath :: !T.Text
, c_zebraHost :: !T.Text
, c_zebraPort :: !Int
} deriving (Eq, Prelude.Show)
-- ** `zebrad`
-- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo
{ ztiHeight :: !Int
, ztiTime :: !Int
, ztiSapling :: !HexString
, ztiOrchard :: !HexString
} deriving (Eq, Show, Read)
instance FromJSON ZebraTreeInfo where
parseJSON =
withObject "ZebraTreeInfo" $ \obj -> do
h <- obj .: "height"
t <- obj .: "time"
s <- obj .: "sapling"
o <- obj .: "orchard"
sc <- s .: "commitments"
oc <- o .: "commitments"
sf <- sc .: "finalState"
ocf <- oc .: "finalState"
pure $ ZebraTreeInfo h t sf ocf
-- ** `zcashd`
-- | Type for modelling the different address sources for `zcashd` 5.0.0 -- | Type for modelling the different address sources for `zcashd` 5.0.0
data AddressSource data AddressSource
= LegacyRandom = LegacyRandom

View File

@ -31,6 +31,14 @@ displayZec s
| s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC " | s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC " | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
-- | Helper function to display small amounts of ZEC
displayTaz :: Integer -> String
displayTaz s
| s < 100 = show s ++ " tazs "
| s < 100000 = show (fromIntegral s / 100) ++ " μTAZ "
| s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ "
| otherwise = show (fromIntegral s / 100000000) ++ " TAZ "
-- | Helper function to display abbreviated Unified Address -- | Helper function to display abbreviated Unified Address
showAddress :: UnifiedAddressDB -> T.Text showAddress :: UnifiedAddressDB -> T.Text
showAddress u = T.take 20 t <> "..." showAddress u = T.take 20 t <> "..."

View File

@ -1,16 +1,27 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Control.Monad (when) import Control.Monad (when)
import Data.HexString
import Database.Persist import Database.Persist
import Database.Persist.Sqlite import Database.Persist.Sqlite
import System.Directory import System.Directory
import Test.HUnit
import Test.Hspec import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress) import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Sapling
( decodeSaplingOutputEsk
, getSaplingNotePosition
, getSaplingWitness
, updateSaplingCommitmentTree
)
import ZcashHaskell.Types import ZcashHaskell.Types
( OrchardSpendingKey(..) ( DecodedNote(..)
, OrchardSpendingKey(..)
, Phrase(..) , Phrase(..)
, SaplingCommitmentTree(..)
, SaplingSpendingKey(..) , SaplingSpendingKey(..)
, Scope(..) , Scope(..)
, ShieldedOutput(..)
, ZcashNet(..) , ZcashNet(..)
) )
import Zenith.Core import Zenith.Core
@ -38,6 +49,7 @@ main = do
Phrase Phrase
"one two three four five six seven eight nine ten eleven twelve") "one two three four five six seven eight nine ten eleven twelve")
2000000 2000000
0
fromSqlKey s `shouldBe` 1 fromSqlKey s `shouldBe` 1
it "read wallet record" $ do it "read wallet record" $ do
s <- s <-
@ -69,6 +81,7 @@ main = do
Phrase 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") "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 2200000
0
zw `shouldNotBe` Nothing zw `shouldNotBe` Nothing
it "Save Account:" $ do it "Save Account:" $ do
s <- s <-
@ -98,3 +111,52 @@ main = do
let ua = let ua =
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x" "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
isValidUnifiedAddress ua `shouldNotBe` Nothing isValidUnifiedAddress ua `shouldNotBe` Nothing
describe "Function tests" $ do
describe "Sapling Decoding" $ do
let sk =
SaplingSpendingKey
"\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB"
let tree =
SaplingCommitmentTree $
hexString
"01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
let nextTree =
SaplingCommitmentTree $
hexString
"01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
it "Sapling is decoded correctly" $ do
so <-
runSqlite "zenith.db" $
selectList [ShieldOutputTx ==. toSqlKey 38318] []
let cmus = map (getHex . shieldOutputCmu . entityVal) so
let pos =
getSaplingNotePosition <$>
(getSaplingWitness =<<
updateSaplingCommitmentTree tree (head cmus))
let pos1 = getSaplingNotePosition <$> getSaplingWitness tree
let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree
case pos of
Nothing -> assertFailure "couldn't get note position"
Just p -> do
print p
print pos1
print pos2
let dn =
decodeSaplingOutputEsk
sk
(ShieldedOutput
(getHex $ shieldOutputCv $ entityVal $ head so)
(getHex $ shieldOutputCmu $ entityVal $ head so)
(getHex $ shieldOutputEphKey $ entityVal $ head so)
(getHex $ shieldOutputEncCipher $ entityVal $ head so)
(getHex $ shieldOutputOutCipher $ entityVal $ head so)
(getHex $ shieldOutputProof $ entityVal $ head so))
TestNet
External
p
case dn of
Nothing -> assertFailure "couldn't decode Sap output"
Just d ->
a_nullifier d `shouldBe`
hexString
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"

@ -1 +1 @@
Subproject commit 938ccb4b9730fd8615513eb27bdbffacd62e29cc Subproject commit 00400c433dd8a584ef19af58fcab7fdd108d4110

View File

@ -1,6 +1,6 @@
cabal-version: 3.0 cabal-version: 3.0
name: zenith name: zenith
version: 0.4.4.3 version: 0.4.6.0
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Rene Vergara author: Rene Vergara
@ -39,10 +39,12 @@ library
Clipboard Clipboard
, aeson , aeson
, array , array
, ascii-progress
, base >=4.12 && <5 , base >=4.12 && <5
, base64-bytestring , base64-bytestring
, brick , brick
, bytestring , bytestring
, esqueleto
, ghc , ghc
, haskoin-core , haskoin-core
, hexstring , hexstring
@ -62,10 +64,10 @@ library
, regex-posix , regex-posix
, scientific , scientific
, text , text
, time
, vector , vector
, vty , vty
, word-wrap , word-wrap
, ascii-progress
, zcash-haskell , zcash-haskell
--pkgconfig-depends: rustzcash_wrapper --pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010 default-language: Haskell2010
@ -119,6 +121,8 @@ test-suite zenith-tests
, persistent , persistent
, persistent-sqlite , persistent-sqlite
, hspec , hspec
, hexstring
, HUnit
, directory , directory
, zcash-haskell , zcash-haskell
, zenith , zenith