Merge pull request #650 from IntersectMBO/jordan/enable-conway-ledger…

…-events Handle plutus related ledger events in Conway
IntersectMBO · Oct 7, 2024 · 649a698 · 649a698
2 parents 00f025d + 9deea90
commit 649a698
Show file tree

Hide file tree

Showing 3 changed files with 18 additions and 5 deletions.
diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/ConvertLedgerEvent.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/ConvertLedgerEvent.hs
@@ -163,7 +163,7 @@ toLedgerEventConway evt =
     ShelleyLedgerEventBBODY
       (ShelleyInAlonzoEvent (LedgersEvent (Shelley.LedgerEvent conwayLedgerEvent))) ->
         case conwayLedgerEvent of
-          Conway.UtxowEvent{} -> Nothing
+          Conway.UtxowEvent utxowEvent -> handleConwayUTxOWEvent utxowEvent
           Conway.CertsEvent{} -> Nothing
           Conway.GovEvent govEvent ->
             case govEvent of

diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/BBODY/LEDGER.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/BBODY/LEDGER.hs
@@ -41,5 +41,5 @@ handleShelleyLEDGEREvents
   => Shelley.ShelleyLedgerEvent ledgerera -> Maybe LedgerEvent
 handleShelleyLEDGEREvents ledgerEvent =
   case ledgerEvent of
-    Shelley.UtxowEvent e -> handleAlonzoOnwardsUTxOWEvent e
+    Shelley.UtxowEvent e -> handleAlonzoUTxOWEvent e
     Shelley.DelegsEvent e -> handleShelleyDELEGSEvent e
diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/BBODY/UTXOW.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/BBODY/UTXOW.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 
 module Cardano.Api.LedgerEvents.Rule.BBODY.UTXOW
-  ( handleAlonzoOnwardsUTxOWEvent
+  ( handleAlonzoUTxOWEvent
   , handleAllegraMaryUTxOWEvent
+  , handleConwayUTxOWEvent
   , handlePreAlonzoUTxOWEvent
   )
 where
@@ -15,18 +17,29 @@ import qualified Cardano.Ledger.Allegra.Rules as Allegra
 import           Cardano.Ledger.Alonzo.Rules (AlonzoUtxoEvent (..), AlonzoUtxosEvent (..),
                    AlonzoUtxowEvent (..))
 import qualified Cardano.Ledger.Alonzo.Rules as Alonzo
+import           Cardano.Ledger.Conway
+import qualified Cardano.Ledger.Conway.Rules as Conway
 import qualified Cardano.Ledger.Core as Ledger.Core
 import qualified Cardano.Ledger.Crypto as Crypto
 import qualified Cardano.Ledger.Shelley.Rules as Shelley
 
 import           Control.State.Transition.Extended
 
-handleAlonzoOnwardsUTxOWEvent
+handleConwayUTxOWEvent
+  :: AlonzoUtxowEvent (ConwayEra Crypto.StandardCrypto) -> Maybe LedgerEvent
+handleConwayUTxOWEvent (Alonzo.WrappedShelleyEraEvent (Shelley.UtxoEvent (Alonzo.UtxosEvent conwayUTxOsEvent))) =
+  case conwayUTxOsEvent of
+    Conway.TotalDeposits{} -> Nothing
+    Conway.SuccessfulPlutusScriptsEvent e -> Just $ SuccessfulPlutusScript e
+    Conway.FailedPlutusScriptsEvent e -> Just $ FailedPlutusScript e
+    Conway.TxUTxODiff _ _ -> Nothing
+
+handleAlonzoUTxOWEvent
   :: Event (Ledger.Core.EraRule "UTXO" ledgerera) ~ AlonzoUtxoEvent ledgerera
   => Event (Ledger.Core.EraRule "UTXOS" ledgerera) ~ AlonzoUtxosEvent ledgerera
   => Ledger.Core.EraCrypto ledgerera ~ Crypto.StandardCrypto
   => AlonzoUtxowEvent ledgerera -> Maybe LedgerEvent
-handleAlonzoOnwardsUTxOWEvent (WrappedShelleyEraEvent (Shelley.UtxoEvent (UtxosEvent utxoEvent))) =
+handleAlonzoUTxOWEvent (WrappedShelleyEraEvent (Shelley.UtxoEvent (UtxosEvent utxoEvent))) =
   case utxoEvent of
     Alonzo.AlonzoPpupToUtxosEvent{} -> Nothing
     Alonzo.TotalDeposits{} -> Nothing