From 5ce822e52f9bf2f32193db6815eb258b1ca4fe2d Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Sun, 7 Apr 2024 09:25:25 -0500 Subject: [PATCH 1/9] Migrate to Esqueleto --- src/Zenith/Core.hs | 9 +- src/Zenith/DB.hs | 260 ++++++++++++++++++++++++++++++++++++--------- test/Spec.hs | 11 ++ zcash-haskell | 2 +- zenith.cabal | 4 +- 5 files changed, 233 insertions(+), 53 deletions(-) diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 3d9fac6..912f9fe 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -163,5 +163,10 @@ createWalletAddress n i zNet scope za = do syncWallet :: T.Text -- ^ The database path -> Entity ZcashWallet - -> IO () -syncWallet walletDb w = undefined + -> IO String +syncWallet walletDb w = do + accs <- getAccounts walletDb $ entityKey w + addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs + lastBlock <- getMaxWalletBlock walletDb + trNotes <- mapM (findTransparentNotes walletDb lastBlock . entityVal) addrs + return $ show trNotes diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 496a353..88704f6 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -14,19 +14,27 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} module Zenith.DB where import Control.Monad (when) -import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString as BS import Data.HexString import Data.Maybe (fromJust, isJust) import qualified Data.Text as T -import Database.Persist -import Database.Persist.Sqlite +import qualified Data.Text.Encoding as TE +import Database.Esqueleto.Experimental +import qualified Database.Persist as P +import qualified Database.Persist.Sqlite as PS import Database.Persist.TH -import Haskoin.Transaction.Common (TxOut(..)) +import Haskoin.Transaction.Common + ( OutPoint(..) + , TxIn(..) + , TxOut(..) + , txHashToHex + ) +import ZcashHaskell.Orchard (isValidUnifiedAddress) import ZcashHaskell.Types ( OrchardAction(..) , OrchardBundle(..) @@ -35,7 +43,9 @@ import ZcashHaskell.Types , ShieldedOutput(..) , ShieldedSpend(..) , Transaction(..) + , TransparentAddress(..) , TransparentBundle(..) + , UnifiedAddress(..) , ZcashNet ) import Zenith.Types @@ -83,6 +93,7 @@ share block Int conf Int time Int + UniqueWTx txId deriving Show Eq WalletTrNote tx WalletTransactionId @@ -99,6 +110,7 @@ share memo T.Text rawId ShieldOutputId spent Bool + nullifier HexStringDB deriving Show Eq WalletOrchNote tx WalletTransactionId @@ -108,6 +120,7 @@ share memo T.Text rawId OrchActionId spent Bool + nullifier HexStringDB deriving Show Eq ZcashTransaction block Int @@ -119,6 +132,18 @@ share tx ZcashTransactionId value Int script BS.ByteString + position Int + UniqueTNPos tx position + deriving Show Eq + TransparentSpend + tx ZcashTransactionId + outPointHash HexStringDB + outPointIndex Int + script BS.ByteString + seq Int + position Int + UniqueTSPos tx position + deriving Show Eq OrchAction tx ZcashTransactionId nf HexStringDB @@ -129,6 +154,8 @@ share outCipher HexStringDB cv HexStringDB auth HexStringDB + position Int + UniqueOAPos tx position deriving Show Eq ShieldOutput tx ZcashTransactionId @@ -138,6 +165,8 @@ share encCipher HexStringDB outCipher HexStringDB proof HexStringDB + position Int + UniqueSOPos tx position deriving Show Eq ShieldSpend tx ZcashTransactionId @@ -147,6 +176,8 @@ share rk HexStringDB proof HexStringDB authSig HexStringDB + position Int + UniqueSSPos tx position deriving Show Eq |] @@ -156,26 +187,35 @@ initDb :: T.Text -- ^ The database path to check -> IO () initDb dbName = do - runSqlite dbName $ do runMigration migrateAll + PS.runSqlite dbName $ do runMigration migrateAll -- | Get existing wallets from database getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet] getWallets dbFp n = - runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] [] + PS.runSqlite dbFp $ + select $ do + wallets <- from $ table @ZcashWallet + where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n)) + pure wallets -- | Save a new wallet to the database saveWallet :: T.Text -- ^ The database path to use -> ZcashWallet -- ^ The wallet to add to the database -> IO (Maybe (Entity ZcashWallet)) -saveWallet dbFp w = runSqlite dbFp $ insertUniqueEntity w +saveWallet dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w -- | Returns a list of accounts associated with the given wallet getAccounts :: T.Text -- ^ The database path -> ZcashWalletId -- ^ The wallet ID to check -> IO [Entity ZcashAccount] -getAccounts dbFp w = runSqlite dbFp $ selectList [ZcashAccountWalletId ==. w] [] +getAccounts dbFp w = + PS.runSqlite dbFp $ + select $ do + accs <- from $ table @ZcashAccount + where_ (accs ^. ZcashAccountWalletId ==. val w) + pure accs -- | Returns the largest account index for the given wallet getMaxAccount :: @@ -184,8 +224,12 @@ getMaxAccount :: -> IO Int getMaxAccount dbFp w = do a <- - runSqlite dbFp $ - selectFirst [ZcashAccountWalletId ==. w] [Desc ZcashAccountIndex] + PS.runSqlite dbFp $ + selectOne $ do + accs <- from $ table @ZcashAccount + where_ (accs ^. ZcashAccountWalletId ==. val w) + orderBy [desc $ accs ^. ZcashAccountIndex] + pure accs case a of Nothing -> return $ -1 Just x -> return $ zcashAccountIndex $ entityVal x @@ -195,7 +239,7 @@ saveAccount :: T.Text -- ^ The database path -> ZcashAccount -- ^ The account to add to the database -> IO (Maybe (Entity ZcashAccount)) -saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a +saveAccount dbFp a = PS.runSqlite dbFp $ insertUniqueEntity a -- | Returns the largest block in storage getMaxBlock :: @@ -203,34 +247,38 @@ getMaxBlock :: -> IO Int getMaxBlock dbPath = do b <- - runSqlite dbPath $ - selectFirst [ZcashTransactionBlock >. 0] [Desc ZcashTransactionBlock] + PS.runSqlite dbPath $ + selectOne $ do + txs <- from $ table @ZcashTransaction + where_ (txs ^. ZcashTransactionBlock >. val 0) + orderBy [desc $ txs ^. ZcashTransactionBlock] + pure txs case b of Nothing -> return $ -1 Just x -> return $ zcashTransactionBlock $ entityVal x --- | Returns the largest block in the wallet -getMaxWalletBlock :: - T.Text -- ^ The database path - -> IO Int -getMaxWalletBlock dbPath = do - b <- - runSqlite dbPath $ - selectFirst [WalletTransactionBlock >. 0] [Desc WalletTransactionBlock] - case b of - Nothing -> return $ -1 - Just x -> return $ walletTransactionBlock $ entityVal x - -- | Returns a list of addresses associated with the given account getAddresses :: T.Text -- ^ The database path -> ZcashAccountId -- ^ The account ID to check -> IO [Entity WalletAddress] getAddresses dbFp a = - runSqlite dbFp $ - selectList - [WalletAddressAccId ==. a, WalletAddressScope ==. ScopeDB External] - [] + PS.runSqlite dbFp $ + select $ do + addrs <- from $ table @WalletAddress + where_ (addrs ^. WalletAddressAccId ==. val a) + where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External)) + pure addrs + +-- | Returns a list of addressess associated with the given wallet +getWalletAddresses :: + T.Text -- ^ The database path + -> ZcashWalletId -- ^ the wallet to search + -> IO [Entity WalletAddress] +getWalletAddresses dbFp w = do + accs <- getAccounts dbFp w + addrs <- mapM (getAddresses dbFp . entityKey) accs + return $ concat addrs -- | Returns the largest address index for the given account getMaxAddress :: @@ -240,10 +288,13 @@ getMaxAddress :: -> IO Int getMaxAddress dbFp aw s = do a <- - runSqlite dbFp $ - selectFirst - [WalletAddressAccId ==. aw, WalletAddressScope ==. ScopeDB s] - [Desc WalletAddressIndex] + PS.runSqlite dbFp $ + selectOne $ do + addrs <- from $ table @WalletAddress + where_ $ addrs ^. WalletAddressAccId ==. val aw + where_ $ addrs ^. WalletAddressScope ==. val (ScopeDB s) + orderBy [desc $ addrs ^. WalletAddressIndex] + pure addrs case a of Nothing -> return $ -1 Just x -> return $ walletAddressIndex $ entityVal x @@ -253,7 +304,7 @@ saveAddress :: T.Text -- ^ the database path -> WalletAddress -- ^ The wallet to add to the database -> IO (Maybe (Entity WalletAddress)) -saveAddress dbFp w = runSqlite dbFp $ insertUniqueEntity w +saveAddress dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w -- | Save a transaction to the data model saveTransaction :: @@ -262,30 +313,50 @@ saveTransaction :: -> Transaction -- ^ The transaction to save -> IO (Key ZcashTransaction) saveTransaction dbFp t wt = - runSqlite dbFp $ do + PS.runSqlite dbFp $ do + let ix = [0 ..] w <- insert $ ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t - when (isJust $ tx_transpBundle wt) $ - insertMany_ $ - map (storeTxOut w) $ (tb_vout . fromJust . tx_transpBundle) wt + when (isJust $ tx_transpBundle wt) $ do + _ <- + insertMany_ $ + zipWith (curry (storeTxOut w)) ix $ + (tb_vout . fromJust . tx_transpBundle) wt + _ <- + insertMany_ $ + zipWith (curry (storeTxIn w)) ix $ + (tb_vin . fromJust . tx_transpBundle) wt + return () when (isJust $ tx_saplingBundle wt) $ do _ <- insertMany_ $ - map (storeSapSpend w) $ (sbSpends . fromJust . tx_saplingBundle) wt + zipWith (curry (storeSapSpend w)) ix $ + (sbSpends . fromJust . tx_saplingBundle) wt _ <- insertMany_ $ - map (storeSapOutput w) $ (sbOutputs . fromJust . tx_saplingBundle) wt + zipWith (curry (storeSapOutput w)) ix $ + (sbOutputs . fromJust . tx_saplingBundle) wt return () when (isJust $ tx_orchardBundle wt) $ insertMany_ $ - map (storeOrchAction w) $ (obActions . fromJust . tx_orchardBundle) wt + zipWith (curry (storeOrchAction w)) ix $ + (obActions . fromJust . tx_orchardBundle) wt return w where - storeTxOut :: ZcashTransactionId -> TxOut -> TransparentNote - storeTxOut wid (TxOut v s) = TransparentNote wid (fromIntegral v) s - storeSapSpend :: ZcashTransactionId -> ShieldedSpend -> ShieldSpend - storeSapSpend wid sp = + storeTxOut :: ZcashTransactionId -> (Int, TxOut) -> TransparentNote + storeTxOut wid (i, TxOut v s) = TransparentNote wid (fromIntegral v) s i + storeTxIn :: ZcashTransactionId -> (Int, TxIn) -> TransparentSpend + storeTxIn wid (i, TxIn (OutPoint h k) s sq) = + TransparentSpend + wid + (HexStringDB . fromText $ txHashToHex h) + (fromIntegral k) + s + (fromIntegral sq) + i + storeSapSpend :: ZcashTransactionId -> (Int, ShieldedSpend) -> ShieldSpend + storeSapSpend wid (i, sp) = ShieldSpend wid (HexStringDB $ sp_cv sp) @@ -294,8 +365,10 @@ saveTransaction dbFp t wt = (HexStringDB $ sp_rk sp) (HexStringDB $ sp_proof sp) (HexStringDB $ sp_auth sp) - storeSapOutput :: ZcashTransactionId -> ShieldedOutput -> ShieldOutput - storeSapOutput wid so = + i + storeSapOutput :: + ZcashTransactionId -> (Int, ShieldedOutput) -> ShieldOutput + storeSapOutput wid (i, so) = ShieldOutput wid (HexStringDB $ s_cv so) @@ -304,8 +377,9 @@ saveTransaction dbFp t wt = (HexStringDB $ s_encCipherText so) (HexStringDB $ s_outCipherText so) (HexStringDB $ s_proof so) - storeOrchAction :: ZcashTransactionId -> OrchardAction -> OrchAction - storeOrchAction wid oa = + i + storeOrchAction :: ZcashTransactionId -> (Int, OrchardAction) -> OrchAction + storeOrchAction wid (i, oa) = OrchAction wid (HexStringDB $ nf oa) @@ -316,3 +390,91 @@ saveTransaction dbFp t wt = (HexStringDB $ out_ciphertext oa) (HexStringDB $ cv oa) (HexStringDB $ auth oa) + i + +-- | Get the transactions from a particular block forward +getZcashTransactions :: + T.Text -- ^ The database path + -> Int -- ^ Block + -> IO [Entity ZcashTransaction] +getZcashTransactions dbFp b = + PS.runSqlite dbFp $ + select $ do + txs <- from $ table @ZcashTransaction + where_ $ txs ^. ZcashTransactionBlock >. val b + orderBy [asc $ txs ^. ZcashTransactionBlock] + return txs + +-- * Wallet +-- | Get the block of the last transaction known to the wallet +getMaxWalletBlock :: + T.Text -- ^ The database path + -> IO Int +getMaxWalletBlock dbPath = do + b <- + PS.runSqlite dbPath $ + selectOne $ do + txs <- from $ table @WalletTransaction + where_ $ txs ^. WalletTransactionBlock >. val 0 + orderBy [desc $ txs ^. WalletTransactionBlock] + return txs + case b of + Nothing -> return $ -1 + Just x -> return $ walletTransactionBlock $ entityVal x + +-- | Find the Transparent Notes that match the given transparent receiver +findTransparentNotes :: + T.Text -- ^ The database path + -> Int -- ^ Starting block + -> WalletAddress + -> IO [(Entity ZcashTransaction, Entity TransparentNote)] +findTransparentNotes dbPath b t = do + let tReceiver = t_rec =<< readUnifiedAddressDB t + case tReceiver of + Just tR -> do + let s = + BS.concat + [ BS.pack [0x76, 0xA9, 0x14] + , (toBytes . ta_bytes) tR + , BS.pack [0x88, 0xAC] + ] + PS.runSqlite dbPath $ + select $ do + (txs :& tNotes) <- + from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on` + (\(txs :& tNotes) -> + txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx) + where_ (txs ^. ZcashTransactionBlock >. val b) + where_ (tNotes ^. TransparentNoteScript ==. val s) + pure (txs, tNotes) + Nothing -> return [] + +-- | Add the transparent notes to the wallet +saveWalletTrNote :: + T.Text -- ^ the database path + -> (Entity ZcashTransaction, Entity TransparentNote) + -> WalletAddressId + -> IO () +saveWalletTrNote dbPath (zt, tn) wa = do + let zT' = entityVal zt + PS.runSqlite dbPath $ do + t <- + upsert + (WalletTransaction + (zcashTransactionTxId zT') + (zcashTransactionBlock zT') + (zcashTransactionConf zT') + (zcashTransactionTime zT')) + [] + insert_ $ + WalletTrNote + (entityKey t) + wa + (transparentNoteValue $ entityVal tn) + (entityKey tn) + False + +-- | Helper function to extract a Unified Address from the database +readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress +readUnifiedAddressDB = + isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress diff --git a/test/Spec.hs b/test/Spec.hs index bfc6f68..3f44006 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -4,6 +4,7 @@ import Control.Monad (when) import Database.Persist import Database.Persist.Sqlite import System.Directory +import Test.HUnit import Test.Hspec import ZcashHaskell.Orchard (isValidUnifiedAddress) import ZcashHaskell.Types @@ -98,3 +99,13 @@ main = do let ua = "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x" isValidUnifiedAddress ua `shouldNotBe` Nothing + describe "Function tests" $ do + it "Wallet sync" $ do + w <- + runSqlite "zenith.db" $ + selectFirst [ZcashWalletBirthdayHeight >. 0] [] + case w of + Nothing -> assertFailure "No wallet in DB" + Just w' -> do + r <- syncWallet "zenith.db" w' + r `shouldBe` "Done" diff --git a/zcash-haskell b/zcash-haskell index 938ccb4..2709d42 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 938ccb4b9730fd8615513eb27bdbffacd62e29cc +Subproject commit 2709d422667080527ccc180e97352693a4c6c2c7 diff --git a/zenith.cabal b/zenith.cabal index 6691f3f..f78e7ed 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -39,10 +39,12 @@ library Clipboard , aeson , array + , ascii-progress , base >=4.12 && <5 , base64-bytestring , brick , bytestring + , esqueleto , ghc , haskoin-core , hexstring @@ -65,7 +67,6 @@ library , vector , vty , word-wrap - , ascii-progress , zcash-haskell --pkgconfig-depends: rustzcash_wrapper default-language: Haskell2010 @@ -119,6 +120,7 @@ test-suite zenith-tests , persistent , persistent-sqlite , hspec + , HUnit , directory , zcash-haskell , zenith From 0543c1141cd6a233f741d97091faa0ccc8f56f06 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Mon, 8 Apr 2024 15:51:14 -0500 Subject: [PATCH 2/9] Implement Shielded Output scanning --- CHANGELOG.md | 11 +++++++++++ src/Zenith/Core.hs | 11 ++++++++++- src/Zenith/DB.hs | 47 +++++++++++++++++++++++++++++++++++++++++++++- zcash-haskell | 2 +- zenith.cabal | 2 +- 5 files changed, 69 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6b90b6e..20a7a48 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,17 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.4.5.0] + +### Added + +- Functions to scan relevant transparent notes +- Functions to scan relevant Sapling notes + +### Changed + +- Update `zcash-haskell` + ## [0.4.4.3] ### Added diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 912f9fe..4a63066 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -169,4 +169,13 @@ syncWallet walletDb w = do addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs lastBlock <- getMaxWalletBlock walletDb trNotes <- mapM (findTransparentNotes walletDb lastBlock . entityVal) addrs - return $ show trNotes + sapNotes <- + mapM + (findSaplingOutputs walletDb lastBlock (zcashWalletNetwork $ entityVal w) . + zcashAccountSapSpendKey . entityVal) + accs + print "Transparent Notes: " + print trNotes + print "Sapling notes: " + print sapNotes + return "Testing" diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 88704f6..421cd1c 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -19,6 +19,7 @@ module Zenith.DB where import Control.Monad (when) +import Data.Bifunctor import qualified Data.ByteString as BS import Data.HexString import Data.Maybe (fromJust, isJust) @@ -35,8 +36,10 @@ import Haskoin.Transaction.Common , txHashToHex ) import ZcashHaskell.Orchard (isValidUnifiedAddress) +import ZcashHaskell.Sapling (decodeSaplingOutputEsk) import ZcashHaskell.Types - ( OrchardAction(..) + ( DecodedNote(..) + , OrchardAction(..) , OrchardBundle(..) , SaplingBundle(..) , Scope(..) @@ -474,6 +477,48 @@ saveWalletTrNote dbPath (zt, tn) wa = do (entityKey tn) False +-- | Find the Sapling notes that match the given spending key +findSaplingOutputs :: + T.Text -- ^ the database path + -> Int -- ^ the starting block + -> ZcashNetDB -- ^ The network + -> SaplingSpendingKeyDB -- ^ The spending key to trial decrypt + -> IO [(Entity ZcashTransaction, DecodedNote)] +findSaplingOutputs dbPath b znet sk = do + r <- + PS.runSqlite dbPath $ do + select $ do + (txs :& sOutputs) <- + from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on` + (\(txs :& sOutputs) -> + txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx) + where_ (txs ^. ZcashTransactionBlock >. val b) + pure (txs, sOutputs) + let decryptedList = + map (saplingTrialDecrypt External (getNet znet)) r <> + map (saplingTrialDecrypt Internal (getNet znet)) r + return $ map (second fromJust) $ filter (\(z, n) -> isJust n) decryptedList + where + saplingTrialDecrypt :: + Scope + -> ZcashNet + -> (Entity ZcashTransaction, Entity ShieldOutput) + -> (Entity ZcashTransaction, Maybe DecodedNote) + saplingTrialDecrypt sc n (zt, so) = (zt, decodeShOut sc n so) + decodeShOut :: Scope -> ZcashNet -> Entity ShieldOutput -> Maybe DecodedNote + decodeShOut scope n s = + decodeSaplingOutputEsk + (getSapSK sk) + (ShieldedOutput + (getHex $ shieldOutputCv $ entityVal s) + (getHex $ shieldOutputCmu $ entityVal s) + (getHex $ shieldOutputEphKey $ entityVal s) + (getHex $ shieldOutputEncCipher $ entityVal s) + (getHex $ shieldOutputOutCipher $ entityVal s) + (getHex $ shieldOutputProof $ entityVal s)) + n + scope + -- | Helper function to extract a Unified Address from the database readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress readUnifiedAddressDB = diff --git a/zcash-haskell b/zcash-haskell index 2709d42..817c52d 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 2709d422667080527ccc180e97352693a4c6c2c7 +Subproject commit 817c52dacf37b95c81c5ad8c59b6b6783e9c498d diff --git a/zenith.cabal b/zenith.cabal index f78e7ed..7a5a24e 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: zenith -version: 0.4.4.3 +version: 0.4.5.0 license: MIT license-file: LICENSE author: Rene Vergara From 9471a861c64bc72f45323957ff14e61ff8f6350f Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Tue, 9 Apr 2024 13:32:39 -0500 Subject: [PATCH 3/9] Add function to check commitment trees --- CHANGELOG.md | 1 + src/Zenith/Core.hs | 18 ++++++++++++++++++ src/Zenith/Types.hs | 24 +++++++++++++++++++++++- zcash-haskell | 2 +- 4 files changed, 43 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 20a7a48..64ce3a1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Functions to scan relevant transparent notes - Functions to scan relevant Sapling notes +- Function to query `zebrad` for commitment trees ### Changed diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 4a63066..cdfc0c5 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -32,6 +32,7 @@ import Zenith.Types , TransparentSpendingKeyDB(..) , UnifiedAddressDB(..) , ZcashNetDB(..) + , ZebraTreeInfo(..) ) -- * Zebra Node interaction @@ -57,6 +58,23 @@ checkBlockChain nodeHost nodePort = do Left e -> throwIO $ userError e Right bci -> return bci +-- | Get commitment trees from Zebra +getCommitmentTrees :: + T.Text -- ^ Host where `zebrad` is avaiable + -> Int -- ^ Port where `zebrad` is available + -> Int -- ^ Block height + -> IO ZebraTreeInfo +getCommitmentTrees nodeHost nodePort block = do + r <- + makeZebraCall + nodeHost + nodePort + "z_gettreestate" + [Data.Aeson.String $ T.pack $ show block] + case r of + Left e -> throwIO $ userError e + Right zti -> return zti + -- * Spending Keys -- | Create an Orchard Spending Key for the given wallet and account index createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 33a946b..b4447bb 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -10,7 +10,6 @@ module Zenith.Types where import Data.Aeson -import Data.Aeson.Types (prependFailure, typeMismatch) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as C @@ -80,6 +79,29 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB derivePersistField "TransparentSpendingKeyDB" -- * RPC +-- ** `zebrad` +-- | Type for modeling the tree state response +data ZebraTreeInfo = ZebraTreeInfo + { ztiHeight :: !Int + , ztiTime :: !Int + , ztiSapling :: !HexString + , ztiOrchard :: !HexString + } deriving (Eq, Show, Read) + +instance FromJSON ZebraTreeInfo where + parseJSON = + withObject "ZebraTreeInfo" $ \obj -> do + h <- obj .: "height" + t <- obj .: "time" + s <- obj .: "sapling" + o <- obj .: "orchard" + sc <- s .: "commitments" + oc <- o .: "commitments" + sf <- sc .: "finalState" + ocf <- oc .: "finalState" + pure $ ZebraTreeInfo h t sf ocf + +-- ** `zcashd` -- | Type for modelling the different address sources for `zcashd` 5.0.0 data AddressSource = LegacyRandom diff --git a/zcash-haskell b/zcash-haskell index 817c52d..ea937f8 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 817c52dacf37b95c81c5ad8c59b6b6783e9c498d +Subproject commit ea937f8e5127f64be94bde06e5f1571df8dfbbde From c6da52f594fbac5e9ed1d5457472208ace1631ed Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 17 Apr 2024 20:28:47 -0500 Subject: [PATCH 4/9] Implement source note discovery --- CHANGELOG.md | 1 + app/Main.hs | 8 +- src/Zenith/CLI.hs | 30 ++++-- src/Zenith/Core.hs | 209 +++++++++++++++++++++++++++++++++++++++--- src/Zenith/DB.hs | 183 ++++++++++++++++++++++++------------ src/Zenith/Scanner.hs | 5 +- src/Zenith/Types.hs | 7 ++ test/Spec.hs | 2 +- zcash-haskell | 2 +- 9 files changed, 363 insertions(+), 84 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 64ce3a1..1188108 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Functions to scan relevant transparent notes - Functions to scan relevant Sapling notes +- Functions to scan relevant Orchard notes - Function to query `zebrad` for commitment trees ### Changed diff --git a/app/Main.hs b/app/Main.hs index d3c271b..dc840b3 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -16,8 +16,10 @@ import System.Environment (getArgs) import System.Exit import System.IO import Text.Read (readMaybe) +import ZcashHaskell.Types import Zenith.CLI -import Zenith.Types (ZcashAddress(..), ZcashPool(..), ZcashTx(..)) +import Zenith.Core (testSync) +import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..)) import Zenith.Utils import Zenith.Zcashd @@ -204,6 +206,7 @@ main = do nodePwd <- require config "nodePwd" zebraPort <- require config "zebraPort" zebraHost <- require config "zebraHost" + let myConfig = Config dbFilePath zebraHost zebraPort if not (null args) then do case head args of @@ -217,7 +220,8 @@ main = do " ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0" } (root nodeUser nodePwd) - "cli" -> runZenithCLI zebraHost zebraPort dbFilePath + "cli" -> runZenithCLI myConfig + "sync" -> testSync myConfig _ -> printUsage else printUsage diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index c25eb69..8bd653c 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -61,12 +61,17 @@ import Lens.Micro.Mtl import Lens.Micro.TH import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) -import ZcashHaskell.Orchard (isValidUnifiedAddress) -import ZcashHaskell.Transparent (encodeTransparent) +import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) +import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Types import Zenith.Core import Zenith.DB -import Zenith.Types (PhraseDB(..), UnifiedAddressDB(..), ZcashNetDB(..)) +import Zenith.Types + ( Config(..) + , PhraseDB(..) + , UnifiedAddressDB(..) + , ZcashNetDB(..) + ) import Zenith.Utils (showAddress) data Name @@ -254,7 +259,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] titleAttr (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> - C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.4.0")) <=> + C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.5.0")) <=> C.hCenter (withAttr blinkAttr $ str "Press any key...")) else emptyWidget capCommand :: String -> String -> Widget Name @@ -280,13 +285,15 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] getUA $ walletAddressUAddress $ entityVal a) <=> B.borderWithLabel (str "Legacy Shielded") - (txtWrapWith - (WrapSettings False True NoFill FillAfterFirst) - "Pending") <=> + (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ + fromMaybe "None" $ + (getSaplingFromUA . + E.encodeUtf8 . getUA . walletAddressUAddress) + (entityVal a)) <=> B.borderWithLabel (str "Transparent") (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ - maybe "Pending" (encodeTransparent (st ^. network)) $ + maybe "None" (encodeTransparentReceiver (st ^. network)) $ t_rec =<< (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress) @@ -511,8 +518,11 @@ theApp = , M.appAttrMap = const theMap } -runZenithCLI :: T.Text -> Int -> T.Text -> IO () -runZenithCLI host port dbFilePath = do +runZenithCLI :: Config -> IO () +runZenithCLI config = do + let host = c_zebraHost config + let port = c_zebraPort config + let dbFilePath = c_dbPath config w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo) case w of Right zebra -> do diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index cdfc0c5..c89c319 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -3,29 +3,42 @@ -- | Core wallet functionality for Zenith module Zenith.Core where -import Control.Exception (throwIO) +import Control.Exception (throwIO, try) import Data.Aeson import Data.HexString (hexString) +import Data.Maybe (fromJust) import qualified Data.Text as T +import qualified Data.Text.Encoding as E import Database.Persist +import Database.Persist.Sqlite import Network.HTTP.Client import ZcashHaskell.Keys import ZcashHaskell.Orchard - ( encodeUnifiedAddress + ( decryptOrchardActionSK + , encodeUnifiedAddress , genOrchardReceiver , genOrchardSpendingKey + , getOrchardNotePosition + , getOrchardWitness + , updateOrchardCommitmentTree ) import ZcashHaskell.Sapling - ( genSaplingInternalAddress + ( decodeSaplingOutputEsk + , genSaplingInternalAddress , genSaplingPaymentAddress , genSaplingSpendingKey + , getSaplingNotePosition + , getSaplingWitness + , updateSaplingCommitmentTree ) import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver) import ZcashHaskell.Types import ZcashHaskell.Utils import Zenith.DB import Zenith.Types - ( OrchardSpendingKeyDB(..) + ( Config(..) + , HexStringDB(..) + , OrchardSpendingKeyDB(..) , PhraseDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) @@ -177,23 +190,195 @@ createWalletAddress n i zNet scope za = do (ScopeDB scope) -- * Wallet +-- | Find the Sapling notes that match the given spending key +findSaplingOutputs :: + Config -- ^ the configuration parameters + -> Int -- ^ the starting block + -> ZcashNetDB -- ^ The network + -> SaplingSpendingKeyDB -- ^ The spending key to trial decrypt + -> IO () +findSaplingOutputs config b znet sk = do + let dbPath = c_dbPath config + let zebraHost = c_zebraHost config + let zebraPort = c_zebraPort config + let zn = getNet znet + tList <- getShieldedOutputs dbPath b + trees <- getCommitmentTrees zebraHost zebraPort (b - 1) + let sT = SaplingCommitmentTree $ ztiSapling trees + decryptNotes sT zn tList + where + decryptNotes :: + SaplingCommitmentTree + -> ZcashNet + -> [(Entity ZcashTransaction, Entity ShieldOutput)] + -> IO () + decryptNotes _ _ [] = return () + decryptNotes st n ((zt, o):txs) = do + let updatedTree = + updateSaplingCommitmentTree + st + (getHex $ shieldOutputCmu $ entityVal o) + case updatedTree of + Nothing -> throwIO $ userError "Failed to update commitment tree" + Just uT -> do + let noteWitness = getSaplingWitness uT + let notePos = getSaplingNotePosition <$> noteWitness + case notePos of + Nothing -> throwIO $ userError "Failed to obtain note position" + Just nP -> do + case decodeShOut External n nP o of + Nothing -> do + case decodeShOut Internal n nP o of + Nothing -> do + decryptNotes uT n txs + Just dn1 -> do + print dn1 + wId <- saveWalletTransaction (c_dbPath config) zt + saveWalletSapNote + (c_dbPath config) + wId + nP + (fromJust noteWitness) + dn1 + decryptNotes uT n txs + Just dn0 -> do + print dn0 + wId <- saveWalletTransaction (c_dbPath config) zt + saveWalletSapNote + (c_dbPath config) + wId + nP + (fromJust noteWitness) + dn0 + decryptNotes uT n txs + decodeShOut :: + Scope + -> ZcashNet + -> Integer + -> Entity ShieldOutput + -> Maybe DecodedNote + decodeShOut scope n pos s = do + decodeSaplingOutputEsk + (getSapSK sk) + (ShieldedOutput + (getHex $ shieldOutputCv $ entityVal s) + (getHex $ shieldOutputCmu $ entityVal s) + (getHex $ shieldOutputEphKey $ entityVal s) + (getHex $ shieldOutputEncCipher $ entityVal s) + (getHex $ shieldOutputOutCipher $ entityVal s) + (getHex $ shieldOutputProof $ entityVal s)) + n + scope + pos + +-- | Get Orchard actions +findOrchardActions :: + Config -- ^ the configuration parameters + -> Int -- ^ the starting block + -> ZcashNetDB -- ^ The network + -> OrchardSpendingKeyDB -- ^ The spending key to trial decrypt + -> IO () +findOrchardActions config b znet sk = do + let dbPath = c_dbPath config + let zebraHost = c_zebraHost config + let zebraPort = c_zebraPort config + let zn = getNet znet + tList <- getOrchardActions dbPath b + trees <- getCommitmentTrees zebraHost zebraPort (b - 1) + let sT = OrchardCommitmentTree $ ztiOrchard trees + decryptNotes sT zn tList + where + decryptNotes :: + OrchardCommitmentTree + -> ZcashNet + -> [(Entity ZcashTransaction, Entity OrchAction)] + -> IO () + decryptNotes _ _ [] = return () + decryptNotes ot n ((zt, o):txs) = do + let updatedTree = + updateOrchardCommitmentTree + ot + (getHex $ orchActionCmx $ entityVal o) + case updatedTree of + Nothing -> throwIO $ userError "Failed to update commitment tree" + Just uT -> do + let noteWitness = getOrchardWitness uT + let notePos = getOrchardNotePosition <$> noteWitness + case notePos of + Nothing -> throwIO $ userError "Failed to obtain note position" + Just nP -> + case decodeOrchAction External nP o of + Nothing -> + case decodeOrchAction Internal nP o of + Nothing -> decryptNotes uT n txs + Just dn1 -> do + print dn1 + wId <- saveWalletTransaction (c_dbPath config) zt + saveWalletOrchNote + (c_dbPath config) + wId + nP + (fromJust noteWitness) + dn1 + decryptNotes uT n txs + Just dn -> do + print dn + wId <- saveWalletTransaction (c_dbPath config) zt + saveWalletOrchNote + (c_dbPath config) + wId + nP + (fromJust noteWitness) + dn + decryptNotes uT n txs + decodeOrchAction :: + Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote + decodeOrchAction scope pos o = + decryptOrchardActionSK (getOrchSK sk) scope $ + OrchardAction + (getHex $ orchActionNf $ entityVal o) + (getHex $ orchActionRk $ entityVal o) + (getHex $ orchActionCmx $ entityVal o) + (getHex $ orchActionEphKey $ entityVal o) + (getHex $ orchActionEncCipher $ entityVal o) + (getHex $ orchActionOutCipher $ entityVal o) + (getHex $ orchActionCv $ entityVal o) + (getHex $ orchActionAuth $ entityVal o) + -- | Sync the wallet with the data store syncWallet :: - T.Text -- ^ The database path + Config -- ^ configuration parameters -> Entity ZcashWallet -> IO String -syncWallet walletDb w = do +syncWallet config w = do + let walletDb = c_dbPath config accs <- getAccounts walletDb $ entityKey w addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs lastBlock <- getMaxWalletBlock walletDb - trNotes <- mapM (findTransparentNotes walletDb lastBlock . entityVal) addrs + let startBlock = + if lastBlock > 0 + then lastBlock + else zcashWalletBirthdayHeight $ entityVal w + trNotes <- mapM (findTransparentNotes walletDb startBlock . entityVal) addrs + mapM_ (saveWalletTrNote walletDb) $ concat trNotes sapNotes <- mapM - (findSaplingOutputs walletDb lastBlock (zcashWalletNetwork $ entityVal w) . + (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w) . zcashAccountSapSpendKey . entityVal) accs - print "Transparent Notes: " - print trNotes - print "Sapling notes: " - print sapNotes + orchNotes <- + mapM + (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w) . + zcashAccountOrchSpendKey . entityVal) + accs 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 diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 421cd1c..6ab4da9 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -25,6 +25,7 @@ import Data.HexString import Data.Maybe (fromJust, isJust) import qualified Data.Text as T import qualified Data.Text.Encoding as TE +import Data.Word import Database.Esqueleto.Experimental import qualified Database.Persist as P import qualified Database.Persist.Sqlite as PS @@ -41,18 +42,23 @@ import ZcashHaskell.Types ( DecodedNote(..) , OrchardAction(..) , OrchardBundle(..) + , OrchardWitness(..) , SaplingBundle(..) + , SaplingCommitmentTree(..) + , SaplingWitness(..) , Scope(..) , ShieldedOutput(..) , ShieldedSpend(..) , Transaction(..) , TransparentAddress(..) , TransparentBundle(..) + , TransparentReceiver(..) , UnifiedAddress(..) , ZcashNet ) import Zenith.Types - ( HexStringDB(..) + ( Config(..) + , HexStringDB(..) , OrchardSpendingKeyDB(..) , PhraseDB(..) , SaplingSpendingKeyDB(..) @@ -100,40 +106,43 @@ share deriving Show Eq WalletTrNote tx WalletTransactionId - addrId WalletAddressId - value Int - rawId TransparentNoteId + value Word64 spent Bool + script BS.ByteString + UniqueTNote tx script deriving Show Eq WalletSapNote tx WalletTransactionId - addrId WalletAddressId - value Int + value Word64 recipient BS.ByteString memo T.Text - rawId ShieldOutputId spent Bool nullifier HexStringDB + position Word64 + witness HexStringDB + UniqueSapNote tx nullifier deriving Show Eq WalletOrchNote tx WalletTransactionId - addrId WalletAddressId - value Int + value Word64 recipient BS.ByteString memo T.Text - rawId OrchActionId spent Bool nullifier HexStringDB + position Word64 + witness HexStringDB + UniqueOrchNote tx nullifier deriving Show Eq ZcashTransaction block Int txId HexStringDB conf Int time Int + UniqueTx block txId deriving Show Eq TransparentNote tx ZcashTransactionId - value Int + value Word64 script BS.ByteString position Int UniqueTNPos tx position @@ -425,6 +434,70 @@ getMaxWalletBlock dbPath = do Nothing -> return $ -1 Just x -> return $ walletTransactionBlock $ entityVal x +-- | Save a @WalletTransaction@ +saveWalletTransaction :: + T.Text -> Entity ZcashTransaction -> IO WalletTransactionId +saveWalletTransaction dbPath zt = do + let zT' = entityVal zt + PS.runSqlite dbPath $ do + t <- + upsert + (WalletTransaction + (zcashTransactionTxId zT') + (zcashTransactionBlock zT') + (zcashTransactionConf zT') + (zcashTransactionTime zT')) + [] + return $ entityKey t + +-- | Save a @WalletSapNote@ +saveWalletSapNote :: + T.Text -- ^ The database path + -> WalletTransactionId -- ^ The index for the transaction that contains the note + -> Integer -- ^ note position + -> SaplingWitness -- ^ the Sapling incremental witness + -> DecodedNote -- The decoded Sapling note + -> IO () +saveWalletSapNote dbPath wId pos wit dn = do + PS.runSqlite dbPath $ do + _ <- + upsert + (WalletSapNote + wId + (fromIntegral $ a_value dn) + (a_recipient dn) + (TE.decodeUtf8Lenient $ a_memo dn) + False + (HexStringDB $ a_nullifier dn) + (fromIntegral pos) + (HexStringDB $ sapWit wit)) + [] + return () + +-- | Save a @WalletOrchNote@ +saveWalletOrchNote :: + T.Text + -> WalletTransactionId + -> Integer + -> OrchardWitness + -> DecodedNote + -> IO () +saveWalletOrchNote dbPath wId pos wit dn = do + PS.runSqlite dbPath $ do + _ <- + upsert + (WalletOrchNote + wId + (fromIntegral $ a_value dn) + (a_recipient dn) + (TE.decodeUtf8Lenient $ a_memo dn) + False + (HexStringDB $ a_nullifier dn) + (fromIntegral pos) + (HexStringDB $ orchWit wit)) + [] + return () + -- | Find the Transparent Notes that match the given transparent receiver findTransparentNotes :: T.Text -- ^ The database path @@ -438,7 +511,7 @@ findTransparentNotes dbPath b t = do let s = BS.concat [ BS.pack [0x76, 0xA9, 0x14] - , (toBytes . ta_bytes) tR + , (toBytes . tr_bytes) tR , BS.pack [0x88, 0xAC] ] PS.runSqlite dbPath $ @@ -456,9 +529,8 @@ findTransparentNotes dbPath b t = do saveWalletTrNote :: T.Text -- ^ the database path -> (Entity ZcashTransaction, Entity TransparentNote) - -> WalletAddressId -> IO () -saveWalletTrNote dbPath (zt, tn) wa = do +saveWalletTrNote dbPath (zt, tn) = do let zT' = entityVal zt PS.runSqlite dbPath $ do t <- @@ -472,52 +544,49 @@ saveWalletTrNote dbPath (zt, tn) wa = do insert_ $ WalletTrNote (entityKey t) - wa (transparentNoteValue $ entityVal tn) - (entityKey tn) False + (transparentNoteScript $ entityVal tn) --- | Find the Sapling notes that match the given spending key -findSaplingOutputs :: - T.Text -- ^ the database path - -> Int -- ^ the starting block - -> ZcashNetDB -- ^ The network - -> SaplingSpendingKeyDB -- ^ The spending key to trial decrypt - -> IO [(Entity ZcashTransaction, DecodedNote)] -findSaplingOutputs dbPath b znet sk = do - r <- - PS.runSqlite dbPath $ do - select $ do - (txs :& sOutputs) <- - from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on` - (\(txs :& sOutputs) -> - txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx) - where_ (txs ^. ZcashTransactionBlock >. val b) - pure (txs, sOutputs) - let decryptedList = - map (saplingTrialDecrypt External (getNet znet)) r <> - map (saplingTrialDecrypt Internal (getNet znet)) r - return $ map (second fromJust) $ filter (\(z, n) -> isJust n) decryptedList - where - saplingTrialDecrypt :: - Scope - -> ZcashNet - -> (Entity ZcashTransaction, Entity ShieldOutput) - -> (Entity ZcashTransaction, Maybe DecodedNote) - saplingTrialDecrypt sc n (zt, so) = (zt, decodeShOut sc n so) - decodeShOut :: Scope -> ZcashNet -> Entity ShieldOutput -> Maybe DecodedNote - decodeShOut scope n s = - decodeSaplingOutputEsk - (getSapSK sk) - (ShieldedOutput - (getHex $ shieldOutputCv $ entityVal s) - (getHex $ shieldOutputCmu $ entityVal s) - (getHex $ shieldOutputEphKey $ entityVal s) - (getHex $ shieldOutputEncCipher $ entityVal s) - (getHex $ shieldOutputOutCipher $ entityVal s) - (getHex $ shieldOutputProof $ entityVal s)) - n - scope +-- | Save a Sapling note to the wallet database +saveSapNote :: T.Text -> WalletSapNote -> IO () +saveSapNote dbPath wsn = PS.runSqlite dbPath $ do insert_ wsn + +-- | Get the shielded outputs from the given blockheight forward +getShieldedOutputs :: + T.Text -- ^ database path + -> Int -- ^ block + -> IO [(Entity ZcashTransaction, Entity ShieldOutput)] +getShieldedOutputs dbPath b = + PS.runSqlite dbPath $ do + select $ do + (txs :& sOutputs) <- + from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on` + (\(txs :& sOutputs) -> + txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx) + where_ (txs ^. ZcashTransactionBlock >. val b) + orderBy + [ asc $ txs ^. ZcashTransactionId + , asc $ sOutputs ^. ShieldOutputPosition + ] + pure (txs, sOutputs) + +-- | Get the Orchard actions from the given blockheight forward +getOrchardActions :: + T.Text -- ^ database path + -> Int -- ^ block + -> IO [(Entity ZcashTransaction, Entity OrchAction)] +getOrchardActions dbPath b = + PS.runSqlite dbPath $ do + select $ do + (txs :& oActions) <- + from $ table @ZcashTransaction `innerJoin` table @OrchAction `on` + (\(txs :& oActions) -> + txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx) + where_ (txs ^. ZcashTransactionBlock >. val b) + orderBy + [asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition] + pure (txs, oActions) -- | Helper function to extract a Unified Address from the database readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs index 283387c..8d49a74 100644 --- a/src/Zenith/Scanner.hs +++ b/src/Zenith/Scanner.hs @@ -44,7 +44,10 @@ scanZebra b host port dbFilePath = do if sb > zgb_blocks bStatus || sb < 1 then throwIO $ userError "Invalid starting block for scan" else do - let bList = [sb .. (zgb_blocks bStatus)] + print $ + "Scanning from " ++ + show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus) + let bList = [(sb + 1) .. (zgb_blocks bStatus)] displayConsoleRegions $ do pg <- newProgressBar def {pgTotal = fromIntegral $ length bList} txList <- diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index b4447bb..a3227ba 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -79,6 +79,13 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB derivePersistField "TransparentSpendingKeyDB" -- * RPC +-- | Type for Configuration parameters +data Config = Config + { c_dbPath :: !T.Text + , c_zebraHost :: !T.Text + , c_zebraPort :: !Int + } deriving (Eq, Prelude.Show) + -- ** `zebrad` -- | Type for modeling the tree state response data ZebraTreeInfo = ZebraTreeInfo diff --git a/test/Spec.hs b/test/Spec.hs index 3f44006..e064dda 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -107,5 +107,5 @@ main = do case w of Nothing -> assertFailure "No wallet in DB" Just w' -> do - r <- syncWallet "zenith.db" w' + r <- syncWallet (Config "zenith.db" "localhost" 18232) w' r `shouldBe` "Done" diff --git a/zcash-haskell b/zcash-haskell index ea937f8..f39b376 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit ea937f8e5127f64be94bde06e5f1571df8dfbbde +Subproject commit f39b37638047159eefdb6fd959ef79938491be8e From 29bed14f7ca5d79fbf609b83db8e4990f421144b Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Sun, 21 Apr 2024 07:07:51 -0500 Subject: [PATCH 5/9] Implement transaction display --- src/Zenith/CLI.hs | 112 +++++++++++++++++++-- src/Zenith/Core.hs | 10 +- src/Zenith/DB.hs | 240 ++++++++++++++++++++++++++++++++++++++++++-- src/Zenith/Types.hs | 8 ++ src/Zenith/Utils.hs | 8 ++ zenith.cabal | 1 + 6 files changed, 365 insertions(+), 14 deletions(-) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 8bd653c..4190f9f 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -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 <- diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index c89c319..42bb2d9 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -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) . diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 6ab4da9..3dabce5 100644 --- a/src/Zenith/DB.hs +++ b/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 = diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index a3227ba..bde9a20 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -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 diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index 0f325ff..0f013e8 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -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 <> "..." diff --git a/zenith.cabal b/zenith.cabal index 7a5a24e..2882d53 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -64,6 +64,7 @@ library , regex-posix , scientific , text + , time , vector , vty , word-wrap From 52ac50e30cbf1360f0418baacd7267a00c30fcf3 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 24 Apr 2024 07:42:35 -0500 Subject: [PATCH 6/9] 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 From 07c1b85829b3d692ecb3dabfa30d2af2571490c0 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 24 Apr 2024 08:58:45 -0500 Subject: [PATCH 7/9] Add balance display to UI --- src/Zenith/CLI.hs | 25 ++++++++++++++++++++++--- src/Zenith/DB.hs | 31 +++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+), 3 deletions(-) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index c349f1b..ea69d75 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -121,6 +121,7 @@ data State = State , _dbPath :: !T.Text , _displayBox :: !DisplayType , _syncBlock :: !Int + , _balance :: !Integer } makeLenses ''State @@ -150,6 +151,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] "(None)" (\(_, a) -> zcashAccountName $ entityVal a) (L.listSelectedElement (st ^. accounts))))) <=> + C.hCenter + (str + ("Balance: " ++ + if st ^. network == MainNet + then displayZec (st ^. balance) + else displayTaz (st ^. balance))) <=> listAddressBox "Addresses" (st ^. addresses) <+> B.vBorder <+> (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=> @@ -608,6 +615,10 @@ runZenithCLI config = do then getUserTx dbFilePath $ entityKey $ head addrList else return [] block <- getMaxWalletBlock dbFilePath + bal <- + if not (null accList) + then getBalance dbFilePath $ entityKey $ head accList + else return 0 void $ M.defaultMain theApp $ State @@ -629,6 +640,7 @@ runZenithCLI config = do dbFilePath MsgDisplay block + bal Left e -> do print $ "No Zebra node available on port " <> @@ -650,6 +662,10 @@ refreshWallet s = do if not (null aL) then getAddresses (s ^. dbPath) $ entityKey $ head aL else return [] + bal <- + if not (null aL) + then getBalance (s ^. dbPath) $ entityKey $ head aL + else return 0 txL <- if not (null addrL) then getUserTx (s ^. dbPath) $ entityKey $ head addrL @@ -658,7 +674,9 @@ refreshWallet s = do 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' & transactions .~ txL' & msg .~ + (s & accounts .~ aL') & balance .~ bal & addresses .~ addrL' & transactions .~ + txL' & + msg .~ "Switched to wallet: " ++ T.unpack (zcashWalletName $ entityVal selWallet) @@ -722,6 +740,7 @@ refreshAccount s = do Just (_j, w1) -> return w1 Just (_k, w) -> return w aL <- getAddresses (s ^. dbPath) $ entityKey selAccount + bal <- getBalance (s ^. dbPath) $ entityKey selAccount let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses) selAddress <- do case L.listSelectedElement aL' of @@ -732,13 +751,13 @@ refreshAccount s = do case selAddress of Nothing -> return $ - s & addresses .~ aL' & msg .~ "Switched to account: " ++ + s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++ T.unpack (zcashAccountName $ entityVal selAccount) Just (_i, a) -> do tList <- getUserTx (s ^. dbPath) $ entityKey a let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions) return $ - s & addresses .~ aL' & transactions .~ tL' & msg .~ + s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~ "Switched to account: " ++ T.unpack (zcashAccountName $ entityVal selAccount) diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 999a4ec..68c8745 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -1019,6 +1019,37 @@ upsertWalTx zt za = (zcashTransactionTime zt)) [] +getBalance :: T.Text -> ZcashAccountId -> IO Integer +getBalance dbPath za = do + trNotes <- + PS.runSqlite dbPath $ do + select $ do + n <- from $ table @WalletTrNote + where_ (n ^. WalletTrNoteAccId ==. val za) + where_ (n ^. WalletTrNoteSpent ==. val False) + pure n + let tAmts = map (walletTrNoteValue . entityVal) trNotes + let tBal = sum tAmts + sapNotes <- + PS.runSqlite dbPath $ do + select $ do + n1 <- from $ table @WalletSapNote + where_ (n1 ^. WalletSapNoteAccId ==. val za) + where_ (n1 ^. WalletSapNoteSpent ==. val False) + pure n1 + let sAmts = map (walletSapNoteValue . entityVal) sapNotes + let sBal = sum sAmts + orchNotes <- + PS.runSqlite dbPath $ do + select $ do + n2 <- from $ table @WalletOrchNote + where_ (n2 ^. WalletOrchNoteAccId ==. val za) + where_ (n2 ^. WalletOrchNoteSpent ==. val False) + pure n2 + let oAmts = map (walletOrchNoteValue . entityVal) orchNotes + let oBal = sum oAmts + return . fromIntegral $ tBal + sBal + oBal + clearWalletTransactions :: T.Text -> IO () clearWalletTransactions dbPath = do PS.runSqlite dbPath $ do From 53c18a833b2bc9f6bb94807be0f7c865565b4fcb Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Wed, 24 Apr 2024 09:04:56 -0500 Subject: [PATCH 8/9] Fix display of last block scanned --- src/Zenith/CLI.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index ea69d75..1b63598 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -614,7 +614,10 @@ runZenithCLI config = do if not (null addrList) then getUserTx dbFilePath $ entityKey $ head addrList else return [] - block <- getMaxWalletBlock dbFilePath + let block = + if not (null walList) + then zcashWalletLastSync $ entityVal $ head walList + else 0 bal <- if not (null accList) then getBalance dbFilePath $ entityKey $ head accList @@ -658,6 +661,7 @@ refreshWallet s = do Just (_j, w1) -> return w1 Just (_k, w) -> return w aL <- getAccounts (s ^. dbPath) $ entityKey selWallet + let bl = zcashWalletLastSync $ entityVal selWallet addrL <- if not (null aL) then getAddresses (s ^. dbPath) $ entityKey $ head aL @@ -674,7 +678,9 @@ refreshWallet s = do 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') & balance .~ bal & addresses .~ addrL' & transactions .~ + (s & accounts .~ aL') & syncBlock .~ bl & balance .~ bal & addresses .~ + addrL' & + transactions .~ txL' & msg .~ "Switched to wallet: " ++ From 900d4f9da60eff8859a4639b9e69151092c5a1e5 Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Thu, 25 Apr 2024 14:22:44 -0500 Subject: [PATCH 9/9] Balance display and transaction display --- CHANGELOG.md | 12 +++++ src/Zenith/CLI.hs | 13 ++++-- src/Zenith/DB.hs | 111 ++++++++++++++++++++++++++++------------------ test/Spec.hs | 71 ++++++++++++++++++++++++----- zcash-haskell | 2 +- zenith.cabal | 3 +- 6 files changed, 154 insertions(+), 58 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1188108..597328a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,18 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.4.6.0] + +### Added + +- Display of account balance +- Functions to identify spends +- Functions to display transactions per address + +### Changed + +- Update `zcash-haskell` + ## [0.4.5.0] ### Added diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 1b63598..7b18b9a 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -37,6 +37,7 @@ import Brick.Widgets.Core , padBottom , str , strWrap + , strWrapWith , txt , txtWrap , txtWrapWith @@ -281,7 +282,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] titleAttr (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> - C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.5.0")) <=> + C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.6.0")) <=> C.hCenter (withAttr blinkAttr $ str "Press any key...")) else emptyWidget capCommand :: String -> String -> Widget Name @@ -351,7 +352,10 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] show (posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx)))) <=> - str ("Tx ID: " ++ show (userTxHex $ entityVal tx)) <=> + (str "Tx ID: " <+> + strWrapWith + (WrapSettings False True NoFill FillAfterFirst) + (show (userTxHex $ entityVal tx))) <=> str ("Amount: " ++ if st ^. network == MainNet @@ -359,7 +363,10 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (fromIntegral $ userTxAmount $ entityVal tx) else displayTaz (fromIntegral $ userTxAmount $ entityVal tx)) <=> - txt ("Memo: " <> userTxMemo (entityVal tx)))) + (txt "Memo: " <+> + txtWrapWith + (WrapSettings False True NoFill FillAfterFirst) + (userTxMemo (entityVal tx))))) BlankDisplay -> emptyWidget mkInputForm :: DialogInput -> Form DialogInput e Name diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 68c8745..a23ae67 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -20,12 +20,11 @@ module Zenith.DB where import Control.Exception (throwIO) import Control.Monad (forM_, when) -import Control.Monad.IO.Class (MonadIO) -import Data.Bifunctor +import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.ByteString as BS import Data.HexString import Data.List (group, sort) -import Data.Maybe (fromJust, isJust) +import Data.Maybe (catMaybes, fromJust, isJust) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Word @@ -122,7 +121,7 @@ share UniqueUTx hex address deriving Show Eq WalletTrNote - tx WalletTransactionId + tx WalletTransactionId OnDeleteCascade OnUpdateCascade accId ZcashAccountId value Word64 spent Bool @@ -132,13 +131,13 @@ share UniqueTNote tx script deriving Show Eq WalletTrSpend - tx WalletTransactionId + tx WalletTransactionId OnDeleteCascade OnUpdateCascade note WalletTrNoteId accId ZcashAccountId value Word64 deriving Show Eq WalletSapNote - tx WalletTransactionId + tx WalletTransactionId OnDeleteCascade OnUpdateCascade accId ZcashAccountId value Word64 recipient BS.ByteString @@ -151,13 +150,13 @@ share UniqueSapNote tx nullifier deriving Show Eq WalletSapSpend - tx WalletTransactionId + tx WalletTransactionId OnDeleteCascade OnUpdateCascade note WalletSapNoteId accId ZcashAccountId value Word64 deriving Show Eq WalletOrchNote - tx WalletTransactionId + tx WalletTransactionId OnDeleteCascade OnUpdateCascade accId ZcashAccountId value Word64 recipient BS.ByteString @@ -170,7 +169,7 @@ share UniqueOrchNote tx nullifier deriving Show Eq WalletOrchSpend - tx WalletTransactionId + tx WalletTransactionId OnDeleteCascade OnUpdateCascade note WalletOrchNoteId accId ZcashAccountId value Word64 @@ -647,7 +646,7 @@ saveWalletTrNote dbPath ch za (zt, tn) = do saveSapNote :: T.Text -> WalletSapNote -> IO () saveSapNote dbPath wsn = PS.runSqlite dbPath $ do insert_ wsn --- | Get the shielded outputs from the given blockheight forward +-- | Get the shielded outputs from the given blockheight getShieldedOutputs :: T.Text -- ^ database path -> Int -- ^ block @@ -659,7 +658,7 @@ getShieldedOutputs dbPath b = from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on` (\(txs :& sOutputs) -> txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx) - where_ (txs ^. ZcashTransactionBlock >. val b) + where_ (txs ^. ZcashTransactionBlock >=. val b) orderBy [ asc $ txs ^. ZcashTransactionId , asc $ sOutputs ^. ShieldOutputPosition @@ -678,7 +677,7 @@ getOrchardActions dbPath b = from $ table @ZcashTransaction `innerJoin` table @OrchAction `on` (\(txs :& oActions) -> txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx) - where_ (txs ^. ZcashTransactionBlock >. val b) + where_ (txs ^. ZcashTransactionBlock >=. val b) orderBy [asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition] pure (txs, oActions) @@ -692,6 +691,8 @@ getWalletTransactions dbPath w = do let w' = entityVal w chgAddr <- getInternalAddresses dbPath $ walletAddressAccId $ entityVal w let ctReceiver = t_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr) + let csReceiver = s_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr) + let coReceiver = o_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr) let tReceiver = t_rec =<< readUnifiedAddressDB w' let sReceiver = s_rec =<< readUnifiedAddressDB w' let oReceiver = o_rec =<< readUnifiedAddressDB w' @@ -730,7 +731,8 @@ getWalletTransactions dbPath w = do select $ do trSpends <- from $ table @WalletTrSpend where_ - (trSpends ^. WalletTrSpendNote `in_` valList (map entityKey trNotes)) + (trSpends ^. WalletTrSpendNote `in_` + valList (map entityKey (trNotes <> trChgNotes))) pure trSpends sapNotes <- case sReceiver of @@ -741,14 +743,16 @@ 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 + sapChgNotes <- + case csReceiver of + Nothing -> return [] + Just sR -> do + PS.runSqlite dbPath $ do + select $ do + snotes <- from $ table @WalletSapNote + where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR)) + pure snotes + sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes) orchNotes <- case oReceiver of Nothing -> return [] @@ -758,22 +762,40 @@ getWalletTransactions dbPath w = do onotes <- from $ table @WalletOrchNote where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR)) pure onotes - orchSpends <- - PS.runSqlite dbPath $ do - select $ do - orchSpends <- from $ table @WalletOrchSpend - where_ - (orchSpends ^. WalletOrchSpendNote `in_` - valList (map entityKey orchNotes)) - pure orchSpends + orchChgNotes <- + case coReceiver of + Nothing -> return [] + Just oR -> do + PS.runSqlite dbPath $ do + select $ do + onotes <- from $ table @WalletOrchNote + where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR)) + pure onotes + orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes) mapM_ addTr trNotes mapM_ addTr trChgNotes mapM_ addSap sapNotes + mapM_ addSap sapChgNotes mapM_ addOrch orchNotes + mapM_ addOrch orchChgNotes mapM_ subTSpend trSpends - mapM_ subSSpend sapSpends - mapM_ subOSpend orchSpends + mapM_ subSSpend $ catMaybes sapSpends + mapM_ subOSpend $ catMaybes orchSpends where + getSapSpends :: WalletSapNoteId -> IO (Maybe (Entity WalletSapSpend)) + getSapSpends n = do + PS.runSqlite dbPath $ do + selectOne $ do + sapSpends <- from $ table @WalletSapSpend + where_ (sapSpends ^. WalletSapSpendNote ==. val n) + pure sapSpends + getOrchSpends :: WalletOrchNoteId -> IO (Maybe (Entity WalletOrchSpend)) + getOrchSpends n = do + PS.runSqlite dbPath $ do + selectOne $ do + orchSpends <- from $ table @WalletOrchSpend + where_ (orchSpends ^. WalletOrchSpendNote ==. val n) + pure orchSpends addTr :: Entity WalletTrNote -> IO () addTr n = upsertUserTx @@ -850,14 +872,14 @@ getWalletTransactions dbPath w = do 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))) - [] + update $ \t -> do + set + t + [ UserTxAmount +=. val amt + , UserTxMemo =. + val (memo <> " " <> userTxMemo (entityVal uTx)) + ] + where_ (t ^. UserTxId ==. val (entityKey uTx)) return () getUserTx :: T.Text -> WalletAddressId -> IO [Entity UserTx] @@ -1053,18 +1075,18 @@ getBalance dbPath za = do 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 + _ <- from $ table @WalletOrchNote return () delete $ do _ <- from $ table @WalletSapSpend return () + delete $ do + _ <- from $ table @WalletSapNote + return () delete $ do _ <- from $ table @WalletTrNote return () @@ -1074,6 +1096,9 @@ clearWalletTransactions dbPath = do delete $ do _ <- from $ table @WalletTransaction return () + delete $ do + _ <- from $ table @UserTx + return () -- | Helper function to extract a Unified Address from the database readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress diff --git a/test/Spec.hs b/test/Spec.hs index e064dda..af1f21f 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,17 +1,27 @@ {-# LANGUAGE OverloadedStrings #-} import Control.Monad (when) +import Data.HexString import Database.Persist import Database.Persist.Sqlite import System.Directory import Test.HUnit import Test.Hspec import ZcashHaskell.Orchard (isValidUnifiedAddress) +import ZcashHaskell.Sapling + ( decodeSaplingOutputEsk + , getSaplingNotePosition + , getSaplingWitness + , updateSaplingCommitmentTree + ) import ZcashHaskell.Types - ( OrchardSpendingKey(..) + ( DecodedNote(..) + , OrchardSpendingKey(..) , Phrase(..) + , SaplingCommitmentTree(..) , SaplingSpendingKey(..) , Scope(..) + , ShieldedOutput(..) , ZcashNet(..) ) import Zenith.Core @@ -39,6 +49,7 @@ main = do Phrase "one two three four five six seven eight nine ten eleven twelve") 2000000 + 0 fromSqlKey s `shouldBe` 1 it "read wallet record" $ do s <- @@ -70,6 +81,7 @@ main = do Phrase "cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest") 2200000 + 0 zw `shouldNotBe` Nothing it "Save Account:" $ do s <- @@ -100,12 +112,51 @@ main = do "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x" isValidUnifiedAddress ua `shouldNotBe` Nothing describe "Function tests" $ do - it "Wallet sync" $ do - w <- - runSqlite "zenith.db" $ - selectFirst [ZcashWalletBirthdayHeight >. 0] [] - case w of - Nothing -> assertFailure "No wallet in DB" - Just w' -> do - r <- syncWallet (Config "zenith.db" "localhost" 18232) w' - r `shouldBe` "Done" + describe "Sapling Decoding" $ do + let sk = + SaplingSpendingKey + "\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB" + let tree = + SaplingCommitmentTree $ + hexString + "01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39" + let nextTree = + SaplingCommitmentTree $ + hexString + "01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39" + it "Sapling is decoded correctly" $ do + so <- + runSqlite "zenith.db" $ + selectList [ShieldOutputTx ==. toSqlKey 38318] [] + let cmus = map (getHex . shieldOutputCmu . entityVal) so + let pos = + getSaplingNotePosition <$> + (getSaplingWitness =<< + updateSaplingCommitmentTree tree (head cmus)) + let pos1 = getSaplingNotePosition <$> getSaplingWitness tree + let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree + case pos of + Nothing -> assertFailure "couldn't get note position" + Just p -> do + print p + print pos1 + print pos2 + let dn = + decodeSaplingOutputEsk + sk + (ShieldedOutput + (getHex $ shieldOutputCv $ entityVal $ head so) + (getHex $ shieldOutputCmu $ entityVal $ head so) + (getHex $ shieldOutputEphKey $ entityVal $ head so) + (getHex $ shieldOutputEncCipher $ entityVal $ head so) + (getHex $ shieldOutputOutCipher $ entityVal $ head so) + (getHex $ shieldOutputProof $ entityVal $ head so)) + TestNet + External + p + case dn of + Nothing -> assertFailure "couldn't decode Sap output" + Just d -> + a_nullifier d `shouldBe` + hexString + "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3" diff --git a/zcash-haskell b/zcash-haskell index f39b376..00400c4 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit f39b37638047159eefdb6fd959ef79938491be8e +Subproject commit 00400c433dd8a584ef19af58fcab7fdd108d4110 diff --git a/zenith.cabal b/zenith.cabal index 2882d53..1b0ea04 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: zenith -version: 0.4.5.0 +version: 0.4.6.0 license: MIT license-file: LICENSE author: Rene Vergara @@ -121,6 +121,7 @@ test-suite zenith-tests , persistent , persistent-sqlite , hspec + , hexstring , HUnit , directory , zcash-haskell