zenith/src/Zenith/DB.hs

{-# 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