diff --git a/CHANGELOG.md b/CHANGELOG.md index aa518fd645..7b4ead6748 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index 65c9038329..f540ddefcd 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/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. diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs index f33c6d1540..fac8808211 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs +++ b/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 diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 5905b4b68f..2ca9839432 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -3780,8 +3780,8 @@ 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) => @@ -3789,22 +3789,9 @@ cacheStateAndGetTransactionTable :: 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 _ <- diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs index 2f0c035069..b15007d1ed 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/TreeState.hs +++ b/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 diff --git a/concordium-consensus/src/Concordium/GlobalState/PurgeTransactions.hs b/concordium-consensus/src/Concordium/GlobalState/PurgeTransactions.hs index 89c31c2955..32856013ae 100644 --- a/concordium-consensus/src/Concordium/GlobalState/PurgeTransactions.hs +++ b/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 diff --git a/concordium-consensus/src/Concordium/GlobalState/TransactionTable.hs b/concordium-consensus/src/Concordium/GlobalState/TransactionTable.hs index df73ec19dd..e8fa2ef2e2 100644 --- a/concordium-consensus/src/Concordium/GlobalState/TransactionTable.hs +++ b/concordium-consensus/src/Concordium/GlobalState/TransactionTable.hs @@ -133,12 +133,9 @@ getTransactionIndex bh = \case -- * Transaction table -- | The non-finalized transactions for a particular account. -data AccountNonFinalizedTransactions = AccountNonFinalizedTransactions +newtype AccountNonFinalizedTransactions = AccountNonFinalizedTransactions { -- | Non-finalized transactions (for an account) and their verification results indexed by nonce. - _anftMap :: !(Map.Map Nonce (Map.Map Transaction TVer.VerificationResult)), - -- | The next available nonce at the last finalized block. - -- 'anftMap' should only contain nonces that are at least 'anftNextNonce'. - _anftNextNonce :: !Nonce + _anftMap :: Map.Map Nonce (Map.Map Transaction TVer.VerificationResult) } deriving (Eq, Show) @@ -147,12 +144,7 @@ makeLenses ''AccountNonFinalizedTransactions -- | Empty (no pending transactions) account non-finalized table starting at the -- minimal nonce. emptyANFT :: AccountNonFinalizedTransactions -emptyANFT = emptyANFTWithNonce minNonce - --- | An account non-finalized table with no pending transactions and given --- starting nonce. -emptyANFTWithNonce :: Nonce -> AccountNonFinalizedTransactions -emptyANFTWithNonce = AccountNonFinalizedTransactions Map.empty +emptyANFT = AccountNonFinalizedTransactions Map.empty -- | The non-finalized chain updates of a particular type. data NonFinalizedChainUpdates = NonFinalizedChainUpdates @@ -207,14 +199,13 @@ emptyNFCUWithSequenceNumber = NonFinalizedChainUpdates Map.empty -- may also have a non-zero highest commit point if it is received in a block, but that block -- is not yet considered arrived (e.g. it is pending its parent). -- --- Generally, '_ttNonFinalizedTransactions' should have an entry for every account, --- with the exception of where the entry would be 'emptyANFT'. Similarly with --- '_ttNonFinalizedChainUpdates' and 'emptyNFCU'. In particular, there should be --- an entry if the next nonce/sequence number is not the minimum value. +-- The '_ttNonFinalizedTransactions' should have an entry for every account which has non-finalized transactions. +-- The '_ttNonFinalizedChainUpdates' should have an entry for all kinds of 'UpdateType's with the exception of where it would be 'emptyNFCU'. +-- In particular, there should be an entry if the next sequence number is not the minimum value. data TransactionTable = TransactionTable { -- | Map from transaction hashes to transactions, together with their current status. _ttHashMap :: !(HM.HashMap TransactionHash (BlockItem, LiveTransactionStatus)), - -- | For each account, the non-finalized transactions for that account, + -- | For accounts that have non-finalized transactions, the non-finalized transactions for that account, -- grouped by nonce. See $equivalence for reasons why AccountAddressEq is used. _ttNonFinalizedTransactions :: !(HM.HashMap AccountAddressEq AccountNonFinalizedTransactions), -- | For each update types, the non-finalized update instructions, grouped by @@ -247,29 +238,33 @@ emptyTransactionTable = _ttNonFinalizedChainUpdates = Map.empty } --- | A transaction table with no transactions, but with the initial next sequence numbers --- set for the accounts and update types. -emptyTransactionTableWithSequenceNumbers :: [(AccountAddress, Nonce)] -> Map.Map UpdateType UpdateSequenceNumber -> TransactionTable -emptyTransactionTableWithSequenceNumbers accs upds = - TransactionTable - { _ttHashMap = HM.empty, - _ttNonFinalizedTransactions = HM.fromList . map (\(k, n) -> (accountAddressEmbed k, emptyANFTWithNonce n)) . filter (\(_, n) -> n /= minNonce) $ accs, - _ttNonFinalizedChainUpdates = emptyNFCUWithSequenceNumber <$> Map.filter (/= minUpdateSequenceNumber) upds - } - --- | Add a transaction to a transaction table if its nonce/sequence number is at least the next --- non-finalized nonce/sequence number. A return value of 'True' indicates that the transaction +-- | Add a transaction to a transaction table. +-- For chain updates it is checked that the sequence number is at least the next +-- non-finalized sequence number. +-- Nothing is checked for normal transactions. +-- +-- A return value of 'True' indicates that the transaction -- was added. The caller should check that the transaction is not already present. -addTransaction :: BlockItem -> CommitPoint -> TVer.VerificationResult -> TransactionTable -> (Bool, TransactionTable) +addTransaction :: + -- | Transaction to add. + BlockItem -> + -- | Commit point of the transaction. + CommitPoint -> + -- | The associated verification result. + TVer.VerificationResult -> + -- | The transaction table to update. + TransactionTable -> + -- | First component is @True@ if table was updated. + -- Second component is the updated table. + (Bool, TransactionTable) addTransaction blockItem@WithMetadata{..} cp !verRes tt0 = case wmdData of - NormalTransaction tr - | tt0 ^. senderANFT . anftNextNonce <= nonce -> - (True, tt1 & senderANFT . anftMap . at' nonce . non Map.empty . at' wmdtr ?~ verRes) + NormalTransaction tr -> (True, tt1 & senderANFT . anftMap . at' nonce . non Map.empty . at' wmdtr ?~ verRes) where sender = accountAddressEmbed (transactionSender tr) senderANFT :: Lens' TransactionTable AccountNonFinalizedTransactions - senderANFT = ttNonFinalizedTransactions . at' sender . non emptyANFT + senderANFT = ttNonFinalizedTransactions . at' sender . non anft + anft = emptyANFT nonce = transactionNonce tr wmdtr = WithMetadata{wmdData = tr, ..} CredentialDeployment{} -> (True, tt1) @@ -447,22 +442,42 @@ reversePTT trs ptt0 = foldr reverse1 ptt0 trs Just (low - 1, high) -- | Returns the next available account nonce for the --- provided account address in the first component and the --- 'Bool' in the second component is 'True' only if all transactions from the --- provided account are finalized. +-- provided account address from the perspective of the 'TransactionTable'. +-- Returns @Nothing@ if no non-finalized transactions were recorded for the provided account. nextAccountNonce :: -- | The account to look up the next account nonce for. AccountAddressEq -> -- | The transaction table to look up in. TransactionTable -> - -- | ("the next available account nonce", "whether all transactions from the account are finalized"). - (Nonce, Bool) -nextAccountNonce addr tt = case tt ^. ttNonFinalizedTransactions . at' addr of - Nothing -> (minNonce, True) - Just anfts -> - case Map.lookupMax (anfts ^. anftMap) of - Nothing -> (anfts ^. anftNextNonce, True) - Just (nonce, _) -> (nonce + 1, False) + -- | Maybe "the next available account nonce" with respect to the provided 'TransactionTable'. + Maybe Nonce +nextAccountNonce addr tt = do + anfts <- tt ^. ttNonFinalizedTransactions . at' addr + (nonce, _) <- Map.lookupMax (anfts ^. anftMap) + return (nonce + 1) + +-- | Remove a non-finalized transaction from the +-- 'ttNonFinalizedTransactions' of the provided 'TransactionTable' +-- for the provided sender 'AccountAddressEq' +-- and account 'Nonce'. +-- Returns back the updated 'TransactionTable'. +finalizeTransactionAt :: + -- | Sender of the transaction + AccountAddressEq -> + -- | The nonce of the transaction + Nonce -> + -- | 'TransactionTable' to update + TransactionTable -> + -- | The resulting 'TransactionTable' + TransactionTable +finalizeTransactionAt addr nonce tt = + tt + & ttNonFinalizedTransactions + . at' addr + . non emptyANFT + . anftMap + . at' nonce + .~ Nothing -- * Transaction grouping diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Transactions.hs b/concordium-consensus/src/Concordium/KonsensusV1/Transactions.hs index 35d77e11ba..799a45c608 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Transactions.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Transactions.hs @@ -11,6 +11,7 @@ -- from the underlying tree state, in this case the 'SkovData pv'. module Concordium.KonsensusV1.Transactions where +import Control.Monad.Catch import Control.Monad.Reader import Control.Monad.State.Strict import Control.Monad.Trans.Cont @@ -33,7 +34,7 @@ import qualified Concordium.GlobalState.TransactionTable as TT import Concordium.GlobalState.Transactions import Concordium.GlobalState.TreeState (MGSTrans (..)) import qualified Concordium.GlobalState.Types as GSTypes -import Concordium.KonsensusV1.TreeState.Implementation +import qualified Concordium.KonsensusV1.TreeState.Implementation as Impl import Concordium.KonsensusV1.TreeState.Types import Concordium.KonsensusV1.Types import Concordium.Scheduler.Types (updateSeqNumber) @@ -43,7 +44,7 @@ import qualified Concordium.TransactionVerification as TVer -- | Monad transformer for acquiring the next available account nonce from the -- underlying tree state. newtype AccountNonceQueryT (m :: Type -> Type) (a :: Type) = AccountNonceQueryT {runAccountNonceQueryT :: m a} - deriving (Functor, Applicative, Monad, MonadIO, TimeMonad, MonadState s, MonadReader r) + deriving (Functor, Applicative, Monad, MonadIO, TimeMonad, MonadState s, MonadReader r, MonadCatch, MonadThrow) deriving (MonadTrans) via IdentityT -- Instance for deducing the protocol version from the parameterized @m@ of the 'AccountNonceQueryT'. @@ -57,15 +58,22 @@ deriving via (MGSTrans AccountNonceQueryT m) instance (AccountOperations m) => A deriving via (MGSTrans AccountNonceQueryT m) instance (ModuleQuery m) => ModuleQuery (AccountNonceQueryT m) -- | The instance used for acquiring the next available account nonce with respect to consensus protocol v1. -instance (MonadState (SkovData (MPV m)) m) => AccountNonceQuery (AccountNonceQueryT m) where - getNextAccountNonce addr = TT.nextAccountNonce addr . view transactionTable <$> get +instance + ( BlockStateQuery m, + GSTypes.BlockState m ~ PBS.HashedPersistentBlockState (MPV m), + MonadState (Impl.SkovData (MPV m)) m + ) => + AccountNonceQuery (AccountNonceQueryT m) + where + getNextAccountNonce addr = Impl.getNextAccountNonce addr =<< get {-# INLINE getNextAccountNonce #-} -- | Verify a block item. This wraps 'TVer.verify'. verifyBlockItem :: ( BlockStateQuery m, MonadProtocolVersion m, - MonadState (SkovData (MPV m)) m + GSTypes.BlockState m ~ PBS.HashedPersistentBlockState (MPV m), + MonadState (Impl.SkovData (MPV m)) m ) => -- | Block time (if transaction is in a block) or current time. Timestamp -> @@ -99,7 +107,7 @@ verifyBlockItem ts bi ctx = runAccountNonceQueryT (runTransactionVerifierT (TVer -- -- This is an internal function only and should not be called directly. addPendingTransaction :: - ( MonadState (SkovData (MPV m)) m, + ( MonadState (Impl.SkovData (MPV m)) m, TimeMonad m, BlockStateQuery m, GSTypes.BlockState m ~ PBS.HashedPersistentBlockState (MPV m) @@ -110,21 +118,21 @@ addPendingTransaction :: addPendingTransaction bi = do case wmdData bi of NormalTransaction tx -> do - fbState <- bpState <$> (_focusBlock <$> gets' _skovPendingTransactions) + fbState <- bpState <$> (Impl._focusBlock <$> gets' Impl._skovPendingTransactions) macct <- getAccount fbState $! transactionSender tx nextNonce <- fromMaybe minNonce <$> mapM (getAccountNonce . snd) macct when (nextNonce <= transactionNonce tx) $ do - pendingTransactionTable %=! TT.addPendingTransaction nextNonce tx - purgeTransactionTable False =<< currentTime + Impl.pendingTransactionTable %=! TT.addPendingTransaction nextNonce tx + Impl.purgeTransactionTable False =<< currentTime CredentialDeployment _ -> do - pendingTransactionTable %=! TT.addPendingDeployCredential txHash - purgeTransactionTable False =<< currentTime + Impl.pendingTransactionTable %=! TT.addPendingDeployCredential txHash + Impl.purgeTransactionTable False =<< currentTime ChainUpdate cu -> do - fbState <- bpState <$> (_focusBlock <$> gets' _skovPendingTransactions) + fbState <- bpState <$> (Impl._focusBlock <$> gets' Impl._skovPendingTransactions) nextSN <- getNextUpdateSequenceNumber fbState (updateType (uiPayload cu)) when (nextSN <= updateSeqNumber (uiHeader cu)) $ do - pendingTransactionTable %=! TT.addPendingUpdate nextSN cu - purgeTransactionTable False =<< currentTime + Impl.pendingTransactionTable %=! TT.addPendingUpdate nextSN cu + Impl.purgeTransactionTable False =<< currentTime where txHash = getHash bi @@ -135,7 +143,7 @@ addPendingTransaction bi = do processBlockItem :: ( MonadProtocolVersion m, IsConsensusV1 (MPV m), - MonadState (SkovData (MPV m)) m, + MonadState (Impl.SkovData (MPV m)) m, TimeMonad m, BlockStateQuery m, GSTypes.BlockState m ~ PBS.HashedPersistentBlockState (MPV m) @@ -146,7 +154,7 @@ processBlockItem :: m AddTransactionResult processBlockItem bi = do -- First we check whether the transaction already exists in the transaction table. - tt <- use' transactionTable + tt <- use' Impl.transactionTable case tt ^. TT.ttHashMap . at' txHash of Just (duplicateTransaction, dupStatus) -> return $! Duplicate duplicateTransaction (Just $! dupStatus ^. TT.tsVerRes) Nothing -> do @@ -160,7 +168,7 @@ processBlockItem bi = do where -- Insert the transaction into the transaction table and pending transaction table. insertTransaction okRes = do - added <- addTransaction 0 bi $! TVer.Ok okRes + added <- Impl.addTransaction 0 bi $! TVer.Ok okRes if added then do addPendingTransaction bi @@ -169,7 +177,7 @@ processBlockItem bi = do return ObsoleteNonce -- Create a context suitable for verifying a transaction within a 'Individual' context. getCtx = do - _ctxBs <- bpState <$> gets' _lastFinalized + _ctxBs <- bpState <$> gets' Impl._lastFinalized chainParams <- Concordium.GlobalState.BlockState.getChainParameters _ctxBs let _ctxMaxBlockEnergy = chainParams ^. cpConsensusParameters . cpBlockEnergyLimit return $! Context{_ctxTransactionOrigin = TVer.Individual, ..} @@ -189,7 +197,7 @@ processBlockItem bi = do preverifyTransaction :: ( BlockStateQuery m, MonadProtocolVersion m, - MonadState (SkovData (MPV m)) m, + MonadState (Impl.SkovData (MPV m)) m, GSTypes.BlockState m ~ PBS.HashedPersistentBlockState (MPV m), IsConsensusV1 (MPV m), TimeMonad m @@ -197,9 +205,9 @@ preverifyTransaction :: BlockItem -> m (Bool, TVer.VerificationResult) preverifyTransaction bi = - gets (lookupLiveTransaction (getHash bi)) >>= \case + gets (Impl.lookupLiveTransaction (getHash bi)) >>= \case Nothing -> do - lastFinState <- bpState <$> use lastFinalized + lastFinState <- bpState <$> use Impl.lastFinalized chainParams <- Concordium.GlobalState.BlockState.getChainParameters lastFinState let ctx = Context @@ -217,7 +225,7 @@ preverifyTransaction bi = -- | Add a transaction to the transaction table that has already been successfully verified. addPreverifiedTransaction :: ( BlockStateQuery m, - MonadState (SkovData (MPV m)) m, + MonadState (Impl.SkovData (MPV m)) m, GSTypes.BlockState m ~ PBS.HashedPersistentBlockState (MPV m), TimeMonad m ) => @@ -225,13 +233,27 @@ addPreverifiedTransaction :: TVer.OkResult -> m AddTransactionResult addPreverifiedTransaction bi okRes = do - added <- addTransaction 0 bi $! TVer.Ok okRes - if added + -- 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. + isNonceOk <- case wmdData bi of + NormalTransaction tr -> do + lfbState <- use (Impl.lastFinalized . to bpState) + mAcc <- getAccount lfbState $ transactionSender tr + nonce <- maybe (pure minNonce) getAccountNonce (snd <$> mAcc) + return $! nonce <= transactionNonce tr + -- the sequence number will be checked by @Impl.addTransaction@. + _ -> return True + if isNonceOk then do - addPendingTransaction bi - return $! Added bi $! TVer.Ok okRes - else -- If the transaction was not added it means it contained an old nonce. - return ObsoleteNonce + added <- Impl.addTransaction 0 bi $! TVer.Ok okRes + if added + then do + addPendingTransaction bi + return $! Added bi $! TVer.Ok okRes + else -- If the (chain update) transaction was not added it means it contained an old nonce. + return ObsoleteNonce + else return ObsoleteNonce -- | Process the 'BlockItem's of a 'BakedBlock', verifying them and adding them to the transaction -- table and pending transactions, marking them as committed for the block. If any of the @@ -245,7 +267,7 @@ processBlockItems :: forall m pv. ( MonadProtocolVersion m, IsConsensusV1 pv, - MonadState (SkovData pv) m, + MonadState (Impl.SkovData pv) m, BlockStateQuery m, TimeMonad m, MPV m ~ pv, @@ -283,14 +305,14 @@ processBlockItems bb parentPointer = do ContT (Maybe r) m (BlockItem, TVer.VerificationResult) process verificationContext bi = ContT $ \continue -> do let txHash = getHash bi - tt' <- gets' _transactionTable + tt' <- gets' Impl._transactionTable -- Check whether we already have the transaction. case tt' ^. TT.ttHashMap . at' txHash of Just (bi', results) -> do -- If we have received the transaction before we update the maximum committed round -- if the new round is higher. when (TT.commitPoint theRound > results ^. TT.tsCommitPoint) $ - transactionTable . TT.ttHashMap . at' txHash . mapped . _2 %=! TT.updateCommitPoint theRound + Impl.transactionTable . TT.ttHashMap . at' txHash . mapped . _2 %=! TT.updateCommitPoint theRound continue (bi', results ^. TT.tsVerRes) Nothing -> do -- We verify the transaction and check whether it's acceptable i.e. Ok or MaybeOk. @@ -305,7 +327,7 @@ processBlockItems bb parentPointer = do -- when processing transactions which originate from a block. -- We add it to the transaction table and continue with the next transaction. acceptedRes -> do - addOK <- addTransaction theRound bi acceptedRes + addOK <- Impl.addTransaction theRound bi acceptedRes -- If the transaction was obsolete, we stop processing transactions. if addOK then do diff --git a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Implementation.hs b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Implementation.hs index e38f3db0fa..19427a7f47 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Implementation.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Implementation.hs @@ -30,6 +30,7 @@ import Control.Monad.Reader import Control.Monad.State import Data.Foldable import Data.IORef +import Data.Maybe (fromMaybe) import Data.Time import Data.Typeable import GHC.Stack @@ -56,13 +57,11 @@ import qualified Concordium.GlobalState.Persistent.BlockState as PBS import Concordium.GlobalState.Persistent.TreeState (DeadCache, emptyDeadCache, insertDeadCache, memberDeadCache) import qualified Concordium.GlobalState.PurgeTransactions as Purge import qualified Concordium.GlobalState.Statistics as Stats -import Concordium.GlobalState.TransactionTable import qualified Concordium.GlobalState.TransactionTable as TT import qualified Concordium.GlobalState.Types as GSTypes import qualified Concordium.KonsensusV1.TreeState.LowLevel as LowLevel import Concordium.KonsensusV1.TreeState.Types import Concordium.KonsensusV1.Types -import Concordium.TransactionVerification import qualified Concordium.TransactionVerification as TVer -- | Exception occurring from a violation of tree state invariants. @@ -289,9 +288,9 @@ mkInitialSkovData :: -- | Bakers at the genesis block EpochBakers -> -- | 'TransactionTable' to initialize the 'SkovData' with. - TransactionTable -> + TT.TransactionTable -> -- | 'PendingTransactionTable' to initialize the 'SkovData' with. - PendingTransactionTable -> + TT.PendingTransactionTable -> -- | The initial 'SkovData' SkovData pv mkInitialSkovData rp genMeta genState _currentTimeout _skovEpochBakers transactionTable' pendingTransactionTable' = @@ -742,20 +741,26 @@ getNonFinalizedCredential txhash sd = do -- that there are no pending or committed (but only finalized) transactions -- tied to this account. getNextAccountNonce :: + ( BlockStateQuery m, + GSTypes.BlockState m ~ PBS.HashedPersistentBlockState (MPV m) + ) => -- | The 'AccountAddressEq' to get the next available nonce for. -- This will work for account aliases as this is an 'AccountAddressEq' -- and not just a 'AccountAddress'. AccountAddressEq -> -- | The 'SkovData pv' to query the next account nonce from. - SkovData pv -> + SkovData (MPV m) -> -- | The resulting account nonce and whether it is finalized or not. - (Nonce, Bool) -getNextAccountNonce addr sd = case sd ^. transactionTable . TT.ttNonFinalizedTransactions . at' addr of - Nothing -> (minNonce, True) - Just anfts -> - case Map.lookupMax (anfts ^. TT.anftMap) of - Nothing -> (anfts ^. TT.anftNextNonce, True) - Just (nonce, _) -> (nonce + 1, False) + m (Nonce, Bool) +getNextAccountNonce addr sd = + maybe fetchFromLastFinalizedBlock return fetchFromTransactionTable + where + fetchFromTransactionTable = (,False) <$> TT.nextAccountNonce addr (sd ^. transactionTable) + fetchFromLastFinalizedBlock = do + macct <- getAccount (sd ^. lastFinalized . to bpState) (aaeAddress addr) + nextNonce <- fromMaybe minNonce <$> mapM (getAccountNonce . snd) macct + return (nextNonce, True) +{-# INLINE getNextAccountNonce #-} -- | Finalizes a list of transactions in the in-memory transaction table. -- This removes the transactions (and any others with the same account and nonce, or update type @@ -765,7 +770,9 @@ getNextAccountNonce addr sd = case sd ^. transactionTable . TT.ttNonFinalizedTra -- nonce. This does not write the transactions to the low-level tree state database, but just -- updates the in-memory transaction table accordingly. finalizeTransactions :: - (MonadState (SkovData pv) m, MonadThrow m) => + ( MonadState (SkovData pv) m, + MonadThrow m + ) => -- | The transactions to remove from the state. [BlockItem] -> m () @@ -775,15 +782,6 @@ finalizeTransactions = mapM_ removeTrans let nonce = transactionNonce tr sender = accountAddressEmbed (transactionSender tr) anft <- use (transactionTable . TT.ttNonFinalizedTransactions . at' sender . non TT.emptyANFT) - unless (anft ^. TT.anftNextNonce == nonce) $ - throwM . TreeStateInvariantViolation $ - "The recorded next nonce for the account " - ++ show sender - ++ " (" - ++ show (anft ^. TT.anftNextNonce) - ++ ") doesn't match the one that is going to be finalized (" - ++ show nonce - ++ ")" let nfn = anft ^. TT.anftMap . at' nonce . non Map.empty wmdtr = WithMetadata{wmdData = tr, ..} unless (Map.member wmdtr nfn) $ @@ -796,15 +794,11 @@ finalizeTransactions = mapM_ removeTrans -- They can never be part of any other block after this point. forM_ (Map.keys nfn) $ \deadTransaction -> transactionTable . TT.ttHashMap . at' (getHash deadTransaction) .= Nothing - -- Update the non-finalized transactions for the sender - transactionTable - . TT.ttNonFinalizedTransactions - . at' sender - ?=! ( anft - & (TT.anftMap . at' nonce .~ Nothing) - & (TT.anftNextNonce .~ nonce + 1) - ) - removeTrans WithMetadata{wmdData = CredentialDeployment{}, ..} = + -- 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@. + transactionTable %=! TT.finalizeTransactionAt sender nonce + removeTrans WithMetadata{wmdData = CredentialDeployment{}, ..} = do transactionTable . TT.ttHashMap . at' wmdHash .= Nothing removeTrans WithMetadata{wmdData = ChainUpdate cu, ..} = do let sn = updateSeqNumber (uiHeader cu) @@ -860,12 +854,21 @@ commitTransaction rnd bh ti transaction = . _2 %=! TT.addResult bh rnd ti --- | Add a transaction to the transaction table if its nonce/sequence number is at least the next --- non-finalized nonce/sequence number. The return value is 'True' if and only if the transaction +-- | Add a transaction to the transaction table. +-- For chain updates it is checked that the sequence number is at least the next +-- non-finalized sequence number. +-- Nothing is checked for normal transactions. This is ok as they have +-- been verified before this is called. +-- The return value is 'True' if and only if the transaction -- was added. -- When adding a transaction from a block, use the 'Round' of the block. Otherwise use round @0@. -- The transaction must not already be present. -addTransaction :: (MonadState (SkovData pv) m) => Round -> BlockItem -> VerificationResult -> m Bool +addTransaction :: + (MonadState (SkovData pv) m) => + Round -> + BlockItem -> + TVer.VerificationResult -> + m Bool addTransaction rnd transaction verRes = do added <- transactionTable %%=! TT.addTransaction transaction (TT.commitPoint rnd) verRes when added $ transactionTablePurgeCounter += 1 diff --git a/concordium-consensus/src/Concordium/Queries.hs b/concordium-consensus/src/Concordium/Queries.hs index 144ca513e9..59a18dea7d 100644 --- a/concordium-consensus/src/Concordium/Queries.hs +++ b/concordium-consensus/src/Concordium/Queries.hs @@ -659,7 +659,7 @@ getNextAccountNonce accountAddress = ) -- consensus v1 ( do - (nanNonce, nanAllFinal) <- gets (SkovV1.getNextAccountNonce acctEq) + (nanNonce, nanAllFinal) <- SkovV1.getNextAccountNonce acctEq =<< get return NextAccountNonce{..} ) where diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs new file mode 100644 index 0000000000..dcf4a2b255 --- /dev/null +++ b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE NumericUnderscores #-} + +-- | End to end test that check transaction table is as expected while the tree state processes blocks. +module ConcordiumTests.EndToEnd.TransactionTableIntegrationTest (tests) where + +import Control.Monad.IO.Class +import Control.Monad.State +import Data.Time.Clock.POSIX +import qualified Data.Vector as Vec +import Lens.Micro.Platform +import Test.HUnit +import Test.Hspec + +import qualified Concordium.GlobalState.TransactionTable as TT +import Concordium.KonsensusV1.TestMonad +import Concordium.KonsensusV1.TreeState.Implementation +import Concordium.KonsensusV1.Types +import Concordium.Types +import Concordium.Types.Execution +import Concordium.Types.Option +import Concordium.Types.Transactions + +import ConcordiumTests.KonsensusV1.Consensus.Blocks hiding (testBB1, testBB2, testBB2', testBB3, testBB3', tests) + +-- | Make a raw transfer transaction with the provided nonce. +mkTransferTransaction :: Nonce -> BareBlockItem +mkTransferTransaction nonce = NormalTransaction{biTransaction = signTransactionSingle foundationKeyPair mkHeader payload} + where + mkHeader = + TransactionHeader + { thSender = foundationAccountAddress, + thNonce = nonce, + thEnergyAmount = 1000000, + thPayloadSize = payloadSize payload, + thExpiry = 10000 + } + payload = encodePayload $ Transfer foundationAccountAddress 10 + +-- | A transfer with nonce 1 for testBB1 +transfer1 :: BlockItem +transfer1 = normalTransaction $ addMetadata (\x -> NormalTransaction{biTransaction = x}) 1000 (biTransaction $ mkTransferTransaction 1) + +-- | A transfer with nonce 2 for testBB4 +transfer2 :: BlockItem +transfer2 = normalTransaction $ addMetadata (\x -> NormalTransaction{biTransaction = x}) 1001 (biTransaction $ mkTransferTransaction 2) + +-- | Valid block for round 1 with 1 normal transfer +testBB1 :: BakedBlock +testBB1 = + BakedBlock + { bbRound = 1, + bbEpoch = 0, + bbTimestamp = 1_000, + bbBaker = bakerId, + bbQuorumCertificate = genesisQuorumCertificate genesisHash, + bbTimeoutCertificate = Absent, + bbEpochFinalizationEntry = Absent, + bbNonce = computeBlockNonce genesisLEN 1 (bakerVRFKey bakerId), + bbTransactions = Vec.fromList [transfer1], + bbTransactionOutcomesHash = read "13907ff30e010398b3438b73a55f6fd02177d653527aafb6b77360a646cb938c", + bbStateHash = read "84d5b24177c60db5fb17f62a5cc93a500afc6565977f080cbd9260a68be66925" + } + where + bakerId = 2 + +-- | Valid block for round 2. +-- This block carries a QC for 'testBB1' thus certifying it. +testBB2 :: BakedBlock +testBB2 = + BakedBlock + { bbRound = 2, + bbEpoch = 0, + bbTimestamp = 3_000, + bbBaker = bakerId, + bbQuorumCertificate = validQCFor testBB1, + bbTimeoutCertificate = Absent, + bbEpochFinalizationEntry = Absent, + bbNonce = computeBlockNonce genesisLEN 2 (bakerVRFKey bakerId), + bbTransactions = Vec.empty, + bbTransactionOutcomesHash = read "f840ea702e095175b8c2fceacc2377d5d2d0be867350bc0bdd8c6d56ee14797c", + bbStateHash = read "0b286c7356d7c69717e42b39fc3cabf2fd82dbc4713f2e752084b1b9e2c5bdb8" + } + where + bakerId = 4 + +-- | Valid block for round 3, finalizes 'testBB1' as this block +-- carries a QC for 'testBB2'. +testBB3 :: BakedBlock +testBB3 = + BakedBlock + { bbRound = 3, + bbEpoch = 0, + bbTimestamp = 5_000, + bbBaker = bakerId, + bbQuorumCertificate = validQCFor testBB2, + bbTimeoutCertificate = Absent, + bbEpochFinalizationEntry = Absent, + bbNonce = computeBlockNonce genesisLEN 3 (bakerVRFKey bakerId), + bbTransactions = Vec.empty, + bbTransactionOutcomesHash = read "9bbf1ab9edd3744bc88dfc0a6aa87a89dc51765d9a4b57bc8c7c49b1fb151099", + bbStateHash = read "80d087748edeea46b7d0b8f25c8fb50bb015b498c11eeb03e8efe8b59e7d40f9" + } + where + bakerId = 4 + +-- | Valid block for round 4 with 1 normal transfer +testBB4 :: BakedBlock +testBB4 = + BakedBlock + { bbRound = 4, + bbEpoch = 0, + bbTimestamp = 7_000, + bbBaker = bakerId, + bbQuorumCertificate = validQCFor testBB3, + bbTimeoutCertificate = Absent, + bbEpochFinalizationEntry = Absent, + bbNonce = computeBlockNonce genesisLEN 4 (bakerVRFKey bakerId), + bbTransactions = Vec.fromList [transfer2], + bbTransactionOutcomesHash = read "d46c011009b5315c7cd32bb1345bd2e73a3cd6111a7e4d06c33e863f16c8c8bd", + bbStateHash = read "a47ca3a8412ad577df94ae8ebc288f8972a499ce5315033bfc2f2c18ce00bfb8" + } + where + bakerId = 3 + +-- | Test that the @getNextAccountNonce@ returns correctly when adding a new transaction for an account A, after +-- some prior transactions for account A has been finalized (and the transaction table is fully purged). +testAccountNonce :: Assertion +testAccountNonce = runTestMonad noBaker testTime genesisData $ do + nonce <- getNextAccountNonce sender =<< get + liftIO $ + assertEqual + "Transaction is not received" + (1, True) + nonce + let b1 = signedPB testBB1 + succeedReceiveBlock b1 + let b2 = signedPB testBB2 + succeedReceiveBlock b2 + + nonce' <- getNextAccountNonce sender =<< get + liftIO $ + assertEqual + "Transaction is in non-finalized transactions" + (2, False) + nonce' + + let b3 = signedPB testBB3 + succeedReceiveBlock b3 + -- transaction in b1 is now finalized and we force purge the table so + -- sender is expunged from transaction table. + purgeTransactionTable True (posixSecondsToUTCTime 1) + sd <- get + nonce'' <- getNextAccountNonce sender sd + liftIO $ + assertEqual + "first transaction should be finalized" + (2, True) + nonce'' + liftIO $ + assertEqual + "transaction should not be in the anft map for the sender anymore" + Nothing + (sd ^? transactionTable . TT.ttNonFinalizedTransactions . ix sender) + + let b4 = signedPB testBB4 + succeedReceiveBlock b4 + nonce''' <- getNextAccountNonce sender =<< get + liftIO $ + assertEqual + "sender should be present in tt again and anftNextNonce is correctly set" + (3, False) + nonce''' + where + sender = accountAddressEmbed foundationAccountAddress + +tests :: Spec +tests = describe "EndToEndTests.TransactionTableIntegrationTest" $ do + it "account nonce test" testAccountNonce diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs index fab6774f13..f96864dd21 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs @@ -22,6 +22,7 @@ import Test.Hspec import qualified Concordium.Crypto.DummyData as Dummy import qualified Concordium.Crypto.SHA256 as H +import Concordium.Crypto.SignatureScheme as Sig import Concordium.Genesis.Data import Concordium.Types import Concordium.Types.BakerIdentity @@ -75,8 +76,16 @@ bakers :: [(BakerIdentity, FullBakerInfo)] foundationAcct = Dummy.createCustomAccount 1_000_000_000_000 - (Dummy.deterministicKP 0) - (Dummy.accountAddressFrom 0) + foundationKeyPair + foundationAccountAddress + +-- | Key pair for the foundation account +foundationKeyPair :: Sig.KeyPair +foundationKeyPair = Dummy.deterministicKP 0 + +-- | Account address for the foundation account +foundationAccountAddress :: AccountAddress +foundationAccountAddress = Dummy.accountAddressFrom 0 -- | Hash of the genesis block. genesisHash :: BlockHash diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs index 0d2a3adc77..e046f24afe 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs @@ -13,9 +13,9 @@ -- The module 'ConcordiumTests.ReceiveTransactionsTest' contains more fine grained tests -- for each individual type of transaction, this is ok since the two -- consensus implementations share the same transaction verifier. -module ConcordiumTests.KonsensusV1.TransactionProcessingTest (tests) where +module ConcordiumTests.KonsensusV1.TransactionProcessingTest where -import qualified Concordium.Crypto.SHA256 as Hash +import Control.Monad.Catch import Control.Monad.Reader import Control.Monad.State import qualified Data.Aeson as AE @@ -37,6 +37,7 @@ import Test.Hspec import Concordium.Common.Version import Concordium.Crypto.DummyData +import qualified Concordium.Crypto.SHA256 as Hash import qualified Concordium.Crypto.SignatureScheme as SigScheme import qualified Concordium.Crypto.VRF as VRF import Concordium.Genesis.Data hiding (GenesisConfiguration) @@ -120,7 +121,7 @@ dummyCredentialDeploymentHash = getHash dummyCredentialDeployment -- | A monad for deriving 'MonadTime' by means of a provided time. newtype FixedTimeT (m :: Type -> Type) a = FixedTime {runDeterministic :: UTCTime -> m a} - deriving (Functor, Applicative, Monad, MonadIO) via ReaderT UTCTime m + deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch) via ReaderT UTCTime m deriving (MonadTrans) via ReaderT UTCTime instance (Monad m) => TimeMonad (FixedTimeT m) where @@ -131,7 +132,7 @@ instance (MonadReader r m) => MonadReader r (FixedTimeT m) where local f (FixedTime k) = FixedTime $ local f . k newtype NoLoggerT m a = NoLoggerT {runNoLoggerT :: m a} - deriving (Functor, Applicative, Monad, MonadIO, MonadReader r, MonadFail, TimeMonad, MonadState s) + deriving (Functor, Applicative, Monad, MonadIO, MonadReader r, MonadFail, TimeMonad, MonadState s, MonadThrow, MonadCatch) instance (Monad m) => MonadLogger (NoLoggerT m) where logEvent _ _ _ = return () diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs index d84a32e079..c96e4fea5e 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs @@ -82,7 +82,7 @@ import qualified Concordium.Crypto.SHA256 as Hash import qualified Concordium.Crypto.SignatureScheme as SigScheme import qualified Concordium.Crypto.VRF as VRF import Concordium.Genesis.Data.BaseV1 -import Concordium.GlobalState.TransactionTable (emptyPendingTransactionTable, emptyTransactionTable) +import qualified Concordium.GlobalState.DummyData as Dummy import Concordium.Scheduler.DummyData import Concordium.Types import Concordium.Types.Execution @@ -106,6 +106,8 @@ import qualified Concordium.TransactionVerification as TVer import Concordium.Types.Option import Concordium.Types.Updates +import qualified ConcordiumTests.KonsensusV1.TransactionProcessingTest as Helper + -- We derive these instances here so we don't accidentally end up using them in production. -- We have them because they are very convenient for testing purposes. deriving instance Eq (BlockStatus pv) @@ -297,8 +299,8 @@ dummyInitialSkovData = dummyBlockState 10_000 dummyEpochBakers - emptyTransactionTable - emptyPendingTransactionTable + TT.emptyTransactionTable + TT.emptyPendingTransactionTable -- | A 'LowLevelDB' for testing purposes. newtype TestLLDB pv = TestLLDB {theTestLLDB :: IORef (LowLevelDB pv)} @@ -491,8 +493,8 @@ dummyAccountAddress = dummyAccountAddressN 0 -- in this file. -- Note that the tests presented in this module -- does no transaction processing i.e. verification of the transaction. -dummyTransaction :: Nonce -> Transaction -dummyTransaction n = +dummyTransaction' :: AccountAddress -> Nonce -> Transaction +dummyTransaction' accAddr n = addMetadata NormalTransaction 0 $ makeAccountTransaction dummyTransactionSignature @@ -501,7 +503,7 @@ dummyTransaction n = where hdr = TransactionHeader - { thSender = dummyAccountAddress, + { thSender = accAddr, thPayloadSize = payloadSize payload, thNonce = n, thExpiry = 500, @@ -509,6 +511,9 @@ dummyTransaction n = } payload = encodePayload $ Transfer dummyAccountAddress 10 +dummyTransaction :: Nonce -> Transaction +dummyTransaction = dummyTransaction' dummyAccountAddress + dummyTransactionBI :: Nonce -> BlockItem dummyTransactionBI = normalTransaction . dummyTransaction @@ -714,16 +719,23 @@ testGetNonFinalizedCredential = describe "getNonFinalizedCredential" $ do -- the correct next account nonce. testGetNextAccountNonce :: Spec testGetNextAccountNonce = describe "getNextAccountNonce" $ do - it "with non-finalized" $ - getNextAccountNonce (accountAddressEmbed dummyAccountAddress) sd - `shouldBe` (4, False) - it "with no transactions" $ - getNextAccountNonce (accountAddressEmbed (dummyAccountAddressN 1)) sd - `shouldBe` (minNonce, True) - it "with finalized transactions" $ - getNextAccountNonce (accountAddressEmbed (dummyAccountAddressN 2)) sd - `shouldBe` (7, True) + it "with non-finalized" $ do + void $ runTestWithBS $ do + n0 <- getNextAccountNonce (accountAddressEmbed dummyAccountAddress) sd + liftIO $ n0 `shouldBe` (4, False) + it "with no transactions" $ do + void $ runTestWithBS $ do + n1 <- getNextAccountNonce (accountAddressEmbed (dummyAccountAddressN 1)) sd + liftIO $ n1 `shouldBe` (minNonce, True) + it "with finalized transactions" $ do + void $ runTestWithBS $ do + n2 <- getNextAccountNonce (accountAddressEmbed (dummyAccountAddressN 2)) sd + liftIO $ n2 `shouldBe` (1, True) where + -- Run the computation via the helper test monad. + -- Note that tests are run via some other skov data than the default one of the + -- test monad. This is fine as we do not rely on the underlying block state. + runTestWithBS = Helper.runMyTestMonad Dummy.dummyIdentityProviders (timestampToUTCTime 1) addTrans n = snd . TT.addTransaction (dummyTransactionBI n) 0 (dummySuccessTransactionResult n) sd = dummyInitialSkovData @@ -731,7 +743,7 @@ testGetNextAccountNonce = describe "getNextAccountNonce" $ do %~ addTrans 2 . addTrans 3 . ( TT.ttNonFinalizedTransactions . at (accountAddressEmbed (dummyAccountAddressN 2)) - ?~ TT.emptyANFTWithNonce 7 + ?~ TT.emptyANFT ) -- | Testing 'finalizeTransactions'. @@ -748,7 +760,7 @@ testRemoveTransactions = describe "finalizeTransactions" $ do sd' <- execStateT (finalizeTransactions [normalTransaction tr0]) sd assertEqual "Account non-finalized transactions" - (Just TT.AccountNonFinalizedTransactions{_anftNextNonce = 2, _anftMap = Map.singleton 2 (Map.singleton tr1 (dummySuccessTransactionResult 2))}) + (Just TT.AccountNonFinalizedTransactions{_anftMap = Map.singleton 2 (Map.singleton tr1 (dummySuccessTransactionResult 2))}) (sd' ^. transactionTable . TT.ttNonFinalizedTransactions . at sender) assertEqual "transaction hash map" @@ -819,7 +831,7 @@ testAddTransaction = describe "addTransaction" $ do sd' <- execStateT (addTransaction tr0Round (normalTransaction tr0) (dummySuccessTransactionResult 1)) dummyInitialSkovData assertEqual "Account non-finalized transactions" - (Just TT.AccountNonFinalizedTransactions{_anftNextNonce = 1, _anftMap = Map.singleton 1 (Map.singleton tr0 (dummySuccessTransactionResult 1))}) + (Just TT.AccountNonFinalizedTransactions{_anftMap = Map.singleton 1 (Map.singleton tr0 (dummySuccessTransactionResult 1))}) (sd' ^. transactionTable . TT.ttNonFinalizedTransactions . at sender) assertEqual "transaction hash map" @@ -830,11 +842,12 @@ testAddTransaction = describe "addTransaction" $ do (1 + dummyInitialSkovData ^. transactionTablePurgeCounter) (sd' ^. transactionTablePurgeCounter) sd'' <- execStateT (finalizeTransactions [normalTransaction tr0]) sd' - added <- evalStateT (addTransaction tr0Round (normalTransaction tr0) (dummySuccessTransactionResult 1)) sd'' - assertEqual "tx should not be added" False added + added <- evalStateT (addTransaction tr0Round (normalTransaction tr1) (dummySuccessTransactionResult 1)) sd'' + assertEqual "tx should be added" True added where tr0Round = 1 tr0 = dummyTransaction 1 + tr1 = dummyTransaction 2 sender = accountAddressEmbed dummyAccountAddress -- | Test of 'commitTransaction'. @@ -905,7 +918,7 @@ testPurgeTransactionTable = describe "purgeTransactionTable" $ do (sd'' ^. transactionTablePurgeCounter) assertEqual "Account non-finalized transactions" - (Just $ TT.AccountNonFinalizedTransactions{_anftMap = Map.empty, _anftNextNonce = 1}) + Nothing (sd'' ^. transactionTable . TT.ttNonFinalizedTransactions . at sender) assertEqual "Chain update non-finalized transactions" diff --git a/concordium-consensus/tests/consensus/Spec.hs b/concordium-consensus/tests/consensus/Spec.hs index fb31005530..950e51696a 100644 --- a/concordium-consensus/tests/consensus/Spec.hs +++ b/concordium-consensus/tests/consensus/Spec.hs @@ -8,6 +8,7 @@ import qualified ConcordiumTests.Afgjort.Lottery (tests) import qualified ConcordiumTests.Afgjort.Types (tests) import qualified ConcordiumTests.Afgjort.WMVBA (tests) import qualified ConcordiumTests.EndToEnd.CredentialDeploymentTests (tests) +import qualified ConcordiumTests.EndToEnd.TransactionTableIntegrationTest (tests) import qualified ConcordiumTests.FinalizationRecover (test) import qualified ConcordiumTests.KonsensusV1.CatchUp (tests) import qualified ConcordiumTests.KonsensusV1.Consensus (tests) @@ -65,3 +66,4 @@ main = atLevel $ \lvl -> hspec $ do ConcordiumTests.KonsensusV1.Consensus.Blocks.tests ConcordiumTests.KonsensusV1.CatchUp.tests ConcordiumTests.EndToEnd.CredentialDeploymentTests.tests lvl + ConcordiumTests.EndToEnd.TransactionTableIntegrationTest.tests