Merge pull request #1075 from Concordium/add-protocol-v7

Add protocol version 7

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

@@ -317,6 +317,7 @@ genesisBakerInfoEx spv cp GenesisBaker{..} = case spv of
     SP4 -> binfoV1
     SP5 -> binfoV1
     SP6 -> binfoV1
+    SP7 -> binfoV1
   where
     bkrInfo =
         BakerInfo

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

@@ -135,6 +135,7 @@ blockVersion SP3 = 2
 blockVersion SP4 = 2
 blockVersion SP5 = 2
 blockVersion SP6 = 3
+blockVersion SP7 = 3
 {-# INLINE blockVersion #-}
 
 -- | Type class that supports serialization of a block.

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

@@ -535,6 +535,7 @@ migratePersistentAccount m@StateMigrationParametersP2P3 (PAV0 acc) = PAV0 <$> V0
 migratePersistentAccount m@StateMigrationParametersP3ToP4{} (PAV0 acc) = PAV1 <$> V0.migratePersistentAccount m acc
 migratePersistentAccount m@StateMigrationParametersP4ToP5{} (PAV1 acc) = PAV2 <$> V1.migratePersistentAccountFromV0 m acc
 migratePersistentAccount m@StateMigrationParametersP5ToP6{} (PAV2 acc) = PAV2 <$> V1.migratePersistentAccount m acc
+migratePersistentAccount m@StateMigrationParametersP6ToP7{} (PAV2 acc) = PAV2 <$> V1.migratePersistentAccount m acc
 
 -- | Migrate a 'PersistentBakerInfoRef' between protocol versions according to a state migration.
 migratePersistentBakerInfoRef ::
@@ -551,6 +552,7 @@ migratePersistentBakerInfoRef m@StateMigrationParametersP2P3 (PBIRV0 bir) = PBIR
 migratePersistentBakerInfoRef m@StateMigrationParametersP3ToP4{} (PBIRV0 bir) = PBIRV1 <$> V0.migratePersistentBakerInfoEx m bir
 migratePersistentBakerInfoRef m@StateMigrationParametersP4ToP5{} (PBIRV1 bir) = PBIRV2 <$> V1.migratePersistentBakerInfoExFromV0 m bir
 migratePersistentBakerInfoRef m@StateMigrationParametersP5ToP6{} (PBIRV2 bir) = PBIRV2 <$> V1.migratePersistentBakerInfoEx m bir
+migratePersistentBakerInfoRef m@StateMigrationParametersP6ToP7{} (PBIRV2 bir) = PBIRV2 <$> V1.migratePersistentBakerInfoEx m bir
 
 -- * Conversion
 

concordium-consensus/src/Concordium/GlobalState/Persistent/Account/StructureV1.hs

@@ -106,6 +106,7 @@ migratePersistentBakerInfoEx ::
     t m (PersistentBakerInfoEx (AccountVersionFor pv))
 migratePersistentBakerInfoEx StateMigrationParametersTrivial = migrateReference return
 migratePersistentBakerInfoEx StateMigrationParametersP5ToP6{} = migrateReference return
+migratePersistentBakerInfoEx StateMigrationParametersP6ToP7{} = migrateReference return
 
 -- | Migrate a 'V0.PersistentBakerInfoEx' to a 'PersistentBakerInfoEx'.
 --  See documentation of @migratePersistentBlockState@.
@@ -1354,6 +1355,7 @@ migratePersistentAccount ::
     t m (PersistentAccount (AccountVersionFor pv))
 migratePersistentAccount StateMigrationParametersTrivial acc = migrateV2ToV2 acc
 migratePersistentAccount StateMigrationParametersP5ToP6{} acc = migrateV2ToV2 acc
+migratePersistentAccount StateMigrationParametersP6ToP7{} acc = migrateV2ToV2 acc
 
 -- | Migration for 'PersistentAccount' from 'V0.PersistentAccount'. This supports migration from
 --  'P4' to 'P5'.

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

@@ -147,6 +147,7 @@ migratePersistentEpochBakers migration PersistentEpochBakers{..} = do
             StateMigrationParametersP3ToP4{} -> NoParam
             StateMigrationParametersP4ToP5 -> NoParam
             (StateMigrationParametersP5ToP6 P6.StateMigrationData{..}) -> SomeParam $ P6.updateFinalizationCommitteeParameters migrationProtocolUpdateData
+            StateMigrationParametersP6ToP7{} -> _bakerFinalizationCommitteeParameters
     return
         PersistentEpochBakers
             { _bakerInfos = newBakerInfos,
@@ -298,6 +299,10 @@ migratePersistentActiveDelegators StateMigrationParametersP5ToP6{} = \case
     PersistentActiveDelegatorsV1{..} -> do
         newDelegators <- Trie.migrateTrieN True return adDelegators
         return PersistentActiveDelegatorsV1{adDelegators = newDelegators, ..}
+migratePersistentActiveDelegators StateMigrationParametersP6ToP7{} = \case
+    PersistentActiveDelegatorsV1{..} -> do
+        newDelegators <- Trie.migrateTrieN True return adDelegators
+        return PersistentActiveDelegatorsV1{adDelegators = newDelegators, ..}
 
 emptyPersistentActiveDelegators :: forall av. (IsAccountVersion av) => PersistentActiveDelegators av
 emptyPersistentActiveDelegators =
@@ -346,6 +351,7 @@ migrateTotalActiveCapital StateMigrationParametersP2P3 _ x = x
 migrateTotalActiveCapital (StateMigrationParametersP3ToP4 _) bts TotalActiveCapitalV0 = TotalActiveCapitalV1 bts
 migrateTotalActiveCapital StateMigrationParametersP4ToP5 _ (TotalActiveCapitalV1 bts) = TotalActiveCapitalV1 bts
 migrateTotalActiveCapital StateMigrationParametersP5ToP6{} _ (TotalActiveCapitalV1 bts) = TotalActiveCapitalV1 bts
+migrateTotalActiveCapital StateMigrationParametersP6ToP7{} _ (TotalActiveCapitalV1 bts) = TotalActiveCapitalV1 bts
 
 instance (IsAccountVersion av) => Serialize (TotalActiveCapital av) where
     put TotalActiveCapitalV0 = return ()

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

@@ -149,33 +149,38 @@ migrateSeedState ::
     SeedState (SeedStateVersionFor pv)
 migrateSeedState StateMigrationParametersTrivial{} ss = case ss of
     SeedStateV0{} -> ss -- In consensus v0, seed state update is handled prior to migration
-    SeedStateV1{..} ->
-        SeedStateV1
-            { -- Reset the epoch to 0.
-              ss1Epoch = 0,
-              ss1CurrentLeadershipElectionNonce = newNonce,
-              ss1UpdatedNonce = newNonce,
-              -- We maintain the trigger block time. This forces an epoch transition as soon as possible
-              -- which will effectively substitute for the epoch transition that would have happened
-              -- on the previous consensus, had it not shut down.
-              ss1TriggerBlockTime = ss1TriggerBlockTime,
-              -- We flag the epoch transition as triggered so that the epoch transition will happen
-              -- as soon as possible.
-              ss1EpochTransitionTriggered = True,
-              -- We clear the shutdown flag.
-              ss1ShutdownTriggered = False
-            }
-      where
-        -- We derive the new nonce from the updated nonce on the basis that it was fixed
-        -- at the trigger block from the previous consensus.
-        newNonce = H.hash $ "Regenesis" <> encode ss1UpdatedNonce
+    SeedStateV1{} -> migrateSeedStateV1Trivial ss
 migrateSeedState StateMigrationParametersP1P2{} ss = ss
 migrateSeedState StateMigrationParametersP2P3{} ss = ss
 migrateSeedState StateMigrationParametersP3ToP4{} ss = ss
 migrateSeedState StateMigrationParametersP4ToP5{} ss = ss
 migrateSeedState (StateMigrationParametersP5ToP6 (P6.StateMigrationData _ time)) SeedStateV0{..} =
     let seed = H.hash $ "Regenesis" <> encode ss0CurrentLeadershipElectionNonce
     in  initialSeedStateV1 seed time
+migrateSeedState StateMigrationParametersP6ToP7{} ss = migrateSeedStateV1Trivial ss
+
+-- | Trivial migration of a 'SeedStateV1' between protocol versions.
+migrateSeedStateV1Trivial :: SeedState 'SeedStateVersion1 -> SeedState 'SeedStateVersion1
+migrateSeedStateV1Trivial SeedStateV1{..} =
+    SeedStateV1
+        { -- Reset the epoch to 0.
+          ss1Epoch = 0,
+          ss1CurrentLeadershipElectionNonce = newNonce,
+          ss1UpdatedNonce = newNonce,
+          -- We maintain the trigger block time. This forces an epoch transition as soon as possible
+          -- which will effectively substitute for the epoch transition that would have happened
+          -- on the previous consensus, had it not shut down.
+          ss1TriggerBlockTime = ss1TriggerBlockTime,
+          -- We flag the epoch transition as triggered so that the epoch transition will happen
+          -- as soon as possible.
+          ss1EpochTransitionTriggered = True,
+          -- We clear the shutdown flag.
+          ss1ShutdownTriggered = False
+        }
+  where
+    -- We derive the new nonce from the updated nonce on the basis that it was fixed
+    -- at the trigger block from the previous consensus.
+    newNonce = H.hash $ "Regenesis" <> encode ss1UpdatedNonce
 
 -- | See documentation of @migratePersistentBlockState@.
 --
@@ -605,6 +610,10 @@ migrateBlockRewardDetails StateMigrationParametersP5ToP6{} _ _ (SomeParam TimePa
     (BlockRewardDetailsV1 hbr) ->
         BlockRewardDetailsV1
             <$> migrateHashedBufferedRef (migratePoolRewards (rewardPeriodEpochs _tpRewardPeriodLength)) hbr
+migrateBlockRewardDetails StateMigrationParametersP6ToP7{} _ _ (SomeParam TimeParametersV1{..}) _ = \case
+    (BlockRewardDetailsV1 hbr) ->
+        BlockRewardDetailsV1
+            <$> migrateHashedBufferedRef (migratePoolRewards (rewardPeriodEpochs _tpRewardPeriodLength)) hbr
 
 instance (MonadBlobStore m) => MHashableTo m (Rewards.BlockRewardDetailsHash av) (BlockRewardDetails av) where
     getHashM (BlockRewardDetailsV0 heb) = return $ Rewards.BlockRewardDetailsHashV0 (getHash heb)
@@ -2167,6 +2176,7 @@ doGetRewardStatus pbs = do
         SP4 -> rewardsV1
         SP5 -> rewardsV1
         SP6 -> rewardsV1
+        SP7 -> rewardsV1
 
 doRewardFoundationAccount :: (SupportsPersistentState pv m) => PersistentBlockState pv -> Amount -> m (PersistentBlockState pv)
 doRewardFoundationAccount pbs reward = do
@@ -2292,6 +2302,7 @@ doModifyAccount pbs aUpd@AccountUpdate{..} = do
                     SP4 -> accountCanonicalAddress acc'
                     SP5 -> return _auIndex
                     SP6 -> return _auIndex
+                    SP7 -> return _auIndex
                 !oldRel <- accountNextReleaseTimestamp acc
                 !newRel <- accountNextReleaseTimestamp acc'
                 return (acctRef :: RSAccountRef pv, oldRel, newRel)
@@ -2834,6 +2845,7 @@ doProcessReleaseSchedule pbs ts = do
                     SP4 -> processAccountP1
                     SP5 -> processAccountP5
                     SP6 -> processAccountP5
+                    SP7 -> processAccountP5
             (newAccs, newRS) <- foldM processAccount (bspAccounts bsp, remRS) affectedAccounts
             storePBS pbs (bsp{bspAccounts = newAccs, bspReleaseSchedule = newRS})
 
@@ -3685,6 +3697,7 @@ migrateBlockPointers migration BlockStatePointers{..} = do
                     Nothing -> error "Account with release schedule does not exist"
                     Just ai -> ai
             StateMigrationParametersP5ToP6{} -> RSMNewToNew
+            StateMigrationParametersP6ToP7{} -> RSMNewToNew
     newReleaseSchedule <- migrateReleaseSchedule rsMigration bspReleaseSchedule
     newAccounts <- Accounts.migrateAccounts migration bspAccounts
     newModules <- migrateHashedBufferedRef Modules.migrateModules bspModules

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

@@ -303,6 +303,8 @@ migratePendingUpdates migration PendingUpdates{..} = withCPVConstraints (chainPa
             SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
         StateMigrationParametersP5ToP6{} -> case pElectionDifficultyQueue of
             SomeParam _ -> return NoParam
+        StateMigrationParametersP6ToP7{} -> case pElectionDifficultyQueue of
+            NoParam -> return NoParam
     newTimeParameters <- case migration of
         StateMigrationParametersTrivial -> case pTimeParametersQueue of
             NoParam -> return NoParam
@@ -318,6 +320,8 @@ migratePendingUpdates migration PendingUpdates{..} = withCPVConstraints (chainPa
             SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
         StateMigrationParametersP5ToP6{} -> case pTimeParametersQueue of
             SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
+        StateMigrationParametersP6ToP7{} -> case pTimeParametersQueue of
+            SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
     newCooldownParameters <- case migration of
         StateMigrationParametersTrivial -> case pCooldownParametersQueue of
             NoParam -> return NoParam
@@ -334,6 +338,8 @@ migratePendingUpdates migration PendingUpdates{..} = withCPVConstraints (chainPa
             SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
         StateMigrationParametersP5ToP6{} -> case pCooldownParametersQueue of
             SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
+        StateMigrationParametersP6ToP7{} -> case pCooldownParametersQueue of
+            SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
     newTimeoutParameters <- case migration of
         StateMigrationParametersTrivial -> case pTimeoutParametersQueue of
             NoParam -> return NoParam
@@ -349,6 +355,8 @@ migratePendingUpdates migration PendingUpdates{..} = withCPVConstraints (chainPa
         StateMigrationParametersP5ToP6{} -> do
             (!hbr, _) <- refFlush =<< refMake emptyUpdateQueue
             return (SomeParam hbr)
+        StateMigrationParametersP6ToP7{} -> case pTimeoutParametersQueue of
+            SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
     newMinBlockTimeQueue <- case migration of
         StateMigrationParametersTrivial -> case pMinBlockTimeQueue of
             NoParam -> return NoParam
@@ -364,6 +372,8 @@ migratePendingUpdates migration PendingUpdates{..} = withCPVConstraints (chainPa
         StateMigrationParametersP5ToP6{} -> do
             (!hbr, _) <- refFlush =<< refMake emptyUpdateQueue
             return (SomeParam hbr)
+        StateMigrationParametersP6ToP7{} -> case pMinBlockTimeQueue of
+            SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
     newBlockEnergyLimitQueue <- case migration of
         StateMigrationParametersTrivial -> case pBlockEnergyLimitQueue of
             NoParam -> return NoParam
@@ -379,6 +389,8 @@ migratePendingUpdates migration PendingUpdates{..} = withCPVConstraints (chainPa
         StateMigrationParametersP5ToP6{} -> do
             (!hbr, _) <- refFlush =<< refMake emptyUpdateQueue
             return (SomeParam hbr)
+        StateMigrationParametersP6ToP7{} -> case pBlockEnergyLimitQueue of
+            SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
     newFinalizationCommitteeParametersQueue <- case migration of
         StateMigrationParametersTrivial -> case pFinalizationCommitteeParametersQueue of
             NoParam -> return NoParam
@@ -394,6 +406,8 @@ migratePendingUpdates migration PendingUpdates{..} = withCPVConstraints (chainPa
         StateMigrationParametersP5ToP6{} -> do
             (!hbr, _) <- refFlush =<< refMake emptyUpdateQueue
             return (SomeParam hbr)
+        StateMigrationParametersP6ToP7{} -> case pFinalizationCommitteeParametersQueue of
+            SomeParam hbr -> SomeParam <$> migrateHashedBufferedRef (migrateUpdateQueue id) hbr
     return $!
         PendingUpdates
             { pRootKeysUpdateQueue = newRootKeys,

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

@@ -17,6 +17,7 @@ import qualified Concordium.Genesis.Data.P3 as P3
 import qualified Concordium.Genesis.Data.P4 as P4
 import qualified Concordium.Genesis.Data.P5 as P5
 import qualified Concordium.Genesis.Data.P6 as P6
+import qualified Concordium.Genesis.Data.P7 as P7
 import qualified Concordium.GlobalState.Basic.BlockState.PoolRewards as Basic
 import qualified Concordium.GlobalState.CapitalDistribution as CapDist
 import qualified Concordium.GlobalState.Persistent.Account as Account
@@ -74,6 +75,9 @@ genesisState gd = MTL.runExceptT $ case Types.protocolVersion @pv of
     Types.SP6 -> case gd of
         GenesisData.GDP6 P6.GDP6Initial{..} ->
             buildGenesisBlockState (CGPV1 genesisCore) genesisInitialState
+    Types.SP7 -> case gd of
+        GenesisData.GDP7 P7.GDP7Initial{..} ->
+            buildGenesisBlockState (CGPV1 genesisCore) genesisInitialState
 
 -------- Types -----------
 

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

@@ -264,6 +264,7 @@ instance (MonadBlobStore m, IsProtocolVersion pv) => BlobStorable m (ReleaseSche
         SP4 -> fmap ReleaseScheduleP0 <$> load
         SP5 -> fmap ReleaseScheduleP5 <$> load
         SP6 -> fmap ReleaseScheduleP5 <$> load
+        SP7 -> fmap ReleaseScheduleP5 <$> load
 
 instance (MonadBlobStore m) => Cacheable m (ReleaseSchedule pv) where
     cache (ReleaseScheduleP0 rs) = ReleaseScheduleP0 <$> cache rs
@@ -293,6 +294,7 @@ emptyReleaseSchedule = case protocolVersion @pv of
     SP4 -> rsP0
     SP5 -> rsP1
     SP6 -> rsP1
+    SP7 -> rsP1
   where
     rsP0 :: (RSAccountRef pv ~ AccountAddress) => m (ReleaseSchedule pv)
     rsP0 = do
@@ -342,6 +344,7 @@ trivialReleaseScheduleMigration = case protocolVersion @pv of
     SP4 -> RSMLegacyToLegacy
     SP5 -> RSMNewToNew
     SP6 -> RSMNewToNew
+    SP7 -> RSMNewToNew
 
 -- | Migrate a release schedule from one protocol version to another, given by a
 --  'ReleaseScheduleMigration'.

concordium-consensus/src/Concordium/KonsensusV1/TestMonad.hs

@@ -25,10 +25,11 @@ import Concordium.Types
 
 import qualified Concordium.Genesis.Data.BaseV1 as BaseV1
 import qualified Concordium.Genesis.Data.P6 as P6
+import qualified Concordium.Genesis.Data.P7 as P7
 import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
 import Concordium.GlobalState.BlockState
 import Concordium.GlobalState.Parameters (
-    GenesisData (GDP6),
+    GenesisData (GDP6, GDP7),
     defaultRuntimeParameters,
     genesisBlockHash,
  )
@@ -145,6 +146,7 @@ instance HasBakerContext (TestContext pv) where
 genesisCore :: forall pv. (IsConsensusV1 pv, IsProtocolVersion pv) => GenesisData pv -> BaseV1.CoreGenesisParametersV1
 genesisCore = case protocolVersion @pv of
     SP6 -> \(GDP6 P6.GDP6Initial{genesisCore = core}) -> core
+    SP7 -> \(GDP7 P7.GDP7Initial{genesisCore = core}) -> core
 
 -- | Run an operation in the 'TestMonad' with the given baker, time and genesis data.
 --  This sets up a temporary blob store for the block state that is deleted after use.

concordium-consensus/src/Concordium/ProtocolUpdate/P5/ProtocolP6.hs

@@ -7,7 +7,7 @@
 --  The update is specified at:
 --  https://github.com/Concordium/concordium-update-proposals/blob/main/updates/P6.txt
 --
---  This protocol update is valid at protocol version P6, and updates
+--  This protocol update is valid at protocol version P5, and updates
 --  to protocol version P6.
 --  The block state is changed during the update.
 --

concordium-consensus/src/Concordium/ProtocolUpdate/P6.hs

@@ -22,15 +22,22 @@ import Concordium.GlobalState.Types
 import qualified Concordium.GlobalState.Types as GSTypes
 import Concordium.KonsensusV1.TreeState.Implementation
 import Concordium.KonsensusV1.TreeState.Types
+import qualified Concordium.ProtocolUpdate.P6.ProtocolP7 as ProtocolP7
 import qualified Concordium.ProtocolUpdate.P6.Reboot as Reboot
 
 -- | Updates that are supported from protocol version P6.
-data Update = Reboot
+data Update
+    = Reboot
+    | ProtocolP7
     deriving (Show)
 
 -- | Hash map for resolving updates from their specification hash.
 updates :: HM.HashMap SHA256.Hash (Get Update)
-updates = HM.fromList [(Reboot.updateHash, return Reboot)]
+updates =
+    HM.fromList
+        [ (Reboot.updateHash, return Reboot)
+        -- (ProtocolP7.updateHash, return ProtocolP7) Comment out to enable updating to P7.
+        ]
 
 -- | Determine if a 'ProtocolUpdate' corresponds to a supported update type.
 checkUpdate :: ProtocolUpdate -> Either String Update
@@ -53,9 +60,11 @@ updateRegenesis ::
     BlockPointer (MPV m) ->
     m (PVInit m)
 updateRegenesis Reboot = Reboot.updateRegenesis
+updateRegenesis ProtocolP7 = ProtocolP7.updateRegenesis
 
 -- | Determine the protocol version the update will update to.
 updateNextProtocolVersion ::
     Update ->
     SomeProtocolVersion
 updateNextProtocolVersion Reboot{} = SomeProtocolVersion SP6
+updateNextProtocolVersion ProtocolP7{} = SomeProtocolVersion SP7