From e8f9889219ed49b22683873a3a8eaa46bb23826d Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 5 Sep 2024 18:54:23 -0600 Subject: [PATCH 1/8] Avoid passing arguments that are available in scope --- .../impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index 5959b8738b9..c57d4e98097 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -162,10 +162,13 @@ conwayDelegTransition = do , c ) <- judgmentContext - let ppKeyDeposit = pp ^. ppKeyDepositL + let + ppKeyDeposit = pp ^. ppKeyDepositL + checkDepositAgainstPParams deposit = + deposit == ppKeyDeposit ?! IncorrectDepositDELEG deposit case c of ConwayRegCert stakeCred sMayDeposit -> do - forM_ sMayDeposit $ checkDepositAgainstPParams ppKeyDeposit + forM_ sMayDeposit checkDepositAgainstPParams dsUnified' <- checkAndAcceptDepositForStakeCred stakeCred ppKeyDeposit dsUnified pure $ dState {dsUnified = dsUnified'} ConwayUnRegCert stakeCred sMayDeposit -> do @@ -178,8 +181,8 @@ conwayDelegTransition = do checkStakeKeyIsRegistered stakeCred dsUnified pure $ dState {dsUnified = processDelegation stakeCred delegatee dsUnified} ConwayRegDelegCert stakeCred delegatee deposit -> do + checkDepositAgainstPParams deposit checkStakeDelegateeRegistered pools delegatee - checkDepositAgainstPParams ppKeyDeposit deposit dsUnified' <- checkAndAcceptDepositForStakeCred stakeCred deposit dsUnified pure $ dState {dsUnified = processDelegation stakeCred delegatee dsUnified'} where @@ -209,8 +212,6 @@ conwayDelegTransition = do DelegStake sPool -> delegStake stakeCred sPool dsUnified DelegVote dRep -> delegVote stakeCred dRep dsUnified DelegStakeVote sPool dRep -> delegVote stakeCred dRep $ delegStake stakeCred sPool dsUnified - checkDepositAgainstPParams ppKeyDeposit deposit = - deposit == ppKeyDeposit ?! IncorrectDepositDELEG deposit checkDepositAgainstPaidDeposit stakeCred dsUnified deposit = Just deposit == fmap (UM.fromCompact . UM.rdDeposit) (UM.lookup stakeCred $ UM.RewDepUView dsUnified) From 6ba4f95ade604216521e1413cd158c87a4fc4801 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 5 Sep 2024 19:02:09 -0600 Subject: [PATCH 2/8] Further simplification of stake credential registration --- .../src/Cardano/Ledger/Conway/Rules/Deleg.hs | 28 +++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index c57d4e98097..cb45b935325 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -166,11 +166,18 @@ conwayDelegTransition = do ppKeyDeposit = pp ^. ppKeyDepositL checkDepositAgainstPParams deposit = deposit == ppKeyDeposit ?! IncorrectDepositDELEG deposit + registerStakeCredential stakeCred dsUnified = + -- This looks like it should have been a right-biased union, so that the (reward, deposit) pair would be inserted + -- (or overwritten) in the UMap. But since we are sure that the stake credential isn't a member yet + -- it will still work. The reason we cannot use a right-biased union here is because UMap treats deposits specially + -- in right-biased unions, and is unable to accept new deposits. + UM.RewDepUView dsUnified + UM.∪ (stakeCred, UM.RDPair (UM.CompactCoin 0) (UM.compactCoinOrError ppKeyDeposit)) case c of ConwayRegCert stakeCred sMayDeposit -> do forM_ sMayDeposit checkDepositAgainstPParams - dsUnified' <- checkAndAcceptDepositForStakeCred stakeCred ppKeyDeposit dsUnified - pure $ dState {dsUnified = dsUnified'} + checkStakeKeyNotRegistered stakeCred dsUnified + pure $ dState {dsUnified = registerStakeCredential stakeCred dsUnified} ConwayUnRegCert stakeCred sMayDeposit -> do checkStakeKeyIsRegistered stakeCred dsUnified checkStakeKeyHasZeroRewardBalance stakeCred dsUnified @@ -183,8 +190,11 @@ conwayDelegTransition = do ConwayRegDelegCert stakeCred delegatee deposit -> do checkDepositAgainstPParams deposit checkStakeDelegateeRegistered pools delegatee - dsUnified' <- checkAndAcceptDepositForStakeCred stakeCred deposit dsUnified - pure $ dState {dsUnified = processDelegation stakeCred delegatee dsUnified'} + checkStakeKeyNotRegistered stakeCred dsUnified + pure $ + dState + { dsUnified = processDelegation stakeCred delegatee $ registerStakeCredential stakeCred dsUnified + } where checkStakeDelegateeRegistered pools = let checkPoolRegistered targetPool = @@ -193,16 +203,6 @@ conwayDelegTransition = do DelegStake targetPool -> checkPoolRegistered targetPool DelegStakeVote targetPool _ -> checkPoolRegistered targetPool DelegVote _ -> pure () - -- Whenever we want to accept new deposit, we must always check if the stake credential isn't already registered. - checkAndAcceptDepositForStakeCred stakeCred deposit dsUnified = do - checkStakeKeyNotRegistered stakeCred dsUnified - -- This looks like it should have been a right-biased union, so that the (reward, deposit) pair would be inserted - -- (or overwritten) in the UMap. But since we are sure that the stake credential isn't a member yet - -- it will still work. The reason we cannot use a right-biased union here is because UMap treats deposits specially - -- in right-biased unions, and is unable to accept new deposits. - pure $ - UM.RewDepUView dsUnified - UM.∪ (stakeCred, UM.RDPair (UM.CompactCoin 0) (UM.compactCoinOrError deposit)) delegStake stakeCred sPool dsUnified = UM.SPoolUView dsUnified UM.⨃ Map.singleton stakeCred sPool delegVote stakeCred dRep dsUnified = From 79b6c0120356985129a354aa93f3724b1074d0e2 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 5 Sep 2024 19:03:17 -0600 Subject: [PATCH 3/8] Consistent order of checks --- eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index cb45b935325..2f1b96eddd5 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -179,18 +179,18 @@ conwayDelegTransition = do checkStakeKeyNotRegistered stakeCred dsUnified pure $ dState {dsUnified = registerStakeCredential stakeCred dsUnified} ConwayUnRegCert stakeCred sMayDeposit -> do + forM_ sMayDeposit $ checkDepositAgainstPaidDeposit stakeCred dsUnified checkStakeKeyIsRegistered stakeCred dsUnified checkStakeKeyHasZeroRewardBalance stakeCred dsUnified - forM_ sMayDeposit $ checkDepositAgainstPaidDeposit stakeCred dsUnified pure $ dState {dsUnified = UM.domDeleteAll (Set.singleton stakeCred) dsUnified} ConwayDelegCert stakeCred delegatee -> do - checkStakeDelegateeRegistered pools delegatee checkStakeKeyIsRegistered stakeCred dsUnified + checkStakeDelegateeRegistered pools delegatee pure $ dState {dsUnified = processDelegation stakeCred delegatee dsUnified} ConwayRegDelegCert stakeCred delegatee deposit -> do checkDepositAgainstPParams deposit - checkStakeDelegateeRegistered pools delegatee checkStakeKeyNotRegistered stakeCred dsUnified + checkStakeDelegateeRegistered pools delegatee pure $ dState { dsUnified = processDelegation stakeCred delegatee $ registerStakeCredential stakeCred dsUnified From e5dca5fcd73d601457956033923d1e744922ef00 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 5 Sep 2024 19:11:50 -0600 Subject: [PATCH 4/8] Avoid complex comment by switching to `UMap.insert` --- .../impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index 2f1b96eddd5..e8aeba5ef34 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -166,18 +166,14 @@ conwayDelegTransition = do ppKeyDeposit = pp ^. ppKeyDepositL checkDepositAgainstPParams deposit = deposit == ppKeyDeposit ?! IncorrectDepositDELEG deposit - registerStakeCredential stakeCred dsUnified = - -- This looks like it should have been a right-biased union, so that the (reward, deposit) pair would be inserted - -- (or overwritten) in the UMap. But since we are sure that the stake credential isn't a member yet - -- it will still work. The reason we cannot use a right-biased union here is because UMap treats deposits specially - -- in right-biased unions, and is unable to accept new deposits. - UM.RewDepUView dsUnified - UM.∪ (stakeCred, UM.RDPair (UM.CompactCoin 0) (UM.compactCoinOrError ppKeyDeposit)) + registerStakeCredential stakeCred = + let rdPair = UM.RDPair (UM.CompactCoin 0) (UM.compactCoinOrError ppKeyDeposit) + in UM.insert stakeCred rdPair $ UM.RewDepUView dsUnified case c of ConwayRegCert stakeCred sMayDeposit -> do forM_ sMayDeposit checkDepositAgainstPParams checkStakeKeyNotRegistered stakeCred dsUnified - pure $ dState {dsUnified = registerStakeCredential stakeCred dsUnified} + pure $ dState {dsUnified = registerStakeCredential stakeCred} ConwayUnRegCert stakeCred sMayDeposit -> do forM_ sMayDeposit $ checkDepositAgainstPaidDeposit stakeCred dsUnified checkStakeKeyIsRegistered stakeCred dsUnified @@ -193,7 +189,7 @@ conwayDelegTransition = do checkStakeDelegateeRegistered pools delegatee pure $ dState - { dsUnified = processDelegation stakeCred delegatee $ registerStakeCredential stakeCred dsUnified + { dsUnified = processDelegation stakeCred delegatee $ registerStakeCredential stakeCred } where checkStakeDelegateeRegistered pools = From adcdac74dc9b9a27672492b2b3e82b701923aee8 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 5 Sep 2024 19:36:57 -0600 Subject: [PATCH 5/8] Stop checking refunds when stake credential is not registered It has been noticed that currently we report invalid refunds, even the stake credential is not registered. This makes little sense, so this commit changes this behavior. --- .../src/Cardano/Ledger/Conway/Rules/Deleg.hs | 21 ++++++++++++------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index e8aeba5ef34..b28b9f3aef9 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -21,7 +21,7 @@ module Cardano.Ledger.Conway.Rules.Deleg ( ConwayDelegEnv (..), ) where -import Cardano.Ledger.BaseTypes (ShelleyBase) +import Cardano.Ledger.BaseTypes (ShelleyBase, StrictMaybe (..)) import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..)) import Cardano.Ledger.Binary.Coders ( Decode (From, Invalid, SumD, Summands), @@ -44,7 +44,7 @@ import Cardano.Ledger.PoolParams (PoolParams) import Cardano.Ledger.Shelley.LedgerState (DState (..)) import qualified Cardano.Ledger.UMap as UM import Control.DeepSeq (NFData) -import Control.Monad (forM_) +import Control.Monad (forM_, guard) import Control.State.Transition ( BaseM, Environment, @@ -55,6 +55,7 @@ import Control.State.Transition ( State, TRC (TRC), TransitionRule, + failOnJust, judgmentContext, transitionRules, (?!), @@ -174,8 +175,16 @@ conwayDelegTransition = do forM_ sMayDeposit checkDepositAgainstPParams checkStakeKeyNotRegistered stakeCred dsUnified pure $ dState {dsUnified = registerStakeCredential stakeCred} - ConwayUnRegCert stakeCred sMayDeposit -> do - forM_ sMayDeposit $ checkDepositAgainstPaidDeposit stakeCred dsUnified + ConwayUnRegCert stakeCred sMayRefund -> do + let mRDPair = UM.lookup stakeCred $ UM.RewDepUView dsUnified + checkInvalidRefund = do + SJust suppliedRefund <- Just sMayRefund + -- we don't want to report invalid refund when stake credential is not registered: + UM.RDPair _ actualRefund <- mRDPair + -- we return offending refund only when it doesn't match the expected one: + guard (suppliedRefund /= UM.fromCompact actualRefund) + Just suppliedRefund + failOnJust checkInvalidRefund IncorrectDepositDELEG checkStakeKeyIsRegistered stakeCred dsUnified checkStakeKeyHasZeroRewardBalance stakeCred dsUnified pure $ dState {dsUnified = UM.domDeleteAll (Set.singleton stakeCred) dsUnified} @@ -208,10 +217,6 @@ conwayDelegTransition = do DelegStake sPool -> delegStake stakeCred sPool dsUnified DelegVote dRep -> delegVote stakeCred dRep dsUnified DelegStakeVote sPool dRep -> delegVote stakeCred dRep $ delegStake stakeCred sPool dsUnified - checkDepositAgainstPaidDeposit stakeCred dsUnified deposit = - Just deposit - == fmap (UM.fromCompact . UM.rdDeposit) (UM.lookup stakeCred $ UM.RewDepUView dsUnified) - ?! IncorrectDepositDELEG deposit checkStakeKeyNotRegistered stakeCred dsUnified = UM.notMember stakeCred (UM.RewDepUView dsUnified) ?! StakeKeyRegisteredDELEG stakeCred checkStakeKeyIsRegistered stakeCred dsUnified = From e067e5ebbd2619b0337419064ef8676ad1fce81d Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 5 Sep 2024 19:46:17 -0600 Subject: [PATCH 6/8] Avoid redundant lookups in the UMap for ConwayUnRegCert --- .../impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index b28b9f3aef9..73527b532c6 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -62,6 +62,7 @@ import Control.State.Transition ( ) import Data.Map (Map) import qualified Data.Map.Strict as Map +import Data.Maybe (isJust) import qualified Data.Set as Set import Data.Void (Void) import GHC.Generics (Generic) @@ -184,9 +185,13 @@ conwayDelegTransition = do -- we return offending refund only when it doesn't match the expected one: guard (suppliedRefund /= UM.fromCompact actualRefund) Just suppliedRefund + checkStakeKeyHasZeroRewardBalance = do + UM.RDPair compactReward _ <- mRDPair + guard (compactReward /= mempty) + Just $ UM.fromCompact compactReward failOnJust checkInvalidRefund IncorrectDepositDELEG - checkStakeKeyIsRegistered stakeCred dsUnified - checkStakeKeyHasZeroRewardBalance stakeCred dsUnified + isJust mRDPair ?! StakeKeyNotRegisteredDELEG stakeCred + failOnJust checkStakeKeyHasZeroRewardBalance StakeKeyHasNonZeroRewardAccountBalanceDELEG pure $ dState {dsUnified = UM.domDeleteAll (Set.singleton stakeCred) dsUnified} ConwayDelegCert stakeCred delegatee -> do checkStakeKeyIsRegistered stakeCred dsUnified @@ -221,6 +226,3 @@ conwayDelegTransition = do UM.notMember stakeCred (UM.RewDepUView dsUnified) ?! StakeKeyRegisteredDELEG stakeCred checkStakeKeyIsRegistered stakeCred dsUnified = UM.member stakeCred (UM.RewDepUView dsUnified) ?! StakeKeyNotRegisteredDELEG stakeCred - checkStakeKeyHasZeroRewardBalance stakeCred dsUnified = - let mReward = UM.rdReward <$> UM.lookup stakeCred (UM.RewDepUView dsUnified) - in forM_ mReward $ \r -> r == mempty ?! StakeKeyHasNonZeroRewardAccountBalanceDELEG (UM.fromCompact r) From 8c545f9ff578b26025602489bc151ae95dbb859f Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 5 Sep 2024 20:00:29 -0600 Subject: [PATCH 7/8] Move the rest of the where bindings into let * Which allows is to avoid passing redundant arguments * Switch to pointfree style and avoid using same name fo rthe umap that is being modified --- .../src/Cardano/Ledger/Conway/Rules/Deleg.hs | 55 +++++++++---------- 1 file changed, 27 insertions(+), 28 deletions(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs index 73527b532c6..e17620c6a55 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Deleg.hs @@ -161,7 +161,7 @@ conwayDelegTransition = do TRC ( ConwayDelegEnv pp pools , dState@DState {dsUnified} - , c + , cert ) <- judgmentContext let @@ -171,10 +171,30 @@ conwayDelegTransition = do registerStakeCredential stakeCred = let rdPair = UM.RDPair (UM.CompactCoin 0) (UM.compactCoinOrError ppKeyDeposit) in UM.insert stakeCred rdPair $ UM.RewDepUView dsUnified - case c of + delegStake stakeCred sPool umap = + UM.SPoolUView umap UM.⨃ Map.singleton stakeCred sPool + delegVote stakeCred dRep umap = + UM.DRepUView umap UM.⨃ Map.singleton stakeCred dRep + processDelegation stakeCred delegatee = + case delegatee of + DelegStake sPool -> delegStake stakeCred sPool + DelegVote dRep -> delegVote stakeCred dRep + DelegStakeVote sPool dRep -> delegVote stakeCred dRep . delegStake stakeCred sPool + checkStakeKeyNotRegistered stakeCred = + UM.notMember stakeCred (UM.RewDepUView dsUnified) ?! StakeKeyRegisteredDELEG stakeCred + checkStakeKeyIsRegistered stakeCred = + UM.member stakeCred (UM.RewDepUView dsUnified) ?! StakeKeyNotRegisteredDELEG stakeCred + checkStakeDelegateeRegistered = + let checkPoolRegistered targetPool = + targetPool `Map.member` pools ?! DelegateeNotRegisteredDELEG targetPool + in \case + DelegStake targetPool -> checkPoolRegistered targetPool + DelegStakeVote targetPool _ -> checkPoolRegistered targetPool + DelegVote _ -> pure () + case cert of ConwayRegCert stakeCred sMayDeposit -> do forM_ sMayDeposit checkDepositAgainstPParams - checkStakeKeyNotRegistered stakeCred dsUnified + checkStakeKeyNotRegistered stakeCred pure $ dState {dsUnified = registerStakeCredential stakeCred} ConwayUnRegCert stakeCred sMayRefund -> do let mRDPair = UM.lookup stakeCred $ UM.RewDepUView dsUnified @@ -194,35 +214,14 @@ conwayDelegTransition = do failOnJust checkStakeKeyHasZeroRewardBalance StakeKeyHasNonZeroRewardAccountBalanceDELEG pure $ dState {dsUnified = UM.domDeleteAll (Set.singleton stakeCred) dsUnified} ConwayDelegCert stakeCred delegatee -> do - checkStakeKeyIsRegistered stakeCred dsUnified - checkStakeDelegateeRegistered pools delegatee + checkStakeKeyIsRegistered stakeCred + checkStakeDelegateeRegistered delegatee pure $ dState {dsUnified = processDelegation stakeCred delegatee dsUnified} ConwayRegDelegCert stakeCred delegatee deposit -> do checkDepositAgainstPParams deposit - checkStakeKeyNotRegistered stakeCred dsUnified - checkStakeDelegateeRegistered pools delegatee + checkStakeKeyNotRegistered stakeCred + checkStakeDelegateeRegistered delegatee pure $ dState { dsUnified = processDelegation stakeCred delegatee $ registerStakeCredential stakeCred } - where - checkStakeDelegateeRegistered pools = - let checkPoolRegistered targetPool = - targetPool `Map.member` pools ?! DelegateeNotRegisteredDELEG targetPool - in \case - DelegStake targetPool -> checkPoolRegistered targetPool - DelegStakeVote targetPool _ -> checkPoolRegistered targetPool - DelegVote _ -> pure () - delegStake stakeCred sPool dsUnified = - UM.SPoolUView dsUnified UM.⨃ Map.singleton stakeCred sPool - delegVote stakeCred dRep dsUnified = - UM.DRepUView dsUnified UM.⨃ Map.singleton stakeCred dRep - processDelegation stakeCred delegatee dsUnified = - case delegatee of - DelegStake sPool -> delegStake stakeCred sPool dsUnified - DelegVote dRep -> delegVote stakeCred dRep dsUnified - DelegStakeVote sPool dRep -> delegVote stakeCred dRep $ delegStake stakeCred sPool dsUnified - checkStakeKeyNotRegistered stakeCred dsUnified = - UM.notMember stakeCred (UM.RewDepUView dsUnified) ?! StakeKeyRegisteredDELEG stakeCred - checkStakeKeyIsRegistered stakeCred dsUnified = - UM.member stakeCred (UM.RewDepUView dsUnified) ?! StakeKeyNotRegisteredDELEG stakeCred From 50c9329ee4bc087a4d735d39c7362ed9a8386346 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Thu, 5 Sep 2024 21:03:12 -0600 Subject: [PATCH 8/8] Move `committeeUpdateContainsColdCred` into let binding for consistency --- .../impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs index e1f3c5df081..b0c2b82ba2a 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs @@ -228,8 +228,12 @@ conwayGovCertTransition = do failOnJust coldCredResigned ConwayCommitteeHasPreviouslyResigned let isCurrentMember = strictMaybe False (Map.member coldCred . committeeMembers) cgceCurrentCommittee + committeeUpdateContainsColdCred GovActionState {gasProposalProcedure} = + case pProcGovAction gasProposalProcedure of + UpdateCommittee _ _ newMembers _ -> Map.member coldCred newMembers + _ -> False isPotentialFutureMember = - any (committeeUpdateContainsColdCred coldCred) cgceCommitteeProposals + any committeeUpdateContainsColdCred cgceCommitteeProposals isCurrentMember || isPotentialFutureMember ?! ConwayCommitteeIsUnknown coldCred pure vState @@ -288,11 +292,6 @@ conwayGovCertTransition = do checkAndOverwriteCommitteeMemberState coldCred $ CommitteeHotCredential hotCred ConwayResignCommitteeColdKey coldCred anchor -> checkAndOverwriteCommitteeMemberState coldCred $ CommitteeMemberResigned anchor - where - committeeUpdateContainsColdCred coldCred GovActionState {gasProposalProcedure} = - case pProcGovAction gasProposalProcedure of - UpdateCommittee _ _ newMembers _ -> Map.member coldCred newMembers - _ -> False computeDRepExpiryVersioned :: ConwayEraPParams era =>