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 #-}
@@ -19,7 +20,7 @@ module Test.Cardano.Ledger.Alonzo.Arbitrary (
   alwaysSucceedsLang,
   alwaysFails,
   alwaysFailsLang,
-  FlexibleCostModels (..),
+  genEraLanguage,
   genAlonzoScript,
   genNativeScript,
   genPlutusScript,
@@ -63,7 +64,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 (..),
@@ -93,9 +94,9 @@ import Numeric.Natural (Natural)
 import qualified PlutusLedgerApi.V1 as PV1
 import Test.Cardano.Ledger.Common
 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 +270,7 @@ instance Arbitrary (AlonzoPParams Identity era) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> genValidCostModels [PlutusV1, PlutusV2]
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
@@ -299,7 +300,7 @@ instance Arbitrary (AlonzoPParams StrictMaybe era) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> oneof [pure SNothing, SJust <$> genValidCostModels [PlutusV1, PlutusV2]]
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
@@ -449,7 +450,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,40 +18,37 @@ 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
     underspecifiedCostModelProp @era
     unknownCostModelProp @era
   prop "applyPPUpdates" $ \valid validUpdate unknown unknownUpdate -> do
-    let
-      validExpected = mkCostModels (costModelsValid validUpdate <> costModelsValid valid)
-      unknownExpected = unknownUpdate <> unknown
     original <- mkCostModelsLenient (flattenCostModels valid <> unknown)
-    update <- mkCostModelsLenient (flattenCostModels validUpdate <> unknownUpdate)
-    expected <- mkCostModelsLenient (flattenCostModels validExpected <> unknownExpected)
+    originalUpdate <- mkCostModelsLenient (flattenCostModels validUpdate <> unknownUpdate)
     let
       pp = emptyPParams & ppCostModelsL .~ original
-      ppUpdate =
-        emptyPParamsUpdate & ppuCostModelsL .~ SJust update
+      ppUpdate = emptyPParamsUpdate & ppuCostModelsL .~ SJust originalUpdate
+      updated = applyPPUpdates @era pp ppUpdate
     -- Starting with Conway we update CostModel on per-language basis, while before
     -- that CostModels where overwritten completely
-    applyPPUpdates @era pp ppUpdate
-      `shouldBe` if eraProtVerLow @era >= natVersion @9
-        then pp & ppCostModelsL .~ expected
-        else pp & ppCostModelsL .~ update
+    if eraProtVerLow @era >= natVersion @9
+      then do
+        expected <- mkCostModelsLenient (flattenCostModels originalUpdate <> flattenCostModels original)
+        updated `shouldBe` (pp & ppCostModelsL .~ expected)
+      else updated `shouldBe` (pp & ppCostModelsL .~ originalUpdate)
 
 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 $
@@ -64,29 +61,29 @@ validCostModelProp = do
     validCm cms =
       not (null (costModelsValid cms)) && null (costModelsUnknown cms)
 
+-- | Underspecified is a CostModel that has less than the normal number of parameters
 underspecifiedCostModelProp ::
   forall era.
   AlonzoEraPParams era =>
   Spec
 underspecifiedCostModelProp = do
   prop "CostModels with less than expected parameters within PParamsUpdate" $
     \(lang :: Language) -> do
-      forAllShow (genInvalidCostModelEnc lang) (showEnc @era) $
+      forAllShow (genUnderspecifiedCostModelEnc lang) (showEnc @era) $
         \shortCmEnc -> do
           encodeAndCheckDecoded @era shortCmEnc $
             \cmDecoded ppuDecoded -> do
-              -- pre-Conway we are failing when deserializing invalid costmodels
+              -- pre-Conway we are failing when deserializing underspecified costmodels
               if eraProtVerHigh @era < natVersion @9
-                then expectDeserialiseFailure cmDecoded (Just "CostModels")
+                then do
+                  expectDeserialiseFailure cmDecoded (Just "CostModels")
+                  expectDeserialiseFailure ppuDecoded Nothing
                 else do
-                  -- post-Conway, we are collecting CostModels deserialization errors
+                  -- post-Conway, we are retaining CostModels that specified less parameters than expected
                   cmRes <- expectRight cmDecoded
                   cmRes `shouldSatisfy` not . null . costModelsValid
-
-              -- in no era are we deserializing invalid costmodels within PParamsUpdate
-              expectDeserialiseFailure ppuDecoded Nothing
   where
-    genInvalidCostModelEnc lang = do
+    genUnderspecifiedCostModelEnc lang = do
       let validCount = costModelParamsCount lang
       count <- choose (0, validCount - 1)
       genCostModelEncForLanguage lang count

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

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

@@ -66,11 +66,7 @@ import Generic.Random (genericArbitraryU)
 import Lens.Micro
 import Test.Cardano.Data (genNonEmptyMap)
 import Test.Cardano.Data.Arbitrary ()
-import Test.Cardano.Ledger.Alonzo.Arbitrary (
-  genValidAndUnknownCostModels,
-  genValidCostModel,
-  unFlexibleCostModels,
- )
+import Test.Cardano.Ledger.Alonzo.Arbitrary (genValidAndUnknownCostModels, genValidCostModel)
 import Test.Cardano.Ledger.Babbage.Arbitrary ()
 import Test.Cardano.Ledger.Common
 
@@ -719,7 +715,7 @@ instance Era era => Arbitrary (ConwayPParams Identity era) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> (THKD . unFlexibleCostModels <$> arbitrary)
+      <*> (THKD <$> arbitrary)
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/RoundTrip.hs

@@ -18,8 +18,8 @@ import Cardano.Ledger.Conway (ConwayEra)
 import Cardano.Ledger.Conway.Governance
 import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto (Crypto)
+import Cardano.Ledger.Plutus (CostModels)
 import Cardano.Ledger.Shelley.LedgerState
-import Test.Cardano.Ledger.Alonzo.Arbitrary (FlexibleCostModels (..))
 import Test.Cardano.Ledger.Alonzo.Binary.RoundTrip (roundTripAlonzoCommonSpec)
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Conway.Arbitrary ()
@@ -65,8 +65,7 @@ roundTripConwayEraTypesSpec = do
     roundTripEraTypeSpec @era @VotingProcedures
     roundTripEraTypeSpec @era @ProposalProcedure
     roundTripEraTypeSpec @era @Constitution
-    -- Conway adds ability to serialize unknown cost models, i.e. FlexibleCostModels
-    prop "CostModels" $ roundTripEraExpectation @era . unFlexibleCostModels
+    prop "CostModels" $ roundTripEraExpectation @era @CostModels
   describe "Conway State Types" $ do
     roundTripShareEraTypeSpec @era @EnactState
     roundTripShareEraTypeSpec @era @GovActionState

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

@@ -42,7 +42,6 @@ import Data.Tree
 import Lens.Micro
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Conway.ImpTest
-import Test.Cardano.Ledger.Core.Arbitrary (FlexibleCostModels (..))
 import Test.Cardano.Ledger.Core.Rational (IsRatio (..))
 import Test.Cardano.Ledger.Imp.Common hiding (Success)
 
@@ -85,7 +84,7 @@ unknownCostModelsSpec =
   describe "Unknown CostModels" $ do
     it "Are accepted" $ do
       costModels <- getsPParams ppCostModelsL
-      FlexibleCostModels newCostModels <- arbitrary
+      newCostModels <- arbitrary
       (hotCommitteeC :| _) <- registerInitialCommittee
       (drepC, _, _) <- setupSingleDRep 1_000_000
       gai <-

libs/cardano-ledger-core/CHANGELOG.md

@@ -5,9 +5,6 @@
 * Add lenses to `RewardAccount`. #4309
   * `rewardAccountCredentialL`
   * `rewardAccountNetworkL`
-
-## 1.11.1.0
-
 * Add `Inject` instances for tuples
 * Add `umElemDRepDelegatedReward` to `UMap`. #4273
 * Add `fromDeltaCoin`
@@ -22,10 +19,22 @@
 * Move `Metadatum` from `cardano-ledger-shelley` into a new module `Cardano.Ledger.Metadata`
 * Add `mkBasicTxAuxData` and `metadataTxAuxDataL` to `EraTxAuxData` type class.
 * Add `Random`, `Uniform` and `UniformRange` instances for `Language`
+* Add `decodeCostModelsLenient` and `decodeCostModelsFailing`
+* Make decoder for `CostModels` very lenient starting with protocol version `9`.
+* Deprecate `decodeValidAndUnknownCostModels`
+* Disable deserialization of `CostModels` for `PlutusV3` and newer whenever current
+  protocol version is not set to at least version `9`
+* Remove `CostModelError` and `costModelsErrors`
+* Stop re-exporting `CostModelApplyError`
+* Change `CostModel` parameter value type from `Integer` to `Int64`. Affects type
+  signatures of all functions that work on raw cost model parameter values.
+* `mkCostModelsLenient` was changed to work in `MonadFail`, since failures during
+  construction is now again possible.
 
 ### `testlib`
 
 * Export `subState`
+* Remove `FlexibleCostModels` and make `Arbitrary` instance for `CostModels` more flexible.
 
 ## 1.11.0.0