Merge pull request #4284 from IntersectMBO/lehins/flexible-costmodel-…

…params

Flexible costmodel params

cabal.project

@@ -20,7 +20,7 @@ index-state:
   -- Bump this if you need newer packages from Hackage
   , hackage.haskell.org 2024-03-19T11:25:56Z
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2024-04-20T00:00:00Z
+  , cardano-haskell-packages 2024-04-30T19:46:33Z
 
 packages:
   eras/allegra/impl

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

@@ -90,7 +90,7 @@ library
         mtl,
         microlens,
         nothunks,
-        plutus-ledger-api ^>=1.26.0,
+        plutus-ledger-api ^>=1.27.0,
         set-algebra >=1.0,
         small-steps >=1.1,
         text,

eras/alonzo/impl/cddl-files/alonzo.cddl

@@ -319,7 +319,7 @@ costmdls = { * language => cost_model } ; New
 ; The values in the serialization are assumed to be ordered
 ; lexicographically by their correpsonding key value.
 ; See Plutus' `ParamName` for parameter ordering
-cost_model = [ 166*166 int ] ; New
+cost_model = [ 166*166 int64 ] ; New
 
 transaction_metadatum =
     { * transaction_metadatum => transaction_metadatum }

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)
@@ -216,10 +217,11 @@ instance
       <*> arbitrary
       <*> arbitrary
 
+genEraLanguage :: forall era. AlonzoEraScript era => Gen Language
+genEraLanguage = choose (minBound, eraMaxLanguage @era)
+
 instance (AlonzoEraScript era, Script era ~ AlonzoScript era) => Arbitrary (AlonzoScript era) where
-  arbitrary = do
-    lang <- elements [minBound .. eraMaxLanguage @era]
-    genAlonzoScript lang
+  arbitrary = genEraLanguage @era >>= genAlonzoScript
 
 genAlonzoScript ::
   ( AlonzoEraScript era
@@ -268,7 +270,7 @@ instance Arbitrary (AlonzoPParams Identity era) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> genValidCostModels [PlutusV1, PlutusV2]
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
@@ -298,7 +300,7 @@ instance Arbitrary (AlonzoPParams StrictMaybe era) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> oneof [pure SNothing, SJust <$> genValidCostModels [PlutusV1, PlutusV2]]
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
@@ -448,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
-    invalidCostModelProp @era
+    underspecifiedCostModelProp @era
     unknownCostModelProp @era
   prop "applyPPUpdates" $ \valid validUpdate unknown unknownUpdate -> do
+    original <- mkCostModelsLenient (flattenCostModels valid <> unknown)
+    originalUpdate <- mkCostModelsLenient (flattenCostModels validUpdate <> unknownUpdate)
     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)
-      pp =
-        emptyPParams & ppCostModelsL .~ original
-      ppUpdate =
-        emptyPParamsUpdate & ppuCostModelsL .~ SJust update
+      pp = emptyPParams & ppCostModelsL .~ original
+      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 $
@@ -62,38 +59,35 @@ validCostModelProp = do
   where
     genValidCostModelEnc lang = genCostModelEncForLanguage lang (costModelParamsCount lang)
     validCm cms =
-      not (null (costModelsValid cms)) && null (costModelsErrors cms) && null (costModelsUnknown cms)
+      not (null (costModelsValid cms)) && null (costModelsUnknown cms)
 
-invalidCostModelProp ::
+-- | Underspecified is a CostModel that has less than the normal number of parameters
+underspecifiedCostModelProp ::
   forall era.
   AlonzoEraPParams era =>
   Spec
-invalidCostModelProp = do
-  prop "invalid CostModels fail within PParamsUpdate" $
+underspecifiedCostModelProp = do
+  prop "CostModels with less than expected parameters within PParamsUpdate" $
     \(lang :: Language) -> do
-      forAllShow (genInvalidCostModelEnc lang) (showEnc @era) $
-        \invalidCmEnc -> do
-          encodeAndCheckDecoded @era invalidCmEnc $
+      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` invalidCm
-
-              -- in no era are we deserializing invalid costmodels within PParamsUpdate
-              expectDeserialiseFailure ppuDecoded Nothing
+                  cmRes `shouldSatisfy` not . null . costModelsValid
   where
-    genInvalidCostModelEnc lang = do
+    genUnderspecifiedCostModelEnc lang = do
       let validCount = costModelParamsCount lang
       count <- choose (0, validCount - 1)
       genCostModelEncForLanguage lang count
 
-    invalidCm cms =
-      null (costModelsValid cms) && not (null (costModelsErrors cms))
-
 unknownCostModelProp ::
   forall era.
   AlonzoEraPParams era =>
@@ -122,7 +116,7 @@ unknownCostModelProp = do
       NonNegative count <- arbitrary
       genCostModelsEnc lang count
     unknownCm cms =
-      null (costModelsValid cms) && null (costModelsErrors cms) && not (null (costModelsUnknown cms))
+      null (costModelsValid cms) && not (null (costModelsUnknown cms))
 
 encodeAndCheckDecoded ::
   forall era.

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/alonzo/test-suite/cardano-ledger-alonzo-test.cabal

@@ -59,7 +59,7 @@ library
         containers,
         data-default-class,
         microlens,
-        plutus-ledger-api ^>=1.26.0,
+        plutus-ledger-api ^>=1.27.0,
         QuickCheck,
         random,
         serialise,

eras/alonzo/test-suite/golden/mainnet-alonzo-genesis.json

@@ -38,7 +38,7 @@
             "multiplyInteger-cpu-arguments-intercept": 61516,
             "cekConstCost-exBudgetMemory": 100,
             "nullList-cpu-arguments": 150000,
-            "equalsString-cpu-arguments-model-arguments-intercept": 150000,
+            "equalsString-cpu-arguments-intercept": 150000,
             "trace-cpu-arguments": 150000,
             "mkNilData-memory-arguments": 32,
             "lengthOfByteString-cpu-arguments": 150000,
@@ -124,7 +124,7 @@
             "remainderInteger-cpu-arguments-constant": 148000,
             "tailList-cpu-arguments": 150000,
             "encodeUtf8-cpu-arguments-intercept": 150000,
-            "equalsString-cpu-arguments-model-arguments-slope": 1000,
+            "equalsString-cpu-arguments-slope": 1000,
             "lessThanByteString-memory-arguments": 1,
             "multiplyInteger-cpu-arguments-slope": 11218,
             "appendByteString-cpu-arguments-intercept": 396231,
@@ -145,7 +145,7 @@
             "sha3_256-memory-arguments": 4,
             "ifThenElse-memory-arguments": 1,
             "mkNilPairData-memory-arguments": 32,
-            "equalsByteString-cpu-arguments-model-arguments-slope": 247,
+            "equalsByteString-cpu-arguments-slope": 247,
             "appendString-cpu-arguments-intercept": 150000,
             "quotientInteger-cpu-arguments-model-arguments-slope": 118,
             "cekApplyCost-exBudgetMemory": 100,
@@ -182,7 +182,7 @@
             "equalsByteString-cpu-arguments-constant": 150000,
             "sliceByteString-memory-arguments-intercept": 0,
             "mkPairData-memory-arguments": 32,
-            "equalsByteString-cpu-arguments-model-arguments-intercept": 112536,
+            "equalsByteString-cpu-arguments-intercept": 112536,
             "appendString-memory-arguments-slope": 1,
             "lessThanInteger-cpu-arguments-slope": 497,
             "modInteger-cpu-arguments-model-arguments-intercept": 425507,

eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs

@@ -45,6 +45,7 @@ import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Base16.Lazy as B16L
 import qualified Data.ByteString.Lazy as BSL
 import Data.Either (fromRight)
+import Data.Int
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromJust)
@@ -406,7 +407,7 @@ expectedCostModelV2 =
     (error ("Error creating CostModel from known PlutusV2 parameters" <> show expectedPParams))
     (mkCostModel PlutusV2 (expectedPParams ++ (replicate 9 0)))
 
-expectedPParams :: [Integer]
+expectedPParams :: [Int64]
 expectedPParams =
   [ 197209
   , 0

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

@@ -83,7 +83,7 @@ library
         deepseq,
         microlens,
         nothunks,
-        plutus-ledger-api ^>=1.26.0,
+        plutus-ledger-api ^>=1.27.0,
         set-algebra,
         small-steps >=1.1,
         text,

eras/babbage/impl/cddl-files/babbage.cddl

@@ -342,8 +342,8 @@ language = 0 ; Plutus v1
          / 1 ; Plutus v2
 
 costmdls =
-  { ? 0 : [ 166*166 int ] ; Plutus v1
-  , ? 1 : [ 175*175 int ] ; Plutus v2
+  { ? 0 : [ 166*166 int64 ] ; Plutus v1
+  , ? 1 : [ 175*175 int64 ] ; Plutus v2
   }
 
 transaction_metadatum =

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