Publish Zenith beta version #80
6 changed files with 365 additions and 14 deletions
|
@ -53,6 +53,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
|
||||||
|
@ -70,9 +71,10 @@ import Zenith.Types
|
||||||
( Config(..)
|
( Config(..)
|
||||||
, PhraseDB(..)
|
, PhraseDB(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
|
, UserTx(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
)
|
)
|
||||||
import Zenith.Utils (showAddress)
|
import Zenith.Utils (displayTaz, displayZec, showAddress)
|
||||||
|
|
||||||
data Name
|
data Name
|
||||||
= WList
|
= WList
|
||||||
|
@ -101,6 +103,7 @@ data DisplayType
|
||||||
= AddrDisplay
|
= AddrDisplay
|
||||||
| MsgDisplay
|
| MsgDisplay
|
||||||
| PhraseDisplay
|
| PhraseDisplay
|
||||||
|
| TxDisplay
|
||||||
| BlankDisplay
|
| BlankDisplay
|
||||||
|
|
||||||
data State = State
|
data State = State
|
||||||
|
@ -108,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 UserTx)
|
||||||
, _msg :: !String
|
, _msg :: !String
|
||||||
, _helpBox :: !Bool
|
, _helpBox :: !Bool
|
||||||
, _dialogBox :: !DialogType
|
, _dialogBox :: !DialogType
|
||||||
|
@ -118,6 +121,7 @@ data State = State
|
||||||
, _startBlock :: !Int
|
, _startBlock :: !Int
|
||||||
, _dbPath :: !T.Text
|
, _dbPath :: !T.Text
|
||||||
, _displayBox :: !DisplayType
|
, _displayBox :: !DisplayType
|
||||||
|
, _syncBlock :: !Int
|
||||||
}
|
}
|
||||||
|
|
||||||
makeLenses ''State
|
makeLenses ''State
|
||||||
|
@ -148,7 +152,9 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
(\(_, a) -> zcashAccountName $ entityVal a)
|
(\(_, a) -> zcashAccountName $ entityVal a)
|
||||||
(L.listSelectedElement (st ^. accounts))))) <=>
|
(L.listSelectedElement (st ^. accounts))))) <=>
|
||||||
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"
|
||||||
|
@ -190,6 +196,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 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
|
||||||
|
@ -315,6 +331,25 @@ 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 (fromInteger (ut_time tx)))) <=>
|
||||||
|
str ("Tx ID: " ++ show (ut_txid tx)) <=>
|
||||||
|
str
|
||||||
|
("Amount: " ++
|
||||||
|
if st ^. network == MainNet
|
||||||
|
then displayZec (ut_value tx)
|
||||||
|
else displayTaz (ut_value tx)) <=>
|
||||||
|
txt ("Memo: " <> ut_memo tx)))
|
||||||
BlankDisplay -> emptyWidget
|
BlankDisplay -> emptyWidget
|
||||||
|
|
||||||
mkInputForm :: DialogInput -> Form DialogInput e Name
|
mkInputForm :: DialogInput -> Form DialogInput e Name
|
||||||
|
@ -360,6 +395,22 @@ listDrawAddress sel w =
|
||||||
walletAddressName (entityVal w) <>
|
walletAddressName (entityVal w) <>
|
||||||
": " <> showAddress (walletAddressUAddress (entityVal w))
|
": " <> showAddress (walletAddressUAddress (entityVal w))
|
||||||
|
|
||||||
|
listDrawTx :: Bool -> UserTx -> Widget Name
|
||||||
|
listDrawTx sel tx =
|
||||||
|
selStr $
|
||||||
|
T.pack (show $ posixSecondsToUTCTime (fromInteger (ut_time tx))) <>
|
||||||
|
" " <> fmtAmt
|
||||||
|
where
|
||||||
|
amt = fromIntegral (ut_value 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"
|
||||||
|
|
||||||
|
@ -386,6 +437,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
|
||||||
|
@ -472,6 +524,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') [] ->
|
||||||
|
@ -480,6 +535,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 ->
|
||||||
|
@ -542,6 +599,12 @@ runZenithCLI config = 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 =<<
|
||||||
|
getWalletTransactions dbFilePath (entityVal $ head addrList)
|
||||||
|
else return []
|
||||||
|
block <- getMaxWalletBlock dbFilePath
|
||||||
void $
|
void $
|
||||||
M.defaultMain theApp $
|
M.defaultMain theApp $
|
||||||
State
|
State
|
||||||
|
@ -549,7 +612,7 @@ runZenithCLI config = 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
|
||||||
|
@ -562,6 +625,7 @@ runZenithCLI config = do
|
||||||
(zgb_blocks chainInfo)
|
(zgb_blocks chainInfo)
|
||||||
dbFilePath
|
dbFilePath
|
||||||
MsgDisplay
|
MsgDisplay
|
||||||
|
block
|
||||||
Left e -> do
|
Left e -> do
|
||||||
print $
|
print $
|
||||||
"No Zebra node available on port " <>
|
"No Zebra node available on port " <>
|
||||||
|
@ -583,10 +647,17 @@ refreshWallet s = do
|
||||||
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 []
|
||||||
|
txL <-
|
||||||
|
if not (null addrL)
|
||||||
|
then getUserTx (s ^. dbPath) =<<
|
||||||
|
getWalletTransactions (s ^. dbPath) (entityVal $ 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') & 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
|
||||||
|
@ -650,10 +721,39 @@ refreshAccount s = do
|
||||||
Just (_k, w) -> return w
|
Just (_k, w) -> return w
|
||||||
aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
|
aL <- getAddresses (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)
|
||||||
|
selAddress <-
|
||||||
|
do case L.listSelectedElement aL' of
|
||||||
|
Nothing -> do
|
||||||
|
let fAdd = L.listSelectedElement $ L.listMoveToBeginning aL'
|
||||||
|
case fAdd of
|
||||||
|
Nothing -> throw $ userError "Failed to select address"
|
||||||
|
Just (_x, a1) -> return a1
|
||||||
|
Just (_y, a2) -> return a2
|
||||||
|
tList <-
|
||||||
|
getUserTx (s ^. dbPath) =<<
|
||||||
|
getWalletTransactions (s ^. dbPath) (entityVal selAddress)
|
||||||
|
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
|
||||||
return $
|
return $
|
||||||
s & addresses .~ aL' & msg .~ "Switched to account: " ++
|
s & addresses .~ aL' & transactions .~ tL' & msg .~ "Switched to account: " ++
|
||||||
T.unpack (zcashAccountName $ entityVal selAccount)
|
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
|
||||||
|
case fAdd of
|
||||||
|
Nothing -> throw $ userError "Failed to select address"
|
||||||
|
Just (_x, a1) -> return a1
|
||||||
|
Just (_y, a2) -> return a2
|
||||||
|
tList <-
|
||||||
|
getUserTx (s ^. dbPath) =<<
|
||||||
|
getWalletTransactions (s ^. dbPath) (entityVal selAddress)
|
||||||
|
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
|
||||||
selAccount <-
|
selAccount <-
|
||||||
|
|
|
@ -239,6 +239,7 @@ findSaplingOutputs config b znet sk = do
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
(fromJust noteWitness)
|
(fromJust noteWitness)
|
||||||
|
True
|
||||||
dn1
|
dn1
|
||||||
decryptNotes uT n txs
|
decryptNotes uT n txs
|
||||||
Just dn0 -> do
|
Just dn0 -> do
|
||||||
|
@ -249,6 +250,7 @@ findSaplingOutputs config b znet sk = do
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
(fromJust noteWitness)
|
(fromJust noteWitness)
|
||||||
|
False
|
||||||
dn0
|
dn0
|
||||||
decryptNotes uT n txs
|
decryptNotes uT n txs
|
||||||
decodeShOut ::
|
decodeShOut ::
|
||||||
|
@ -319,6 +321,7 @@ findOrchardActions config b znet sk = do
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
(fromJust noteWitness)
|
(fromJust noteWitness)
|
||||||
|
True
|
||||||
dn1
|
dn1
|
||||||
decryptNotes uT n txs
|
decryptNotes uT n txs
|
||||||
Just dn -> do
|
Just dn -> do
|
||||||
|
@ -329,6 +332,7 @@ findOrchardActions config b znet sk = do
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
(fromJust noteWitness)
|
(fromJust noteWitness)
|
||||||
|
False
|
||||||
dn
|
dn
|
||||||
decryptNotes uT n txs
|
decryptNotes uT n txs
|
||||||
decodeOrchAction ::
|
decodeOrchAction ::
|
||||||
|
@ -354,13 +358,17 @@ syncWallet config w = do
|
||||||
let walletDb = c_dbPath config
|
let walletDb = c_dbPath config
|
||||||
accs <- getAccounts walletDb $ entityKey w
|
accs <- getAccounts walletDb $ entityKey w
|
||||||
addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
|
addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
|
||||||
|
intAddrs <- concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
|
||||||
lastBlock <- getMaxWalletBlock walletDb
|
lastBlock <- getMaxWalletBlock walletDb
|
||||||
let startBlock =
|
let startBlock =
|
||||||
if lastBlock > 0
|
if lastBlock > 0
|
||||||
then lastBlock
|
then lastBlock
|
||||||
else zcashWalletBirthdayHeight $ entityVal w
|
else zcashWalletBirthdayHeight $ entityVal w
|
||||||
trNotes <- mapM (findTransparentNotes walletDb startBlock . entityVal) addrs
|
trNotes <- mapM (findTransparentNotes walletDb startBlock . entityVal) addrs
|
||||||
mapM_ (saveWalletTrNote walletDb) $ concat trNotes
|
mapM_ (saveWalletTrNote walletDb External) $ concat trNotes
|
||||||
|
trChNotes <-
|
||||||
|
mapM (findTransparentNotes walletDb startBlock . entityVal) intAddrs
|
||||||
|
mapM_ (saveWalletTrNote walletDb Internal) $ concat trChNotes
|
||||||
sapNotes <-
|
sapNotes <-
|
||||||
mapM
|
mapM
|
||||||
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w) .
|
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w) .
|
||||||
|
|
240
src/Zenith/DB.hs
240
src/Zenith/DB.hs
|
@ -19,6 +19,7 @@
|
||||||
module Zenith.DB where
|
module Zenith.DB where
|
||||||
|
|
||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
|
import Control.Monad.IO.Class (MonadIO)
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
|
@ -42,19 +43,23 @@ import ZcashHaskell.Types
|
||||||
( DecodedNote(..)
|
( DecodedNote(..)
|
||||||
, OrchardAction(..)
|
, OrchardAction(..)
|
||||||
, OrchardBundle(..)
|
, OrchardBundle(..)
|
||||||
|
, OrchardSpendingKey(..)
|
||||||
, OrchardWitness(..)
|
, OrchardWitness(..)
|
||||||
, SaplingBundle(..)
|
, SaplingBundle(..)
|
||||||
, SaplingCommitmentTree(..)
|
, SaplingCommitmentTree(..)
|
||||||
|
, SaplingSpendingKey(..)
|
||||||
, SaplingWitness(..)
|
, SaplingWitness(..)
|
||||||
, Scope(..)
|
, Scope(..)
|
||||||
, ShieldedOutput(..)
|
, ShieldedOutput(..)
|
||||||
, ShieldedSpend(..)
|
, ShieldedSpend(..)
|
||||||
|
, ToBytes(..)
|
||||||
, Transaction(..)
|
, Transaction(..)
|
||||||
, TransparentAddress(..)
|
, TransparentAddress(..)
|
||||||
, TransparentBundle(..)
|
, TransparentBundle(..)
|
||||||
, TransparentReceiver(..)
|
, TransparentReceiver(..)
|
||||||
, UnifiedAddress(..)
|
, UnifiedAddress(..)
|
||||||
, ZcashNet
|
, ZcashNet
|
||||||
|
, decodeHexText
|
||||||
)
|
)
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( Config(..)
|
( Config(..)
|
||||||
|
@ -65,6 +70,7 @@ import Zenith.Types
|
||||||
, ScopeDB(..)
|
, ScopeDB(..)
|
||||||
, TransparentSpendingKeyDB
|
, TransparentSpendingKeyDB
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
|
, UserTx(..)
|
||||||
, ZcashNetDB(..)
|
, ZcashNetDB(..)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -109,8 +115,14 @@ share
|
||||||
value Word64
|
value Word64
|
||||||
spent Bool
|
spent Bool
|
||||||
script BS.ByteString
|
script BS.ByteString
|
||||||
|
change Bool
|
||||||
UniqueTNote tx script
|
UniqueTNote tx script
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
|
WalletTrSpend
|
||||||
|
tx WalletTransactionId
|
||||||
|
note WalletTrNoteId
|
||||||
|
value Word64
|
||||||
|
deriving Show Eq
|
||||||
WalletSapNote
|
WalletSapNote
|
||||||
tx WalletTransactionId
|
tx WalletTransactionId
|
||||||
value Word64
|
value Word64
|
||||||
|
@ -120,8 +132,14 @@ share
|
||||||
nullifier HexStringDB
|
nullifier HexStringDB
|
||||||
position Word64
|
position Word64
|
||||||
witness HexStringDB
|
witness HexStringDB
|
||||||
|
change Bool
|
||||||
UniqueSapNote tx nullifier
|
UniqueSapNote tx nullifier
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
|
WalletSapSpend
|
||||||
|
tx WalletTransactionId
|
||||||
|
note WalletSapNoteId
|
||||||
|
value Word64
|
||||||
|
deriving Show Eq
|
||||||
WalletOrchNote
|
WalletOrchNote
|
||||||
tx WalletTransactionId
|
tx WalletTransactionId
|
||||||
value Word64
|
value Word64
|
||||||
|
@ -131,8 +149,14 @@ share
|
||||||
nullifier HexStringDB
|
nullifier HexStringDB
|
||||||
position Word64
|
position Word64
|
||||||
witness HexStringDB
|
witness HexStringDB
|
||||||
|
change Bool
|
||||||
UniqueOrchNote tx nullifier
|
UniqueOrchNote tx nullifier
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
|
WalletOrchSpend
|
||||||
|
tx WalletTransactionId
|
||||||
|
note WalletOrchNoteId
|
||||||
|
value Word64
|
||||||
|
deriving Show Eq
|
||||||
ZcashTransaction
|
ZcashTransaction
|
||||||
block Int
|
block Int
|
||||||
txId HexStringDB
|
txId HexStringDB
|
||||||
|
@ -282,6 +306,19 @@ getAddresses dbFp a =
|
||||||
where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External))
|
where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External))
|
||||||
pure addrs
|
pure addrs
|
||||||
|
|
||||||
|
-- | Returns a list of change addresses associated with the given account
|
||||||
|
getInternalAddresses ::
|
||||||
|
T.Text -- ^ The database path
|
||||||
|
-> ZcashAccountId -- ^ The account ID to check
|
||||||
|
-> IO [Entity WalletAddress]
|
||||||
|
getInternalAddresses dbFp a =
|
||||||
|
PS.runSqlite dbFp $
|
||||||
|
select $ do
|
||||||
|
addrs <- from $ table @WalletAddress
|
||||||
|
where_ (addrs ^. WalletAddressAccId ==. val a)
|
||||||
|
where_ (addrs ^. WalletAddressScope ==. val (ScopeDB Internal))
|
||||||
|
pure addrs
|
||||||
|
|
||||||
-- | Returns a list of addressess associated with the given wallet
|
-- | Returns a list of addressess associated with the given wallet
|
||||||
getWalletAddresses ::
|
getWalletAddresses ::
|
||||||
T.Text -- ^ The database path
|
T.Text -- ^ The database path
|
||||||
|
@ -456,9 +493,10 @@ saveWalletSapNote ::
|
||||||
-> WalletTransactionId -- ^ The index for the transaction that contains the note
|
-> WalletTransactionId -- ^ The index for the transaction that contains the note
|
||||||
-> Integer -- ^ note position
|
-> Integer -- ^ note position
|
||||||
-> SaplingWitness -- ^ the Sapling incremental witness
|
-> SaplingWitness -- ^ the Sapling incremental witness
|
||||||
|
-> Bool -- ^ change flag
|
||||||
-> DecodedNote -- The decoded Sapling note
|
-> DecodedNote -- The decoded Sapling note
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletSapNote dbPath wId pos wit dn = do
|
saveWalletSapNote dbPath wId pos wit ch dn = do
|
||||||
PS.runSqlite dbPath $ do
|
PS.runSqlite dbPath $ do
|
||||||
_ <-
|
_ <-
|
||||||
upsert
|
upsert
|
||||||
|
@ -466,11 +504,12 @@ saveWalletSapNote dbPath wId pos wit dn = do
|
||||||
wId
|
wId
|
||||||
(fromIntegral $ a_value dn)
|
(fromIntegral $ a_value dn)
|
||||||
(a_recipient dn)
|
(a_recipient dn)
|
||||||
(TE.decodeUtf8Lenient $ a_memo dn)
|
(T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn)
|
||||||
False
|
False
|
||||||
(HexStringDB $ a_nullifier dn)
|
(HexStringDB $ a_nullifier dn)
|
||||||
(fromIntegral pos)
|
(fromIntegral pos)
|
||||||
(HexStringDB $ sapWit wit))
|
(HexStringDB $ sapWit wit)
|
||||||
|
ch)
|
||||||
[]
|
[]
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
@ -480,9 +519,10 @@ saveWalletOrchNote ::
|
||||||
-> WalletTransactionId
|
-> WalletTransactionId
|
||||||
-> Integer
|
-> Integer
|
||||||
-> OrchardWitness
|
-> OrchardWitness
|
||||||
|
-> Bool
|
||||||
-> DecodedNote
|
-> DecodedNote
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletOrchNote dbPath wId pos wit dn = do
|
saveWalletOrchNote dbPath wId pos wit ch dn = do
|
||||||
PS.runSqlite dbPath $ do
|
PS.runSqlite dbPath $ do
|
||||||
_ <-
|
_ <-
|
||||||
upsert
|
upsert
|
||||||
|
@ -490,11 +530,12 @@ saveWalletOrchNote dbPath wId pos wit dn = do
|
||||||
wId
|
wId
|
||||||
(fromIntegral $ a_value dn)
|
(fromIntegral $ a_value dn)
|
||||||
(a_recipient dn)
|
(a_recipient dn)
|
||||||
(TE.decodeUtf8Lenient $ a_memo dn)
|
(T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn)
|
||||||
False
|
False
|
||||||
(HexStringDB $ a_nullifier dn)
|
(HexStringDB $ a_nullifier dn)
|
||||||
(fromIntegral pos)
|
(fromIntegral pos)
|
||||||
(HexStringDB $ orchWit wit))
|
(HexStringDB $ orchWit wit)
|
||||||
|
ch)
|
||||||
[]
|
[]
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
@ -528,9 +569,10 @@ findTransparentNotes dbPath b t = do
|
||||||
-- | Add the transparent notes to the wallet
|
-- | Add the transparent notes to the wallet
|
||||||
saveWalletTrNote ::
|
saveWalletTrNote ::
|
||||||
T.Text -- ^ the database path
|
T.Text -- ^ the database path
|
||||||
|
-> Scope
|
||||||
-> (Entity ZcashTransaction, Entity TransparentNote)
|
-> (Entity ZcashTransaction, Entity TransparentNote)
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletTrNote dbPath (zt, tn) = do
|
saveWalletTrNote dbPath ch (zt, tn) = do
|
||||||
let zT' = entityVal zt
|
let zT' = entityVal zt
|
||||||
PS.runSqlite dbPath $ do
|
PS.runSqlite dbPath $ do
|
||||||
t <-
|
t <-
|
||||||
|
@ -547,6 +589,7 @@ saveWalletTrNote dbPath (zt, tn) = do
|
||||||
(transparentNoteValue $ entityVal tn)
|
(transparentNoteValue $ entityVal tn)
|
||||||
False
|
False
|
||||||
(transparentNoteScript $ entityVal tn)
|
(transparentNoteScript $ entityVal tn)
|
||||||
|
(ch == Internal)
|
||||||
|
|
||||||
-- | Save a Sapling note to the wallet database
|
-- | Save a Sapling note to the wallet database
|
||||||
saveSapNote :: T.Text -> WalletSapNote -> IO ()
|
saveSapNote :: T.Text -> WalletSapNote -> IO ()
|
||||||
|
@ -588,6 +631,189 @@ getOrchardActions dbPath b =
|
||||||
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
|
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
|
||||||
pure (txs, oActions)
|
pure (txs, oActions)
|
||||||
|
|
||||||
|
-- | Get the transactions belonging to the given address
|
||||||
|
getWalletTransactions ::
|
||||||
|
T.Text -- ^ database path
|
||||||
|
-> WalletAddress
|
||||||
|
-> IO [WalletTransactionId]
|
||||||
|
getWalletTransactions dbPath w = do
|
||||||
|
let tReceiver = t_rec =<< readUnifiedAddressDB w
|
||||||
|
let sReceiver = s_rec =<< readUnifiedAddressDB w
|
||||||
|
let oReceiver = o_rec =<< readUnifiedAddressDB w
|
||||||
|
trNotes <-
|
||||||
|
case tReceiver of
|
||||||
|
Nothing -> return []
|
||||||
|
Just tR -> do
|
||||||
|
let s =
|
||||||
|
BS.concat
|
||||||
|
[ BS.pack [0x76, 0xA9, 0x14]
|
||||||
|
, (toBytes . tr_bytes) tR
|
||||||
|
, BS.pack [0x88, 0xAC]
|
||||||
|
]
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
tnotes <- from $ table @WalletTrNote
|
||||||
|
where_ (tnotes ^. WalletTrNoteScript ==. val s)
|
||||||
|
pure tnotes
|
||||||
|
sapNotes <-
|
||||||
|
case sReceiver of
|
||||||
|
Nothing -> return []
|
||||||
|
Just sR -> do
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
snotes <- from $ table @WalletSapNote
|
||||||
|
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
|
||||||
|
pure snotes
|
||||||
|
orchNotes <-
|
||||||
|
case oReceiver of
|
||||||
|
Nothing -> return []
|
||||||
|
Just oR -> do
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
onotes <- from $ table @WalletOrchNote
|
||||||
|
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
|
||||||
|
pure onotes
|
||||||
|
let addrTx =
|
||||||
|
map (walletTrNoteTx . entityVal) trNotes <>
|
||||||
|
map (walletSapNoteTx . entityVal) sapNotes <>
|
||||||
|
map (walletOrchNoteTx . entityVal) orchNotes
|
||||||
|
return addrTx
|
||||||
|
|
||||||
|
getUserTx :: T.Text -> [WalletTransactionId] -> IO [UserTx]
|
||||||
|
getUserTx dbPath addrTx = do
|
||||||
|
mapM convertUserTx addrTx
|
||||||
|
where
|
||||||
|
convertUserTx :: WalletTransactionId -> IO UserTx
|
||||||
|
convertUserTx tId = do
|
||||||
|
tr <-
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
tx <- from $ table @WalletTransaction
|
||||||
|
where_ (tx ^. WalletTransactionId ==. val tId)
|
||||||
|
pure tx
|
||||||
|
trNotes <-
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
trNotes <- from $ table @WalletTrNote
|
||||||
|
where_ (trNotes ^. WalletTrNoteTx ==. val tId)
|
||||||
|
pure trNotes
|
||||||
|
trSpends <-
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
trSpends <- from $ table @WalletTrSpend
|
||||||
|
where_ (trSpends ^. WalletTrSpendTx ==. val tId)
|
||||||
|
pure trSpends
|
||||||
|
sapNotes <-
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
sapNotes <- from $ table @WalletSapNote
|
||||||
|
where_ (sapNotes ^. WalletSapNoteTx ==. val tId)
|
||||||
|
pure sapNotes
|
||||||
|
sapSpends <-
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
sapSpends <- from $ table @WalletSapSpend
|
||||||
|
where_ (sapSpends ^. WalletSapSpendTx ==. val tId)
|
||||||
|
pure sapSpends
|
||||||
|
orchNotes <-
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
orchNotes <- from $ table @WalletOrchNote
|
||||||
|
where_ (orchNotes ^. WalletOrchNoteTx ==. val tId)
|
||||||
|
pure orchNotes
|
||||||
|
orchSpends <-
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
orchSpends <- from $ table @WalletOrchSpend
|
||||||
|
where_ (orchSpends ^. WalletOrchSpendTx ==. val tId)
|
||||||
|
pure orchSpends
|
||||||
|
return $
|
||||||
|
UserTx
|
||||||
|
(getHex $ walletTransactionTxId $ entityVal $ head tr)
|
||||||
|
(fromIntegral $ walletTransactionTime $ entityVal $ head tr)
|
||||||
|
(sum (map (fromIntegral . walletTrNoteValue . entityVal) trNotes) +
|
||||||
|
sum (map (fromIntegral . walletSapNoteValue . entityVal) sapNotes) +
|
||||||
|
sum (map (fromIntegral . walletOrchNoteValue . entityVal) orchNotes) -
|
||||||
|
sum (map (fromIntegral . walletTrSpendValue . entityVal) trSpends) -
|
||||||
|
sum (map (fromIntegral . walletSapSpendValue . entityVal) sapSpends) -
|
||||||
|
sum
|
||||||
|
(map (fromIntegral . walletOrchSpendValue . entityVal) orchSpends))
|
||||||
|
(T.concat (map (walletSapNoteMemo . entityVal) sapNotes) <>
|
||||||
|
T.concat (map (walletOrchNoteMemo . entityVal) orchNotes))
|
||||||
|
|
||||||
|
-- | Sapling DAG-aware spend tracking
|
||||||
|
findSapSpends :: T.Text -> SaplingSpendingKey -> [Entity WalletSapNote] -> IO ()
|
||||||
|
findSapSpends _ _ [] = return ()
|
||||||
|
findSapSpends dbPath sk (n:notes) = do
|
||||||
|
s <-
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
(tx :& sapSpends) <-
|
||||||
|
from $ table @ZcashTransaction `innerJoin` table @ShieldSpend `on`
|
||||||
|
(\(tx :& sapSpends) ->
|
||||||
|
tx ^. ZcashTransactionId ==. sapSpends ^. ShieldSpendTx)
|
||||||
|
where_
|
||||||
|
(sapSpends ^. ShieldSpendNullifier ==.
|
||||||
|
val (walletSapNoteNullifier (entityVal n)))
|
||||||
|
pure (tx, sapSpends)
|
||||||
|
if null s
|
||||||
|
then findSapSpends dbPath sk notes
|
||||||
|
else do
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
_ <-
|
||||||
|
update $ \w -> do
|
||||||
|
set w [WalletSapNoteSpent =. val True]
|
||||||
|
where_ $ w ^. WalletSapNoteId ==. val (entityKey n)
|
||||||
|
t' <- upsertWalTx $ entityVal $ fst $ head s
|
||||||
|
insert_ $
|
||||||
|
WalletSapSpend
|
||||||
|
(entityKey t')
|
||||||
|
(entityKey n)
|
||||||
|
(walletSapNoteValue $ entityVal n)
|
||||||
|
findSapSpends dbPath sk notes
|
||||||
|
|
||||||
|
findOrchSpends ::
|
||||||
|
T.Text -> OrchardSpendingKey -> [Entity WalletOrchNote] -> IO ()
|
||||||
|
findOrchSpends _ _ [] = return ()
|
||||||
|
findOrchSpends dbPath sk (n:notes) = do
|
||||||
|
s <-
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
select $ do
|
||||||
|
(tx :& orchSpends) <-
|
||||||
|
from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
|
||||||
|
(\(tx :& orchSpends) ->
|
||||||
|
tx ^. ZcashTransactionId ==. orchSpends ^. OrchActionTx)
|
||||||
|
where_
|
||||||
|
(orchSpends ^. OrchActionNf ==.
|
||||||
|
val (walletOrchNoteNullifier (entityVal n)))
|
||||||
|
pure (tx, orchSpends)
|
||||||
|
if null s
|
||||||
|
then findOrchSpends dbPath sk notes
|
||||||
|
else do
|
||||||
|
PS.runSqlite dbPath $ do
|
||||||
|
_ <-
|
||||||
|
update $ \w -> do
|
||||||
|
set w [WalletOrchNoteSpent =. val True]
|
||||||
|
where_ $ w ^. WalletOrchNoteId ==. val (entityKey n)
|
||||||
|
t' <- upsertWalTx $ entityVal $ fst $ head s
|
||||||
|
insert_ $
|
||||||
|
WalletOrchSpend
|
||||||
|
(entityKey t')
|
||||||
|
(entityKey n)
|
||||||
|
(walletOrchNoteValue $ entityVal n)
|
||||||
|
findOrchSpends dbPath sk notes
|
||||||
|
|
||||||
|
upsertWalTx ::
|
||||||
|
MonadIO m => ZcashTransaction -> SqlPersistT m (Entity WalletTransaction)
|
||||||
|
upsertWalTx zt =
|
||||||
|
upsert
|
||||||
|
(WalletTransaction
|
||||||
|
(zcashTransactionTxId zt)
|
||||||
|
(zcashTransactionBlock zt)
|
||||||
|
(zcashTransactionConf zt)
|
||||||
|
(zcashTransactionTime zt))
|
||||||
|
[]
|
||||||
|
|
||||||
-- | Helper function to extract a Unified Address from the database
|
-- | Helper function to extract a Unified Address from the database
|
||||||
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||||
readUnifiedAddressDB =
|
readUnifiedAddressDB =
|
||||||
|
|
|
@ -29,6 +29,14 @@ import ZcashHaskell.Types
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
-- * UI
|
||||||
|
data UserTx = UserTx
|
||||||
|
{ ut_txid :: !HexString
|
||||||
|
, ut_time :: !Integer
|
||||||
|
, ut_value :: !Integer
|
||||||
|
, ut_memo :: !T.Text
|
||||||
|
} deriving (Eq, Show, Read)
|
||||||
|
|
||||||
-- * Database field type wrappers
|
-- * Database field type wrappers
|
||||||
newtype HexStringDB = HexStringDB
|
newtype HexStringDB = HexStringDB
|
||||||
{ getHex :: HexString
|
{ getHex :: HexString
|
||||||
|
|
|
@ -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,6 +64,7 @@ library
|
||||||
, regex-posix
|
, regex-posix
|
||||||
, scientific
|
, scientific
|
||||||
, text
|
, text
|
||||||
|
, time
|
||||||
, vector
|
, vector
|
||||||
, vty
|
, vty
|
||||||
, word-wrap
|
, word-wrap
|
||||||
|
|
Loading…
Reference in a new issue