Include display of balance and transactions #76
6 changed files with 365 additions and 14 deletions
|
|
@ -53,6 +53,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
|
||||
|
|
@ -70,9 +71,10 @@ import Zenith.Types
|
|||
( Config(..)
|
||||
, PhraseDB(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, UserTx(..)
|
||||
, ZcashNetDB(..)
|
||||
)
|
||||
import Zenith.Utils (showAddress)
|
||||
import Zenith.Utils (displayTaz, displayZec, showAddress)
|
||||
|
||||
data Name
|
||||
= WList
|
||||
|
|
@ -101,6 +103,7 @@ data DisplayType
|
|||
= AddrDisplay
|
||||
| MsgDisplay
|
||||
| PhraseDisplay
|
||||
| TxDisplay
|
||||
| BlankDisplay
|
||||
|
||||
data State = State
|
||||
|
|
@ -108,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 UserTx)
|
||||
, _msg :: !String
|
||||
, _helpBox :: !Bool
|
||||
, _dialogBox :: !DialogType
|
||||
|
|
@ -118,6 +121,7 @@ data State = State
|
|||
, _startBlock :: !Int
|
||||
, _dbPath :: !T.Text
|
||||
, _displayBox :: !DisplayType
|
||||
, _syncBlock :: !Int
|
||||
}
|
||||
|
||||
makeLenses ''State
|
||||
|
|
@ -148,7 +152,9 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(\(_, a) -> zcashAccountName $ entityVal a)
|
||||
(L.listSelectedElement (st ^. accounts))))) <=>
|
||||
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"
|
||||
|
|
@ -190,6 +196,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 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
|
||||
|
|
@ -315,6 +331,25 @@ 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 (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
|
||||
|
||||
mkInputForm :: DialogInput -> Form DialogInput e Name
|
||||
|
|
@ -360,6 +395,22 @@ listDrawAddress sel w =
|
|||
walletAddressName (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 = L.listSelectedAttr <> A.attrName "custom"
|
||||
|
||||
|
|
@ -386,6 +437,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
|
||||
|
|
@ -472,6 +524,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') [] ->
|
||||
|
|
@ -480,6 +535,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 ->
|
||||
|
|
@ -542,6 +599,12 @@ runZenithCLI config = do
|
|||
if not (null accList)
|
||||
then getAddresses dbFilePath $ entityKey $ head accList
|
||||
else return []
|
||||
txList <-
|
||||
if not (null addrList)
|
||||
then getUserTx dbFilePath =<<
|
||||
getWalletTransactions dbFilePath (entityVal $ head addrList)
|
||||
else return []
|
||||
block <- getMaxWalletBlock dbFilePath
|
||||
void $
|
||||
M.defaultMain theApp $
|
||||
State
|
||||
|
|
@ -549,7 +612,7 @@ runZenithCLI config = 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
|
||||
|
|
@ -562,6 +625,7 @@ runZenithCLI config = do
|
|||
(zgb_blocks chainInfo)
|
||||
dbFilePath
|
||||
MsgDisplay
|
||||
block
|
||||
Left e -> do
|
||||
print $
|
||||
"No Zebra node available on port " <>
|
||||
|
|
@ -583,10 +647,17 @@ refreshWallet s = do
|
|||
if not (null aL)
|
||||
then getAddresses (s ^. dbPath) $ entityKey $ head aL
|
||||
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 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') & addresses .~ addrL' & transactions .~ txL' & msg .~
|
||||
"Switched to wallet: " ++
|
||||
T.unpack (zcashWalletName $ entityVal selWallet)
|
||||
|
||||
addNewWallet :: T.Text -> State -> IO State
|
||||
|
|
@ -650,10 +721,39 @@ refreshAccount s = do
|
|||
Just (_k, w) -> return w
|
||||
aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
|
||||
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 $
|
||||
s & addresses .~ aL' & msg .~ "Switched to account: " ++
|
||||
s & 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
|
||||
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 n scope s = do
|
||||
selAccount <-
|
||||
|
|
|
|||
|
|
@ -239,6 +239,7 @@ findSaplingOutputs config b znet sk = do
|
|||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
True
|
||||
dn1
|
||||
decryptNotes uT n txs
|
||||
Just dn0 -> do
|
||||
|
|
@ -249,6 +250,7 @@ findSaplingOutputs config b znet sk = do
|
|||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
False
|
||||
dn0
|
||||
decryptNotes uT n txs
|
||||
decodeShOut ::
|
||||
|
|
@ -319,6 +321,7 @@ findOrchardActions config b znet sk = do
|
|||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
True
|
||||
dn1
|
||||
decryptNotes uT n txs
|
||||
Just dn -> do
|
||||
|
|
@ -329,6 +332,7 @@ findOrchardActions config b znet sk = do
|
|||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
False
|
||||
dn
|
||||
decryptNotes uT n txs
|
||||
decodeOrchAction ::
|
||||
|
|
@ -354,13 +358,17 @@ 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
|
||||
lastBlock <- getMaxWalletBlock walletDb
|
||||
let startBlock =
|
||||
if lastBlock > 0
|
||||
then lastBlock
|
||||
else zcashWalletBirthdayHeight $ entityVal w
|
||||
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 <-
|
||||
mapM
|
||||
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w) .
|
||||
|
|
|
|||
240
src/Zenith/DB.hs
240
src/Zenith/DB.hs
|
|
@ -19,6 +19,7 @@
|
|||
module Zenith.DB where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Data.Bifunctor
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.HexString
|
||||
|
|
@ -42,19 +43,23 @@ import ZcashHaskell.Types
|
|||
( DecodedNote(..)
|
||||
, OrchardAction(..)
|
||||
, OrchardBundle(..)
|
||||
, OrchardSpendingKey(..)
|
||||
, OrchardWitness(..)
|
||||
, SaplingBundle(..)
|
||||
, SaplingCommitmentTree(..)
|
||||
, SaplingSpendingKey(..)
|
||||
, SaplingWitness(..)
|
||||
, Scope(..)
|
||||
, ShieldedOutput(..)
|
||||
, ShieldedSpend(..)
|
||||
, ToBytes(..)
|
||||
, Transaction(..)
|
||||
, TransparentAddress(..)
|
||||
, TransparentBundle(..)
|
||||
, TransparentReceiver(..)
|
||||
, UnifiedAddress(..)
|
||||
, ZcashNet
|
||||
, decodeHexText
|
||||
)
|
||||
import Zenith.Types
|
||||
( Config(..)
|
||||
|
|
@ -65,6 +70,7 @@ import Zenith.Types
|
|||
, ScopeDB(..)
|
||||
, TransparentSpendingKeyDB
|
||||
, UnifiedAddressDB(..)
|
||||
, UserTx(..)
|
||||
, ZcashNetDB(..)
|
||||
)
|
||||
|
||||
|
|
@ -109,8 +115,14 @@ share
|
|||
value Word64
|
||||
spent Bool
|
||||
script BS.ByteString
|
||||
change Bool
|
||||
UniqueTNote tx script
|
||||
deriving Show Eq
|
||||
WalletTrSpend
|
||||
tx WalletTransactionId
|
||||
note WalletTrNoteId
|
||||
value Word64
|
||||
deriving Show Eq
|
||||
WalletSapNote
|
||||
tx WalletTransactionId
|
||||
value Word64
|
||||
|
|
@ -120,8 +132,14 @@ share
|
|||
nullifier HexStringDB
|
||||
position Word64
|
||||
witness HexStringDB
|
||||
change Bool
|
||||
UniqueSapNote tx nullifier
|
||||
deriving Show Eq
|
||||
WalletSapSpend
|
||||
tx WalletTransactionId
|
||||
note WalletSapNoteId
|
||||
value Word64
|
||||
deriving Show Eq
|
||||
WalletOrchNote
|
||||
tx WalletTransactionId
|
||||
value Word64
|
||||
|
|
@ -131,8 +149,14 @@ share
|
|||
nullifier HexStringDB
|
||||
position Word64
|
||||
witness HexStringDB
|
||||
change Bool
|
||||
UniqueOrchNote tx nullifier
|
||||
deriving Show Eq
|
||||
WalletOrchSpend
|
||||
tx WalletTransactionId
|
||||
note WalletOrchNoteId
|
||||
value Word64
|
||||
deriving Show Eq
|
||||
ZcashTransaction
|
||||
block Int
|
||||
txId HexStringDB
|
||||
|
|
@ -282,6 +306,19 @@ getAddresses dbFp a =
|
|||
where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External))
|
||||
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
|
||||
getWalletAddresses ::
|
||||
T.Text -- ^ The database path
|
||||
|
|
@ -456,9 +493,10 @@ saveWalletSapNote ::
|
|||
-> WalletTransactionId -- ^ The index for the transaction that contains the note
|
||||
-> Integer -- ^ note position
|
||||
-> SaplingWitness -- ^ the Sapling incremental witness
|
||||
-> Bool -- ^ change flag
|
||||
-> DecodedNote -- The decoded Sapling note
|
||||
-> IO ()
|
||||
saveWalletSapNote dbPath wId pos wit dn = do
|
||||
saveWalletSapNote dbPath wId pos wit ch dn = do
|
||||
PS.runSqlite dbPath $ do
|
||||
_ <-
|
||||
upsert
|
||||
|
|
@ -466,11 +504,12 @@ saveWalletSapNote dbPath wId pos wit dn = do
|
|||
wId
|
||||
(fromIntegral $ a_value dn)
|
||||
(a_recipient dn)
|
||||
(TE.decodeUtf8Lenient $ a_memo dn)
|
||||
(T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn)
|
||||
False
|
||||
(HexStringDB $ a_nullifier dn)
|
||||
(fromIntegral pos)
|
||||
(HexStringDB $ sapWit wit))
|
||||
(HexStringDB $ sapWit wit)
|
||||
ch)
|
||||
[]
|
||||
return ()
|
||||
|
||||
|
|
@ -480,9 +519,10 @@ saveWalletOrchNote ::
|
|||
-> WalletTransactionId
|
||||
-> Integer
|
||||
-> OrchardWitness
|
||||
-> Bool
|
||||
-> DecodedNote
|
||||
-> IO ()
|
||||
saveWalletOrchNote dbPath wId pos wit dn = do
|
||||
saveWalletOrchNote dbPath wId pos wit ch dn = do
|
||||
PS.runSqlite dbPath $ do
|
||||
_ <-
|
||||
upsert
|
||||
|
|
@ -490,11 +530,12 @@ saveWalletOrchNote dbPath wId pos wit dn = do
|
|||
wId
|
||||
(fromIntegral $ a_value dn)
|
||||
(a_recipient dn)
|
||||
(TE.decodeUtf8Lenient $ a_memo dn)
|
||||
(T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn)
|
||||
False
|
||||
(HexStringDB $ a_nullifier dn)
|
||||
(fromIntegral pos)
|
||||
(HexStringDB $ orchWit wit))
|
||||
(HexStringDB $ orchWit wit)
|
||||
ch)
|
||||
[]
|
||||
return ()
|
||||
|
||||
|
|
@ -528,9 +569,10 @@ findTransparentNotes dbPath b t = do
|
|||
-- | Add the transparent notes to the wallet
|
||||
saveWalletTrNote ::
|
||||
T.Text -- ^ the database path
|
||||
-> Scope
|
||||
-> (Entity ZcashTransaction, Entity TransparentNote)
|
||||
-> IO ()
|
||||
saveWalletTrNote dbPath (zt, tn) = do
|
||||
saveWalletTrNote dbPath ch (zt, tn) = do
|
||||
let zT' = entityVal zt
|
||||
PS.runSqlite dbPath $ do
|
||||
t <-
|
||||
|
|
@ -547,6 +589,7 @@ saveWalletTrNote dbPath (zt, tn) = do
|
|||
(transparentNoteValue $ entityVal tn)
|
||||
False
|
||||
(transparentNoteScript $ entityVal tn)
|
||||
(ch == Internal)
|
||||
|
||||
-- | Save a Sapling note to the wallet database
|
||||
saveSapNote :: T.Text -> WalletSapNote -> IO ()
|
||||
|
|
@ -588,6 +631,189 @@ getOrchardActions dbPath b =
|
|||
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
|
||||
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
|
||||
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
|
||||
readUnifiedAddressDB =
|
||||
|
|
|
|||
|
|
@ -29,6 +29,14 @@ import ZcashHaskell.Types
|
|||
, 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
|
||||
newtype HexStringDB = HexStringDB
|
||||
{ getHex :: HexString
|
||||
|
|
|
|||
|
|
@ -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,6 +64,7 @@ library
|
|||
, regex-posix
|
||||
, scientific
|
||||
, text
|
||||
, time
|
||||
, vector
|
||||
, vty
|
||||
, word-wrap
|
||||
|
|
|
|||
Loading…
Reference in a new issue