Swap Mempool/Ledger predicate failures in Dijkstra

To get there we need to move the `ApplyTxError era` type to be a
data family in the ApplyTx class

Author: f-f

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