suspension via computeBakerStakesAndCapital

CHANGELOG.md

@@ -3,6 +3,7 @@
 ## Unreleased changes
 
 - 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
   of the consensus, at consensus version 1.
 - Update Rust version to 1.82.

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

@@ -734,7 +734,11 @@ data ActiveBakerInfo' bakerInfoRef = ActiveBakerInfo
       activeBakerPendingChange :: !(StakePendingChange' Timestamp),
       -- | Information about the delegators to the baker in ascending order of 'DelegatorId'.
       --  (There must be no duplicate 'DelegatorId's.)
-      activeBakerDelegators :: ![ActiveDelegatorInfo]
+      activeBakerDelegators :: ![ActiveDelegatorInfo],
+      -- | A flag indicating whether the baker is suspended.
+      activeBakerIsSuspended :: !Bool,
+      -- | The id of the baker.
+      activeBakerId :: !BakerId
     }
     deriving (Eq, Show)
 

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

@@ -84,6 +84,7 @@ import Concordium.Types
 import Concordium.Types.Accounts (AccountBaker (..))
 import qualified Concordium.Types.Accounts as BaseAccounts
 import qualified Concordium.Types.AnonymityRevokers as ARS
+import Concordium.Types.Conditionally
 import Concordium.Types.Execution (DelegationTarget (..), TransactionIndex, TransactionSummary)
 import qualified Concordium.Types.Execution as Transactions
 import Concordium.Types.HashableTo
@@ -1336,7 +1337,19 @@ doGetActiveBakersAndDelegators pbs = do
                           activeBakerEquityCapital = theBaker ^. BaseAccounts.stakedAmount,
                           activeBakerPendingChange =
                             BaseAccounts.pendingChangeEffectiveTimestamp <$> theBaker ^. BaseAccounts.bakerPendingChange,
-                          activeBakerDelegators = abd
+                          activeBakerDelegators = abd,
+                          activeBakerIsSuspended =
+                            fromCondDef
+                                ( BaseAccounts._bieAccountIsSuspended $
+                                    BaseAccounts._accountBakerInfo $
+                                        theBaker
+                                )
+                                False,
+                          activeBakerId =
+                            BaseAccounts._bakerIdentity $
+                                BaseAccounts._bieBakerInfo $
+                                    BaseAccounts._accountBakerInfo $
+                                        theBaker
                         }
     mkActiveDelegatorInfo :: BlockStatePointers pv -> DelegatorId -> m ActiveDelegatorInfo
     mkActiveDelegatorInfo bsp activeDelegatorId@(DelegatorId acct) =

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

@@ -244,8 +244,7 @@ doEpochTransition True epochDuration theState0 = do
                         theState7
                         bakerStakes
                         (chainParams ^. cpFinalizationCommitteeParameters)
-                capDist <- capitalDistributionM
-                theState9 <- bsoSetNextCapitalDistribution theState8 capDist
+                theState9 <- bsoSetNextCapitalDistribution theState8 capitalDistribution
                 -- 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

concordium-consensus/src/Concordium/Kontrol/Bakers.hs

@@ -165,21 +165,20 @@ effectiveTest' genData paydayEpoch = (<= paydayEpochTime)
 -- | A helper datatype for computing the stake and capital distribution.
 --  This is intentionally lazy, as the caller may not wish to evaluate all of the fields, but
 --  constructing them together can avoid unnecessary duplication of work.
-data BakerStakesAndCapital m = BakerStakesAndCapital
+data BakerStakesAndCapital bakerInfoRef = BakerStakesAndCapital
     { -- | The baker info and stake for each baker.
-      bakerStakes :: [(BakerInfoRef m, Amount)],
+      bakerStakes :: [(bakerInfoRef, Amount)],
       -- | Determine the capital distribution.
-      capitalDistributionM :: m CapitalDistribution
+      capitalDistribution :: CapitalDistribution
     }
 
 -- | Compute the baker stakes and capital distribution.
 computeBakerStakesAndCapital ::
-    forall m.
-    (AccountOperations m) =>
+    forall bakerInfoRef.
     PoolParameters' 'PoolParametersVersion1 ->
-    [ActiveBakerInfo m] ->
+    [ActiveBakerInfo' bakerInfoRef] ->
     [ActiveDelegatorInfo] ->
-    BakerStakesAndCapital m
+    BakerStakesAndCapital bakerInfoRef
 computeBakerStakesAndCapital poolParams activeBakers passiveDelegators = BakerStakesAndCapital{..}
   where
     leverage = poolParams ^. ppLeverageBound
@@ -196,20 +195,19 @@ computeBakerStakesAndCapital poolParams activeBakers passiveDelegators = BakerSt
               capLimit
             ]
         )
-    bakerStakes = zipWith makeBakerStake activeBakers poolCapitals
+    filteredActiveBakers = [abi | abi@ActiveBakerInfo{..} <- activeBakers, not activeBakerIsSuspended]
+    filteredPoolCapitals = poolCapital <$> filteredActiveBakers
+    bakerStakes = zipWith makeBakerStake filteredActiveBakers filteredPoolCapitals
     delegatorCapital ActiveDelegatorInfo{..} = DelegatorCapital activeDelegatorId activeDelegatorStake
-    bakerCapital ActiveBakerInfo{..} = do
-        bid <- _bakerIdentity <$> derefBakerInfo activeBakerInfoRef
-        return
-            BakerCapital
-                { bcBakerId = bid,
-                  bcBakerEquityCapital = activeBakerEquityCapital,
-                  bcDelegatorCapital = Vec.fromList $ delegatorCapital <$> activeBakerDelegators
-                }
-    capitalDistributionM = do
-        bakerPoolCapital <- Vec.fromList <$> mapM bakerCapital activeBakers
-        let passiveDelegatorsCapital = Vec.fromList $ delegatorCapital <$> passiveDelegators
-        return CapitalDistribution{..}
+    bakerCapital ActiveBakerInfo{..} =
+        BakerCapital
+            { bcBakerId = activeBakerId,
+              bcBakerEquityCapital = activeBakerEquityCapital,
+              bcDelegatorCapital = Vec.fromList $ delegatorCapital <$> activeBakerDelegators
+            }
+    bakerPoolCapital = Vec.fromList $ bakerCapital <$> filteredActiveBakers
+    passiveDelegatorsCapital = Vec.fromList $ delegatorCapital <$> passiveDelegators
+    capitalDistribution = CapitalDistribution{..}
 
 -- | Generate and set the next epoch bakers and next capital based on the current active bakers.
 generateNextBakers ::
@@ -244,8 +242,7 @@ generateNextBakers paydayEpoch bs0 = do
                 activeBakers
                 passiveDelegators
     bs1 <- bsoSetNextEpochBakers bs0 bakerStakes NoParam
-    capDist <- capitalDistributionM
-    bsoSetNextCapitalDistribution bs1 capDist
+    bsoSetNextCapitalDistribution bs1 capitalDistribution
 
 -- | Compute the epoch of the last payday at or before the given epoch.
 --  This accounts for changes to the reward period length.
@@ -392,7 +389,7 @@ getSlotBakersP4 genData bs slot =
                                         ePoolParams pp' updates
                                 ePoolParams pp _ = pp
                                 effectivePoolParameters = ePoolParams (chainParams ^. cpPoolParameters) pendingPoolParams
-                                bsc = computeBakerStakesAndCapital @m effectivePoolParameters activeBakers passiveDelegators
+                                bsc = computeBakerStakesAndCapital effectivePoolParameters activeBakers passiveDelegators
                             let mkFullBaker (biRef, _bakerStake) = do
                                     _theBakerInfo <- derefBakerInfo biRef
                                     return FullBakerInfo{..}

concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LeaderElectionTest.hs

@@ -157,40 +157,40 @@ testComputeMissedRounds :: Spec
 testComputeMissedRounds =
     describe "computeMissedRounds" $ do
         it "no timeout" $
-            ( Map.toList $
-                computeMissedRounds
+            Map.toList
+                ( computeMissedRounds
                     Absent
                     dummyFullBakers
                     (read "ba3aba3b6c31fb6b0251a19c83666cd90da9a0835a2b54dc4f01c6d451ab24e8")
                     6
-            )
+                )
                 `shouldBe` []
         it "timeout present, 1 missed round" $
-            ( Map.toList $
-                computeMissedRounds
+            Map.toList
+                ( computeMissedRounds
                     (Present $ dummyTimeoutCertificate 5)
                     dummyFullBakers
                     (read "ba3aba3b6c31fb6b0251a19c83666cd90da9a0835a2b54dc4f01c6d451ab24e8")
                     6
-            )
+                )
                 `shouldBe` [(1, 1)]
         it "timeout present, 3 missed rounds" $
-            ( Map.toList $
-                computeMissedRounds
+            Map.toList
+                ( computeMissedRounds
                     (Present $ dummyTimeoutCertificate 5)
                     dummyFullBakers
                     (read "ba3aba3b6c31fb6b0251a19c83666cd90da9a0835a2b54dc4f01c6d451ab24e8")
                     8
-            )
+                )
                 `shouldBe` [(1, 2), (2, 1)]
         it "timeout present, 95 missed rounds" $
-            ( Map.toList $
-                computeMissedRounds
+            Map.toList
+                ( computeMissedRounds
                     (Present $ dummyTimeoutCertificate 5)
                     dummyFullBakers
                     (read "ba3aba3b6c31fb6b0251a19c83666cd90da9a0835a2b54dc4f01c6d451ab24e8")
                     100
-            )
+                )
                 `shouldBe` [(1, 46), (2, 49)]
 
 tests :: Spec

concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs

@@ -335,8 +335,7 @@ makeInitialState accs seedState rpLen = withIsAuthorizationsVersionForPV (protoc
     (activeBakers, passiveDelegators) <- bsoGetActiveBakersAndDelegators pbs0
     let BakerStakesAndCapital{..} = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers passiveDelegators
     pbs1 <- bsoSetNextEpochBakers pbs0 bakerStakes (chainParams ^. cpFinalizationCommitteeParameters)
-    capDist <- capitalDistributionM
-    pbs2 <- bsoSetNextCapitalDistribution pbs1 capDist
+    pbs2 <- bsoSetNextCapitalDistribution pbs1 capitalDistribution
     pbs <- bsoRotateCurrentCapitalDistribution =<< bsoRotateCurrentEpochBakers pbs2
 
     bsp <- loadPBS pbs
@@ -476,7 +475,7 @@ testEpochTransitionSnapshotOnly accountConfigs = runTestBlockState @P7 $ do
                 (chainParams ^. cpPoolParameters)
                 activeBakers
                 activeDelegators
-    updatedCapitalDistr <- capitalDistributionM
+    let updatedCapitalDistr = capitalDistribution
     let mkFullBaker (ref, stake) = do
             loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case
                 (BakerInfoExV1 info extra _isSuspended) ->
@@ -535,7 +534,7 @@ testEpochTransitionSnapshotPayday accountConfigs = runTestBlockState @P7 $ do
                 (chainParams ^. cpPoolParameters)
                 activeBakers
                 activeDelegators
-    updatedCapitalDistr <- capitalDistributionM
+    let updatedCapitalDistr = capitalDistribution
     let mkFullBaker (ref, stake) = do
             loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case
                 (BakerInfoExV1 info extra _isSuspended) ->
@@ -610,7 +609,9 @@ testEpochTransitionSnapshotPayday accountConfigs = runTestBlockState @P7 $ do
 -- | Test epoch transitions for two successive transitions where the payday length is one epoch.
 -- In this case, both the snapshot and payday processing occur on each transition, so this tests
 -- that they are correctly ordered.
-testEpochTransitionSnapshotPaydayCombo :: [AccountConfig 'AccountV3] -> Assertion
+testEpochTransitionSnapshotPaydayCombo ::
+    [AccountConfig 'AccountV3] ->
+    Assertion
 testEpochTransitionSnapshotPaydayCombo accountConfigs = runTestBlockState @P7 $ do
     -- Setup the initial state.
     bs0 <- makeInitialState accountConfigs (transitionalSeedState startEpoch startTriggerTime) 1
@@ -623,7 +624,7 @@ testEpochTransitionSnapshotPaydayCombo accountConfigs = runTestBlockState @P7 $
                 (chainParams ^. cpPoolParameters)
                 activeBakers
                 activeDelegators
-    updatedCapitalDistr <- capitalDistributionM
+    let updatedCapitalDistr = capitalDistribution
     let mkFullBaker (ref, stake) = do
             loadPersistentBakerInfoRef @_ @'AccountV3 ref <&> \case
                 (BakerInfoExV1 info extra _isSuspended) ->
@@ -729,7 +730,7 @@ testMissedRoundsUpdate accountConfigs = runTestBlockState @P8 $ do
     chainParams <- bsoGetChainParameters bs1
     (activeBakers, passiveDelegators) <- bsoGetActiveBakersAndDelegators bs1
     let BakerStakesAndCapital{..} = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers passiveDelegators
-    CapitalDistribution{..} <- capitalDistributionM
+    let CapitalDistribution{..} = capitalDistribution
     let n = Vec.length bakerPoolCapital `div` 2
     let newBakerStake = take n bakerStakes
     bids <- Set.fromList <$> mapM (loadBakerId . fst) newBakerStake
@@ -763,6 +764,74 @@ testMissedRoundsUpdate accountConfigs = runTestBlockState @P8 $ do
     startEpoch = 10
     startTriggerTime = 1000
 
+-- | Test that suspended validators have zero stake.
+testComputeBakerStakesAndCapital :: [AccountConfig 'AccountV4] -> Assertion
+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 capitalDistribution0 = capitalDistribution bakerStakesAndCapital0
+    let passiveDelegatorCapital0 = passiveDelegatorsCapital capitalDistribution0
+    liftIO $
+        assertBool
+            "With no validators suspended, baker stakes are not empty."
+            (not $ null $ bakerStakes bakerStakesAndCapital0)
+    liftIO $
+        assertBool
+            "With no validators suspended, baker pool capital is not empty."
+            (not $ Vec.null $ bakerPoolCapital capitalDistribution0)
+    validatorIxs <-
+        filterM
+            ( \i -> do
+                mbAcc <- bsoGetAccountByIndex bs0 i
+                case mbAcc of
+                    Nothing -> return False
+                    Just acc -> isJust <$> getAccountBakerInfoRef acc
+            )
+            [acAccountIndex ac | ac <- accountConfigs]
+    bs1 <-
+        foldM
+            ( \bs i -> do
+                bsErr <- bsoUpdateValidator bs (Timestamp 1000) i suspendValidator
+                case bsErr of
+                    Left err -> liftIO $ assertFailure $ "Failed to suspend validator: " ++ show err
+                    Right (_, bs') -> return bs'
+            )
+            bs0
+            validatorIxs
+    (activeBakers1, passiveDelegators1) <- bsoGetActiveBakersAndDelegators bs1
+    let bakerStakesAndCapital1 = computeBakerStakesAndCapital (chainParams ^. cpPoolParameters) activeBakers1 passiveDelegators1
+    liftIO $
+        assertBool
+            "With all validators suspended, baker stakes are empty."
+            (null $ bakerStakes bakerStakesAndCapital1)
+    let capitalDistribution1 = capitalDistribution bakerStakesAndCapital1
+    let passiveDelegatorCapital1 = passiveDelegatorsCapital capitalDistribution1
+    liftIO $
+        assertBool
+            "With all validators suspended, baker pool capital is empty."
+            (Vec.null $ bakerPoolCapital capitalDistribution1)
+    liftIO $
+        assertBool
+            "Passive delegator capital is unchanged"
+            (passiveDelegatorCapital0 == passiveDelegatorCapital1)
+  where
+    startEpoch = 10
+    startTriggerTime = 1000
+    suspendValidator =
+        ValidatorUpdate
+            { vuKeys = Nothing,
+              vuCapital = Nothing,
+              vuRestakeEarnings = Nothing,
+              vuOpenForDelegation = Nothing,
+              vuMetadataURL = Nothing,
+              vuTransactionFeeCommission = Nothing,
+              vuBakingRewardCommission = Nothing,
+              vuFinalizationRewardCommission = Nothing,
+              vuSuspend = Just True
+            }
+
 tests :: Spec
 tests = parallel $ describe "EpochTransition" $ do
     it "testEpochTransitionNoPaydayNoSnapshot" $
@@ -777,3 +846,5 @@ tests = parallel $ describe "EpochTransition" $ do
         forAll (genAccountConfigs False) testEpochTransitionSnapshotPaydayCombo
     it "testMissedRoundsUpdate" $
         forAll (genAccountConfigs False) testMissedRoundsUpdate
+    it "testComputeBakerStakesAndCapital" $
+        forAll (genAccountConfigs False) testComputeBakerStakesAndCapital