From 7e13a2acc64785939c6b147a26f28004411dec9d Mon Sep 17 00:00:00 2001 From: John Ky Date: Tue, 24 Oct 2023 21:00:14 +1100 Subject: [PATCH] Delete ProtocolUTxOCostPerWordFeature and all related code --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 2 - .../Cardano/Api/ProtocolParameters.hs | 95 ++----------------- cardano-api/src/Cardano/Api.hs | 1 - 3 files changed, 9 insertions(+), 89 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 0dc494919d..eeb047502b 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -898,7 +898,6 @@ genProtocolParameters era = do protocolParamPoolPledgeInfluence <- genRationalInt64 protocolParamMonetaryExpansion <- genRational protocolParamTreasuryCut <- genRational - protocolParamUTxOCostPerWord <- inEonForEra @ProtocolUTxOCostPerWordFeature (pure Nothing) (const (Just <$> genLovelace)) era protocolParamCostModels <- pure mempty --TODO: Babbage figure out how to deal with -- asymmetric cost model JSON instances @@ -935,7 +934,6 @@ genProtocolParametersUpdate era = do protocolUpdatePoolPledgeInfluence <- Gen.maybe genRationalInt64 protocolUpdateMonetaryExpansion <- Gen.maybe genRational protocolUpdateTreasuryCut <- Gen.maybe genRational - protocolUpdateUTxOCostPerWord <- inEonForEra @ProtocolUTxOCostPerWordFeature (pure Nothing) (const (Just <$> genLovelace)) era let protocolUpdateCostModels = mempty -- genCostModels --TODO: Babbage figure out how to deal with -- asymmetric cost model JSON instances diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs index 89335827da..ab0bed383b 100644 --- a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs @@ -93,7 +93,6 @@ module Cardano.Api.ProtocolParameters ( -- ** Era-dependent protocol features ProtocolUTxOCostPerByteFeature(..), - ProtocolUTxOCostPerWordFeature(..), ) where import Cardano.Api.Address @@ -563,11 +562,6 @@ data ProtocolParameters = -- protocolParamTreasuryCut :: Rational, - -- | Cost in ada per word of UTxO storage. - -- - -- /Introduced in Alonzo/ - protocolParamUTxOCostPerWord :: Maybe Lovelace, - -- | Cost models for script languages that use them. -- -- /Introduced in Alonzo/ @@ -634,7 +628,6 @@ instance FromJSON ProtocolParameters where <*> o .: "poolPledgeInfluence" <*> o .: "monetaryExpansion" <*> o .: "treasuryCut" - <*> o .:? "utxoCostPerWord" <*> (fmap unCostModels <$> o .:? "costModels") .!= Map.empty <*> o .:? "executionUnitPrices" <*> o .:? "maxTxExecutionUnits" @@ -666,7 +659,6 @@ instance ToJSON ProtocolParameters where , "txFeeFixed" .= protocolParamTxFeeFixed , "txFeePerByte" .= protocolParamTxFeePerByte -- Alonzo era: - , "utxoCostPerWord" .= protocolParamUTxOCostPerWord , "costModels" .= CostModels protocolParamCostModels , "executionUnitPrices" .= protocolParamPrices , "maxTxExecutionUnits" .= protocolParamMaxTxExUnits @@ -800,13 +792,6 @@ data ProtocolParametersUpdate = -- Introduced in Alonzo, - -- | Cost in ada per word of UTxO storage. - -- - -- /Introduced in Alonzo, obsoleted in Babbage by 'protocolUpdateUTxOCostPerByte'/ - protocolUpdateUTxOCostPerWord :: Maybe Lovelace, - - -- Introduced in Alonzo, - -- | Cost models for script languages that use them. -- -- /Introduced in Alonzo/ @@ -845,7 +830,7 @@ data ProtocolParametersUpdate = -- | Cost in ada per byte of UTxO storage. -- - -- /Introduced in Babbage. Supercedes 'protocolUpdateUTxOCostPerWord'/ + -- /Introduced in Babbage/ protocolUpdateUTxOCostPerByte :: Maybe Lovelace } deriving (Eq, Show) @@ -871,7 +856,6 @@ instance Semigroup ProtocolParametersUpdate where , protocolUpdateMonetaryExpansion = merge protocolUpdateMonetaryExpansion , protocolUpdateTreasuryCut = merge protocolUpdateTreasuryCut -- Introduced in Alonzo below. - , protocolUpdateUTxOCostPerWord = merge protocolUpdateUTxOCostPerWord , protocolUpdateCostModels = mergeMap protocolUpdateCostModels , protocolUpdatePrices = merge protocolUpdatePrices , protocolUpdateMaxTxExUnits = merge protocolUpdateMaxTxExUnits @@ -911,7 +895,6 @@ instance Monoid ProtocolParametersUpdate where , protocolUpdatePoolPledgeInfluence = Nothing , protocolUpdateMonetaryExpansion = Nothing , protocolUpdateTreasuryCut = Nothing - , protocolUpdateUTxOCostPerWord = Nothing , protocolUpdateCostModels = mempty , protocolUpdatePrices = Nothing , protocolUpdateMaxTxExUnits = Nothing @@ -942,7 +925,6 @@ instance ToCBOR ProtocolParametersUpdate where <> toCBOR protocolUpdatePoolPledgeInfluence <> toCBOR protocolUpdateMonetaryExpansion <> toCBOR protocolUpdateTreasuryCut - <> toCBOR protocolUpdateUTxOCostPerWord <> toCBOR protocolUpdateCostModels <> toCBOR protocolUpdatePrices <> toCBOR protocolUpdateMaxTxExUnits @@ -981,7 +963,6 @@ instance FromCBOR ProtocolParametersUpdate where <*> fromCBOR <*> fromCBOR <*> fromCBOR - <*> fromCBOR -- ---------------------------------------------------------------------------- -- Features @@ -1014,31 +995,6 @@ instance ToCardanoEra ProtocolUTxOCostPerByteFeature where ProtocolUTxOCostPerByteInBabbageEra -> BabbageEra ProtocolUTxOCostPerByteInConwayEra -> ConwayEra --- | A representation of whether the era supports the 'UTxO Cost Per Word' --- protocol parameter. --- --- The Babbage and subsequent eras support such a protocol parameter. --- -data ProtocolUTxOCostPerWordFeature era where - ProtocolUpdateUTxOCostPerWordInAlonzoEra :: ProtocolUTxOCostPerWordFeature AlonzoEra - -deriving instance Eq (ProtocolUTxOCostPerWordFeature era) -deriving instance Show (ProtocolUTxOCostPerWordFeature era) - -instance Eon ProtocolUTxOCostPerWordFeature where - inEonForEra no yes = \case - ByronEra -> no - ShelleyEra -> no - AllegraEra -> no - MaryEra -> no - AlonzoEra -> yes ProtocolUpdateUTxOCostPerWordInAlonzoEra - BabbageEra -> no - ConwayEra -> no - -instance ToCardanoEra ProtocolUTxOCostPerWordFeature where - toCardanoEra = \case - ProtocolUpdateUTxOCostPerWordInAlonzoEra -> AlonzoEra - -- ---------------------------------------------------------------------------- -- Praos nonce -- @@ -1377,16 +1333,12 @@ toAlonzoPParamsUpdate :: Ledger.Crypto crypto toAlonzoPParamsUpdate protocolParametersUpdate@ProtocolParametersUpdate { protocolUpdateDecentralization - , protocolUpdateUTxOCostPerWord } = do ppuAlonzoCommon <- toAlonzoCommonPParamsUpdate protocolParametersUpdate d <- mapM (boundRationalEither "D") protocolUpdateDecentralization let ppuAlonzo = ppuAlonzoCommon & ppuDL .~ noInlineMaybeToStrictMaybe d - & ppuCoinsPerUTxOWordL .~ - (CoinPerWord . toShelleyLovelace <$> - noInlineMaybeToStrictMaybe protocolUpdateUTxOCostPerWord) pure ppuAlonzo @@ -1490,7 +1442,6 @@ fromShelleyCommonPParamsUpdate ppu = strictMaybeToMaybe (ppu ^. ppuRhoL) , protocolUpdateTreasuryCut = Ledger.unboundRational <$> strictMaybeToMaybe (ppu ^. ppuTauL) - , protocolUpdateUTxOCostPerWord = Nothing , protocolUpdateCostModels = mempty , protocolUpdatePrices = Nothing , protocolUpdateMaxTxExUnits = Nothing @@ -1520,10 +1471,10 @@ fromShelleyPParamsUpdate ppu = strictMaybeToMaybe (ppu ^. ppuMinUTxOValueL) } -fromAlonzoCommonPParamsUpdate :: AlonzoEraPParams ledgerera +fromAlonzoPParamsUpdate :: AlonzoEraPParams ledgerera => PParamsUpdate ledgerera -> ProtocolParametersUpdate -fromAlonzoCommonPParamsUpdate ppu = +fromAlonzoPParamsUpdate ppu = (fromShelleyCommonPParamsUpdate ppu) { protocolUpdateCostModels = maybe mempty fromAlonzoCostModels (strictMaybeToMaybe (ppu ^. ppuCostModelsL)) @@ -1539,21 +1490,11 @@ fromAlonzoCommonPParamsUpdate ppu = , protocolUpdateUTxOCostPerByte = Nothing } - -fromAlonzoPParamsUpdate :: Ledger.Crypto crypto - => PParamsUpdate (Ledger.AlonzoEra crypto) - -> ProtocolParametersUpdate -fromAlonzoPParamsUpdate ppu = - (fromAlonzoCommonPParamsUpdate ppu) { - protocolUpdateUTxOCostPerWord = fromShelleyLovelace . unCoinPerWord <$> - strictMaybeToMaybe (ppu ^. ppuCoinsPerUTxOWordL) - } - fromBabbagePParamsUpdate :: BabbageEraPParams ledgerera => PParamsUpdate ledgerera -> ProtocolParametersUpdate fromBabbagePParamsUpdate ppu = - (fromAlonzoCommonPParamsUpdate ppu) { + (fromAlonzoPParamsUpdate ppu) { protocolUpdateUTxOCostPerByte = fromShelleyLovelace . unCoinPerByte <$> strictMaybeToMaybe (ppu ^. ppuCoinsPerUTxOByteL) } @@ -1689,7 +1630,6 @@ toAlonzoPParams :: Ledger.Crypto crypto toAlonzoPParams protocolParameters@ProtocolParameters { protocolParamDecentralization - , protocolParamUTxOCostPerWord } = do ppAlonzoCommon <- toAlonzoCommonPParams protocolParameters -- QUESTION? This is strange, why do we need to construct Alonzo Tx with Babbage PParams? @@ -1708,12 +1648,9 @@ toAlonzoPParams -- d <- requireParam "protocolParamDecentralization" -- (boundRationalEither "D") -- protocolParamDecentralization - utxoCostPerWord <- - requireParam "protocolParamUTxOCostPerWord" Right protocolParamUTxOCostPerWord let ppAlonzo = ppAlonzoCommon & ppDL .~ d - & ppCoinsPerUTxOWordL .~ CoinPerWord (toShelleyLovelace utxoCostPerWord) pure ppAlonzo @@ -1773,7 +1710,6 @@ fromShelleyCommonPParams pp = , protocolParamPoolPledgeInfluence = Ledger.unboundRational (pp ^. ppA0L) , protocolParamMonetaryExpansion = Ledger.unboundRational (pp ^. ppRhoL) , protocolParamTreasuryCut = Ledger.unboundRational (pp ^. ppTauL) - , protocolParamUTxOCostPerWord = Nothing -- Obsolete from Babbage onwards , protocolParamCostModels = mempty -- Only from Alonzo onwards , protocolParamPrices = Nothing -- Only from Alonzo onwards , protocolParamMaxTxExUnits = Nothing -- Only from Alonzo onwards @@ -1801,10 +1737,10 @@ fromShelleyPParams pp = } -fromAlonzoCommonPParams :: AlonzoEraPParams ledgerera +fromAlonzoPParams :: AlonzoEraPParams ledgerera => PParams ledgerera -> ProtocolParameters -fromAlonzoCommonPParams pp = +fromAlonzoPParams pp = (fromShelleyCommonPParams pp) { protocolParamCostModels = fromAlonzoCostModels $ pp ^. ppCostModelsL , protocolParamPrices = Just . fromAlonzoPrices $ pp ^. ppPricesL @@ -1815,21 +1751,11 @@ fromAlonzoCommonPParams pp = , protocolParamMaxCollateralInputs = Just $ pp ^. ppMaxCollateralInputsL } - -fromAlonzoPParams :: Ledger.Crypto crypto - => PParams (Ledger.AlonzoEra crypto) - -> ProtocolParameters -fromAlonzoPParams pp = - (fromAlonzoCommonPParams pp) { - protocolParamUTxOCostPerWord = Just . fromShelleyLovelace . unCoinPerWord $ - pp ^. ppCoinsPerUTxOWordL - } - fromBabbagePParams :: BabbageEraPParams ledgerera => PParams ledgerera -> ProtocolParameters fromBabbagePParams pp = - (fromAlonzoCommonPParams pp) { + (fromAlonzoPParams pp) { protocolParamUTxOCostPerByte = Just . fromShelleyLovelace . unCoinPerByte $ pp ^. ppCoinsPerUTxOByteL } @@ -1854,7 +1780,6 @@ checkProtocolParameters sbe ProtocolParameters{..} = where era = shelleyBasedToCardanoEra sbe - costPerWord = isJust protocolParamUTxOCostPerWord cModel = not $ Map.null protocolParamCostModels prices = isJust protocolParamPrices maxTxUnits = isJust protocolParamMaxTxExUnits @@ -1868,8 +1793,7 @@ checkProtocolParameters sbe ProtocolParameters{..} = alonzoPParamFieldsRequirements :: [Bool] alonzoPParamFieldsRequirements = - [ costPerWord - , cModel + [ cModel , prices , maxTxUnits , maxBlockExUnits @@ -1881,8 +1805,7 @@ checkProtocolParameters sbe ProtocolParameters{..} = babbagePParamFieldsRequirements :: [Bool] babbagePParamFieldsRequirements = - [ not costPerWord - , cModel + [ cModel , prices , maxTxUnits , maxBlockExUnits diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 226097cf8b..146b67c922 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -405,7 +405,6 @@ module Cardano.Api ( -- ** Era-dependent protocol features ProtocolUTxOCostPerByteFeature(..), - ProtocolUTxOCostPerWordFeature(..), -- ** Fee calculation LedgerEpochInfo(..),