app/Main.hs

@@ -18,7 +18,7 @@ import System.IO
 import Text.Read (readMaybe)
 import ZcashHaskell.Types
 import Zenith.CLI
-import Zenith.Core (testSync)
+import Zenith.Core (clearSync, testSync)
 import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
 import Zenith.Utils
 import Zenith.Zcashd
@@ -222,6 +222,7 @@ main = do
               (root nodeUser nodePwd)
         "cli" -> runZenithCLI myConfig
         "sync" -> testSync myConfig
+        "rescan" -> clearSync myConfig
         _ -> printUsage
     else printUsage
 

src/Zenith/CLI.hs

@@ -71,7 +71,6 @@ import Zenith.Types
   ( Config(..)
   , PhraseDB(..)
   , UnifiedAddressDB(..)
-  , UserTx(..)
   , ZcashNetDB(..)
   )
 import Zenith.Utils (displayTaz, displayZec, showAddress)
@@ -111,7 +110,7 @@ data State = State
   , _wallets :: !(L.List Name (Entity ZcashWallet))
   , _accounts :: !(L.List Name (Entity ZcashAccount))
   , _addresses :: !(L.List Name (Entity WalletAddress))
-  , _transactions :: !(L.List Name UserTx)
+  , _transactions :: !(L.List Name (Entity UserTx))
   , _msg :: !String
   , _helpBox :: !Bool
   , _dialogBox :: !DialogType
@@ -196,7 +195,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
         , str " "
         , C.hCenter $ str "Use arrows to select"
         ]
-    listTxBox :: String -> L.List Name UserTx -> Widget Name
+    listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name
     listTxBox titleLabel tx =
       C.vCenter $
       vBox
@@ -342,14 +341,18 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                    1
                    (str
                       ("Date:   " ++
-                       show (posixSecondsToUTCTime (fromInteger (ut_time tx)))) <=>
+                       show
-                    str ("Tx ID:  " ++ show (ut_txid tx)) <=>
+                         (posixSecondsToUTCTime
+                            (fromIntegral (userTxTime $ entityVal tx)))) <=>
+                    str ("Tx ID:  " ++ show (userTxHex $ entityVal tx)) <=>
                     str
                       ("Amount: " ++
                        if st ^. network == MainNet
-                         then displayZec (ut_value tx)
+                         then displayZec
-                         else displayTaz (ut_value tx)) <=>
+                                (fromIntegral $ userTxAmount $ entityVal tx)
-                    txt ("Memo:   " <> ut_memo tx)))
+                         else displayTaz
+                                (fromIntegral $ userTxAmount $ entityVal tx)) <=>
+                    txt ("Memo:   " <> userTxMemo (entityVal tx))))
         BlankDisplay -> emptyWidget
 
 mkInputForm :: DialogInput -> Form DialogInput e Name
@@ -395,13 +398,14 @@ listDrawAddress sel w =
       walletAddressName (entityVal w) <>
       ": " <> showAddress (walletAddressUAddress (entityVal w))
 
-listDrawTx :: Bool -> UserTx -> Widget Name
+listDrawTx :: Bool -> Entity UserTx -> Widget Name
 listDrawTx sel tx =
   selStr $
-  T.pack (show $ posixSecondsToUTCTime (fromInteger (ut_time tx))) <>
+  T.pack
+    (show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <>
   " " <> fmtAmt
   where
-    amt = fromIntegral (ut_value tx) / 100000000
+    amt = fromIntegral (userTxAmount $ entityVal tx) / 100000000
     fmtAmt =
       if amt > 0
         then "↘" <> T.pack (show amt) <> " "
@@ -601,8 +605,7 @@ runZenithCLI config = do
               else return []
           txList <-
             if not (null addrList)
-              then getUserTx dbFilePath =<<
+              then getUserTx dbFilePath $ entityKey $ head addrList
-                   getWalletTransactions dbFilePath (entityVal $ head addrList)
               else return []
           block <- getMaxWalletBlock dbFilePath
           void $
@@ -649,8 +652,7 @@ refreshWallet s = do
       else return []
   txL <-
     if not (null addrL)
-      then getUserTx (s ^. dbPath) =<<
+      then getUserTx (s ^. dbPath) $ entityKey $ head addrL
-           getWalletTransactions (s ^. dbPath) (entityVal $ head addrL)
       else return []
   let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
   let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
@@ -667,7 +669,7 @@ addNewWallet n s = do
   let netName = s ^. network
   r <-
     saveWallet (s ^. dbPath) $
-    ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH
+    ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
   case r of
     Nothing -> do
       return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
@@ -725,16 +727,19 @@ refreshAccount s = do
     do case L.listSelectedElement aL' of
          Nothing -> do
            let fAdd = L.listSelectedElement $ L.listMoveToBeginning aL'
-           case fAdd of
+           return fAdd
-             Nothing -> throw $ userError "Failed to select address"
+         Just a2 -> return $ Just a2
-             Just (_x, a1) -> return a1
+  case selAddress of
-         Just (_y, a2) -> return a2
+    Nothing ->
-  tList <-
+      return $
-    getUserTx (s ^. dbPath) =<<
+      s & addresses .~ aL' & msg .~ "Switched to account: " ++
-    getWalletTransactions (s ^. dbPath) (entityVal selAddress)
+      T.unpack (zcashAccountName $ entityVal selAccount)
+    Just (_i, a) -> do
+      tList <- getUserTx (s ^. dbPath) $ entityKey a
       let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
       return $
-    s & addresses .~ aL' & transactions .~ tL' & msg .~ "Switched to account: " ++
+        s & addresses .~ aL' & transactions .~ tL' & msg .~
+        "Switched to account: " ++
         T.unpack (zcashAccountName $ entityVal selAccount)
 
 refreshTxs :: State -> IO State
@@ -744,13 +749,12 @@ refreshTxs s = do
          Nothing -> do
            let fAdd =
                  L.listSelectedElement $ L.listMoveToBeginning $ s ^. addresses
-           case fAdd of
+           return fAdd
-             Nothing -> throw $ userError "Failed to select address"
+         Just a2 -> return $ Just a2
-             Just (_x, a1) -> return a1
+  case selAddress of
-         Just (_y, a2) -> return a2
+    Nothing -> return s
-  tList <-
+    Just (_i, a) -> do
-    getUserTx (s ^. dbPath) =<<
+      tList <- getUserTx (s ^. dbPath) $ entityKey a
-    getWalletTransactions (s ^. dbPath) (entityVal selAddress)
       let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
       return $ s & transactions .~ tL'
 

src/Zenith/Core.hs

@@ -195,9 +195,9 @@ findSaplingOutputs ::
      Config -- ^ the configuration parameters
   -> Int -- ^ the starting block
   -> ZcashNetDB -- ^ The network
-  -> SaplingSpendingKeyDB -- ^ The spending key to trial decrypt
+  -> Entity ZcashAccount -- ^ The account to use
   -> IO ()
-findSaplingOutputs config b znet sk = do
+findSaplingOutputs config b znet za = do
   let dbPath = c_dbPath config
   let zebraHost = c_zebraHost config
   let zebraPort = c_zebraPort config
@@ -206,7 +206,11 @@ findSaplingOutputs config b znet sk = do
   trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
   let sT = SaplingCommitmentTree $ ztiSapling trees
   decryptNotes sT zn tList
+  sapNotes <- getWalletSapNotes dbPath (entityKey za)
+  findSapSpends dbPath (entityKey za) sapNotes
   where
+    sk :: SaplingSpendingKeyDB
+    sk = zcashAccountSapSpendKey $ entityVal za
     decryptNotes ::
          SaplingCommitmentTree
       -> ZcashNet
@@ -233,24 +237,31 @@ findSaplingOutputs config b znet sk = do
                       decryptNotes uT n txs
                     Just dn1 -> do
                       print dn1
-                      wId <- saveWalletTransaction (c_dbPath config) zt
+                      wId <-
+                        saveWalletTransaction
+                          (c_dbPath config)
+                          (entityKey za)
+                          zt
                       saveWalletSapNote
                         (c_dbPath config)
                         wId
                         nP
                         (fromJust noteWitness)
                         True
+                        (entityKey za)
                         dn1
                       decryptNotes uT n txs
                 Just dn0 -> do
                   print dn0
-                  wId <- saveWalletTransaction (c_dbPath config) zt
+                  wId <-
+                    saveWalletTransaction (c_dbPath config) (entityKey za) zt
                   saveWalletSapNote
                     (c_dbPath config)
                     wId
                     nP
                     (fromJust noteWitness)
                     False
+                    (entityKey za)
                     dn0
                   decryptNotes uT n txs
     decodeShOut ::
@@ -278,9 +289,9 @@ findOrchardActions ::
      Config -- ^ the configuration parameters
   -> Int -- ^ the starting block
   -> ZcashNetDB -- ^ The network
-  -> OrchardSpendingKeyDB -- ^ The spending key to trial decrypt
+  -> Entity ZcashAccount -- ^ The account to use
   -> IO ()
-findOrchardActions config b znet sk = do
+findOrchardActions config b znet za = do
   let dbPath = c_dbPath config
   let zebraHost = c_zebraHost config
   let zebraPort = c_zebraPort config
@@ -289,6 +300,8 @@ findOrchardActions config b znet sk = do
   trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
   let sT = OrchardCommitmentTree $ ztiOrchard trees
   decryptNotes sT zn tList
+  orchNotes <- getWalletOrchNotes dbPath (entityKey za)
+  findOrchSpends dbPath (entityKey za) orchNotes
   where
     decryptNotes ::
          OrchardCommitmentTree
@@ -315,26 +328,35 @@ findOrchardActions config b znet sk = do
                     Nothing -> decryptNotes uT n txs
                     Just dn1 -> do
                       print dn1
-                      wId <- saveWalletTransaction (c_dbPath config) zt
+                      wId <-
+                        saveWalletTransaction
+                          (c_dbPath config)
+                          (entityKey za)
+                          zt
                       saveWalletOrchNote
                         (c_dbPath config)
                         wId
                         nP
                         (fromJust noteWitness)
                         True
+                        (entityKey za)
                         dn1
                       decryptNotes uT n txs
                 Just dn -> do
                   print dn
-                  wId <- saveWalletTransaction (c_dbPath config) zt
+                  wId <-
+                    saveWalletTransaction (c_dbPath config) (entityKey za) zt
                   saveWalletOrchNote
                     (c_dbPath config)
                     wId
                     nP
                     (fromJust noteWitness)
                     False
+                    (entityKey za)
                     dn
                   decryptNotes uT n txs
+    sk :: OrchardSpendingKeyDB
+    sk = zcashAccountOrchSpendKey $ entityVal za
     decodeOrchAction ::
          Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote
     decodeOrchAction scope pos o =
@@ -359,34 +381,42 @@ syncWallet config w = do
   accs <- getAccounts walletDb $ entityKey w
   addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
   intAddrs <- concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
-  lastBlock <- getMaxWalletBlock walletDb
+  chainTip <- getMaxBlock walletDb
+  let lastBlock = zcashWalletLastSync $ entityVal w
   let startBlock =
         if lastBlock > 0
           then lastBlock
           else zcashWalletBirthdayHeight $ entityVal w
-  trNotes <- mapM (findTransparentNotes walletDb startBlock . entityVal) addrs
+  mapM_ (findTransparentNotes walletDb startBlock) addrs
-  mapM_ (saveWalletTrNote walletDb External) $ concat trNotes
+  mapM_ (findTransparentNotes walletDb startBlock) intAddrs
-  trChNotes <-
+  mapM_ (findTransparentSpends walletDb . entityKey) accs
-    mapM (findTransparentNotes walletDb startBlock . entityVal) intAddrs
-  mapM_ (saveWalletTrNote walletDb Internal) $ concat trChNotes
   sapNotes <-
     mapM
-      (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w) .
+      (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
-       zcashAccountSapSpendKey . entityVal)
       accs
   orchNotes <-
     mapM
-      (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w) .
+      (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
-       zcashAccountOrchSpendKey . entityVal)
       accs
+  updateWalletSync walletDb chainTip (entityKey w)
+  mapM_ (getWalletTransactions walletDb) addrs
   return "Testing"
 
 testSync :: Config -> IO ()
 testSync config = do
   let dbPath = c_dbPath config
-  w <- runSqlite dbPath $ selectFirst [ZcashWalletName ==. "Main"] []
+  _ <- initDb dbPath
-  case w of
+  w <- getWallets dbPath TestNet
-    Nothing -> print "No wallet"
+  r <- mapM (syncWallet config) w
-    Just w' -> do
+  print r
-      r <- syncWallet config w'
+
+clearSync :: Config -> IO ()
+clearSync config = do
+  let dbPath = c_dbPath config
+  _ <- initDb dbPath
+  _ <- clearWalletTransactions dbPath
+  w <- getWallets dbPath TestNet
+  mapM_ (updateWalletSync dbPath 0 . entityKey) w
+  w' <- getWallets dbPath TestNet
+  r <- mapM (syncWallet config) w'
   print r

src/Zenith/DB.hs

@@ -18,11 +18,13 @@
 
 module Zenith.DB where
 
-import Control.Monad (when)
+import Control.Exception (throwIO)
+import Control.Monad (forM_, when)
 import Control.Monad.IO.Class (MonadIO)
 import Data.Bifunctor
 import qualified Data.ByteString as BS
 import Data.HexString
+import Data.List (group, sort)
 import Data.Maybe (fromJust, isJust)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
@@ -70,7 +72,6 @@ import Zenith.Types
   , ScopeDB(..)
   , TransparentSpendingKeyDB
   , UnifiedAddressDB(..)
-  , UserTx(..)
   , ZcashNetDB(..)
   )
 
@@ -82,6 +83,7 @@ share
     network ZcashNetDB
     seedPhrase PhraseDB
     birthdayHeight Int
+    lastSync Int default=0
     UniqueWallet name network
     deriving Show Eq
   ZcashAccount
@@ -105,26 +107,39 @@ share
     deriving Show Eq
   WalletTransaction
     txId HexStringDB
+    accId ZcashAccountId
     block Int
     conf Int
     time Int
-    UniqueWTx txId
+    UniqueWTx txId accId
+    deriving Show Eq
+  UserTx
+    hex HexStringDB
+    address WalletAddressId
+    time Int
+    amount Int
+    memo T.Text
+    UniqueUTx hex address
     deriving Show Eq
   WalletTrNote
     tx WalletTransactionId
+    accId ZcashAccountId
     value Word64
     spent Bool
     script BS.ByteString
     change Bool
+    position Word64
     UniqueTNote tx script
     deriving Show Eq
   WalletTrSpend
     tx WalletTransactionId
     note WalletTrNoteId
+    accId ZcashAccountId
     value Word64
     deriving Show Eq
   WalletSapNote
     tx WalletTransactionId
+    accId ZcashAccountId
     value Word64
     recipient BS.ByteString
     memo T.Text
@@ -138,10 +153,12 @@ share
   WalletSapSpend
     tx WalletTransactionId
     note WalletSapNoteId
+    accId ZcashAccountId
     value Word64
     deriving Show Eq
   WalletOrchNote
     tx WalletTransactionId
+    accId ZcashAccountId
     value Word64
     recipient BS.ByteString
     memo T.Text
@@ -155,6 +172,7 @@ share
   WalletOrchSpend
     tx WalletTransactionId
     note WalletOrchNoteId
+    accId ZcashAccountId
     value Word64
     deriving Show Eq
   ZcashTransaction
@@ -174,9 +192,9 @@ share
   TransparentSpend
     tx ZcashTransactionId
     outPointHash HexStringDB
-    outPointIndex Int
+    outPointIndex Word64
     script BS.ByteString
-    seq Int
+    seq Word64
     position Int
     UniqueTSPos tx position
     deriving Show Eq
@@ -225,6 +243,13 @@ initDb ::
 initDb dbName = do
   PS.runSqlite dbName $ do runMigration migrateAll
 
+-- | Upgrade the database
+upgradeDb ::
+     T.Text -- ^ database path
+  -> IO ()
+upgradeDb dbName = do
+  PS.runSqlite dbName $ do runMigrationUnsafe migrateAll
+
 -- | Get existing wallets from database
 getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
 getWallets dbFp n =
@@ -241,6 +266,14 @@ saveWallet ::
   -> IO (Maybe (Entity ZcashWallet))
 saveWallet dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
 
+-- | Update the last sync block for the wallet
+updateWalletSync :: T.Text -> Int -> ZcashWalletId -> IO ()
+updateWalletSync dbPath b i = do
+  PS.runSqlite dbPath $ do
+    update $ \w -> do
+      set w [ZcashWalletLastSync =. val b]
+      where_ $ w ^. ZcashWalletId ==. val i
+
 -- | Returns a list of accounts associated with the given wallet
 getAccounts ::
      T.Text -- ^ The database path
@@ -473,14 +506,18 @@ getMaxWalletBlock dbPath = do
 
 -- | Save a @WalletTransaction@
 saveWalletTransaction ::
-     T.Text -> Entity ZcashTransaction -> IO WalletTransactionId
+     T.Text
-saveWalletTransaction dbPath zt = do
+  -> ZcashAccountId
+  -> Entity ZcashTransaction
+  -> IO WalletTransactionId
+saveWalletTransaction dbPath za zt = do
   let zT' = entityVal zt
   PS.runSqlite dbPath $ do
     t <-
       upsert
         (WalletTransaction
            (zcashTransactionTxId zT')
+           za
            (zcashTransactionBlock zT')
            (zcashTransactionConf zT')
            (zcashTransactionTime zT'))
@@ -494,14 +531,16 @@ saveWalletSapNote ::
   -> Integer -- ^ note position
   -> SaplingWitness -- ^ the Sapling incremental witness
   -> Bool -- ^ change flag
+  -> ZcashAccountId
   -> DecodedNote -- The decoded Sapling note
   -> IO ()
-saveWalletSapNote dbPath wId pos wit ch dn = do
+saveWalletSapNote dbPath wId pos wit ch za dn = do
   PS.runSqlite dbPath $ do
     _ <-
       upsert
         (WalletSapNote
            wId
+           za
            (fromIntegral $ a_value dn)
            (a_recipient dn)
            (T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn)
@@ -520,14 +559,16 @@ saveWalletOrchNote ::
   -> Integer
   -> OrchardWitness
   -> Bool
+  -> ZcashAccountId
   -> DecodedNote
   -> IO ()
-saveWalletOrchNote dbPath wId pos wit ch dn = do
+saveWalletOrchNote dbPath wId pos wit ch za dn = do
   PS.runSqlite dbPath $ do
     _ <-
       upsert
         (WalletOrchNote
            wId
+           za
            (fromIntegral $ a_value dn)
            (a_recipient dn)
            (T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn)
@@ -543,10 +584,10 @@ saveWalletOrchNote dbPath wId pos wit ch dn = do
 findTransparentNotes ::
      T.Text -- ^ The database path
   -> Int -- ^ Starting block
-  -> WalletAddress
+  -> Entity WalletAddress
-  -> IO [(Entity ZcashTransaction, Entity TransparentNote)]
+  -> IO ()
 findTransparentNotes dbPath b t = do
-  let tReceiver = t_rec =<< readUnifiedAddressDB t
+  let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t)
   case tReceiver of
     Just tR -> do
       let s =
@@ -555,6 +596,7 @@ findTransparentNotes dbPath b t = do
               , (toBytes . tr_bytes) tR
               , BS.pack [0x88, 0xAC]
               ]
+      tN <-
         PS.runSqlite dbPath $
         select $ do
           (txs :& tNotes) <-
@@ -564,21 +606,29 @@ findTransparentNotes dbPath b t = do
           where_ (txs ^. ZcashTransactionBlock >. val b)
           where_ (tNotes ^. TransparentNoteScript ==. val s)
           pure (txs, tNotes)
-    Nothing -> return []
+      mapM_
+        (saveWalletTrNote
+           dbPath
+           (getScope $ walletAddressScope $ entityVal t)
+           (walletAddressAccId $ entityVal t))
+        tN
+    Nothing -> return ()
 
 -- | Add the transparent notes to the wallet
 saveWalletTrNote ::
      T.Text -- ^ the database path
   -> Scope
+  -> ZcashAccountId
   -> (Entity ZcashTransaction, Entity TransparentNote)
   -> IO ()
-saveWalletTrNote dbPath ch (zt, tn) = do
+saveWalletTrNote dbPath ch za (zt, tn) = do
   let zT' = entityVal zt
   PS.runSqlite dbPath $ do
     t <-
       upsert
         (WalletTransaction
            (zcashTransactionTxId zT')
+           za
            (zcashTransactionBlock zT')
            (zcashTransactionConf zT')
            (zcashTransactionTime zT'))
@@ -586,10 +636,12 @@ saveWalletTrNote dbPath ch (zt, tn) = do
     insert_ $
       WalletTrNote
         (entityKey t)
+        za
         (transparentNoteValue $ entityVal tn)
         False
         (transparentNoteScript $ entityVal tn)
         (ch == Internal)
+        (fromIntegral $ transparentNotePosition $ entityVal tn)
 
 -- | Save a Sapling note to the wallet database
 saveSapNote :: T.Text -> WalletSapNote -> IO ()
@@ -634,12 +686,15 @@ getOrchardActions dbPath b =
 -- | Get the transactions belonging to the given address
 getWalletTransactions ::
      T.Text -- ^ database path
-  -> WalletAddress
+  -> Entity WalletAddress
-  -> IO [WalletTransactionId]
+  -> IO ()
 getWalletTransactions dbPath w = do
-  let tReceiver = t_rec =<< readUnifiedAddressDB w
+  let w' = entityVal w
-  let sReceiver = s_rec =<< readUnifiedAddressDB w
+  chgAddr <- getInternalAddresses dbPath $ walletAddressAccId $ entityVal w
-  let oReceiver = o_rec =<< readUnifiedAddressDB w
+  let ctReceiver = t_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
+  let tReceiver = t_rec =<< readUnifiedAddressDB w'
+  let sReceiver = s_rec =<< readUnifiedAddressDB w'
+  let oReceiver = o_rec =<< readUnifiedAddressDB w'
   trNotes <-
     case tReceiver of
       Nothing -> return []
@@ -655,6 +710,28 @@ getWalletTransactions dbPath w = do
             tnotes <- from $ table @WalletTrNote
             where_ (tnotes ^. WalletTrNoteScript ==. val s)
             pure tnotes
+  trChgNotes <-
+    case ctReceiver of
+      Nothing -> return []
+      Just tR -> do
+        let s1 =
+              BS.concat
+                [ BS.pack [0x76, 0xA9, 0x14]
+                , (toBytes . tr_bytes) tR
+                , BS.pack [0x88, 0xAC]
+                ]
+        PS.runSqlite dbPath $ do
+          select $ do
+            tnotes <- from $ table @WalletTrNote
+            where_ (tnotes ^. WalletTrNoteScript ==. val s1)
+            pure tnotes
+  trSpends <-
+    PS.runSqlite dbPath $ do
+      select $ do
+        trSpends <- from $ table @WalletTrSpend
+        where_
+          (trSpends ^. WalletTrSpendNote `in_` valList (map entityKey trNotes))
+        pure trSpends
   sapNotes <-
     case sReceiver of
       Nothing -> return []
@@ -664,6 +741,14 @@ getWalletTransactions dbPath w = do
             snotes <- from $ table @WalletSapNote
             where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
             pure snotes
+  sapSpends <-
+    PS.runSqlite dbPath $ do
+      select $ do
+        sapSpends <- from $ table @WalletSapSpend
+        where_
+          (sapSpends ^. WalletSapSpendNote `in_`
+           valList (map entityKey sapNotes))
+        pure sapSpends
   orchNotes <-
     case oReceiver of
       Nothing -> return []
@@ -673,78 +758,185 @@ getWalletTransactions dbPath w = do
             onotes <- from $ table @WalletOrchNote
             where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
             pure onotes
-  let addrTx =
+  orchSpends <-
-        map (walletTrNoteTx . entityVal) trNotes <>
+    PS.runSqlite dbPath $ do
-        map (walletSapNoteTx . entityVal) sapNotes <>
+      select $ do
-        map (walletOrchNoteTx . entityVal) orchNotes
+        orchSpends <- from $ table @WalletOrchSpend
-  return addrTx
+        where_
-
+          (orchSpends ^. WalletOrchSpendNote `in_`
-getUserTx :: T.Text -> [WalletTransactionId] -> IO [UserTx]
+           valList (map entityKey orchNotes))
-getUserTx dbPath addrTx = do
+        pure orchSpends
-  mapM convertUserTx addrTx
+  mapM_ addTr trNotes
+  mapM_ addTr trChgNotes
+  mapM_ addSap sapNotes
+  mapM_ addOrch orchNotes
+  mapM_ subTSpend trSpends
+  mapM_ subSSpend sapSpends
+  mapM_ subOSpend orchSpends
   where
-    convertUserTx :: WalletTransactionId -> IO UserTx
+    addTr :: Entity WalletTrNote -> IO ()
-    convertUserTx tId = do
+    addTr n =
+      upsertUserTx
+        (walletTrNoteTx $ entityVal n)
+        (entityKey w)
+        (fromIntegral $ walletTrNoteValue $ entityVal n)
+        ""
+    addSap :: Entity WalletSapNote -> IO ()
+    addSap n =
+      upsertUserTx
+        (walletSapNoteTx $ entityVal n)
+        (entityKey w)
+        (fromIntegral $ walletSapNoteValue $ entityVal n)
+        (walletSapNoteMemo $ entityVal n)
+    addOrch :: Entity WalletOrchNote -> IO ()
+    addOrch n =
+      upsertUserTx
+        (walletOrchNoteTx $ entityVal n)
+        (entityKey w)
+        (fromIntegral $ walletOrchNoteValue $ entityVal n)
+        (walletOrchNoteMemo $ entityVal n)
+    subTSpend :: Entity WalletTrSpend -> IO ()
+    subTSpend n =
+      upsertUserTx
+        (walletTrSpendTx $ entityVal n)
+        (entityKey w)
+        (-(fromIntegral $ walletTrSpendValue $ entityVal n))
+        ""
+    subSSpend :: Entity WalletSapSpend -> IO ()
+    subSSpend n =
+      upsertUserTx
+        (walletSapSpendTx $ entityVal n)
+        (entityKey w)
+        (-(fromIntegral $ walletSapSpendValue $ entityVal n))
+        ""
+    subOSpend :: Entity WalletOrchSpend -> IO ()
+    subOSpend n =
+      upsertUserTx
+        (walletOrchSpendTx $ entityVal n)
+        (entityKey w)
+        (-(fromIntegral $ walletOrchSpendValue $ entityVal n))
+        ""
+    upsertUserTx ::
+         WalletTransactionId -> WalletAddressId -> Int -> T.Text -> IO ()
+    upsertUserTx tId wId amt memo = do
       tr <-
         PS.runSqlite dbPath $ do
           select $ do
             tx <- from $ table @WalletTransaction
             where_ (tx ^. WalletTransactionId ==. val tId)
             pure tx
-      trNotes <-
+      existingUtx <-
+        PS.runSqlite dbPath $ do
+          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
-            trNotes <- from $ table @WalletTrNote
+      uTxs <- from $ table @UserTx
-            where_ (trNotes ^. WalletTrNoteTx ==. val tId)
+      where_ (uTxs ^. UserTxAddress ==. val aId)
-            pure trNotes
+      return uTxs
-      trSpends <-
+
+-- | Get wallet transparent notes by account
+getWalletTrNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletTrNote]
+getWalletTrNotes dbPath za = do
   PS.runSqlite dbPath $ do
     select $ do
-            trSpends <- from $ table @WalletTrSpend
+      n <- from $ table @WalletTrNote
-            where_ (trSpends ^. WalletTrSpendTx ==. val tId)
+      where_ (n ^. WalletTrNoteAccId ==. val za)
-            pure trSpends
+      pure n
-      sapNotes <-
+
+-- | 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
-            sapNotes <- from $ table @WalletSapNote
+                (tx :& trSpends) <-
-            where_ (sapNotes ^. WalletSapNoteTx ==. val tId)
+                  from $
-            pure sapNotes
+                  table @ZcashTransaction `innerJoin` table @TransparentSpend `on`
-      sapSpends <-
+                  (\(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
-            sapSpends <- from $ table @WalletSapSpend
+      n <- from $ table @WalletSapNote
-            where_ (sapSpends ^. WalletSapSpendTx ==. val tId)
+      where_ (n ^. WalletSapNoteAccId ==. val za)
-            pure sapSpends
+      pure n
-      orchNotes <-
-        PS.runSqlite dbPath $ do
-          select $ do
-            orchNotes <- from $ table @WalletOrchNote
-            where_ (orchNotes ^. WalletOrchNoteTx ==. val tId)
-            pure orchNotes
-      orchSpends <-
-        PS.runSqlite dbPath $ do
-          select $ do
-            orchSpends <- from $ table @WalletOrchSpend
-            where_ (orchSpends ^. WalletOrchSpendTx ==. val tId)
-            pure orchSpends
-      return $
-        UserTx
-          (getHex $ walletTransactionTxId $ entityVal $ head tr)
-          (fromIntegral $ walletTransactionTime $ entityVal $ head tr)
-          (sum (map (fromIntegral . walletTrNoteValue . entityVal) trNotes) +
-           sum (map (fromIntegral . walletSapNoteValue . entityVal) sapNotes) +
-           sum (map (fromIntegral . walletOrchNoteValue . entityVal) orchNotes) -
-           sum (map (fromIntegral . walletTrSpendValue . entityVal) trSpends) -
-           sum (map (fromIntegral . walletSapSpendValue . entityVal) sapSpends) -
-           sum
-             (map (fromIntegral . walletOrchSpendValue . entityVal) orchSpends))
-          (T.concat (map (walletSapNoteMemo . entityVal) sapNotes) <>
-           T.concat (map (walletOrchNoteMemo . entityVal) orchNotes))
 
 -- | Sapling DAG-aware spend tracking
-findSapSpends :: T.Text -> SaplingSpendingKey -> [Entity WalletSapNote] -> IO ()
+findSapSpends :: T.Text -> ZcashAccountId -> [Entity WalletSapNote] -> IO ()
 findSapSpends _ _ [] = return ()
-findSapSpends dbPath sk (n:notes) = do
+findSapSpends dbPath za (n:notes) = do
   s <-
     PS.runSqlite dbPath $ do
       select $ do
@@ -757,25 +949,33 @@ findSapSpends dbPath sk (n:notes) = do
            val (walletSapNoteNullifier (entityVal n)))
         pure (tx, sapSpends)
   if null s
-    then findSapSpends dbPath sk notes
+    then findSapSpends dbPath za notes
     else do
       PS.runSqlite dbPath $ do
         _ <-
           update $ \w -> do
             set w [WalletSapNoteSpent =. val True]
             where_ $ w ^. WalletSapNoteId ==. val (entityKey n)
-        t' <- upsertWalTx $ entityVal $ fst $ head s
+        t' <- upsertWalTx (entityVal $ fst $ head s) za
         insert_ $
           WalletSapSpend
             (entityKey t')
             (entityKey n)
+            za
             (walletSapNoteValue $ entityVal n)
-      findSapSpends dbPath sk notes
+      findSapSpends dbPath za notes
 
-findOrchSpends ::
+getWalletOrchNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletOrchNote]
-     T.Text -> OrchardSpendingKey -> [Entity WalletOrchNote] -> IO ()
+getWalletOrchNotes dbPath za = do
+  PS.runSqlite dbPath $ do
+    select $ do
+      n <- from $ table @WalletOrchNote
+      where_ (n ^. WalletOrchNoteAccId ==. val za)
+      pure n
+
+findOrchSpends :: T.Text -> ZcashAccountId -> [Entity WalletOrchNote] -> IO ()
 findOrchSpends _ _ [] = return ()
-findOrchSpends dbPath sk (n:notes) = do
+findOrchSpends dbPath za (n:notes) = do
   s <-
     PS.runSqlite dbPath $ do
       select $ do
@@ -788,33 +988,66 @@ findOrchSpends dbPath sk (n:notes) = do
            val (walletOrchNoteNullifier (entityVal n)))
         pure (tx, orchSpends)
   if null s
-    then findOrchSpends dbPath sk notes
+    then findOrchSpends dbPath za notes
     else do
       PS.runSqlite dbPath $ do
         _ <-
           update $ \w -> do
             set w [WalletOrchNoteSpent =. val True]
             where_ $ w ^. WalletOrchNoteId ==. val (entityKey n)
-        t' <- upsertWalTx $ entityVal $ fst $ head s
+        t' <- upsertWalTx (entityVal $ fst $ head s) za
         insert_ $
           WalletOrchSpend
             (entityKey t')
             (entityKey n)
+            za
             (walletOrchNoteValue $ entityVal n)
-      findOrchSpends dbPath sk notes
+      findOrchSpends dbPath za notes
 
 upsertWalTx ::
-     MonadIO m => ZcashTransaction -> SqlPersistT m (Entity WalletTransaction)
+     MonadIO m
-upsertWalTx zt =
+  => 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

src/Zenith/Types.hs

@@ -30,13 +30,6 @@ import ZcashHaskell.Types
   )
 
 -- * UI
-data UserTx = UserTx
-  { ut_txid :: !HexString
-  , ut_time :: !Integer
-  , ut_value :: !Integer
-  , ut_memo :: !T.Text
-  } deriving (Eq, Show, Read)
-
 -- * Database field type wrappers
 newtype HexStringDB = HexStringDB
   { getHex :: HexString