Compare commits
10 commits
a36de0a307
...
8ec2fe31a4
Author | SHA1 | Date | |
---|---|---|---|
8ec2fe31a4 | |||
900d4f9da6 | |||
53c18a833b | |||
07c1b85829 | |||
52ac50e30c | |||
29bed14f7c | |||
c6da52f594 | |||
9471a861c6 | |||
0543c1141c | |||
5ce822e52f |
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/),
|
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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
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
|
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 <-
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 <> "..."
|
||||||
|
|
64
test/Spec.hs
64
test/Spec.hs
|
@ -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
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue