Prevent votes for non existent entities

eras/conway/impl/CHANGELOG.md

@@ -8,6 +8,18 @@
 * Added `cgceCurrentCommittee` and `cgceCommitteeProposals` to `ConwayGovCertEnv`
 * Added `proposalsWithPurpose`, `isGovActionWithPurpose` and `ToGovActionPurpose`
 * Added `ConwayTxRefScriptsSizeTooBig` predicate failure to `ConwayLedgerPredFailure`
+* Replaced `geCommitteeState` with `geCertState` in `GovEnv`
+* Added `VotersDoNotExist` predicate failure to `ConwayGovPredFailure`
+* Export `ConwayEraTxCert`, `RegDepositTxCert`, `UnRegDepositTxCert`, `DelegTxCert`,
+  `RegDepositDelegTxCert`, `AuthCommitteeHotKeyTxCert`, `ResignCommitteeColdTxCert`,
+  `RegDRepTxCert`, `UnRegDRepTxCert` and `UpdateDRepTxCert` from
+  `Cardano.Ledger.Conway.Core`
+* Remove `GovProcedures` in favor of newly added type `GovSignal`
+
+### `testlib`
+
+* Change the return type of `resignCommitteeColdKey`
+* Add an argument to `registerCommitteeHotKeys`
 
 ## 1.15.1.0
 

eras/conway/impl/cardano-ledger-conway.cabal

@@ -90,7 +90,7 @@ library
         cardano-ledger-allegra ^>=1.5,
         cardano-ledger-alonzo ^>=1.9,
         cardano-ledger-babbage ^>=1.8,
-        cardano-ledger-core ^>=1.13,
+        cardano-ledger-core ^>=1.13.2,
         cardano-ledger-mary ^>=1.6,
         cardano-ledger-shelley ^>=1.12.2,
         cardano-slotting,

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

@@ -29,6 +29,16 @@ module Cardano.Ledger.Conway.Core (
   ConwayEraScript (..),
   pattern VotingPurpose,
   pattern ProposingPurpose,
+  ConwayEraTxCert,
+  pattern RegDepositTxCert,
+  pattern UnRegDepositTxCert,
+  pattern DelegTxCert,
+  pattern RegDepositDelegTxCert,
+  pattern AuthCommitteeHotKeyTxCert,
+  pattern ResignCommitteeColdTxCert,
+  pattern RegDRepTxCert,
+  pattern UnRegDRepTxCert,
+  pattern UpdateDRepTxCert,
   module Cardano.Ledger.Babbage.Core,
 )
 where
@@ -67,3 +77,15 @@ import Cardano.Ledger.Conway.Scripts (
  )
 import Cardano.Ledger.Conway.Tx ()
 import Cardano.Ledger.Conway.TxBody (ConwayEraTxBody (..))
+import Cardano.Ledger.Conway.TxCert (
+  ConwayEraTxCert,
+  pattern AuthCommitteeHotKeyTxCert,
+  pattern DelegTxCert,
+  pattern RegDRepTxCert,
+  pattern RegDepositDelegTxCert,
+  pattern RegDepositTxCert,
+  pattern ResignCommitteeColdTxCert,
+  pattern UnRegDRepTxCert,
+  pattern UnRegDepositTxCert,
+  pattern UpdateDRepTxCert,
+ )

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

@@ -40,7 +40,6 @@ module Cardano.Ledger.Conway.Governance (
   foldlVotingProcedures,
   foldrVotingProcedures,
   ProposalProcedure (..),
-  GovProcedures (..),
   Anchor (..),
   AnchorData (..),
   indexedGovProps,

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

@@ -23,7 +23,6 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Ledger.Conway.Governance.Procedures (
-  GovProcedures (..),
   VotingProcedures (..),
   VotingProcedure (..),
   foldlVotingProcedures,
@@ -66,7 +65,6 @@ module Cardano.Ledger.Conway.Governance.Procedures (
   gasCommitteeVotesL,
   gasExpiresAfterL,
   gasProposalProcedureL,
-  govProceduresProposalsL,
   gasActionL,
   gasReturnAddrL,
   gasProposedInL,
@@ -143,7 +141,6 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe.Strict (StrictMaybe (..))
 import qualified Data.OMap.Strict as OMap
-import qualified Data.OSet.Strict as OSet
 import qualified Data.Sequence as Seq
 import Data.Set (Set)
 import qualified Data.Text as Text
@@ -465,15 +462,6 @@ toVotingProcedurePairs vProc@(VotingProcedure _ _) =
       , "decision" .= vProcVote
       ]
 
-data GovProcedures era = GovProcedures
-  { gpVotingProcedures :: !(VotingProcedures era)
-  , gpProposalProcedures :: !(OSet.OSet (ProposalProcedure era))
-  }
-  deriving (Eq, Generic)
-
-govProceduresProposalsL :: Lens' (GovProcedures era) (OSet.OSet (ProposalProcedure era))
-govProceduresProposalsL = lens gpProposalProcedures $ \x y -> x {gpProposalProcedures = y}
-
 -- | Attaches indices to a sequence of proposal procedures. The indices grow
 -- from left to right.
 indexedGovProps ::
@@ -484,12 +472,6 @@ indexedGovProps = enumerateProps 0
     enumerateProps _ Seq.Empty = Seq.Empty
     enumerateProps !n (x Seq.:<| xs) = (GovActionIx n, x) Seq.:<| enumerateProps (succ n) xs
 
-instance EraPParams era => NoThunks (GovProcedures era)
-
-instance EraPParams era => NFData (GovProcedures era)
-
-deriving instance EraPParams era => Show (GovProcedures era)
-
 data ProposalProcedure era = ProposalProcedure
   { pProcDeposit :: !Coin
   , pProcReturnAddr :: !(RewardAccount (EraCrypto era))

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

@@ -83,6 +83,7 @@
 module Cardano.Ledger.Conway.Governance.Proposals (
   -- * Intended interface to be used for all implementation
   Proposals,
+  mapProposals,
   proposalsIds,
   proposalsActions,
   proposalsSize,
@@ -225,6 +226,10 @@ data Proposals era = Proposals
   deriving stock (Show, Eq, Generic)
   deriving anyclass (NoThunks, NFData, Default)
 
+-- | Make sure not to change the `gasId`, otherwise all hell will break loose.
+mapProposals :: (GovActionState era -> GovActionState era) -> Proposals era -> Proposals era
+mapProposals f props = props {pProps = OMap.mapUnsafe f (pProps props)}
+
 pPropsL :: Lens' (Proposals era) (OMap.OMap (GovActionId (EraCrypto era)) (GovActionState era))
 pPropsL = lens pProps $ \x y -> x {pProps = y}
 

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

@@ -21,6 +21,7 @@
 module Cardano.Ledger.Conway.Rules.Gov (
   ConwayGOV,
   GovEnv (..),
+  GovSignal (..),
   ConwayGovEvent (..),
   ConwayGovPredFailure (..),
 ) where
@@ -50,22 +51,31 @@ import Cardano.Ledger.Binary.Coders (
   (!>),
   (<!),
  )
-import Cardano.Ledger.CertState (CommitteeState)
+import Cardano.Ledger.CertState (
+  CertState (..),
+  CommitteeState (..),
+  PState (..),
+  VState (..),
+  authorizedHotCommitteeCredentials,
+ )
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Era (ConwayEra, ConwayGOV)
 import Cardano.Ledger.Conway.Governance (
+  GovAction (..),
   GovActionId (..),
   GovActionPurpose (..),
   GovActionState (..),
-  GovProcedures (..),
   GovPurposeId (..),
   GovRelation (..),
   ProposalProcedure (..),
   Proposals,
   Voter (..),
   VotingProcedure (..),
+  VotingProcedures (..),
   foldlVotingProcedures,
+  foldrVotingProcedures,
   gasAction,
+  gasDRepVotesL,
   grHardForkL,
   indexedGovProps,
   isCommitteeVotingAllowed,
@@ -78,12 +88,13 @@ import Cardano.Ledger.Conway.Governance (
   proposalsLookupId,
   toPrevGovActionIds,
  )
-import Cardano.Ledger.Conway.Governance.Procedures (GovAction (..), foldrVotingProcedures)
+import Cardano.Ledger.Conway.Governance.Proposals (mapProposals)
 import Cardano.Ledger.Conway.PParams (
   ConwayEraPParams (..),
   ppGovActionDepositL,
   ppGovActionLifetimeL,
  )
+import Cardano.Ledger.Conway.TxCert
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential)
 import Cardano.Ledger.Keys (KeyRole (..))
@@ -106,6 +117,7 @@ import Control.State.Transition.Extended (
   tellEvent,
   (?!),
  )
+import qualified Data.Foldable as F
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as Map
 import qualified Data.OSet.Strict as OSet
@@ -123,7 +135,7 @@ data GovEnv era = GovEnv
   , geEpoch :: !EpochNo
   , gePParams :: !(PParams era)
   , gePPolicy :: !(StrictMaybe (ScriptHash (EraCrypto era)))
-  , geCommitteeState :: !(CommitteeState era)
+  , geCertState :: !(CertState era)
   }
   deriving (Generic)
 
@@ -168,6 +180,8 @@ data ConwayGovPredFailure era
   | DisallowedProposalDuringBootstrap (ProposalProcedure era)
   | DisallowedVotesDuringBootstrap
       (NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era)))
+  | -- | Predicate failure for votes by entities that are not present in the ledger state
+    VotersDoNotExist (NonEmpty (Voter (EraCrypto era)))
   deriving (Eq, Show, Generic)
 
 type instance EraRuleFailure "GOV" (ConwayEra c) = ConwayGovPredFailure (ConwayEra c)
@@ -196,6 +210,7 @@ instance EraPParams era => DecCBOR (ConwayGovPredFailure era) where
     11 -> SumD InvalidPolicyHash <! From <! From
     12 -> SumD DisallowedProposalDuringBootstrap <! From
     13 -> SumD DisallowedVotesDuringBootstrap <! From
+    14 -> SumD VotersDoNotExist <! From
     k -> Invalid k
 
 instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where
@@ -232,6 +247,8 @@ instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where
         Sum DisallowedProposalDuringBootstrap 12 !> To proposal
       DisallowedVotesDuringBootstrap votes ->
         Sum DisallowedVotesDuringBootstrap 13 !> To votes
+      VotersDoNotExist voters ->
+        Sum VotersDoNotExist 14 !> To voters
 
 instance EraPParams era => ToCBOR (ConwayGovPredFailure era) where
   toCBOR = toEraCBOR @era
@@ -245,15 +262,28 @@ data ConwayGovEvent era
 
 instance EraPParams era => NFData (ConwayGovEvent era)
 
+data GovSignal era = GovSignal
+  { gsVotingProcedures :: !(VotingProcedures era)
+  , gsProposalProcedures :: !(OSet.OSet (ProposalProcedure era))
+  , gsCertificates :: !(SSeq.StrictSeq (TxCert era))
+  }
+  deriving (Generic)
+
+deriving instance (EraPParams era, Eq (TxCert era)) => Eq (GovSignal era)
+deriving instance (EraPParams era, Show (TxCert era)) => Show (GovSignal era)
+
+instance (EraPParams era, NFData (TxCert era)) => NFData (GovSignal era)
+
 instance
-  ( ConwayEraPParams era
+  ( ConwayEraTxCert era
+  , ConwayEraPParams era
   , EraRule "GOV" era ~ ConwayGOV era
   , InjectRuleFailure "GOV" ConwayGovPredFailure era
   ) =>
   STS (ConwayGOV era)
   where
   type State (ConwayGOV era) = Proposals era
-  type Signal (ConwayGOV era) = GovProcedures era
+  type Signal (ConwayGOV era) = GovSignal era
   type Environment (ConwayGOV era) = GovEnv era
   type BaseM (ConwayGOV era) = ShelleyBase
   type PredicateFailure (ConwayGOV era) = ConwayGovPredFailure era
@@ -346,10 +376,11 @@ checkBootstrapProposal pp proposal@ProposalProcedure {pProcGovAction}
 
 govTransition ::
   forall era.
-  ( ConwayEraPParams era
+  ( ConwayEraTxCert era
+  , ConwayEraPParams era
   , STS (EraRule "GOV" era)
   , Event (EraRule "GOV" era) ~ ConwayGovEvent era
-  , Signal (EraRule "GOV" era) ~ GovProcedures era
+  , Signal (EraRule "GOV" era) ~ GovSignal era
   , PredicateFailure (EraRule "GOV" era) ~ ConwayGovPredFailure era
   , BaseM (EraRule "GOV" era) ~ ShelleyBase
   , Environment (EraRule "GOV" era) ~ GovEnv era
@@ -359,12 +390,16 @@ govTransition ::
   TransitionRule (EraRule "GOV" era)
 govTransition = do
   TRC
-    ( GovEnv txid currentEpoch pp constitutionPolicy committeeState
+    ( GovEnv txid currentEpoch pp constitutionPolicy CertState {certPState, certVState}
       , st
-      , gp
+      , GovSignal {gsVotingProcedures, gsProposalProcedures, gsCertificates}
       ) <-
     judgmentContext
   let prevGovActionIds = st ^. pRootsL . L.to toPrevGovActionIds
+      committeeState = vsCommitteeState certVState
+      knownDReps = vsDReps certVState
+      knownStakePools = psStakePoolParams certPState
+      knownCommitteeMembers = authorizedHotCommitteeCredentials committeeState
 
   expectedNetworkId <- liftSTS $ asks networkId
 
@@ -437,16 +472,12 @@ govTransition = do
               Nothing -> ps <$ failBecause (InvalidPrevGovActionId proposal)
 
   proposals <-
-    foldlM'
-      processProposal
-      st
-      (indexedGovProps $ SSeq.fromStrict $ OSet.toStrictSeq $ gpProposalProcedures gp)
-
-  -- Voting
-  let votingProcedures = gpVotingProcedures gp
-      -- Inversion of the keys in VotingProcedures, where we can find
-      -- the voters for every govActionId
-      (unknownGovActionIds, knownVotes) =
+    foldlM' processProposal st $
+      indexedGovProps (SSeq.fromStrict (OSet.toStrictSeq gsProposalProcedures))
+
+  -- Inversion of the keys in VotingProcedures, where we can find the voters for every
+  -- govActionId
+  let (unknownGovActionIds, knownVotes) =
         foldrVotingProcedures
           -- strictness is not needed for `unknown`
           ( \voter gaId _ (unknown, !known) ->
@@ -455,9 +486,17 @@ govTransition = do
                 Nothing -> (gaId : unknown, known)
           )
           ([], [])
-          votingProcedures
+          gsVotingProcedures
       curGovActionIds = proposalsActionsMap proposals
-
+      isVoterKnown = \case
+        CommitteeVoter hotCred -> hotCred `Set.member` knownCommitteeMembers
+        DRepVoter cred -> cred `Map.member` knownDReps
+        StakePoolVoter poolId -> poolId `Map.member` knownStakePools
+      unknownVoters =
+        Map.keys $
+          Map.filterWithKey (\voter _ -> not (isVoterKnown voter)) (unVotingProcedures gsVotingProcedures)
+
+  failOnNonEmpty unknownVoters VotersDoNotExist
   failOnNonEmpty unknownGovActionIds GovActionsDoNotExist
   runTest $ checkBootstrapVotes pp knownVotes
   runTest $ checkVotesAreNotForExpiredActions currentEpoch knownVotes
@@ -466,7 +505,18 @@ govTransition = do
   let
     addVoterVote ps voter govActionId VotingProcedure {vProcVote} =
       proposalsAddVote voter vProcVote govActionId ps
-    updatedProposalStates = foldlVotingProcedures addVoterVote proposals votingProcedures
+    updatedProposalStates =
+      cleanupProposalVotes $
+        foldlVotingProcedures addVoterVote proposals gsVotingProcedures
+    unregisteredDReps =
+      let collectRemovals drepCreds = \case
+            UnRegDRepTxCert drepCred _ -> Set.insert drepCred drepCreds
+            _ -> drepCreds
+       in F.foldl' collectRemovals mempty gsCertificates
+    cleanupProposalVotes =
+      let cleanupVoters gas =
+            gas & gasDRepVotesL %~ (`Map.withoutKeys` unregisteredDReps)
+       in mapProposals cleanupVoters
 
   -- Report the event
   tellEvent $ GovNewProposals txid updatedProposalStates