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 diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index fd2b2c9a5..7c81152df 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs @@ -1530,6 +1530,27 @@ 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. 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 -> + -- | 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 + -- 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 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 @@ -1850,6 +1871,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 = lift . bsoPrimeForSuspension s + bsoSuspendValidators s = lift . bsoSuspendValidators s type StateSnapshot (MGSTrans t m) = StateSnapshot m bsoSnapshotState = lift . bsoSnapshotState bsoRollback s = lift . bsoRollback s @@ -1907,6 +1930,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..3238de4ca 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs @@ -3509,6 +3509,83 @@ 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 + ) => + PersistentBlockState pv -> + Word64 -> + m ([BakerId], PersistentBlockState pv) +doPrimeForSuspension pbs threshold = do + bprds <- doGetBakerPoolRewardDetails pbs + bsp0 <- loadPBS pbs + (bidsUpd, bsp') <- do + foldM + ( \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) + (Map.toList bprds) + 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 indices that were suspended together with their canonical account +-- addresses. +doSuspendValidators :: + forall pv m. + ( SupportsPersistentState pv m + ) => + PersistentBlockState pv -> + [AccountIndex] -> + m ([(AccountIndex, AccountAddress)], 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) + address <- accountCanonicalAddress newAcc + return ((ai, address) : 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 +4532,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/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/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index 477d76fa8..b02b188be 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs @@ -9,6 +9,9 @@ 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.Singletons import Data.Time import Data.Word import Lens.Micro.Platform @@ -16,13 +19,14 @@ import Lens.Micro.Platform import Concordium.Logger import Concordium.TimeMonad import Concordium.Types +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 +121,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 +155,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: -- @@ -178,16 +196,16 @@ paydayHandleCooldowns = case sSupportsFlexibleCooldown (sAccountVersionFor (prot -- 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 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 +243,18 @@ 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 + | 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))) @@ -239,6 +266,7 @@ doEpochTransition True epochDuration theState0 = do (chainParams ^. cpPoolParameters) activeBakers passiveDelegators + suspendedBids theState8 <- bsoSetNextEpochBakers theState7 @@ -248,10 +276,12 @@ 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) + where + hasValidatorSuspension = fromSing $ sSupportsValidatorSuspension (sAccountVersionFor (protocolVersion @pv)) -- | Update the seed state to account for a block. -- See 'updateSeedStateForBlock' for details of what this entails. @@ -303,13 +333,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 @@ -349,10 +380,14 @@ 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, BlockStateStorage m, - IsConsensusV1 pv + IsConsensusV1 pv, + IsProtocolVersion pv ) => Maybe (PaydayParameters (AccountVersionFor (MPV m))) -> UpdatableBlockState m -> @@ -363,7 +398,51 @@ 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 + primeInactiveValidators 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 + ) => + UpdatableBlockState m -> + m (UpdatableBlockState m) +primeInactiveValidators theState1 = + case hasValidatorSuspension of + SFalse -> return theState1 + STrue -> do + cps <- bsoGetChainParameters theState1 + case _cpValidatorScoreParameters cps of + NoParam -> return theState1 + SomeParam (ValidatorScoreParameters{..}) -> do + (bids, theState2) <- + bsoPrimeForSuspension + theState1 + _vspMaxMissedRounds + + 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 -- finalizers that signed the QC in the block are awake (and eligible for finalizer rewards). @@ -402,10 +481,33 @@ 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] + 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 -- payday. executeBlockEpilogue :: + forall pv m. ( pv ~ MPV m, IsProtocolVersion pv, BlockStateStorage m, @@ -416,12 +518,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 +702,7 @@ executeBlockState execData@BlockExecutionData{..} transactions = do prologuePaydayParameters terTransactionRewardParameters bedMissedRounds + prologueSuspendedBids terBlockState return (endState, terEnergyUsed) @@ -647,6 +758,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..5beab1fcf 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 @@ -175,11 +176,18 @@ 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 = BakerStakesAndCapital{..} +computeBakerStakesAndCapital poolParams activeBakers passiveDelegators snapshotSuspendedBids = BakerStakesAndCapital{..} where leverage = poolParams ^. ppLeverageBound capitalBound = poolParams ^. ppCapitalBound @@ -195,7 +203,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 @@ -209,7 +217,8 @@ computeBakerStakesAndCapital poolParams activeBakers passiveDelegators = BakerSt 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, @@ -241,6 +250,7 @@ generateNextBakers paydayEpoch bs0 = do (cps ^. cpPoolParameters) activeBakers passiveDelegators + Set.empty bs1 <- bsoSetNextEpochBakers bs0 bakerStakes NoParam bsoSetNextCapitalDistribution bs1 capitalDistribution @@ -389,7 +399,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/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 diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs index cdbd60b44..c32835b60 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 $ @@ -793,6 +796,30 @@ 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 @@ -804,21 +831,21 @@ testComputeBakerStakesAndCapital accountConfigs = runTestBlockState @P8 $ do bs0 validatorIxs (activeBakers1, passiveDelegators1) <- bsoGetActiveBakersAndDelegators bs1 - let bakerStakesAndCapital1 = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers1 passiveDelegators1 + 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 @@ -835,6 +862,97 @@ 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 + liftIO $ + assertEqual + "Current active bakers should be primed for suspension as expected" + (Set.fromList activeBakerIds0) + (Set.fromList primedBakers) + (primedBakers1, _bs2) <- bsoPrimeForSuspension bs1 5 + 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 is set to 1. + (_primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 + bs3 <- bsoSetPaydayEpoch bs2 (startEpoch + 10) + (res1, _bs4) <- doEpochTransition True hour bs3 + liftIO $ + assertBool + "No validators are getting suspended if epoch transition is not at snapshot" + (isNothing $ 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 is set to 1. + (primedBakers1, bs2) <- bsoPrimeForSuspension bs1 1 + bs4 <- bsoSetPaydayEpoch bs2 (startEpoch + 2) + (res, _bs5) <- doEpochTransition True hour bs4 + liftIO $ + assertEqual + "Primed validators are suspended at snapshot" + (Just $ Set.fromList primedBakers1) + (mSnapshotSuspendedIds res) + 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 + 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 + startTriggerTime = 1000 + tests :: Spec tests = parallel $ describe "EpochTransition" $ do it "testEpochTransitionNoPaydayNoSnapshot" $ @@ -851,3 +969,11 @@ 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 + it "testSuspendPrimedSnapshotPaydayCombo" $ + forAll (genAccountConfigs False) testSuspendPrimedSnapshotPaydayCombo