Merge pull request #5851 from IntersectMBO/lehins/add-predicate-failure-tests

Organize predicate failure CBOR roundtrip tests

Author: lehins

eras/allegra/impl/CHANGELOG.md

@@ -14,6 +14,7 @@
 
 ### `testlib`
 
+* Export `shelleyToBabbageSpec`
 * Make `Test.Cardano.Ledger.Allegra.Imp.spec` accept `Proxy era`
 * In `Test.Cardano.Ledger.Allegra.Examples`:
   - Remove `mkAllegraBasedExampleTx`, `exampleAllegraBasedTxBody`, `exampleAllegraBasedShelleyTxBody`

eras/allegra/impl/test/Main.hs

@@ -11,12 +11,11 @@ import qualified Test.Cardano.Ledger.Allegra.Imp as Imp
 import Test.Cardano.Ledger.Allegra.ImpTest ()
 import Test.Cardano.Ledger.Core.JSON (roundTripJsonEraSpec)
 import Test.Cardano.Ledger.Era
-import qualified Test.Cardano.Ledger.Shelley.Imp as Imp (shelleyEraSpecificSpec)
 import Test.Cardano.Ledger.Shelley.JSON (roundTripJsonShelleyEraSpec)
 
 instance EraSpec AllegraEra where
   eraImpSpec era = do
-    Imp.shelleyEraSpecificSpec era
+    Imp.shelleyToBabbageSpec era
     Imp.spec era
 
 main :: IO ()

eras/allegra/impl/test/Test/Cardano/Ledger/Allegra/BinarySpec.hs

@@ -12,7 +12,6 @@ import Test.Cardano.Ledger.Allegra.Era ()
 import Test.Cardano.Ledger.Allegra.TreeDiff ()
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec, txSizeSpec)
-import Test.Cardano.Ledger.Core.Binary.RoundTrip (RuleListEra (..))
 import Test.Cardano.Ledger.Shelley.Binary.RoundTrip (roundTripShelleyCommonSpec)
 
 spec :: Spec
@@ -22,17 +21,3 @@ spec = do
   describe "DecCBOR instances equivalence" $ do
     Binary.decoderEquivalenceCoreEraTypesSpec @AllegraEra
   Binary.txSizeSpec @AllegraEra
-
-instance RuleListEra AllegraEra where
-  type
-    EraRules AllegraEra =
-      '[ "DELEG"
-       , "DELEGS"
-       , "DELPL"
-       , "LEDGER"
-       , "LEDGERS"
-       , "POOL"
-       , "PPUP"
-       , "UTXO"
-       , "UTXOW"
-       ]

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

@@ -1,4 +1,6 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -37,6 +39,20 @@ class
   AllegraEraTest era
 
 instance EraTest AllegraEra where
+  type
+    EraRulesWithFailures AllegraEra =
+      '[ "BBODY"
+       , "DELEG"
+       , "DELEGS"
+       , "DELPL"
+       , "LEDGER"
+       , "LEDGERS"
+       , "POOL"
+       , "PPUP"
+       , "UTXO"
+       , "UTXOW"
+       ]
+
   zeroCostModels = emptyCostModels
 
   mkTestAccountState = mkShelleyTestAccountState

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

@@ -3,7 +3,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Test.Cardano.Ledger.Allegra.Imp (spec) where
+module Test.Cardano.Ledger.Allegra.Imp (spec, Shelley.shelleyToBabbageSpec) where
 
 import Cardano.Ledger.Core
 import qualified Cardano.Ledger.Shelley.Rules as Shelley

eras/alonzo/impl/CHANGELOG.md

@@ -49,6 +49,7 @@
 
 ### `testlib`
 
+* Add `Arbitrary` instance for `AlonzoBbodyPredFailure`
 * Add to `Test.Cardano.Ledger.Alonzo.Examples`:
   - `exampleAlonzoPParams`
   - `exampleAlonzoPParamsUpdate`

eras/alonzo/impl/test/Main.hs

@@ -17,13 +17,12 @@ import Test.Cardano.Ledger.Alonzo.ImpTest ()
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.JSON (roundTripJsonEraSpec)
 import Test.Cardano.Ledger.Era
-import qualified Test.Cardano.Ledger.Shelley.Imp as Shelley
 import Test.Cardano.Ledger.Shelley.JSON (roundTripJsonShelleyEraSpec)
 
 instance EraSpec AlonzoEra where
   eraImpSpec era = do
-    Shelley.shelleyEraSpecificSpec era
-    Imp.alonzoEraSpecificSpec era
+    Imp.shelleyToBabbageSpec era
+    Imp.alonzoToConwaySpec era
     Imp.spec era
 
 main :: IO ()

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

@@ -51,6 +51,7 @@ import Cardano.Ledger.Alonzo.Plutus.Context (
 import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError)
 import Cardano.Ledger.Alonzo.Plutus.TxInfo (AlonzoContextError)
 import Cardano.Ledger.Alonzo.Rules (
+  AlonzoBbodyPredFailure,
   AlonzoUtxoPredFailure (..),
   AlonzoUtxosPredFailure (..),
   AlonzoUtxowPredFailure (..),
@@ -358,6 +359,14 @@ instance
   where
   arbitrary = genericArbitraryU
 
+instance
+  ( Era era
+  , Arbitrary (Shelley.PredicateFailure (EraRule "LEDGERS" era))
+  ) =>
+  Arbitrary (AlonzoBbodyPredFailure era)
+  where
+  arbitrary = genericArbitraryU
+
 deriving instance Arbitrary ix => Arbitrary (AsIx ix it)
 
 deriving instance Arbitrary it => Arbitrary (AsItem ix it)

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/RoundTrip.hs

@@ -13,7 +13,6 @@ module Test.Cardano.Ledger.Alonzo.Binary.RoundTrip (
   roundTripAlonzoEraTypesSpec,
 ) where
 
-import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Scripts (
   AlonzoEraScript (..),
   AsIx (..),
@@ -26,20 +25,14 @@ import Test.Cardano.Ledger.Alonzo.Era (AlonzoEraTest)
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.Arbitrary (genValidCostModels)
 import Test.Cardano.Ledger.Core.Binary.RoundTrip (
-  RuleListEra (..),
   roundTripAnnEraTypeSpec,
   roundTripEraExpectation,
   roundTripEraTypeExpectation,
   roundTripEraTypeSpec,
  )
 import Test.Cardano.Ledger.Shelley.Binary.RoundTrip (roundTripShelleyCommonSpec)
 
-roundTripAlonzoCommonSpec ::
-  forall era.
-  ( AlonzoEraTest era
-  , RuleListEra era
-  ) =>
-  Spec
+roundTripAlonzoCommonSpec :: forall era. AlonzoEraTest era => Spec
 roundTripAlonzoCommonSpec = do
   roundTripAlonzoEraTypesSpec @era
   roundTripShelleyCommonSpec @era
@@ -69,18 +62,3 @@ roundTripAlonzoEraTypesSpec = do
     prop "Redeemers" $
       forAll genNonEmptyRedeemers $
         roundTripEraTypeExpectation @era @Redeemers
-
-instance RuleListEra AlonzoEra where
-  type
-    EraRules AlonzoEra =
-      '[ "DELEG"
-       , "DELEGS"
-       , "DELPL"
-       , "LEDGER"
-       , "LEDGERS"
-       , "POOL"
-       , "PPUP"
-       , "UTXO"
-       , "UTXOW"
-       , "UTXOS"
-       ]

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

@@ -45,6 +45,21 @@ class
   AlonzoEraTest era
 
 instance EraTest AlonzoEra where
+  type
+    EraRulesWithFailures AlonzoEra =
+      '[ "BBODY"
+       , "DELEG"
+       , "DELEGS"
+       , "DELPL"
+       , "LEDGER"
+       , "LEDGERS"
+       , "POOL"
+       , "PPUP"
+       , "UTXO"
+       , "UTXOS"
+       , "UTXOW"
+       ]
+
   zeroCostModels = zeroTestingCostModels [PlutusV1]
 
   mkTestAccountState = mkShelleyTestAccountState