Merge pull request #980 from Concordium/fix-979

Retroactively fix chain update handling.

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.

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)

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

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"