Include display of balance and transactions #76
11 changed files with 1429 additions and 100 deletions
25
CHANGELOG.md
25
CHANGELOG.md
|
|
@ -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/),
|
||||
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]
|
||||
|
||||
### Added
|
||||
|
|
|
|||
|
|
@ -16,8 +16,10 @@ import System.Environment (getArgs)
|
|||
import System.Exit
|
||||
import System.IO
|
||||
import Text.Read (readMaybe)
|
||||
import ZcashHaskell.Types
|
||||
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.Zcashd
|
||||
|
||||
|
|
@ -204,6 +206,7 @@ main = do
|
|||
nodePwd <- require config "nodePwd"
|
||||
zebraPort <- require config "zebraPort"
|
||||
zebraHost <- require config "zebraHost"
|
||||
let myConfig = Config dbFilePath zebraHost zebraPort
|
||||
if not (null args)
|
||||
then do
|
||||
case head args of
|
||||
|
|
@ -217,7 +220,9 @@ main = do
|
|||
" ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0"
|
||||
}
|
||||
(root nodeUser nodePwd)
|
||||
"cli" -> runZenithCLI zebraHost zebraPort dbFilePath
|
||||
"cli" -> runZenithCLI myConfig
|
||||
"sync" -> testSync myConfig
|
||||
"rescan" -> clearSync myConfig
|
||||
_ -> printUsage
|
||||
else printUsage
|
||||
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@ import Brick.Widgets.Core
|
|||
, padBottom
|
||||
, str
|
||||
, strWrap
|
||||
, strWrapWith
|
||||
, txt
|
||||
, txtWrap
|
||||
, txtWrapWith
|
||||
|
|
@ -53,6 +54,7 @@ import Control.Monad.IO.Class (liftIO)
|
|||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
import qualified Data.Vector as Vec
|
||||
import Database.Persist
|
||||
import qualified Graphics.Vty as V
|
||||
|
|
@ -61,13 +63,18 @@ import Lens.Micro.Mtl
|
|||
import Lens.Micro.TH
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
|
||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||
import ZcashHaskell.Transparent (encodeTransparent)
|
||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
import ZcashHaskell.Types
|
||||
import Zenith.Core
|
||||
import Zenith.DB
|
||||
import Zenith.Types (PhraseDB(..), UnifiedAddressDB(..), ZcashNetDB(..))
|
||||
import Zenith.Utils (showAddress)
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
, PhraseDB(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ZcashNetDB(..)
|
||||
)
|
||||
import Zenith.Utils (displayTaz, displayZec, showAddress)
|
||||
|
||||
data Name
|
||||
= WList
|
||||
|
|
@ -96,6 +103,7 @@ data DisplayType
|
|||
= AddrDisplay
|
||||
| MsgDisplay
|
||||
| PhraseDisplay
|
||||
| TxDisplay
|
||||
| BlankDisplay
|
||||
|
||||
data State = State
|
||||
|
|
@ -103,7 +111,7 @@ data State = State
|
|||
, _wallets :: !(L.List Name (Entity ZcashWallet))
|
||||
, _accounts :: !(L.List Name (Entity ZcashAccount))
|
||||
, _addresses :: !(L.List Name (Entity WalletAddress))
|
||||
, _transactions :: !(L.List Name String)
|
||||
, _transactions :: !(L.List Name (Entity UserTx))
|
||||
, _msg :: !String
|
||||
, _helpBox :: !Bool
|
||||
, _dialogBox :: !DialogType
|
||||
|
|
@ -113,6 +121,8 @@ data State = State
|
|||
, _startBlock :: !Int
|
||||
, _dbPath :: !T.Text
|
||||
, _displayBox :: !DisplayType
|
||||
, _syncBlock :: !Int
|
||||
, _balance :: !Integer
|
||||
}
|
||||
|
||||
makeLenses ''State
|
||||
|
|
@ -142,8 +152,16 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
"(None)"
|
||||
(\(_, a) -> zcashAccountName $ entityVal a)
|
||||
(L.listSelectedElement (st ^. accounts))))) <=>
|
||||
C.hCenter
|
||||
(str
|
||||
("Balance: " ++
|
||||
if st ^. network == MainNet
|
||||
then displayZec (st ^. balance)
|
||||
else displayTaz (st ^. balance))) <=>
|
||||
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
|
||||
(hBox
|
||||
[ capCommand "W" "allets"
|
||||
|
|
@ -185,6 +203,16 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
, str " "
|
||||
, 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 st =
|
||||
if st ^. helpBox
|
||||
|
|
@ -254,7 +282,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
titleAttr
|
||||
(str
|
||||
" _____ _ _ _ \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..."))
|
||||
else emptyWidget
|
||||
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) <=>
|
||||
B.borderWithLabel
|
||||
(str "Legacy Shielded")
|
||||
(txtWrapWith
|
||||
(WrapSettings False True NoFill FillAfterFirst)
|
||||
"Pending") <=>
|
||||
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
||||
fromMaybe "None" $
|
||||
(getSaplingFromUA .
|
||||
E.encodeUtf8 . getUA . walletAddressUAddress)
|
||||
(entityVal a)) <=>
|
||||
B.borderWithLabel
|
||||
(str "Transparent")
|
||||
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
|
||||
maybe "Pending" (encodeTransparent (st ^. network)) $
|
||||
maybe "None" (encodeTransparentReceiver (st ^. network)) $
|
||||
t_rec =<<
|
||||
(isValidUnifiedAddress .
|
||||
E.encodeUtf8 . getUA . walletAddressUAddress)
|
||||
|
|
@ -308,6 +338,35 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
D.renderDialog
|
||||
(D.dialog (Just $ txt "Message") Nothing 50)
|
||||
(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
|
||||
|
||||
mkInputForm :: DialogInput -> Form DialogInput e Name
|
||||
|
|
@ -353,6 +412,23 @@ listDrawAddress sel w =
|
|||
walletAddressName (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 = L.listSelectedAttr <> A.attrName "custom"
|
||||
|
||||
|
|
@ -379,6 +455,7 @@ appEvent (BT.VtyEvent e) = do
|
|||
AddrDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||
MsgDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||
PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||
TxDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||
BlankDisplay -> do
|
||||
case s ^. dialogBox of
|
||||
WName -> do
|
||||
|
|
@ -465,6 +542,9 @@ appEvent (BT.VtyEvent e) = do
|
|||
Blank -> do
|
||||
case e of
|
||||
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 '?') [] -> BT.modify $ set helpBox True
|
||||
V.EvKey (V.KChar 'n') [] ->
|
||||
|
|
@ -473,6 +553,8 @@ appEvent (BT.VtyEvent e) = do
|
|||
BT.modify $ set displayBox AddrDisplay
|
||||
V.EvKey (V.KChar 'w') [] ->
|
||||
BT.modify $ set dialogBox WSelect
|
||||
V.EvKey (V.KChar 't') [] ->
|
||||
BT.modify $ set displayBox TxDisplay
|
||||
V.EvKey (V.KChar 'a') [] ->
|
||||
BT.modify $ set dialogBox ASelect
|
||||
ev ->
|
||||
|
|
@ -511,8 +593,11 @@ theApp =
|
|||
, M.appAttrMap = const theMap
|
||||
}
|
||||
|
||||
runZenithCLI :: T.Text -> Int -> T.Text -> IO ()
|
||||
runZenithCLI host port dbFilePath = do
|
||||
runZenithCLI :: Config -> IO ()
|
||||
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)
|
||||
case w of
|
||||
Right zebra -> do
|
||||
|
|
@ -532,6 +617,18 @@ runZenithCLI host port dbFilePath = do
|
|||
if not (null accList)
|
||||
then getAddresses dbFilePath $ entityKey $ head accList
|
||||
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 $
|
||||
M.defaultMain theApp $
|
||||
State
|
||||
|
|
@ -539,7 +636,7 @@ runZenithCLI host port dbFilePath = do
|
|||
(L.list WList (Vec.fromList walList) 1)
|
||||
(L.list AcList (Vec.fromList accList) 0)
|
||||
(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 " ++
|
||||
(T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
|
||||
False
|
||||
|
|
@ -552,6 +649,8 @@ runZenithCLI host port dbFilePath = do
|
|||
(zgb_blocks chainInfo)
|
||||
dbFilePath
|
||||
MsgDisplay
|
||||
block
|
||||
bal
|
||||
Left e -> do
|
||||
print $
|
||||
"No Zebra node available on port " <>
|
||||
|
|
@ -569,14 +668,29 @@ refreshWallet s = do
|
|||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
aL <- getAccounts (s ^. dbPath) $ entityKey selWallet
|
||||
let bl = zcashWalletLastSync $ entityVal selWallet
|
||||
addrL <-
|
||||
if not (null aL)
|
||||
then getAddresses (s ^. dbPath) $ entityKey $ head aL
|
||||
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 addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
||||
let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions)
|
||||
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)
|
||||
|
||||
addNewWallet :: T.Text -> State -> IO State
|
||||
|
|
@ -586,7 +700,7 @@ addNewWallet n s = do
|
|||
let netName = s ^. network
|
||||
r <-
|
||||
saveWallet (s ^. dbPath) $
|
||||
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH
|
||||
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
|
||||
case r of
|
||||
Nothing -> do
|
||||
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
|
||||
|
|
@ -639,10 +753,42 @@ refreshAccount s = do
|
|||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
|
||||
bal <- getBalance (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)
|
||||
selAddress <-
|
||||
do case L.listSelectedElement aL' of
|
||||
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 n scope s = do
|
||||
|
|
|
|||
|
|
@ -3,35 +3,49 @@
|
|||
-- | Core wallet functionality for Zenith
|
||||
module Zenith.Core where
|
||||
|
||||
import Control.Exception (throwIO)
|
||||
import Control.Exception (throwIO, try)
|
||||
import Data.Aeson
|
||||
import Data.HexString (hexString)
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
import Network.HTTP.Client
|
||||
import ZcashHaskell.Keys
|
||||
import ZcashHaskell.Orchard
|
||||
( encodeUnifiedAddress
|
||||
( decryptOrchardActionSK
|
||||
, encodeUnifiedAddress
|
||||
, genOrchardReceiver
|
||||
, genOrchardSpendingKey
|
||||
, getOrchardNotePosition
|
||||
, getOrchardWitness
|
||||
, updateOrchardCommitmentTree
|
||||
)
|
||||
import ZcashHaskell.Sapling
|
||||
( genSaplingInternalAddress
|
||||
( decodeSaplingOutputEsk
|
||||
, genSaplingInternalAddress
|
||||
, genSaplingPaymentAddress
|
||||
, genSaplingSpendingKey
|
||||
, getSaplingNotePosition
|
||||
, getSaplingWitness
|
||||
, updateSaplingCommitmentTree
|
||||
)
|
||||
import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver)
|
||||
import ZcashHaskell.Types
|
||||
import ZcashHaskell.Utils
|
||||
import Zenith.DB
|
||||
import Zenith.Types
|
||||
( OrchardSpendingKeyDB(..)
|
||||
( Config(..)
|
||||
, HexStringDB(..)
|
||||
, OrchardSpendingKeyDB(..)
|
||||
, PhraseDB(..)
|
||||
, SaplingSpendingKeyDB(..)
|
||||
, ScopeDB(..)
|
||||
, TransparentSpendingKeyDB(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZebraTreeInfo(..)
|
||||
)
|
||||
|
||||
-- * Zebra Node interaction
|
||||
|
|
@ -57,6 +71,23 @@ checkBlockChain nodeHost nodePort = do
|
|||
Left e -> throwIO $ userError e
|
||||
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
|
||||
-- | Create an Orchard Spending Key for the given wallet and account index
|
||||
createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey
|
||||
|
|
@ -159,9 +190,233 @@ createWalletAddress n i zNet scope za = do
|
|||
(ScopeDB scope)
|
||||
|
||||
-- * 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
|
||||
syncWallet ::
|
||||
T.Text -- ^ The database path
|
||||
Config -- ^ configuration parameters
|
||||
-> Entity ZcashWallet
|
||||
-> IO ()
|
||||
syncWallet walletDb w = undefined
|
||||
-> IO String
|
||||
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
|
||||
|
|
|
|||
923
src/Zenith/DB.hs
923
src/Zenith/DB.hs
File diff suppressed because it is too large
Load diff
|
|
@ -44,7 +44,10 @@ scanZebra b host port dbFilePath = do
|
|||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then throwIO $ userError "Invalid starting block for scan"
|
||||
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
|
||||
pg <- newProgressBar def {pgTotal = fromIntegral $ length bList}
|
||||
txList <-
|
||||
|
|
|
|||
|
|
@ -10,7 +10,6 @@
|
|||
module Zenith.Types where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (prependFailure, typeMismatch)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Char8 as C
|
||||
|
|
@ -30,6 +29,7 @@ import ZcashHaskell.Types
|
|||
, ZcashNet(..)
|
||||
)
|
||||
|
||||
-- * UI
|
||||
-- * Database field type wrappers
|
||||
newtype HexStringDB = HexStringDB
|
||||
{ getHex :: HexString
|
||||
|
|
@ -80,6 +80,36 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
|
|||
derivePersistField "TransparentSpendingKeyDB"
|
||||
|
||||
-- * 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
|
||||
data AddressSource
|
||||
= LegacyRandom
|
||||
|
|
|
|||
|
|
@ -31,6 +31,14 @@ displayZec s
|
|||
| s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
|
||||
| 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
|
||||
showAddress :: UnifiedAddressDB -> T.Text
|
||||
showAddress u = T.take 20 t <> "..."
|
||||
|
|
|
|||
64
test/Spec.hs
64
test/Spec.hs
|
|
@ -1,16 +1,27 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import Control.Monad (when)
|
||||
import Data.HexString
|
||||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
import System.Directory
|
||||
import Test.HUnit
|
||||
import Test.Hspec
|
||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||
import ZcashHaskell.Sapling
|
||||
( decodeSaplingOutputEsk
|
||||
, getSaplingNotePosition
|
||||
, getSaplingWitness
|
||||
, updateSaplingCommitmentTree
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
( OrchardSpendingKey(..)
|
||||
( DecodedNote(..)
|
||||
, OrchardSpendingKey(..)
|
||||
, Phrase(..)
|
||||
, SaplingCommitmentTree(..)
|
||||
, SaplingSpendingKey(..)
|
||||
, Scope(..)
|
||||
, ShieldedOutput(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import Zenith.Core
|
||||
|
|
@ -38,6 +49,7 @@ main = do
|
|||
Phrase
|
||||
"one two three four five six seven eight nine ten eleven twelve")
|
||||
2000000
|
||||
0
|
||||
fromSqlKey s `shouldBe` 1
|
||||
it "read wallet record" $ do
|
||||
s <-
|
||||
|
|
@ -69,6 +81,7 @@ main = do
|
|||
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
|
||||
0
|
||||
zw `shouldNotBe` Nothing
|
||||
it "Save Account:" $ do
|
||||
s <-
|
||||
|
|
@ -98,3 +111,52 @@ main = do
|
|||
let ua =
|
||||
"utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
|
||||
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
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
cabal-version: 3.0
|
||||
name: zenith
|
||||
version: 0.4.4.3
|
||||
version: 0.4.6.0
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Rene Vergara
|
||||
|
|
@ -39,10 +39,12 @@ library
|
|||
Clipboard
|
||||
, aeson
|
||||
, array
|
||||
, ascii-progress
|
||||
, base >=4.12 && <5
|
||||
, base64-bytestring
|
||||
, brick
|
||||
, bytestring
|
||||
, esqueleto
|
||||
, ghc
|
||||
, haskoin-core
|
||||
, hexstring
|
||||
|
|
@ -62,10 +64,10 @@ library
|
|||
, regex-posix
|
||||
, scientific
|
||||
, text
|
||||
, time
|
||||
, vector
|
||||
, vty
|
||||
, word-wrap
|
||||
, ascii-progress
|
||||
, zcash-haskell
|
||||
--pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
|
@ -119,6 +121,8 @@ test-suite zenith-tests
|
|||
, persistent
|
||||
, persistent-sqlite
|
||||
, hspec
|
||||
, hexstring
|
||||
, HUnit
|
||||
, directory
|
||||
, zcash-haskell
|
||||
, zenith
|
||||
|
|
|
|||
Loading…
Reference in a new issue