zenith/src/Zenith/DB.hs

1489 lines
45 KiB
Haskell
Raw Normal View History

2024-01-22 18:58:37 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DerivingStrategies #-}
2024-03-01 20:57:13 +00:00
{-# LANGUAGE DeriveAnyClass #-}
2024-01-22 18:58:37 +00:00
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
2024-01-23 15:55:24 +00:00
{-# LANGUAGE TypeOperators #-}
2024-04-07 14:25:25 +00:00
{-# LANGUAGE TypeApplications #-}
2024-01-22 18:58:37 +00:00
2024-01-17 18:15:21 +00:00
module Zenith.DB where
2024-01-22 18:58:37 +00:00
2024-04-24 12:42:35 +00:00
import Control.Exception (throwIO)
import Control.Monad (forM_, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
2024-05-05 14:49:55 +00:00
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
2024-05-03 12:10:08 +00:00
import Data.Bifunctor (bimap)
2024-01-22 18:58:37 +00:00
import qualified Data.ByteString as BS
import Data.HexString
2024-04-24 12:42:35 +00:00
import Data.List (group, sort)
import Data.Maybe (catMaybes, fromJust, isJust)
2024-05-03 12:10:08 +00:00
import Data.Pool (Pool)
2024-01-22 18:58:37 +00:00
import qualified Data.Text as T
2024-04-07 14:25:25 +00:00
import qualified Data.Text.Encoding as TE
2024-04-18 01:28:47 +00:00
import Data.Word
2024-04-07 14:25:25 +00:00
import Database.Esqueleto.Experimental
import qualified Database.Persist as P
import qualified Database.Persist.Sqlite as PS
2024-01-22 18:58:37 +00:00
import Database.Persist.TH
2024-04-07 14:25:25 +00:00
import Haskoin.Transaction.Common
( OutPoint(..)
, TxIn(..)
, TxOut(..)
, txHashToHex
)
2024-05-05 14:49:55 +00:00
import qualified Lens.Micro as ML ((&), (.~), (^.))
2024-04-07 14:25:25 +00:00
import ZcashHaskell.Orchard (isValidUnifiedAddress)
2024-04-08 20:51:14 +00:00
import ZcashHaskell.Sapling (decodeSaplingOutputEsk)
2024-04-03 20:14:14 +00:00
import ZcashHaskell.Types
2024-04-08 20:51:14 +00:00
( DecodedNote(..)
, OrchardAction(..)
2024-04-03 20:14:14 +00:00
, OrchardBundle(..)
2024-04-21 12:07:51 +00:00
, OrchardSpendingKey(..)
2024-04-18 01:28:47 +00:00
, OrchardWitness(..)
2024-04-03 20:14:14 +00:00
, SaplingBundle(..)
2024-04-18 01:28:47 +00:00
, SaplingCommitmentTree(..)
2024-04-21 12:07:51 +00:00
, SaplingSpendingKey(..)
2024-04-18 01:28:47 +00:00
, SaplingWitness(..)
2024-04-03 20:14:14 +00:00
, Scope(..)
, ShieldedOutput(..)
, ShieldedSpend(..)
2024-04-21 12:07:51 +00:00
, ToBytes(..)
2024-04-03 20:14:14 +00:00
, Transaction(..)
2024-04-07 14:25:25 +00:00
, TransparentAddress(..)
2024-04-03 20:14:14 +00:00
, TransparentBundle(..)
2024-04-18 01:28:47 +00:00
, TransparentReceiver(..)
2024-04-07 14:25:25 +00:00
, UnifiedAddress(..)
2024-04-03 20:14:14 +00:00
, ZcashNet
2024-04-21 12:07:51 +00:00
, decodeHexText
2024-04-03 20:14:14 +00:00
)
2024-03-17 12:17:52 +00:00
import Zenith.Types
2024-04-18 01:28:47 +00:00
( Config(..)
, HexStringDB(..)
, OrchardSpendingKeyDB(..)
2024-03-17 12:17:52 +00:00
, PhraseDB(..)
2024-05-03 12:10:08 +00:00
, RseedDB(..)
2024-03-17 12:17:52 +00:00
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB
, UnifiedAddressDB(..)
, ZcashNetDB(..)
)
2024-03-05 18:34:30 +00:00
2024-01-22 18:58:37 +00:00
share
[mkPersist sqlSettings, mkMigrate "migrateAll"]
[persistLowerCase|
ZcashWallet
name T.Text
2024-03-17 12:17:52 +00:00
network ZcashNetDB
seedPhrase PhraseDB
2024-03-01 20:57:13 +00:00
birthdayHeight Int
2024-04-24 12:42:35 +00:00
lastSync Int default=0
UniqueWallet name network
2024-03-01 20:57:13 +00:00
deriving Show Eq
ZcashAccount
index Int
2024-03-01 20:57:13 +00:00
walletId ZcashWalletId
name T.Text
2024-03-17 12:17:52 +00:00
orchSpendKey OrchardSpendingKeyDB
sapSpendKey SaplingSpendingKeyDB
tPrivateKey TransparentSpendingKeyDB
2024-03-01 20:57:13 +00:00
UniqueAccount index walletId
2024-03-05 18:34:30 +00:00
UniqueAccName walletId name
2024-03-01 20:57:13 +00:00
deriving Show Eq
WalletAddress
index Int
2024-03-05 18:34:30 +00:00
accId ZcashAccountId
name T.Text
2024-03-17 12:17:52 +00:00
uAddress UnifiedAddressDB
scope ScopeDB
UniqueAddress index scope accId
2024-03-05 18:34:30 +00:00
UniqueAddName accId name
2024-03-01 20:57:13 +00:00
deriving Show Eq
WalletTransaction
2024-04-04 18:21:55 +00:00
txId HexStringDB
2024-04-24 12:42:35 +00:00
accId ZcashAccountId
2024-04-04 19:35:08 +00:00
block Int
2024-04-04 18:21:55 +00:00
conf Int
time Int
2024-04-24 12:42:35 +00:00
UniqueWTx txId accId
deriving Show Eq
UserTx
hex HexStringDB
2024-05-09 15:44:07 +00:00
address WalletAddressId OnDeleteCascade OnUpdateCascade
2024-04-24 12:42:35 +00:00
time Int
amount Int
memo T.Text
UniqueUTx hex address
2024-04-04 18:21:55 +00:00
deriving Show Eq
WalletTrNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
2024-05-09 15:44:07 +00:00
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
address WalletAddressId OnDeleteCascade OnUpdateCascade
2024-04-18 01:28:47 +00:00
value Word64
2024-04-04 18:21:55 +00:00
spent Bool
2024-04-18 01:28:47 +00:00
script BS.ByteString
2024-04-21 12:07:51 +00:00
change Bool
2024-04-24 12:42:35 +00:00
position Word64
2024-04-18 01:28:47 +00:00
UniqueTNote tx script
2024-04-04 18:21:55 +00:00
deriving Show Eq
2024-04-21 12:07:51 +00:00
WalletTrSpend
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
2024-05-09 15:44:07 +00:00
note WalletTrNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
2024-04-21 12:07:51 +00:00
value Word64
2024-05-09 15:44:07 +00:00
UniqueTrSpend tx accId
2024-04-21 12:07:51 +00:00
deriving Show Eq
2024-04-04 18:21:55 +00:00
WalletSapNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
2024-05-09 15:44:07 +00:00
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
2024-04-18 01:28:47 +00:00
value Word64
2024-04-04 18:21:55 +00:00
recipient BS.ByteString
memo T.Text
spent Bool
2024-04-07 14:25:25 +00:00
nullifier HexStringDB
2024-04-18 01:28:47 +00:00
position Word64
witness HexStringDB
2024-04-21 12:07:51 +00:00
change Bool
2024-05-03 12:10:08 +00:00
witPos ShieldOutputId OnDeleteIgnore OnUpdateIgnore
rseed RseedDB
2024-04-18 01:28:47 +00:00
UniqueSapNote tx nullifier
2024-04-04 18:21:55 +00:00
deriving Show Eq
2024-04-21 12:07:51 +00:00
WalletSapSpend
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
2024-05-09 15:44:07 +00:00
note WalletSapNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
2024-04-21 12:07:51 +00:00
value Word64
2024-05-09 15:44:07 +00:00
UniqueSapSepnd tx accId
2024-04-21 12:07:51 +00:00
deriving Show Eq
2024-04-04 18:21:55 +00:00
WalletOrchNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
2024-05-09 15:44:07 +00:00
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
2024-04-18 01:28:47 +00:00
value Word64
2024-04-04 18:21:55 +00:00
recipient BS.ByteString
memo T.Text
spent Bool
2024-04-07 14:25:25 +00:00
nullifier HexStringDB
2024-04-18 01:28:47 +00:00
position Word64
witness HexStringDB
2024-04-21 12:07:51 +00:00
change Bool
2024-05-03 12:10:08 +00:00
witPos OrchActionId OnDeleteIgnore OnUpdateIgnore
rho BS.ByteString
rseed RseedDB
2024-04-18 01:28:47 +00:00
UniqueOrchNote tx nullifier
2024-04-04 18:21:55 +00:00
deriving Show Eq
2024-04-21 12:07:51 +00:00
WalletOrchSpend
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
2024-05-09 15:44:07 +00:00
note WalletOrchNoteId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId OnDeleteCascade OnUpdateCascade
2024-04-21 12:07:51 +00:00
value Word64
2024-05-09 15:44:07 +00:00
UniqueOrchSpend tx accId
2024-04-21 12:07:51 +00:00
deriving Show Eq
2024-04-04 18:21:55 +00:00
ZcashTransaction
block Int
txId HexStringDB
conf Int
time Int
2024-04-18 01:28:47 +00:00
UniqueTx block txId
deriving Show Eq
2024-04-03 20:14:14 +00:00
TransparentNote
2024-04-04 18:21:55 +00:00
tx ZcashTransactionId
2024-04-18 01:28:47 +00:00
value Word64
2024-04-03 20:14:14 +00:00
script BS.ByteString
2024-04-07 14:25:25 +00:00
position Int
UniqueTNPos tx position
deriving Show Eq
TransparentSpend
tx ZcashTransactionId
outPointHash HexStringDB
2024-04-24 12:42:35 +00:00
outPointIndex Word64
2024-04-07 14:25:25 +00:00
script BS.ByteString
2024-04-24 12:42:35 +00:00
seq Word64
2024-04-07 14:25:25 +00:00
position Int
UniqueTSPos tx position
deriving Show Eq
OrchAction
2024-04-04 18:21:55 +00:00
tx ZcashTransactionId
nf HexStringDB
rk HexStringDB
cmx HexStringDB
ephKey HexStringDB
encCipher HexStringDB
outCipher HexStringDB
cv HexStringDB
auth HexStringDB
2024-04-07 14:25:25 +00:00
position Int
UniqueOAPos tx position
deriving Show Eq
ShieldOutput
2024-04-04 18:21:55 +00:00
tx ZcashTransactionId
cv HexStringDB
cmu HexStringDB
ephKey HexStringDB
encCipher HexStringDB
outCipher HexStringDB
proof HexStringDB
2024-04-07 14:25:25 +00:00
position Int
UniqueSOPos tx position
deriving Show Eq
ShieldSpend
2024-04-04 18:21:55 +00:00
tx ZcashTransactionId
cv HexStringDB
anchor HexStringDB
nullifier HexStringDB
rk HexStringDB
proof HexStringDB
authSig HexStringDB
2024-04-07 14:25:25 +00:00
position Int
UniqueSSPos tx position
deriving Show Eq
AddressBook
network ZcashNetDB
descrip T.Text
address HexStringDB
UniqueABA address
deriving Show Eq
|]
2024-03-05 18:34:30 +00:00
-- * Database functions
-- | Initializes the database
initDb ::
T.Text -- ^ The database path to check
-> IO ()
initDb dbName = do
2024-04-07 14:25:25 +00:00
PS.runSqlite dbName $ do runMigration migrateAll
2024-03-05 18:34:30 +00:00
2024-05-05 14:49:55 +00:00
initPool :: T.Text -> NoLoggingT IO ConnectionPool
initPool dbPath = do
let dbInfo = PS.mkSqliteConnectionInfo dbPath
PS.createSqlitePoolFromInfo dbInfo 5
2024-04-24 12:42:35 +00:00
-- | Upgrade the database
upgradeDb ::
T.Text -- ^ database path
-> IO ()
upgradeDb dbName = do
PS.runSqlite dbName $ do runMigrationUnsafe migrateAll
2024-03-05 18:34:30 +00:00
-- | Get existing wallets from database
2024-05-05 14:49:55 +00:00
getWallets :: ConnectionPool -> ZcashNet -> IO [Entity ZcashWallet]
getWallets pool n =
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
wallets <- from $ table @ZcashWallet
where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n))
pure wallets
2024-03-05 18:34:30 +00:00
-- | Save a new wallet to the database
saveWallet ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path to use
2024-03-05 18:34:30 +00:00
-> ZcashWallet -- ^ The wallet to add to the database
-> IO (Maybe (Entity ZcashWallet))
2024-05-05 14:49:55 +00:00
saveWallet pool w =
runNoLoggingT $
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
2024-03-05 18:34:30 +00:00
2024-04-24 12:42:35 +00:00
-- | Update the last sync block for the wallet
2024-05-05 14:49:55 +00:00
updateWalletSync :: ConnectionPool -> Int -> ZcashWalletId -> IO ()
updateWalletSync pool b i = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
update $ \w -> do
set w [ZcashWalletLastSync =. val b]
where_ $ w ^. ZcashWalletId ==. val i
2024-04-24 12:42:35 +00:00
2024-03-05 18:34:30 +00:00
-- | Returns a list of accounts associated with the given wallet
getAccounts ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-03-05 18:34:30 +00:00
-> ZcashWalletId -- ^ The wallet ID to check
2024-05-05 14:49:55 +00:00
-> NoLoggingT IO [Entity ZcashAccount]
getAccounts pool w =
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
2024-05-03 12:10:08 +00:00
accs <- from $ table @ZcashAccount
2024-05-05 14:49:55 +00:00
where_ (accs ^. ZcashAccountWalletId ==. val w)
2024-05-03 12:10:08 +00:00
pure accs
2024-05-05 14:49:55 +00:00
getAccountById ::
ConnectionPool -> ZcashAccountId -> IO (Maybe (Entity ZcashAccount))
getAccountById pool za = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
accs <- from $ table @ZcashAccount
where_ (accs ^. ZcashAccountId ==. val za)
pure accs
2024-03-05 18:34:30 +00:00
-- | Returns the largest account index for the given wallet
getMaxAccount ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-03-05 18:34:30 +00:00
-> ZcashWalletId -- ^ The wallet ID to check
-> IO Int
2024-05-05 14:49:55 +00:00
getMaxAccount pool w = do
2024-03-05 18:34:30 +00:00
a <-
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
accs <- from $ table @ZcashAccount
where_ (accs ^. ZcashAccountWalletId ==. val w)
orderBy [desc $ accs ^. ZcashAccountIndex]
pure accs
2024-03-05 18:34:30 +00:00
case a of
Nothing -> return $ -1
Just x -> return $ zcashAccountIndex $ entityVal x
-- | Save a new account to the database
saveAccount ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-03-05 18:34:30 +00:00
-> ZcashAccount -- ^ The account to add to the database
-> IO (Maybe (Entity ZcashAccount))
2024-05-05 14:49:55 +00:00
saveAccount pool a =
runNoLoggingT $
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity a
2024-03-05 18:34:30 +00:00
2024-04-04 18:21:55 +00:00
-- | Returns the largest block in storage
getMaxBlock ::
2024-05-05 14:49:55 +00:00
Pool SqlBackend -- ^ The database pool
-> NoLoggingT IO Int
getMaxBlock pool = do
2024-04-04 18:21:55 +00:00
b <-
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
txs <- from $ table @ZcashTransaction
where_ (txs ^. ZcashTransactionBlock >. val 0)
orderBy [desc $ txs ^. ZcashTransactionBlock]
pure txs
2024-04-04 18:21:55 +00:00
case b of
Nothing -> return $ -1
Just x -> return $ zcashTransactionBlock $ entityVal x
2024-03-05 18:34:30 +00:00
-- | Returns a list of addresses associated with the given account
getAddresses ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-03-05 18:34:30 +00:00
-> ZcashAccountId -- ^ The account ID to check
2024-05-05 14:49:55 +00:00
-> NoLoggingT IO [Entity WalletAddress]
getAddresses pool a =
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
addrs <- from $ table @WalletAddress
where_ (addrs ^. WalletAddressAccId ==. val a)
where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External))
pure addrs
2024-04-07 14:25:25 +00:00
2024-05-05 14:49:55 +00:00
getAddressById ::
ConnectionPool -> WalletAddressId -> IO (Maybe (Entity WalletAddress))
getAddressById pool a = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
addr <- from $ table @WalletAddress
where_ (addr ^. WalletAddressId ==. val a)
pure addr
2024-05-03 12:10:08 +00:00
2024-04-21 12:07:51 +00:00
-- | Returns a list of change addresses associated with the given account
getInternalAddresses ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-04-21 12:07:51 +00:00
-> ZcashAccountId -- ^ The account ID to check
2024-05-05 14:49:55 +00:00
-> NoLoggingT IO [Entity WalletAddress]
getInternalAddresses pool a =
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
addrs <- from $ table @WalletAddress
where_ (addrs ^. WalletAddressAccId ==. val a)
where_ (addrs ^. WalletAddressScope ==. val (ScopeDB Internal))
pure addrs
2024-04-21 12:07:51 +00:00
2024-04-07 14:25:25 +00:00
-- | Returns a list of addressess associated with the given wallet
getWalletAddresses ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-04-07 14:25:25 +00:00
-> ZcashWalletId -- ^ the wallet to search
2024-05-05 14:49:55 +00:00
-> NoLoggingT IO [Entity WalletAddress]
getWalletAddresses pool w = do
accs <- getAccounts pool w
addrs <- mapM (getAddresses pool . entityKey) accs
2024-04-07 14:25:25 +00:00
return $ concat addrs
2024-03-05 18:34:30 +00:00
-- | Returns the largest address index for the given account
getMaxAddress ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-03-17 12:17:52 +00:00
-> ZcashAccountId -- ^ The account ID to check
-> Scope -- ^ The scope of the address
2024-03-05 18:34:30 +00:00
-> IO Int
2024-05-05 14:49:55 +00:00
getMaxAddress pool aw s = do
2024-03-05 18:34:30 +00:00
a <-
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
addrs <- from $ table @WalletAddress
where_ $ addrs ^. WalletAddressAccId ==. val aw
where_ $ addrs ^. WalletAddressScope ==. val (ScopeDB s)
orderBy [desc $ addrs ^. WalletAddressIndex]
pure addrs
2024-03-05 18:34:30 +00:00
case a of
Nothing -> return $ -1
Just x -> return $ walletAddressIndex $ entityVal x
-- | Save a new address to the database
saveAddress ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ the database path
2024-03-05 18:34:30 +00:00
-> WalletAddress -- ^ The wallet to add to the database
-> IO (Maybe (Entity WalletAddress))
2024-05-05 14:49:55 +00:00
saveAddress pool w =
runNoLoggingT $
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
2024-04-03 20:14:14 +00:00
-- | Save a transaction to the data model
saveTransaction ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ the database path
2024-04-03 20:14:14 +00:00
-> Int -- ^ block time
-> Transaction -- ^ The transaction to save
2024-05-05 14:49:55 +00:00
-> NoLoggingT IO (Key ZcashTransaction)
saveTransaction pool t wt =
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-07 14:25:25 +00:00
let ix = [0 ..]
2024-04-03 20:14:14 +00:00
w <-
insert $
2024-04-04 18:21:55 +00:00
ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t
2024-04-07 14:25:25 +00:00
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 ()
2024-04-03 20:14:14 +00:00
when (isJust $ tx_saplingBundle wt) $ do
_ <-
insertMany_ $
2024-04-07 14:25:25 +00:00
zipWith (curry (storeSapSpend w)) ix $
(sbSpends . fromJust . tx_saplingBundle) wt
2024-04-03 20:14:14 +00:00
_ <-
insertMany_ $
2024-04-07 14:25:25 +00:00
zipWith (curry (storeSapOutput w)) ix $
(sbOutputs . fromJust . tx_saplingBundle) wt
2024-04-03 20:14:14 +00:00
return ()
when (isJust $ tx_orchardBundle wt) $
insertMany_ $
2024-04-07 14:25:25 +00:00
zipWith (curry (storeOrchAction w)) ix $
(obActions . fromJust . tx_orchardBundle) wt
2024-04-03 20:14:14 +00:00
return w
where
2024-04-07 14:25:25 +00:00
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) =
2024-04-03 20:14:14 +00:00
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)
2024-04-07 14:25:25 +00:00
i
storeSapOutput ::
ZcashTransactionId -> (Int, ShieldedOutput) -> ShieldOutput
storeSapOutput wid (i, so) =
2024-04-03 20:14:14 +00:00
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)
2024-04-07 14:25:25 +00:00
i
storeOrchAction :: ZcashTransactionId -> (Int, OrchardAction) -> OrchAction
storeOrchAction wid (i, oa) =
2024-04-03 20:14:14 +00:00
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)
2024-04-07 14:25:25 +00:00
i
-- | Get the transactions from a particular block forward
getZcashTransactions ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-04-07 14:25:25 +00:00
-> Int -- ^ Block
-> IO [Entity ZcashTransaction]
2024-05-05 14:49:55 +00:00
getZcashTransactions pool b =
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
txs <- from $ table @ZcashTransaction
where_ $ txs ^. ZcashTransactionBlock >. val b
orderBy [asc $ txs ^. ZcashTransactionBlock]
return txs
2024-04-07 14:25:25 +00:00
-- * Wallet
-- | Get the block of the last transaction known to the wallet
getMaxWalletBlock ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-04-07 14:25:25 +00:00
-> IO Int
2024-05-05 14:49:55 +00:00
getMaxWalletBlock pool = do
2024-04-07 14:25:25 +00:00
b <-
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
txs <- from $ table @WalletTransaction
where_ $ txs ^. WalletTransactionBlock >. val 0
orderBy [desc $ txs ^. WalletTransactionBlock]
return txs
2024-04-07 14:25:25 +00:00
case b of
Nothing -> return $ -1
Just x -> return $ walletTransactionBlock $ entityVal x
2024-05-05 14:49:55 +00:00
getMinBirthdayHeight :: ConnectionPool -> IO Int
getMinBirthdayHeight pool = do
2024-05-03 12:10:08 +00:00
b <-
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
w <- from $ table @ZcashWallet
where_ (w ^. ZcashWalletBirthdayHeight >. val 0)
orderBy [asc $ w ^. ZcashWalletBirthdayHeight]
pure w
2024-05-03 12:10:08 +00:00
case b of
Nothing -> return 0
Just x -> return $ zcashWalletBirthdayHeight $ entityVal x
2024-05-09 15:44:07 +00:00
getLastSyncBlock :: ConnectionPool -> ZcashWalletId -> IO Int
getLastSyncBlock pool zw = do
b <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
w <- from $ table @ZcashWallet
where_ (w ^. ZcashWalletId ==. val zw)
pure w
case b of
Nothing -> throwIO $ userError "Failed to retrieve wallet"
Just x -> return $ zcashWalletLastSync $ entityVal x
2024-04-18 01:28:47 +00:00
-- | Save a @WalletTransaction@
saveWalletTransaction ::
2024-05-05 14:49:55 +00:00
ConnectionPool
2024-04-24 12:42:35 +00:00
-> ZcashAccountId
-> Entity ZcashTransaction
-> IO WalletTransactionId
2024-05-05 14:49:55 +00:00
saveWalletTransaction pool za zt = do
2024-04-18 01:28:47 +00:00
let zT' = entityVal zt
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
t <-
upsert
(WalletTransaction
(zcashTransactionTxId zT')
za
(zcashTransactionBlock zT')
(zcashTransactionConf zT')
(zcashTransactionTime zT'))
[]
return $ entityKey t
2024-04-18 01:28:47 +00:00
-- | Save a @WalletSapNote@
saveWalletSapNote ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-04-18 01:28:47 +00:00
-> WalletTransactionId -- ^ The index for the transaction that contains the note
-> Integer -- ^ note position
-> SaplingWitness -- ^ the Sapling incremental witness
2024-04-21 12:07:51 +00:00
-> Bool -- ^ change flag
2024-04-24 12:42:35 +00:00
-> ZcashAccountId
2024-05-03 12:10:08 +00:00
-> ShieldOutputId
2024-04-18 01:28:47 +00:00
-> DecodedNote -- The decoded Sapling note
-> IO ()
2024-05-05 14:49:55 +00:00
saveWalletSapNote pool wId pos wit ch za zt dn = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ 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
zt
(RseedDB $ a_rseed dn))
[]
return ()
2024-04-18 01:28:47 +00:00
-- | Save a @WalletOrchNote@
saveWalletOrchNote ::
2024-05-05 14:49:55 +00:00
ConnectionPool
2024-04-18 01:28:47 +00:00
-> WalletTransactionId
-> Integer
-> OrchardWitness
2024-04-21 12:07:51 +00:00
-> Bool
2024-04-24 12:42:35 +00:00
-> ZcashAccountId
2024-05-03 12:10:08 +00:00
-> OrchActionId
2024-04-18 01:28:47 +00:00
-> DecodedNote
-> IO ()
2024-05-05 14:49:55 +00:00
saveWalletOrchNote pool wId pos wit ch za zt dn = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ 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
zt
(a_rho dn)
(RseedDB $ a_rseed dn))
[]
return ()
2024-04-18 01:28:47 +00:00
2024-04-07 14:25:25 +00:00
-- | Find the Transparent Notes that match the given transparent receiver
findTransparentNotes ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ The database path
2024-04-07 14:25:25 +00:00
-> Int -- ^ Starting block
2024-04-24 12:42:35 +00:00
-> Entity WalletAddress
-> IO ()
2024-05-05 14:49:55 +00:00
findTransparentNotes pool b t = do
2024-04-24 12:42:35 +00:00
let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t)
2024-04-07 14:25:25 +00:00
case tReceiver of
Just tR -> do
let s =
BS.concat
[ BS.pack [0x76, 0xA9, 0x14]
2024-04-18 01:28:47 +00:00
, (toBytes . tr_bytes) tR
2024-04-07 14:25:25 +00:00
, BS.pack [0x88, 0xAC]
]
2024-04-24 12:42:35 +00:00
tN <-
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
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)
2024-04-24 12:42:35 +00:00
mapM_
(saveWalletTrNote
2024-05-05 14:49:55 +00:00
pool
2024-04-24 12:42:35 +00:00
(getScope $ walletAddressScope $ entityVal t)
2024-05-03 12:10:08 +00:00
(walletAddressAccId $ entityVal t)
(entityKey t))
2024-04-24 12:42:35 +00:00
tN
Nothing -> return ()
2024-04-07 14:25:25 +00:00
-- | Add the transparent notes to the wallet
saveWalletTrNote ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ the database path
2024-04-21 12:07:51 +00:00
-> Scope
2024-04-24 12:42:35 +00:00
-> ZcashAccountId
2024-05-03 12:10:08 +00:00
-> WalletAddressId
2024-04-07 14:25:25 +00:00
-> (Entity ZcashTransaction, Entity TransparentNote)
-> IO ()
2024-05-05 14:49:55 +00:00
saveWalletTrNote pool ch za wa (zt, tn) = do
2024-04-07 14:25:25 +00:00
let zT' = entityVal zt
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
t <-
upsert
(WalletTransaction
(zcashTransactionTxId zT')
za
(zcashTransactionBlock zT')
(zcashTransactionConf zT')
(zcashTransactionTime zT'))
[]
insert_ $
WalletTrNote
(entityKey t)
za
wa
(transparentNoteValue $ entityVal tn)
False
(transparentNoteScript $ entityVal tn)
(ch == Internal)
(fromIntegral $ transparentNotePosition $ entityVal tn)
2024-04-07 14:25:25 +00:00
2024-04-18 01:28:47 +00:00
-- | Save a Sapling note to the wallet database
2024-05-05 14:49:55 +00:00
saveSapNote :: ConnectionPool -> WalletSapNote -> IO ()
saveSapNote pool wsn =
runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ insert_ wsn
2024-04-18 01:28:47 +00:00
-- | Get the shielded outputs from the given blockheight
2024-04-18 01:28:47 +00:00
getShieldedOutputs ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ database path
2024-04-18 01:28:47 +00:00
-> Int -- ^ block
-> IO [(Entity ZcashTransaction, Entity ShieldOutput)]
2024-05-05 14:49:55 +00:00
getShieldedOutputs pool b =
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-18 01:28:47 +00:00
select $ do
(txs :& sOutputs) <-
from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on`
(\(txs :& sOutputs) ->
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
where_ (txs ^. ZcashTransactionBlock >=. val b)
2024-04-18 01:28:47 +00:00
orderBy
[ asc $ txs ^. ZcashTransactionId
, asc $ sOutputs ^. ShieldOutputPosition
]
pure (txs, sOutputs)
-- | Get the Orchard actions from the given blockheight forward
getOrchardActions ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ database path
2024-04-18 01:28:47 +00:00
-> Int -- ^ block
-> IO [(Entity ZcashTransaction, Entity OrchAction)]
2024-05-05 14:49:55 +00:00
getOrchardActions pool b =
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-18 01:28:47 +00:00
select $ do
(txs :& oActions) <-
from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
(\(txs :& oActions) ->
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
where_ (txs ^. ZcashTransactionBlock >=. val b)
2024-04-18 01:28:47 +00:00
orderBy
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
pure (txs, oActions)
2024-04-08 20:51:14 +00:00
2024-04-21 12:07:51 +00:00
-- | Get the transactions belonging to the given address
getWalletTransactions ::
2024-05-05 14:49:55 +00:00
ConnectionPool -- ^ database path
2024-04-24 12:42:35 +00:00
-> Entity WalletAddress
2024-05-05 14:49:55 +00:00
-> NoLoggingT IO ()
getWalletTransactions pool w = do
2024-04-24 12:42:35 +00:00
let w' = entityVal w
2024-05-05 14:49:55 +00:00
chgAddr <- getInternalAddresses pool $ walletAddressAccId $ entityVal w
2024-04-24 12:42:35 +00:00
let ctReceiver = t_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
let csReceiver = s_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
let coReceiver = o_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
2024-04-24 12:42:35 +00:00
let tReceiver = t_rec =<< readUnifiedAddressDB w'
let sReceiver = s_rec =<< readUnifiedAddressDB w'
let oReceiver = o_rec =<< readUnifiedAddressDB w'
2024-04-21 12:07:51 +00:00
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]
]
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
tnotes <- from $ table @WalletTrNote
where_ (tnotes ^. WalletTrNoteScript ==. val s)
pure tnotes
2024-04-24 12:42:35 +00:00
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]
]
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
tnotes <- from $ table @WalletTrNote
where_ (tnotes ^. WalletTrNoteScript ==. val s1)
pure tnotes
2024-04-24 12:42:35 +00:00
trSpends <-
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-24 12:42:35 +00:00
select $ do
trSpends <- from $ table @WalletTrSpend
where_
(trSpends ^. WalletTrSpendNote `in_`
valList (map entityKey (trNotes <> trChgNotes)))
2024-04-24 12:42:35 +00:00
pure trSpends
2024-04-21 12:07:51 +00:00
sapNotes <-
case sReceiver of
Nothing -> return []
Just sR -> do
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
snotes <- from $ table @WalletSapNote
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
pure snotes
sapChgNotes <-
case csReceiver of
Nothing -> return []
Just sR -> do
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
snotes <- from $ table @WalletSapNote
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
pure snotes
sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes)
2024-04-21 12:07:51 +00:00
orchNotes <-
case oReceiver of
Nothing -> return []
Just oR -> do
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
onotes <- from $ table @WalletOrchNote
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
pure onotes
orchChgNotes <-
case coReceiver of
Nothing -> return []
Just oR -> do
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
onotes <- from $ table @WalletOrchNote
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
pure onotes
orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
2024-05-05 14:49:55 +00:00
clearUserTx (entityKey w)
2024-04-24 12:42:35 +00:00
mapM_ addTr trNotes
mapM_ addTr trChgNotes
mapM_ addSap sapNotes
mapM_ addSap sapChgNotes
2024-04-24 12:42:35 +00:00
mapM_ addOrch orchNotes
mapM_ addOrch orchChgNotes
2024-04-24 12:42:35 +00:00
mapM_ subTSpend trSpends
mapM_ subSSpend $ catMaybes sapSpends
mapM_ subOSpend $ catMaybes orchSpends
2024-04-21 12:07:51 +00:00
where
2024-05-05 14:49:55 +00:00
clearUserTx :: WalletAddressId -> NoLoggingT IO ()
clearUserTx waId = do
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
delete $ do
u <- from $ table @UserTx
where_ (u ^. UserTxAddress ==. val waId)
return ()
getSapSpends ::
WalletSapNoteId -> NoLoggingT IO (Maybe (Entity WalletSapSpend))
getSapSpends n = do
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
sapSpends <- from $ table @WalletSapSpend
where_ (sapSpends ^. WalletSapSpendNote ==. val n)
pure sapSpends
getOrchSpends ::
WalletOrchNoteId -> NoLoggingT IO (Maybe (Entity WalletOrchSpend))
getOrchSpends n = do
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
orchSpends <- from $ table @WalletOrchSpend
where_ (orchSpends ^. WalletOrchSpendNote ==. val n)
pure orchSpends
addTr :: Entity WalletTrNote -> NoLoggingT IO ()
2024-04-24 12:42:35 +00:00
addTr n =
upsertUserTx
(walletTrNoteTx $ entityVal n)
(entityKey w)
(fromIntegral $ walletTrNoteValue $ entityVal n)
""
2024-05-05 14:49:55 +00:00
addSap :: Entity WalletSapNote -> NoLoggingT IO ()
2024-04-24 12:42:35 +00:00
addSap n =
upsertUserTx
(walletSapNoteTx $ entityVal n)
(entityKey w)
(fromIntegral $ walletSapNoteValue $ entityVal n)
(walletSapNoteMemo $ entityVal n)
2024-05-05 14:49:55 +00:00
addOrch :: Entity WalletOrchNote -> NoLoggingT IO ()
2024-04-24 12:42:35 +00:00
addOrch n =
upsertUserTx
(walletOrchNoteTx $ entityVal n)
(entityKey w)
(fromIntegral $ walletOrchNoteValue $ entityVal n)
(walletOrchNoteMemo $ entityVal n)
2024-05-05 14:49:55 +00:00
subTSpend :: Entity WalletTrSpend -> NoLoggingT IO ()
2024-04-24 12:42:35 +00:00
subTSpend n =
upsertUserTx
(walletTrSpendTx $ entityVal n)
(entityKey w)
(-(fromIntegral $ walletTrSpendValue $ entityVal n))
""
2024-05-05 14:49:55 +00:00
subSSpend :: Entity WalletSapSpend -> NoLoggingT IO ()
2024-04-24 12:42:35 +00:00
subSSpend n =
upsertUserTx
(walletSapSpendTx $ entityVal n)
(entityKey w)
(-(fromIntegral $ walletSapSpendValue $ entityVal n))
""
2024-05-05 14:49:55 +00:00
subOSpend :: Entity WalletOrchSpend -> NoLoggingT IO ()
2024-04-24 12:42:35 +00:00
subOSpend n =
upsertUserTx
(walletOrchSpendTx $ entityVal n)
(entityKey w)
(-(fromIntegral $ walletOrchSpendValue $ entityVal n))
""
upsertUserTx ::
2024-05-05 14:49:55 +00:00
WalletTransactionId
-> WalletAddressId
-> Int
-> T.Text
-> NoLoggingT IO ()
2024-04-24 12:42:35 +00:00
upsertUserTx tId wId amt memo = do
2024-04-21 12:07:51 +00:00
tr <-
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-21 12:07:51 +00:00
select $ do
tx <- from $ table @WalletTransaction
where_ (tx ^. WalletTransactionId ==. val tId)
pure tx
2024-04-24 12:42:35 +00:00
existingUtx <-
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-24 12:42:35 +00:00
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
_ <-
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-24 12:42:35 +00:00
upsert
(UserTx
(walletTransactionTxId $ entityVal $ head tr)
wId
(walletTransactionTime $ entityVal $ head tr)
amt
memo)
[]
return ()
Just uTx -> do
_ <-
2024-05-05 14:49:55 +00:00
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
update $ \t -> do
set
t
[ UserTxAmount +=. val amt
, UserTxMemo =.
val (memo <> " " <> userTxMemo (entityVal uTx))
]
where_ (t ^. UserTxId ==. val (entityKey uTx))
2024-04-24 12:42:35 +00:00
return ()
2024-05-05 14:49:55 +00:00
getUserTx :: ConnectionPool -> WalletAddressId -> IO [Entity UserTx]
getUserTx pool aId = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
uTxs <- from $ table @UserTx
where_ (uTxs ^. UserTxAddress ==. val aId)
orderBy [asc $ uTxs ^. UserTxTime]
return uTxs
2024-04-24 12:42:35 +00:00
-- | Get wallet transparent notes by account
2024-05-05 14:49:55 +00:00
getWalletTrNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
getWalletTrNotes pool za = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n <- from $ table @WalletTrNote
where_ (n ^. WalletTrNoteAccId ==. val za)
pure n
2024-04-24 12:42:35 +00:00
-- | find Transparent spends
2024-05-05 14:49:55 +00:00
findTransparentSpends :: ConnectionPool -> ZcashAccountId -> IO ()
findTransparentSpends pool za = do
notes <- getWalletTrNotes pool za
2024-04-24 12:42:35 +00:00
mapM_ findOneTrSpend notes
where
findOneTrSpend :: Entity WalletTrNote -> IO ()
findOneTrSpend n = do
mReverseTxId <-
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-24 12:42:35 +00:00
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
2024-05-03 12:10:08 +00:00
let flipTxId =
HexStringDB $
HexString $ BS.reverse $ toBytes $ getHex reverseTxId
2024-04-24 12:42:35 +00:00
s <-
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-24 12:42:35 +00:00
select $ do
(tx :& trSpends) <-
from $
table @ZcashTransaction `innerJoin` table @TransparentSpend `on`
(\(tx :& trSpends) ->
tx ^. ZcashTransactionId ==. trSpends ^. TransparentSpendTx)
where_
2024-05-03 12:10:08 +00:00
(trSpends ^. TransparentSpendOutPointHash ==. val flipTxId)
2024-04-24 12:42:35 +00:00
where_
(trSpends ^. TransparentSpendOutPointIndex ==.
val (walletTrNotePosition $ entityVal n))
pure (tx, trSpends)
if null s
then return ()
else do
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
_ <-
update $ \w -> do
set w [WalletTrNoteSpent =. val True]
where_ $ w ^. WalletTrNoteId ==. val (entityKey n)
t' <- upsertWalTx (entityVal $ fst $ head s) za
2024-05-09 15:44:07 +00:00
_ <-
upsert
(WalletTrSpend
(entityKey t')
(entityKey n)
za
(walletTrNoteValue $ entityVal n))
[]
return ()
2024-04-24 12:42:35 +00:00
2024-05-05 14:49:55 +00:00
getWalletSapNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote]
getWalletSapNotes pool za = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n <- from $ table @WalletSapNote
where_ (n ^. WalletSapNoteAccId ==. val za)
pure n
2024-04-21 12:07:51 +00:00
-- | Sapling DAG-aware spend tracking
2024-05-05 14:49:55 +00:00
findSapSpends ::
ConnectionPool -> ZcashAccountId -> [Entity WalletSapNote] -> IO ()
2024-04-21 12:07:51 +00:00
findSapSpends _ _ [] = return ()
2024-05-05 14:49:55 +00:00
findSapSpends pool za (n:notes) = do
2024-04-21 12:07:51 +00:00
s <-
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-21 12:07:51 +00:00
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
2024-05-05 14:49:55 +00:00
then findSapSpends pool za notes
2024-04-21 12:07:51 +00:00
else do
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
_ <-
update $ \w -> do
set w [WalletSapNoteSpent =. val True]
where_ $ w ^. WalletSapNoteId ==. val (entityKey n)
t' <- upsertWalTx (entityVal $ fst $ head s) za
2024-05-09 15:44:07 +00:00
_ <-
upsert
(WalletSapSpend
(entityKey t')
(entityKey n)
za
(walletSapNoteValue $ entityVal n))
[]
return ()
2024-05-05 14:49:55 +00:00
findSapSpends pool za notes
2024-04-21 12:07:51 +00:00
2024-05-05 14:49:55 +00:00
getWalletOrchNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote]
getWalletOrchNotes pool za = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n <- from $ table @WalletOrchNote
where_ (n ^. WalletOrchNoteAccId ==. val za)
pure n
2024-04-24 12:42:35 +00:00
2024-05-05 14:49:55 +00:00
getUnspentSapNotes :: ConnectionPool -> IO [Entity WalletSapNote]
getUnspentSapNotes pool = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n <- from $ table @WalletSapNote
where_ (n ^. WalletSapNoteSpent ==. val False)
pure n
2024-05-03 12:10:08 +00:00
getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB]
getSaplingCmus pool zt = do
PS.runSqlPool
(select $ do
n <- from $ table @ShieldOutput
where_ (n ^. ShieldOutputId >. val zt)
orderBy [asc $ n ^. ShieldOutputId]
pure $ n ^. ShieldOutputCmu)
pool
getMaxSaplingNote :: Pool SqlBackend -> IO ShieldOutputId
getMaxSaplingNote pool = do
flip PS.runSqlPool pool $ do
x <-
selectOne $ do
n <- from $ table @ShieldOutput
where_ (n ^. ShieldOutputId >. val (toSqlKey 0))
orderBy [desc $ n ^. ShieldOutputId]
pure (n ^. ShieldOutputId)
case x of
Nothing -> return $ toSqlKey 0
Just (Value y) -> return y
updateSapNoteRecord ::
Pool SqlBackend
-> WalletSapNoteId
-> SaplingWitness
-> ShieldOutputId
-> IO ()
updateSapNoteRecord pool n w o = do
flip PS.runSqlPool pool $ do
update $ \x -> do
set
x
[ WalletSapNoteWitness =. val (HexStringDB $ sapWit w)
, WalletSapNoteWitPos =. val o
]
where_ (x ^. WalletSapNoteId ==. val n)
2024-05-05 14:49:55 +00:00
getUnspentOrchNotes :: ConnectionPool -> IO [Entity WalletOrchNote]
getUnspentOrchNotes pool = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n <- from $ table @WalletOrchNote
where_ (n ^. WalletOrchNoteSpent ==. val False)
pure n
2024-05-03 12:10:08 +00:00
getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB]
getOrchardCmxs pool zt = do
PS.runSqlPool
(select $ do
n <- from $ table @OrchAction
where_ (n ^. OrchActionId >. val zt)
orderBy [asc $ n ^. OrchActionId]
pure $ n ^. OrchActionCmx)
pool
getMaxOrchardNote :: Pool SqlBackend -> IO OrchActionId
getMaxOrchardNote pool = do
flip PS.runSqlPool pool $ do
x <-
selectOne $ do
n <- from $ table @OrchAction
where_ (n ^. OrchActionId >. val (toSqlKey 0))
orderBy [desc $ n ^. OrchActionId]
pure (n ^. OrchActionId)
case x of
Nothing -> return $ toSqlKey 0
Just (Value y) -> return y
updateOrchNoteRecord ::
Pool SqlBackend
-> WalletOrchNoteId
-> OrchardWitness
-> OrchActionId
-> IO ()
updateOrchNoteRecord pool n w o = do
flip PS.runSqlPool pool $ do
update $ \x -> do
set
x
[ WalletOrchNoteWitness =. val (HexStringDB $ orchWit w)
, WalletOrchNoteWitPos =. val o
]
where_ (x ^. WalletOrchNoteId ==. val n)
2024-05-05 14:49:55 +00:00
findOrchSpends ::
ConnectionPool -> ZcashAccountId -> [Entity WalletOrchNote] -> IO ()
2024-04-21 12:07:51 +00:00
findOrchSpends _ _ [] = return ()
2024-05-05 14:49:55 +00:00
findOrchSpends pool za (n:notes) = do
2024-04-21 12:07:51 +00:00
s <-
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-04-21 12:07:51 +00:00
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
2024-05-05 14:49:55 +00:00
then findOrchSpends pool za notes
2024-04-21 12:07:51 +00:00
else do
2024-05-05 14:49:55 +00:00
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
_ <-
update $ \w -> do
set w [WalletOrchNoteSpent =. val True]
where_ $ w ^. WalletOrchNoteId ==. val (entityKey n)
t' <- upsertWalTx (entityVal $ fst $ head s) za
2024-05-09 15:44:07 +00:00
_ <-
upsert
(WalletOrchSpend
(entityKey t')
(entityKey n)
za
(walletOrchNoteValue $ entityVal n))
[]
return ()
2024-05-05 14:49:55 +00:00
findOrchSpends pool za notes
2024-04-21 12:07:51 +00:00
upsertWalTx ::
2024-04-24 12:42:35 +00:00
MonadIO m
=> ZcashTransaction
-> ZcashAccountId
-> SqlPersistT m (Entity WalletTransaction)
upsertWalTx zt za =
2024-04-21 12:07:51 +00:00
upsert
(WalletTransaction
(zcashTransactionTxId zt)
2024-04-24 12:42:35 +00:00
za
2024-04-21 12:07:51 +00:00
(zcashTransactionBlock zt)
(zcashTransactionConf zt)
(zcashTransactionTime zt))
[]
2024-05-05 14:49:55 +00:00
getBalance :: ConnectionPool -> ZcashAccountId -> IO Integer
getBalance pool za = do
trNotes <- getWalletUnspentTrNotes pool za
2024-04-24 13:58:45 +00:00
let tAmts = map (walletTrNoteValue . entityVal) trNotes
let tBal = sum tAmts
2024-05-05 14:49:55 +00:00
sapNotes <- getWalletUnspentSapNotes pool za
2024-04-24 13:58:45 +00:00
let sAmts = map (walletSapNoteValue . entityVal) sapNotes
let sBal = sum sAmts
2024-05-05 14:49:55 +00:00
orchNotes <- getWalletUnspentOrchNotes pool za
2024-04-24 13:58:45 +00:00
let oAmts = map (walletOrchNoteValue . entityVal) orchNotes
let oBal = sum oAmts
return . fromIntegral $ tBal + sBal + oBal
2024-05-05 14:49:55 +00:00
clearWalletTransactions :: ConnectionPool -> IO ()
clearWalletTransactions pool = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
2024-05-09 15:44:07 +00:00
delete $ do
_ <- from $ table @UserTx
return ()
2024-05-05 14:49:55 +00:00
delete $ do
_ <- from $ table @WalletOrchSpend
return ()
delete $ do
_ <- from $ table @WalletOrchNote
return ()
delete $ do
_ <- from $ table @WalletSapSpend
return ()
delete $ do
_ <- from $ table @WalletSapNote
return ()
delete $ do
_ <- from $ table @WalletTrNote
return ()
delete $ do
_ <- from $ table @WalletTrSpend
return ()
delete $ do
_ <- from $ table @WalletTransaction
return ()
2024-04-24 12:42:35 +00:00
2024-05-05 14:49:55 +00:00
getWalletUnspentTrNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
getWalletUnspentTrNotes pool za = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n <- from $ table @WalletTrNote
where_ (n ^. WalletTrNoteAccId ==. val za)
where_ (n ^. WalletTrNoteSpent ==. val False)
pure n
2024-05-03 12:10:08 +00:00
getWalletUnspentSapNotes ::
2024-05-05 14:49:55 +00:00
ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote]
getWalletUnspentSapNotes pool za = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n1 <- from $ table @WalletSapNote
where_ (n1 ^. WalletSapNoteAccId ==. val za)
where_ (n1 ^. WalletSapNoteSpent ==. val False)
pure n1
2024-05-03 12:10:08 +00:00
getWalletUnspentOrchNotes ::
2024-05-05 14:49:55 +00:00
ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote]
getWalletUnspentOrchNotes pool za = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n2 <- from $ table @WalletOrchNote
where_ (n2 ^. WalletOrchNoteAccId ==. val za)
where_ (n2 ^. WalletOrchNoteSpent ==. val False)
pure n2
2024-05-03 12:10:08 +00:00
selectUnspentNotes ::
2024-05-05 14:49:55 +00:00
ConnectionPool
2024-05-03 12:10:08 +00:00
-> ZcashAccountId
-> Integer
-> IO ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
2024-05-05 14:49:55 +00:00
selectUnspentNotes pool za amt = do
trNotes <- getWalletUnspentTrNotes pool za
2024-05-03 12:10:08 +00:00
let (a1, tList) = checkTransparent (fromIntegral amt) trNotes
if a1 > 0
then do
2024-05-05 14:49:55 +00:00
sapNotes <- getWalletUnspentSapNotes pool za
2024-05-03 12:10:08 +00:00
let (a2, sList) = checkSapling a1 sapNotes
if a2 > 0
then do
2024-05-05 14:49:55 +00:00
orchNotes <- getWalletUnspentOrchNotes pool za
2024-05-03 12:10:08 +00:00
let (a3, oList) = checkOrchard a2 orchNotes
if a3 > 0
then throwIO $ userError "Not enough funds"
else return (tList, sList, oList)
else return (tList, sList, [])
else return (tList, [], [])
where
checkTransparent ::
Word64 -> [Entity WalletTrNote] -> (Word64, [Entity WalletTrNote])
checkTransparent x [] = (x, [])
checkTransparent x (n:ns) =
if walletTrNoteValue (entityVal n) < x
then ( fst (checkTransparent (x - walletTrNoteValue (entityVal n)) ns)
, n :
snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns))
else (0, [n])
checkSapling ::
Word64 -> [Entity WalletSapNote] -> (Word64, [Entity WalletSapNote])
checkSapling x [] = (x, [])
checkSapling x (n:ns) =
if walletSapNoteValue (entityVal n) < x
then ( fst (checkSapling (x - walletSapNoteValue (entityVal n)) ns)
, n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns))
else (0, [n])
checkOrchard ::
Word64 -> [Entity WalletOrchNote] -> (Word64, [Entity WalletOrchNote])
checkOrchard x [] = (x, [])
checkOrchard x (n:ns) =
if walletOrchNoteValue (entityVal n) < x
then ( fst (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns)
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
else (0, [n])
2024-05-05 14:49:55 +00:00
getWalletTxId ::
ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
getWalletTxId pool wId = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
wtx <- from $ table @WalletTransaction
where_ (wtx ^. WalletTransactionId ==. val wId)
pure $ wtx ^. WalletTransactionTxId
2024-05-03 12:10:08 +00:00
2024-04-07 14:25:25 +00:00
-- | Helper function to extract a Unified Address from the database
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
readUnifiedAddressDB =
isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress
2024-04-24 12:42:35 +00:00
-- | Get list of external zcash addresses from database
getAdrBook :: ConnectionPool -> ZcashNet -> IO [Entity AddressBook]
getAdrBook pool n =
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
adrbook <- from $ table @AddressBook
where_ (adrbook ^. AddressBookNetwork ==. val (ZcashNetDB n))
pure adrbook
2024-04-24 12:42:35 +00:00
rmdups :: Ord a => [a] -> [a]
rmdups = map head . group . sort