Trim the transaction table

CHANGELOG.md

@@ -1,6 +1,7 @@
 # Changelog
 
 ## Unreleased changes
+- If an account does not have any non-finalized transactions, then the transaction table is no longer used for tracking next available account nonce.
 
 ## 6.2.1
 

concordium-consensus/src/Concordium/GlobalState/BlockState.hs

@@ -1437,8 +1437,8 @@ class (BlockStateOperations m, FixedSizeSerialization (BlockStateRef m)) => Bloc
     -- | Cache the block state.
     cacheBlockState :: BlockState m -> m ()
 
-    -- | Cache the block state and get the initial (empty) transaction table with the next account nonces
-    --  and update sequence numbers populated.
+    -- | Cache the block state and get the initial (empty) transaction table with
+    --  the next "update sequence numbers".
     cacheBlockStateAndGetTransactionTable :: BlockState m -> m TransactionTable
 
     -- | Populate the LMDB account map if it has not already been initialized.

concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs

@@ -246,6 +246,19 @@ instance (SupportsPersistentAccount pv m, av ~ AccountVersionFor pv) => Cacheabl
         return
             accts{accountTable = acctTable}
 
+-- This instance is here so we can cache the account table when starting up,
+-- allowing for efficient modification of the state.
+instance (SupportsPersistentAccount pv m) => Cacheable m (Accounts pv) where
+    cache accts = do
+        let atLeaf =
+                return @_
+                    @( HashedCachedRef
+                        (AccountCache (AccountVersionFor pv))
+                        (PersistentAccount (AccountVersionFor pv))
+                     )
+        acctTable <- liftCache atLeaf (accountTable accts)
+        return accts{accountTable = acctTable}
+
 -- | Create a new empty 'Accounts' structure.
 emptyAccounts :: (MonadIO m) => m (Accounts pv)
 emptyAccounts = do

concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs

@@ -3780,31 +3780,18 @@ cacheState hpbs = do
                 }
     return ()
 
--- | Cache the block state and get the initial (empty) transaction table with the next account nonces
---  and update sequence numbers populated.
+-- | Cache the block state and get the initial (empty) transaction table with the next
+-- update sequence numbers populated.
 cacheStateAndGetTransactionTable ::
     forall pv m.
     (SupportsPersistentState pv m) =>
     HashedPersistentBlockState pv ->
     m TransactionTable.TransactionTable
 cacheStateAndGetTransactionTable hpbs = do
     BlockStatePointers{..} <- loadPBS (hpbsPointers hpbs)
-    -- When caching the accounts, we populate the transaction table with the next account nonces.
-    -- This is done by using 'liftCache' on the account table with a custom cache function that
-    -- records the nonces.
-    let perAcct acct = do
-            -- Note: we do not need to cache the account because a loaded account is already fully
-            -- cached. (Indeed, 'cache' is defined to be 'pure'.)
-            nonce <- accountNonce acct
-            unless (nonce == minNonce) $ do
-                addr <- accountCanonicalAddress acct
-                MTL.modify
-                    ( TransactionTable.ttNonFinalizedTransactions . at' (accountAddressEmbed addr)
-                        ?~ TransactionTable.emptyANFTWithNonce nonce
-                    )
-            return acct
-    (accts, tt0) <- MTL.runStateT (liftCache perAcct bspAccounts) TransactionTable.emptyTransactionTable
-    -- first cache the modules
+    -- cache the account table
+    accts <- cache bspAccounts
+    -- cache the modules
     mods <- cache bspModules
     -- then cache the instances, but don't cache the modules again. Instead
     -- share the references in memory we have already constructed by caching
@@ -3825,7 +3812,7 @@ cacheStateAndGetTransactionTable hpbs = do
                             & TransactionTable.ttNonFinalizedChainUpdates . at' uty
                                 ?~ TransactionTable.emptyNFCUWithSequenceNumber sn
                 else return tt
-    tt <- foldM updInTT tt0 [minBound ..]
+    tt <- foldM updInTT TransactionTable.emptyTransactionTable [minBound ..]
     rels <- cache bspReleaseSchedule
     red <- cache bspRewardDetails
     _ <-

concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs

@@ -634,17 +634,35 @@ constructBlock StoredBlockWithStateHash{sbshStoredBlock = StoredBlock{..}, ..} =
 
 instance
     ( MonadState state m,
-      HasSkovPersistentData pv state
+      HasSkovPersistentData pv state,
+      BlockStateQuery m,
+      BlockState m ~ PBS.HashedPersistentBlockState pv,
+      MonadProtocolVersion m,
+      MPV m ~ pv,
+      MonadLogger (PersistentTreeStateMonad state m),
+      MonadIO (PersistentTreeStateMonad state m),
+      BlockStateStorage (PersistentTreeStateMonad state m)
     ) =>
     AccountNonceQuery (PersistentTreeStateMonad state m)
     where
-    getNextAccountNonce addr = nextAccountNonce addr <$> use (skovPersistentData . transactionTable)
+    getNextAccountNonce addr = do
+        sd <- use skovPersistentData
+        maybe (fetchFromLastFinalizedBlock sd) return (fetchFromTransactionTable sd)
+      where
+        fetchFromTransactionTable skovData = (,False) <$> nextAccountNonce addr (skovData ^. transactionTable)
+        fetchFromLastFinalizedBlock sd = do
+            st <- blockState $ sd ^. lastFinalized
+            macct <- getAccount st (aaeAddress addr)
+            nextNonce <- fromMaybe minNonce <$> mapM (getAccountNonce . snd) macct
+            return (nextNonce, True)
+    {-# INLINE getNextAccountNonce #-}
 
 instance
     ( MonadLogger (PersistentTreeStateMonad state m),
       MonadIO (PersistentTreeStateMonad state m),
       BlockStateStorage (PersistentTreeStateMonad state m),
       MonadState state m,
+      BlockStateQuery m,
       HasSkovPersistentData pv state,
       MonadProtocolVersion m,
       MPV m ~ pv,
@@ -873,19 +891,31 @@ instance
         -- check if the transaction is in the transaction table cache
         case tt ^? ttHashMap . ix trHash of
             Nothing -> do
-                -- Finalized credentials are not present in the transaction table, so we
-                -- check if they are already in the on-disk transaction table.
-                -- For other transaction types, we use the nonce/sequence number to rule
-                -- out the transaction already being finalized.
-                oldCredential <- case wmdData of
-                    CredentialDeployment{} -> memberTransactionTable wmdHash
-                    _ -> return False
-                let ~(added, newTT) = addTransaction bi 0 verRes tt
-                if not oldCredential && added
+                mayAddTransaction <- case wmdData of
+                    -- Finalized credentials are not present in the transaction table, so we
+                    -- check if they are already in the on-disk transaction table.
+                    -- For other transaction types, we use the nonce/sequence number to rule
+                    -- out the transaction already being finalized.
+                    NormalTransaction tr -> do
+                        lfbState <- use (skovPersistentData . lastFinalized . to _bpState)
+                        mAcc <- getAccount lfbState $ transactionSender tr
+                        nonce <- maybe (pure minNonce) getAccountNonce (snd <$> mAcc)
+                        return $! nonce <= transactionNonce tr
+                    -- We need to check here that the nonce is still ok with respect to the last finalized block,
+                    -- because it could be that a block was finalized thus the next account nonce being incremented
+                    -- after this transaction was received and pre-verified.
+                    CredentialDeployment{} -> not <$> memberTransactionTable wmdHash
+                    -- the sequence number will be checked by @Impl.addTransaction@.
+                    _ -> return True
+                if mayAddTransaction
                     then do
-                        skovPersistentData . transactionTablePurgeCounter += 1
-                        skovPersistentData . transactionTable .=! newTT
-                        return (Added bi verRes)
+                        let ~(added, newTT) = addTransaction bi 0 verRes tt
+                        if added
+                            then do
+                                skovPersistentData . transactionTablePurgeCounter += 1
+                                skovPersistentData . transactionTable .=! newTT
+                                return (Added bi verRes)
+                            else return ObsoleteNonce
                     else return ObsoleteNonce
             Just (bi', results) -> do
                 -- The `Finalized` case is not reachable because finalized transactions are removed
@@ -902,33 +932,23 @@ instance
             let nonce = transactionNonce tr
                 sender = accountAddressEmbed (transactionSender tr)
             anft <- use (skovPersistentData . transactionTable . ttNonFinalizedTransactions . at' sender . non emptyANFT)
-            if anft ^. anftNextNonce == nonce
+            let nfn = anft ^. anftMap . at' nonce . non Map.empty
+                wmdtr = WithMetadata{wmdData = tr, ..}
+            if Map.member wmdtr nfn
                 then do
-                    let nfn = anft ^. anftMap . at' nonce . non Map.empty
-                        wmdtr = WithMetadata{wmdData = tr, ..}
-                    if Map.member wmdtr nfn
-                        then do
-                            -- Remove any other transactions with this nonce from the transaction table.
-                            -- They can never be part of any other block after this point.
-                            forM_ (Map.keys (Map.delete wmdtr nfn)) $
-                                \deadTransaction -> skovPersistentData . transactionTable . ttHashMap . at' (getHash deadTransaction) .= Nothing
-                            -- Mark the status of the transaction as finalized, and remove the data from the in-memory table.
-                            ss <- deleteAndFinalizeStatus wmdHash
-                            -- Update the non-finalized transactions for the sender
-                            skovPersistentData
-                                . transactionTable
-                                . ttNonFinalizedTransactions
-                                . at' sender
-                                ?= ( anft
-                                        & (anftMap . at' nonce .~ Nothing)
-                                        & (anftNextNonce .~ nonce + 1)
-                                   )
-                            return ss
-                        else do
-                            logErrorAndThrowTS $ "Tried to finalize transaction which is not known to be in the set of non-finalized transactions for the sender " ++ show sender
+                    -- Remove any other transactions with this nonce from the transaction table.
+                    -- They can never be part of any other block after this point.
+                    forM_ (Map.keys (Map.delete wmdtr nfn)) $
+                        \deadTransaction -> skovPersistentData . transactionTable . ttHashMap . at' (getHash deadTransaction) .= Nothing
+                    -- Mark the status of the transaction as finalized, and remove the data from the in-memory table.
+                    ss <- deleteAndFinalizeStatus wmdHash
+                    -- Remove the transaction from the non finalized transactions.
+                    -- If there are no non-finalized transactions left then remove the entry
+                    -- for the sender in @ttNonFinalizedTransactions@.
+                    skovPersistentData . transactionTable %=! finalizeTransactionAt sender nonce
+                    return ss
                 else do
-                    logErrorAndThrowTS $
-                        "The recorded next nonce for the account " ++ show sender ++ " (" ++ show (anft ^. anftNextNonce) ++ ") doesn't match the one that is going to be finalized (" ++ show nonce ++ ")"
+                    logErrorAndThrowTS $ "Tried to finalize transaction which is not known to be in the set of non-finalized transactions for the sender " ++ show sender
         finTrans WithMetadata{wmdData = CredentialDeployment{}, ..} =
             deleteAndFinalizeStatus wmdHash
         finTrans WithMetadata{wmdData = ChainUpdate cu, ..} = do

concordium-consensus/src/Concordium/GlobalState/PurgeTransactions.hs

@@ -107,20 +107,35 @@ purgeTables lastFinCommitPoint oldestArrivalTime currentTime TransactionTable{..
                 | otherwise = (mmnonce <> Just (Max n), Just ts')
         put (mmnonce', tht')
         return mres
-    -- Purge the non-finalized transactions for a specific account.
-    purgeAccount :: AccountAddressEq -> AccountNonFinalizedTransactions -> State (PendingTransactionTable, TransactionHashTable) AccountNonFinalizedTransactions
-    purgeAccount addr AccountNonFinalizedTransactions{..} = do
-        (ptt0, trs0) <- get
+    -- Purge the non-finalized transactions for an account,
+    -- accumulating the non-finalized transactions that were
+    -- not purged. Purging the transactions removes them
+    -- from the transaction table and updates the pending
+    -- transaction table accordingly.
+    purgeAccount ::
+        -- accumulator
+        ( HM.HashMap AccountAddressEq AccountNonFinalizedTransactions,
+          (PendingTransactionTable, TransactionHashTable)
+        ) ->
+        -- current entry key
+        AccountAddressEq ->
+        -- current entry value
+        AccountNonFinalizedTransactions ->
+        -- result
+        ( HM.HashMap AccountAddressEq AccountNonFinalizedTransactions,
+          (PendingTransactionTable, TransactionHashTable)
+        )
+    purgeAccount (!anfts, (ptt0, trs0)) addr AccountNonFinalizedTransactions{..} =
         -- Purge the transactions from the transaction table.
         let (newANFTMap, (mmax, !trs1)) = runState (Map.traverseMaybeWithKey purgeTxs _anftMap) (Nothing, trs0)
-        -- Update the pending transaction table.
-        let updptt (Just (Max newHigh)) (Just (low, _))
+            -- Update the pending transaction table.
+            updptt (Just (Max newHigh)) (Just (low, _))
                 | newHigh < low = Nothing
                 | otherwise = Just (low, newHigh)
             updptt _ _ = Nothing
             !ptt1 = ptt0 & pttWithSender . at' addr %~ updptt mmax
-        put (ptt1, trs1)
-        return AccountNonFinalizedTransactions{_anftMap = newANFTMap, ..}
+            anfts' = if null newANFTMap then anfts else HM.insert addr AccountNonFinalizedTransactions{_anftMap = newANFTMap, ..} anfts
+        in  (anfts', (ptt1, trs1))
     -- Purge the deploy credential transactions that are pending.
     purgeDeployCredentials = do
         dc0 <- use (_1 . pttDeployCredential)
@@ -175,8 +190,11 @@ purgeTables lastFinCommitPoint oldestArrivalTime currentTime TransactionTable{..
             !ptt1 = ptt0 & pttUpdates . at' uty %~ updptt mmax
         in  (nfcu{_nfcuMap = newNFCUMap}, (ptt1, uis1))
     purge = do
-        -- Purge each account
-        nnft <- HM.traverseWithKey purgeAccount _ttNonFinalizedTransactions
+        -- Purge each account, and possibly remove the @AccountNonFinalizedTransactions@
+        -- if an account does not have any pending transactions left.
+        pttAndTxTable <- get
+        let (!nnft, (!ptt, !txTable)) = HM.foldlWithKey' purgeAccount (HM.empty, pttAndTxTable) _ttNonFinalizedTransactions
+        put (ptt, txTable)
         -- Purge credential deployments
         purgeDeployCredentials
         -- Purge chain updates