diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 200172c9f8..25f149afe5 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -154,7 +154,6 @@ library iproute, memory, microlens, - microlens-aeson, mono-traversable, mtl, network, @@ -312,18 +311,18 @@ library gen build-depends: FailT, - QuickCheck < 2.16, + QuickCheck <2.16, aeson >=1.5.6.0, base16-bytestring, bytestring, cardano-api, cardano-binary >=1.6 && <1.8, - cardano-ledger-byron, cardano-crypto-class ^>=2.2.1, cardano-crypto-test ^>=1.6, cardano-crypto-wrapper, cardano-ledger-alonzo >=1.8.1, cardano-ledger-babbage, + cardano-ledger-byron, cardano-ledger-conway, cardano-ledger-core >=1.14, cardano-ledger-dijkstra >=0.1, @@ -350,7 +349,7 @@ test-suite cardano-api-test type: exitcode-stdio-1.0 build-depends: FailT, - QuickCheck < 2.16, + QuickCheck <2.16, aeson >=1.5.6.0, base16-bytestring, bytestring, @@ -382,7 +381,6 @@ test-suite cardano-api-test ouroboros-consensus, ouroboros-consensus-cardano, ouroboros-consensus-protocol, - plutus-ledger-api, tasty, tasty-hedgehog, tasty-quickcheck, diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs index 78d914197f..2b0ab11984 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs @@ -36,6 +36,7 @@ import Cardano.Ledger.HKD (HKD, NoUpdate (..)) import Cardano.Ledger.Keys (VRFVerKeyHash (..)) import Cardano.Ledger.Mary.Value qualified as ConcreteValue import Cardano.Ledger.Mary.Value qualified as Ledger +import Cardano.Ledger.Plutus.CostModels qualified as L import Cardano.Ledger.Plutus.CostModels qualified as Ledger import Cardano.Ledger.Plutus.Language qualified as L import Cardano.Ledger.Plutus.Language qualified as Ledger @@ -742,7 +743,7 @@ instance Arbitrary Alonzo.CostModels where genValidCostModel :: Ledger.Language -> Gen Ledger.CostModel genValidCostModel lang = do - newParamValues <- vectorOf (costModelParamsCountLegacy lang) arbitrary + newParamValues <- vectorOf (L.costModelInitParamCount lang) arbitrary either (\err -> error $ "Corrupt cost model: " ++ show err) pure $ Ledger.mkCostModel lang newParamValues @@ -778,12 +779,12 @@ genCostModelValues lang = do Positive sub <- arbitrary (,) lang' <$> oneof - [ listAtLeast (costModelParamsCountLegacy lang) + [ listAtLeast (L.costModelInitParamCount lang) , take (tooFew sub) <$> arbitrary ] where lang' = fromIntegral (fromEnum lang) - tooFew sub = costModelParamsCountLegacy lang - sub + tooFew sub = L.costModelInitParamCount lang - sub listAtLeast :: Int -> Gen [Int64] listAtLeast x = do NonNegative y <- arbitrary diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs index b6831169c9..651b89d568 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs @@ -23,7 +23,6 @@ import Cardano.Api.Address qualified as Api import Cardano.Api.Certificate.Internal qualified as Api import Cardano.Api.Era.Internal.Core (DijkstraEra) import Cardano.Api.Era.Internal.Eon.Convert -import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra qualified as Api import Cardano.Api.Experimental.Era diff --git a/cardano-api/src/Cardano/Api/Genesis.hs b/cardano-api/src/Cardano/Api/Genesis.hs index 32ab7e0c1f..3c32d2337b 100644 --- a/cardano-api/src/Cardano/Api/Genesis.hs +++ b/cardano-api/src/Cardano/Api/Genesis.hs @@ -2,7 +2,6 @@ module Cardano.Api.Genesis ( ShelleyGenesis (..) , shelleyGenesisDefaults , alonzoGenesisDefaults - , decodeAlonzoGenesis , conwayGenesisDefaults -- ** Configuration @@ -29,9 +28,6 @@ module Cardano.Api.Genesis -- * Utilities , unsafeBoundedRational , fromShelleyGenesis - - -- * Testing only - , costModelParamsCountLegacy ) where diff --git a/cardano-api/src/Cardano/Api/Genesis/Internal.hs b/cardano-api/src/Cardano/Api/Genesis/Internal.hs index 3c9eaa251b..b93fca0d21 100644 --- a/cardano-api/src/Cardano/Api/Genesis/Internal.hs +++ b/cardano-api/src/Cardano/Api/Genesis/Internal.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} @@ -13,7 +12,6 @@ module Cardano.Api.Genesis.Internal ( ShelleyGenesis (..) , shelleyGenesisDefaults , alonzoGenesisDefaults - , decodeAlonzoGenesis , conwayGenesisDefaults -- ** Configuration @@ -35,26 +33,10 @@ module Cardano.Api.Genesis.Internal -- * Utilities , unsafeBoundedRational - - -- * Testing only - , costModelParamsCountLegacy ) where -import Cardano.Api.Era.Internal.Core - ( CardanoEra - , forEraMaybeEon - , monoidForEraInEon - ) -import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards import Cardano.Api.IO -import Cardano.Api.Monad.Error - ( ExceptT - , MonadError (throwError) - , MonadTransError - , liftEither - , modifyError - ) import Cardano.Chain.Genesis qualified import Cardano.Crypto.Hash.Blake2b qualified @@ -64,6 +46,7 @@ import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), Prices (..)) import Cardano.Ledger.Api (CoinPerWord (..)) import Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) import Cardano.Ledger.Conway.PParams ( DRepVotingThresholds (..) @@ -85,33 +68,25 @@ import PlutusCore.Evaluation.Machine.CostModelInterface import PlutusCore.Evaluation.Machine.ExBudgetingDefaults import PlutusCore.Evaluation.Machine.MachineParameters import PlutusLedgerApi.Common (IsParamName, readParamName) -import PlutusLedgerApi.V2 qualified as V2 import PlutusLedgerApi.V3 qualified as V3 import Control.Monad import Control.Monad.Trans.Fail.String (errorFail) -import Data.Aeson qualified as A import Data.ByteString (ByteString) -import Data.ByteString.Lazy qualified as LBS import Data.Default.Class qualified as DefaultClass import Data.Functor.Identity import Data.Int (Int64) -import Data.List (sortOn) import Data.ListMap qualified as ListMap -import Data.Map (Map) import Data.Map.Strict qualified as M import Data.Map.Strict qualified as Map import Data.Maybe import Data.Ratio -import Data.Set qualified as S import Data.Text (Text) import Data.Time qualified as Time import Data.Typeable -import Data.Vector qualified as V import GHC.Exts (IsList (..)) import GHC.Stack (HasCallStack) import Lens.Micro -import Lens.Micro.Aeson qualified as AL import Barbies (bmap) import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts @@ -198,7 +173,7 @@ shelleyGenesisDefaults = -- pot = tx_fees + ρ * remaining_reserves & ppRhoL .~ unsafeBR (1 % 10) -- How much of reserves goes into pot & ppTauL .~ unsafeBR (1 % 10) -- τ * remaining_reserves is sent to treasury every epoch - & ppKeyDepositL .~ 400000 -- require a non-zero deposit when registering keys + & ppKeyDepositL .~ L.Coin 400000 -- require a non-zero deposit when registering keys , -- genesis keys and initial funds sgGenDelegs = M.empty , sgStaking = emptyGenesisStaking @@ -280,9 +255,11 @@ conwayGenesisDefaults = costModelParamsForTesting :: HasCallStack => [(V3.ParamName, Int64)] costModelParamsForTesting = - Map.toList $ - fromJust $ - extractCostModelParamsLedgerOrder mCostModel + -- all geneses should contain only the number of cost model params equal to the initial number + take (L.costModelInitParamCount PlutusV3) + . Map.toList + . fromJust + $ extractCostModelParamsLedgerOrder mCostModel mCostModel :: MCostModel mCostModel = @@ -341,119 +318,11 @@ type MBuiltinCostModel = BuiltinCostModelBase MCostingFun (%!) :: forall r. (HasCallStack, Typeable r, BoundedRational r) => Integer -> Integer -> r n %! d = unsafeBoundedRational $ n Data.Ratio.% d --- | Decode Alonzo genesis in an optionally era sensitive way. --- --- Because the Plutus V2 cost model has changed between Babbage and Conway era, we need to know the era if we --- want to decde Alonzo Genesis with a cost model baked in. If the V2 cost model is present in genesis, you --- need to provide an era witness. --- --- When an era witness is provided, for Plutus V2 model the function additionally: --- 1. Does extra cost model parameters name validation: Checks for mandatory 175 parameters if provided in --- a map form. --- 2. If >= Conway: adds defaults for new 10 parameters, if they were not provided (maxBound) --- 3. Removes extra parameters above the max count: Babbage - 175, Conway - 185. -decodeAlonzoGenesis - :: forall era t m - . MonadTransError String t m - => Maybe (CardanoEra era) - -- ^ An optional era witness in which we're reading the genesis - -> LBS.ByteString - -- ^ Genesis JSON - -> t m AlonzoGenesis -decodeAlonzoGenesis Nothing genesisBs = - modifyError ("Cannot decode Alonzo genesis: " <>) $ - liftEither $ - A.eitherDecode genesisBs -decodeAlonzoGenesis (Just era) genesisBs = modifyError ("Cannot decode era-sensitive Alonzo genesis: " <>) $ do - genesisValue :: A.Value <- liftEither $ A.eitherDecode genesisBs - -- Making a fixup of a costmodel is easier before JSON deserialization. This also saves us from building - -- plutus' EvaluationContext one more time after cost model update. - genesisValue' <- - (AL.key "costModels" . AL.key "PlutusV2" . AL._Value) setCostModelDefaultValues genesisValue - fromJsonE genesisValue' - where - setCostModelDefaultValues :: A.Value -> ExceptT String m A.Value - setCostModelDefaultValues = \case - obj@(A.Object _) -> do - -- decode cost model into a map first - costModel :: Map V2.ParamName Int64 <- - modifyError ("Decoding cost model object: " <>) $ fromJsonE obj - - let costModelWithDefaults = - sortOn fst - . toList - $ M.union costModel optionalCostModelDefaultValues - - -- check that we have all required params - unless (allCostModelParams == (fst <$> costModelWithDefaults)) $ do - let allCostModelParamsSet = fromList allCostModelParams - providedCostModelParamsSet = fromList $ fst <$> costModelWithDefaults - missingParameters = toList $ S.difference allCostModelParamsSet providedCostModelParamsSet - throwError $ - unlines - [ "Missing V2 Plutus cost model parameters: " - , show missingParameters - , "Number of missing parameters: " <> show (length missingParameters) - ] - -- We have already have required params, we already added optional ones (which are trimmed later - -- if required). Continue processing further in array representation. - setCostModelDefaultValues . A.toJSON $ map snd costModelWithDefaults - A.Array vec - -- here we rely on an assumption that params are in correct order, so that we can take only the - -- required ones for an era - | V.length vec < costModelExpectedCount -> - pure . A.Array . V.take costModelExpectedCount $ - vec <> (A.toJSON . snd <$> optionalCostModelDefaultValues) - | V.length vec > costModelExpectedCount -> pure . A.Array $ V.take costModelExpectedCount vec - other -> pure other - - -- Plutus V2 params expected count depending on an era - costModelExpectedCount :: Int - costModelExpectedCount - -- use all available parameters >= conway - | isConwayOnwards = length allCostModelParams - -- use only required params in < conway - | otherwise = costModelParamsCountLegacy L.PlutusV2 -- Babbage - - -- A list-like of tuples (param name, value) with default maxBound value - optionalCostModelDefaultValues :: (Item l ~ (V2.ParamName, Int64), IsList l) => l - optionalCostModelDefaultValues = fromList $ map (,maxBound) optionalV2costModelParams - - allCostModelParams :: [V2.ParamName] - allCostModelParams = [minBound .. maxBound] - - -- The new V2 cost model params introduced in Conway - optionalV2costModelParams :: [V2.ParamName] - optionalV2costModelParams = - [ V2.IntegerToByteString'cpu'arguments'c0 - , V2.IntegerToByteString'cpu'arguments'c1 - , V2.IntegerToByteString'cpu'arguments'c2 - , V2.IntegerToByteString'memory'arguments'intercept - , V2.IntegerToByteString'memory'arguments'slope - , V2.ByteStringToInteger'cpu'arguments'c0 - , V2.ByteStringToInteger'cpu'arguments'c1 - , V2.ByteStringToInteger'cpu'arguments'c2 - , V2.ByteStringToInteger'memory'arguments'intercept - , V2.ByteStringToInteger'memory'arguments'slope - ] - - fromJsonE :: A.FromJSON a => A.Value -> ExceptT String m a - fromJsonE v = - case A.fromJSON v of - A.Success a -> pure a - A.Error e -> throwError e - - isConwayOnwards = isJust $ forEraMaybeEon @ConwayEraOnwards era - -- | Some reasonable starting defaults for constructing a 'AlonzoGenesis'. -- Based on https://github.com/IntersectMBO/cardano-node/blob/master/cardano-testnet/src/Testnet/Defaults.hs --- The era determines Plutus V2 cost model parameters: --- * Conway: 185 --- * <= Babbage: 175 alonzoGenesisDefaults - :: CardanoEra era - -> AlonzoGenesis -alonzoGenesisDefaults era = + :: AlonzoGenesis +alonzoGenesisDefaults = AlonzoGenesis { agPrices = Prices @@ -829,23 +698,6 @@ alonzoGenesisDefaults era = , 32947 , 10 ] - <> defaultV2CostModelNewConwayParams - - -- New Conway cost model parameters - defaultV2CostModelNewConwayParams = - monoidForEraInEon @ConwayEraOnwards era $ - const - [ 1292075 - , 24469 - , 74 - , 0 - , 1 - , 936157 - , 49601 - , 237 - , 0 - , 1 - ] -- | Convert Rational to a bounded rational. Throw an exception when the rational is out of bounds. unsafeBoundedRational @@ -856,15 +708,3 @@ unsafeBoundedRational unsafeBoundedRational x = fromMaybe (error errMessage) $ boundRational x where errMessage = show (typeRep (Proxy @r)) <> " is out of bounds: " <> show x - --- Only use this function in the generation of an Alonzo genesis file --- The number of parameters for PlutusV3 reflects that of the Babbage --- era cost model before the intra era hardfork. --- Pre intra-era hardfork the V3 cost model has 231 parameters --- Post intra-era hardfork the V3 cost model has 251 parameters --- TODO: This needs to be parameterized by the protocol version. -costModelParamsCountLegacy :: Language -> Int -costModelParamsCountLegacy PlutusV1 = 166 -costModelParamsCountLegacy PlutusV2 = 175 -costModelParamsCountLegacy PlutusV3 = 231 -costModelParamsCountLegacy PlutusV4 = 251 diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index ffbbeabc1d..18af7644a3 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -109,7 +109,7 @@ import Cardano.Api.Certificate.Internal import Cardano.Api.Consensus.Internal.Mode import Cardano.Api.Consensus.Internal.Mode qualified as Api import Cardano.Api.Era.Internal.Case -import Cardano.Api.Era.Internal.Core (CardanoEra, forEraMaybeEon) +import Cardano.Api.Era.Internal.Core (forEraMaybeEon) import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Error as Api import Cardano.Api.Genesis.Internal @@ -233,6 +233,7 @@ import Data.Aeson as Aeson , (.:) , (.:?) ) +import Data.Aeson qualified as A import Data.Aeson.Types (Parser) import Data.Bifunctor import Data.ByteArray (ByteArrayAccess) @@ -358,7 +359,7 @@ initialLedgerState nodeConfigFile = do -- can remove the nodeConfigFile argument and much of the code in this -- module. config <- modifyError ILSEConfigFile (readNodeConfig nodeConfigFile) - genesisConfig <- modifyError ILSEGenesisFile (readCardanoGenesisConfig Nothing config) + genesisConfig <- modifyError ILSEGenesisFile (readCardanoGenesisConfig config) env <- modifyError ILSELedgerConsensusConfig (except (genesisConfigToEnv genesisConfig)) let ledgerState = initLedgerStateVar genesisConfig return (env, ledgerState) @@ -1497,15 +1498,12 @@ shelleyPraosNonce genesisHash = readCardanoGenesisConfig :: MonadIOTransError GenesisConfigError t m - => Maybe (CardanoEra era) - -- ^ Provide era witness to read Alonzo Genesis in an era-sensitive manner (see - -- 'Cardano.Api.Genesis.Internal.decodeAlonzGenesis' for more details) - -> NodeConfig + => NodeConfig -> t m GenesisConfig -readCardanoGenesisConfig mEra enc = do +readCardanoGenesisConfig enc = do byronGenesis <- readByronGenesisConfig enc ShelleyConfig shelleyGenesis shelleyGenesisHash <- readShelleyGenesisConfig enc - alonzoGenesis <- readAlonzoGenesisConfig mEra enc + alonzoGenesis <- readAlonzoGenesisConfig enc conwayGenesis <- readConwayGenesisConfig enc -- TODO: Build dummy dijkstra genesis value let dijkstraGenesis = exampleDijkstraGenesis -- TODO: Dijkstra - add plumbing to read Dijkstra genesis @@ -1597,15 +1595,12 @@ readShelleyGenesisConfig enc = do readAlonzoGenesisConfig :: MonadIOTransError GenesisConfigError t m - => Maybe (CardanoEra era) - -- ^ Provide era witness to read Alonzo Genesis in an era-sensitive manner (see - -- 'Cardano.Api.Genesis.Internal.decodeAlonzGenesis' for more details) - -> NodeConfig + => NodeConfig -> t m AlonzoGenesis -readAlonzoGenesisConfig mEra enc = do +readAlonzoGenesisConfig enc = do let file = ncAlonzoGenesisFile enc modifyError (NEAlonzoConfig (unFile file) . renderAlonzoGenesisError) $ - readAlonzoGenesis mEra file (ncAlonzoGenesisHash enc) + readAlonzoGenesis file (ncAlonzoGenesisHash enc) -- | If the conway genesis file does not exist we simply put in a default. readConwayGenesisConfig @@ -1678,21 +1673,18 @@ renderShelleyGenesisError sge = ] readAlonzoGenesis - :: forall m t era + :: forall m t . MonadIOTransError AlonzoGenesisError t m - => Maybe (CardanoEra era) - -- ^ Provide era witness to read Alonzo Genesis in an era-sensitive manner (see - -- 'Cardano.Api.Genesis.Internal.decodeAlonzGenesis' for more details) - -> File AlonzoGenesis 'In + => File AlonzoGenesis 'In -> GenesisHashAlonzo -> t m AlonzoGenesis -readAlonzoGenesis mEra (File file) expectedGenesisHash = do +readAlonzoGenesis (File file) expectedGenesisHash = do content <- modifyError id $ handleIOExceptT (AlonzoGenesisReadError file . textShow) $ LBS.readFile file let genesisHash = GenesisHashAlonzo . Cardano.Crypto.Hash.Class.hashWith id $ LBS.toStrict content checkExpectedGenesisHash genesisHash - modifyError (AlonzoGenesisDecodeError file . Text.pack) $ - decodeAlonzoGenesis mEra content + modifyError (AlonzoGenesisDecodeError file . Text.pack) . liftEither $ + A.eitherDecode content where checkExpectedGenesisHash :: GenesisHashAlonzo -> t m () checkExpectedGenesisHash actual = diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs index 546ef88a38..ff3424a5a4 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs @@ -9,19 +9,19 @@ module Test.Cardano.Api.Genesis where import Cardano.Api +import Cardano.Api.Experimental.Era (Some (..)) import Cardano.Api.Ledger qualified as L import Cardano.Binary qualified as CB import Cardano.Ledger.Alonzo.Genesis qualified as L import Cardano.Ledger.Binary qualified as L import Cardano.Ledger.Plutus qualified as L -import PlutusLedgerApi.V2 qualified as V2 import Codec.CBOR.Decoding qualified as CBOR import Codec.CBOR.Encoding qualified as CBOR import Codec.CBOR.Write qualified as CBOR +import Control.Monad import Data.ByteString.Lazy qualified as LBS -import Data.Either import Data.Int (Int64) import Data.Map.Strict qualified as M import Data.Maybe @@ -33,121 +33,90 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testProperty) -- | Test reading and decoding of AlonzoGenesis with cost models - era dependent test -prop_reading_plutus_v2_era_sensitive_costmodel +prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive :: forall era - . IsCardanoEra era - => CardanoEra era + . CardanoEra era -- ^ An era in which we read the cost model -> PlutusV2CostModelFormat -- ^ cost model in genesis variant -> Property -prop_reading_plutus_v2_era_sensitive_costmodel era cmf = H.propertyOnce $ do +prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive era cmf = H.propertyOnce $ do H.noteShow_ $ "Era: " <> pshow era H.noteShow_ $ "Cost model type: " <> show cmf (allCostModels, v2costModelValues) <- - H.leftFailM $ loadPlutusV2CostModelFromGenesis (Just era) (getGenesisFile cmf) + H.leftFailM $ loadPlutusV2CostModelFromGenesis (getGenesisFile cmf) H.noteShow_ v2costModelValues - let isConwayOnwards = isJust $ maybeEon @ConwayEraOnwards @era - last10CostModelValues = reverse . take 10 $ reverse v2costModelValues - -- values from @perturbing - last10CostModelCorrectValues = [1292075, 24469, 74, 0, 1, 936157, 49601, 237, 0, 1] - - if isConwayOnwards - then do - length v2costModelValues === 185 - if getCostModelFileParamCount cmf < 185 - then last10CostModelValues === replicate 10 maxBound - else last10CostModelValues === last10CostModelCorrectValues - else length v2costModelValues === 175 + -- the V2 params count is expected to be 175 + -- vide https://github.com/IntersectMBO/cardano-ledger/pull/5241/files + -- will allways succeed + length v2costModelValues === 175 -- Make sure that our just read genesis is CBOR encoding roundtripping - aeo <- H.nothingFail $ maybeEon @AlonzoEraOnwards @era + -- because after protocol version >= 9 the CBOR decoder is failing on errors + aeo <- H.nothingFail $ forEraMaybeEon @AlonzoEraOnwards era let allCostModelsBs = encodeCborInEraCostModels aeo allCostModels allCostModels' <- H.leftFail $ decodeCborInEraCostModels aeo allCostModelsBs H.note_ "Check that read genesis is CBOR encoding roundtripping" allCostModels' === allCostModels - -- Yeah, let's check the default one if it's roundtripping as well - let defaultCostModels = L.agCostModels $ alonzoGenesisDefaults era - defaultCostModelsBs = encodeCborInEraCostModels aeo defaultCostModels - defaultCostModels' <- H.leftFail $ decodeCborInEraCostModels aeo defaultCostModelsBs - H.note_ "Check that the default genesis is CBOR encoding roundtripping" - defaultCostModels' === defaultCostModels - -- | Test reading and decoding of AlonzoGenesis with cost models - an era independent test -prop_reading_plutus_v2_costmodel +prop_reading_plutus_v2_costmodel_json :: PlutusV2CostModelFormat -> Property -prop_reading_plutus_v2_costmodel cmf = H.propertyOnce $ do +prop_reading_plutus_v2_costmodel_json cmf = H.propertyOnce $ do H.noteShow_ $ "Cost model type: " <> show cmf - mCostModelValues <- fmap snd <$> loadPlutusV2CostModelFromGenesis Nothing (getGenesisFile cmf) + mCostModelValues <- fmap snd <$> loadPlutusV2CostModelFromGenesis (getGenesisFile cmf) H.noteShow_ mCostModelValues - if cmf == Map175 - then do - -- reading a map with 175 params should fail - H.assertWith mCostModelValues isLeft - else do - costModelValues <- H.leftFail mCostModelValues - length costModelValues === getCostModelFileParamCount cmf - -prop_verify_plutus_v2_costmodel :: Property -prop_verify_plutus_v2_costmodel = H.propertyOnce $ do - let lastParamName = maxBound - last10Params = (toEnum . subtract 9 $ fromEnum lastParamName) `enumFromTo` lastParamName :: [V2.ParamName] - H.note_ "Check that last 10 params of PlutusV2 cost models are exactly the ones we expect" - -- The conditional logic of trimming conway parameters in babbage relies on the fact that last 10 V2 params - -- are those below - last10Params - === [ V2.IntegerToByteString'cpu'arguments'c0 - , V2.IntegerToByteString'cpu'arguments'c1 - , V2.IntegerToByteString'cpu'arguments'c2 - , V2.IntegerToByteString'memory'arguments'intercept - , V2.IntegerToByteString'memory'arguments'slope - , V2.ByteStringToInteger'cpu'arguments'c0 - , V2.ByteStringToInteger'cpu'arguments'c1 - , V2.ByteStringToInteger'cpu'arguments'c2 - , V2.ByteStringToInteger'memory'arguments'intercept - , V2.ByteStringToInteger'memory'arguments'slope - ] + costModelValues <- H.leftFail mCostModelValues + length costModelValues === getCostModelFileParamCount cmf + +prop_check_default_alonzo_genesis_roundtrips :: Property +prop_check_default_alonzo_genesis_roundtrips = H.propertyOnce $ do + let eras = + catMaybes + [ Some <$> forEraMaybeEon @AlonzoEraOnwards era + | AnyCardanoEra era <- [(AnyCardanoEra AlonzoEra) .. maxBound] + ] + + forM_ eras $ \(Some aeo) -> do + let defaultCostModels = L.agCostModels alonzoGenesisDefaults + defaultCostModelsBs = encodeCborInEraCostModels aeo defaultCostModels + H.note_ $ "Decode alonzo genesis for era " <> show aeo + defaultCostModels' <- H.leftFail $ decodeCborInEraCostModels aeo defaultCostModelsBs + H.note_ $ "Check that the default genesis is CBOR encoding roundtripping for era " <> show aeo + defaultCostModels' === defaultCostModels -- * Utilities data PlutusV2CostModelFormat = Map175 - | Map185 | Array175 - | Array185 deriving (Eq, Show) getGenesisFile :: PlutusV2CostModelFormat -> FilePath getGenesisFile = ("./test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-" <>) . \case Map175 -> "map-175.json" - Map185 -> "map-185.json" Array175 -> "array-175.json" - Array185 -> "array-185.json" getCostModelFileParamCount :: PlutusV2CostModelFormat -> Int getCostModelFileParamCount = \case Map175 -> 175 - Map185 -> 185 Array175 -> 175 - Array185 -> 185 loadPlutusV2CostModelFromGenesis :: HasCallStack => MonadIO m => MonadTest m - => Maybe (CardanoEra era) - -> FilePath + => FilePath -> m (Either String (L.CostModels, [Int64])) -loadPlutusV2CostModelFromGenesis mEra filePath = withFrozenCallStack . runExceptT $ do - genesisBs <- H.lbsReadFile filePath - costModels <- modifyError show $ L.agCostModels <$> decodeAlonzoGenesis mEra genesisBs +loadPlutusV2CostModelFromGenesis filePath = withFrozenCallStack . runExceptT $ do + genesis <- H.readJsonFileOk filePath + let costModels = L.agCostModels genesis liftEither . fmap ((costModels,) . L.getCostModelParams) . maybe (Left "No PlutusV2 model found") Right @@ -180,31 +149,17 @@ tests :: TestTree tests = testGroup "Test.Cardano.Api.Genesis" - [ testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - Babbage" $ - prop_reading_plutus_v2_era_sensitive_costmodel BabbageEra Map175 + [ testProperty "Default Alonzo Genesis roundtrips CBOR" prop_check_default_alonzo_genesis_roundtrips + , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - Babbage" $ + prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive BabbageEra Map175 , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - Conway" $ - prop_reading_plutus_v2_era_sensitive_costmodel ConwayEra Map175 + prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive ConwayEra Map175 , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - era insensitive" $ - prop_reading_plutus_v2_costmodel Map175 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - Babbage" $ - prop_reading_plutus_v2_era_sensitive_costmodel BabbageEra Map185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - Conway" $ - prop_reading_plutus_v2_era_sensitive_costmodel ConwayEra Map185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - era insensitive" $ - prop_reading_plutus_v2_costmodel Map185 + prop_reading_plutus_v2_costmodel_json Map175 , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - Babbage" $ - prop_reading_plutus_v2_era_sensitive_costmodel BabbageEra Array175 + prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive BabbageEra Array175 , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - Conway" $ - prop_reading_plutus_v2_era_sensitive_costmodel ConwayEra Array175 + prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive ConwayEra Array175 , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - era insensitive" $ - prop_reading_plutus_v2_costmodel Array175 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - Babbage" $ - prop_reading_plutus_v2_era_sensitive_costmodel BabbageEra Array185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - Conway" $ - prop_reading_plutus_v2_era_sensitive_costmodel ConwayEra Array185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - era insensitive" $ - prop_reading_plutus_v2_costmodel Array185 - , testProperty - "Make sure that last 10 PlutusV2 cost model parameters are the ones we expect" - prop_verify_plutus_v2_costmodel + prop_reading_plutus_v2_costmodel_json Array175 ] diff --git a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-array-185.json b/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-array-185.json deleted file mode 100644 index 2b5ae7754a..0000000000 --- a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-array-185.json +++ /dev/null @@ -1,375 +0,0 @@ -{ - "collateralPercentage": 150, - "costModels": { - "PlutusV1": [ - 205665, - 812, - 1, - 1, - 1000, - 571, - 0, - 1, - 1000, - 24177, - 4, - 1, - 1000, - 32, - 117366, - 10475, - 4, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 100, - 100, - 23000, - 100, - 19537, - 32, - 175354, - 32, - 46417, - 4, - 221973, - 511, - 0, - 1, - 89141, - 32, - 497525, - 14068, - 4, - 2, - 196500, - 453240, - 220, - 0, - 1, - 1, - 1000, - 28662, - 4, - 2, - 245000, - 216773, - 62, - 1, - 1060367, - 12586, - 1, - 208512, - 421, - 1, - 187000, - 1000, - 52998, - 1, - 80436, - 32, - 43249, - 32, - 1000, - 32, - 80556, - 1, - 57667, - 4, - 1000, - 10, - 197145, - 156, - 1, - 197145, - 156, - 1, - 204924, - 473, - 1, - 208896, - 511, - 1, - 52467, - 32, - 64832, - 32, - 65493, - 32, - 22558, - 32, - 16563, - 32, - 76511, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 69522, - 11687, - 0, - 1, - 60091, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 196500, - 453240, - 220, - 0, - 1, - 1, - 806990, - 30482, - 4, - 1927926, - 82523, - 4, - 265318, - 0, - 4, - 0, - 85931, - 32, - 205665, - 812, - 1, - 1, - 41182, - 32, - 212342, - 32, - 31220, - 32, - 32696, - 32, - 43357, - 32, - 32247, - 32, - 38314, - 32, - 9462713, - 1021, - 10 - ], - "PlutusV2": [ - 205665, - 812, - 1, - 1, - 1000, - 571, - 0, - 1, - 1000, - 24177, - 4, - 1, - 1000, - 32, - 117366, - 10475, - 4, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 100, - 100, - 23000, - 100, - 19537, - 32, - 175354, - 32, - 46417, - 4, - 221973, - 511, - 0, - 1, - 89141, - 32, - 497525, - 14068, - 4, - 2, - 196500, - 453240, - 220, - 0, - 1, - 1, - 1000, - 28662, - 4, - 2, - 245000, - 216773, - 62, - 1, - 1060367, - 12586, - 1, - 208512, - 421, - 1, - 187000, - 1000, - 52998, - 1, - 80436, - 32, - 43249, - 32, - 1000, - 32, - 80556, - 1, - 57667, - 4, - 1000, - 10, - 197145, - 156, - 1, - 197145, - 156, - 1, - 204924, - 473, - 1, - 208896, - 511, - 1, - 52467, - 32, - 64832, - 32, - 65493, - 32, - 22558, - 32, - 16563, - 32, - 76511, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 69522, - 11687, - 0, - 1, - 60091, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 196500, - 453240, - 220, - 0, - 1, - 1, - 1159724, - 392670, - 0, - 2, - 806990, - 30482, - 4, - 1927926, - 82523, - 4, - 265318, - 0, - 4, - 0, - 85931, - 32, - 205665, - 812, - 1, - 1, - 41182, - 32, - 212342, - 32, - 31220, - 32, - 32696, - 32, - 43357, - 32, - 32247, - 32, - 38314, - 32, - 35892428, - 10, - 9462713, - 1021, - 10, - 38887044, - 32947, - 10, - 1292075, - 24469, - 74, - 0, - 1, - 936157, - 49601, - 237, - 0, - 1 - ] - }, - "executionPrices": { - "prMem": 0.0577, - "prSteps": 7.21e-05 - }, - "lovelacePerUTxOWord": 34482, - "maxBlockExUnits": { - "exUnitsMem": 62000000, - "exUnitsSteps": 40000000000 - }, - "maxCollateralInputs": 3, - "maxTxExUnits": { - "exUnitsMem": 14000000, - "exUnitsSteps": 10000000000 - }, - "maxValueSize": 5000 -} diff --git a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-175.json b/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-175.json index 92b58b19d0..3d0d6ba16d 100644 --- a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-175.json +++ b/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-175.json @@ -166,9 +166,6 @@ "unListData-memory-arguments": 32, "unMapData-cpu-arguments": 38314, "unMapData-memory-arguments": 32, - "verifyEd25519Signature-cpu-arguments-intercept": 9462713, - "verifyEd25519Signature-cpu-arguments-slope": 1021, - "verifyEd25519Signature-memory-arguments": 10, "verifySignature-cpu-arguments-intercept": 3345831, "verifySignature-cpu-arguments-slope": 1, "verifySignature-memory-arguments": 1 diff --git a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-185.json b/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-185.json deleted file mode 100644 index 201172e460..0000000000 --- a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-185.json +++ /dev/null @@ -1,385 +0,0 @@ -{ - "coinsPerUTxOByte": 4310, - "collateralPercentage": 150, - "costModels": { - "PlutusV1": { - "addInteger-cpu-arguments-intercept": 205665, - "addInteger-cpu-arguments-slope": 812, - "addInteger-memory-arguments-intercept": 1, - "addInteger-memory-arguments-slope": 1, - "appendByteString-cpu-arguments-intercept": 1000, - "appendByteString-cpu-arguments-slope": 571, - "appendByteString-memory-arguments-intercept": 0, - "appendByteString-memory-arguments-slope": 1, - "appendString-cpu-arguments-intercept": 1000, - "appendString-cpu-arguments-slope": 24177, - "appendString-memory-arguments-intercept": 4, - "appendString-memory-arguments-slope": 1, - "bData-cpu-arguments": 1000, - "bData-memory-arguments": 32, - "blake2b-cpu-arguments-intercept": 117366, - "blake2b-cpu-arguments-slope": 10475, - "blake2b-memory-arguments": 4, - "cekApplyCost-exBudgetCPU": 23000, - "cekApplyCost-exBudgetMemory": 100, - "cekBuiltinCost-exBudgetCPU": 23000, - "cekBuiltinCost-exBudgetMemory": 100, - "cekConstCost-exBudgetCPU": 23000, - "cekConstCost-exBudgetMemory": 100, - "cekDelayCost-exBudgetCPU": 23000, - "cekDelayCost-exBudgetMemory": 100, - "cekForceCost-exBudgetCPU": 23000, - "cekForceCost-exBudgetMemory": 100, - "cekLamCost-exBudgetCPU": 23000, - "cekLamCost-exBudgetMemory": 100, - "cekStartupCost-exBudgetCPU": 100, - "cekStartupCost-exBudgetMemory": 100, - "cekVarCost-exBudgetCPU": 23000, - "cekVarCost-exBudgetMemory": 100, - "chooseData-cpu-arguments": 19537, - "chooseData-memory-arguments": 32, - "chooseList-cpu-arguments": 175354, - "chooseList-memory-arguments": 32, - "chooseUnit-cpu-arguments": 46417, - "chooseUnit-memory-arguments": 4, - "consByteString-cpu-arguments-intercept": 221973, - "consByteString-cpu-arguments-slope": 511, - "consByteString-memory-arguments-intercept": 0, - "consByteString-memory-arguments-slope": 1, - "constrData-cpu-arguments": 89141, - "constrData-memory-arguments": 32, - "decodeUtf8-cpu-arguments-intercept": 497525, - "decodeUtf8-cpu-arguments-slope": 14068, - "decodeUtf8-memory-arguments-intercept": 4, - "decodeUtf8-memory-arguments-slope": 2, - "divideInteger-cpu-arguments-constant": 196500, - "divideInteger-cpu-arguments-model-arguments-intercept": 453240, - "divideInteger-cpu-arguments-model-arguments-slope": 220, - "divideInteger-memory-arguments-intercept": 0, - "divideInteger-memory-arguments-minimum": 1, - "divideInteger-memory-arguments-slope": 1, - "encodeUtf8-cpu-arguments-intercept": 1000, - "encodeUtf8-cpu-arguments-slope": 28662, - "encodeUtf8-memory-arguments-intercept": 4, - "encodeUtf8-memory-arguments-slope": 2, - "equalsByteString-cpu-arguments-constant": 245000, - "equalsByteString-cpu-arguments-intercept": 216773, - "equalsByteString-cpu-arguments-slope": 62, - "equalsByteString-memory-arguments": 1, - "equalsData-cpu-arguments-intercept": 1060367, - "equalsData-cpu-arguments-slope": 12586, - "equalsData-memory-arguments": 1, - "equalsInteger-cpu-arguments-intercept": 208512, - "equalsInteger-cpu-arguments-slope": 421, - "equalsInteger-memory-arguments": 1, - "equalsString-cpu-arguments-constant": 187000, - "equalsString-cpu-arguments-intercept": 1000, - "equalsString-cpu-arguments-slope": 52998, - "equalsString-memory-arguments": 1, - "fstPair-cpu-arguments": 80436, - "fstPair-memory-arguments": 32, - "headList-cpu-arguments": 43249, - "headList-memory-arguments": 32, - "iData-cpu-arguments": 1000, - "iData-memory-arguments": 32, - "ifThenElse-cpu-arguments": 80556, - "ifThenElse-memory-arguments": 1, - "indexByteString-cpu-arguments": 57667, - "indexByteString-memory-arguments": 4, - "lengthOfByteString-cpu-arguments": 1000, - "lengthOfByteString-memory-arguments": 10, - "lessThanByteString-cpu-arguments-intercept": 197145, - "lessThanByteString-cpu-arguments-slope": 156, - "lessThanByteString-memory-arguments": 1, - "lessThanEqualsByteString-cpu-arguments-intercept": 197145, - "lessThanEqualsByteString-cpu-arguments-slope": 156, - "lessThanEqualsByteString-memory-arguments": 1, - "lessThanEqualsInteger-cpu-arguments-intercept": 204924, - "lessThanEqualsInteger-cpu-arguments-slope": 473, - "lessThanEqualsInteger-memory-arguments": 1, - "lessThanInteger-cpu-arguments-intercept": 208896, - "lessThanInteger-cpu-arguments-slope": 511, - "lessThanInteger-memory-arguments": 1, - "listData-cpu-arguments": 52467, - "listData-memory-arguments": 32, - "mapData-cpu-arguments": 64832, - "mapData-memory-arguments": 32, - "mkCons-cpu-arguments": 65493, - "mkCons-memory-arguments": 32, - "mkNilData-cpu-arguments": 22558, - "mkNilData-memory-arguments": 32, - "mkNilPairData-cpu-arguments": 16563, - "mkNilPairData-memory-arguments": 32, - "mkPairData-cpu-arguments": 76511, - "mkPairData-memory-arguments": 32, - "modInteger-cpu-arguments-constant": 196500, - "modInteger-cpu-arguments-model-arguments-intercept": 453240, - "modInteger-cpu-arguments-model-arguments-slope": 220, - "modInteger-memory-arguments-intercept": 0, - "modInteger-memory-arguments-minimum": 1, - "modInteger-memory-arguments-slope": 1, - "multiplyInteger-cpu-arguments-intercept": 69522, - "multiplyInteger-cpu-arguments-slope": 11687, - "multiplyInteger-memory-arguments-intercept": 0, - "multiplyInteger-memory-arguments-slope": 1, - "nullList-cpu-arguments": 60091, - "nullList-memory-arguments": 32, - "quotientInteger-cpu-arguments-constant": 196500, - "quotientInteger-cpu-arguments-model-arguments-intercept": 453240, - "quotientInteger-cpu-arguments-model-arguments-slope": 220, - "quotientInteger-memory-arguments-intercept": 0, - "quotientInteger-memory-arguments-minimum": 1, - "quotientInteger-memory-arguments-slope": 1, - "remainderInteger-cpu-arguments-constant": 196500, - "remainderInteger-cpu-arguments-model-arguments-intercept": 453240, - "remainderInteger-cpu-arguments-model-arguments-slope": 220, - "remainderInteger-memory-arguments-intercept": 0, - "remainderInteger-memory-arguments-minimum": 1, - "remainderInteger-memory-arguments-slope": 1, - "sha2_256-cpu-arguments-intercept": 806990, - "sha2_256-cpu-arguments-slope": 30482, - "sha2_256-memory-arguments": 4, - "sha3_256-cpu-arguments-intercept": 1927926, - "sha3_256-cpu-arguments-slope": 82523, - "sha3_256-memory-arguments": 4, - "sliceByteString-cpu-arguments-intercept": 265318, - "sliceByteString-cpu-arguments-slope": 0, - "sliceByteString-memory-arguments-intercept": 4, - "sliceByteString-memory-arguments-slope": 0, - "sndPair-cpu-arguments": 85931, - "sndPair-memory-arguments": 32, - "subtractInteger-cpu-arguments-intercept": 205665, - "subtractInteger-cpu-arguments-slope": 812, - "subtractInteger-memory-arguments-intercept": 1, - "subtractInteger-memory-arguments-slope": 1, - "tailList-cpu-arguments": 41182, - "tailList-memory-arguments": 32, - "trace-cpu-arguments": 212342, - "trace-memory-arguments": 32, - "unBData-cpu-arguments": 31220, - "unBData-memory-arguments": 32, - "unConstrData-cpu-arguments": 32696, - "unConstrData-memory-arguments": 32, - "unIData-cpu-arguments": 43357, - "unIData-memory-arguments": 32, - "unListData-cpu-arguments": 32247, - "unListData-memory-arguments": 32, - "unMapData-cpu-arguments": 38314, - "unMapData-memory-arguments": 32, - "verifyEd25519Signature-cpu-arguments-intercept": 9462713, - "verifyEd25519Signature-cpu-arguments-slope": 1021, - "verifyEd25519Signature-memory-arguments": 10, - "verifySignature-cpu-arguments-intercept": 3345831, - "verifySignature-cpu-arguments-slope": 1, - "verifySignature-memory-arguments": 1 - }, - "PlutusV2": { - "addInteger-cpu-arguments-intercept": 205665, - "addInteger-cpu-arguments-slope": 812, - "addInteger-memory-arguments-intercept": 1, - "addInteger-memory-arguments-slope": 1, - "appendByteString-cpu-arguments-intercept": 1000, - "appendByteString-cpu-arguments-slope": 571, - "appendByteString-memory-arguments-intercept": 0, - "appendByteString-memory-arguments-slope": 1, - "appendString-cpu-arguments-intercept": 1000, - "appendString-cpu-arguments-slope": 24177, - "appendString-memory-arguments-intercept": 4, - "appendString-memory-arguments-slope": 1, - "bData-cpu-arguments": 1000, - "bData-memory-arguments": 32, - "blake2b_256-cpu-arguments-intercept": 117366, - "blake2b_256-cpu-arguments-slope": 10475, - "blake2b_256-memory-arguments": 4, - "cekApplyCost-exBudgetCPU": 23000, - "cekApplyCost-exBudgetMemory": 100, - "cekBuiltinCost-exBudgetCPU": 23000, - "cekBuiltinCost-exBudgetMemory": 100, - "cekConstCost-exBudgetCPU": 23000, - "cekConstCost-exBudgetMemory": 100, - "cekDelayCost-exBudgetCPU": 23000, - "cekDelayCost-exBudgetMemory": 100, - "cekForceCost-exBudgetCPU": 23000, - "cekForceCost-exBudgetMemory": 100, - "cekLamCost-exBudgetCPU": 23000, - "cekLamCost-exBudgetMemory": 100, - "cekStartupCost-exBudgetCPU": 100, - "cekStartupCost-exBudgetMemory": 100, - "cekVarCost-exBudgetCPU": 23000, - "cekVarCost-exBudgetMemory": 100, - "chooseData-cpu-arguments": 19537, - "chooseData-memory-arguments": 32, - "chooseList-cpu-arguments": 175354, - "chooseList-memory-arguments": 32, - "chooseUnit-cpu-arguments": 46417, - "chooseUnit-memory-arguments": 4, - "consByteString-cpu-arguments-intercept": 221973, - "consByteString-cpu-arguments-slope": 511, - "consByteString-memory-arguments-intercept": 0, - "consByteString-memory-arguments-slope": 1, - "constrData-cpu-arguments": 89141, - "constrData-memory-arguments": 32, - "decodeUtf8-cpu-arguments-intercept": 497525, - "decodeUtf8-cpu-arguments-slope": 14068, - "decodeUtf8-memory-arguments-intercept": 4, - "decodeUtf8-memory-arguments-slope": 2, - "divideInteger-cpu-arguments-constant": 196500, - "divideInteger-cpu-arguments-model-arguments-intercept": 453240, - "divideInteger-cpu-arguments-model-arguments-slope": 220, - "divideInteger-memory-arguments-intercept": 0, - "divideInteger-memory-arguments-minimum": 1, - "divideInteger-memory-arguments-slope": 1, - "encodeUtf8-cpu-arguments-intercept": 1000, - "encodeUtf8-cpu-arguments-slope": 28662, - "encodeUtf8-memory-arguments-intercept": 4, - "encodeUtf8-memory-arguments-slope": 2, - "equalsByteString-cpu-arguments-constant": 245000, - "equalsByteString-cpu-arguments-intercept": 216773, - "equalsByteString-cpu-arguments-slope": 62, - "equalsByteString-memory-arguments": 1, - "equalsData-cpu-arguments-intercept": 1060367, - "equalsData-cpu-arguments-slope": 12586, - "equalsData-memory-arguments": 1, - "equalsInteger-cpu-arguments-intercept": 208512, - "equalsInteger-cpu-arguments-slope": 421, - "equalsInteger-memory-arguments": 1, - "equalsString-cpu-arguments-constant": 187000, - "equalsString-cpu-arguments-intercept": 1000, - "equalsString-cpu-arguments-slope": 52998, - "equalsString-memory-arguments": 1, - "fstPair-cpu-arguments": 80436, - "fstPair-memory-arguments": 32, - "headList-cpu-arguments": 43249, - "headList-memory-arguments": 32, - "iData-cpu-arguments": 1000, - "iData-memory-arguments": 32, - "ifThenElse-cpu-arguments": 80556, - "ifThenElse-memory-arguments": 1, - "indexByteString-cpu-arguments": 57667, - "indexByteString-memory-arguments": 4, - "lengthOfByteString-cpu-arguments": 1000, - "lengthOfByteString-memory-arguments": 10, - "lessThanByteString-cpu-arguments-intercept": 197145, - "lessThanByteString-cpu-arguments-slope": 156, - "lessThanByteString-memory-arguments": 1, - "lessThanEqualsByteString-cpu-arguments-intercept": 197145, - "lessThanEqualsByteString-cpu-arguments-slope": 156, - "lessThanEqualsByteString-memory-arguments": 1, - "lessThanEqualsInteger-cpu-arguments-intercept": 204924, - "lessThanEqualsInteger-cpu-arguments-slope": 473, - "lessThanEqualsInteger-memory-arguments": 1, - "lessThanInteger-cpu-arguments-intercept": 208896, - "lessThanInteger-cpu-arguments-slope": 511, - "lessThanInteger-memory-arguments": 1, - "listData-cpu-arguments": 52467, - "listData-memory-arguments": 32, - "mapData-cpu-arguments": 64832, - "mapData-memory-arguments": 32, - "mkCons-cpu-arguments": 65493, - "mkCons-memory-arguments": 32, - "mkNilData-cpu-arguments": 22558, - "mkNilData-memory-arguments": 32, - "mkNilPairData-cpu-arguments": 16563, - "mkNilPairData-memory-arguments": 32, - "mkPairData-cpu-arguments": 76511, - "mkPairData-memory-arguments": 32, - "modInteger-cpu-arguments-constant": 196500, - "modInteger-cpu-arguments-model-arguments-intercept": 453240, - "modInteger-cpu-arguments-model-arguments-slope": 220, - "modInteger-memory-arguments-intercept": 0, - "modInteger-memory-arguments-minimum": 1, - "modInteger-memory-arguments-slope": 1, - "multiplyInteger-cpu-arguments-intercept": 69522, - "multiplyInteger-cpu-arguments-slope": 11687, - "multiplyInteger-memory-arguments-intercept": 0, - "multiplyInteger-memory-arguments-slope": 1, - "nullList-cpu-arguments": 60091, - "nullList-memory-arguments": 32, - "quotientInteger-cpu-arguments-constant": 196500, - "quotientInteger-cpu-arguments-model-arguments-intercept": 453240, - "quotientInteger-cpu-arguments-model-arguments-slope": 220, - "quotientInteger-memory-arguments-intercept": 0, - "quotientInteger-memory-arguments-minimum": 1, - "quotientInteger-memory-arguments-slope": 1, - "remainderInteger-cpu-arguments-constant": 196500, - "remainderInteger-cpu-arguments-model-arguments-intercept": 453240, - "remainderInteger-cpu-arguments-model-arguments-slope": 220, - "remainderInteger-memory-arguments-intercept": 0, - "remainderInteger-memory-arguments-minimum": 1, - "remainderInteger-memory-arguments-slope": 1, - "serialiseData-cpu-arguments-intercept": 1159724, - "serialiseData-cpu-arguments-slope": 392670, - "serialiseData-memory-arguments-intercept": 0, - "serialiseData-memory-arguments-slope": 2, - "sha2_256-cpu-arguments-intercept": 806990, - "sha2_256-cpu-arguments-slope": 30482, - "sha2_256-memory-arguments": 4, - "sha3_256-cpu-arguments-intercept": 1927926, - "sha3_256-cpu-arguments-slope": 82523, - "sha3_256-memory-arguments": 4, - "sliceByteString-cpu-arguments-intercept": 265318, - "sliceByteString-cpu-arguments-slope": 0, - "sliceByteString-memory-arguments-intercept": 4, - "sliceByteString-memory-arguments-slope": 0, - "sndPair-cpu-arguments": 85931, - "sndPair-memory-arguments": 32, - "subtractInteger-cpu-arguments-intercept": 205665, - "subtractInteger-cpu-arguments-slope": 812, - "subtractInteger-memory-arguments-intercept": 1, - "subtractInteger-memory-arguments-slope": 1, - "tailList-cpu-arguments": 41182, - "tailList-memory-arguments": 32, - "trace-cpu-arguments": 212342, - "trace-memory-arguments": 32, - "unBData-cpu-arguments": 31220, - "unBData-memory-arguments": 32, - "unConstrData-cpu-arguments": 32696, - "unConstrData-memory-arguments": 32, - "unIData-cpu-arguments": 43357, - "unIData-memory-arguments": 32, - "unListData-cpu-arguments": 32247, - "unListData-memory-arguments": 32, - "unMapData-cpu-arguments": 38314, - "unMapData-memory-arguments": 32, - "verifyEcdsaSecp256k1Signature-cpu-arguments": 35892428, - "verifyEcdsaSecp256k1Signature-memory-arguments": 10, - "verifyEd25519Signature-cpu-arguments-intercept": 57996947, - "verifyEd25519Signature-cpu-arguments-slope": 18975, - "verifyEd25519Signature-memory-arguments": 10, - "verifySchnorrSecp256k1Signature-cpu-arguments-intercept": 38887044, - "verifySchnorrSecp256k1Signature-cpu-arguments-slope": 32947, - "verifySchnorrSecp256k1Signature-memory-arguments": 10, - "integerToByteString-cpu-arguments-c0": 1292075, - "integerToByteString-cpu-arguments-c1": 24469, - "integerToByteString-cpu-arguments-c2": 74, - "integerToByteString-memory-arguments-intercept": 0, - "integerToByteString-memory-arguments-slope": 1, - "byteStringToInteger-cpu-arguments-c0": 936157, - "byteStringToInteger-cpu-arguments-c1": 49601, - "byteStringToInteger-cpu-arguments-c2": 237, - "byteStringToInteger-memory-arguments-intercept": 0, - "byteStringToInteger-memory-arguments-slope": 1 - } - }, - "executionPrices": { - "prMem": { - "denominator": 10000, - "numerator": 577 - }, - "prSteps": { - "denominator": 10000000, - "numerator": 721 - } - }, - "lovelacePerUTxOWord": 4310, - "maxBlockExUnits": { - "exUnitsMem": 62000000, - "exUnitsSteps": 40000000000 - }, - "maxCollateralInputs": 3, - "maxTxExUnits": { - "exUnitsMem": 14000000, - "exUnitsSteps": 10000000000 - }, - "maxValueSize": 5000 -}