diff --git a/CHANGELOG.md b/CHANGELOG.md index 9d9ed71b00..1a8cf06f58 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,11 @@ ## Unreleased changes +- Apply fix for processing of chain parameter updates when they occur at the same time + retroactively to all protocol versions. This may break compatibility with any local/private + chains on which the bug occurs. +- Remove the concept of pending blocks. + ## 6.1.0 - `GetPoolInfo` now also returns the commission rates for the current reward period. @@ -21,8 +26,6 @@ - Add debug-level logging when a round is advanced, either due to a quorum certificate or a timeout certificate. -- Remove the concept of pending blocks. - ## 6.0.4 - Fix a bug in how timeout certificates across epoch boundaries are handled in catch-up. diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 50bec671c0..d0c800c3f0 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -2777,7 +2777,7 @@ doProcessUpdateQueues :: doProcessUpdateQueues pbs ts = do bsp <- loadPBS pbs let (u, ars, ips) = (bspUpdates bsp, bspAnonymityRevokers bsp, bspIdentityProviders bsp) - (changes, (u', ars', ips')) <- processUpdateQueues (protocolVersion @pv) ts (u, ars, ips) + (changes, (u', ars', ips')) <- processUpdateQueues ts (u, ars, ips) (changes,) <$> storePBS pbs bsp{bspUpdates = u', bspAnonymityRevokers = ars', bspIdentityProviders = ips'} doProcessReleaseSchedule :: forall m pv. (SupportsPersistentState pv m) => PersistentBlockState pv -> Timestamp -> m (PersistentBlockState pv) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Updates.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Updates.hs index 5c03f74cd9..b57185eb5f 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Updates.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Updates.hs @@ -1416,16 +1416,14 @@ type UpdatesWithARsAndIPs (cpv :: ChainParametersVersion) = (BufferedRef (Updates' cpv), HashedBufferedRef ARS.AnonymityRevokers, HashedBufferedRef IPS.IdentityProviders) -- |Process all update queues. This returns a list of the updates that occurred, with their times, --- ordered by the time. (Note: for protocol versions @<= 'P5'@, this list may omit entries with --- duplicate time stamps.) +-- ordered by the time. processUpdateQueues :: - forall m pv. - (MonadBlobStore m, IsChainParametersVersion (ChainParametersVersionFor pv)) => - SProtocolVersion pv -> + forall m cpv. + (MonadBlobStore m, IsChainParametersVersion cpv) => Timestamp -> - UpdatesWithARsAndIPs (ChainParametersVersionFor pv) -> - m ([(TransactionTime, UpdateValue (ChainParametersVersionFor pv))], UpdatesWithARsAndIPs (ChainParametersVersionFor pv)) -processUpdateQueues spv t (u0, ars, ips) = do + UpdatesWithARsAndIPs cpv -> + m ([(TransactionTime, UpdateValue cpv)], UpdatesWithARsAndIPs cpv) +processUpdateQueues t (u0, ars, ips) = do (ms, u1) <- combine [ processRootKeysUpdates t, @@ -1455,29 +1453,18 @@ processUpdateQueues spv t (u0, ars, ips) = do -- Collect all the updates. Note that we need to reverse the list -- since combine returns one in reverse order of the input actions. let allUpdates = reverse (m3 : m2 : ms) - -- In protocol versions <= 5 there was a bug where we only returned the - -- first update for a given time, since a map from transaction time was - -- returned. See https://github.com/Concordium/concordium-node/issues/972 - -- We fix this in protocol 6. - if demoteProtocolVersion spv >= P6 - then do - -- foldr is reasonable here since we are producing a list - -- that will be traversed. And the merge function is lazy in the sense - -- that it will produce output without consuming the whole input in general. - let updates = List.foldr (merge . Map.toAscList) [] allUpdates - return (updates, (u3, ars', ips')) - else do - -- The cause of the bug is here since the monoid operation for maps is - -- left-biased union. So only updates from the first update (in the - -- order of the list of actions above) remains. - return (Map.toAscList (mconcat allUpdates), (u3, ars', ips')) + -- foldr is reasonable here since we are producing a list + -- that will be traversed. And the merge function is lazy in the sense + -- that it will produce output without consuming the whole input in general. + let updates = List.foldr (merge . Map.toAscList) [] allUpdates + return (updates, (u3, ars', ips')) where -- Combine all the updates in sequence from left to right. -- The return value is the final state of updates, and the list of -- updates. The list is in **reverse** order of the input list. combine :: - [BufferedRef (Updates' (ChainParametersVersionFor pv)) -> m (r, BufferedRef (Updates' (ChainParametersVersionFor pv)))] -> - m ([r], BufferedRef (Updates' (ChainParametersVersionFor pv))) + [BufferedRef (Updates' cpv) -> m (r, BufferedRef (Updates' cpv))] -> + m ([r], BufferedRef (Updates' cpv)) combine = foldM ( \(ms, updates) action -> do diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/UpdateQueues.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/UpdateQueues.hs index 7fa6fedb42..1698109c22 100644 --- a/concordium-consensus/tests/globalstate/GlobalStateTests/UpdateQueues.hs +++ b/concordium-consensus/tests/globalstate/GlobalStateTests/UpdateQueues.hs @@ -18,54 +18,40 @@ import Concordium.GlobalState.Persistent.BlobStore import qualified Concordium.GlobalState.Persistent.BlockState.Updates as PU import Concordium.Types --- This is a regression test for https://github.com/Concordium/concordium-node/issues/972 --- In protocol version 1-5 the chain parameter update effects were sometimes lost --- if they were effective at the same time. This is fixed in protocol 6. -testCase :: forall pv. IsProtocolVersion pv => SProtocolVersion pv -> String -> IO () -testCase spv pvString = do +-- This tests that chain parameter updates that are scheduled at the same time are not lost +-- when calling 'PU.processUpdateQueues'. +testCase :: forall cpv. IsChainParametersVersion cpv => SChainParametersVersion cpv -> String -> IO () +testCase scpv pvString = do -- Schedule three updates let rootKeyUpdate = UVRootKeys dummyHigherLevelKeys - let poolParameterUpdate = UVPoolParameters (dummyChainParameters @(ChainParametersVersionFor pv) ^. cpPoolParameters) - let euroEnergyExchange = UVEuroPerEnergy (_erEuroPerEnergy (dummyChainParameters @(ChainParametersVersionFor pv) ^. cpExchangeRates)) + let poolParameterUpdate = UVPoolParameters (dummyChainParameters @cpv ^. cpPoolParameters) + let euroEnergyExchange = UVEuroPerEnergy (_erEuroPerEnergy (dummyChainParameters @cpv ^. cpExchangeRates)) -- The first two are scheduled at effectiveTime = 123 -- The last one is schedule for a millisecond earlier. let effectiveTime = 123 :: TransactionTime effects <- liftIO . runBlobStoreTemp "." $ do - u1 <- refMake =<< PU.initialUpdates (withIsAuthorizationsVersionForPV spv dummyKeyCollection) dummyChainParameters + (u1 :: BufferedRef (PU.Updates' cpv)) <- + refMake + =<< PU.initialUpdates (withIsAuthorizationsVersionFor scpv dummyKeyCollection) dummyChainParameters enqueuedState <- PU.enqueueUpdate effectiveTime poolParameterUpdate =<< PU.enqueueUpdate (effectiveTime - 1) euroEnergyExchange =<< PU.enqueueUpdate effectiveTime rootKeyUpdate u1 ars <- refMake dummyArs ips <- refMake dummyIdentityProviders - fst <$> PU.processUpdateQueues (protocolVersion @pv) (transactionTimeToTimestamp effectiveTime) (enqueuedState, ars, ips) - -- In protocol version <= 5 the pool parameter update is not returned, since it occurs - -- at the same time as the root keys update. - if demoteProtocolVersion spv <= P5 - then - assertEqual - (pvString ++ ": Only the root key update is returned at effectiveTime") - [ (effectiveTime - 1, euroEnergyExchange), - (effectiveTime, rootKeyUpdate) - ] - effects - else -- In P6 and up all updates are returned. - - assertEqual - (pvString ++ ": All updates should be returned") - [ (effectiveTime - 1, euroEnergyExchange), - (effectiveTime, rootKeyUpdate), - (effectiveTime, poolParameterUpdate) - ] - effects + fst <$> PU.processUpdateQueues (transactionTimeToTimestamp effectiveTime) (enqueuedState, ars, ips) + assertEqual + (pvString ++ ": All updates should be returned") + [ (effectiveTime - 1, euroEnergyExchange), + (effectiveTime, rootKeyUpdate), + (effectiveTime, poolParameterUpdate) + ] + effects tests :: Spec tests = do describe "Scheduler.UpdateQueues" $ do specify "Correct effects are returned" $ do - testCase SP1 "P1" - testCase SP2 "P2" - testCase SP3 "P3" - testCase SP4 "P4" - testCase SP5 "P5" - testCase SP6 "P6" + testCase SChainParametersV0 "CPV0" + testCase SChainParametersV1 "CPV1" + testCase SChainParametersV2 "CPV2"