diff --git a/CHANGELOG.md b/CHANGELOG.md index 7d114a6a9d..1aa4021551 100644 --- a/CHANGELOG.md +++ b/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. diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs index 17a1faa12d..4abf69dc47 100644 --- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs +++ b/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) diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs index 254d189d1e..ef5b872b8c 100644 --- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs +++ b/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) = diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs index 5dcae8fe74..477d76fa80 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs +++ b/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 diff --git a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs b/concordium-consensus/src/Concordium/Kontrol/Bakers.hs index 2cc906752c..af28d8dc2f 100644 --- a/concordium-consensus/src/Concordium/Kontrol/Bakers.hs +++ b/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{..} diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LeaderElectionTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LeaderElectionTest.hs index 6aea061b28..913e28bf77 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LeaderElectionTest.hs +++ b/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 diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs b/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs index 1490afd4e8..9c1ab1157c 100644 --- a/concordium-consensus/tests/scheduler/SchedulerTests/KonsensusV1/EpochTransition.hs +++ b/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