Disable CC ratification when number of members is below ppCommitteeMinSize

eras/conway/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.13.0.0
 
+* Add `geCommitteeState`
 * Remove `ConwayDelegEvent`, `ConwayGovCertEvent`
 * Add `GovInfoEvent`
 * Add `ConwayUtxosEvent`

eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs

@@ -79,7 +79,7 @@ import Cardano.Ledger.Binary.Coders (
   (!>),
   (<!),
  )
-import Cardano.Ledger.CertState (CommitteeState)
+import Cardano.Ledger.CertState (CommitteeAuthorization (..), CommitteeState (..))
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Governance.Procedures
 import Cardano.Ledger.Conway.PParams (
@@ -397,9 +397,9 @@ votingStakePoolThresholdInternal pp isElectedCommittee action =
         TreasuryWithdrawals {} -> NoVotingAllowed
         InfoAction {} -> NoVotingThreshold
 
-isCommitteeVotingAllowed :: ConwayEraPParams era => GovAction era -> Bool
-isCommitteeVotingAllowed =
-  isVotingAllowed . votingCommitteeThresholdInternal def committee
+isCommitteeVotingAllowed :: ConwayEraPParams era => CommitteeState era -> GovAction era -> Bool
+isCommitteeVotingAllowed committeeState =
+  isVotingAllowed . votingCommitteeThresholdInternal def committee committeeState
   where
     -- Information about presence of committee is irrelevant for knowing if voting is
     -- allowed or not
@@ -408,10 +408,11 @@ isCommitteeVotingAllowed =
 votingCommitteeThreshold ::
   ConwayEraPParams era =>
   RatifyState era ->
+  CommitteeState era ->
   GovAction era ->
   StrictMaybe UnitInterval
-votingCommitteeThreshold ratifyState =
-  toRatifyVotingThreshold . votingCommitteeThresholdInternal pp committee
+votingCommitteeThreshold ratifyState committeeState =
+  toRatifyVotingThreshold . votingCommitteeThresholdInternal pp committee committeeState
   where
     committee = ratifyState ^. rsEnactStateL . ensCommitteeL
     pp = ratifyState ^. rsEnactStateL . ensCurPParamsL
@@ -420,9 +421,10 @@ votingCommitteeThresholdInternal ::
   ConwayEraPParams era =>
   PParams era ->
   StrictMaybe (Committee era) ->
+  CommitteeState era ->
   GovAction era ->
   VotingThreshold
-votingCommitteeThresholdInternal pp committee = \case
+votingCommitteeThresholdInternal pp committee (CommitteeState hotKeys) = \case
   NoConfidence {} -> NoVotingAllowed
   UpdateCommittee {} -> NoVotingAllowed
   NewConstitution {} -> threshold
@@ -433,12 +435,19 @@ votingCommitteeThresholdInternal pp committee = \case
   where
     threshold =
       case committeeThreshold <$> committee of
-        -- if the committee size is smaller than the mnimimum given in pparams,
-        -- we treat it as if we had no committe
-        SJust t | committeeSize >= minSize -> VotingThreshold t
+        -- if the committee size is smaller than the minimum given in PParams,
+        -- we treat it as if we had no committee
+        SJust t | activeCommitteeSize >= minSize -> VotingThreshold t
         _ -> NoVotingThreshold
     minSize = pp ^. ppCommitteeMinSizeL
-    committeeSize = fromIntegral $ Map.size $ foldMap' committeeMembers committee
+    isActive coldKey _validUntil =
+      case Map.lookup coldKey hotKeys of
+        Just (CommitteeMemberResigned _) -> False
+        Just _ -> True -- TODO do we need to check if member's term is expired here?
+        Nothing -> False
+    activeCommitteeSize =
+      fromIntegral . Map.size . Map.filterWithKey isActive $
+        foldMap' committeeMembers committee
 
 isDRepVotingAllowed ::
   ConwayEraPParams era =>

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs

@@ -50,6 +50,7 @@ import Cardano.Ledger.Binary.Coders (
   (!>),
   (<!),
  )
+import Cardano.Ledger.CertState (CommitteeState)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Era (ConwayEra, ConwayGOV)
 import Cardano.Ledger.Conway.Governance (
@@ -122,6 +123,7 @@ data GovEnv era = GovEnv
   , gePParams :: !(PParams era)
   , gePrevGovActionIds :: !(GovRelation StrictMaybe era)
   , gePPolicy :: !(StrictMaybe (ScriptHash (EraCrypto era)))
+  , geCommitteeState :: !(CommitteeState era)
   }
   deriving (Generic)
 
@@ -264,11 +266,12 @@ checkVotesAreNotForExpiredActions curEpoch voters =
 checkVotersAreValid ::
   forall era.
   ConwayEraPParams era =>
+  CommitteeState era ->
   [(Voter (EraCrypto era), GovActionState era)] ->
   Test (ConwayGovPredFailure era)
-checkVotersAreValid voters =
+checkVotersAreValid committeeState voters =
   let canVoteOn voter govAction = case voter of
-        CommitteeVoter {} -> isCommitteeVotingAllowed govAction
+        CommitteeVoter {} -> isCommitteeVotingAllowed committeeState govAction
         DRepVoter {} -> isDRepVotingAllowed govAction
         StakePoolVoter {} -> isStakePoolVotingAllowed govAction
       disallowedVoters =
@@ -327,7 +330,7 @@ govTransition ::
   TransitionRule (EraRule "GOV" era)
 govTransition = do
   TRC
-    ( GovEnv txid currentEpoch pp prevGovActionIds constitutionPolicy
+    ( GovEnv txid currentEpoch pp prevGovActionIds constitutionPolicy committeeState
       , st
       , gp
       ) <-
@@ -424,7 +427,7 @@ govTransition = do
       curGovActionIds = proposalsActionsMap proposals
   failOnNonEmpty unknownGovActionIds GovActionsDoNotExist
   runTest $ checkVotesAreNotForExpiredActions currentEpoch knownVotes
-  runTest $ checkVotersAreValid knownVotes
+  runTest $ checkVotersAreValid committeeState knownVotes
 
   let
     addVoterVote ps voter govActionId VotingProcedure {vProcVote} =

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs

@@ -78,7 +78,9 @@ import Cardano.Ledger.Shelley.LedgerState (
   LedgerState (..),
   UTxOState (..),
   asTreasuryL,
+  certVStateL,
   utxosGovStateL,
+  vsCommitteeStateL,
  )
 import Cardano.Ledger.Shelley.Rules (
   LedgerEnv (..),
@@ -383,6 +385,7 @@ ledgerTransition = do
                   pp
                   (utxoState ^. utxosGovStateL . proposalsGovStateL . pRootsL . L.to toPrevGovActionIds)
                   (utxoState ^. utxosGovStateL . constitutionGovStateL . constitutionScriptL)
+                  (certState ^. certVStateL . vsCommitteeStateL)
               , utxoState ^. utxosGovStateL . proposalsGovStateL
               , govProcedures
               )

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ratify.hs

@@ -128,7 +128,7 @@ committeeAccepted ::
   GovActionState era ->
   Bool
 committeeAccepted RatifyEnv {reCommitteeState, reCurrentEpoch} rs gas =
-  case votingCommitteeThreshold rs (gasAction gas) of
+  case votingCommitteeThreshold rs reCommitteeState (gasAction gas) of
     SNothing -> False -- this happens if we have no committee, or if the committee is too small,
     -- in which case the committee vote is `no`
     SJust r ->

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs

@@ -559,6 +559,7 @@ instance (Era era, Arbitrary (PParamsHKD Identity era)) => Arbitrary (GovEnv era
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
+      <*> arbitrary
 
 instance Era era => Arbitrary (VotingProcedure era) where
   arbitrary = VotingProcedure <$> arbitrary <*> arbitrary

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs

@@ -704,6 +704,7 @@ votingSpec ::
   forall era.
   ( ConwayEraImp era
   , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
+  , GovState era ~ ConwayGovState era
   ) =>
   SpecWith (ImpTestState era)
 votingSpec =
@@ -754,6 +755,64 @@ votingSpec =
       it
         "committee member can't vote on committee update when sandwiched between other votes"
         ccVoteOnConstitutionFailsWithMultipleVotes
+      it "CC cannot ratify if below quorum" $ do
+        modifyPParams $ \pp ->
+          pp
+            & ppGovActionLifetimeL .~ EpochInterval 3
+            & ppDRepVotingThresholdsL
+              .~ def
+                { dvtUpdateToConstitution = 1 %! 2
+                }
+            & ppCommitteeMinSizeL .~ 2
+            & ppCommitteeMaxTermLengthL .~ EpochInterval 10
+        (khDRep, _, _) <- setupSingleDRep 1_000_000
+        let dRepCred = KeyHashObj khDRep
+        ccColdCred0 <- KeyHashObj <$> freshKeyHash
+        ccColdCred1 <- KeyHashObj <$> freshKeyHash
+        electionGovAction <-
+          submitGovAction $
+            UpdateCommittee
+              SNothing
+              mempty
+              ( Map.fromList
+                  [ (ccColdCred0, EpochNo 10)
+                  , (ccColdCred1, EpochNo 10)
+                  ]
+              )
+              (3 %! 5)
+        submitYesVote_ (DRepVoter dRepCred) electionGovAction
+        logAcceptedRatio electionGovAction
+        passNEpochs 3
+        expectNoCurrentProposals
+        ccHotKey0 <- registerCommitteeHotKey ccColdCred0
+        ccHotKey1 <- registerCommitteeHotKey ccColdCred1
+        anchor <- arbitrary
+        constitutionChangeId <-
+          submitGovAction $
+            NewConstitution
+              SNothing
+              Constitution
+                { constitutionScript = SNothing
+                , constitutionAnchor = anchor
+                }
+        submitYesVote_ (DRepVoter dRepCred) constitutionChangeId
+        resignCommitteeColdKey ccColdCred0 SNothing
+        submitYesVote_ (CommitteeVoter ccHotKey0) constitutionChangeId
+        submitYesVote_ (CommitteeVoter ccHotKey1) constitutionChangeId
+        passEpoch
+        logAcceptedRatio constitutionChangeId
+        logToExpr =<< lookupGovActionState constitutionChangeId
+        passNEpochs 4
+        conAnchor <-
+          getsNES $
+            nesEsL
+              . esLStateL
+              . lsUTxOStateL
+              . utxosGovStateL
+              . cgsConstitutionL
+              . constitutionAnchorL
+        expectNoCurrentProposals
+        conAnchor `shouldNotBe` anchor
 
 constitutionSpec ::
   forall era.

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs

@@ -178,6 +178,7 @@ import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromJust, isJust)
 import Data.Maybe.Strict (isSJust)
+import Data.Sequence.Strict (StrictSeq (..))
 import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
 import qualified Data.Text as T
@@ -287,8 +288,7 @@ registerDRep = do
   dreps `shouldSatisfy` Map.member (KeyHashObj khDRep)
   pure khDRep
 
--- | Registers a new DRep and delegates 1 ADA to it. Returns the keyhash of the
--- DRep
+-- | Registers a new DRep and delegates the specified amount of ADA to it.
 setupSingleDRep ::
   forall era.
   ( ConwayEraTxCert era
@@ -889,7 +889,7 @@ logRatificationChecks gaId = do
           <> " [ To Pass: "
           <> show (committeeAcceptedRatio members gasCommitteeVotes committeeState currentEpoch)
           <> " >= "
-          <> show (votingCommitteeThreshold ratSt (gasAction gas))
+          <> show (votingCommitteeThreshold ratSt committeeState (gasAction gas))
           <> " ]"
       , "spoAccepted:\t\t"
           <> show (spoAccepted ratEnv ratSt gas)
@@ -1228,10 +1228,12 @@ expectCurrentProposals = do
   props <- currentProposalIds
   assertBool "Expected proposals in current gov state" (not (SSeq.null props))
 
-expectNoCurrentProposals :: (HasCallStack, ConwayEraGov era) => ImpTestM era ()
+expectNoCurrentProposals :: (HasCallStack, ConwayEraImp era) => ImpTestM era ()
 expectNoCurrentProposals = do
-  props <- currentProposalIds
-  assertBool "Expected no proposals in current gov state" (SSeq.null props)
+  proposals <- getProposals
+  case proposalsActions proposals of
+    Empty -> pure ()
+    xs -> assertFailure $ "Expected no active proposals, but got:\n" <> show (toExpr xs)
 
 expectPulserProposals :: (HasCallStack, ConwayEraGov era) => ImpTestM era ()
 expectPulserProposals = do

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/V2/Conway/GOV.hs

@@ -28,7 +28,7 @@ govEnvSpec ::
   IsConwayUniv fn =>
   Spec fn (GovEnv (ConwayEra StandardCrypto))
 govEnvSpec = constrained $ \ge ->
-  match ge $ \_ _ pp _ _ ->
+  match ge $ \_ _ pp _ _ _ ->
     satisfies pp pparamsSpec
 
 -- TODO:
@@ -258,7 +258,7 @@ govProceduresSpec ge@GovEnv {..} ps =
         , f (gasAction act)
         ]
       committeeVotableActionIds =
-        actions isCommitteeVotingAllowed
+        actions (isCommitteeVotingAllowed geCommitteeState)
       drepVotableActionIds =
         actions isDRepVotingAllowed
       stakepoolVotableActionIds =