diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md index b9372136c77..b09b29fa353 100644 --- a/eras/alonzo/impl/CHANGELOG.md +++ b/eras/alonzo/impl/CHANGELOG.md @@ -2,6 +2,12 @@ ## 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` * Remove deprecated type `AlonzoTxWits'` and its accessor functions: - `txwitsVKey'` @@ -38,6 +44,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..b12d1807657 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs @@ -3,93 +3,147 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Alonzo.Genesis ( AlonzoGenesis ( AlonzoGenesisWrapper, unAlonzoGenesisWrapper, + extraConfig, AlonzoGenesis, agCoinsPerUTxOWord, - agCostModels, + agPlutusV1CostModel, agPrices, agMaxTxExUnits, 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.Scripts (CostModels, ExUnits (..), Prices (..)) +import Cardano.Ledger.Alonzo.PParams ( + CoinPerWord, + UpgradeAlonzoPParams (..), + ) +import Cardano.Ledger.Alonzo.Scripts ( + CostModel, + CostModels, + ExUnits (..), + Prices (..), + costModelsValid, + decodeCostModel, + decodeCostModelsLenient, + encodeCostModel, + flattenCostModels, + mkCostModels, + ) 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 + +instance ToJSON AlonzoExtraConfig where + toJSON (AlonzoExtraConfig cms) = Aeson.object ["costModels" .= cms] + pattern AlonzoGenesis :: CoinPerWord -> - CostModels -> + CostModel -> Prices -> ExUnits -> ExUnits -> Natural -> Natural -> Natural -> + Maybe AlonzoExtraConfig -> AlonzoGenesis pattern AlonzoGenesis { agCoinsPerUTxOWord - , agCostModels + , agPlutusV1CostModel , agPrices , agMaxTxExUnits , agMaxBlockExUnits , agMaxValSize , agCollateralPercentage , agMaxCollateralInputs + , agExtraConfig } <- - ( unAlonzoGenesisWrapper -> + AlonzoGenesisWrapper + { unAlonzoGenesisWrapper = UpgradeAlonzoPParams { uappCoinsPerUTxOWord = agCoinsPerUTxOWord - , uappCostModels = agCostModels + , uappPlutusV1CostModel = agPlutusV1CostModel , uappPrices = agPrices , uappMaxTxExUnits = agMaxTxExUnits , uappMaxBlockExUnits = agMaxBlockExUnits @@ -97,7 +151,8 @@ pattern AlonzoGenesis , uappCollateralPercentage = agCollateralPercentage , uappMaxCollateralInputs = agMaxCollateralInputs } - ) + , extraConfig = agExtraConfig + } where AlonzoGenesis coinsPerUTxOWord_ @@ -107,18 +162,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_ + , uappPlutusV1CostModel = costModels_ + , uappPrices = prices_ + , uappMaxTxExUnits = maxTxExUnits_ + , uappMaxBlockExUnits = maxBlockExUnits_ + , uappMaxValSize = maxValSize_ + , uappCollateralPercentage = collateralPercentage_ + , uappMaxCollateralInputs = maxCollateralInputs_ + } + ) + extraConfig_ {-# COMPLETE AlonzoGenesis #-} @@ -136,6 +194,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" + cms <- parseCostModels False [PlutusV1] =<< o .: "costModels" agPrices <- o .: "executionPrices" agMaxTxExUnits <- o .: "maxTxExUnits" agMaxBlockExUnits <- o .: "maxBlockExUnits" agMaxValSize <- o .: "maxValueSize" agCollateralPercentage <- o .: "collateralPercentage" agMaxCollateralInputs <- o .: "maxCollateralInputs" + 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 - , "costModels" .= agCostModels ag + , "costModels" .= mkCostModels (Map.singleton PlutusV1 $ agPlutusV1CostModel ag) , "executionPrices" .= agPrices ag , "maxTxExUnits" .= agMaxTxExUnits ag , "maxBlockExUnits" .= agMaxBlockExUnits ag @@ -191,3 +251,4 @@ instance ToKeyValuePairs AlonzoGenesis where , "collateralPercentage" .= agCollateralPercentage ag , "maxCollateralInputs" .= agMaxCollateralInputs ag ] + ++ ["extraConfig" .= extraConfig | Just extraConfig <- [agExtraConfig ag]] diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs index 4feb6181565..341188be19b 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs @@ -8,6 +8,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -96,6 +97,7 @@ import Cardano.Ledger.Plutus.CostModels ( emptyCostModels, getCostModelLanguage, getCostModelParams, + mkCostModels, ) import Cardano.Ledger.Plutus.ExUnits ( ExUnits (..), @@ -106,10 +108,7 @@ import Cardano.Ledger.Plutus.Language (Language (..)) import Cardano.Ledger.Plutus.ToPlutusData (ToPlutusData (..)) import Cardano.Ledger.Shelley.PParams import Control.DeepSeq (NFData) -import Data.Aeson as Aeson ( - FromJSON, - ToJSON (..), - ) +import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Coerce (coerce) @@ -410,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) @@ -422,7 +421,15 @@ data UpgradeAlonzoPParams f = UpgradeAlonzoPParams emptyAlonzoUpgradePParamsUpdate :: UpgradeAlonzoPParams StrictMaybe emptyAlonzoUpgradePParamsUpdate = - UpgradeAlonzoPParams SNothing SNothing SNothing SNothing SNothing SNothing SNothing SNothing + UpgradeAlonzoPParams + SNothing + SNothing + SNothing + SNothing + SNothing + SNothing + SNothing + SNothing deriving instance Eq (UpgradeAlonzoPParams Identity) @@ -436,7 +443,7 @@ instance Default (UpgradeAlonzoPParams StrictMaybe) where def = UpgradeAlonzoPParams { uappCoinsPerUTxOWord = SNothing - , uappCostModels = SNothing + , uappPlutusV1CostModel = SNothing , uappPrices = SNothing , uappMaxTxExUnits = SNothing , uappMaxBlockExUnits = SNothing @@ -605,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/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/src/Cardano/Ledger/Alonzo/Translation.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs index b2dbb2440aa..1db410cc4ac 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs @@ -62,7 +62,7 @@ instance TranslateEra AlonzoEra NewEpochState where } instance TranslateEra AlonzoEra PParams where - translateEra (AlonzoGenesisWrapper upgradeArgs) = pure . upgradePParams upgradeArgs + translateEra (AlonzoGenesisWrapper upgradeArgs _) = pure . upgradePParams upgradeArgs instance TranslateEra AlonzoEra FuturePParams where translateEra ctxt = \case 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 bd839d408ac..6715231df9c 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs @@ -35,7 +35,7 @@ module Test.Cardano.Ledger.Alonzo.Arbitrary ( import Cardano.Ledger.Alonzo (AlonzoEra, Tx (..)) import Cardano.Ledger.Alonzo.BlockBody (AlonzoBlockBody (AlonzoBlockBody)) import Cardano.Ledger.Alonzo.Core -import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) +import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..)) import Cardano.Ledger.Alonzo.PParams ( AlonzoPParams (AlonzoPParams), LangDepView (..), @@ -425,7 +425,8 @@ instance Arbitrary AlonzoGenesis where arbitrary = AlonzoGenesis <$> arbitrary - <*> genValidCostModels [PlutusV1, PlutusV2] + <*> genValidCostModel PlutusV1 + <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary @@ -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..d878bfd368d 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,11 +210,12 @@ 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 , agMaxValSize = 1234 , agCollateralPercentage = 20 , agMaxCollateralInputs = 30 + , 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 4106112910e..3c185c95771 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 @@ -432,6 +432,7 @@ instance ShelleyEraImp AlonzoEra where , agMaxValSize = 5000 , agCollateralPercentage = 150 , agMaxCollateralInputs = 3 + , agExtraConfig = Nothing } impSatisfyNativeScript = impAllegraSatisfyNativeScript 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 fb66e9408f6..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 @@ -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) @@ -367,31 +364,21 @@ 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 = Nothing } -expectedCostModels :: CostModels -expectedCostModels = - mkCostModels - (Map.fromList [(PlutusV1, expectedCostModel), (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}) 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