Adjust CostModel tests

eras/alonzo/impl/test/Test/Cardano/Ledger/Alonzo/BinarySpec.hs

@@ -4,7 +4,6 @@ module Test.Cardano.Ledger.Alonzo.BinarySpec (spec) where
 
 import Cardano.Ledger.Alonzo
 import Cardano.Ledger.Alonzo.Genesis
-import Cardano.Ledger.Alonzo.Scripts
 import Test.Cardano.Ledger.Alonzo.Arbitrary ()
 import Test.Cardano.Ledger.Alonzo.Binary.RoundTrip (roundTripAlonzoCommonSpec)
 import Test.Cardano.Ledger.Alonzo.TreeDiff ()
@@ -23,6 +22,3 @@ spec = do
     roundTripAlonzoCommonSpec @Alonzo
     -- AlonzoGenesis only makes sense in Alonzo era
     roundTripEraSpec @Alonzo @AlonzoGenesis
-    -- CostModel serialization changes drastically for Conway, which requires a different
-    -- QuickCheck generator, hence Arbitrary can't be reused
-    roundTripEraSpec @Alonzo @CostModels

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

@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -20,6 +21,7 @@ module Test.Cardano.Ledger.Alonzo.Arbitrary (
   alwaysFails,
   alwaysFailsLang,
   FlexibleCostModels (..),
+  genEraLanguage,
   genAlonzoScript,
   genNativeScript,
   genPlutusScript,
@@ -63,7 +65,7 @@ import Cardano.Ledger.Alonzo.TxWits (
   Redeemers (Redeemers),
   TxDats (TxDats),
  )
-import Cardano.Ledger.BaseTypes (StrictMaybe)
+import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import Cardano.Ledger.Plutus.Data (
   BinaryData,
   Data (..),
@@ -96,6 +98,7 @@ import Test.Cardano.Ledger.Core.Arbitrary (
   FlexibleCostModels (..),
   genValidAndUnknownCostModels,
   genValidCostModel,
+  genValidCostModels,
  )
 import Test.Cardano.Ledger.Mary.Arbitrary ()
 import Test.Cardano.Ledger.Plutus (alwaysFailsPlutus, alwaysSucceedsPlutus)
@@ -269,7 +272,7 @@ instance Arbitrary (AlonzoPParams Identity era) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> genValidCostModels [PlutusV1, PlutusV2]
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
@@ -299,7 +302,7 @@ instance Arbitrary (AlonzoPParams StrictMaybe era) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> oneof [pure SNothing, SJust <$> genValidCostModels [PlutusV1, PlutusV2]]
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
@@ -450,7 +453,7 @@ instance Arbitrary AlonzoGenesis where
   arbitrary =
     AlonzoGenesis
       <$> arbitrary
-      <*> arbitrary
+      <*> genValidCostModels [PlutusV1, PlutusV2]
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary

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

@@ -18,10 +18,10 @@ import qualified Data.Map as Map
 import Data.Text (Text)
 import Data.Word (Word8)
 import Lens.Micro
-import Test.Cardano.Ledger.Alonzo.Arbitrary ()
+import Test.Cardano.Ledger.Alonzo.Arbitrary (genEraLanguage)
 import Test.Cardano.Ledger.Common
 
-spec :: forall era. AlonzoEraPParams era => Spec
+spec :: forall era. (AlonzoEraPParams era, AlonzoEraScript era) => Spec
 spec = do
   describe "CBOR deserialization" $ do
     validCostModelProp @era
@@ -47,11 +47,11 @@ spec = do
 
 validCostModelProp ::
   forall era.
-  AlonzoEraPParams era =>
+  (AlonzoEraPParams era, AlonzoEraScript era) =>
   Spec
 validCostModelProp = do
   prop "valid CostModels deserialize correctly, both independently and within PParamsUpdate" $
-    \(lang :: Language) -> do
+    forAll (genEraLanguage @era) $ \(lang :: Language) -> do
       forAllShow (genValidCostModelEnc lang) (showEnc @era) $
         \validCmEnc -> do
           encodeAndCheckDecoded @era validCmEnc $

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -16,12 +17,18 @@ import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Compactible
 import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto (Crypto)
-import Cardano.Ledger.Plutus.Data
+import Cardano.Ledger.Plutus
 import Cardano.Ledger.Shelley.Governance
 import Cardano.Ledger.Shelley.LedgerState
 import Test.Cardano.Ledger.Alonzo.Arbitrary ()
 import Test.Cardano.Ledger.Common
-import Test.Cardano.Ledger.Core.Binary.RoundTrip
+import Test.Cardano.Ledger.Core.Arbitrary (genValidCostModels)
+import Test.Cardano.Ledger.Core.Binary.RoundTrip (
+  RuleListEra (..),
+  roundTripAnnEraTypeSpec,
+  roundTripEraExpectation,
+  roundTripEraTypeSpec,
+ )
 import Test.Cardano.Ledger.Shelley.Binary.RoundTrip (roundTripShelleyCommonSpec)
 
 roundTripAlonzoCommonSpec ::
@@ -56,6 +63,11 @@ roundTripAlonzoEraTypesSpec = do
   describe "Alonzo era types" $ do
     roundTripAnnEraTypeSpec @era @Data
     roundTripEraTypeSpec @era @BinaryData
+    -- CostModel serialization changes drastically for Conway, which requires a different
+    -- QuickCheck generator, hence Arbitrary can't be reused
+    prop "CostModels" $
+      forAll (genValidCostModels [PlutusV1, PlutusV2]) $
+        roundTripEraExpectation @era
     xdescribe "Datum doesn't roundtrip" $ do
       -- TODO: Adjust Datum implementation somehow to avoid this situtaiton
       -- It doesn't roundtrip because we do not en/decode NoDatum

eras/babbage/impl/test/Test/Cardano/Ledger/Babbage/BinarySpec.hs

@@ -5,7 +5,6 @@
 
 module Test.Cardano.Ledger.Babbage.BinarySpec (spec) where
 
-import Cardano.Ledger.Alonzo.Scripts
 import Cardano.Ledger.Babbage
 import Cardano.Ledger.Crypto (Crypto)
 import Data.Default.Class (def)
@@ -14,16 +13,13 @@ import Test.Cardano.Ledger.Babbage.Arbitrary ()
 import Test.Cardano.Ledger.Babbage.TreeDiff ()
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.Binary (specUpgrade)
-import Test.Cardano.Ledger.Core.Binary.RoundTrip (RuleListEra (..), roundTripEraSpec)
+import Test.Cardano.Ledger.Core.Binary.RoundTrip (RuleListEra (..))
 
 spec :: Spec
 spec = do
   specUpgrade @Babbage def
   describe "RoundTrip" $ do
     roundTripAlonzoCommonSpec @Babbage
-    -- CostModel serialization changes drastically for Conway, which requires a different
-    -- QuickCheck generator, hence Arbitrary can't be reused
-    roundTripEraSpec @Babbage @CostModels
 
 instance Crypto c => RuleListEra (BabbageEra c) where
   type

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

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -16,14 +17,15 @@ import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..), BabbageUtxowPr
 import Cardano.Ledger.Babbage.Tx
 import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
 import Cardano.Ledger.Babbage.TxInfo (BabbageContextError (..))
-import Cardano.Ledger.BaseTypes (StrictMaybe)
+import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import Cardano.Ledger.Binary (Sized)
 import Cardano.Ledger.Crypto (Crypto)
-import Cardano.Ledger.Plutus.TxInfo (TxOutSource)
+import Cardano.Ledger.Plutus
 import Control.State.Transition (STS (PredicateFailure))
 import Data.Functor.Identity (Identity)
 import Generic.Random (genericArbitraryU)
 import Test.Cardano.Ledger.Alonzo.Arbitrary ()
+import Test.Cardano.Ledger.Core.Arbitrary (genValidCostModels)
 import Test.QuickCheck
 
 deriving instance Arbitrary CoinPerByte
@@ -46,7 +48,7 @@ instance Arbitrary (BabbagePParams Identity era) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> genValidCostModels [PlutusV1, PlutusV2]
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
@@ -72,7 +74,7 @@ instance Arbitrary (BabbagePParams StrictMaybe era) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> oneof [pure SNothing, SJust <$> genValidCostModels [PlutusV1, PlutusV2]]
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary

libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/CostModels.hs

@@ -376,7 +376,10 @@ mkCostModelsLenient = Map.foldrWithKey addRawCostModel (pure (CostModels mempty
 -- upon deserialization.
 flattenCostModels :: CostModels -> Map Word8 [Int64]
 flattenCostModels (CostModels validCostModels unknownCostModels) =
-  Map.foldrWithKey (\lang cm -> Map.insert (languageToWord8 lang) (cmValues cm)) unknownCostModels validCostModels
+  Map.foldrWithKey
+    (\lang cm -> Map.insert (languageToWord8 lang) (cmValues cm))
+    unknownCostModels
+    validCostModels
 
 languageToWord8 :: Language -> Word8
 languageToWord8 lang

libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Arbitrary.hs

@@ -35,6 +35,7 @@ module Test.Cardano.Ledger.Core.Arbitrary (
   FlexibleCostModels (..),
   genValidAndUnknownCostModels,
   genValidCostModel,
+  genValidCostModels,
 
   -- * Utils
 

libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/RoundTrip.hs

@@ -51,7 +51,7 @@ import Test.Cardano.Ledger.Core.Arbitrary ()
 -- | QuickCheck property spec that uses `roundTripEraExpectation`
 roundTripEraSpec ::
   forall era t.
-  (Era era, Show t, Eq t, EncCBOR t, DecCBOR t, Arbitrary t) =>
+  (Era era, Show t, Eq t, EncCBOR t, DecCBOR t, Arbitrary t, HasCallStack) =>
   Spec
 roundTripEraSpec =
   prop (show (typeRep $ Proxy @t)) $ roundTripEraExpectation @era @t
@@ -60,7 +60,7 @@ roundTripEraSpec =
 -- EncCBOR/DecCBOR. Requires TypeApplication of an @@era@
 roundTripEraExpectation ::
   forall era t.
-  (Era era, Show t, Eq t, EncCBOR t, DecCBOR t) =>
+  (Era era, Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
   t ->
   Expectation
 roundTripEraExpectation =
@@ -69,7 +69,7 @@ roundTripEraExpectation =
 -- | QuickCheck property spec that uses `roundTripAnnEraExpectation`
 roundTripAnnEraSpec ::
   forall era t.
-  (Era era, Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t) =>
+  (Era era, Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t, HasCallStack) =>
   Spec
 roundTripAnnEraSpec =
   prop (show (typeRep $ Proxy @t)) $ roundTripAnnEraExpectation @era @t
@@ -79,7 +79,7 @@ roundTripAnnEraSpec =
 -- to be already fully encoded.
 roundTripAnnEraExpectation ::
   forall era t.
-  (Era era, Show t, Eq t, ToCBOR t, DecCBOR (Annotator t)) =>
+  (Era era, Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), HasCallStack) =>
   t ->
   Expectation
 roundTripAnnEraExpectation =
@@ -88,7 +88,14 @@ roundTripAnnEraExpectation =
 -- | QuickCheck property spec that uses `roundTripEraTypeExpectation`
 roundTripEraTypeSpec ::
   forall era t.
-  (Era era, Show (t era), Eq (t era), EncCBOR (t era), DecCBOR (t era), Arbitrary (t era)) =>
+  ( Era era
+  , Show (t era)
+  , Eq (t era)
+  , EncCBOR (t era)
+  , DecCBOR (t era)
+  , Arbitrary (t era)
+  , HasCallStack
+  ) =>
   Spec
 roundTripEraTypeSpec =
   prop (show (typeRep $ Proxy @(t era))) $ roundTripEraTypeExpectation @era @t
@@ -98,7 +105,7 @@ roundTripEraTypeSpec =
 -- types of this function are unambiguous.
 roundTripEraTypeExpectation ::
   forall era t.
-  (Era era, Show (t era), Eq (t era), EncCBOR (t era), DecCBOR (t era)) =>
+  (Era era, Show (t era), Eq (t era), EncCBOR (t era), DecCBOR (t era), HasCallStack) =>
   t era ->
   Expectation
 roundTripEraTypeExpectation = roundTripEraExpectation @era @(t era)
@@ -112,6 +119,7 @@ roundTripAnnEraTypeSpec ::
   , ToCBOR (t era)
   , DecCBOR (Annotator (t era))
   , Arbitrary (t era)
+  , HasCallStack
   ) =>
   Spec
 roundTripAnnEraTypeSpec =
@@ -125,6 +133,7 @@ roundTripAnnEraTypeExpectation ::
   , Eq (t era)
   , ToCBOR (t era)
   , DecCBOR (Annotator (t era))
+  , HasCallStack
   ) =>
   t era ->
   Expectation
@@ -133,7 +142,7 @@ roundTripAnnEraTypeExpectation = roundTripAnnEraExpectation @era @(t era)
 -- | QuickCheck property spec that uses `roundTripShareEraExpectation`
 roundTripShareEraSpec ::
   forall era t.
-  (Era era, Show t, Eq t, EncCBOR t, DecShareCBOR t, Arbitrary t) =>
+  (Era era, Show t, Eq t, EncCBOR t, DecShareCBOR t, Arbitrary t, HasCallStack) =>
   Spec
 roundTripShareEraSpec =
   prop (show (typeRep $ Proxy @t)) $ roundTripShareEraExpectation @era @t
@@ -142,7 +151,7 @@ roundTripShareEraSpec =
 -- EncCBOR/DecShareCBOR. Requires TypeApplication of an @@era@
 roundTripShareEraExpectation ::
   forall era t.
-  (Era era, Show t, Eq t, EncCBOR t, DecShareCBOR t) =>
+  (Era era, Show t, Eq t, EncCBOR t, DecShareCBOR t, HasCallStack) =>
   t ->
   Expectation
 roundTripShareEraExpectation =
@@ -154,7 +163,14 @@ roundTripShareEraExpectation =
 -- | QuickCheck property spec that uses `roundTripShareEraTypeExpectation`
 roundTripShareEraTypeSpec ::
   forall era t.
-  (Era era, Show (t era), Eq (t era), EncCBOR (t era), DecShareCBOR (t era), Arbitrary (t era)) =>
+  ( Era era
+  , Show (t era)
+  , Eq (t era)
+  , EncCBOR (t era)
+  , DecShareCBOR (t era)
+  , Arbitrary (t era)
+  , HasCallStack
+  ) =>
   Spec
 roundTripShareEraTypeSpec =
   prop (show (typeRep $ Proxy @(t era))) $ roundTripShareEraTypeExpectation @era @t
@@ -164,7 +180,7 @@ roundTripShareEraTypeSpec =
 -- types of this function are unambiguous.
 roundTripShareEraTypeExpectation ::
   forall era t.
-  (Era era, Show (t era), Eq (t era), EncCBOR (t era), DecShareCBOR (t era)) =>
+  (Era era, Show (t era), Eq (t era), EncCBOR (t era), DecShareCBOR (t era), HasCallStack) =>
   t era ->
   Expectation
 roundTripShareEraTypeExpectation = roundTripShareEraExpectation @era @(t era)
@@ -184,6 +200,7 @@ roundTripCoreEraTypesSpec ::
   , Arbitrary (Script era)
   , Arbitrary (PParams era)
   , Arbitrary (PParamsUpdate era)
+  , HasCallStack
   ) =>
   Spec
 roundTripCoreEraTypesSpec = do
@@ -252,6 +269,7 @@ roundTripAllPredicateFailures ::
   forall era.
   ( RuleListEra era
   , Era era
+  , HasCallStack
   ) =>
   Spec
 roundTripAllPredicateFailures =