From 5ce822e52f9bf2f32193db6815eb258b1ca4fe2d Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Sun, 7 Apr 2024 09:25:25 -0500 Subject: [PATCH] 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