Add governance related ledger events (#3856)

* Implement ConwayGovEvent
Emit an event for proposals snapshot in an incoming tx

* Add EpochBoundaryRatifyState to ConwayEpochEvent. This event will output
the RatityState at the epoch boundary.

* Update LedgerEvents.md

docs/LedgerEvents.md

@@ -124,6 +124,14 @@ all the information needed to re-run a Plutus script.
 This event is the same as `SuccessfulPlutusScriptsEvent`, except that it contains the
 information for all the failed Plutus scripts in a single transaction.
 
+### `EpochBoundaryRatifyState ratifyState`
+
+This event happens on the epoch boundary and gives us the ratification state (`RatifyState era`) _up to the current epoch boundary_.
+
+### `GovNewProposals txid proposalsSnapshot`
+
+This event is triggered on each tx and gives us the votes, proposals and txid of a particular tx.
+
 ## Notes / TODO
 
 There appears to be multiple, redundant `NewEpoch` events.

eras/conway/impl/CHANGELOG.md

@@ -9,6 +9,8 @@
 * Fix [#3835](https://github.com/input-output-hk/cardano-ledger/issues/3835)
 * Rename `PParamGroup` to `PPGroup` and `GovernanceGroup` to `GovGroup`
 * Introduce `THKD` and use it for `ConwayPParams`
+* Add `data ConwayGovEvent era` with constructor `GovNewProposals !(TxId (EraCrypto era)) !(ProposalsSnapshot era)`. #3856
+* Add `EpochBoundaryRatifyState (RatifyState era)` inhabitant to the `ConwayEpochEvent era` data type.
 
 ### `testlib`
 

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

@@ -7,7 +7,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}

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

@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE EmptyCase #-}
@@ -7,7 +6,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -107,6 +105,7 @@ import Control.State.Transition (
   TransitionRule,
   judgmentContext,
   liftSTS,
+  tellEvent,
   trans,
  )
 import Data.Foldable (Foldable (..))
@@ -120,6 +119,7 @@ import Lens.Micro ((%~), (&), (+~), (.~), (<>~), (^.))
 data ConwayEpochEvent era
   = PoolReapEvent (Event (EraRule "POOLREAP" era))
   | SnapEvent (Event (EraRule "SNAP" era))
+  | EpochBoundaryRatifyState (RatifyState era)
 
 instance
   ( EraTxOut era
@@ -279,7 +279,7 @@ epochTransition = do
   let
     pulsingState = epochState0 ^. epochStateDRepPulsingStateL
 
-    RatifyState {rsRemoved, rsEnactState} = extractDRepPulsingState pulsingState
+    ratState0@RatifyState {rsRemoved, rsEnactState} = extractDRepPulsingState pulsingState
 
     (accountState2, dState2, newEnactState) =
       applyEnactedWithdrawals accountState1 dState1 rsEnactState
@@ -320,7 +320,7 @@ epochTransition = do
         & esAccountStateL .~ accountState3
         & esSnapshotsL .~ snapshots1
         & esLStateL .~ ledgerState1
-
+  tellEvent $ EpochBoundaryRatifyState ratState0
   liftSTS $ setFreshDRepPulsingState eNo stakePoolDistr epochState1
 
 instance

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

@@ -16,6 +16,7 @@
 module Cardano.Ledger.Conway.Rules.Gov (
   ConwayGOV,
   GovEnv (..),
+  ConwayGovEvent (..),
   ConwayGovPredFailure (..),
 ) where
 
@@ -90,6 +91,7 @@ import Control.State.Transition.Extended (
   TransitionRule,
   judgmentContext,
   liftSTS,
+  tellEvent,
   (?!),
  )
 import qualified Data.Map.Merge.Strict as Map (dropMissing, merge, zipWithMaybeMatched)
@@ -182,13 +184,16 @@ instance EraPParams era => ToCBOR (ConwayGovPredFailure era) where
 instance EraPParams era => FromCBOR (ConwayGovPredFailure era) where
   fromCBOR = fromEraCBOR @era
 
+data ConwayGovEvent era
+  = GovNewProposals !(TxId (EraCrypto era)) !(ProposalsSnapshot era)
+
 instance ConwayEraPParams era => STS (ConwayGOV era) where
   type State (ConwayGOV era) = ProposalsSnapshot era
   type Signal (ConwayGOV era) = GovProcedures era
   type Environment (ConwayGOV era) = GovEnv era
   type BaseM (ConwayGOV era) = ShelleyBase
   type PredicateFailure (ConwayGOV era) = ConwayGovPredFailure era
-  type Event (ConwayGOV era) = ()
+  type Event (ConwayGOV era) = ConwayGovEvent era
 
   initialRules = []
 
@@ -213,8 +218,8 @@ addAction ::
   GovAction era ->
   ProposalsSnapshot era ->
   ProposalsSnapshot era
-addAction epoch gaExpiry gaid c addr act as =
-  snapshotInsertGovAction gai' as
+addAction epoch gaExpiry gaid c addr act =
+  snapshotInsertGovAction gai'
   where
     gai' =
       GovActionState
@@ -287,7 +292,7 @@ checkProposalsHaveAValidPrevious prevGovActionIds snapshots procedures =
           -- The case of having an SNothing as valid, for the very first proposal ever, is handled in `prevActionAsExpected`
           SNothing -> False
           SJust (PrevGovActionId govActionId) ->
-            case snapshotLookupId govActionId $ snapshots of
+            case snapshotLookupId govActionId snapshots of
               Nothing -> False
               -- lookup has to succeed _and_ purpose of looked-up action has to match condition
               Just found -> snapshotCond $ gasAction found
@@ -377,7 +382,10 @@ govTransition = do
 
   let applyVoterVotes curState voter =
         Map.foldlWithKey' (addVoterVote voter) curState
-  pure $ Map.foldlWithKey' applyVoterVotes stProps votingProcedures
+      updatedProposalStates =
+        Map.foldlWithKey' applyVoterVotes stProps votingProcedures
+  tellEvent $ GovNewProposals txid updatedProposalStates
+  pure updatedProposalStates
 
 instance Inject (ConwayGovPredFailure era) (ConwayGovPredFailure era) where
   inject = id

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

@@ -49,7 +49,7 @@ import Cardano.Ledger.Conway.Governance (
 import Cardano.Ledger.Conway.PParams (ConwayEraPParams)
 import Cardano.Ledger.Conway.Rules.Cert (CertEnv)
 import Cardano.Ledger.Conway.Rules.Certs (CertsEnv (CertsEnv), ConwayCertsEvent, ConwayCertsPredFailure)
-import Cardano.Ledger.Conway.Rules.Gov (ConwayGovPredFailure, GovEnv (..))
+import Cardano.Ledger.Conway.Rules.Gov (ConwayGovEvent (..), ConwayGovPredFailure, GovEnv (..))
 import Cardano.Ledger.Conway.Tx (AlonzoEraTx (..))
 import Cardano.Ledger.Conway.TxBody (ConwayEraTxBody (..), currentTreasuryValueTxBodyL)
 import Cardano.Ledger.Credential (Credential)
@@ -290,6 +290,7 @@ ledgerTransition = do
           all (`UMap.member` delegatedAddrs) wdrlCreds
             ?! ConwayWdrlNotDelegatedToDRep (wdrlCreds Set.\\ Map.keysSet (dRepMap dUnified))
 
+        -- Votes and proposals from signal tx
         let govProcedures =
               GovProcedures
                 { gpVotingProcedures = txBody ^. votingProceduresTxBodyL
@@ -391,7 +392,7 @@ instance
   ( ConwayEraPParams era
   , BaseM (ConwayLEDGER era) ~ ShelleyBase
   , PredicateFailure (EraRule "GOV" era) ~ ConwayGovPredFailure era
-  , Event (EraRule "GOV" era) ~ ()
+  , Event (EraRule "GOV" era) ~ ConwayGovEvent era
   ) =>
   Embed (ConwayGOV era) (ConwayLEDGER era)
   where