Vergara_Tech
/
zenith
2
0
Fork 0
Code Issues 38 Pull Requests Packages Projects Releases 5 Wiki Activity

Implement per-address tx display

This commit is contained in:
Rene Vergara 2024-04-24 07:42:35 -05:00
parent 29bed14f7c
commit 52ac50e30c
Signed by: pitmutt
GPG Key ID: 65122AD495A7F5B2
5 changed files with 420 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
app/Main.hs
View File

@ -18,7 +18,7 @@ import System.IO
import Text.Read (readMaybe)
import ZcashHaskell.Types
import Zenith.CLI
import Zenith.Core (testSync)
import Zenith.Core (clearSync, testSync)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils
import Zenith.Zcashd
@ -222,6 +222,7 @@ main = do
(root nodeUser nodePwd)
"cli" -> runZenithCLI myConfig
"sync" -> testSync myConfig
"rescan" -> clearSync myConfig
_ -> printUsage
else printUsage

76
src/Zenith/CLI.hs
View File

@ -71,7 +71,6 @@ import Zenith.Types
( Config(..)
, PhraseDB(..)
, UnifiedAddressDB(..)
, UserTx(..)
, ZcashNetDB(..)
)
import Zenith.Utils (displayTaz, displayZec, showAddress)
@ -111,7 +110,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 UserTx)
, _transactions :: !(L.List Name (Entity UserTx))
, _msg :: !String
, _helpBox :: !Bool
, _dialogBox :: !DialogType
@ -196,7 +195,7 @@ 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 :: String -> L.List Name (Entity UserTx) -> Widget Name
listTxBox titleLabel tx =
C.vCenter $
vBox
@ -342,14 +341,18 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
1
(str
("Date: " ++
show (posixSecondsToUTCTime (fromInteger (ut_time tx)))) <=>
str ("Tx ID: " ++ show (ut_txid tx)) <=>
show
(posixSecondsToUTCTime
(fromIntegral (userTxTime $ entityVal tx)))) <=>
str ("Tx ID: " ++ show (userTxHex $ entityVal tx)) <=>
str
("Amount: " ++
if st ^. network == MainNet
then displayZec (ut_value tx)
else displayTaz (ut_value tx)) <=>
txt ("Memo: " <> ut_memo tx)))
then displayZec
(fromIntegral $ userTxAmount $ entityVal tx)
else displayTaz
(fromIntegral $ userTxAmount $ entityVal tx)) <=>
txt ("Memo: " <> userTxMemo (entityVal tx))))
BlankDisplay -> emptyWidget
mkInputForm :: DialogInput -> Form DialogInput e Name
@ -395,13 +398,14 @@ listDrawAddress sel w =
walletAddressName (entityVal w) <>
": " <> showAddress (walletAddressUAddress (entityVal w))
listDrawTx :: Bool -> UserTx -> Widget Name
listDrawTx :: Bool -> Entity UserTx -> Widget Name
listDrawTx sel tx =
selStr $
T.pack (show $ posixSecondsToUTCTime (fromInteger (ut_time tx))) <>
T.pack
(show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <>
" " <> fmtAmt
where
amt = fromIntegral (ut_value tx) / 100000000
amt = fromIntegral (userTxAmount $ entityVal tx) / 100000000
fmtAmt =
if amt > 0
then "↘" <> T.pack (show amt) <> " "
@ -601,8 +605,7 @@ runZenithCLI config = do
else return []
txList <-
if not (null addrList)
then getUserTx dbFilePath =<<
getWalletTransactions dbFilePath (entityVal $ head addrList)
then getUserTx dbFilePath $ entityKey $ head addrList
else return []
block <- getMaxWalletBlock dbFilePath
void $
@ -649,8 +652,7 @@ refreshWallet s = do
else return []
txL <-
if not (null addrL)
then getUserTx (s ^. dbPath) =<<
getWalletTransactions (s ^. dbPath) (entityVal $ head addrL)
then getUserTx (s ^. dbPath) $ entityKey $ head addrL
else return []
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
@ -667,7 +669,7 @@ addNewWallet n s = do
let netName = s ^. network
r <-
saveWallet (s ^. dbPath) $
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
case r of
Nothing -> do
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
@ -725,17 +727,20 @@ refreshAccount s = do
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' & transactions .~ tL' & msg .~ "Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
return fAdd
Just a2 -> return $ Just a2
case selAddress of
Nothing ->
return $
s & 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 & addresses .~ aL' & transactions .~ tL' & msg .~
"Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
refreshTxs :: State -> IO State
refreshTxs s = do
@ -744,15 +749,14 @@ refreshTxs s = do
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'
return fAdd
Just a2 -> return $ Just a2
case selAddress of
Nothing -> return s
Just (_i, a) -> do
tList <- getUserTx (s ^. dbPath) $ entityKey a
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
return $ s & transactions .~ tL'
addNewAddress :: T.Text -> Scope -> State -> IO State
addNewAddress n scope s = do

78
src/Zenith/Core.hs
View File

@ -195,9 +195,9 @@ findSaplingOutputs ::
Config -- ^ the configuration parameters
-> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network
-> SaplingSpendingKeyDB -- ^ The spending key to trial decrypt
-> Entity ZcashAccount -- ^ The account to use
-> IO ()
findSaplingOutputs config b znet sk = do
findSaplingOutputs config b znet za = do
let dbPath = c_dbPath config
let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config
@ -206,7 +206,11 @@ findSaplingOutputs config b znet sk = do
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
@ -233,24 +237,31 @@ findSaplingOutputs config b znet sk = do
decryptNotes uT n txs
Just dn1 -> do
print dn1
wId <- saveWalletTransaction (c_dbPath config) zt
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) zt
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 ::
@ -278,9 +289,9 @@ findOrchardActions ::
Config -- ^ the configuration parameters
-> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network
-> OrchardSpendingKeyDB -- ^ The spending key to trial decrypt
-> Entity ZcashAccount -- ^ The account to use
-> IO ()
findOrchardActions config b znet sk = do
findOrchardActions config b znet za = do
let dbPath = c_dbPath config
let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config
@ -289,6 +300,8 @@ findOrchardActions config b znet sk = do
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
@ -315,26 +328,35 @@ findOrchardActions config b znet sk = do
Nothing -> decryptNotes uT n txs
Just dn1 -> do
print dn1
wId <- saveWalletTransaction (c_dbPath config) zt
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) zt
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 =
@ -359,34 +381,42 @@ syncWallet config w = do
accs <- getAccounts walletDb $ entityKey w
addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
intAddrs <- concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
lastBlock <- getMaxWalletBlock walletDb
chainTip <- getMaxBlock walletDb
let lastBlock = zcashWalletLastSync $ entityVal w
let startBlock =
if lastBlock > 0
then lastBlock
else zcashWalletBirthdayHeight $ entityVal w
trNotes <- mapM (findTransparentNotes walletDb startBlock . entityVal) addrs
mapM_ (saveWalletTrNote walletDb External) $ concat trNotes
trChNotes <-
mapM (findTransparentNotes walletDb startBlock . entityVal) intAddrs
mapM_ (saveWalletTrNote walletDb Internal) $ concat trChNotes
mapM_ (findTransparentNotes walletDb startBlock) addrs
mapM_ (findTransparentNotes walletDb startBlock) intAddrs
mapM_ (findTransparentSpends walletDb . entityKey) accs
sapNotes <-
mapM
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w) .
zcashAccountSapSpendKey . entityVal)
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
accs
orchNotes <-
mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w) .
zcashAccountOrchSpendKey . entityVal)
(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
w <- runSqlite dbPath $ selectFirst [ZcashWalletName ==. "Main"] []
case w of
Nothing -> print "No wallet"
Just w' -> do
r <- syncWallet config w'
print r
_ <- 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

415
src/Zenith/DB.hs
View File

@ -18,11 +18,13 @@
module Zenith.DB where
import Control.Monad (when)
import Control.Exception (throwIO)
import Control.Monad (forM_, when)
import Control.Monad.IO.Class (MonadIO)
import Data.Bifunctor
import qualified Data.ByteString as BS
import Data.HexString
import Data.List (group, sort)
import Data.Maybe (fromJust, isJust)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@ -70,7 +72,6 @@ import Zenith.Types
, ScopeDB(..)
, TransparentSpendingKeyDB
, UnifiedAddressDB(..)
, UserTx(..)
, ZcashNetDB(..)
)
@ -82,6 +83,7 @@ share
network ZcashNetDB
seedPhrase PhraseDB
birthdayHeight Int
lastSync Int default=0
UniqueWallet name network
deriving Show Eq
ZcashAccount
@ -105,26 +107,39 @@ share
deriving Show Eq
WalletTransaction
txId HexStringDB
accId ZcashAccountId
block Int
conf Int
time Int
UniqueWTx txId
UniqueWTx txId accId
deriving Show Eq
UserTx
hex HexStringDB
address WalletAddressId
time Int
amount Int
memo T.Text
UniqueUTx hex address
deriving Show Eq
WalletTrNote
tx WalletTransactionId
accId ZcashAccountId
value Word64
spent Bool
script BS.ByteString
change Bool
position Word64
UniqueTNote tx script
deriving Show Eq
WalletTrSpend
tx WalletTransactionId
note WalletTrNoteId
accId ZcashAccountId
value Word64
deriving Show Eq
WalletSapNote
tx WalletTransactionId
accId ZcashAccountId
value Word64
recipient BS.ByteString
memo T.Text
@ -138,10 +153,12 @@ share
WalletSapSpend
tx WalletTransactionId
note WalletSapNoteId
accId ZcashAccountId
value Word64
deriving Show Eq
WalletOrchNote
tx WalletTransactionId
accId ZcashAccountId
value Word64
recipient BS.ByteString
memo T.Text
@ -155,6 +172,7 @@ share
WalletOrchSpend
tx WalletTransactionId
note WalletOrchNoteId
accId ZcashAccountId
value Word64
deriving Show Eq
ZcashTransaction
@ -174,9 +192,9 @@ share
TransparentSpend
tx ZcashTransactionId
outPointHash HexStringDB
outPointIndex Int
outPointIndex Word64
script BS.ByteString
seq Int
seq Word64
position Int
UniqueTSPos tx position
deriving Show Eq
@ -225,6 +243,13 @@ initDb ::
initDb dbName = do
PS.runSqlite dbName $ do runMigration migrateAll
-- | Upgrade the database
upgradeDb ::
T.Text -- ^ database path
-> IO ()
upgradeDb dbName = do
PS.runSqlite dbName $ do runMigrationUnsafe migrateAll
-- | Get existing wallets from database
getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
getWallets dbFp n =
@ -241,6 +266,14 @@ saveWallet ::
-> IO (Maybe (Entity ZcashWallet))
saveWallet dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
-- | Update the last sync block for the wallet
updateWalletSync :: T.Text -> Int -> ZcashWalletId -> IO ()
updateWalletSync dbPath b i = do
PS.runSqlite dbPath $ do
update $ \w -> do
set w [ZcashWalletLastSync =. val b]
where_ $ w ^. ZcashWalletId ==. val i
-- | Returns a list of accounts associated with the given wallet
getAccounts ::
T.Text -- ^ The database path
@ -473,14 +506,18 @@ getMaxWalletBlock dbPath = do
-- | Save a @WalletTransaction@
saveWalletTransaction ::
T.Text -> Entity ZcashTransaction -> IO WalletTransactionId
saveWalletTransaction dbPath zt = do
T.Text
-> ZcashAccountId
-> Entity ZcashTransaction
-> IO WalletTransactionId
saveWalletTransaction dbPath za zt = do
let zT' = entityVal zt
PS.runSqlite dbPath $ do
t <-
upsert
(WalletTransaction
(zcashTransactionTxId zT')
za
(zcashTransactionBlock zT')
(zcashTransactionConf zT')
(zcashTransactionTime zT'))
@ -494,14 +531,16 @@ saveWalletSapNote ::
-> Integer -- ^ note position
-> SaplingWitness -- ^ the Sapling incremental witness
-> Bool -- ^ change flag
-> ZcashAccountId
-> DecodedNote -- The decoded Sapling note
-> IO ()
saveWalletSapNote dbPath wId pos wit ch dn = do
saveWalletSapNote dbPath wId pos wit ch za dn = do
PS.runSqlite dbPath $ do
_ <-
upsert
(WalletSapNote
wId
za
(fromIntegral $ a_value dn)
(a_recipient dn)
(T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn)
@ -520,14 +559,16 @@ saveWalletOrchNote ::
-> Integer
-> OrchardWitness
-> Bool
-> ZcashAccountId
-> DecodedNote
-> IO ()
saveWalletOrchNote dbPath wId pos wit ch dn = do
saveWalletOrchNote dbPath wId pos wit ch za dn = do
PS.runSqlite dbPath $ do
_ <-
upsert
(WalletOrchNote
wId
za
(fromIntegral $ a_value dn)
(a_recipient dn)
(T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn)
@ -543,10 +584,10 @@ saveWalletOrchNote dbPath wId pos wit ch dn = do
findTransparentNotes ::
T.Text -- ^ The database path
-> Int -- ^ Starting block
-> WalletAddress
-> IO [(Entity ZcashTransaction, Entity TransparentNote)]
-> Entity WalletAddress
-> IO ()
findTransparentNotes dbPath b t = do
let tReceiver = t_rec =<< readUnifiedAddressDB t
let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t)
case tReceiver of
Just tR -> do
let s =
@ -555,7 +596,8 @@ findTransparentNotes dbPath b t = do
, (toBytes . tr_bytes) tR
, BS.pack [0x88, 0xAC]
]
PS.runSqlite dbPath $
tN <-
PS.runSqlite dbPath $
select $ do
(txs :& tNotes) <-
from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
@ -564,21 +606,29 @@ findTransparentNotes dbPath b t = do
where_ (txs ^. ZcashTransactionBlock >. val b)
where_ (tNotes ^. TransparentNoteScript ==. val s)
pure (txs, tNotes)
Nothing -> return []
mapM_
(saveWalletTrNote
dbPath
(getScope $ walletAddressScope $ entityVal t)
(walletAddressAccId $ entityVal t))
tN
Nothing -> return ()
-- | Add the transparent notes to the wallet
saveWalletTrNote ::
T.Text -- ^ the database path
-> Scope
-> ZcashAccountId
-> (Entity ZcashTransaction, Entity TransparentNote)
-> IO ()
saveWalletTrNote dbPath ch (zt, tn) = do
saveWalletTrNote dbPath ch za (zt, tn) = do
let zT' = entityVal zt
PS.runSqlite dbPath $ do
t <-
upsert
(WalletTransaction
(zcashTransactionTxId zT')
za
(zcashTransactionBlock zT')
(zcashTransactionConf zT')
(zcashTransactionTime zT'))
@ -586,10 +636,12 @@ saveWalletTrNote dbPath ch (zt, tn) = do
insert_ $
WalletTrNote
(entityKey t)
za
(transparentNoteValue $ entityVal tn)
False
(transparentNoteScript $ entityVal tn)
(ch == Internal)
(fromIntegral $ transparentNotePosition $ entityVal tn)
-- | Save a Sapling note to the wallet database
saveSapNote :: T.Text -> WalletSapNote -> IO ()
@ -634,12 +686,15 @@ getOrchardActions dbPath b =
-- | Get the transactions belonging to the given address
getWalletTransactions ::
T.Text -- ^ database path
-> WalletAddress
-> IO [WalletTransactionId]
-> Entity WalletAddress
-> IO ()
getWalletTransactions dbPath w = do
let tReceiver = t_rec =<< readUnifiedAddressDB w
let sReceiver = s_rec =<< readUnifiedAddressDB w
let oReceiver = o_rec =<< readUnifiedAddressDB w
let w' = entityVal w
chgAddr <- getInternalAddresses dbPath $ walletAddressAccId $ entityVal w
let ctReceiver = t_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
let tReceiver = t_rec =<< readUnifiedAddressDB w'
let sReceiver = s_rec =<< readUnifiedAddressDB w'
let oReceiver = o_rec =<< readUnifiedAddressDB w'
trNotes <-
case tReceiver of
Nothing -> return []
@ -655,6 +710,28 @@ getWalletTransactions dbPath w = do
tnotes <- from $ table @WalletTrNote
where_ (tnotes ^. WalletTrNoteScript ==. val s)
pure tnotes
trChgNotes <-
case ctReceiver of
Nothing -> return []
Just tR -> do
let s1 =
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 s1)
pure tnotes
trSpends <-
PS.runSqlite dbPath $ do
select $ do
trSpends <- from $ table @WalletTrSpend
where_
(trSpends ^. WalletTrSpendNote `in_` valList (map entityKey trNotes))
pure trSpends
sapNotes <-
case sReceiver of
Nothing -> return []
@ -664,6 +741,14 @@ getWalletTransactions dbPath w = do
snotes <- from $ table @WalletSapNote
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
pure snotes
sapSpends <-
PS.runSqlite dbPath $ do
select $ do
sapSpends <- from $ table @WalletSapSpend
where_
(sapSpends ^. WalletSapSpendNote `in_`
valList (map entityKey sapNotes))
pure sapSpends
orchNotes <-
case oReceiver of
Nothing -> return []
@ -673,78 +758,185 @@ getWalletTransactions dbPath w = 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
orchSpends <-
PS.runSqlite dbPath $ do
select $ do
orchSpends <- from $ table @WalletOrchSpend
where_
(orchSpends ^. WalletOrchSpendNote `in_`
valList (map entityKey orchNotes))
pure orchSpends
mapM_ addTr trNotes
mapM_ addTr trChgNotes
mapM_ addSap sapNotes
mapM_ addOrch orchNotes
mapM_ subTSpend trSpends
mapM_ subSSpend sapSpends
mapM_ subOSpend orchSpends
where
convertUserTx :: WalletTransactionId -> IO UserTx
convertUserTx tId = do
addTr :: Entity WalletTrNote -> IO ()
addTr n =
upsertUserTx
(walletTrNoteTx $ entityVal n)
(entityKey w)
(fromIntegral $ walletTrNoteValue $ entityVal n)
""
addSap :: Entity WalletSapNote -> IO ()
addSap n =
upsertUserTx
(walletSapNoteTx $ entityVal n)
(entityKey w)
(fromIntegral $ walletSapNoteValue $ entityVal n)
(walletSapNoteMemo $ entityVal n)
addOrch :: Entity WalletOrchNote -> IO ()
addOrch n =
upsertUserTx
(walletOrchNoteTx $ entityVal n)
(entityKey w)
(fromIntegral $ walletOrchNoteValue $ entityVal n)
(walletOrchNoteMemo $ entityVal n)
subTSpend :: Entity WalletTrSpend -> IO ()
subTSpend n =
upsertUserTx
(walletTrSpendTx $ entityVal n)
(entityKey w)
(-(fromIntegral $ walletTrSpendValue $ entityVal n))
""
subSSpend :: Entity WalletSapSpend -> IO ()
subSSpend n =
upsertUserTx
(walletSapSpendTx $ entityVal n)
(entityKey w)
(-(fromIntegral $ walletSapSpendValue $ entityVal n))
""
subOSpend :: Entity WalletOrchSpend -> IO ()
subOSpend n =
upsertUserTx
(walletOrchSpendTx $ entityVal n)
(entityKey w)
(-(fromIntegral $ walletOrchSpendValue $ entityVal n))
""
upsertUserTx ::
WalletTransactionId -> WalletAddressId -> Int -> T.Text -> IO ()
upsertUserTx tId wId amt memo = do
tr <-
PS.runSqlite dbPath $ do
select $ do
tx <- from $ table @WalletTransaction
where_ (tx ^. WalletTransactionId ==. val tId)
pure tx
trNotes <-
existingUtx <-
PS.runSqlite dbPath $ do
select $ do
trNotes <- from $ table @WalletTrNote
where_ (trNotes ^. WalletTrNoteTx ==. val tId)
pure trNotes
trSpends <-
selectOne $ do
ut <- from $ table @UserTx
where_
(ut ^. UserTxHex ==.
val (walletTransactionTxId $ entityVal $ head tr))
where_ (ut ^. UserTxAddress ==. val wId)
pure ut
case existingUtx of
Nothing -> do
_ <-
PS.runSqlite dbPath $ do
upsert
(UserTx
(walletTransactionTxId $ entityVal $ head tr)
wId
(walletTransactionTime $ entityVal $ head tr)
amt
memo)
[]
return ()
Just uTx -> do
_ <-
PS.runSqlite dbPath $ do
upsert
(UserTx
(walletTransactionTxId $ entityVal $ head tr)
wId
(walletTransactionTime $ entityVal $ head tr)
(amt + userTxAmount (entityVal uTx))
(memo <> " " <> userTxMemo (entityVal uTx)))
[]
return ()
getUserTx :: T.Text -> WalletAddressId -> IO [Entity UserTx]
getUserTx dbPath aId = do
PS.runSqlite dbPath $ do
select $ do
uTxs <- from $ table @UserTx
where_ (uTxs ^. UserTxAddress ==. val aId)
return uTxs
-- | Get wallet transparent notes by account
getWalletTrNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletTrNote]
getWalletTrNotes dbPath za = do
PS.runSqlite dbPath $ do
select $ do
n <- from $ table @WalletTrNote
where_ (n ^. WalletTrNoteAccId ==. val za)
pure n
-- | find Transparent spends
findTransparentSpends :: T.Text -> ZcashAccountId -> IO ()
findTransparentSpends dbPath za = do
notes <- getWalletTrNotes dbPath za
mapM_ findOneTrSpend notes
where
findOneTrSpend :: Entity WalletTrNote -> IO ()
findOneTrSpend n = do
mReverseTxId <-
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))
selectOne $ do
wtx <- from $ table @WalletTransaction
where_
(wtx ^. WalletTransactionId ==. val (walletTrNoteTx $ entityVal n))
pure $ wtx ^. WalletTransactionTxId
case mReverseTxId of
Nothing -> throwIO $ userError "failed to get tx ID"
Just (Value reverseTxId) -> do
s <-
PS.runSqlite dbPath $ do
select $ do
(tx :& trSpends) <-
from $
table @ZcashTransaction `innerJoin` table @TransparentSpend `on`
(\(tx :& trSpends) ->
tx ^. ZcashTransactionId ==. trSpends ^. TransparentSpendTx)
where_
(trSpends ^. TransparentSpendOutPointHash ==. val reverseTxId)
where_
(trSpends ^. TransparentSpendOutPointIndex ==.
val (walletTrNotePosition $ entityVal n))
pure (tx, trSpends)
if null s
then return ()
else do
PS.runSqlite dbPath $ do
_ <-
update $ \w -> do
set w [WalletTrNoteSpent =. val True]
where_ $ w ^. WalletTrNoteId ==. val (entityKey n)
t' <- upsertWalTx (entityVal $ fst $ head s) za
insert_ $
WalletTrSpend
(entityKey t')
(entityKey n)
za
(walletTrNoteValue $ entityVal n)
getWalletSapNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletSapNote]
getWalletSapNotes dbPath za = do
PS.runSqlite dbPath $ do
select $ do
n <- from $ table @WalletSapNote
where_ (n ^. WalletSapNoteAccId ==. val za)
pure n
-- | Sapling DAG-aware spend tracking
findSapSpends :: T.Text -> SaplingSpendingKey -> [Entity WalletSapNote] -> IO ()
findSapSpends :: T.Text -> ZcashAccountId -> [Entity WalletSapNote] -> IO ()
findSapSpends _ _ [] = return ()
findSapSpends dbPath sk (n:notes) = do
findSapSpends dbPath za (n:notes) = do
s <-
PS.runSqlite dbPath $ do
select $ do
@ -757,25 +949,33 @@ findSapSpends dbPath sk (n:notes) = do
val (walletSapNoteNullifier (entityVal n)))
pure (tx, sapSpends)
if null s
then findSapSpends dbPath sk notes
then findSapSpends dbPath za 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
t' <- upsertWalTx (entityVal $ fst $ head s) za
insert_ $
WalletSapSpend
(entityKey t')
(entityKey n)
za
(walletSapNoteValue $ entityVal n)
findSapSpends dbPath sk notes
findSapSpends dbPath za notes
findOrchSpends ::
T.Text -> OrchardSpendingKey -> [Entity WalletOrchNote] -> IO ()
getWalletOrchNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletOrchNote]
getWalletOrchNotes dbPath za = do
PS.runSqlite dbPath $ do
select $ do
n <- from $ table @WalletOrchNote
where_ (n ^. WalletOrchNoteAccId ==. val za)
pure n
findOrchSpends :: T.Text -> ZcashAccountId -> [Entity WalletOrchNote] -> IO ()
findOrchSpends _ _ [] = return ()
findOrchSpends dbPath sk (n:notes) = do
findOrchSpends dbPath za (n:notes) = do
s <-
PS.runSqlite dbPath $ do
select $ do
@ -788,33 +988,66 @@ findOrchSpends dbPath sk (n:notes) = do
val (walletOrchNoteNullifier (entityVal n)))
pure (tx, orchSpends)
if null s
then findOrchSpends dbPath sk notes
then findOrchSpends dbPath za 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
t' <- upsertWalTx (entityVal $ fst $ head s) za
insert_ $
WalletOrchSpend
(entityKey t')
(entityKey n)
za
(walletOrchNoteValue $ entityVal n)
findOrchSpends dbPath sk notes
findOrchSpends dbPath za notes
upsertWalTx ::
MonadIO m => ZcashTransaction -> SqlPersistT m (Entity WalletTransaction)
upsertWalTx zt =
MonadIO m
=> ZcashTransaction
-> ZcashAccountId
-> SqlPersistT m (Entity WalletTransaction)
upsertWalTx zt za =
upsert
(WalletTransaction
(zcashTransactionTxId zt)
za
(zcashTransactionBlock zt)
(zcashTransactionConf zt)
(zcashTransactionTime zt))
[]
clearWalletTransactions :: T.Text -> IO ()
clearWalletTransactions dbPath = do
PS.runSqlite dbPath $ do
delete $ do
_ <- from $ table @WalletOrchNote
return ()
delete $ do
_ <- from $ table @WalletOrchSpend
return ()
delete $ do
_ <- from $ table @WalletSapNote
return ()
delete $ do
_ <- from $ table @WalletSapSpend
return ()
delete $ do
_ <- from $ table @WalletTrNote
return ()
delete $ do
_ <- from $ table @WalletTrSpend
return ()
delete $ do
_ <- from $ table @WalletTransaction
return ()
-- | Helper function to extract a Unified Address from the database
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
readUnifiedAddressDB =
isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress
rmdups :: Ord a => [a] -> [a]
rmdups = map head . group . sort

7
src/Zenith/Types.hs
View File

@ -30,13 +30,6 @@ import ZcashHaskell.Types
)
-- * 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