Make tests era-generic

Author: Soupstraw

CONTRIBUTING.md

@@ -356,7 +356,11 @@ Next you'll want to add a datatype to represent the new era (e.g. `ConwayEra`).
 Then copy over the entire test suite from the previous era and substitute the 
 era types for the newly added era type. Once the tests are in place, the type 
 checker will guide you to add all the necessary type family and type class 
-instances.
+instances. You might need to make some of the tests era-generic. See which tests
+don't yet take an era type annotation and modify those test if possible. The tests
+that can be made era-generic should be moved to the `testlib` of the era where 
+they were first introduced, and any era-specific tests should reside in the test
+suite package of that era.
 
 Add the `Cardano.Ledger.<era>.Core` module and re-export the `Core` module from 
 the previous era. Use the `Core` module from the current era whenever you need 

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

@@ -153,6 +153,7 @@ library testlib
     Test.Cardano.Ledger.Conway.ImpTest
     Test.Cardano.Ledger.Conway.Plutus.PlutusSpec
     Test.Cardano.Ledger.Conway.Proposals
+    Test.Cardano.Ledger.Conway.Spec
     Test.Cardano.Ledger.Conway.SPORatifySpec
     Test.Cardano.Ledger.Conway.Translation.TranslatableGen
     Test.Cardano.Ledger.Conway.TreeDiff
@@ -249,7 +250,6 @@ test-suite tests
   other-modules:
     Paths_cardano_ledger_conway
     Test.Cardano.Ledger.Conway.GoldenTranslation
-    Test.Cardano.Ledger.Conway.Spec
 
   default-language: Haskell2010
   ghc-options:
@@ -269,6 +269,5 @@ test-suite tests
     base,
     cardano-ledger-alonzo:testlib,
     cardano-ledger-conway,
-    cardano-ledger-core,
-    cardano-ledger-core:testlib,
+    cardano-ledger-core:{testlib, cardano-ledger-core},
     testlib,

eras/conway/impl/test/Main.hs

@@ -2,50 +2,30 @@
 
 module Main where
 
+import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway (ConwayEra)
-import qualified Test.Cardano.Ledger.Alonzo.Binary.CostModelsSpec as CostModelsSpec
-import qualified Test.Cardano.Ledger.Alonzo.Binary.TxWitsSpec as TxWitsSpec
+import Cardano.Ledger.Conway.Tx (tierRefScriptFee)
 import Test.Cardano.Ledger.Common
-import qualified Test.Cardano.Ledger.Conway.Binary.CddlSpec as Cddl
-import qualified Test.Cardano.Ledger.Conway.Binary.Regression as Regression
-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.GenesisSpec as Genesis
-import Test.Cardano.Ledger.Conway.GoldenSpec as Golden
 import qualified Test.Cardano.Ledger.Conway.GoldenTranslation as GoldenTranslation
 import qualified Test.Cardano.Ledger.Conway.GovActionReorderSpec as GovActionReorder
-import qualified Test.Cardano.Ledger.Conway.Imp as Imp
 import Test.Cardano.Ledger.Conway.Plutus.PlutusSpec as PlutusSpec
-import qualified Test.Cardano.Ledger.Conway.Proposals as Proposals
-import qualified Test.Cardano.Ledger.Conway.SPORatifySpec as SPORatifySpec
-import qualified Test.Cardano.Ledger.Conway.Spec as Spec
-import qualified Test.Cardano.Ledger.Conway.TxInfoSpec as TxInfo
-import Test.Cardano.Ledger.Core.JSON (roundTripJsonEraSpec)
+import qualified Test.Cardano.Ledger.Conway.Spec as ConwaySpec
 
 main :: IO ()
-main =
-  ledgerTestMain $
-    describe "Conway" $ do
-      GoldenTranslation.spec
-      Golden.spec
-      Spec.spec
-      Proposals.spec
-      Binary.spec
-      Cddl.spec @ConwayEra
-      DRepRatify.spec
-      CommitteeRatify.spec
-      SPORatifySpec.spec
-      Genesis.spec
-      GovActionReorder.spec
-      roundTripJsonEraSpec @ConwayEra
-      describe "Imp" $
-        Imp.spec @ConwayEra
-      describe "CostModels" $ do
-        CostModelsSpec.spec @ConwayEra
-      describe "TxWits" $ do
-        TxWitsSpec.spec @ConwayEra
-      describe "Plutus" $ do
-        PlutusSpec.spec
-      Regression.spec @ConwayEra
-      TxInfo.spec
+main = ledgerTestMain $ do
+  describe "Conway era-generic" $ ConwaySpec.spec @ConwayEra
+  describe "Conway era-specific" $ do
+    GoldenTranslation.spec
+    Genesis.spec
+    GovActionReorder.spec
+    describe "Plutus" $ do
+      PlutusSpec.spec
+  describe "Various tests for functions defined in Conway" $ do
+    prop "tierRefScriptFee is a linear function when growth is 1" $ \(Positive sizeIncrement) baseFee (NonNegative size) ->
+      tierRefScriptFee 1 sizeIncrement baseFee size
+        === Coin (floor (fromIntegral size * baseFee))
+    it "tierRefScriptFee" $ do
+      let step = 25600
+      map (tierRefScriptFee 1.5 step 15) [0, step .. 204800]
+        `shouldBe` map Coin [0, 384000, 960000, 1824000, 3120000, 5064000, 7980000, 12354000, 18915000]

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

@@ -3,15 +3,18 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Test.Cardano.Ledger.Conway.BinarySpec (spec) where
 
 import Cardano.Ledger.Alonzo.TxWits (Redeemers, TxDats)
 import Cardano.Ledger.Binary
 import Cardano.Ledger.Conway
+import Cardano.Ledger.Conway.Core (AlonzoEraScript (..), AsIx)
 import Cardano.Ledger.Conway.Genesis
 import Cardano.Ledger.Conway.Governance
 import Cardano.Ledger.Core
+import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses)
 import Data.Default (def)
 import Data.Proxy
 import Data.Typeable (typeRep)
@@ -21,14 +24,29 @@ import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Conway.Binary.Annotator ()
 import Test.Cardano.Ledger.Conway.Binary.RoundTrip (roundTripConwayCommonSpec)
+import Test.Cardano.Ledger.Conway.Era (BabbageEraTest)
+import Test.Cardano.Ledger.Conway.ImpTest (ConwayEraImp)
 import Test.Cardano.Ledger.Conway.TreeDiff ()
 import Test.Cardano.Ledger.Core.Binary (specUpgrade)
 import Test.Cardano.Ledger.Core.Binary as Binary (decoderEquivalenceCoreEraTypesSpec, txSizeSpec)
-import Test.Cardano.Ledger.Core.Binary.RoundTrip (roundTripEraSpec)
+import Test.Cardano.Ledger.Core.Binary.RoundTrip (RuleListEra, roundTripEraSpec)
 
-spec :: Spec
+spec ::
+  forall era.
+  ( BabbageEraTest (PreviousEra era)
+  , ConwayEraImp era
+  , DecCBOR (TxAuxData era)
+  , DecCBOR (TxWits era)
+  , DecCBOR (TxBody era)
+  , DecCBOR (Tx era)
+  , Arbitrary (PlutusPurpose AsIx era)
+  , RuleListEra era
+  , StashedAVVMAddresses era ~ ()
+  , SafeToHash (TxWits era)
+  ) =>
+  Spec
 spec = do
-  specUpgrade @ConwayEra def
+  specUpgrade @era def
   describe "RoundTrip" $ do
     roundTripCborSpec @GovActionId
     roundTripCborSpec @(GovPurposeId 'PParamUpdatePurpose)
@@ -37,14 +55,14 @@ spec = do
     roundTripCborSpec @(GovPurposeId 'ConstitutionPurpose)
     roundTripCborSpec @Vote
     roundTripCborSpec @Voter
-    roundTripConwayCommonSpec @ConwayEra
+    roundTripConwayCommonSpec @era
     -- ConwayGenesis only makes sense in Conway era
-    roundTripEraSpec @ConwayEra @ConwayGenesis
+    roundTripEraSpec @era @ConwayGenesis
   describe "DecCBOR instances equivalence" $ do
-    Binary.decoderEquivalenceCoreEraTypesSpec @ConwayEra
-    decoderEquivalenceLenientSpec @(TxDats ConwayEra)
-    decoderEquivalenceLenientSpec @(Redeemers ConwayEra)
-  Binary.txSizeSpec @ConwayEra
+    Binary.decoderEquivalenceCoreEraTypesSpec @era
+    decoderEquivalenceLenientSpec @(TxDats era)
+    decoderEquivalenceLenientSpec @(Redeemers era)
+  Binary.txSizeSpec @era
   where
     -- The expectation used in this spec allows for the deserialization to fail, in which case
     -- it only checks that it fails for both decoders.

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

@@ -40,12 +40,13 @@ import qualified Data.Set as Set
 import Lens.Micro ((&), (.~))
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Conway.Arbitrary ()
+import Test.Cardano.Ledger.Conway.Era (ConwayEraTest)
 import Test.Cardano.Ledger.Core.Arbitrary ()
 
-spec :: Spec
+spec :: forall era. ConwayEraTest era => Spec
 spec = do
   describe "Committee Ratification" $ do
-    acceptedProp @ConwayEra
+    acceptedProp @era
     acceptedRatioProp
     allYesProp
     allNoProp

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

@@ -42,14 +42,15 @@ import qualified Data.Set as Set
 import Data.Word (Word64)
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Conway.Arbitrary ()
+import Test.Cardano.Ledger.Conway.Era (ConwayEraTest)
 import Test.Cardano.Ledger.Core.Arbitrary ()
 import Test.Cardano.Ledger.Core.Rational ((%!))
 
-spec :: Spec
+spec :: forall era. ConwayEraTest era => Spec
 spec = do
   describe "DRep Ratification" $ do
-    correctThresholdsProp @ConwayEra
-    noStakeProp @ConwayEra
+    correctThresholdsProp @era
+    noStakeProp @era
     acceptedRatioProp
     allAbstainProp
     noVotesProp

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

@@ -1,18 +1,18 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Test.Cardano.Ledger.Conway.GoldenSpec (spec) where
 
-import Cardano.Ledger.Conway
 import Paths_cardano_ledger_conway (getDataFileName)
 import Test.Cardano.Ledger.Common
-import Test.Cardano.Ledger.Conway.Era ()
+import Test.Cardano.Ledger.Conway.Era (ConwayEraTest)
 import Test.Cardano.Ledger.Core.JSON (goldenJsonPParamsSpec, goldenJsonPParamsUpdateSpec)
 
-spec :: Spec
+spec :: forall era. ConwayEraTest era => Spec
 spec =
   describe "Golden" $ do
     beforeAll (getDataFileName "golden/pparams.json") $
-      goldenJsonPParamsSpec @ConwayEra
+      goldenJsonPParamsSpec @era
     beforeAll (getDataFileName "golden/pparams-update.json") $
-      goldenJsonPParamsUpdateSpec @ConwayEra
+      goldenJsonPParamsUpdateSpec @era

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

@@ -1,10 +1,9 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Test.Cardano.Ledger.Conway.Proposals where
 
-import Cardano.Ledger.Conway
 import Cardano.Ledger.Conway.Governance
 import Control.DeepSeq (force)
 import Control.Exception (AssertionFailed (..), evaluate)
@@ -22,13 +21,14 @@ import Test.Cardano.Ledger.Conway.Arbitrary (
   ProposalsForEnactment (..),
   ProposalsNewActions (..),
  )
+import Test.Cardano.Ledger.Conway.Era (ConwayEraTest)
 
-spec :: Spec
+spec :: forall era. ConwayEraTest era => Spec
 spec = do
   describe "Proposals" $ do
     describe "Construction" $ do
       prop "Adding new nodes keeps Proposals consistent" $
-        \(ProposalsNewActions ps actions :: ProposalsNewActions ConwayEra) ->
+        \(ProposalsNewActions ps actions :: ProposalsNewActions era) ->
           let ps' =
                 F.foldl'
                   (\p action -> fromMaybe (error "Unable to add action") $ proposalsAddAction action p)
@@ -38,22 +38,22 @@ spec = do
            in actionsMap `shouldBe` (actionsMap `Map.intersection` proposalsActionsMap ps')
     describe "Removal" $ do
       prop "Removing leaf nodes keeps Proposals consistent" $
-        \(ps :: Proposals ConwayEra) -> do
+        \(ps :: Proposals era) -> do
           let gais = Set.fromList $ toList $ SSeq.takeLast 4 $ proposalsIds ps
               ps' = fst $ proposalsRemoveWithDescendants gais ps
           proposalsSize ps' `shouldBe` proposalsSize ps - Set.size gais
       prop "Removing root nodes keeps Proposals consistent" $
-        \(ps :: Proposals ConwayEra) -> do
+        \(ps :: Proposals era) -> do
           let gais = Set.fromList $ toList $ SSeq.take 4 $ proposalsIds ps
               ps' = fst $ proposalsRemoveWithDescendants gais ps
           proposalsSize ps' `shouldSatisfy` (<= proposalsSize ps)
       prop "Removing non-member nodes throws an AssertionFailure" $
-        \(ProposalsNewActions ps actions :: ProposalsNewActions ConwayEra) ->
+        \(ProposalsNewActions ps actions :: ProposalsNewActions era) ->
           (evaluate . force) (proposalsRemoveWithDescendants (Set.fromList $ gasId <$> actions) ps)
             `shouldThrow` \AssertionFailed {} -> True
     describe "Enactment" $ do
       prop "Adding votes preserves consistency" $
-        \( ProposalsForEnactment {pfeProposals, pfeToEnact} :: ProposalsForEnactment ConwayEra
+        \( ProposalsForEnactment {pfeProposals, pfeToEnact} :: ProposalsForEnactment era
            , voter :: Voter
            , vote :: Vote
            ) -> do
@@ -62,20 +62,20 @@ spec = do
               _ -> True
       prop "Enacting exhaustive lineages reduces Proposals to their roots" $
         \( ProposalsForEnactment {pfeProposals, pfeToEnact, pfeToRemove, pfeToRetain} ::
-             ProposalsForEnactment ConwayEra
+             ProposalsForEnactment era
            ) -> do
             let (ps', enacted, removedDueToEnactment, expiredRemoved) = proposalsApplyEnactment pfeToEnact Set.empty pfeProposals
             expiredRemoved `shouldSatisfy` Map.null
             enacted `shouldBe` fromElems gasId pfeToEnact
             Map.keysSet removedDueToEnactment `shouldBe` pfeToRemove
             proposalsSize ps' `shouldBe` Set.size pfeToRetain
       prop "Enacting non-member nodes throws an AssertionFailure" $
-        \(ProposalsNewActions ps actions :: ProposalsNewActions ConwayEra) ->
+        \(ProposalsNewActions ps actions :: ProposalsNewActions era) ->
           (evaluate . force) (proposalsApplyEnactment (fromList actions) Set.empty ps)
             `shouldThrow` \AssertionFailed {} -> True
       prop "Expiring compliments of exhaustive lineages keeps proposals consistent" $
         \( ProposalsForEnactment {pfeProposals, pfeToEnact, pfeToRemove, pfeToRetain} ::
-             ProposalsForEnactment ConwayEra
+             ProposalsForEnactment era
            ) -> do
             let (ps', enacted, removedDueToEnactment, expiredRemoved) =
                   proposalsApplyEnactment Seq.Empty pfeToRemove pfeProposals
@@ -88,12 +88,12 @@ spec = do
             proposalsSize emptyProposals `shouldBe` Set.size pfeToRetain
             enactedMap `shouldBe` enactMap
       prop "Expiring non-member nodes throws an AssertionFailure" $
-        \(ProposalsNewActions ps actions :: ProposalsNewActions ConwayEra) ->
+        \(ProposalsNewActions ps actions :: ProposalsNewActions era) ->
           (evaluate . force) (proposalsApplyEnactment Seq.Empty (Set.fromList $ gasId <$> actions) ps)
             `shouldThrow` \AssertionFailed {} -> True
       prop "Enacting and expiring conflicting proposals does not lead to removal due to enactment" $
         \( ProposalsForEnactment {pfeProposals, pfeToEnact, pfeToRemove, pfeToRetain} ::
-             ProposalsForEnactment ConwayEra
+             ProposalsForEnactment era
            ) -> do
             let (ps', enacted, enactedRemoved, expiredRemoved) = proposalsApplyEnactment pfeToEnact pfeToRemove pfeProposals
             Map.keysSet expiredRemoved `shouldBe` pfeToRemove

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

@@ -14,7 +14,6 @@ import Cardano.Ledger.Address (RewardAccount (..))
 import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
 import Cardano.Ledger.Compactible (Compactible (..))
-import Cardano.Ledger.Conway
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Governance (
   GovAction (..),
@@ -46,17 +45,18 @@ import Data.Ratio ((%))
 import Lens.Micro
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Conway.Arbitrary ()
+import Test.Cardano.Ledger.Conway.Era (ConwayEraTest)
 import Test.Cardano.Ledger.Core.Arbitrary ()
 
-spec :: Spec
+spec :: forall era. ConwayEraTest era => Spec
 spec = do
   describe "SPO Ratification" $ do
-    acceptedRatioProp @ConwayEra
-    noStakeProp @ConwayEra
-    allAbstainProp @ConwayEra
-    noVotesProp @ConwayEra
-    allYesProp @ConwayEra
-    noConfidenceProp @ConwayEra
+    acceptedRatioProp @era
+    noStakeProp @era
+    allAbstainProp @era
+    noVotesProp @era
+    allYesProp @era
+    noConfidenceProp @era
 
 acceptedRatioProp ::
   forall era.