From dedf82e80a7ebc0204814db9506c922b93df6728 Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Tue, 28 Oct 2025 20:01:16 +0100 Subject: [PATCH 1/4] Add `AlonzoExtraConfig` to `AlonzoGenesis` --- eras/alonzo/impl/CHANGELOG.md | 3 + .../impl/src/Cardano/Ledger/Alonzo/Genesis.hs | 76 ++++++++++++++----- .../impl/src/Cardano/Ledger/Alonzo/PParams.hs | 16 ++-- .../src/Cardano/Ledger/Alonzo/Translation.hs | 2 +- .../Test/Cardano/Ledger/Alonzo/Arbitrary.hs | 5 +- .../Test/Cardano/Ledger/Alonzo/Examples.hs | 3 +- .../Test/Cardano/Ledger/Alonzo/ImpTest.hs | 3 +- .../test/Test/Cardano/Ledger/Alonzo/Golden.hs | 3 +- 8 files changed, 81 insertions(+), 30 deletions(-) diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md index b9372136c77..a3d9b105b9f 100644 --- a/eras/alonzo/impl/CHANGELOG.md +++ b/eras/alonzo/impl/CHANGELOG.md @@ -2,6 +2,8 @@ ## 1.15.0.0 +* Updated `AlonzoGenesis` with `extraConfig` field +* Added `AlonzoExtraConfig` and its instances * Remove deprecated functions `nullRedeemers`, `lookupRedeemers`, `nullDats` * Remove deprecated type `AlonzoTxWits'` and its accessor functions: - `txwitsVKey'` @@ -38,6 +40,7 @@ ### `testlib` +* Added `Arbitrary` instance for `AlonzoExtraConfig` * Add CDDL definitions for Plutus V1 types: `big_int`, `big_uint`, `big_nint`, `bounded_bytes` * Rename `plutus_script` -> `plutus_v1_script` in CDDL * Add `plutus_v1_script` to CDDL exports diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs index f23e3471385..5c99a2a6a74 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} @@ -17,6 +18,7 @@ module Cardano.Ledger.Alonzo.Genesis ( AlonzoGenesis ( AlonzoGenesisWrapper, unAlonzoGenesisWrapper, + extraConfig, AlonzoGenesis, agCoinsPerUTxOWord, agCostModels, @@ -25,12 +27,17 @@ module Cardano.Ledger.Alonzo.Genesis ( agMaxBlockExUnits, agMaxValSize, agCollateralPercentage, - agMaxCollateralInputs + agMaxCollateralInputs, + agExtraConfig ), + AlonzoExtraConfig (..), ) where import Cardano.Ledger.Alonzo.Era (AlonzoEra) -import Cardano.Ledger.Alonzo.PParams (CoinPerWord, UpgradeAlonzoPParams (..)) +import Cardano.Ledger.Alonzo.PParams ( + CoinPerWord, + UpgradeAlonzoPParams (..), + ) import Cardano.Ledger.Alonzo.Scripts (CostModels, ExUnits (..), Prices (..)) import Cardano.Ledger.BaseTypes (KeyValuePairs (..), ToKeyValuePairs (..)) import Cardano.Ledger.Binary ( @@ -51,7 +58,7 @@ import Cardano.Ledger.Core import Cardano.Ledger.Genesis (EraGenesis (..)) import Cardano.Ledger.Plutus.CostModels (parseCostModels) import Control.DeepSeq (NFData) -import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=)) +import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson import Data.Functor.Identity (Identity) import GHC.Generics (Generic) @@ -59,13 +66,32 @@ import NoThunks.Class (NoThunks) import Numeric.Natural (Natural) -- | All configuration that is necessary to bootstrap AlonzoEra from ShelleyGenesis -newtype AlonzoGenesis = AlonzoGenesisWrapper +data AlonzoGenesis = AlonzoGenesisWrapper { unAlonzoGenesisWrapper :: UpgradeAlonzoPParams Identity + , extraConfig :: AlonzoExtraConfig } - deriving stock (Eq, Generic) - deriving newtype (Show, NoThunks, NFData) + deriving stock (Eq, Show, Generic) deriving (ToJSON) via KeyValuePairs AlonzoGenesis +instance NoThunks AlonzoGenesis + +instance NFData AlonzoGenesis + +newtype AlonzoExtraConfig = AlonzoExtraConfig + { aecCostModels :: Maybe CostModels + } + deriving (Eq) + deriving newtype (EncCBOR, DecCBOR, NFData, NoThunks, Show) + +instance FromJSON AlonzoExtraConfig where + parseJSON = Aeson.withObject "Extra Config" $ \o -> + o .:? "costModels" >>= \case + Nothing -> pure $ AlonzoExtraConfig Nothing + Just val -> AlonzoExtraConfig . Just <$> parseCostModels True [] val + +instance ToJSON AlonzoExtraConfig where + toJSON (AlonzoExtraConfig cms) = Aeson.object ["costModels" .= cms] + pattern AlonzoGenesis :: CoinPerWord -> CostModels -> @@ -75,6 +101,7 @@ pattern AlonzoGenesis :: Natural -> Natural -> Natural -> + AlonzoExtraConfig -> AlonzoGenesis pattern AlonzoGenesis { agCoinsPerUTxOWord @@ -85,8 +112,10 @@ pattern AlonzoGenesis , agMaxValSize , agCollateralPercentage , agMaxCollateralInputs + , agExtraConfig } <- - ( unAlonzoGenesisWrapper -> + AlonzoGenesisWrapper + { unAlonzoGenesisWrapper = UpgradeAlonzoPParams { uappCoinsPerUTxOWord = agCoinsPerUTxOWord , uappCostModels = agCostModels @@ -97,7 +126,8 @@ pattern AlonzoGenesis , uappCollateralPercentage = agCollateralPercentage , uappMaxCollateralInputs = agMaxCollateralInputs } - ) + , extraConfig = agExtraConfig + } where AlonzoGenesis coinsPerUTxOWord_ @@ -107,18 +137,21 @@ pattern AlonzoGenesis maxBlockExUnits_ maxValSize_ collateralPercentage_ - maxCollateralInputs_ = - AlonzoGenesisWrapper $ - UpgradeAlonzoPParams - { uappCoinsPerUTxOWord = coinsPerUTxOWord_ - , uappCostModels = costModels_ - , uappPrices = prices_ - , uappMaxTxExUnits = maxTxExUnits_ - , uappMaxBlockExUnits = maxBlockExUnits_ - , uappMaxValSize = maxValSize_ - , uappCollateralPercentage = collateralPercentage_ - , uappMaxCollateralInputs = maxCollateralInputs_ - } + maxCollateralInputs_ + extraConfig_ = + AlonzoGenesisWrapper + ( UpgradeAlonzoPParams + { uappCoinsPerUTxOWord = coinsPerUTxOWord_ + , uappCostModels = costModels_ + , uappPrices = prices_ + , uappMaxTxExUnits = maxTxExUnits_ + , uappMaxBlockExUnits = maxBlockExUnits_ + , uappMaxValSize = maxValSize_ + , uappCollateralPercentage = collateralPercentage_ + , uappMaxCollateralInputs = maxCollateralInputs_ + } + ) + extraConfig_ {-# COMPLETE AlonzoGenesis #-} @@ -143,6 +176,7 @@ instance FromCBOR AlonzoGenesis where arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary alwaysSucceeds :: forall l era. @@ -480,3 +481,5 @@ instance instance Arbitrary LangDepView where arbitrary = LangDepView <$> arbitrary <*> arbitrary + +deriving instance Arbitrary AlonzoExtraConfig diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs index a1402629940..595d6cad2f0 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs @@ -15,7 +15,7 @@ module Test.Cardano.Ledger.Alonzo.Examples ( import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) +import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..)) import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo) import Cardano.Ledger.Alonzo.Scripts ( AlonzoPlutusPurpose (..), @@ -218,4 +218,5 @@ exampleAlonzoGenesis = , agMaxValSize = 1234 , agCollateralPercentage = 20 , agMaxCollateralInputs = 30 + , agExtraConfig = AlonzoExtraConfig Nothing } diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs index 4106112910e..f7f0f2ee02c 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs @@ -47,7 +47,7 @@ module Test.Cardano.Ledger.Alonzo.ImpTest ( import Cardano.Ledger.Address (Addr (..)) import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) +import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..)) import Cardano.Ledger.Alonzo.Plutus.Context (ContextError) import Cardano.Ledger.Alonzo.Plutus.Evaluate ( collectPlutusScriptsWithContext, @@ -432,6 +432,7 @@ instance ShelleyEraImp AlonzoEra where , agMaxValSize = 5000 , agCollateralPercentage = 150 , agMaxCollateralInputs = 3 + , agExtraConfig = AlonzoExtraConfig Nothing } impSatisfyNativeScript = impAllegraSatisfyNativeScript diff --git a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs index fb66e9408f6..374e0ecc679 100644 --- a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs +++ b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs @@ -9,7 +9,7 @@ module Test.Cardano.Ledger.Alonzo.Golden ( import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) +import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..)) import Cardano.Ledger.Alonzo.PParams ( LangDepView (..), getLanguageView, @@ -373,6 +373,7 @@ expectedGenesis = , agMaxValSize = 5000 , agCollateralPercentage = 150 , agMaxCollateralInputs = 3 + , agExtraConfig = AlonzoExtraConfig Nothing } expectedCostModels :: CostModels From 3f25fca23ca0963f5faeb271325effa93dfb876b Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Wed, 29 Oct 2025 23:44:35 +0100 Subject: [PATCH 2/4] Restrict languages in Alonzo cost model parsing Only allow `PlutusV1` when parsing cost models in `AlonzoGenesis` and `UpgradeAlonzoPParams`. --- eras/alonzo/impl/CHANGELOG.md | 4 + .../impl/src/Cardano/Ledger/Alonzo/Genesis.hs | 101 ++-- .../impl/src/Cardano/Ledger/Alonzo/PParams.hs | 7 +- .../Test/Cardano/Ledger/Alonzo/Arbitrary.hs | 2 +- .../Test/Cardano/Ledger/Alonzo/Examples.hs | 3 +- .../Test/Cardano/Ledger/Alonzo/ImpTest.hs | 4 +- .../golden/mainnet-alonzo-genesis.json | 562 ++++++++++++------ .../Cardano/Ledger/Alonzo/AlonzoEraGen.hs | 6 +- .../test/Test/Cardano/Ledger/Alonzo/Golden.hs | 6 +- 9 files changed, 445 insertions(+), 250 deletions(-) diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md index a3d9b105b9f..b09b29fa353 100644 --- a/eras/alonzo/impl/CHANGELOG.md +++ b/eras/alonzo/impl/CHANGELOG.md @@ -2,6 +2,10 @@ ## 1.15.0.0 +* Renamed `uappCostModels` to `uappPlutusV1CostModel` + and changed its type from `CostModels` to `CostModel` +* Renamed `agCostModels` to `agPlutusV1CostModel` + and changed its type from `CostModels` to `CostModel` * Updated `AlonzoGenesis` with `extraConfig` field * Added `AlonzoExtraConfig` and its instances * Remove deprecated functions `nullRedeemers`, `lookupRedeemers`, `nullDats` diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs index 5c99a2a6a74..58cf8938bc0 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs @@ -21,7 +21,7 @@ module Cardano.Ledger.Alonzo.Genesis ( extraConfig, AlonzoGenesis, agCoinsPerUTxOWord, - agCostModels, + agPlutusV1CostModel, agPrices, agMaxTxExUnits, agMaxBlockExUnits, @@ -38,25 +38,29 @@ import Cardano.Ledger.Alonzo.PParams ( CoinPerWord, UpgradeAlonzoPParams (..), ) -import Cardano.Ledger.Alonzo.Scripts (CostModels, ExUnits (..), Prices (..)) +import Cardano.Ledger.Alonzo.Scripts ( + CostModel, + CostModels, + ExUnits (..), + Prices (..), + decodeCostModel, + decodeCostModelsLenient, + encodeCostModel, + ) import Cardano.Ledger.BaseTypes (KeyValuePairs (..), ToKeyValuePairs (..)) import Cardano.Ledger.Binary ( - DecCBOR, - EncCBOR, + DecCBOR (..), + EncCBOR (..), FromCBOR (..), ToCBOR (..), + decodeNullMaybe, + encodeNullMaybe, ) -import Cardano.Ledger.Binary.Coders ( - Decode (From, RecD), - Encode (Rec, To), - decode, - encode, - (!>), - ( E (encodeNullMaybe encCBOR) aecCostModels instance FromJSON AlonzoExtraConfig where parseJSON = Aeson.withObject "Extra Config" $ \o -> o .:? "costModels" >>= \case Nothing -> pure $ AlonzoExtraConfig Nothing - Just val -> AlonzoExtraConfig . Just <$> parseCostModels True [] val + Just val -> AlonzoExtraConfig . Just <$> parseCostModels True val instance ToJSON AlonzoExtraConfig where toJSON (AlonzoExtraConfig cms) = Aeson.object ["costModels" .= cms] pattern AlonzoGenesis :: CoinPerWord -> - CostModels -> + CostModel -> Prices -> ExUnits -> ExUnits -> @@ -105,7 +127,7 @@ pattern AlonzoGenesis :: AlonzoGenesis pattern AlonzoGenesis { agCoinsPerUTxOWord - , agCostModels + , agPlutusV1CostModel , agPrices , agMaxTxExUnits , agMaxBlockExUnits @@ -118,7 +140,7 @@ pattern AlonzoGenesis { unAlonzoGenesisWrapper = UpgradeAlonzoPParams { uappCoinsPerUTxOWord = agCoinsPerUTxOWord - , uappCostModels = agCostModels + , uappPlutusV1CostModel = agPlutusV1CostModel , uappPrices = agPrices , uappMaxTxExUnits = agMaxTxExUnits , uappMaxBlockExUnits = agMaxBlockExUnits @@ -142,7 +164,7 @@ pattern AlonzoGenesis AlonzoGenesisWrapper ( UpgradeAlonzoPParams { uappCoinsPerUTxOWord = coinsPerUTxOWord_ - , uappCostModels = costModels_ + , uappPlutusV1CostModel = costModels_ , uappPrices = prices_ , uappMaxTxExUnits = maxTxExUnits_ , uappMaxBlockExUnits = maxBlockExUnits_ @@ -169,7 +191,7 @@ instance FromCBOR AlonzoGenesis where decode $ RecD AlonzoGenesis To agCoinsPerUTxOWord - !> To agCostModels - !> To agPrices - !> To agMaxTxExUnits - !> To agMaxBlockExUnits - !> To agMaxValSize - !> To agCollateralPercentage - !> To agMaxCollateralInputs + toCBOR x@(AlonzoGenesis _ _ _ _ _ _ _ _ _) = + let AlonzoGenesis {..} = x + in toEraCBOR @AlonzoEra . encode $ + Rec AlonzoGenesis + !> To agCoinsPerUTxOWord + !> E encodeCostModel agPlutusV1CostModel + !> To agPrices + !> To agMaxTxExUnits + !> To agMaxBlockExUnits + !> To agMaxValSize + !> To agCollateralPercentage + !> To agMaxCollateralInputs + !> To agExtraConfig instance FromJSON AlonzoGenesis where parseJSON = Aeson.withObject "Alonzo Genesis" $ \o -> do agCoinsPerUTxOWord <- o .: "lovelacePerUTxOWord" - agCostModels <- parseCostModels False =<< o .: "costModels" + agPlutusV1CostModel <- parseCostModelAsArray False PlutusV1 =<< o .: "plutusV1CostModel" agPrices <- o .: "executionPrices" agMaxTxExUnits <- o .: "maxTxExUnits" agMaxBlockExUnits <- o .: "maxBlockExUnits" @@ -218,7 +231,7 @@ instance FromJSON AlonzoGenesis where instance ToKeyValuePairs AlonzoGenesis where toKeyValuePairs ag = [ "lovelacePerUTxOWord" .= agCoinsPerUTxOWord ag - , "costModels" .= agCostModels ag + , "plutusV1CostModel" .= agPlutusV1CostModel ag , "executionPrices" .= agPrices ag , "maxTxExUnits" .= agMaxTxExUnits ag , "maxBlockExUnits" .= agMaxBlockExUnits ag diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs index 71ab03179f3..341188be19b 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs @@ -97,6 +97,7 @@ import Cardano.Ledger.Plutus.CostModels ( emptyCostModels, getCostModelLanguage, getCostModelParams, + mkCostModels, ) import Cardano.Ledger.Plutus.ExUnits ( ExUnits (..), @@ -408,7 +409,7 @@ instance Ord OrdExUnits where -- | Parameters that were added in Alonzo data UpgradeAlonzoPParams f = UpgradeAlonzoPParams { uappCoinsPerUTxOWord :: !(HKD f CoinPerWord) - , uappCostModels :: !(HKD f CostModels) + , uappPlutusV1CostModel :: !(HKD f CostModel) , uappPrices :: !(HKD f Prices) , uappMaxTxExUnits :: !(HKD f ExUnits) , uappMaxBlockExUnits :: !(HKD f ExUnits) @@ -442,7 +443,7 @@ instance Default (UpgradeAlonzoPParams StrictMaybe) where def = UpgradeAlonzoPParams { uappCoinsPerUTxOWord = SNothing - , uappCostModels = SNothing + , uappPlutusV1CostModel = SNothing , uappPrices = SNothing , uappMaxTxExUnits = SNothing , uappMaxBlockExUnits = SNothing @@ -611,7 +612,7 @@ upgradeAlonzoPParams UpgradeAlonzoPParams {..} ShelleyPParams {..} = , appMinPoolCost = sppMinPoolCost , -- new in alonzo appCoinsPerUTxOWord = uappCoinsPerUTxOWord - , appCostModels = uappCostModels + , appCostModels = hkdMap (Proxy @f) (mkCostModels . Map.singleton PlutusV1) uappPlutusV1CostModel , appPrices = uappPrices , appMaxTxExUnits = hkdMap (Proxy @f) OrdExUnits uappMaxTxExUnits , appMaxBlockExUnits = hkdMap (Proxy @f) OrdExUnits uappMaxBlockExUnits diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs index 0bef0a51ccc..6715231df9c 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs @@ -425,7 +425,7 @@ instance Arbitrary AlonzoGenesis where arbitrary = AlonzoGenesis <$> arbitrary - <*> genValidCostModels [PlutusV1, PlutusV2] + <*> genValidCostModel PlutusV1 <*> arbitrary <*> arbitrary <*> arbitrary diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs index 595d6cad2f0..25667e3d84b 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs @@ -30,7 +30,6 @@ import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Keys (asWitness) import Cardano.Ledger.Mary.Value (MaryValue (..)) -import Cardano.Ledger.Plutus.CostModels (mkCostModels) import Cardano.Ledger.Plutus.Data (Data (..), hashData) import Cardano.Ledger.Plutus.Language (Language (..)) import Cardano.Ledger.Shelley.API ( @@ -211,7 +210,7 @@ exampleAlonzoGenesis :: AlonzoGenesis exampleAlonzoGenesis = AlonzoGenesis { agCoinsPerUTxOWord = CoinPerWord $ Coin 1 - , agCostModels = mkCostModels (Map.fromList [(PlutusV1, zeroTestingCostModelV1)]) + , agPlutusV1CostModel = zeroTestingCostModelV1 , agPrices = Prices (unsafeBoundRational 90) (unsafeBoundRational 91) , agMaxTxExUnits = ExUnits 123 123 , agMaxBlockExUnits = ExUnits 223 223 diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs index f7f0f2ee02c..f3432f07d0e 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs @@ -112,7 +112,7 @@ import Test.Cardano.Ledger.Mary.ImpTest import Test.Cardano.Ledger.Plutus ( PlutusArgs (..), ScriptTestContext (..), - testingCostModels, + testingCostModel, ) import Test.Cardano.Ledger.Plutus.Examples import Test.Cardano.Ledger.Plutus.Guardrail (guardrailScript) @@ -413,7 +413,7 @@ instance ShelleyEraImp AlonzoEra where pure AlonzoGenesis { agCoinsPerUTxOWord = CoinPerWord (Coin 34_482) - , agCostModels = testingCostModels [PlutusV1] + , agPlutusV1CostModel = testingCostModel PlutusV1 , agPrices = Prices { prMem = 577 %! 10_000 diff --git a/eras/alonzo/test-suite/golden/mainnet-alonzo-genesis.json b/eras/alonzo/test-suite/golden/mainnet-alonzo-genesis.json index 95fe5d7b451..ccb3ed00780 100644 --- a/eras/alonzo/test-suite/golden/mainnet-alonzo-genesis.json +++ b/eras/alonzo/test-suite/golden/mainnet-alonzo-genesis.json @@ -1,195 +1,373 @@ { - "lovelacePerUTxOWord": 34482, - "executionPrices": { - "prSteps": - { - "numerator" : 721, - "denominator" : 10000000 - }, - "prMem": - { - "numerator" : 577, - "denominator" : 10000 - } + "lovelacePerUTxOWord": 34482, + "executionPrices": { + "prSteps": { + "numerator": 721, + "denominator": 10000000 }, - "maxTxExUnits": { - "exUnitsMem": 10000000, - "exUnitsSteps": 10000000000 - }, - "maxBlockExUnits": { - "exUnitsMem": 50000000, - "exUnitsSteps": 40000000000 - }, - "maxValueSize": 5000, - "collateralPercentage": 150, - "maxCollateralInputs": 3, + "prMem": { + "numerator": 577, + "denominator": 10000 + } + }, + "maxTxExUnits": { + "exUnitsMem": 10000000, + "exUnitsSteps": 10000000000 + }, + "maxBlockExUnits": { + "exUnitsMem": 50000000, + "exUnitsSteps": 40000000000 + }, + "maxValueSize": 5000, + "collateralPercentage": 150, + "maxCollateralInputs": 3, + "plutusV1CostModel": [ + 197209, + 0, + 1, + 1, + 396231, + 621, + 0, + 1, + 150000, + 1000, + 0, + 1, + 150000, + 32, + 2477736, + 29175, + 4, + 29773, + 100, + 29773, + 100, + 29773, + 100, + 29773, + 100, + 29773, + 100, + 29773, + 100, + 100, + 100, + 29773, + 100, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 1000, + 0, + 1, + 150000, + 32, + 150000, + 1000, + 0, + 8, + 148000, + 425507, + 118, + 0, + 1, + 1, + 150000, + 1000, + 0, + 8, + 150000, + 112536, + 247, + 1, + 150000, + 10000, + 1, + 136542, + 1326, + 1, + 1000, + 150000, + 1000, + 1, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 1, + 1, + 150000, + 1, + 150000, + 4, + 103599, + 248, + 1, + 103599, + 248, + 1, + 145276, + 1366, + 1, + 179690, + 497, + 1, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 148000, + 425507, + 118, + 0, + 1, + 1, + 61516, + 11218, + 0, + 1, + 150000, + 32, + 148000, + 425507, + 118, + 0, + 1, + 1, + 148000, + 425507, + 118, + 0, + 1, + 1, + 2477736, + 29175, + 4, + 0, + 82363, + 4, + 150000, + 5000, + 0, + 1, + 150000, + 32, + 197209, + 0, + 1, + 1, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 3345831, + 1, + 1 + ], + "extraConfig": { "costModels": { - "PlutusV1": { - "sha2_256-memory-arguments": 4, - "equalsString-cpu-arguments-constant": 1000, - "cekDelayCost-exBudgetMemory": 100, - "lessThanEqualsByteString-cpu-arguments-intercept": 103599, - "divideInteger-memory-arguments-minimum": 1, - "appendByteString-cpu-arguments-slope": 621, - "blake2b-cpu-arguments-slope": 29175, - "iData-cpu-arguments": 150000, - "encodeUtf8-cpu-arguments-slope": 1000, - "unBData-cpu-arguments": 150000, - "multiplyInteger-cpu-arguments-intercept": 61516, - "cekConstCost-exBudgetMemory": 100, - "nullList-cpu-arguments": 150000, - "equalsString-cpu-arguments-intercept": 150000, - "trace-cpu-arguments": 150000, - "mkNilData-memory-arguments": 32, - "lengthOfByteString-cpu-arguments": 150000, - "cekBuiltinCost-exBudgetCPU": 29773, - "bData-cpu-arguments": 150000, - "subtractInteger-cpu-arguments-slope": 0, - "unIData-cpu-arguments": 150000, - "consByteString-memory-arguments-intercept": 0, - "divideInteger-memory-arguments-slope": 1, - "divideInteger-cpu-arguments-model-arguments-slope": 118, - "listData-cpu-arguments": 150000, - "headList-cpu-arguments": 150000, - "chooseData-memory-arguments": 32, - "equalsInteger-cpu-arguments-intercept": 136542, - "sha3_256-cpu-arguments-slope": 82363, - "sliceByteString-cpu-arguments-slope": 5000, - "unMapData-cpu-arguments": 150000, - "lessThanInteger-cpu-arguments-intercept": 179690, - "mkCons-cpu-arguments": 150000, - "appendString-memory-arguments-intercept": 0, - "modInteger-cpu-arguments-model-arguments-slope": 118, - "ifThenElse-cpu-arguments": 1, - "mkNilPairData-cpu-arguments": 150000, - "lessThanEqualsInteger-cpu-arguments-intercept": 145276, - "addInteger-memory-arguments-slope": 1, - "chooseList-memory-arguments": 32, - "constrData-memory-arguments": 32, - "decodeUtf8-cpu-arguments-intercept": 150000, - "equalsData-memory-arguments": 1, - "subtractInteger-memory-arguments-slope": 1, - "appendByteString-memory-arguments-intercept": 0, - "lengthOfByteString-memory-arguments": 4, - "headList-memory-arguments": 32, - "listData-memory-arguments": 32, - "consByteString-cpu-arguments-intercept": 150000, - "unIData-memory-arguments": 32, - "remainderInteger-memory-arguments-minimum": 1, - "bData-memory-arguments": 32, - "lessThanByteString-cpu-arguments-slope": 248, - "encodeUtf8-memory-arguments-intercept": 0, - "cekStartupCost-exBudgetCPU": 100, - "multiplyInteger-memory-arguments-intercept": 0, - "unListData-memory-arguments": 32, - "remainderInteger-cpu-arguments-model-arguments-slope": 118, - "cekVarCost-exBudgetCPU": 29773, - "remainderInteger-memory-arguments-slope": 1, - "cekForceCost-exBudgetCPU": 29773, - "sha2_256-cpu-arguments-slope": 29175, - "equalsInteger-memory-arguments": 1, - "indexByteString-memory-arguments": 1, - "addInteger-memory-arguments-intercept": 1, - "chooseUnit-cpu-arguments": 150000, - "sndPair-cpu-arguments": 150000, - "cekLamCost-exBudgetCPU": 29773, - "fstPair-cpu-arguments": 150000, - "quotientInteger-memory-arguments-minimum": 1, - "decodeUtf8-cpu-arguments-slope": 1000, - "lessThanInteger-memory-arguments": 1, - "lessThanEqualsInteger-cpu-arguments-slope": 1366, - "fstPair-memory-arguments": 32, - "modInteger-memory-arguments-intercept": 0, - "unConstrData-cpu-arguments": 150000, - "lessThanEqualsInteger-memory-arguments": 1, - "chooseUnit-memory-arguments": 32, - "sndPair-memory-arguments": 32, - "addInteger-cpu-arguments-intercept": 197209, - "decodeUtf8-memory-arguments-slope": 8, - "equalsData-cpu-arguments-intercept": 150000, - "mapData-cpu-arguments": 150000, - "mkPairData-cpu-arguments": 150000, - "quotientInteger-cpu-arguments-constant": 148000, - "consByteString-memory-arguments-slope": 1, - "cekVarCost-exBudgetMemory": 100, - "indexByteString-cpu-arguments": 150000, - "unListData-cpu-arguments": 150000, - "equalsInteger-cpu-arguments-slope": 1326, - "cekStartupCost-exBudgetMemory": 100, - "subtractInteger-cpu-arguments-intercept": 197209, - "divideInteger-cpu-arguments-model-arguments-intercept": 425507, - "divideInteger-memory-arguments-intercept": 0, - "cekForceCost-exBudgetMemory": 100, - "blake2b-cpu-arguments-intercept": 2477736, - "remainderInteger-cpu-arguments-constant": 148000, - "tailList-cpu-arguments": 150000, - "encodeUtf8-cpu-arguments-intercept": 150000, - "equalsString-cpu-arguments-slope": 1000, - "lessThanByteString-memory-arguments": 1, - "multiplyInteger-cpu-arguments-slope": 11218, - "appendByteString-cpu-arguments-intercept": 396231, - "lessThanEqualsByteString-cpu-arguments-slope": 248, - "modInteger-memory-arguments-slope": 1, - "addInteger-cpu-arguments-slope": 0, - "equalsData-cpu-arguments-slope": 10000, - "decodeUtf8-memory-arguments-intercept": 0, - "chooseList-cpu-arguments": 150000, - "constrData-cpu-arguments": 150000, - "equalsByteString-memory-arguments": 1, - "cekApplyCost-exBudgetCPU": 29773, - "quotientInteger-memory-arguments-slope": 1, - "verifySignature-cpu-arguments-intercept": 3345831, - "unMapData-memory-arguments": 32, - "mkCons-memory-arguments": 32, - "sliceByteString-memory-arguments-slope": 1, - "sha3_256-memory-arguments": 4, - "ifThenElse-memory-arguments": 1, - "mkNilPairData-memory-arguments": 32, - "equalsByteString-cpu-arguments-slope": 247, - "appendString-cpu-arguments-intercept": 150000, - "quotientInteger-cpu-arguments-model-arguments-slope": 118, - "cekApplyCost-exBudgetMemory": 100, - "equalsString-memory-arguments": 1, - "multiplyInteger-memory-arguments-slope": 1, - "cekBuiltinCost-exBudgetMemory": 100, - "remainderInteger-memory-arguments-intercept": 0, - "sha2_256-cpu-arguments-intercept": 2477736, - "remainderInteger-cpu-arguments-model-arguments-intercept": 425507, - "lessThanEqualsByteString-memory-arguments": 1, - "tailList-memory-arguments": 32, - "mkNilData-cpu-arguments": 150000, - "chooseData-cpu-arguments": 150000, - "unBData-memory-arguments": 32, - "blake2b-memory-arguments": 4, - "iData-memory-arguments": 32, - "nullList-memory-arguments": 32, - "cekDelayCost-exBudgetCPU": 29773, - "subtractInteger-memory-arguments-intercept": 1, - "lessThanByteString-cpu-arguments-intercept": 103599, - "consByteString-cpu-arguments-slope": 1000, - "appendByteString-memory-arguments-slope": 1, - "trace-memory-arguments": 32, - "divideInteger-cpu-arguments-constant": 148000, - "cekConstCost-exBudgetCPU": 29773, - "encodeUtf8-memory-arguments-slope": 8, - "quotientInteger-cpu-arguments-model-arguments-intercept": 425507, - "mapData-memory-arguments": 32, - "appendString-cpu-arguments-slope": 1000, - "modInteger-cpu-arguments-constant": 148000, - "verifySignature-cpu-arguments-slope": 1, - "unConstrData-memory-arguments": 32, - "quotientInteger-memory-arguments-intercept": 0, - "equalsByteString-cpu-arguments-constant": 150000, - "sliceByteString-memory-arguments-intercept": 0, - "mkPairData-memory-arguments": 32, - "equalsByteString-cpu-arguments-intercept": 112536, - "appendString-memory-arguments-slope": 1, - "lessThanInteger-cpu-arguments-slope": 497, - "modInteger-cpu-arguments-model-arguments-intercept": 425507, - "modInteger-memory-arguments-minimum": 1, - "sha3_256-cpu-arguments-intercept": 0, - "verifySignature-memory-arguments": 1, - "cekLamCost-exBudgetMemory": 100, - "sliceByteString-cpu-arguments-intercept": 150000 - }, - "PlutusV2": [197209, 0, 1, 1, 396231, 621, 0, 1, 150000, 1000, 0, 1, 150000, 32, 2477736, 29175, 4, 29773, 100, 29773, 100, 29773, 100, 29773, 100, 29773, 100, 29773, 100, 100, 100, 29773, 100, 150000, 32, 150000, 32, 150000, 32, 150000, 1000, 0, 1, 150000, 32, 150000, 1000, 0, 8, 148000, 425507, 118, 0, 1, 1, 150000, 1000, 0, 8, 150000, 112536, 247, 1, 150000, 10000, 1, 136542, 1326, 1, 1000, 150000, 1000, 1, 150000, 32, 150000, 32, 150000, 32, 1, 1, 150000, 1, 150000, 4, 103599, 248, 1, 103599, 248, 1, 145276, 1366, 1, 179690, 497, 1, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 148000, 425507, 118, 0, 1, 1, 61516, 11218, 0, 1, 150000, 32, 148000, 425507, 118, 0, 1, 1, 148000, 425507, 118, 0, 1, 1, 2477736, 29175, 4, 0, 82363, 4, 150000, 5000, 0, 1, 150000, 32, 197209, 0, 1, 1, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 3345831, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0 ] } } + "PlutusV2": [ + 197209, + 0, + 1, + 1, + 396231, + 621, + 0, + 1, + 150000, + 1000, + 0, + 1, + 150000, + 32, + 2477736, + 29175, + 4, + 29773, + 100, + 29773, + 100, + 29773, + 100, + 29773, + 100, + 29773, + 100, + 29773, + 100, + 100, + 100, + 29773, + 100, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 1000, + 0, + 1, + 150000, + 32, + 150000, + 1000, + 0, + 8, + 148000, + 425507, + 118, + 0, + 1, + 1, + 150000, + 1000, + 0, + 8, + 150000, + 112536, + 247, + 1, + 150000, + 10000, + 1, + 136542, + 1326, + 1, + 1000, + 150000, + 1000, + 1, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 1, + 1, + 150000, + 1, + 150000, + 4, + 103599, + 248, + 1, + 103599, + 248, + 1, + 145276, + 1366, + 1, + 179690, + 497, + 1, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 148000, + 425507, + 118, + 0, + 1, + 1, + 61516, + 11218, + 0, + 1, + 150000, + 32, + 148000, + 425507, + 118, + 0, + 1, + 1, + 148000, + 425507, + 118, + 0, + 1, + 1, + 2477736, + 29175, + 4, + 0, + 82363, + 4, + 150000, + 5000, + 0, + 1, + 150000, + 32, + 197209, + 0, + 1, + 1, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 150000, + 32, + 3345831, + 1, + 1, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0, + 0 + ] + } + } +} diff --git a/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs b/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs index 77df5043064..6d0b09f0b0f 100644 --- a/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs +++ b/eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs @@ -104,7 +104,7 @@ import Test.Cardano.Ledger.Alonzo.ImpTest (computeScriptIntegrity) import Test.Cardano.Ledger.Binary.Random import Test.Cardano.Ledger.Common (tracedDiscard) import Test.Cardano.Ledger.MaryEraGen (addTokens, genMint, maryGenesisValue, policyIndex) -import Test.Cardano.Ledger.Plutus (alwaysFailsPlutus, alwaysSucceedsPlutus, zeroTestingCostModels) +import Test.Cardano.Ledger.Plutus (alwaysFailsPlutus, alwaysSucceedsPlutus, zeroTestingCostModel) import Test.Cardano.Ledger.Plutus.Examples import Test.Cardano.Ledger.Shelley.Constants (Constants (..)) import Test.Cardano.Ledger.Shelley.Generator.Core ( @@ -359,7 +359,7 @@ genAlonzoPParamsUpdate constants pp = do let alonzoUpgrade = UpgradeAlonzoPParams { uappCoinsPerUTxOWord = coinPerWord - , uappCostModels = SJust $ zeroTestingCostModels [PlutusV1] + , uappPlutusV1CostModel = SJust $ zeroTestingCostModel PlutusV1 , uappPrices = prices , uappMaxTxExUnits = maxTxExUnits , uappMaxBlockExUnits = maxBlockExUnits @@ -387,7 +387,7 @@ genAlonzoPParams constants = do let alonzoUpgrade = UpgradeAlonzoPParams { uappCoinsPerUTxOWord = coinPerWord - , uappCostModels = zeroTestingCostModels [PlutusV1] + , uappPlutusV1CostModel = zeroTestingCostModel PlutusV1 , uappPrices = prices , uappMaxTxExUnits = maxTxExUnits , uappMaxBlockExUnits = maxBlockExUnits diff --git a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs index 374e0ecc679..3b51aa8ce41 100644 --- a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs +++ b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs @@ -367,19 +367,19 @@ expectedGenesis = AlonzoGenesis { agCoinsPerUTxOWord = CoinPerWord $ Coin 34482 , agPrices = Prices (fromJust $ boundRational 0.0577) (fromJust $ boundRational 0.0000721) - , agCostModels = expectedCostModels + , agPlutusV1CostModel = expectedCostModel , agMaxTxExUnits = ExUnits 10000000 10000000000 , agMaxBlockExUnits = ExUnits 50000000 40000000000 , agMaxValSize = 5000 , agCollateralPercentage = 150 , agMaxCollateralInputs = 3 - , agExtraConfig = AlonzoExtraConfig Nothing + , agExtraConfig = AlonzoExtraConfig $ Just expectedCostModels } expectedCostModels :: CostModels expectedCostModels = mkCostModels - (Map.fromList [(PlutusV1, expectedCostModel), (PlutusV2, expectedCostModelV2)]) + (Map.fromList [(PlutusV2, expectedCostModelV2)]) expectedCostModel :: CostModel expectedCostModel = From 1d8cea643f8d456366069e3335140ce208e106dd Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Sun, 16 Nov 2025 23:50:50 +0100 Subject: [PATCH 3/4] Add code review suggestions * Override cost models when injecting into test state (if extra config cost models are provided) * Preserve `AlonzoGenesis` JSON and binary representations but change the Haskell side representation --- .../impl/src/Cardano/Ledger/Alonzo/Genesis.hs | 32 +- .../src/Cardano/Ledger/Alonzo/Transition.hs | 27 +- .../Test/Cardano/Ledger/Alonzo/Examples.hs | 4 +- .../Test/Cardano/Ledger/Alonzo/ImpTest.hs | 4 +- .../golden/mainnet-alonzo-genesis.json | 562 ++++++------------ .../test/Test/Cardano/Ledger/Alonzo/Golden.hs | 18 +- .../src/Cardano/Ledger/Babbage/Transition.hs | 4 +- .../src/Cardano/Ledger/Conway/Transition.hs | 9 +- 8 files changed, 254 insertions(+), 406 deletions(-) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs index 58cf8938bc0..bb7a12fc097 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs @@ -4,14 +4,12 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Alonzo.Genesis ( @@ -43,9 +41,12 @@ import Cardano.Ledger.Alonzo.Scripts ( CostModels, ExUnits (..), Prices (..), + costModelsValid, decodeCostModel, decodeCostModelsLenient, encodeCostModel, + flattenCostModels, + mkCostModels, ) import Cardano.Ledger.BaseTypes (KeyValuePairs (..), ToKeyValuePairs (..)) import Cardano.Ledger.Binary ( @@ -59,12 +60,14 @@ import Cardano.Ledger.Binary ( import Cardano.Ledger.Binary.Coders import Cardano.Ledger.Core import Cardano.Ledger.Genesis (EraGenesis (..)) -import Cardano.Ledger.Plutus.CostModels (parseCostModelAsArray, parseCostModels) -import Cardano.Ledger.Plutus.Language (Language (..)) +import Cardano.Ledger.Plutus (Language (PlutusV1)) +import Cardano.Ledger.Plutus.CostModels (parseCostModels) import Control.DeepSeq (NFData) import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson import Data.Functor.Identity (Identity) +import qualified Data.List as List +import qualified Data.Map.Strict as Map import GHC.Generics (Generic) import NoThunks.Class (NoThunks) import Numeric.Natural (Natural) @@ -72,7 +75,7 @@ import Numeric.Natural (Natural) -- | All configuration that is necessary to bootstrap AlonzoEra from ShelleyGenesis data AlonzoGenesis = AlonzoGenesisWrapper { unAlonzoGenesisWrapper :: UpgradeAlonzoPParams Identity - , extraConfig :: AlonzoExtraConfig + , extraConfig :: Maybe AlonzoExtraConfig } deriving stock (Eq, Show, Generic) deriving (ToJSON) via KeyValuePairs AlonzoGenesis @@ -123,7 +126,7 @@ pattern AlonzoGenesis :: Natural -> Natural -> Natural -> - AlonzoExtraConfig -> + Maybe AlonzoExtraConfig -> AlonzoGenesis pattern AlonzoGenesis { agCoinsPerUTxOWord @@ -218,25 +221,34 @@ instance ToCBOR AlonzoGenesis where instance FromJSON AlonzoGenesis where parseJSON = Aeson.withObject "Alonzo Genesis" $ \o -> do agCoinsPerUTxOWord <- o .: "lovelacePerUTxOWord" - agPlutusV1CostModel <- parseCostModelAsArray False PlutusV1 =<< o .: "plutusV1CostModel" + cms <- parseCostModels False =<< o .: "costModels" agPrices <- o .: "executionPrices" agMaxTxExUnits <- o .: "maxTxExUnits" agMaxBlockExUnits <- o .: "maxBlockExUnits" agMaxValSize <- o .: "maxValueSize" agCollateralPercentage <- o .: "collateralPercentage" agMaxCollateralInputs <- o .: "maxCollateralInputs" - agExtraConfig <- o .: "extraConfig" + agExtraConfig <- o .:? "extraConfig" + agPlutusV1CostModel <- + case Map.toList (costModelsValid cms) of + [] -> fail "Expected \"PlutusV1\" cost model to be supplied" + [(PlutusV1, pv1CostModel)] -> pure pv1CostModel + _ -> + fail $ + "Only PlutusV1 CostModel is allowed in the AlonzoGenesis, but " + <> List.intercalate ", " (map show . Map.keys $ flattenCostModels cms) + <> " were supplied. Use \"extraConfig\" if you need to inject other cost models for testing." return AlonzoGenesis {..} instance ToKeyValuePairs AlonzoGenesis where toKeyValuePairs ag = [ "lovelacePerUTxOWord" .= agCoinsPerUTxOWord ag - , "plutusV1CostModel" .= agPlutusV1CostModel ag + , "costModels" .= mkCostModels (Map.singleton PlutusV1 $ agPlutusV1CostModel ag) , "executionPrices" .= agPrices ag , "maxTxExUnits" .= agMaxTxExUnits ag , "maxBlockExUnits" .= agMaxBlockExUnits ag , "maxValueSize" .= agMaxValSize ag , "collateralPercentage" .= agCollateralPercentage ag , "maxCollateralInputs" .= agMaxCollateralInputs ag - , "extraConfig" .= agExtraConfig ag ] + ++ ["extraConfig" .= extraConfig | Just extraConfig <- [agExtraConfig ag]] diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Transition.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Transition.hs index 9a290ea82a6..252c3a49dbb 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Transition.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Transition.hs @@ -1,18 +1,23 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Alonzo.Transition ( TransitionConfig (..), + alonzoInjectCostModels, ) where +import Cardano.Ledger.Alonzo.Core (AlonzoEraPParams, ppCostModelsL) import Cardano.Ledger.Alonzo.Era -import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis) +import Cardano.Ledger.Alonzo.Genesis import Cardano.Ledger.Alonzo.Translation () import Cardano.Ledger.Mary import Cardano.Ledger.Mary.Transition (TransitionConfig (MaryTransitionConfig)) +import Cardano.Ledger.Plutus.CostModels (CostModels, updateCostModels) +import Cardano.Ledger.Shelley.LedgerState import Cardano.Ledger.Shelley.Transition import GHC.Generics import Lens.Micro @@ -27,7 +32,8 @@ instance EraTransition AlonzoEra where mkTransitionConfig = AlonzoTransitionConfig - injectIntoTestState = shelleyRegisterInitialFundsThenStaking + injectIntoTestState cfg = + shelleyRegisterInitialFundsThenStaking cfg . alonzoInjectCostModels cfg tcPreviousEraConfigL = lens atcMaryTransitionConfig (\atc pc -> atc {atcMaryTransitionConfig = pc}) @@ -36,3 +42,20 @@ instance EraTransition AlonzoEra where lens atcAlonzoGenesis (\atc ag -> atc {atcAlonzoGenesis = ag}) instance NoThunks (TransitionConfig AlonzoEra) + +alonzoInjectCostModels :: + (EraTransition era, AlonzoEraPParams era) => + TransitionConfig AlonzoEra -> NewEpochState era -> NewEpochState era +alonzoInjectCostModels cfg = + case agExtraConfig $ cfg ^. tcTranslationContextL of + Nothing -> id + Just aec -> overrideCostModels (aecCostModels aec) + +overrideCostModels :: + (EraTransition era, AlonzoEraPParams era) => + Maybe CostModels -> + NewEpochState era -> + NewEpochState era +overrideCostModels = \case + Nothing -> id + Just cms -> nesEsL . curPParamsEpochStateL . ppCostModelsL %~ updateCostModels cms diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs index 25667e3d84b..d878bfd368d 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs @@ -15,7 +15,7 @@ module Test.Cardano.Ledger.Alonzo.Examples ( import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..)) +import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo) import Cardano.Ledger.Alonzo.Scripts ( AlonzoPlutusPurpose (..), @@ -217,5 +217,5 @@ exampleAlonzoGenesis = , agMaxValSize = 1234 , agCollateralPercentage = 20 , agMaxCollateralInputs = 30 - , agExtraConfig = AlonzoExtraConfig Nothing + , agExtraConfig = Nothing } diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs index f3432f07d0e..3c185c95771 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs @@ -47,7 +47,7 @@ module Test.Cardano.Ledger.Alonzo.ImpTest ( import Cardano.Ledger.Address (Addr (..)) import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..)) +import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) import Cardano.Ledger.Alonzo.Plutus.Context (ContextError) import Cardano.Ledger.Alonzo.Plutus.Evaluate ( collectPlutusScriptsWithContext, @@ -432,7 +432,7 @@ instance ShelleyEraImp AlonzoEra where , agMaxValSize = 5000 , agCollateralPercentage = 150 , agMaxCollateralInputs = 3 - , agExtraConfig = AlonzoExtraConfig Nothing + , agExtraConfig = Nothing } impSatisfyNativeScript = impAllegraSatisfyNativeScript diff --git a/eras/alonzo/test-suite/golden/mainnet-alonzo-genesis.json b/eras/alonzo/test-suite/golden/mainnet-alonzo-genesis.json index ccb3ed00780..95fe5d7b451 100644 --- a/eras/alonzo/test-suite/golden/mainnet-alonzo-genesis.json +++ b/eras/alonzo/test-suite/golden/mainnet-alonzo-genesis.json @@ -1,373 +1,195 @@ { - "lovelacePerUTxOWord": 34482, - "executionPrices": { - "prSteps": { - "numerator": 721, - "denominator": 10000000 + "lovelacePerUTxOWord": 34482, + "executionPrices": { + "prSteps": + { + "numerator" : 721, + "denominator" : 10000000 + }, + "prMem": + { + "numerator" : 577, + "denominator" : 10000 + } }, - "prMem": { - "numerator": 577, - "denominator": 10000 - } - }, - "maxTxExUnits": { - "exUnitsMem": 10000000, - "exUnitsSteps": 10000000000 - }, - "maxBlockExUnits": { - "exUnitsMem": 50000000, - "exUnitsSteps": 40000000000 - }, - "maxValueSize": 5000, - "collateralPercentage": 150, - "maxCollateralInputs": 3, - "plutusV1CostModel": [ - 197209, - 0, - 1, - 1, - 396231, - 621, - 0, - 1, - 150000, - 1000, - 0, - 1, - 150000, - 32, - 2477736, - 29175, - 4, - 29773, - 100, - 29773, - 100, - 29773, - 100, - 29773, - 100, - 29773, - 100, - 29773, - 100, - 100, - 100, - 29773, - 100, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 1000, - 0, - 1, - 150000, - 32, - 150000, - 1000, - 0, - 8, - 148000, - 425507, - 118, - 0, - 1, - 1, - 150000, - 1000, - 0, - 8, - 150000, - 112536, - 247, - 1, - 150000, - 10000, - 1, - 136542, - 1326, - 1, - 1000, - 150000, - 1000, - 1, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 1, - 1, - 150000, - 1, - 150000, - 4, - 103599, - 248, - 1, - 103599, - 248, - 1, - 145276, - 1366, - 1, - 179690, - 497, - 1, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 148000, - 425507, - 118, - 0, - 1, - 1, - 61516, - 11218, - 0, - 1, - 150000, - 32, - 148000, - 425507, - 118, - 0, - 1, - 1, - 148000, - 425507, - 118, - 0, - 1, - 1, - 2477736, - 29175, - 4, - 0, - 82363, - 4, - 150000, - 5000, - 0, - 1, - 150000, - 32, - 197209, - 0, - 1, - 1, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 3345831, - 1, - 1 - ], - "extraConfig": { + "maxTxExUnits": { + "exUnitsMem": 10000000, + "exUnitsSteps": 10000000000 + }, + "maxBlockExUnits": { + "exUnitsMem": 50000000, + "exUnitsSteps": 40000000000 + }, + "maxValueSize": 5000, + "collateralPercentage": 150, + "maxCollateralInputs": 3, "costModels": { - "PlutusV2": [ - 197209, - 0, - 1, - 1, - 396231, - 621, - 0, - 1, - 150000, - 1000, - 0, - 1, - 150000, - 32, - 2477736, - 29175, - 4, - 29773, - 100, - 29773, - 100, - 29773, - 100, - 29773, - 100, - 29773, - 100, - 29773, - 100, - 100, - 100, - 29773, - 100, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 1000, - 0, - 1, - 150000, - 32, - 150000, - 1000, - 0, - 8, - 148000, - 425507, - 118, - 0, - 1, - 1, - 150000, - 1000, - 0, - 8, - 150000, - 112536, - 247, - 1, - 150000, - 10000, - 1, - 136542, - 1326, - 1, - 1000, - 150000, - 1000, - 1, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 1, - 1, - 150000, - 1, - 150000, - 4, - 103599, - 248, - 1, - 103599, - 248, - 1, - 145276, - 1366, - 1, - 179690, - 497, - 1, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 148000, - 425507, - 118, - 0, - 1, - 1, - 61516, - 11218, - 0, - 1, - 150000, - 32, - 148000, - 425507, - 118, - 0, - 1, - 1, - 148000, - 425507, - 118, - 0, - 1, - 1, - 2477736, - 29175, - 4, - 0, - 82363, - 4, - 150000, - 5000, - 0, - 1, - 150000, - 32, - 197209, - 0, - 1, - 1, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 150000, - 32, - 3345831, - 1, - 1, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0, - 0 - ] - } - } -} + "PlutusV1": { + "sha2_256-memory-arguments": 4, + "equalsString-cpu-arguments-constant": 1000, + "cekDelayCost-exBudgetMemory": 100, + "lessThanEqualsByteString-cpu-arguments-intercept": 103599, + "divideInteger-memory-arguments-minimum": 1, + "appendByteString-cpu-arguments-slope": 621, + "blake2b-cpu-arguments-slope": 29175, + "iData-cpu-arguments": 150000, + "encodeUtf8-cpu-arguments-slope": 1000, + "unBData-cpu-arguments": 150000, + "multiplyInteger-cpu-arguments-intercept": 61516, + "cekConstCost-exBudgetMemory": 100, + "nullList-cpu-arguments": 150000, + "equalsString-cpu-arguments-intercept": 150000, + "trace-cpu-arguments": 150000, + "mkNilData-memory-arguments": 32, + "lengthOfByteString-cpu-arguments": 150000, + "cekBuiltinCost-exBudgetCPU": 29773, + "bData-cpu-arguments": 150000, + "subtractInteger-cpu-arguments-slope": 0, + "unIData-cpu-arguments": 150000, + "consByteString-memory-arguments-intercept": 0, + "divideInteger-memory-arguments-slope": 1, + "divideInteger-cpu-arguments-model-arguments-slope": 118, + "listData-cpu-arguments": 150000, + "headList-cpu-arguments": 150000, + "chooseData-memory-arguments": 32, + "equalsInteger-cpu-arguments-intercept": 136542, + "sha3_256-cpu-arguments-slope": 82363, + "sliceByteString-cpu-arguments-slope": 5000, + "unMapData-cpu-arguments": 150000, + "lessThanInteger-cpu-arguments-intercept": 179690, + "mkCons-cpu-arguments": 150000, + "appendString-memory-arguments-intercept": 0, + "modInteger-cpu-arguments-model-arguments-slope": 118, + "ifThenElse-cpu-arguments": 1, + "mkNilPairData-cpu-arguments": 150000, + "lessThanEqualsInteger-cpu-arguments-intercept": 145276, + "addInteger-memory-arguments-slope": 1, + "chooseList-memory-arguments": 32, + "constrData-memory-arguments": 32, + "decodeUtf8-cpu-arguments-intercept": 150000, + "equalsData-memory-arguments": 1, + "subtractInteger-memory-arguments-slope": 1, + "appendByteString-memory-arguments-intercept": 0, + "lengthOfByteString-memory-arguments": 4, + "headList-memory-arguments": 32, + "listData-memory-arguments": 32, + "consByteString-cpu-arguments-intercept": 150000, + "unIData-memory-arguments": 32, + "remainderInteger-memory-arguments-minimum": 1, + "bData-memory-arguments": 32, + "lessThanByteString-cpu-arguments-slope": 248, + "encodeUtf8-memory-arguments-intercept": 0, + "cekStartupCost-exBudgetCPU": 100, + "multiplyInteger-memory-arguments-intercept": 0, + "unListData-memory-arguments": 32, + "remainderInteger-cpu-arguments-model-arguments-slope": 118, + "cekVarCost-exBudgetCPU": 29773, + "remainderInteger-memory-arguments-slope": 1, + "cekForceCost-exBudgetCPU": 29773, + "sha2_256-cpu-arguments-slope": 29175, + "equalsInteger-memory-arguments": 1, + "indexByteString-memory-arguments": 1, + "addInteger-memory-arguments-intercept": 1, + "chooseUnit-cpu-arguments": 150000, + "sndPair-cpu-arguments": 150000, + "cekLamCost-exBudgetCPU": 29773, + "fstPair-cpu-arguments": 150000, + "quotientInteger-memory-arguments-minimum": 1, + "decodeUtf8-cpu-arguments-slope": 1000, + "lessThanInteger-memory-arguments": 1, + "lessThanEqualsInteger-cpu-arguments-slope": 1366, + "fstPair-memory-arguments": 32, + "modInteger-memory-arguments-intercept": 0, + "unConstrData-cpu-arguments": 150000, + "lessThanEqualsInteger-memory-arguments": 1, + "chooseUnit-memory-arguments": 32, + "sndPair-memory-arguments": 32, + "addInteger-cpu-arguments-intercept": 197209, + "decodeUtf8-memory-arguments-slope": 8, + "equalsData-cpu-arguments-intercept": 150000, + "mapData-cpu-arguments": 150000, + "mkPairData-cpu-arguments": 150000, + "quotientInteger-cpu-arguments-constant": 148000, + "consByteString-memory-arguments-slope": 1, + "cekVarCost-exBudgetMemory": 100, + "indexByteString-cpu-arguments": 150000, + "unListData-cpu-arguments": 150000, + "equalsInteger-cpu-arguments-slope": 1326, + "cekStartupCost-exBudgetMemory": 100, + "subtractInteger-cpu-arguments-intercept": 197209, + "divideInteger-cpu-arguments-model-arguments-intercept": 425507, + "divideInteger-memory-arguments-intercept": 0, + "cekForceCost-exBudgetMemory": 100, + "blake2b-cpu-arguments-intercept": 2477736, + "remainderInteger-cpu-arguments-constant": 148000, + "tailList-cpu-arguments": 150000, + "encodeUtf8-cpu-arguments-intercept": 150000, + "equalsString-cpu-arguments-slope": 1000, + "lessThanByteString-memory-arguments": 1, + "multiplyInteger-cpu-arguments-slope": 11218, + "appendByteString-cpu-arguments-intercept": 396231, + "lessThanEqualsByteString-cpu-arguments-slope": 248, + "modInteger-memory-arguments-slope": 1, + "addInteger-cpu-arguments-slope": 0, + "equalsData-cpu-arguments-slope": 10000, + "decodeUtf8-memory-arguments-intercept": 0, + "chooseList-cpu-arguments": 150000, + "constrData-cpu-arguments": 150000, + "equalsByteString-memory-arguments": 1, + "cekApplyCost-exBudgetCPU": 29773, + "quotientInteger-memory-arguments-slope": 1, + "verifySignature-cpu-arguments-intercept": 3345831, + "unMapData-memory-arguments": 32, + "mkCons-memory-arguments": 32, + "sliceByteString-memory-arguments-slope": 1, + "sha3_256-memory-arguments": 4, + "ifThenElse-memory-arguments": 1, + "mkNilPairData-memory-arguments": 32, + "equalsByteString-cpu-arguments-slope": 247, + "appendString-cpu-arguments-intercept": 150000, + "quotientInteger-cpu-arguments-model-arguments-slope": 118, + "cekApplyCost-exBudgetMemory": 100, + "equalsString-memory-arguments": 1, + "multiplyInteger-memory-arguments-slope": 1, + "cekBuiltinCost-exBudgetMemory": 100, + "remainderInteger-memory-arguments-intercept": 0, + "sha2_256-cpu-arguments-intercept": 2477736, + "remainderInteger-cpu-arguments-model-arguments-intercept": 425507, + "lessThanEqualsByteString-memory-arguments": 1, + "tailList-memory-arguments": 32, + "mkNilData-cpu-arguments": 150000, + "chooseData-cpu-arguments": 150000, + "unBData-memory-arguments": 32, + "blake2b-memory-arguments": 4, + "iData-memory-arguments": 32, + "nullList-memory-arguments": 32, + "cekDelayCost-exBudgetCPU": 29773, + "subtractInteger-memory-arguments-intercept": 1, + "lessThanByteString-cpu-arguments-intercept": 103599, + "consByteString-cpu-arguments-slope": 1000, + "appendByteString-memory-arguments-slope": 1, + "trace-memory-arguments": 32, + "divideInteger-cpu-arguments-constant": 148000, + "cekConstCost-exBudgetCPU": 29773, + "encodeUtf8-memory-arguments-slope": 8, + "quotientInteger-cpu-arguments-model-arguments-intercept": 425507, + "mapData-memory-arguments": 32, + "appendString-cpu-arguments-slope": 1000, + "modInteger-cpu-arguments-constant": 148000, + "verifySignature-cpu-arguments-slope": 1, + "unConstrData-memory-arguments": 32, + "quotientInteger-memory-arguments-intercept": 0, + "equalsByteString-cpu-arguments-constant": 150000, + "sliceByteString-memory-arguments-intercept": 0, + "mkPairData-memory-arguments": 32, + "equalsByteString-cpu-arguments-intercept": 112536, + "appendString-memory-arguments-slope": 1, + "lessThanInteger-cpu-arguments-slope": 497, + "modInteger-cpu-arguments-model-arguments-intercept": 425507, + "modInteger-memory-arguments-minimum": 1, + "sha3_256-cpu-arguments-intercept": 0, + "verifySignature-memory-arguments": 1, + "cekLamCost-exBudgetMemory": 100, + "sliceByteString-cpu-arguments-intercept": 150000 + }, + "PlutusV2": [197209, 0, 1, 1, 396231, 621, 0, 1, 150000, 1000, 0, 1, 150000, 32, 2477736, 29175, 4, 29773, 100, 29773, 100, 29773, 100, 29773, 100, 29773, 100, 29773, 100, 100, 100, 29773, 100, 150000, 32, 150000, 32, 150000, 32, 150000, 1000, 0, 1, 150000, 32, 150000, 1000, 0, 8, 148000, 425507, 118, 0, 1, 1, 150000, 1000, 0, 8, 150000, 112536, 247, 1, 150000, 10000, 1, 136542, 1326, 1, 1000, 150000, 1000, 1, 150000, 32, 150000, 32, 150000, 32, 1, 1, 150000, 1, 150000, 4, 103599, 248, 1, 103599, 248, 1, 145276, 1366, 1, 179690, 497, 1, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 148000, 425507, 118, 0, 1, 1, 61516, 11218, 0, 1, 150000, 32, 148000, 425507, 118, 0, 1, 1, 148000, 425507, 118, 0, 1, 1, 2477736, 29175, 4, 0, 82363, 4, 150000, 5000, 0, 1, 150000, 32, 197209, 0, 1, 1, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 150000, 32, 3345831, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0 ] } } diff --git a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs index 3b51aa8ce41..235a879d0db 100644 --- a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs +++ b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs @@ -9,7 +9,7 @@ module Test.Cardano.Ledger.Alonzo.Golden ( import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..)) +import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) import Cardano.Ledger.Alonzo.PParams ( LangDepView (..), getLanguageView, @@ -25,9 +25,7 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Mary.Value (valueFromList) import Cardano.Ledger.Plutus.CostModels ( CostModel, - CostModels, mkCostModel, - mkCostModels, ) import Cardano.Ledger.Plutus.Data (Data (..), hashData) import Cardano.Ledger.Plutus.ExUnits ( @@ -45,7 +43,6 @@ 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) import Data.Sequence.Strict import GHC.Stack (HasCallStack) @@ -373,26 +370,15 @@ expectedGenesis = , agMaxValSize = 5000 , agCollateralPercentage = 150 , agMaxCollateralInputs = 3 - , agExtraConfig = AlonzoExtraConfig $ Just expectedCostModels + , agExtraConfig = Nothing } -expectedCostModels :: CostModels -expectedCostModels = - mkCostModels - (Map.fromList [(PlutusV2, expectedCostModelV2)]) - expectedCostModel :: CostModel expectedCostModel = fromRight (error ("Error creating CostModel from known parameters" <> show expectedPParams)) (mkCostModel PlutusV1 expectedPParams) -expectedCostModelV2 :: CostModel -expectedCostModelV2 = - fromRight - (error ("Error creating CostModel from known PlutusV2 parameters" <> show expectedPParams)) - (mkCostModel PlutusV2 (expectedPParams ++ (replicate 9 0))) - expectedPParams :: [Int64] expectedPParams = [ 197209 diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Transition.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Transition.hs index 81d51f3910e..d354e2ea7ef 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Transition.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Transition.hs @@ -3,7 +3,7 @@ {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} -module Cardano.Ledger.Babbage.Transition (TransitionConfig (..)) where +module Cardano.Ledger.Babbage.Transition (TransitionConfig (..), alonzoInjectCostModels) where import Cardano.Ledger.Alonzo import Cardano.Ledger.Alonzo.Transition @@ -23,7 +23,7 @@ instance EraTransition BabbageEra where mkTransitionConfig NoGenesis = BabbageTransitionConfig - injectIntoTestState = shelleyRegisterInitialFundsThenStaking + injectIntoTestState cfg = shelleyRegisterInitialFundsThenStaking cfg . alonzoInjectCostModels (cfg ^. tcPreviousEraConfigL) tcPreviousEraConfigL = lens btcAlonzoTransitionConfig (\btc pc -> btc {btcAlonzoTransitionConfig = pc}) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Transition.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Transition.hs index 87232f42fc8..98e3626619a 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Transition.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Transition.hs @@ -20,7 +20,10 @@ module Cardano.Ledger.Conway.Transition ( ) where import Cardano.Ledger.Babbage -import Cardano.Ledger.Babbage.Transition (TransitionConfig (BabbageTransitionConfig)) +import Cardano.Ledger.Babbage.Transition ( + TransitionConfig (BabbageTransitionConfig), + alonzoInjectCostModels, + ) import Cardano.Ledger.Coin (compactCoinOrError) import Cardano.Ledger.Conway.Era import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) @@ -73,7 +76,9 @@ instance EraTransition ConwayEra where mkTransitionConfig = ConwayTransitionConfig - injectIntoTestState = conwayRegisterInitialFundsThenStaking + injectIntoTestState cfg = + conwayRegisterInitialFundsThenStaking cfg + . alonzoInjectCostModels (cfg ^. tcPreviousEraConfigL . tcPreviousEraConfigL) tcPreviousEraConfigL = lens ctcBabbageTransitionConfig (\ctc pc -> ctc {ctcBabbageTransitionConfig = pc}) From 3e1ff5ff38af60dc64d78d3bc03a01b7ed942fd1 Mon Sep 17 00:00:00 2001 From: Lucsanszky Date: Tue, 25 Nov 2025 00:22:14 +0100 Subject: [PATCH 4/4] Add ability to properly restrict languages when parsing cost models --- .../impl/src/Cardano/Ledger/Alonzo/Genesis.hs | 4 ++-- libs/cardano-ledger-core/CHANGELOG.md | 1 + .../src/Cardano/Ledger/Plutus/CostModels.hs | 13 ++++++++++--- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs index bb7a12fc097..b12d1807657 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs @@ -112,7 +112,7 @@ instance FromJSON AlonzoExtraConfig where parseJSON = Aeson.withObject "Extra Config" $ \o -> o .:? "costModels" >>= \case Nothing -> pure $ AlonzoExtraConfig Nothing - Just val -> AlonzoExtraConfig . Just <$> parseCostModels True val + Just val -> AlonzoExtraConfig . Just <$> parseCostModels True [] val instance ToJSON AlonzoExtraConfig where toJSON (AlonzoExtraConfig cms) = Aeson.object ["costModels" .= cms] @@ -221,7 +221,7 @@ instance ToCBOR AlonzoGenesis where instance FromJSON AlonzoGenesis where parseJSON = Aeson.withObject "Alonzo Genesis" $ \o -> do agCoinsPerUTxOWord <- o .: "lovelacePerUTxOWord" - cms <- parseCostModels False =<< o .: "costModels" + cms <- parseCostModels False [PlutusV1] =<< o .: "costModels" agPrices <- o .: "executionPrices" agMaxTxExUnits <- o .: "maxTxExUnits" agMaxBlockExUnits <- o .: "maxBlockExUnits" diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md index 2d4863059a3..84c4c75ff4b 100644 --- a/libs/cardano-ledger-core/CHANGELOG.md +++ b/libs/cardano-ledger-core/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.19.0.0 +* Changed type of `parseCostModels` by adding `[Language]` argument * Add `HasOKey` instance for `TxId (TxBody l era)` * Add `cddl` sub-library. * Limit `DecCBORGroup` decoding of `ProtVer` fields to `Word32` starting from protocol version `12` diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/CostModels.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/CostModels.hs index 42dc3b37d78..cf2b53bc4f6 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/CostModels.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/CostModels.hs @@ -134,17 +134,24 @@ instance NFData CostModel where rnf (CostModel lang cm ectx) = lang `deepseq` cm `deepseq` rnf ectx instance FromJSON CostModels where - parseJSON = parseCostModels True + parseJSON = parseCostModels True [] parseCostModels :: -- | Do not restrict number of parameters to the initial count and allow parsing of cost models -- for unknown plutus versions. Bool -> + -- | Restrict parsable Plutus language versions to the given list. + -- If left empty, no restrictions are applied and all non-native languages + -- are parsed. + [Language] -> Value -> Parser CostModels -parseCostModels isLenient = +parseCostModels isLenient languages = withObject "CostModels" $ \o -> do - cms <- mapM (parseCostModel isLenient o) nonNativeLanguages + cms <- + if null languages + then mapM (parseCostModel isLenient o) nonNativeLanguages + else mapM (parseCostModel isLenient o) languages let cmsMap = Map.fromList [(cmLanguage cm, cm) | Just cm <- cms] unknownCostModels <- if isLenient