{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeApplications #-} module Zenith.DB where 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 import Data.Word 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 ( OutPoint(..) , TxIn(..) , TxOut(..) , txHashToHex ) import ZcashHaskell.Orchard (isValidUnifiedAddress) import ZcashHaskell.Sapling (decodeSaplingOutputEsk) 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(..) , HexStringDB(..) , OrchardSpendingKeyDB(..) , PhraseDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) , TransparentSpendingKeyDB , UnifiedAddressDB(..) , ZcashNetDB(..) ) share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| ZcashWallet name T.Text network ZcashNetDB seedPhrase PhraseDB birthdayHeight Int lastSync Int default=0 UniqueWallet name network deriving Show Eq ZcashAccount index Int walletId ZcashWalletId name T.Text orchSpendKey OrchardSpendingKeyDB sapSpendKey SaplingSpendingKeyDB tPrivateKey TransparentSpendingKeyDB UniqueAccount index walletId UniqueAccName walletId name deriving Show Eq WalletAddress index Int accId ZcashAccountId name T.Text uAddress UnifiedAddressDB scope ScopeDB UniqueAddress index scope accId UniqueAddName accId name deriving Show Eq WalletTransaction txId HexStringDB accId ZcashAccountId block Int conf Int time Int 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 spent Bool nullifier HexStringDB position Word64 witness HexStringDB change Bool UniqueSapNote tx nullifier deriving Show Eq 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 spent Bool nullifier HexStringDB position Word64 witness HexStringDB change Bool UniqueOrchNote tx nullifier deriving Show Eq WalletOrchSpend tx WalletTransactionId note WalletOrchNoteId accId ZcashAccountId value Word64 deriving Show Eq ZcashTransaction block Int txId HexStringDB conf Int time Int UniqueTx block txId deriving Show Eq TransparentNote tx ZcashTransactionId value Word64 script BS.ByteString position Int UniqueTNPos tx position deriving Show Eq TransparentSpend tx ZcashTransactionId outPointHash HexStringDB outPointIndex Word64 script BS.ByteString seq Word64 position Int UniqueTSPos tx position deriving Show Eq OrchAction tx ZcashTransactionId nf HexStringDB rk HexStringDB cmx HexStringDB ephKey HexStringDB encCipher HexStringDB outCipher HexStringDB cv HexStringDB auth HexStringDB position Int UniqueOAPos tx position deriving Show Eq ShieldOutput tx ZcashTransactionId cv HexStringDB cmu HexStringDB ephKey HexStringDB encCipher HexStringDB outCipher HexStringDB proof HexStringDB position Int UniqueSOPos tx position deriving Show Eq ShieldSpend tx ZcashTransactionId cv HexStringDB anchor HexStringDB nullifier HexStringDB rk HexStringDB proof HexStringDB authSig HexStringDB position Int UniqueSSPos tx position deriving Show Eq |] -- * Database functions -- | Initializes the database initDb :: T.Text -- ^ The database path to check -> IO () 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 = 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 = 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 -> ZcashWalletId -- ^ The wallet ID to check -> IO [Entity ZcashAccount] 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 :: T.Text -- ^ The database path -> ZcashWalletId -- ^ The wallet ID to check -> IO Int getMaxAccount dbFp w = do a <- 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 -- | Save a new account to the database saveAccount :: T.Text -- ^ The database path -> ZcashAccount -- ^ The account to add to the database -> IO (Maybe (Entity ZcashAccount)) saveAccount dbFp a = PS.runSqlite dbFp $ insertUniqueEntity a -- | Returns the largest block in storage getMaxBlock :: T.Text -- ^ The database path -> IO Int getMaxBlock dbPath = do b <- 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 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 = 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 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 -> 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 :: T.Text -- ^ The database path -> ZcashAccountId -- ^ The account ID to check -> Scope -- ^ The scope of the address -> IO Int getMaxAddress dbFp aw s = do a <- 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 -- | Save a new address to the database saveAddress :: T.Text -- ^ the database path -> WalletAddress -- ^ The wallet to add to the database -> IO (Maybe (Entity WalletAddress)) saveAddress dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w -- | Save a transaction to the data model saveTransaction :: T.Text -- ^ the database path -> Int -- ^ block time -> Transaction -- ^ The transaction to save -> IO (Key ZcashTransaction) saveTransaction dbFp t wt = 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) $ 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_ $ zipWith (curry (storeSapSpend w)) ix $ (sbSpends . fromJust . tx_saplingBundle) wt _ <- insertMany_ $ zipWith (curry (storeSapOutput w)) ix $ (sbOutputs . fromJust . tx_saplingBundle) wt return () when (isJust $ tx_orchardBundle wt) $ insertMany_ $ zipWith (curry (storeOrchAction w)) ix $ (obActions . fromJust . tx_orchardBundle) wt return w where 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) (HexStringDB $ sp_anchor sp) (HexStringDB $ sp_nullifier sp) (HexStringDB $ sp_rk sp) (HexStringDB $ sp_proof sp) (HexStringDB $ sp_auth sp) i storeSapOutput :: ZcashTransactionId -> (Int, ShieldedOutput) -> ShieldOutput storeSapOutput wid (i, so) = ShieldOutput wid (HexStringDB $ s_cv so) (HexStringDB $ s_cmu so) (HexStringDB $ s_ephKey so) (HexStringDB $ s_encCipherText so) (HexStringDB $ s_outCipherText so) (HexStringDB $ s_proof so) i storeOrchAction :: ZcashTransactionId -> (Int, OrchardAction) -> OrchAction storeOrchAction wid (i, oa) = OrchAction wid (HexStringDB $ nf oa) (HexStringDB $ rk oa) (HexStringDB $ cmx oa) (HexStringDB $ eph_key oa) (HexStringDB $ enc_ciphertext oa) (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 -- | Save a @WalletTransaction@ saveWalletTransaction :: 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')) [] 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 -> Bool -- ^ change flag -> ZcashAccountId -> DecodedNote -- The decoded Sapling note -> IO () 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) False (HexStringDB $ a_nullifier dn) (fromIntegral pos) (HexStringDB $ sapWit wit) ch) [] return () -- | Save a @WalletOrchNote@ saveWalletOrchNote :: T.Text -> WalletTransactionId -> Integer -> OrchardWitness -> Bool -> ZcashAccountId -> DecodedNote -> IO () 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) False (HexStringDB $ a_nullifier dn) (fromIntegral pos) (HexStringDB $ orchWit wit) ch) [] return () -- | Find the Transparent Notes that match the given transparent receiver findTransparentNotes :: T.Text -- ^ The database path -> Int -- ^ Starting block -> Entity WalletAddress -> IO () findTransparentNotes dbPath b t = do let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t) case tReceiver of Just tR -> do let s = BS.concat [ BS.pack [0x76, 0xA9, 0x14] , (toBytes . tr_bytes) tR , BS.pack [0x88, 0xAC] ] tN <- 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) 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 za (zt, tn) = do let zT' = entityVal zt PS.runSqlite dbPath $ do t <- upsert (WalletTransaction (zcashTransactionTxId zT') za (zcashTransactionBlock zT') (zcashTransactionConf zT') (zcashTransactionTime zT')) [] 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 () 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) -- | Get the transactions belonging to the given address getWalletTransactions :: T.Text -- ^ database path -> Entity WalletAddress -> IO () getWalletTransactions dbPath w = do 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 [] 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 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 [] Just sR -> do PS.runSqlite dbPath $ do select $ 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 [] Just oR -> do PS.runSqlite dbPath $ do select $ 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 mapM_ addTr trNotes mapM_ addTr trChgNotes mapM_ addSap sapNotes mapM_ addOrch orchNotes mapM_ subTSpend trSpends mapM_ subSSpend sapSpends mapM_ subOSpend orchSpends where 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 existingUtx <- PS.runSqlite dbPath $ do 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 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 -> ZcashAccountId -> [Entity WalletSapNote] -> IO () findSapSpends _ _ [] = return () findSapSpends dbPath za (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 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) za insert_ $ WalletSapSpend (entityKey t') (entityKey n) za (walletSapNoteValue $ entityVal n) findSapSpends dbPath za notes 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 za (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 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) za insert_ $ WalletOrchSpend (entityKey t') (entityKey n) za (walletOrchNoteValue $ entityVal n) findOrchSpends dbPath za notes upsertWalTx :: 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