Event logger redux

alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs

@@ -15,6 +15,7 @@
 module Cardano.Ledger.Alonzo.Rules.Bbody
   ( AlonzoBBODY,
     AlonzoBbodyPredFail (..),
+    AlonzoBbodyEvent (..),
     bbodyTransition,
   )
 where
@@ -64,6 +65,7 @@ import Shelley.Spec.Ledger.LedgerState (LedgerState)
 import Shelley.Spec.Ledger.OverlaySchedule (isOverlaySlot)
 import Shelley.Spec.Ledger.STS.Bbody
   ( BbodyEnv (..),
+    BbodyEvent (..),
     BbodyPredicateFailure (..),
     BbodyState (..),
   )
@@ -82,6 +84,9 @@ data AlonzoBbodyPredFail era
       -- ^ Maximum allowed by protocal parameters
   deriving (Generic)
 
+data AlonzoBbodyEvent era
+  = ShelleyInAlonzoEvent (BbodyEvent era)
+
 deriving instance
   (Era era, Show (PredicateFailure (Core.EraRule "LEDGERS" era))) =>
   Show (AlonzoBbodyPredFail era)
@@ -230,6 +235,7 @@ instance
   type BaseM (AlonzoBBODY era) = ShelleyBase
 
   type PredicateFailure (AlonzoBBODY era) = AlonzoBbodyPredFail era
+  type Event (AlonzoBBODY era) = AlonzoBbodyEvent era
 
   initialRules = []
   transitionRules = [bbodyTransition @AlonzoBBODY]
@@ -245,3 +251,4 @@ instance
   Embed ledgers (AlonzoBBODY era)
   where
   wrapFailed = ShelleyInAlonzoPredFail . LedgersFailure
+  wrapEvent = ShelleyInAlonzoEvent . LedgersEvent

alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs

@@ -42,6 +42,7 @@ import Data.Kind (Type)
 import Data.Sequence (Seq)
 import Data.Sequence.Strict (StrictSeq)
 import qualified Data.Sequence.Strict as StrictSeq
+import Data.Void (Void)
 import GHC.Records (HasField, getField)
 import Shelley.Spec.Ledger.EpochBoundary (obligation)
 import Shelley.Spec.Ledger.LedgerState
@@ -50,8 +51,8 @@ import Shelley.Spec.Ledger.LedgerState
     PState (..),
     UTxOState (..),
   )
-import Shelley.Spec.Ledger.STS.Delegs (DELEGS, DelegsEnv (..), DelegsPredicateFailure)
-import Shelley.Spec.Ledger.STS.Ledger (LedgerEnv (..), LedgerPredicateFailure (..))
+import Shelley.Spec.Ledger.STS.Delegs (DELEGS, DelegsEnv (..), DelegsEvent, DelegsPredicateFailure)
+import Shelley.Spec.Ledger.STS.Ledger (LedgerEnv (..), LedgerEvent (..), LedgerPredicateFailure (..))
 import qualified Shelley.Spec.Ledger.STS.Ledgers as Shelley
 import Shelley.Spec.Ledger.STS.Utxo
   ( UtxoEnv (..),
@@ -143,6 +144,7 @@ instance
   type Environment (AlonzoLEDGER era) = LedgerEnv era
   type BaseM (AlonzoLEDGER era) = ShelleyBase
   type PredicateFailure (AlonzoLEDGER era) = LedgerPredicateFailure era
+  type Event (AlonzoLEDGER era) = LedgerEvent era
 
   initialRules = []
   transitionRules = [ledgerTransition @AlonzoLEDGER]
@@ -167,26 +169,32 @@ instance
 instance
   ( Era era,
     STS (DELEGS era),
-    PredicateFailure (Core.EraRule "DELEGS" era) ~ DelegsPredicateFailure era
+    PredicateFailure (Core.EraRule "DELEGS" era) ~ DelegsPredicateFailure era,
+    Event (Core.EraRule "DELEGS" era) ~ DelegsEvent era
   ) =>
   Embed (DELEGS era) (AlonzoLEDGER era)
   where
   wrapFailed = DelegsFailure
+  wrapEvent = DelegsEvent
 
 instance
   ( Era era,
     STS (AlonzoUTXOW era),
-    PredicateFailure (Core.EraRule "UTXOW" era) ~ AlonzoPredFail era
+    PredicateFailure (Core.EraRule "UTXOW" era) ~ AlonzoPredFail era,
+    Event (Core.EraRule "UTXOW" era) ~ Void
   ) =>
   Embed (AlonzoUTXOW era) (AlonzoLEDGER era)
   where
   wrapFailed = UtxowFailure
+  wrapEvent = UtxowEvent
 
 instance
   ( Era era,
     STS (AlonzoLEDGER era),
-    PredicateFailure (Core.EraRule "LEDGER" era) ~ LedgerPredicateFailure era
+    PredicateFailure (Core.EraRule "LEDGER" era) ~ LedgerPredicateFailure era,
+    Event (Core.EraRule "LEDGER" era) ~ LedgerEvent era
   ) =>
   Embed (AlonzoLEDGER era) (Shelley.LEDGERS era)
   where
   wrapFailed = Shelley.LedgerFailure
+  wrapEvent = Shelley.LedgerEvent

alonzo/test/test/Test/Cardano/Ledger/Alonzo/Trials.hs

@@ -81,8 +81,8 @@ import Shelley.Spec.Ledger.LedgerState
     UTxOState,
   )
 import Shelley.Spec.Ledger.PParams (PParams' (..))
-import Shelley.Spec.Ledger.STS.Chain (CHAIN, ChainPredicateFailure (..), ChainState (..))
-import Shelley.Spec.Ledger.STS.Ledger (LEDGER, LedgerEnv (..), LedgerPredicateFailure (UtxowFailure))
+import Shelley.Spec.Ledger.STS.Chain (CHAIN, ChainEvent (..), ChainPredicateFailure (..), ChainState (..))
+import Shelley.Spec.Ledger.STS.Ledger (LEDGER, LedgerEnv (..), LedgerEvent (..), LedgerPredicateFailure (UtxowFailure))
 import System.Timeout
 import Test.Cardano.Ledger.Alonzo.AlonzoEraGen ()
 import Test.Cardano.Ledger.EraBuffet (TestCrypto)
@@ -118,9 +118,11 @@ import Test.Tasty.QuickCheck
 
 instance Embed (AlonzoBBODY (AlonzoEra TestCrypto)) (CHAIN (AlonzoEra TestCrypto)) where
   wrapFailed = BbodyFailure
+  wrapEvent = BbodyEvent
 
 instance Embed (AlonzoUTXOW (AlonzoEra TestCrypto)) (LEDGER (AlonzoEra TestCrypto)) where
   wrapFailed = UtxowFailure
+  wrapEvent = UtxowEvent
 
 -- ======================================================================================
 -- It is incredably hard to debug property test generators.  These functions mimic the

cardano-ledger-core/src/Cardano/Ledger/Rules/ValidationMode.hs

@@ -27,7 +27,8 @@ applySTSValidateSuchThat ::
   ([Label] -> Bool) ->
   RuleContext rtype s ->
   m (Either [PredicateFailure s] (State s))
-applySTSValidateSuchThat cond = applySTSOptsEither opts
+applySTSValidateSuchThat cond =
+  applySTSOptsEither opts
   where
     opts =
       ApplySTSOpts