Skip to content

Commit

Permalink
Delete ProtocolUTxOCostPerWordFeature and all related code
Browse files Browse the repository at this point in the history
  • Loading branch information
newhoggy committed Oct 24, 2023
1 parent 225ac3c commit 7e13a2a
Show file tree
Hide file tree
Showing 3 changed files with 9 additions and 89 deletions.
2 changes: 0 additions & 2 deletions cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
95 changes: 9 additions & 86 deletions cardano-api/internal/Cardano/Api/ProtocolParameters.hs
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,6 @@ module Cardano.Api.ProtocolParameters (

-- ** Era-dependent protocol features
ProtocolUTxOCostPerByteFeature(..),
ProtocolUTxOCostPerWordFeature(..),
) where

import Cardano.Api.Address
Expand Down Expand Up @@ -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/
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -666,7 +659,6 @@ instance ToJSON ProtocolParameters where
, "txFeeFixed" .= protocolParamTxFeeFixed
, "txFeePerByte" .= protocolParamTxFeePerByte
-- Alonzo era:
, "utxoCostPerWord" .= protocolParamUTxOCostPerWord
, "costModels" .= CostModels protocolParamCostModels
, "executionUnitPrices" .= protocolParamPrices
, "maxTxExecutionUnits" .= protocolParamMaxTxExUnits
Expand Down Expand Up @@ -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/
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -911,7 +895,6 @@ instance Monoid ProtocolParametersUpdate where
, protocolUpdatePoolPledgeInfluence = Nothing
, protocolUpdateMonetaryExpansion = Nothing
, protocolUpdateTreasuryCut = Nothing
, protocolUpdateUTxOCostPerWord = Nothing
, protocolUpdateCostModels = mempty
, protocolUpdatePrices = Nothing
, protocolUpdateMaxTxExUnits = Nothing
Expand Down Expand Up @@ -942,7 +925,6 @@ instance ToCBOR ProtocolParametersUpdate where
<> toCBOR protocolUpdatePoolPledgeInfluence
<> toCBOR protocolUpdateMonetaryExpansion
<> toCBOR protocolUpdateTreasuryCut
<> toCBOR protocolUpdateUTxOCostPerWord
<> toCBOR protocolUpdateCostModels
<> toCBOR protocolUpdatePrices
<> toCBOR protocolUpdateMaxTxExUnits
Expand Down Expand Up @@ -981,7 +963,6 @@ instance FromCBOR ProtocolParametersUpdate where
<*> fromCBOR
<*> fromCBOR
<*> fromCBOR
<*> fromCBOR

-- ----------------------------------------------------------------------------
-- Features
Expand Down Expand Up @@ -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
--
Expand Down Expand Up @@ -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


Expand Down Expand Up @@ -1490,7 +1442,6 @@ fromShelleyCommonPParamsUpdate ppu =
strictMaybeToMaybe (ppu ^. ppuRhoL)
, protocolUpdateTreasuryCut = Ledger.unboundRational <$>
strictMaybeToMaybe (ppu ^. ppuTauL)
, protocolUpdateUTxOCostPerWord = Nothing
, protocolUpdateCostModels = mempty
, protocolUpdatePrices = Nothing
, protocolUpdateMaxTxExUnits = Nothing
Expand Down Expand Up @@ -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))
Expand All @@ -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)
}
Expand Down Expand Up @@ -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?
Expand All @@ -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


Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
}
Expand All @@ -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
Expand All @@ -1868,8 +1793,7 @@ checkProtocolParameters sbe ProtocolParameters{..} =

alonzoPParamFieldsRequirements :: [Bool]
alonzoPParamFieldsRequirements =
[ costPerWord
, cModel
[ cModel
, prices
, maxTxUnits
, maxBlockExUnits
Expand All @@ -1881,8 +1805,7 @@ checkProtocolParameters sbe ProtocolParameters{..} =

babbagePParamFieldsRequirements :: [Bool]
babbagePParamFieldsRequirements =
[ not costPerWord
, cModel
[ cModel
, prices
, maxTxUnits
, maxBlockExUnits
Expand Down
1 change: 0 additions & 1 deletion cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -405,7 +405,6 @@ module Cardano.Api (

-- ** Era-dependent protocol features
ProtocolUTxOCostPerByteFeature(..),
ProtocolUTxOCostPerWordFeature(..),

-- ** Fee calculation
LedgerEpochInfo(..),
Expand Down

0 comments on commit 7e13a2a

Please sign in to comment.