Primed for suspension

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

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

@@ -1530,6 +1530,28 @@ 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 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 ->
+        -- | 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
+    --  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 +1872,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 +1931,8 @@ instance (Monad (t m), MonadTrans t, BlockStateOperations m) => BlockStateOperat
     {-# INLINE bsoGetCurrentEpochBakers #-}
     {-# INLINE bsoIsProtocolUpdateEffective #-}
     {-# INLINE bsoUpdateMissedRounds #-}
+    {-# INLINE bsoPrimeForSuspension #-}
+    {-# INLINE bsoSuspendValidators #-}
     {-# INLINE bsoSnapshotState #-}
     {-# INLINE bsoRollback #-}
 

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

@@ -3509,6 +3509,87 @@ 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 ->
+    [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 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 +4536,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

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)