Swap Mempool/Ledger predicate failures in Dijkstra

eras/allegra/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.9.0.0
 
+* Add `AllegraApplyTxError` constructor for `ApplyTxError era`
 * Add `cddl` sub-library, and `generate-cddl` executable.
 * Remove deprecated type `Allegra`
 * Remove deprecated type `TimelockConstr`

eras/allegra/impl/src/Cardano/Ledger/Allegra.hs

@@ -1,13 +1,17 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Allegra (
   AllegraEra,
   Tx (..),
+  ApplyTxError (..),
 ) where
 
 import Cardano.Ledger.Allegra.BlockBody ()
@@ -20,13 +24,22 @@ import Cardano.Ledger.Allegra.Transition ()
 import Cardano.Ledger.Allegra.Translation ()
 import Cardano.Ledger.Allegra.Tx (Tx (..))
 import Cardano.Ledger.Allegra.UTxO ()
+import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
 import Cardano.Ledger.Shelley.API
+import Cardano.Ledger.Shelley.Rules (ShelleyLedgerPredFailure)
+import Data.Bifunctor (Bifunctor (first))
+import Data.List.NonEmpty (NonEmpty)
 
 --------------------------------------------------------------------------------
 -- Mempool instances
 --------------------------------------------------------------------------------
 
 instance ApplyTx AllegraEra where
-  applyTxValidation = ruleApplyTxValidation @"LEDGER"
+  newtype ApplyTxError AllegraEra = AllegraApplyTxError (NonEmpty (ShelleyLedgerPredFailure AllegraEra))
+    deriving (Eq, Show)
+    deriving newtype (EncCBOR, DecCBOR)
+  applyTxValidation validationPolicy globals env state tx =
+    first AllegraApplyTxError $
+      ruleApplyTxValidation @"LEDGER" validationPolicy globals env state tx
 
 instance ApplyBlock AllegraEra

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Arbitrary.hs

@@ -19,7 +19,7 @@ module Test.Cardano.Ledger.Allegra.Arbitrary (
   maxTimelockDepth,
 ) where
 
-import Cardano.Ledger.Allegra (AllegraEra, Tx (..))
+import Cardano.Ledger.Allegra (AllegraEra, ApplyTxError (..), Tx (..))
 import Cardano.Ledger.Allegra.Rules (AllegraUtxoPredFailure)
 import Cardano.Ledger.Allegra.Scripts (
   AllegraEraScript (..),
@@ -132,3 +132,5 @@ instance Arbitrary ValidityInterval where
 deriving newtype instance Arbitrary (TransitionConfig AllegraEra)
 
 deriving newtype instance Arbitrary (Tx TopTx AllegraEra)
+
+deriving newtype instance Arbitrary (ApplyTxError AllegraEra)

eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/Examples.hs

@@ -41,7 +41,7 @@ import Test.Cardano.Ledger.Shelley.Examples (
   mkWitnessesPreAlonzo,
  )
 
-ledgerExamples :: LedgerExamples AllegraEra
+ledgerExamples :: LedgerExamples "LEDGER" AllegraEra
 ledgerExamples =
   mkLedgerExamples
     (mkWitnessesPreAlonzo (Proxy @AllegraEra))

eras/alonzo/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.15.0.0
 
+* Add `AlonzoApplyTxError` constructor for `ApplyTxError era`
 * Changed the type of `dappMinUTxOValue` to `CompactForm Coin` in `DowngradeAlonzoPParams`
 * Changed the type of the following fields to `CompactForm Coin` in `AlonzoPParams`:
   - `appMinFeeA`

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

@@ -1,9 +1,12 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -15,6 +18,7 @@ module Cardano.Ledger.Alonzo (
   AlonzoScript,
   AlonzoTxAuxData,
   Tx (..),
+  ApplyTxError (..),
 ) where
 
 import Cardano.Ledger.Alonzo.BlockBody ()
@@ -31,13 +35,22 @@ import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData)
 import Cardano.Ledger.Alonzo.TxBody (AlonzoTxOut, TxBody (AlonzoTxBody))
 import Cardano.Ledger.Alonzo.TxWits ()
 import Cardano.Ledger.Alonzo.UTxO ()
+import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
 import Cardano.Ledger.Mary.Value (MaryValue)
 import Cardano.Ledger.Plutus.Data ()
 import Cardano.Ledger.Shelley.API
+import Cardano.Ledger.Shelley.Rules (ShelleyLedgerPredFailure)
+import Data.Bifunctor (Bifunctor (first))
+import Data.List.NonEmpty (NonEmpty)
 
 -- =====================================================
 
 instance ApplyTx AlonzoEra where
-  applyTxValidation = ruleApplyTxValidation @"LEDGER"
+  newtype ApplyTxError AlonzoEra = AlonzoApplyTxError (NonEmpty (ShelleyLedgerPredFailure AlonzoEra))
+    deriving (Eq, Show)
+    deriving newtype (EncCBOR, DecCBOR)
+  applyTxValidation validationPolicy globals env state tx =
+    first AlonzoApplyTxError $
+      ruleApplyTxValidation @"LEDGER" validationPolicy globals env state tx
 
 instance ApplyBlock AlonzoEra

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs

@@ -32,7 +32,7 @@ module Test.Cardano.Ledger.Alonzo.Arbitrary (
   genAlonzoPlutusPurposePointer,
 ) where
 
-import Cardano.Ledger.Alonzo (AlonzoEra, Tx (..))
+import Cardano.Ledger.Alonzo (AlonzoEra, ApplyTxError (..), Tx (..))
 import Cardano.Ledger.Alonzo.Core
 import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..))
 import Cardano.Ledger.Alonzo.PParams (
@@ -468,6 +468,8 @@ instance Arbitrary (TransitionConfig AlonzoEra) where
 
 deriving newtype instance Arbitrary (Tx TopTx AlonzoEra)
 
+deriving newtype instance Arbitrary (ApplyTxError AlonzoEra)
+
 instance
   ( EraBlockBody era
   , AlonzoEraTx era

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs

@@ -33,7 +33,6 @@ import Cardano.Ledger.Mary.Value (MaryValue (..))
 import Cardano.Ledger.Plutus.Data (Data (..), hashData)
 import Cardano.Ledger.Plutus.Language (Language (..))
 import Cardano.Ledger.Shelley.API (
-  ApplyTxError (..),
   Credential (..),
   Network (..),
   NewEpochState (..),
@@ -42,11 +41,16 @@ import Cardano.Ledger.Shelley.API (
   TxId (..),
   Update (..),
  )
-import Cardano.Ledger.Shelley.Rules (ShelleyDelegsPredFailure (..), ShelleyLedgerPredFailure (..))
+import Cardano.Ledger.Shelley.Rules (
+  PredicateFailure,
+  ShelleyDelegsPredFailure (..),
+  ShelleyLedgerPredFailure (..),
+ )
 import Cardano.Ledger.Shelley.Scripts
 import Cardano.Ledger.TxIn (mkTxInPartial)
 import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..))
 import Data.Default (def)
+import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map.Strict as Map
 import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
@@ -72,13 +76,12 @@ import Test.Cardano.Ledger.Shelley.Examples (
   testShelleyGenesis,
  )
 
-ledgerExamples :: LedgerExamples AlonzoEra
+ledgerExamples :: LedgerExamples "LEDGER" AlonzoEra
 ledgerExamples =
   mkLedgerExamples
-    ( ApplyTxError $
-        pure $
-          DelegsFailure $
-            DelegateeNotRegisteredDELEG @AlonzoEra (mkKeyHash 1)
+    ( pure $
+        DelegsFailure $
+          DelegateeNotRegisteredDELEG @AlonzoEra (mkKeyHash 1)
     )
     exampleAlonzoNewEpochState
     exampleTxAlonzo
@@ -87,11 +90,11 @@ ledgerExamples =
 mkLedgerExamples ::
   forall era.
   AlonzoEraPParams era =>
-  ApplyTxError era ->
+  NonEmpty (PredicateFailure (EraRule "LEDGER" era)) ->
   NewEpochState era ->
   Tx TopTx era ->
   TranslationContext era ->
-  LedgerExamples era
+  LedgerExamples "LEDGER" era
 mkLedgerExamples
   applyTxError
   newEpochState

eras/babbage/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.13.0.0
 
+* Add `BabbageApplyTxError` constructor for `ApplyTxError era`
 * Add `babbageUtxoValidation`
 * Add `babbageUtxoTests`
 * Changed the type of the following fields to `CompactForm Coin` in `BabbagePParams`:

eras/babbage/impl/src/Cardano/Ledger/Babbage.hs

@@ -1,7 +1,10 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -10,6 +13,7 @@ module Cardano.Ledger.Babbage (
   BabbageTxOut,
   TxBody (BabbageTxBody),
   Tx (..),
+  ApplyTxError (..),
   AlonzoScript,
   AlonzoTxAuxData,
 ) where
@@ -26,11 +30,20 @@ import Cardano.Ledger.Babbage.Tx (Tx (..))
 import Cardano.Ledger.Babbage.TxBody (BabbageTxOut, TxBody (BabbageTxBody))
 import Cardano.Ledger.Babbage.TxInfo ()
 import Cardano.Ledger.Babbage.UTxO ()
+import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
 import Cardano.Ledger.Shelley.API
+import Cardano.Ledger.Shelley.Rules (ShelleyLedgerPredFailure)
+import Data.Bifunctor (Bifunctor (first))
+import Data.List.NonEmpty (NonEmpty)
 
 -- =====================================================
 
 instance ApplyTx BabbageEra where
-  applyTxValidation = ruleApplyTxValidation @"LEDGER"
+  newtype ApplyTxError BabbageEra = BabbageApplyTxError (NonEmpty (ShelleyLedgerPredFailure BabbageEra))
+    deriving (Eq, Show)
+    deriving newtype (EncCBOR, DecCBOR)
+  applyTxValidation validationPolicy globals env state tx =
+    first BabbageApplyTxError $
+      ruleApplyTxValidation @"LEDGER" validationPolicy globals env state tx
 
 instance ApplyBlock BabbageEra

eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Arbitrary.hs

@@ -150,3 +150,5 @@ instance Arbitrary (TxBody TopTx BabbageEra) where
 deriving newtype instance Arbitrary (TransitionConfig BabbageEra)
 
 deriving newtype instance Arbitrary (Tx TopTx BabbageEra)
+
+deriving newtype instance Arbitrary (ApplyTxError BabbageEra)

eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/Examples.hs

@@ -27,7 +27,6 @@ import Cardano.Ledger.Plutus.Data (
  )
 import Cardano.Ledger.Plutus.Language (Language (..))
 import Cardano.Ledger.Shelley.API (
-  ApplyTxError (..),
   Network (..),
   NewEpochState (..),
   ProposedPPUpdates (..),
@@ -59,13 +58,12 @@ import Test.Cardano.Ledger.Shelley.Examples (
   mkKeyHash,
  )
 
-ledgerExamples :: LedgerExamples BabbageEra
+ledgerExamples :: LedgerExamples "LEDGER" BabbageEra
 ledgerExamples =
   mkLedgerExamples
-    ( ApplyTxError $
-        pure $
-          DelegsFailure $
-            DelegateeNotRegisteredDELEG @BabbageEra (mkKeyHash 1)
+    ( pure $
+        DelegsFailure $
+          DelegateeNotRegisteredDELEG @BabbageEra (mkKeyHash 1)
     )
     exampleBabbageNewEpochState
     exampleTxBabbage

eras/conway/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.21.0.0
 
+* Add `ConwayApplyTxError` constructor for `ApplyTxError era`
 * Re-export `UtxoEnv` from `Cardano.Ledger.Conway.Rules.Utxo`
 * Changed the type of the following fields to `CompactForm Coin` in `ConwayPParams`:
   - `cppMinFeeA`

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

@@ -149,6 +149,7 @@ library testlib
     Test.Cardano.Ledger.Conway.Imp.GovSpec
     Test.Cardano.Ledger.Conway.Imp.HardForkSpec
     Test.Cardano.Ledger.Conway.Imp.LedgerSpec
+    Test.Cardano.Ledger.Conway.Imp.MempoolSpec
     Test.Cardano.Ledger.Conway.Imp.RatifySpec
     Test.Cardano.Ledger.Conway.Imp.UtxoSpec
     Test.Cardano.Ledger.Conway.Imp.UtxosSpec

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

@@ -1,7 +1,9 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -12,9 +14,11 @@ module Cardano.Ledger.Conway (
   hardforkConwayDELEGIncorrectDepositsAndRefunds,
   hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule,
   Tx (..),
+  ApplyTxError (..),
 ) where
 
 import Cardano.Ledger.Babbage.TxBody ()
+import Cardano.Ledger.BaseTypes (Inject (..))
 import Cardano.Ledger.Conway.BlockBody ()
 import Cardano.Ledger.Conway.Era (
   ConwayEra,
@@ -24,7 +28,7 @@ import Cardano.Ledger.Conway.Era (
   hardforkConwayMoveWithdrawalsAndDRepChecksToLedgerRule,
  )
 import Cardano.Ledger.Conway.Governance (RunConwayRatify (..))
-import Cardano.Ledger.Conway.Rules ()
+import Cardano.Ledger.Conway.Rules (ConwayLedgerPredFailure)
 import Cardano.Ledger.Conway.State ()
 import Cardano.Ledger.Conway.Transition ()
 import Cardano.Ledger.Conway.Translation ()
@@ -33,12 +37,21 @@ import Cardano.Ledger.Conway.TxInfo ()
 import Cardano.Ledger.Conway.TxOut ()
 import Cardano.Ledger.Conway.UTxO ()
 import Cardano.Ledger.Shelley.API
+import Data.Bifunctor (Bifunctor (first))
+import Data.List.NonEmpty (NonEmpty)
 
 -- =====================================================
 
 instance ApplyTx ConwayEra where
-  applyTxValidation = ruleApplyTxValidation @"MEMPOOL"
+  newtype ApplyTxError ConwayEra = ConwayApplyTxError (NonEmpty (ConwayLedgerPredFailure ConwayEra))
+    deriving (Eq, Show)
+  applyTxValidation validationPolicy globals env state tx =
+    first ConwayApplyTxError $
+      ruleApplyTxValidation @"MEMPOOL" validationPolicy globals env state tx
 
 instance ApplyBlock ConwayEra
 
 instance RunConwayRatify ConwayEra
+
+instance Inject (NonEmpty (ConwayLedgerPredFailure ConwayEra)) (ApplyTxError ConwayEra) where
+  inject = ConwayApplyTxError

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

@@ -28,7 +28,6 @@ import Cardano.Ledger.Plutus.Data (
  )
 import Cardano.Ledger.Plutus.Language (Language (..))
 import Cardano.Ledger.Shelley.API (
-  ApplyTxError (..),
   RewardAccount (..),
   TxId (..),
  )
@@ -60,13 +59,12 @@ import Test.Cardano.Ledger.Shelley.Examples (
   mkKeyHash,
  )
 
-ledgerExamples :: LedgerExamples ConwayEra
+ledgerExamples :: LedgerExamples "LEDGER" ConwayEra
 ledgerExamples =
   mkLedgerExamples
-    ( ApplyTxError $
-        pure $
-          wrapFailed @(ConwayDELEG ConwayEra) @(ConwayLEDGER ConwayEra) $
-            DelegateeStakePoolNotRegisteredDELEG @ConwayEra (mkKeyHash 1)
+    ( pure $
+        wrapFailed @(ConwayDELEG ConwayEra) @(ConwayLEDGER ConwayEra) $
+          DelegateeStakePoolNotRegisteredDELEG @ConwayEra (mkKeyHash 1)
     )
     exampleBabbageNewEpochState
     exampleTxConway

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

@@ -28,6 +28,7 @@ import qualified Test.Cardano.Ledger.Conway.Imp.GovCertSpec as GovCert
 import qualified Test.Cardano.Ledger.Conway.Imp.GovSpec as Gov
 import qualified Test.Cardano.Ledger.Conway.Imp.HardForkSpec as HardFork
 import qualified Test.Cardano.Ledger.Conway.Imp.LedgerSpec as Ledger
+import qualified Test.Cardano.Ledger.Conway.Imp.MempoolSpec as Mempool
 import qualified Test.Cardano.Ledger.Conway.Imp.RatifySpec as Ratify
 import qualified Test.Cardano.Ledger.Conway.Imp.UtxoSpec as Utxo
 import qualified Test.Cardano.Ledger.Conway.Imp.UtxosSpec as Utxos
@@ -75,6 +76,7 @@ conwayEraSpecificSpec :: SpecWith (ImpInit (LedgerSpec ConwayEra))
 conwayEraSpecificSpec = do
   describe "Conway era specific Imp spec" $ do
     describe "UTXO" Utxo.conwayEraSpecificSpec
+    describe "MEMPOOL" Mempool.conwayEraSpecificSpec
 
 instance EraSpecificSpec ConwayEra where
   eraSpecificSpec =