From c7679d55aaed9bb32eec0d23ff9d2a1ac6fa5f52 Mon Sep 17 00:00:00 2001 From: drsk Date: Wed, 4 Dec 2024 18:18:04 +0100 Subject: [PATCH 01/21] some more boilerplate --- .../src/Concordium/GlobalState/Persistent/BlockState/Updates.hs | 2 ++ concordium-consensus/src/Concordium/Queries.hs | 1 + 2 files changed, 3 insertions(+) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Updates.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Updates.hs index 8c52e0661..786a9b170 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Updates.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Updates.hs @@ -493,6 +493,7 @@ instance hMinBlockTimeQueue <- hashWhenSupported pMinBlockTimeQueue hBlockEnergyLimitQueue <- hashWhenSupported pBlockEnergyLimitQueue hFinalizationCommitteeParametersQueue <- hashWhenSupported pFinalizationCommitteeParametersQueue + hValidatorScoreParametersQueue <- hashWhenSupported pValidatorScoreParametersQueue return $! H.hash $ hRootKeysUpdateQueue @@ -515,6 +516,7 @@ instance <> hMinBlockTimeQueue <> hBlockEnergyLimitQueue <> hFinalizationCommitteeParametersQueue + <> hValidatorScoreParametersQueue where hashWhenSupported :: (MHashableTo m H.Hash a) => OParam pt cpv a -> m BS.ByteString hashWhenSupported = maybeWhenSupported (return mempty) (fmap H.hashToByteString . getHashM) diff --git a/concordium-consensus/src/Concordium/Queries.hs b/concordium-consensus/src/Concordium/Queries.hs index 057b3e90a..ff8177d0e 100644 --- a/concordium-consensus/src/Concordium/Queries.hs +++ b/concordium-consensus/src/Concordium/Queries.hs @@ -919,6 +919,7 @@ getBlockPendingUpdates = liftSkovQueryStateBHI query `merge` queueMapperOptional PUEMinBlockTime _pMinBlockTimeQueue `merge` queueMapperOptional PUEBlockEnergyLimit _pBlockEnergyLimitQueue `merge` queueMapperOptional PUEFinalizationCommitteeParameters _pFinalizationCommitteeParametersQueue + `merge` queueMapperOptional PUEValidatorScoreParameters _pValidatorScoreParametersQueue where cpv :: SChainParametersVersion cpv cpv = chainParametersVersion From 47261975dc3ae57157b3371581abfa581e54db46 Mon Sep 17 00:00:00 2001 From: drsk Date: Tue, 19 Nov 2024 11:17:58 +0100 Subject: [PATCH 02/21] auto suspension implementation --- .../src/Concordium/GlobalState/BlockState.hs | 14 +++ .../GlobalState/Persistent/BlockState.hs | 78 +++++++++++++++ .../src/Concordium/KonsensusV1/Scheduler.hs | 97 ++++++++++++++++--- .../src/Concordium/Kontrol/Bakers.hs | 12 ++- .../Scheduler/TreeStateEnvironment.hs | 3 +- 5 files changed, 183 insertions(+), 21 deletions(-) diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index fd2b2c9a5..e3a109471 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -1530,6 +1530,16 @@ class (BlockStateQuery m) => BlockStateOperations m where -- round did timeout. bsoUpdateMissedRounds :: (PVSupportsDelegation (MPV m), PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> Map.Map BakerId Word64 -> m (UpdatableBlockState m) + -- | Mark given validators for possible suspension at the next snapshot epoch. + bsoPrimeForSuspension :: (PVSupportsDelegation (MPV m), PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> Word64 -> [BakerId] -> m ([BakerId], UpdatableBlockState m) + + -- \| Suspend validators with the given account indices, if + -- 1) the account index points to an existing account + -- 2) the account belongs to a validator + -- 3) the account was not already suspended + -- Returns the subset of account indices that were suspended. + bsoSuspendValidators :: (PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> [AccountIndex] -> m ([AccountIndex], UpdatableBlockState m) + -- | A snapshot of the block state that can be used to roll back to a previous state. type StateSnapshot m @@ -1850,6 +1860,8 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat bsoSetRewardAccounts s = lift . bsoSetRewardAccounts s bsoIsProtocolUpdateEffective = lift . bsoIsProtocolUpdateEffective bsoUpdateMissedRounds s = lift . bsoUpdateMissedRounds s + bsoPrimeForSuspension s t = lift . bsoPrimeForSuspension s t + bsoSuspendValidators s = lift . bsoSuspendValidators s type StateSnapshot (MGSTrans t m) = StateSnapshot m bsoSnapshotState = lift . bsoSnapshotState bsoRollback s = lift . bsoRollback s @@ -1907,6 +1919,8 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat {-# INLINE bsoGetCurrentEpochBakers #-} {-# INLINE bsoIsProtocolUpdateEffective #-} {-# INLINE bsoUpdateMissedRounds #-} + {-# INLINE bsoPrimeForSuspension #-} + {-# INLINE bsoSuspendValidators #-} {-# INLINE bsoSnapshotState #-} {-# INLINE bsoRollback #-} diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 6b7cd626d..42d7f8f51 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -3509,6 +3509,82 @@ doUpdateMissedRounds pbs rds = do (Map.toList rds) storePBS pbs bsp' +doPrimeForSuspension :: + ( PVSupportsDelegation pv, + SupportsPersistentState pv m + ) => + PersistentBlockState pv -> + Word64 -> + [BakerId] -> + m ([BakerId], PersistentBlockState pv) +doPrimeForSuspension pbs threshold bids = do + bprds <- doGetBakerPoolRewardDetails pbs + bsp0 <- loadPBS pbs + (bidsUpd, bsp') <- do + foldM + ( \res@(acc, bsp) bId -> do + let mBprd = Map.lookup bId bprds + case mBprd of + Just bprd + | CTrue SuspensionInfo{..} <- suspensionInfo bprd, + missedRounds > threshold -> do + bsp' <- + modifyBakerPoolRewardDetailsInPoolRewards + bsp + bId + (\bpr -> bpr{suspensionInfo = (\suspInfo -> suspInfo{primedForSuspension = True}) <$> suspensionInfo bpr}) + return (bId : acc, bsp') + _otherwise -> return res + ) + ([], bsp0) + bids + pbs' <- storePBS pbs bsp' + return (bidsUpd, pbs') + +-- | Suspend validators with the given account indices, if +-- 1) the account index points to an existing account +-- 2) the account belongs to a validator +-- 3) the account was not already suspended +-- Returns the subset of account indeces that were suspended. +doSuspendValidators :: + forall pv m. + ( SupportsPersistentState pv m + ) => + PersistentBlockState pv -> + [AccountIndex] -> + m ([AccountIndex], PersistentBlockState pv) +doSuspendValidators pbs ais = + case hasValidatorSuspension of + STrue -> do + bsp0 <- loadPBS pbs + (aisSusp, bspUpd) <- + foldM + ( \res@(aisSusp, bsp) ai -> do + mAcc <- Accounts.indexedAccount ai (bspAccounts bsp) + case mAcc of + Nothing -> return res + Just acc -> do + mValidatorExists <- accountBaker acc + case mValidatorExists of + Nothing -> return res + Just ba + -- The validator is not yet suspended + | False <- + uncond $ BaseAccounts._bieAccountIsSuspended $ _accountBakerInfo ba -> do + newAcc <- setAccountValidatorSuspended True acc + newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp) + return (ai : aisSusp, bsp{bspAccounts = newAccounts}) + -- The validator is already suspended, nothing to do + | otherwise -> return res + ) + ([], bsp0) + ais + pbsUpd <- storePBS pbs bspUpd + return (aisSusp, pbsUpd) + SFalse -> return ([], pbs) + where + hasValidatorSuspension = sSupportsValidatorSuspension (accountVersion @(AccountVersionFor pv)) + doProcessUpdateQueues :: forall pv m. (SupportsPersistentState pv m) => @@ -4455,6 +4531,8 @@ instance (IsProtocolVersion pv, PersistentState av pv r m) => BlockStateOperatio bsoSetRewardAccounts = doSetRewardAccounts bsoIsProtocolUpdateEffective = doIsProtocolUpdateEffective bsoUpdateMissedRounds = doUpdateMissedRounds + bsoPrimeForSuspension = doPrimeForSuspension + bsoSuspendValidators = doSuspendValidators type StateSnapshot (PersistentBlockStateMonad pv r m) = BlockStatePointers pv bsoSnapshotState = loadPBS bsoRollback = storePBS diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index 477d76fa8..d9076182d 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -9,6 +9,7 @@ module Concordium.KonsensusV1.Scheduler where import Control.Monad import Data.Bool.Singletons import qualified Data.Map as Map +import qualified Data.Set as Set import Data.Time import Data.Word import Lens.Micro.Platform @@ -16,13 +17,15 @@ import Lens.Micro.Platform import Concordium.Logger import Concordium.TimeMonad import Concordium.Types +import Concordium.Types.Accounts (bakerIdentity) +import Concordium.Types.Conditionally import Concordium.Types.SeedState import Concordium.GlobalState.BakerInfo import Concordium.GlobalState.BlockState import Concordium.GlobalState.CapitalDistribution import qualified Concordium.GlobalState.Persistent.BlockState as PBS -import Concordium.GlobalState.PoolRewards (BakerPoolRewardDetails) +import Concordium.GlobalState.PoolRewards (BakerPoolRewardDetails (..), SuspensionInfo (..), emptySuspensionInfo) import Concordium.GlobalState.TransactionTable import Concordium.GlobalState.Types import Concordium.KonsensusV1.LeaderElection @@ -117,7 +120,11 @@ data PrologueResult m av = PrologueResult prologueBlockState :: UpdatableBlockState m, -- | If the block should pay out for a payday, these parameters determine the pay out. -- Otherwise, they are 'Nothing'. - prologuePaydayParameters :: Maybe (PaydayParameters av) + prologuePaydayParameters :: Maybe (PaydayParameters av), + -- | If the block triggered an epoch transition and the new epoch is a + -- snapshot,this field contains the validator ids that are newly suspended. + -- Otherwise, this is `Nothing`. + prologueSuspendedBids :: Maybe (Set.Set BakerId) } -- * Block prologue @@ -147,6 +154,16 @@ paydayHandleCooldowns = case sSupportsFlexibleCooldown (sAccountVersionFor (prot let cooldownTime = triggerTime `addDurationSeconds` (cooldownParams ^. cpUnifiedCooldown) bsoProcessCooldowns theState0 triggerTime cooldownTime +-- | Result of the epoch transition used for parameter passing. +data EpochTransitionResult m = EpochTransitionResult + { -- If the epoch transition was a payday, this contains the payday + -- parameters. + mPaydayParams :: Maybe (PaydayParameters (AccountVersionFor (MPV m))), + -- If the epoch transition was a snapshot, this contains the set of + -- validator ids that will be newly suspended. + mSnapshotSuspendedIds :: Maybe (Set.Set BakerId) + } + -- | Update the state to reflect an epoch transition. If the block is not the first in a new epoch -- then this does nothing. Otherwise, it makes the following changes: -- @@ -186,8 +203,8 @@ doEpochTransition :: Duration -> -- | State to update UpdatableBlockState m -> - m (Maybe (PaydayParameters (AccountVersionFor (MPV m))), UpdatableBlockState m) -doEpochTransition False _ theState = return (Nothing, theState) + m (EpochTransitionResult m, UpdatableBlockState m) +doEpochTransition False _ theState = return (EpochTransitionResult Nothing Nothing, theState) doEpochTransition True epochDuration theState0 = do chainParams <- bsoGetChainParameters theState0 oldSeedState <- bsoGetSeedState theState0 @@ -225,9 +242,16 @@ doEpochTransition True epochDuration theState0 = do newBakers <- bsoGetCurrentEpochBakers theState6 let newSeedState = updateSeedStateForEpoch newBakers epochDuration oldSeedState theState7 <- bsoSetSeedState theState6 newSeedState - theState9 <- - if newEpoch + 1 == newNextPayday + let isSnapshot = newEpoch + 1 == newNextPayday + (suspendedBids, theState8) <- do + if isSnapshot then do + snapshotPoolRewards <- bsoGetBakerPoolRewardDetails theState7 + -- account indexes that will be suspended + let suspendedBids = + Set.fromList + [ bid | (bid, rd) <- Map.toList snapshotPoolRewards, primedForSuspension $ fromCondDef (suspensionInfo rd) emptySuspensionInfo + ] -- This is the start of the last epoch of a payday, so take a baker snapshot. let epochEnd = newSeedState ^. triggerBlockTime let av = accountVersionFor (demoteProtocolVersion (protocolVersion @(MPV m))) @@ -239,6 +263,7 @@ doEpochTransition True epochDuration theState0 = do (chainParams ^. cpPoolParameters) activeBakers passiveDelegators + suspendedBids theState8 <- bsoSetNextEpochBakers theState7 @@ -248,10 +273,10 @@ doEpochTransition True epochDuration theState0 = do -- From P7 onwards, we transition pre-pre-cooldowns into pre-cooldowns, so that -- at the next payday they will enter cooldown. case sSupportsFlexibleCooldown (sAccountVersionFor (protocolVersion @(MPV m))) of - STrue -> bsoProcessPrePreCooldowns theState9 - SFalse -> return theState9 - else return theState7 - return (mPaydayParams, theState9) + STrue -> (Just suspendedBids,) <$> bsoProcessPrePreCooldowns theState9 + SFalse -> return (Just suspendedBids, theState9) + else return (Nothing, theState7) + return (EpochTransitionResult mPaydayParams suspendedBids, theState8) -- | Update the seed state to account for a block. -- See 'updateSeedStateForBlock' for details of what this entails. @@ -303,13 +328,14 @@ executeBlockPrologue BlockExecutionData{..} = do -- unlock the scheduled releases that have expired theState3 <- bsoProcessReleaseSchedule theState2 bedTimestamp -- transition the epoch if necessary - (mPaydayParms, theState4) <- doEpochTransition bedIsNewEpoch bedEpochDuration theState3 + (EpochTransitionResult{..}, theState4) <- doEpochTransition bedIsNewEpoch bedEpochDuration theState3 -- update the seed state using the block time and block nonce theState5 <- doUpdateSeedStateForBlock bedTimestamp bedBlockNonce theState4 return PrologueResult { prologueBlockState = theState5, - prologuePaydayParameters = mPaydayParms + prologuePaydayParameters = mPaydayParams, + prologueSuspendedBids = mSnapshotSuspendedIds } -- * Block epilogue @@ -350,9 +376,11 @@ doMintingP6 mintRate foundationAddr theState0 = do -- | If a payday has elapsed, this mints and distributes rewards for the payday. processPaydayRewards :: + forall pv m. ( pv ~ MPV m, BlockStateStorage m, - IsConsensusV1 pv + IsConsensusV1 pv, + IsProtocolVersion pv ) => Maybe (PaydayParameters (AccountVersionFor (MPV m))) -> UpdatableBlockState m -> @@ -363,7 +391,18 @@ processPaydayRewards (Just PaydayParameters{..}) theState0 = do -- in which the rewards are distributed. foundationAddr <- getAccountCanonicalAddress =<< bsoGetFoundationAccount theState0 theState1 <- doMintingP6 paydayMintRate foundationAddr theState0 - distributeRewards foundationAddr paydayCapitalDistribution paydayBakers paydayPoolRewards theState1 + theState2 <- distributeRewards foundationAddr paydayCapitalDistribution paydayBakers paydayPoolRewards theState1 + case hasValidatorSuspension of + SFalse -> return theState2 + STrue -> do + cps <- bsoGetChainParameters theState1 + case _cpValidatorScoreParameters cps of + NoParam -> return theState1 + SomeParam (ValidatorScoreParameters{..}) -> do + (bids, theState3) <- bsoPrimeForSuspension theState2 _vspMaxMissedRounds (bakerInfoExs paydayBakers ^.. each . bakerIdentity) + foldM bsoAddSpecialTransactionOutcome theState3 (ValidatorPrimedForSuspension <$> bids) + where + hasValidatorSuspension = sSupportsValidatorSuspension (sAccountVersionFor (protocolVersion @pv)) -- | Records that the baker baked this block (so it is eligible for baking rewards) and that the -- finalizers that signed the QC in the block are awake (and eligible for finalizer rewards). @@ -402,10 +441,26 @@ processBlockRewards ParticipatingBakers{..} TransactionRewardParameters{..} miss where hasValidatorSuspension = sSupportsValidatorSuspension (sAccountVersionFor (protocolVersion @pv)) +-- | Suspend the given set of validators. Logs the suspension of a validator in +-- a special transaction outcome. +processSuspensions :: + forall pv m. + ( pv ~ MPV m, + BlockStateStorage m, + PVSupportsValidatorSuspension pv + ) => + Set.Set BakerId -> + UpdatableBlockState m -> + m (UpdatableBlockState m) +processSuspensions snapshotSuspendedBids bs0 = do + (ais', bs1) <- bsoSuspendValidators bs0 [ai | BakerId ai <- Set.toList snapshotSuspendedBids] + foldM bsoAddSpecialTransactionOutcome bs1 (ValidatorSuspended . BakerId <$> ais') + -- | Execute the block epilogue. This mints and distributes the rewards for a payday if the block is -- in a new payday. This also accrues the rewards for the block that will be paid at the next -- payday. executeBlockEpilogue :: + forall pv m. ( pv ~ MPV m, IsProtocolVersion pv, BlockStateStorage m, @@ -416,12 +471,20 @@ executeBlockEpilogue :: Maybe (PaydayParameters (AccountVersionFor (MPV m))) -> TransactionRewardParameters -> Map.Map BakerId Word64 -> + Maybe (Set.Set BakerId) -> UpdatableBlockState m -> m (PBS.HashedPersistentBlockState pv) -executeBlockEpilogue participants paydayParams transactionRewardParams missedRounds theState0 = do +executeBlockEpilogue participants paydayParams transactionRewardParams missedRounds snapshotSuspendedBids theState0 = do theState1 <- processPaydayRewards paydayParams theState0 theState2 <- processBlockRewards participants transactionRewardParams missedRounds theState1 - freezeBlockState theState2 + theState3 <- case hasValidatorSuspension of + STrue + | Just suspendedBids <- snapshotSuspendedBids -> processSuspensions suspendedBids theState2 + | otherwise -> return theState2 + SFalse -> return theState2 + freezeBlockState theState3 + where + hasValidatorSuspension = sSupportsValidatorSuspension (sAccountVersionFor (protocolVersion @pv)) -- * Transactions @@ -592,6 +655,7 @@ executeBlockState execData@BlockExecutionData{..} transactions = do prologuePaydayParameters terTransactionRewardParameters bedMissedRounds + prologueSuspendedBids terBlockState return (endState, terEnergyUsed) @@ -647,6 +711,7 @@ constructBlockState runtimeParams transactionTable pendingTable execData@BlockEx prologuePaydayParameters terTransactionRewardParameters bedMissedRounds + prologueSuspendedBids terBlockState endTime <- currentTime logEvent Scheduler LLInfo $ "Constructed a block in " ++ show (diffUTCTime endTime startTime) diff --git a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs index af28d8dc2..a211a8f0b 100644 --- a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs +++ b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs @@ -12,6 +12,7 @@ module Concordium.Kontrol.Bakers where import Data.Maybe import Data.Monoid +import qualified Data.Set as Set import qualified Data.Vector as Vec import Lens.Micro.Platform @@ -178,8 +179,9 @@ computeBakerStakesAndCapital :: PoolParameters' 'PoolParametersVersion1 -> [ActiveBakerInfo' bakerInfoRef] -> [ActiveDelegatorInfo] -> + Set.Set BakerId -> BakerStakesAndCapital bakerInfoRef -computeBakerStakesAndCapital poolParams activeBakers passiveDelegators = BakerStakesAndCapital{..} +computeBakerStakesAndCapital poolParams activeBakers passiveDelegators snapshotSuspendedBids = BakerStakesAndCapital{..} where leverage = poolParams ^. ppLeverageBound capitalBound = poolParams ^. ppCapitalBound @@ -195,7 +197,7 @@ computeBakerStakesAndCapital poolParams activeBakers passiveDelegators = BakerSt capLimit ] ) - filteredActiveBakers = [abi | abi@ActiveBakerInfo{..} <- activeBakers, not activeBakerIsSuspended] + filteredActiveBakers = [abi | abi@ActiveBakerInfo{..} <- activeBakers, not (activeBakerIsSuspended || activeBakerId `Set.member` snapshotSuspendedBids)] filteredPoolCapitals = poolCapital <$> filteredActiveBakers bakerStakes = zipWith makeBakerStake filteredActiveBakers filteredPoolCapitals delegatorCapital ActiveDelegatorInfo{..} = DelegatorCapital activeDelegatorId activeDelegatorStake @@ -219,9 +221,10 @@ generateNextBakers :: ) => -- | The payday epoch Epoch -> + Set.Set BakerId -> UpdatableBlockState m -> m (UpdatableBlockState m) -generateNextBakers paydayEpoch bs0 = do +generateNextBakers paydayEpoch suspendedBids bs0 = do isEffective <- effectiveTest paydayEpoch -- Determine the bakers and delegators for the next reward period, accounting for any -- stake reductions that are currently pending on active bakers with effective time at @@ -241,6 +244,7 @@ generateNextBakers paydayEpoch bs0 = do (cps ^. cpPoolParameters) activeBakers passiveDelegators + suspendedBids bs1 <- bsoSetNextEpochBakers bs0 bakerStakes NoParam bsoSetNextCapitalDistribution bs1 capitalDistribution @@ -389,7 +393,7 @@ getSlotBakersP4 genData bs slot = ePoolParams pp' updates ePoolParams pp _ = pp effectivePoolParameters = ePoolParams (chainParams ^. cpPoolParameters) pendingPoolParams - bsc = computeBakerStakesAndCapital effectivePoolParameters activeBakers passiveDelegators + bsc = computeBakerStakesAndCapital effectivePoolParameters activeBakers passiveDelegators Set.empty let mkFullBaker (biRef, _bakerStake) = do _theBakerInfo <- derefBakerInfo biRef return FullBakerInfo{..} diff --git a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs index 72438f000..ecfb665b8 100644 --- a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs +++ b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs @@ -20,6 +20,7 @@ import qualified Data.Map as Map import Data.Maybe import Data.Ratio import qualified Data.Sequence as Seq +import qualified Data.Set as Set import Data.Time import qualified Data.Vector as Vec import Data.Word @@ -1110,7 +1111,7 @@ updateBirkParameters newSeedState bs0 oldChainParameters updates = case protocol processPaydays pd mrps0 bspp0 = do bspp1 <- if oldSeedState ^. epoch < pd - 1 && pd - 1 <= newSeedState ^. epoch - then generateNextBakers pd bspp0 + then generateNextBakers pd Set.empty bspp0 else return bspp0 if pd <= newSeedState ^. epoch then do From 424a20458d5fe2012fb798340e9f61a77cdd71c5 Mon Sep 17 00:00:00 2001 From: drsk Date: Mon, 2 Dec 2024 16:10:40 +0100 Subject: [PATCH 03/21] fix tests --- .../KonsensusV1/EpochTransition.hs | 25 +++++++++++-------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs index cdbd60b44..461794809 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs @@ -333,7 +333,7 @@ makeInitialState accs seedState rpLen = withIsAuthorizationsVersionForPV (protoc chainParams let pbs0 = hpbsPointers initialBS (activeBakers, passiveDelegators) <- bsoGetActiveBakersAndDelegators pbs0 - let BakerStakesAndCapital{..} = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers passiveDelegators + let BakerStakesAndCapital{..} = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers passiveDelegators Set.empty pbs1 <- bsoSetNextEpochBakers pbs0 bakerStakes (chainParams ^. cpFinalizationCommitteeParameters) pbs2 <- bsoSetNextCapitalDistribution pbs1 capitalDistribution pbs <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers pbs2 @@ -380,7 +380,7 @@ testEpochTransitionNoPaydayNoSnapshot accountConfigs = runTestBlockState @P7 $ d initCapDist <- bsoGetCurrentCapitalDistribution bs0 initBakers <- bsoGetCurrentEpochFullBakersEx bs0 bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 10) - (mPaydayParams, resState) <- doEpochTransition True hour bs1 + (EpochTransitionResult{..}, resState) <- doEpochTransition True hour bs1 liftIO $ assertEqual "Payday parameters" Nothing mPaydayParams newCooldowns <- checkCooldowns resState liftIO $ assertEqual "Cooldowns should be unchanged" (map acCooldowns accountConfigs) newCooldowns @@ -417,7 +417,7 @@ testEpochTransitionPaydayOnly accountConfigs = runTestBlockState @P7 $ do initCapDist <- bsoGetCurrentCapitalDistribution bs0 initBakers <- bsoGetCurrentEpochFullBakersEx bs0 bs1 <- bsoSetPaydayEpoch bs0 (startEpoch + 1) - (mPaydayParams, resState) <- doEpochTransition True hour bs1 + (EpochTransitionResult{..}, resState) <- doEpochTransition True hour bs1 liftIO $ case mPaydayParams of Just PaydayParameters{..} -> do assertEqual "Payday capital distribution" initCapDist paydayCapitalDistribution @@ -475,6 +475,7 @@ testEpochTransitionSnapshotOnly accountConfigs = runTestBlockState @P7 $ do (chainParams ^. cpPoolParameters) activeBakers activeDelegators + Set.empty let updatedCapitalDistr = capitalDistribution let mkFullBaker (ref, stake) = do loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case @@ -486,7 +487,7 @@ testEpochTransitionSnapshotOnly accountConfigs = runTestBlockState @P7 $ do bkrs <- mapM mkFullBaker bakerStakes let updatedBakerStakes = FullBakersEx (Vec.fromList bkrs) (sum $ snd <$> bakerStakes) - (mPaydayParams, resState) <- doEpochTransition True hour bs1 + (EpochTransitionResult{..}, resState) <- doEpochTransition True hour bs1 liftIO $ assertEqual "Payday parameters" Nothing mPaydayParams newCooldowns <- checkCooldowns resState liftIO $ @@ -534,6 +535,7 @@ testEpochTransitionSnapshotPayday accountConfigs = runTestBlockState @P7 $ do (chainParams ^. cpPoolParameters) activeBakers activeDelegators + Set.empty let updatedCapitalDistr = capitalDistribution let mkFullBaker (ref, stake) = do loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case @@ -545,7 +547,7 @@ testEpochTransitionSnapshotPayday accountConfigs = runTestBlockState @P7 $ do bkrs <- mapM mkFullBaker bakerStakes let updatedBakerStakes = FullBakersEx (Vec.fromList bkrs) (sum $ snd <$> bakerStakes) - (mPaydayParams, snapshotState) <- doEpochTransition True hour bs1 + (EpochTransitionResult{..}, snapshotState) <- doEpochTransition True hour bs1 liftIO $ assertEqual "Payday parameters" Nothing mPaydayParams newCooldowns <- checkCooldowns snapshotState let expectCooldowns1 = processPrePreCooldown . acCooldowns <$> accountConfigs @@ -571,7 +573,7 @@ testEpochTransitionSnapshotPayday accountConfigs = runTestBlockState @P7 $ do snapshotBakers <- bsoGetCurrentEpochFullBakersEx snapshotState liftIO $ assertEqual "Bakers should be unchanged" initBakers snapshotBakers - (mPaydayParams', resState) <- doEpochTransition True hour snapshotState + (EpochTransitionResult mPaydayParams' _mSuspendedBids, resState) <- doEpochTransition True hour snapshotState liftIO $ case mPaydayParams' of Just PaydayParameters{..} -> do assertEqual "Payday capital distribution" initCapDist paydayCapitalDistribution @@ -624,6 +626,7 @@ testEpochTransitionSnapshotPaydayCombo accountConfigs = runTestBlockState @P7 $ (chainParams ^. cpPoolParameters) activeBakers activeDelegators + Set.empty let updatedCapitalDistr = capitalDistribution let mkFullBaker (ref, stake) = do loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case @@ -636,7 +639,7 @@ testEpochTransitionSnapshotPaydayCombo accountConfigs = runTestBlockState @P7 $ let updatedBakerStakes = FullBakersEx (Vec.fromList bkrs) (sum $ snd <$> bakerStakes) -- First epoch transition. - (mPaydayParams, snapshotState) <- doEpochTransition True hour bs1 + (EpochTransitionResult{..}, snapshotState) <- doEpochTransition True hour bs1 liftIO $ case mPaydayParams of Just PaydayParameters{..} -> do assertEqual "Payday capital distribution (1)" initCapDist paydayCapitalDistribution @@ -673,7 +676,7 @@ testEpochTransitionSnapshotPaydayCombo accountConfigs = runTestBlockState @P7 $ -- Second epoch transition. let payday2Time = startTriggerTime `addDuration` hour - (mPaydayParams', resState) <- doEpochTransition True hour snapshotState + (EpochTransitionResult mPaydayParams' _mSuspendedBids, resState) <- doEpochTransition True hour snapshotState liftIO $ case mPaydayParams' of Just PaydayParameters{..} -> do assertEqual "Payday capital distribution" initCapDist paydayCapitalDistribution @@ -730,7 +733,7 @@ testMissedRoundsUpdate accountConfigs = runTestBlockState @P8 $ do missedRounds1 chainParams <- bsoGetChainParameters bs1 (activeBakers, passiveDelegators) <- bsoGetActiveBakersAndDelegators bs1 - let BakerStakesAndCapital{..} = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers passiveDelegators + let BakerStakesAndCapital{..} = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers passiveDelegators Set.empty let CapitalDistribution{..} = capitalDistribution let n = Vec.length bakerPoolCapital `div` 2 let newBakerStake = take n bakerStakes @@ -773,7 +776,7 @@ testComputeBakerStakesAndCapital accountConfigs = runTestBlockState @P8 $ do bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 24 chainParams <- bsoGetChainParameters bs0 (activeBakers0, passiveDelegators0) <- bsoGetActiveBakersAndDelegators bs0 - let bakerStakesAndCapital0 = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers0 passiveDelegators0 + let bakerStakesAndCapital0 = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers0 passiveDelegators0 Set.empty let capitalDistribution0 = capitalDistribution bakerStakesAndCapital0 let passiveDelegatorCapital0 = passiveDelegatorsCapital capitalDistribution0 liftIO $ @@ -804,7 +807,7 @@ testComputeBakerStakesAndCapital accountConfigs = runTestBlockState @P8 $ do bs0 validatorIxs (activeBakers1, passiveDelegators1) <- bsoGetActiveBakersAndDelegators bs1 - let bakerStakesAndCapital1 = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers1 passiveDelegators1 + let bakerStakesAndCapital1 = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers1 passiveDelegators1 Set.empty liftIO $ assertBool "With all validators suspended, baker stakes are empty." From f01eb5e34eebc20d4f7775b8f6aa535a6bf6b83d Mon Sep 17 00:00:00 2001 From: drsk Date: Mon, 2 Dec 2024 17:54:43 +0100 Subject: [PATCH 04/21] extend test for `computeBakerStakesAndCapital` --- .../KonsensusV1/EpochTransition.hs | 31 +++++++++++++++---- 1 file changed, 25 insertions(+), 6 deletions(-) diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs index 461794809..543126f13 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs @@ -796,6 +796,25 @@ testComputeBakerStakesAndCapital accountConfigs = runTestBlockState @P8 $ do Just acc -> isJust <$> getAccountBakerInfoRef acc ) [acAccountIndex ac | ac <- accountConfigs] + + -- suspension at snapshot epoch transition + let bakerStakesAndCapital1 = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers0 passiveDelegators0 (Set.fromList [BakerId aix | aix <- validatorIxs]) + liftIO $ + assertBool + "With all validators suspended at snapshot, baker stakes are empty." + (null $ bakerStakes bakerStakesAndCapital1) + let capitalDistribution1 = capitalDistribution bakerStakesAndCapital1 + let passiveDelegatorCapital1 = passiveDelegatorsCapital capitalDistribution1 + liftIO $ + assertBool + "With all validators suspended at snapshot, baker pool capital is empty." + (Vec.null $ bakerPoolCapital capitalDistribution1) + liftIO $ + assertBool + "Passive delegator capital is unchanged" + (passiveDelegatorCapital0 == passiveDelegatorCapital1) + + -- suspension of already suspended validators bs1 <- foldM ( \bs i -> do @@ -807,21 +826,21 @@ testComputeBakerStakesAndCapital accountConfigs = runTestBlockState @P8 $ do bs0 validatorIxs (activeBakers1, passiveDelegators1) <- bsoGetActiveBakersAndDelegators bs1 - let bakerStakesAndCapital1 = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers1 passiveDelegators1 Set.empty + let bakerStakesAndCapital2 = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers1 passiveDelegators1 Set.empty liftIO $ assertBool "With all validators suspended, baker stakes are empty." - (null $ bakerStakes bakerStakesAndCapital1) - let capitalDistribution1 = capitalDistribution bakerStakesAndCapital1 - let passiveDelegatorCapital1 = passiveDelegatorsCapital capitalDistribution1 + (null $ bakerStakes bakerStakesAndCapital2) + let capitalDistribution2 = capitalDistribution bakerStakesAndCapital2 + let passiveDelegatorCapital2 = passiveDelegatorsCapital capitalDistribution2 liftIO $ assertBool "With all validators suspended, baker pool capital is empty." - (Vec.null $ bakerPoolCapital capitalDistribution1) + (Vec.null $ bakerPoolCapital capitalDistribution2) liftIO $ assertBool "Passive delegator capital is unchanged" - (passiveDelegatorCapital0 == passiveDelegatorCapital1) + (passiveDelegatorCapital0 == passiveDelegatorCapital2) where startEpoch = 10 startTriggerTime = 1000 From 2995cceb658024006479e6c7e2378b9ecedd62bd Mon Sep 17 00:00:00 2001 From: drsk Date: Mon, 2 Dec 2024 18:07:14 +0100 Subject: [PATCH 05/21] add tests for epoch transition --- .../src/Concordium/GlobalState/BlockState.hs | 4 +- .../GlobalState/Persistent/BlockState.hs | 3 + .../KonsensusV1/EpochTransition.hs | 71 +++++++++++++++++++ 3 files changed, 77 insertions(+), 1 deletion(-) diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index e3a109471..074aff833 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -1530,7 +1530,9 @@ class (BlockStateQuery m) => BlockStateOperations m where -- round did timeout. bsoUpdateMissedRounds :: (PVSupportsDelegation (MPV m), PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> Map.Map BakerId Word64 -> m (UpdatableBlockState m) - -- | Mark given validators for possible suspension at the next snapshot epoch. + -- | Mark given validators for possible suspension at the next snapshot + -- epoch. Returns the subset of the given validator ids whose missed rounds + -- exceeded the given threshold and are now priMed for suspension. bsoPrimeForSuspension :: (PVSupportsDelegation (MPV m), PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> Word64 -> [BakerId] -> m ([BakerId], UpdatableBlockState m) -- \| Suspend validators with the given account indices, if diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 42d7f8f51..95ae65dc7 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -3509,6 +3509,9 @@ doUpdateMissedRounds pbs rds = do (Map.toList rds) storePBS pbs bsp' +-- | Prime validators for suspension. Returns the subset of the given validator +-- ids whose missed rounds exceeded the given threshold and are now primed for +-- suspension. doPrimeForSuspension :: ( PVSupportsDelegation pv, SupportsPersistentState pv m diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs index 543126f13..eb92c883e 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs @@ -857,6 +857,71 @@ testComputeBakerStakesAndCapital accountConfigs = runTestBlockState @P8 $ do vuSuspend = Just True } +testPrimeForSuspension :: [AccountConfig 'AccountV4] -> Assertion +testPrimeForSuspension accountConfigs = runTestBlockState @P8 $ do + bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 24 + bprd <- bsoGetBakerPoolRewardDetails bs0 + let activeBakerIds0 = Map.keys bprd + let missedRounds = Map.fromList $ zip activeBakerIds0 [1 ..] + bs1 <- bsoUpdateMissedRounds bs0 missedRounds + (primedBakers, _bs2) <- bsoPrimeForSuspension bs1 0 activeBakerIds0 + liftIO $ + assertEqual + "Current active bakers should be primed for suspension as expected" + (Set.fromList activeBakerIds0) + (Set.fromList primedBakers) + (primedBakers1, _bs2) <- bsoPrimeForSuspension bs1 5 activeBakerIds0 + liftIO $ + assertEqual + "Current active bakers should be primed for suspension as expected" + (Set.fromList $ drop 5 activeBakerIds0) + (Set.fromList $ primedBakers1) + where + startEpoch = 10 + startTriggerTime = 1000 + +testSuspendPrimedNoPaydayNoSnapshot :: [AccountConfig 'AccountV4] -> Assertion +testSuspendPrimedNoPaydayNoSnapshot accountConfigs = runTestBlockState @P8 $ do + bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 24 + bprd0 <- bsoGetBakerPoolRewardDetails bs0 + let activeBakerIds0 = Map.keys bprd0 + let missedRounds = Map.fromList $ zip activeBakerIds0 [2 ..] + bs1 <- bsoUpdateMissedRounds bs0 missedRounds + -- The maximum missed rounds threshold in the dummy chain parameters are set to 1. + (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 activeBakerIds0 + bs3 <- bsoSetPaydayEpoch bs2 (startEpoch + 10) + (res1, _bs4) <- doEpochTransition True hour bs3 + liftIO $ + assertEqual + "No validators are getting suspended if epoch transition is not at snapshot" + Nothing + (mSnapshotSuspendedIds res1) + where + hour = Duration 3_600_000 + startEpoch = 10 + startTriggerTime = 1000 + +testSuspendPrimedSnapshotOnly :: [AccountConfig 'AccountV4] -> Assertion +testSuspendPrimedSnapshotOnly accountConfigs = runTestBlockState @P8 $ do + bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 24 + bprd0 <- bsoGetBakerPoolRewardDetails bs0 + let activeBakerIds0 = Map.keys bprd0 + let missedRounds = Map.fromList $ zip activeBakerIds0 [2 ..] + bs1 <- bsoUpdateMissedRounds bs0 missedRounds + -- The maximum missed rounds threshold in the dummy chain parameters are set to 1. + (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 activeBakerIds0 + bs4 <- bsoSetPaydayEpoch bs2 (startEpoch + 2) + (res2, _bs5) <- doEpochTransition True hour bs4 + liftIO $ + assertEqual + "Primed validators are suspended at snapshot" + (Just $ Set.fromList primedBakers1) + (mSnapshotSuspendedIds res2) + where + hour = Duration 3_600_000 + startEpoch = 10 + startTriggerTime = 1000 + tests :: Spec tests = parallel $ describe "EpochTransition" $ do it "testEpochTransitionNoPaydayNoSnapshot" $ @@ -873,3 +938,9 @@ tests = parallel $ describe "EpochTransition" $ do forAll (genAccountConfigs False) testMissedRoundsUpdate it "testComputeBakerStakesAndCapital" $ forAll (genAccountConfigs False) testComputeBakerStakesAndCapital + it "testPrimeForSuspension" $ + forAll (genAccountConfigs False) testPrimeForSuspension + it "testSuspendPrimedNoPaydayNoSnapshot" $ + forAll (genAccountConfigs False) testSuspendPrimedNoPaydayNoSnapshot + it "testSuspendPrimedSnapshotOnly" $ + forAll (genAccountConfigs False) testSuspendPrimedSnapshotOnly From 9d3fdd0efa20811528e0676ca9d32b7c473221c2 Mon Sep 17 00:00:00 2001 From: Thomas Dinsdale-Young Date: Wed, 4 Dec 2024 16:06:16 +0100 Subject: [PATCH 06/21] Add account address to transaction events and special outcomes. --- concordium-base | 1 - .../src/Concordium/GlobalState/BlockState.hs | 7 ++--- .../GlobalState/Persistent/BlockState.hs | 8 +++--- .../src/Concordium/KonsensusV1/Scheduler.hs | 27 +++++++++++++++++-- 4 files changed, 34 insertions(+), 9 deletions(-) delete mode 160000 concordium-base diff --git a/concordium-base b/concordium-base deleted file mode 160000 index 23f2746ee..000000000 --- a/concordium-base +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 23f2746ee611d755e8249b9c9f9a09a52f5d6c4b diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index 074aff833..3edbfbc07 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -1535,12 +1535,13 @@ class (BlockStateQuery m) => BlockStateOperations m where -- exceeded the given threshold and are now priMed for suspension. bsoPrimeForSuspension :: (PVSupportsDelegation (MPV m), PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> Word64 -> [BakerId] -> m ([BakerId], UpdatableBlockState m) - -- \| Suspend validators with the given account indices, if + -- | Suspend validators with the given account indices, if -- 1) the account index points to an existing account -- 2) the account belongs to a validator -- 3) the account was not already suspended - -- Returns the subset of account indices that were suspended. - bsoSuspendValidators :: (PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> [AccountIndex] -> m ([AccountIndex], UpdatableBlockState m) + -- Returns the subset of account indices that were suspended together with their canonical + -- addresses. + bsoSuspendValidators :: (PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> [AccountIndex] -> m ([(AccountIndex, AccountAddress)], UpdatableBlockState m) -- | A snapshot of the block state that can be used to roll back to a previous state. type StateSnapshot m diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 95ae65dc7..82dd7efef 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -3548,14 +3548,15 @@ doPrimeForSuspension pbs threshold bids = do -- 1) the account index points to an existing account -- 2) the account belongs to a validator -- 3) the account was not already suspended --- Returns the subset of account indeces that were suspended. +-- Returns the subset of account indices that were suspended together with their canonical account +-- addresses. doSuspendValidators :: forall pv m. ( SupportsPersistentState pv m ) => PersistentBlockState pv -> [AccountIndex] -> - m ([AccountIndex], PersistentBlockState pv) + m ([(AccountIndex, AccountAddress)], PersistentBlockState pv) doSuspendValidators pbs ais = case hasValidatorSuspension of STrue -> do @@ -3576,7 +3577,8 @@ doSuspendValidators pbs ais = uncond $ BaseAccounts._bieAccountIsSuspended $ _accountBakerInfo ba -> do newAcc <- setAccountValidatorSuspended True acc newAccounts <- Accounts.setAccountAtIndex ai newAcc (bspAccounts bsp) - return (ai : aisSusp, bsp{bspAccounts = newAccounts}) + address <- accountCanonicalAddress newAcc + return ((ai, address) : aisSusp, bsp{bspAccounts = newAccounts}) -- The validator is already suspended, nothing to do | otherwise -> return res ) diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index d9076182d..31fd97167 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -9,6 +9,7 @@ module Concordium.KonsensusV1.Scheduler where import Control.Monad import Data.Bool.Singletons import qualified Data.Map as Map +import Data.Maybe import qualified Data.Set as Set import Data.Time import Data.Word @@ -400,7 +401,22 @@ processPaydayRewards (Just PaydayParameters{..}) theState0 = do NoParam -> return theState1 SomeParam (ValidatorScoreParameters{..}) -> do (bids, theState3) <- bsoPrimeForSuspension theState2 _vspMaxMissedRounds (bakerInfoExs paydayBakers ^.. each . bakerIdentity) - foldM bsoAddSpecialTransactionOutcome theState3 (ValidatorPrimedForSuspension <$> bids) + let addOutcome :: UpdatableBlockState m -> BakerId -> m (UpdatableBlockState m) + addOutcome theState bid = do + -- The account must exist, since it is a validator, so this can't fail + account <- + fromJust + <$> bsoGetAccountByIndex + theState + (bakerAccountIndex bid) + address <- getAccountCanonicalAddress account + let outcome = + ValidatorPrimedForSuspension + { vpfsBakerId = bid, + vpfsAccount = address + } + bsoAddSpecialTransactionOutcome theState outcome + foldM addOutcome theState3 bids where hasValidatorSuspension = sSupportsValidatorSuspension (sAccountVersionFor (protocolVersion @pv)) @@ -454,7 +470,14 @@ processSuspensions :: m (UpdatableBlockState m) processSuspensions snapshotSuspendedBids bs0 = do (ais', bs1) <- bsoSuspendValidators bs0 [ai | BakerId ai <- Set.toList snapshotSuspendedBids] - foldM bsoAddSpecialTransactionOutcome bs1 (ValidatorSuspended . BakerId <$> ais') + let addOutcome bs (accIndex, accAddr) = do + let outcome = + ValidatorSuspended + { vsBakerId = BakerId accIndex, + vsAccount = accAddr + } + bsoAddSpecialTransactionOutcome bs outcome + foldM addOutcome bs1 ais' -- | Execute the block epilogue. This mints and distributes the rewards for a payday if the block is -- in a new payday. This also accrues the rewards for the block that will be paid at the next From b3fbf129f273fb1d67e81c97ba51ec1391f93bec Mon Sep 17 00:00:00 2001 From: drsk Date: Thu, 5 Dec 2024 16:29:22 +0100 Subject: [PATCH 07/21] add back concordium-base --- concordium-base | 1 + 1 file changed, 1 insertion(+) create mode 160000 concordium-base diff --git a/concordium-base b/concordium-base new file mode 160000 index 000000000..23f2746ee --- /dev/null +++ b/concordium-base @@ -0,0 +1 @@ +Subproject commit 23f2746ee611d755e8249b9c9f9a09a52f5d6c4b From 4cd004339924f5bb1e8333278931913f88bf8d00 Mon Sep 17 00:00:00 2001 From: drsk Date: Thu, 5 Dec 2024 16:48:15 +0100 Subject: [PATCH 08/21] format & cosmetics --- .../src/Concordium/GlobalState/BlockState.hs | 2 +- .../src/Concordium/KonsensusV1/Scheduler.hs | 10 +++++++--- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index 3edbfbc07..2cbeacd52 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -1532,7 +1532,7 @@ class (BlockStateQuery m) => BlockStateOperations m where -- | Mark given validators for possible suspension at the next snapshot -- epoch. Returns the subset of the given validator ids whose missed rounds - -- exceeded the given threshold and are now priMed for suspension. + -- exceeded the given threshold and are now primed for suspension. bsoPrimeForSuspension :: (PVSupportsDelegation (MPV m), PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> Word64 -> [BakerId] -> m ([BakerId], UpdatableBlockState m) -- | Suspend validators with the given account indices, if diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index 31fd97167..8addac108 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -123,7 +123,7 @@ data PrologueResult m av = PrologueResult -- Otherwise, they are 'Nothing'. prologuePaydayParameters :: Maybe (PaydayParameters av), -- | If the block triggered an epoch transition and the new epoch is a - -- snapshot,this field contains the validator ids that are newly suspended. + -- snapshot, this field contains the validator ids that are newly suspended. -- Otherwise, this is `Nothing`. prologueSuspendedBids :: Maybe (Set.Set BakerId) } @@ -161,7 +161,7 @@ data EpochTransitionResult m = EpochTransitionResult -- parameters. mPaydayParams :: Maybe (PaydayParameters (AccountVersionFor (MPV m))), -- If the epoch transition was a snapshot, this contains the set of - -- validator ids that will be newly suspended. + -- validator ids that will be newly suspended. mSnapshotSuspendedIds :: Maybe (Set.Set BakerId) } @@ -400,7 +400,11 @@ processPaydayRewards (Just PaydayParameters{..}) theState0 = do case _cpValidatorScoreParameters cps of NoParam -> return theState1 SomeParam (ValidatorScoreParameters{..}) -> do - (bids, theState3) <- bsoPrimeForSuspension theState2 _vspMaxMissedRounds (bakerInfoExs paydayBakers ^.. each . bakerIdentity) + (bids, theState3) <- + bsoPrimeForSuspension + theState2 + _vspMaxMissedRounds + (bakerInfoExs paydayBakers ^.. each . bakerIdentity) let addOutcome :: UpdatableBlockState m -> BakerId -> m (UpdatableBlockState m) addOutcome theState bid = do -- The account must exist, since it is a validator, so this can't fail From 495bb1e95fbd27a42ed80e87ebf8ff5f0e3c8c9f Mon Sep 17 00:00:00 2001 From: drsk Date: Thu, 5 Dec 2024 16:48:15 +0100 Subject: [PATCH 09/21] additional test --- .../KonsensusV1/EpochTransition.hs | 60 +++++++++++++++---- 1 file changed, 47 insertions(+), 13 deletions(-) diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs index eb92c883e..802ee41aa 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs @@ -798,7 +798,12 @@ testComputeBakerStakesAndCapital accountConfigs = runTestBlockState @P8 $ do [acAccountIndex ac | ac <- accountConfigs] -- suspension at snapshot epoch transition - let bakerStakesAndCapital1 = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers0 passiveDelegators0 (Set.fromList [BakerId aix | aix <- validatorIxs]) + let bakerStakesAndCapital1 = + computeBakerStakesAndCapital + (chainParams ^. cpPoolParameters) + activeBakers0 + passiveDelegators0 + (Set.fromList [BakerId aix | aix <- validatorIxs]) liftIO $ assertBool "With all validators suspended at snapshot, baker stakes are empty." @@ -866,13 +871,13 @@ testPrimeForSuspension accountConfigs = runTestBlockState @P8 $ do bs1 <- bsoUpdateMissedRounds bs0 missedRounds (primedBakers, _bs2) <- bsoPrimeForSuspension bs1 0 activeBakerIds0 liftIO $ - assertEqual - "Current active bakers should be primed for suspension as expected" + assertEqual + "Current active bakers should be primed for suspension as expected" (Set.fromList activeBakerIds0) (Set.fromList primedBakers) (primedBakers1, _bs2) <- bsoPrimeForSuspension bs1 5 activeBakerIds0 liftIO $ - assertEqual + assertEqual "Current active bakers should be primed for suspension as expected" (Set.fromList $ drop 5 activeBakerIds0) (Set.fromList $ primedBakers1) @@ -887,15 +892,15 @@ testSuspendPrimedNoPaydayNoSnapshot accountConfigs = runTestBlockState @P8 $ do let activeBakerIds0 = Map.keys bprd0 let missedRounds = Map.fromList $ zip activeBakerIds0 [2 ..] bs1 <- bsoUpdateMissedRounds bs0 missedRounds - -- The maximum missed rounds threshold in the dummy chain parameters are set to 1. - (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 activeBakerIds0 + -- The maximum missed rounds threshold in the dummy chain parameters is set to 1. + (_primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 activeBakerIds0 bs3 <- bsoSetPaydayEpoch bs2 (startEpoch + 10) (res1, _bs4) <- doEpochTransition True hour bs3 liftIO $ assertEqual - "No validators are getting suspended if epoch transition is not at snapshot" - Nothing - (mSnapshotSuspendedIds res1) + "No validators are getting suspended if epoch transition is not at snapshot" + Nothing + (mSnapshotSuspendedIds res1) where hour = Duration 3_600_000 startEpoch = 10 @@ -908,15 +913,42 @@ testSuspendPrimedSnapshotOnly accountConfigs = runTestBlockState @P8 $ do let activeBakerIds0 = Map.keys bprd0 let missedRounds = Map.fromList $ zip activeBakerIds0 [2 ..] bs1 <- bsoUpdateMissedRounds bs0 missedRounds - -- The maximum missed rounds threshold in the dummy chain parameters are set to 1. + -- The maximum missed rounds threshold in the dummy chain parameters is set to 1. (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 activeBakerIds0 bs4 <- bsoSetPaydayEpoch bs2 (startEpoch + 2) (res2, _bs5) <- doEpochTransition True hour bs4 liftIO $ assertEqual - "Primed validators are suspended at snapshot" - (Just $ Set.fromList primedBakers1) - (mSnapshotSuspendedIds res2) + "Primed validators are suspended at snapshot" + (Just $ Set.fromList primedBakers1) + (mSnapshotSuspendedIds res2) + where + hour = Duration 3_600_000 + startEpoch = 10 + startTriggerTime = 1000 + +testSuspendPrimedSnapshotPaydayCombo :: [AccountConfig 'AccountV4] -> Assertion +testSuspendPrimedSnapshotPaydayCombo accountConfigs = runTestBlockState @P8 $ do + bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 1 + bprd0 <- bsoGetBakerPoolRewardDetails bs0 + let activeBakerIds0 = Map.keys bprd0 + let missedRounds = Map.fromList $ zip activeBakerIds0 [2 ..] + bs1 <- bsoUpdateMissedRounds bs0 missedRounds + -- The maximum missed rounds threshold in the dummy chain parameters is set to 1. + (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 activeBakerIds0 + bs4 <- bsoSetPaydayEpoch bs2 (startEpoch + 1) + (EpochTransitionResult{..}, _bs5) <- doEpochTransition True hour bs4 + liftIO $ + assertEqual + "Primed validators are suspended at snapshot" + (Just $ Set.fromList primedBakers1) + mSnapshotSuspendedIds + -- We can't compare newly primed validators to the ones of the previous + -- epoch, because they get rotated. + liftIO $ + assertBool + "Validators are primed after previously primed validators got suspended." + (isJust mPaydayParams) where hour = Duration 3_600_000 startEpoch = 10 @@ -944,3 +976,5 @@ tests = parallel $ describe "EpochTransition" $ do forAll (genAccountConfigs False) testSuspendPrimedNoPaydayNoSnapshot it "testSuspendPrimedSnapshotOnly" $ forAll (genAccountConfigs False) testSuspendPrimedSnapshotOnly + it "testSuspendPrimedSnapshotPaydayCombo" $ + forAll (genAccountConfigs False) testSuspendPrimedSnapshotPaydayCombo From beecbf7e08ddf1b69806a2e4fc6b5b6c16ac26b2 Mon Sep 17 00:00:00 2001 From: drsk Date: Thu, 5 Dec 2024 18:07:18 +0100 Subject: [PATCH 10/21] Update changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 855ca8412..708ec75f3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ ## Unreleased changes +- Automatically suspend validators from the consensus that missed too many + rounds in the previous payday. - Add support for suspend/resume to validator configuration updates. - Validators that are suspended are paused from participating in the consensus algorithm. - Add `GetConsensusDetailedStatus` gRPC endpoint for getting detailed information on the status From 4f92b77a46f96deec6ba2b46bee66a3828aab397 Mon Sep 17 00:00:00 2001 From: drsk Date: Thu, 5 Dec 2024 21:19:56 +0100 Subject: [PATCH 11/21] some more cosmetics --- .../SchedulerTests/KonsensusV1/EpochTransition.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs index 802ee41aa..1f166e26f 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs @@ -897,10 +897,9 @@ testSuspendPrimedNoPaydayNoSnapshot accountConfigs = runTestBlockState @P8 $ do bs3 <- bsoSetPaydayEpoch bs2 (startEpoch + 10) (res1, _bs4) <- doEpochTransition True hour bs3 liftIO $ - assertEqual + assertBool "No validators are getting suspended if epoch transition is not at snapshot" - Nothing - (mSnapshotSuspendedIds res1) + (isNothing $ mSnapshotSuspendedIds res1) where hour = Duration 3_600_000 startEpoch = 10 @@ -916,12 +915,12 @@ testSuspendPrimedSnapshotOnly accountConfigs = runTestBlockState @P8 $ do -- The maximum missed rounds threshold in the dummy chain parameters is set to 1. (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 activeBakerIds0 bs4 <- bsoSetPaydayEpoch bs2 (startEpoch + 2) - (res2, _bs5) <- doEpochTransition True hour bs4 + (res, _bs5) <- doEpochTransition True hour bs4 liftIO $ assertEqual "Primed validators are suspended at snapshot" (Just $ Set.fromList primedBakers1) - (mSnapshotSuspendedIds res2) + (mSnapshotSuspendedIds res) where hour = Duration 3_600_000 startEpoch = 10 From af32b38c076c8a34a125b438c84d263dda7e3967 Mon Sep 17 00:00:00 2001 From: drsk <827698+drsk0@users.noreply.github.com> Date: Mon, 9 Dec 2024 10:45:12 +0100 Subject: [PATCH 12/21] Update concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs Co-authored-by: Thomas Dinsdale-Young --- concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index 8addac108..a1c657d3d 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -124,7 +124,7 @@ data PrologueResult m av = PrologueResult prologuePaydayParameters :: Maybe (PaydayParameters av), -- | If the block triggered an epoch transition and the new epoch is a -- snapshot, this field contains the validator ids that are newly suspended. - -- Otherwise, this is `Nothing`. + -- Otherwise, this is `Nothing`. prologueSuspendedBids :: Maybe (Set.Set BakerId) } From 024552db7168e1036337ab1902a63480d6e9afe7 Mon Sep 17 00:00:00 2001 From: drsk <827698+drsk0@users.noreply.github.com> Date: Mon, 9 Dec 2024 10:45:29 +0100 Subject: [PATCH 13/21] Update concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs Co-authored-by: Thomas Dinsdale-Young --- .../src/Concordium/KonsensusV1/Scheduler.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index a1c657d3d..77c738987 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -157,11 +157,11 @@ paydayHandleCooldowns = case sSupportsFlexibleCooldown (sAccountVersionFor (prot -- | Result of the epoch transition used for parameter passing. data EpochTransitionResult m = EpochTransitionResult - { -- If the epoch transition was a payday, this contains the payday - -- parameters. + { -- | If the epoch transition was a payday, this contains the payday + -- parameters. mPaydayParams :: Maybe (PaydayParameters (AccountVersionFor (MPV m))), - -- If the epoch transition was a snapshot, this contains the set of - -- validator ids that will be newly suspended. + -- | If the epoch transition was a snapshot, this contains the set of + -- validator ids that will be newly suspended. mSnapshotSuspendedIds :: Maybe (Set.Set BakerId) } From 7920c4c0bf39b8f758f0249a8643290bc1369f94 Mon Sep 17 00:00:00 2001 From: drsk Date: Mon, 9 Dec 2024 10:57:12 +0100 Subject: [PATCH 14/21] Updated docs for `processPaydayRewards`. --- concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index 77c738987..0f958357c 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -376,6 +376,8 @@ doMintingP6 mintRate foundationAddr theState0 = do } -- | If a payday has elapsed, this mints and distributes rewards for the payday. +-- If the protocol version >= 8, all validators of the past payday whose missed rounds +-- exceed the threshold given in the chain parameters are primed for suspension. processPaydayRewards :: forall pv m. ( pv ~ MPV m, From 9646f20efafd68c64c9cb2555df8784d220b6566 Mon Sep 17 00:00:00 2001 From: drsk Date: Mon, 9 Dec 2024 10:57:12 +0100 Subject: [PATCH 15/21] make generateNextBakers independent of suspended validator ids. --- concordium-consensus/src/Concordium/Kontrol/Bakers.hs | 8 ++++---- .../src/Concordium/Scheduler/TreeStateEnvironment.hs | 3 +-- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs index a211a8f0b..5bd39ee97 100644 --- a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs +++ b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs @@ -211,7 +211,8 @@ computeBakerStakesAndCapital poolParams activeBakers passiveDelegators snapshotS passiveDelegatorsCapital = Vec.fromList $ delegatorCapital <$> passiveDelegators capitalDistribution = CapitalDistribution{..} --- | Generate and set the next epoch bakers and next capital based on the current active bakers. +-- | Generate and set the next epoch bakers and next capital based on the +-- current active bakers. This assumes that no validators are suspended. generateNextBakers :: forall m. ( TreeStateMonad m, @@ -221,10 +222,9 @@ generateNextBakers :: ) => -- | The payday epoch Epoch -> - Set.Set BakerId -> UpdatableBlockState m -> m (UpdatableBlockState m) -generateNextBakers paydayEpoch suspendedBids bs0 = do +generateNextBakers paydayEpoch bs0 = do isEffective <- effectiveTest paydayEpoch -- Determine the bakers and delegators for the next reward period, accounting for any -- stake reductions that are currently pending on active bakers with effective time at @@ -244,7 +244,7 @@ generateNextBakers paydayEpoch suspendedBids bs0 = do (cps ^. cpPoolParameters) activeBakers passiveDelegators - suspendedBids + Set.empty bs1 <- bsoSetNextEpochBakers bs0 bakerStakes NoParam bsoSetNextCapitalDistribution bs1 capitalDistribution diff --git a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs index ecfb665b8..72438f000 100644 --- a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs +++ b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs @@ -20,7 +20,6 @@ import qualified Data.Map as Map import Data.Maybe import Data.Ratio import qualified Data.Sequence as Seq -import qualified Data.Set as Set import Data.Time import qualified Data.Vector as Vec import Data.Word @@ -1111,7 +1110,7 @@ updateBirkParameters newSeedState bs0 oldChainParameters updates = case protocol processPaydays pd mrps0 bspp0 = do bspp1 <- if oldSeedState ^. epoch < pd - 1 && pd - 1 <= newSeedState ^. epoch - then generateNextBakers pd Set.empty bspp0 + then generateNextBakers pd bspp0 else return bspp0 if pd <= newSeedState ^. epoch then do From af93309cf2885c1d101e30c5fe8839567b314d40 Mon Sep 17 00:00:00 2001 From: drsk Date: Mon, 9 Dec 2024 10:57:12 +0100 Subject: [PATCH 16/21] docs for `computeBakerStakesAndCapital` parameters --- concordium-consensus/src/Concordium/Kontrol/Bakers.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs index 5bd39ee97..5beab1fcf 100644 --- a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs +++ b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs @@ -176,9 +176,15 @@ data BakerStakesAndCapital bakerInfoRef = BakerStakesAndCapital -- | Compute the baker stakes and capital distribution. computeBakerStakesAndCapital :: forall bakerInfoRef. + -- | Pool parameters PoolParameters' 'PoolParametersVersion1 -> + -- | Active validators [ActiveBakerInfo' bakerInfoRef] -> + -- | Passive delegators [ActiveDelegatorInfo] -> + -- | Validator ids that will be suspended during the snapshot transition + -- because they are primed, but are not yet marked as suspended in their + -- `ActiveBakerInfo`. Set.Set BakerId -> BakerStakesAndCapital bakerInfoRef computeBakerStakesAndCapital poolParams activeBakers passiveDelegators snapshotSuspendedBids = BakerStakesAndCapital{..} From fbca9d5dce33fa695a721eef9a169d6e28c28065 Mon Sep 17 00:00:00 2001 From: drsk Date: Mon, 9 Dec 2024 11:28:03 +0100 Subject: [PATCH 17/21] conditionally compute suspended validator ids --- .../src/Concordium/KonsensusV1/Scheduler.hs | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index 0f958357c..a0923149c 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -11,6 +11,7 @@ import Data.Bool.Singletons import qualified Data.Map as Map import Data.Maybe import qualified Data.Set as Set +import Data.Singletons import Data.Time import Data.Word import Lens.Micro.Platform @@ -196,8 +197,8 @@ data EpochTransitionResult m = EpochTransitionResult -- a catastrophic invariant violation. (This does not apply from protocol version 7 onwards, as -- cooldowns are processed differently.) doEpochTransition :: - forall m. - (BlockStateOperations m, MonadProtocolVersion m, IsConsensusV1 (MPV m)) => + forall m pv. + (pv ~ MPV m, BlockStateOperations m, MonadProtocolVersion m, IsConsensusV1 (MPV m)) => -- | Whether the block is the first in a new epoch Bool -> -- | The epoch duration @@ -249,10 +250,12 @@ doEpochTransition True epochDuration theState0 = do then do snapshotPoolRewards <- bsoGetBakerPoolRewardDetails theState7 -- account indexes that will be suspended - let suspendedBids = - Set.fromList - [ bid | (bid, rd) <- Map.toList snapshotPoolRewards, primedForSuspension $ fromCondDef (suspensionInfo rd) emptySuspensionInfo - ] + let suspendedBids + | hasValidatorSuspension = + Set.fromList + [ bid | (bid, rd) <- Map.toList snapshotPoolRewards, primedForSuspension $ fromCondDef (suspensionInfo rd) emptySuspensionInfo + ] + | otherwise = Set.empty -- This is the start of the last epoch of a payday, so take a baker snapshot. let epochEnd = newSeedState ^. triggerBlockTime let av = accountVersionFor (demoteProtocolVersion (protocolVersion @(MPV m))) @@ -278,6 +281,8 @@ doEpochTransition True epochDuration theState0 = do SFalse -> return (Just suspendedBids, theState9) else return (Nothing, theState7) return (EpochTransitionResult mPaydayParams suspendedBids, theState8) + where + hasValidatorSuspension = fromSing $ sSupportsValidatorSuspension (sAccountVersionFor (protocolVersion @pv)) -- | Update the seed state to account for a block. -- See 'updateSeedStateForBlock' for details of what this entails. From 4940c01ce140ec4cb195b71ff3bd48ab62096abb Mon Sep 17 00:00:00 2001 From: drsk Date: Mon, 9 Dec 2024 11:47:49 +0100 Subject: [PATCH 18/21] factor out `primeInactiveValidators` --- .../src/Concordium/KonsensusV1/Scheduler.hs | 56 ++++++++++++------- 1 file changed, 36 insertions(+), 20 deletions(-) diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index a0923149c..bd6d4691f 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -400,35 +400,51 @@ processPaydayRewards (Just PaydayParameters{..}) theState0 = do foundationAddr <- getAccountCanonicalAddress =<< bsoGetFoundationAccount theState0 theState1 <- doMintingP6 paydayMintRate foundationAddr theState0 theState2 <- distributeRewards foundationAddr paydayCapitalDistribution paydayBakers paydayPoolRewards theState1 + primeInactiveValidators (bakerInfoExs paydayBakers ^.. each . bakerIdentity) theState2 + +-- | If the protocol version supports validator suspension, prime the given +-- bakers for suspension and log a special transaction outcome. +primeInactiveValidators :: + forall pv m. + ( pv ~ MPV m, + BlockStateStorage m, + IsConsensusV1 pv, + IsProtocolVersion pv + ) => + [BakerId] -> + UpdatableBlockState m -> + m (UpdatableBlockState m) +primeInactiveValidators paydayBakerIds theState1 = case hasValidatorSuspension of - SFalse -> return theState2 + SFalse -> return theState1 STrue -> do cps <- bsoGetChainParameters theState1 case _cpValidatorScoreParameters cps of NoParam -> return theState1 SomeParam (ValidatorScoreParameters{..}) -> do - (bids, theState3) <- + (bids, theState2) <- bsoPrimeForSuspension - theState2 + theState1 _vspMaxMissedRounds - (bakerInfoExs paydayBakers ^.. each . bakerIdentity) - let addOutcome :: UpdatableBlockState m -> BakerId -> m (UpdatableBlockState m) - addOutcome theState bid = do - -- The account must exist, since it is a validator, so this can't fail - account <- - fromJust - <$> bsoGetAccountByIndex - theState - (bakerAccountIndex bid) - address <- getAccountCanonicalAddress account - let outcome = - ValidatorPrimedForSuspension - { vpfsBakerId = bid, - vpfsAccount = address - } - bsoAddSpecialTransactionOutcome theState outcome - foldM addOutcome theState3 bids + paydayBakerIds + + foldM addOutcome theState2 bids where + addOutcome :: UpdatableBlockState m -> BakerId -> m (UpdatableBlockState m) + addOutcome theState bid = do + -- The account must exist, since it is a validator, so this can't fail + account <- + fromJust + <$> bsoGetAccountByIndex + theState + (bakerAccountIndex bid) + address <- getAccountCanonicalAddress account + let outcome = + ValidatorPrimedForSuspension + { vpfsBakerId = bid, + vpfsAccount = address + } + bsoAddSpecialTransactionOutcome theState outcome hasValidatorSuspension = sSupportsValidatorSuspension (sAccountVersionFor (protocolVersion @pv)) -- | Records that the baker baked this block (so it is eligible for baking rewards) and that the From e04d0975a33efa6988ac39672363ef22dfb66475 Mon Sep 17 00:00:00 2001 From: drsk Date: Mon, 9 Dec 2024 12:03:58 +0100 Subject: [PATCH 19/21] added docs for parameters of bsoPrimeForSuspension --- .../src/Concordium/GlobalState/BlockState.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index 2cbeacd52..57dd8ce95 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -1533,7 +1533,16 @@ class (BlockStateQuery m) => BlockStateOperations m where -- | Mark given validators for possible suspension at the next snapshot -- epoch. Returns the subset of the given validator ids whose missed rounds -- exceeded the given threshold and are now primed for suspension. - bsoPrimeForSuspension :: (PVSupportsDelegation (MPV m), PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> Word64 -> [BakerId] -> m ([BakerId], UpdatableBlockState m) + bsoPrimeForSuspension :: + (PVSupportsDelegation (MPV m), PVSupportsValidatorSuspension (MPV m)) => + UpdatableBlockState m -> + -- | The threshold for maximal missed rounds + Word64 -> + -- | The set of validators that are considered for suspension. This + -- should be the current payday validators. + [BakerId] -> + -- | Returns the subset of primed validator ids and the updated block state + m ([BakerId], UpdatableBlockState m) -- | Suspend validators with the given account indices, if -- 1) the account index points to an existing account From ce83e6ca0744facdd1c449ce0b98721ca5403fa0 Mon Sep 17 00:00:00 2001 From: drsk Date: Mon, 9 Dec 2024 14:22:29 +0100 Subject: [PATCH 20/21] drop bids from bsoPrimeForSuspension --- .../src/Concordium/GlobalState/BlockState.hs | 13 +++++----- .../GlobalState/Persistent/BlockState.hs | 26 ++++++++----------- .../src/Concordium/KonsensusV1/Scheduler.hs | 7 ++--- 3 files changed, 19 insertions(+), 27 deletions(-) diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index 57dd8ce95..7c81152df 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -1531,17 +1531,16 @@ class (BlockStateQuery m) => BlockStateOperations m where bsoUpdateMissedRounds :: (PVSupportsDelegation (MPV m), PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> Map.Map BakerId Word64 -> m (UpdatableBlockState m) -- | Mark given validators for possible suspension at the next snapshot - -- epoch. Returns the subset of the given validator ids whose missed rounds - -- exceeded the given threshold and are now primed for suspension. + -- epoch. Returns the subset of the current epoch validator ids whose + -- missed rounds exceeded the given threshold and are now primed for + -- suspension. bsoPrimeForSuspension :: (PVSupportsDelegation (MPV m), PVSupportsValidatorSuspension (MPV m)) => UpdatableBlockState m -> -- | The threshold for maximal missed rounds Word64 -> - -- | The set of validators that are considered for suspension. This - -- should be the current payday validators. - [BakerId] -> - -- | Returns the subset of primed validator ids and the updated block state + -- | Returns the subset of primed validator ids of the current epoch + -- validators and the updated block state m ([BakerId], UpdatableBlockState m) -- | Suspend validators with the given account indices, if @@ -1872,7 +1871,7 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat bsoSetRewardAccounts s = lift . bsoSetRewardAccounts s bsoIsProtocolUpdateEffective = lift . bsoIsProtocolUpdateEffective bsoUpdateMissedRounds s = lift . bsoUpdateMissedRounds s - bsoPrimeForSuspension s t = lift . bsoPrimeForSuspension s t + bsoPrimeForSuspension s = lift . bsoPrimeForSuspension s bsoSuspendValidators s = lift . bsoSuspendValidators s type StateSnapshot (MGSTrans t m) = StateSnapshot m bsoSnapshotState = lift . bsoSnapshotState diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 82dd7efef..3238de4ca 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -3518,29 +3518,25 @@ doPrimeForSuspension :: ) => PersistentBlockState pv -> Word64 -> - [BakerId] -> m ([BakerId], PersistentBlockState pv) -doPrimeForSuspension pbs threshold bids = do +doPrimeForSuspension pbs threshold = do bprds <- doGetBakerPoolRewardDetails pbs bsp0 <- loadPBS pbs (bidsUpd, bsp') <- do foldM - ( \res@(acc, bsp) bId -> do - let mBprd = Map.lookup bId bprds - case mBprd of - Just bprd - | CTrue SuspensionInfo{..} <- suspensionInfo bprd, - missedRounds > threshold -> do - bsp' <- - modifyBakerPoolRewardDetailsInPoolRewards - bsp - bId - (\bpr -> bpr{suspensionInfo = (\suspInfo -> suspInfo{primedForSuspension = True}) <$> suspensionInfo bpr}) - return (bId : acc, bsp') + ( \res@(acc, bsp) (bId, bprd) -> do + case suspensionInfo bprd of + CTrue SuspensionInfo{..} | missedRounds > threshold -> do + bsp' <- + modifyBakerPoolRewardDetailsInPoolRewards + bsp + bId + (\bpr -> bpr{suspensionInfo = (\suspInfo -> suspInfo{primedForSuspension = True}) <$> suspensionInfo bpr}) + return (bId : acc, bsp') _otherwise -> return res ) ([], bsp0) - bids + (Map.toList bprds) pbs' <- storePBS pbs bsp' return (bidsUpd, pbs') diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index bd6d4691f..b02b188be 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -19,7 +19,6 @@ import Lens.Micro.Platform import Concordium.Logger import Concordium.TimeMonad import Concordium.Types -import Concordium.Types.Accounts (bakerIdentity) import Concordium.Types.Conditionally import Concordium.Types.SeedState @@ -400,7 +399,7 @@ processPaydayRewards (Just PaydayParameters{..}) theState0 = do foundationAddr <- getAccountCanonicalAddress =<< bsoGetFoundationAccount theState0 theState1 <- doMintingP6 paydayMintRate foundationAddr theState0 theState2 <- distributeRewards foundationAddr paydayCapitalDistribution paydayBakers paydayPoolRewards theState1 - primeInactiveValidators (bakerInfoExs paydayBakers ^.. each . bakerIdentity) theState2 + primeInactiveValidators theState2 -- | If the protocol version supports validator suspension, prime the given -- bakers for suspension and log a special transaction outcome. @@ -411,10 +410,9 @@ primeInactiveValidators :: IsConsensusV1 pv, IsProtocolVersion pv ) => - [BakerId] -> UpdatableBlockState m -> m (UpdatableBlockState m) -primeInactiveValidators paydayBakerIds theState1 = +primeInactiveValidators theState1 = case hasValidatorSuspension of SFalse -> return theState1 STrue -> do @@ -426,7 +424,6 @@ primeInactiveValidators paydayBakerIds theState1 = bsoPrimeForSuspension theState1 _vspMaxMissedRounds - paydayBakerIds foldM addOutcome theState2 bids where From 12cdcb599d931ea6487216efc795250727a5e4e1 Mon Sep 17 00:00:00 2001 From: drsk Date: Tue, 10 Dec 2024 11:05:26 +0100 Subject: [PATCH 21/21] update tests --- .../SchedulerTests/KonsensusV1/EpochTransition.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs index 1f166e26f..c32835b60 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs +++ b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs @@ -869,13 +869,13 @@ testPrimeForSuspension accountConfigs = runTestBlockState @P8 $ do let activeBakerIds0 = Map.keys bprd let missedRounds = Map.fromList $ zip activeBakerIds0 [1 ..] bs1 <- bsoUpdateMissedRounds bs0 missedRounds - (primedBakers, _bs2) <- bsoPrimeForSuspension bs1 0 activeBakerIds0 + (primedBakers, _bs2) <- bsoPrimeForSuspension bs1 0 liftIO $ assertEqual "Current active bakers should be primed for suspension as expected" (Set.fromList activeBakerIds0) (Set.fromList primedBakers) - (primedBakers1, _bs2) <- bsoPrimeForSuspension bs1 5 activeBakerIds0 + (primedBakers1, _bs2) <- bsoPrimeForSuspension bs1 5 liftIO $ assertEqual "Current active bakers should be primed for suspension as expected" @@ -893,7 +893,7 @@ testSuspendPrimedNoPaydayNoSnapshot accountConfigs = runTestBlockState @P8 $ do let missedRounds = Map.fromList $ zip activeBakerIds0 [2 ..] bs1 <- bsoUpdateMissedRounds bs0 missedRounds -- The maximum missed rounds threshold in the dummy chain parameters is set to 1. - (_primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 activeBakerIds0 + (_primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 bs3 <- bsoSetPaydayEpoch bs2 (startEpoch + 10) (res1, _bs4) <- doEpochTransition True hour bs3 liftIO $ @@ -913,7 +913,7 @@ testSuspendPrimedSnapshotOnly accountConfigs = runTestBlockState @P8 $ do let missedRounds = Map.fromList $ zip activeBakerIds0 [2 ..] bs1 <- bsoUpdateMissedRounds bs0 missedRounds -- The maximum missed rounds threshold in the dummy chain parameters is set to 1. - (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 activeBakerIds0 + (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 bs4 <- bsoSetPaydayEpoch bs2 (startEpoch + 2) (res, _bs5) <- doEpochTransition True hour bs4 liftIO $ @@ -934,7 +934,7 @@ testSuspendPrimedSnapshotPaydayCombo accountConfigs = runTestBlockState @P8 $ do let missedRounds = Map.fromList $ zip activeBakerIds0 [2 ..] bs1 <- bsoUpdateMissedRounds bs0 missedRounds -- The maximum missed rounds threshold in the dummy chain parameters is set to 1. - (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 activeBakerIds0 + (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 bs4 <- bsoSetPaydayEpoch bs2 (startEpoch + 1) (EpochTransitionResult{..}, _bs5) <- doEpochTransition True hour bs4 liftIO $