From 52ac50e30cbf1360f0418baacd7267a00c30fcf3 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 24 Apr 2024 07:42:35 -0500 Subject: [PATCH] Implement per-address tx display --- app/Main.hs | 3 +- src/Zenith/CLI.hs | 76 ++++---- src/Zenith/Core.hs | 78 ++++++--- src/Zenith/DB.hs | 415 ++++++++++++++++++++++++++++++++++---------- src/Zenith/Types.hs | 7 - 5 files changed, 420 insertions(+), 159 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index dc840b3..eb13ce7 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 4190f9f..c349f1b 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -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 diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 42bb2d9..3d3ecbe 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -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 diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 3dabce5..999a4ec 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -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 diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index bde9a20..32c44ea 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -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