Add EraSpecificSpec class

Author: Lucsanszky

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

@@ -4,19 +4,22 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Test.Cardano.Ledger.Allegra.Imp (spec) where
 
+import Cardano.Ledger.Allegra (AllegraEra)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Shelley.Rules (ShelleyUtxoPredFailure, ShelleyUtxowPredFailure)
 import qualified Test.Cardano.Ledger.Allegra.Imp.UtxowSpec as UtxowSpec
+import Test.Cardano.Ledger.Allegra.ImpTest
 import Test.Cardano.Ledger.Imp.Common
 import qualified Test.Cardano.Ledger.Shelley.Imp as ShelleyImp
-import Test.Cardano.Ledger.Shelley.ImpTest
 
 spec ::
   forall era.
   ( ShelleyEraImp era
+  , EraSpecificSpec era
   , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
   , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
   ) =>
@@ -25,3 +28,5 @@ spec = do
   ShelleyImp.spec @era
   describe "AllegraImpSpec" . withImpInit @(LedgerSpec era) $ do
     UtxowSpec.spec
+
+instance EraSpecificSpec AllegraEra

eras/alonzo/impl/test/Main.hs

@@ -31,7 +31,6 @@ main =
       Golden.spec
       describe "Imp" $ do
         Imp.spec @AlonzoEra
-        Imp.shelleyCertsSpec @AlonzoEra
       describe "CostModels" $ do
         CostModelsSpec.spec @AlonzoEra
       describe "TxWits" $ do

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

@@ -4,30 +4,32 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Test.Cardano.Ledger.Alonzo.Imp where
 
+import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Core
 import Cardano.Ledger.Alonzo.Rules (
   AlonzoUtxoPredFailure,
   AlonzoUtxosPredFailure,
   AlonzoUtxowPredFailure,
  )
 import Cardano.Ledger.Shelley.Rules (
-  ShelleyDelegPredFailure,
   ShelleyUtxoPredFailure,
   ShelleyUtxowPredFailure,
  )
 import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxoSpec as Utxo
 import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxosSpec as Utxos
 import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec as Utxow
-import Test.Cardano.Ledger.Alonzo.ImpTest (AlonzoEraImp, LedgerSpec)
+import Test.Cardano.Ledger.Alonzo.ImpTest
 import Test.Cardano.Ledger.Imp.Common
 import qualified Test.Cardano.Ledger.Mary.Imp as MaryImp
 
 spec ::
   forall era.
   ( AlonzoEraImp era
+  , EraSpecificSpec era
   , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
   , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era
@@ -42,16 +44,5 @@ spec = do
     Utxos.spec
     Utxow.spec
 
-shelleyCertsSpec ::
-  forall era.
-  ( AlonzoEraImp era
-  , ShelleyEraTxCert era
-  , InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
-  , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
-  , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
-  , InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
-  ) =>
-  Spec
-shelleyCertsSpec = do
-  describe "AlonzoImp - certificates without deposit" . withImpInit @(LedgerSpec era) $ do
-    Utxow.shelleyCertsSpec
+instance EraSpecificSpec AlonzoEra where
+  eraSpecific = Utxow.shelleyCertsSpec

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec.hs

@@ -44,6 +44,6 @@ shelleyCertsSpec ::
   ) =>
   SpecWith (ImpInit (LedgerSpec era))
 shelleyCertsSpec = do
-  describe "UTXOW" $ do
+  describe "UTXOW - certificates without deposits" $ do
     Valid.shelleyCertsSpec
     Invalid.shelleyCertsSpec

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

@@ -4,6 +4,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Test.Cardano.Ledger.Babbage.Imp (spec) where
 
@@ -13,17 +14,18 @@ import Cardano.Ledger.Alonzo.Rules (
   AlonzoUtxosPredFailure,
   AlonzoUtxowPredFailure,
  )
+import Cardano.Ledger.Babbage (BabbageEra)
 import Cardano.Ledger.Babbage.Core (BabbageEraTxBody, InjectRuleFailure)
 import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure, BabbageUtxowPredFailure)
 import Cardano.Ledger.Babbage.TxInfo (BabbageContextError)
 import Cardano.Ledger.BaseTypes (Inject)
 import Cardano.Ledger.Shelley.Rules (
-  -- ShelleyDelegPredFailure,
   ShelleyUtxoPredFailure,
   ShelleyUtxowPredFailure,
  )
 import qualified Test.Cardano.Ledger.Alonzo.Imp as AlonzoImp
-import Test.Cardano.Ledger.Alonzo.ImpTest (AlonzoEraImp, LedgerSpec)
+import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec as AlonzoUtxow
+import Test.Cardano.Ledger.Alonzo.ImpTest (AlonzoEraImp, EraSpecificSpec (..), LedgerSpec)
 import qualified Test.Cardano.Ledger.Babbage.Imp.UtxoSpec as Utxo
 import qualified Test.Cardano.Ledger.Babbage.Imp.UtxosSpec as Utxos
 import qualified Test.Cardano.Ledger.Babbage.Imp.UtxowSpec as Utxow
@@ -32,9 +34,9 @@ import Test.Cardano.Ledger.Imp.Common
 spec ::
   forall era.
   ( AlonzoEraImp era
+  , EraSpecificSpec era
   , BabbageEraTxBody era
-  , -- , InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
-    InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
+  , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
@@ -46,8 +48,10 @@ spec ::
   Spec
 spec = do
   AlonzoImp.spec @era
-  withImpInit @(LedgerSpec era) $
-    describe "BabbageImpSpec" $ do
-      Utxo.spec
-      Utxow.spec
-      Utxos.spec @era
+  describe "BabbageImpSpec - era generic tests" . withImpInit @(LedgerSpec era) $ do
+    Utxo.spec
+    Utxow.spec
+    Utxos.spec @era
+
+instance EraSpecificSpec BabbageEra where
+  eraSpecific = AlonzoUtxow.shelleyCertsSpec

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

@@ -5,9 +5,9 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
-{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
-module Test.Cardano.Ledger.Conway.Imp (spec, conwaySpec, shelleyCertsSpec) where
+module Test.Cardano.Ledger.Conway.Imp (spec) where
 
 import Cardano.Ledger.Alonzo.Plutus.Context (
   EraPlutusContext (ContextError),
@@ -21,6 +21,7 @@ import Cardano.Ledger.Alonzo.Rules (
 import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure, BabbageUtxowPredFailure)
 import Cardano.Ledger.Babbage.TxInfo (BabbageContextError)
 import Cardano.Ledger.BaseTypes (Inject)
+import Cardano.Ledger.Conway (ConwayEra)
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Rules (
   ConwayBbodyPredFailure,
@@ -39,13 +40,12 @@ import Cardano.Ledger.Conway.TxInfo (ConwayContextError)
 import Cardano.Ledger.Plutus (Language (..))
 import Cardano.Ledger.Shelley.API.Mempool (ApplyTx (..))
 import Cardano.Ledger.Shelley.Rules (
-  ShelleyDelegPredFailure,
   ShelleyUtxoPredFailure,
   ShelleyUtxowPredFailure,
  )
 import Control.State.Transition.Extended
 import Data.Typeable (Typeable)
-import qualified Test.Cardano.Ledger.Alonzo.Imp as AlonzoImp
+import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec as AlonzoUtxow
 import qualified Test.Cardano.Ledger.Babbage.Imp as BabbageImp
 import qualified Test.Cardano.Ledger.Conway.Imp.BbodySpec as Bbody
 import qualified Test.Cardano.Ledger.Conway.Imp.CertsSpec as Certs
@@ -65,11 +65,12 @@ import Test.Cardano.Ledger.Conway.ImpTest (
   modifyImpInitProtVer,
  )
 import Test.Cardano.Ledger.Imp.Common
-import Test.Cardano.Ledger.Shelley.ImpTest (ImpInit)
+import Test.Cardano.Ledger.Shelley.ImpTest (EraSpecificSpec (..), ImpInit)
 
 spec ::
   forall era.
   ( ConwayEraImp era
+  , EraSpecificSpec era
   , Inject (BabbageContextError era) (ContextError era)
   , Inject (ConwayContextError era) (ContextError era)
   , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
@@ -79,7 +80,6 @@ spec ::
   , InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
-  , InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
   , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
   , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
   , InjectRuleFailure "LEDGER" ConwayDelegPredFailure era
@@ -106,10 +106,10 @@ spec = do
   withImpInit @(LedgerSpec era) $
     forM_ (eraProtVersions @era) $ \protVer ->
       describe ("ConwayImpSpec - " <> show protVer) $
-        modifyImpInitProtVer protVer $
-          conwaySpec @era
+        modifyImpInitProtVer protVer $ do
+          conwayEraGenericSpec @era
 
-conwaySpec ::
+conwayEraGenericSpec ::
   forall era.
   ( ConwayEraImp era
   , Inject (BabbageContextError era) (ContextError era)
@@ -139,7 +139,7 @@ conwaySpec ::
   , EraPlutusTxInfo PlutusV2 era
   ) =>
   SpecWith (ImpInit (LedgerSpec era))
-conwaySpec = do
+conwayEraGenericSpec = do
   describe "BBODY" Bbody.spec
   describe "CERTS" Certs.spec
   describe "DELEG" Deleg.spec
@@ -154,40 +154,23 @@ conwaySpec = do
 
 -- describe "UTXOW" Utxow.spec
 
-shelleyCertsSpec ::
-  forall era.
+conwayEraSpecificSpec ::
   ( ConwayEraImp era
   , ShelleyEraTxCert era
-  , Inject (BabbageContextError era) (ContextError era)
   , Inject (ConwayContextError era) (ContextError era)
-  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
-  , InjectRuleFailure "LEDGER" ConwayCertsPredFailure era
-  , InjectRuleFailure "LEDGER" BabbageUtxoPredFailure era
-  , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
-  , InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
-  , InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
-  , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
   , InjectRuleFailure "LEDGER" ConwayDelegPredFailure era
-  , InjectRuleFailure "LEDGER" ConwayGovCertPredFailure era
   , InjectRuleFailure "LEDGER" ConwayLedgerPredFailure era
-  , InjectRuleFailure "LEDGER" ConwayUtxoPredFailure era
-  , InjectRuleFailure "BBODY" ConwayBbodyPredFailure era
-  , InjectRuleEvent "TICK" ConwayEpochEvent era
-  , Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era
-  , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era
-  , Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era
-  , ApplyTx era
-  , NFData (Event (EraRule "ENACT" era))
-  , ToExpr (Event (EraRule "ENACT" era))
-  , Eq (Event (EraRule "ENACT" era))
-  , Typeable (Event (EraRule "ENACT" era))
+  , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
   ) =>
-  Spec
-shelleyCertsSpec = do
-  AlonzoImp.shelleyCertsSpec @era
-  withImpInit @(LedgerSpec era) $
-    forM_ (eraProtVersions @era) $ \protVer ->
-      describe ("Certificates without deposits - " <> show protVer) $
-        modifyImpInitProtVer protVer $ do
-          describe "DELEG" Deleg.shelleyCertsSpec
-          describe "UTXO" Utxo.shelleyCertsSpec
+  SpecWith (ImpInit (LedgerSpec era))
+conwayEraSpecificSpec = do
+  describe "DELEG - certificates without deposits" Deleg.shelleyCertsSpec
+  describe "LEDGER - certificates without deposits" Ledger.shelleyCertsSpec
+  describe "RATIFY - certificates without deposits" Ratify.shelleyCertsSpec
+  describe "UTXO - certificates without deposits" Utxo.shelleyCertsSpec
+  describe "UTXOS - certificates without deposits" Utxos.shelleyCertsSpec
+
+instance EraSpecificSpec ConwayEra where
+  eraSpecific =
+    AlonzoUtxow.shelleyCertsSpec
+      >> conwayEraSpecificSpec

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

@@ -39,7 +39,6 @@ import Cardano.Ledger.Plutus.Language (SLanguage (..))
 import Cardano.Ledger.Shelley.API (ApplyTx)
 import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses)
 import Cardano.Ledger.Shelley.Rules (
-  ShelleyDelegPredFailure,
   ShelleyUtxoPredFailure,
   ShelleyUtxowPredFailure,
  )
@@ -54,7 +53,7 @@ import qualified Test.Cardano.Ledger.Conway.BinarySpec as Binary
 import qualified Test.Cardano.Ledger.Conway.CommitteeRatifySpec as CommitteeRatify
 import qualified Test.Cardano.Ledger.Conway.DRepRatifySpec as DRepRatify
 import qualified Test.Cardano.Ledger.Conway.Imp as Imp
-import Test.Cardano.Ledger.Conway.ImpTest (ConwayEraImp)
+import Test.Cardano.Ledger.Conway.ImpTest (ConwayEraImp, EraSpecificSpec)
 import qualified Test.Cardano.Ledger.Conway.Proposals as Proposals
 import qualified Test.Cardano.Ledger.Conway.SPORatifySpec as SPORatifySpec
 import qualified Test.Cardano.Ledger.Conway.TxInfoSpec as TxInfo
@@ -68,6 +67,7 @@ spec ::
   , EraPlutusTxInfo PlutusV3 era
   , RuleListEra era
   , ConwayEraImp era
+  , EraSpecificSpec era
   , ApplyTx era
   , DecCBOR (TxWits era)
   , DecCBOR (TxBody era)
@@ -88,7 +88,6 @@ spec ::
   , InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
   , InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
-  , InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
   , InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
   , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
   , InjectRuleFailure "LEDGER" ConwayDelegPredFailure era
@@ -116,7 +115,6 @@ spec =
     roundTripJsonEraSpec @era
     describe "Imp" $ do
       Imp.spec @era
-      Imp.shelleyCertsSpec @era
     describe "CostModels" $ do
       CostModelsSpec.spec @era
     describe "TxWits" $ do

eras/dijkstra/test/Main.hs

@@ -15,13 +15,10 @@ import Test.Cardano.Ledger.Shelley.JSON (roundTripJsonShelleyEraSpec)
 
 main :: IO ()
 main =
-  ledgerTestMain $ do
-    describe "Dijkstra era-generic" $ do
-      TxInfo.spec -- @DijkstraEra
+  ledgerTestMain $
+    describe "Dijkstra" $ do
+      GoldenSpec.spec
+      roundTripJsonShelleyEraSpec @DijkstraEra
+      TxInfo.spec
       describe "Imp" $ do
         Imp.spec @DijkstraEra
-    describe "Dijkstra era-specific" $ do
-      -- TODO
-      pure ()
-    roundTripJsonShelleyEraSpec @DijkstraEra
-    GoldenSpec.spec