diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index bbd65a8ea8..a0faa2e596 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -358,7 +358,6 @@ test-suite cardano-api-test Test.Cardano.Api.Metadata Test.Cardano.Api.Ord Test.Cardano.Api.Orphans - Test.Cardano.Api.ProtocolParameters Test.Cardano.Api.RawBytes Test.Cardano.Api.Transaction.Autobalance Test.Cardano.Api.TxBody @@ -386,7 +385,6 @@ test-suite cardano-api-golden cardano-data >=1.0, cardano-ledger-alonzo, cardano-ledger-api >=1.9, - cardano-ledger-babbage >=1.9, cardano-ledger-binary, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.14, cardano-ledger-shelley, @@ -415,7 +413,6 @@ test-suite cardano-api-golden other-modules: Test.Golden.Cardano.Api.Genesis Test.Golden.Cardano.Api.Ledger - Test.Golden.Cardano.Api.ProtocolParameters Test.Golden.Cardano.Api.Script Test.Golden.Cardano.Api.Value Test.Golden.ErrorsSpec diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 1117d29e99..b98cdba85b 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -31,7 +31,6 @@ module Test.Gen.Cardano.Api.Typed , genMaybePraosNonce , genPraosNonce , genValidProtocolParameters - , genProtocolParameters , genValueNestedRep , genValueNestedBundle , genByronKeyWitness @@ -1170,40 +1169,7 @@ genPraosNonce = makePraosNonce <$> Gen.bytes (Range.linear 0 32) genMaybePraosNonce :: Gen (Maybe PraosNonce) genMaybePraosNonce = Gen.maybe genPraosNonce -genProtocolParameters :: CardanoEra era -> Gen ProtocolParameters -genProtocolParameters era = do - protocolParamProtocolVersion <- (,) <$> genNat <*> genNat - protocolParamDecentralization <- Gen.maybe genRational - protocolParamExtraPraosEntropy <- genMaybePraosNonce - protocolParamMaxBlockHeaderSize <- genNat - protocolParamMaxBlockBodySize <- genNat - protocolParamMaxTxSize <- genNat - protocolParamTxFeeFixed <- genLovelace - protocolParamTxFeePerByte <- genLovelace - protocolParamMinUTxOValue <- Gen.maybe genLovelace - protocolParamStakeAddressDeposit <- genLovelace - protocolParamStakePoolDeposit <- genLovelace - protocolParamMinPoolCost <- genLovelace - protocolParamPoolRetireMaxEpoch <- genEpochInterval - protocolParamStakePoolTargetNum <- genWord16 - protocolParamPoolPledgeInfluence <- genRationalInt64 - protocolParamMonetaryExpansion <- genRational - protocolParamTreasuryCut <- genRational - let protocolParamCostModels = mempty - -- TODO: Babbage figure out how to deal with - -- asymmetric cost model JSON instances - protocolParamPrices <- Gen.maybe genExecutionUnitPrices - protocolParamMaxTxExUnits <- Gen.maybe genExecutionUnits - protocolParamMaxBlockExUnits <- Gen.maybe genExecutionUnits - protocolParamMaxValueSize <- Gen.maybe genNat - protocolParamCollateralPercent <- Gen.maybe genNat - protocolParamMaxCollateralInputs <- Gen.maybe genNat - protocolParamUTxOCostPerByte <- - inEonForEra @BabbageEraOnwards (pure Nothing) (const (Just <$> genLovelace)) era - - pure ProtocolParameters{..} - --- | Generate valid protocol parameters which pass validations in Cardano.Api.Internal.ProtocolParameters +-- | Generate valid protocol parameters which pass validations in Cardano.Api.ProtocolParameters genValidProtocolParameters :: ShelleyBasedEra era -> Gen (LedgerProtocolParameters era) genValidProtocolParameters sbe = shelleyBasedEraTestConstraints sbe $ LedgerProtocolParameters <$> Q.arbitrary diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index de24d8107b..71ddb33eb8 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -953,8 +953,6 @@ module Cardano.Api , ProtocolParametersConversionError (..) -- ** Conversions - , toLedgerPParams - , fromLedgerPParams , toCtxUTxOTxOut -- TODO: arrange not to export these , fromNetworkMagic diff --git a/cardano-api/src/Cardano/Api/Internal/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/Internal/ProtocolParameters.hs index 675a45393c..4fdac4d5fa 100644 --- a/cardano-api/src/Cardano/Api/Internal/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/Internal/ProtocolParameters.hs @@ -30,9 +30,7 @@ -- * parameters fixed in the genesis file: 'GenesisParameters' module Cardano.Api.Internal.ProtocolParameters ( -- * The updatable protocol parameters - ProtocolParameters (..) - , checkProtocolParameters - , EpochNo + EpochNo -- * The updatable protocol parameters , LedgerProtocolParameters (..) @@ -45,7 +43,6 @@ module Cardano.Api.Internal.ProtocolParameters , IntroducedInBabbagePParams (..) , IntroducedInConwayPParams (..) , createEraBasedProtocolParamUpdate - , convertToLedgerProtocolParameters , createPParams -- * Deprecated @@ -76,9 +73,7 @@ module Cardano.Api.Internal.ProtocolParameters , fromLedgerUpdate , toLedgerProposedPPUpdates , fromLedgerProposedPPUpdates - , toLedgerPParams , toLedgerPParamsUpdate - , fromLedgerPParams , fromLedgerPParamsUpdate , toAlonzoPrices , fromAlonzoPrices @@ -138,8 +133,7 @@ import Cardano.Slotting.Slot (EpochNo (..)) import PlutusLedgerApi.Common (CostModelApplyError) import Control.Monad -import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.!=), (.:), (.:?), - (.=)) +import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=)) import Data.Bifunctor (bimap, first) import Data.ByteString (ByteString) import Data.Data (Data) @@ -147,7 +141,6 @@ import Data.Either.Combinators (maybeToRight) import Data.Int (Int64) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (isJust) import Data.Maybe.Strict (StrictMaybe (..)) import Data.String (IsString) import Data.Text (Text) @@ -175,17 +168,6 @@ instance IsShelleyBasedEra era => Eq (LedgerProtocolParameters era) where shelleyBasedEraConstraints (shelleyBasedEra @era) $ a == b -{-# DEPRECATED - convertToLedgerProtocolParameters - "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork." - #-} -convertToLedgerProtocolParameters - :: ShelleyBasedEra era - -> ProtocolParameters - -> Either ProtocolParametersConversionError (LedgerProtocolParameters era) -convertToLedgerProtocolParameters sbe pp = - LedgerProtocolParameters <$> toLedgerPParams sbe pp - createPParams :: ShelleyBasedEra era -> EraBasedProtocolParametersUpdate era @@ -1273,13 +1255,6 @@ toBabbagePParamsUpdate & ppuProtocolVersionL .~ noInlineMaybeToStrictMaybe protVer pure ppuBabbage -requireParam - :: String - -> (a -> Either ProtocolParametersConversionError b) - -> Maybe a - -> Either ProtocolParametersConversionError b -requireParam paramName = maybe (Left $ PpceMissingParameter paramName) - mkProtVer :: (Natural, Natural) -> Either ProtocolParametersConversionError Ledger.ProtVer mkProtVer (majorProtVer, minorProtVer) = maybeToRight (PpceVersionInvalid majorProtVer) $ @@ -1454,377 +1429,6 @@ fromConwayPParamsUpdate -> ProtocolParametersUpdate fromConwayPParamsUpdate = fromBabbageCommonPParamsUpdate --- ---------------------------------------------------------------------------- --- Conversion functions: protocol parameters to ledger types --- - -toLedgerPParams - :: ShelleyBasedEra era - -> ProtocolParameters - -> Either ProtocolParametersConversionError (Ledger.PParams (ShelleyLedgerEra era)) -toLedgerPParams ShelleyBasedEraShelley = toShelleyPParams -toLedgerPParams ShelleyBasedEraAllegra = toShelleyPParams -toLedgerPParams ShelleyBasedEraMary = toShelleyPParams -toLedgerPParams ShelleyBasedEraAlonzo = toAlonzoPParams -toLedgerPParams ShelleyBasedEraBabbage = toBabbagePParams -toLedgerPParams ShelleyBasedEraConway = toConwayPParams - -toShelleyCommonPParams - :: EraPParams ledgerera - => ProtocolParameters - -> Either ProtocolParametersConversionError (PParams ledgerera) -toShelleyCommonPParams - ProtocolParameters - { protocolParamProtocolVersion - , protocolParamMaxBlockHeaderSize - , protocolParamMaxBlockBodySize - , protocolParamMaxTxSize - , protocolParamTxFeeFixed - , protocolParamTxFeePerByte - , protocolParamStakeAddressDeposit - , protocolParamStakePoolDeposit - , protocolParamMinPoolCost - , protocolParamPoolRetireMaxEpoch - , protocolParamStakePoolTargetNum - , protocolParamPoolPledgeInfluence - , protocolParamMonetaryExpansion - , protocolParamTreasuryCut - } = do - a0 <- boundRationalEither "A0" protocolParamPoolPledgeInfluence - rho <- boundRationalEither "Rho" protocolParamMonetaryExpansion - tau <- boundRationalEither "Tau" protocolParamTreasuryCut - protVer <- mkProtVer protocolParamProtocolVersion - let ppCommon = - emptyPParams - & ppMinFeeAL .~ protocolParamTxFeePerByte - & ppMinFeeBL .~ protocolParamTxFeeFixed - & ppMaxBBSizeL .~ fromIntegral protocolParamMaxBlockBodySize - & ppMaxTxSizeL .~ fromIntegral protocolParamMaxTxSize - & ppMaxBHSizeL .~ fromIntegral protocolParamMaxBlockHeaderSize - & ppKeyDepositL .~ protocolParamStakeAddressDeposit - & ppPoolDepositL .~ protocolParamStakePoolDeposit - & ppEMaxL .~ protocolParamPoolRetireMaxEpoch - & ppNOptL .~ protocolParamStakePoolTargetNum - & ppA0L .~ a0 - & ppRhoL .~ rho - & ppTauL .~ tau - & ppProtocolVersionL .~ protVer - & ppMinPoolCostL .~ protocolParamMinPoolCost - pure ppCommon - -toShelleyPParams - :: ( EraPParams ledgerera - , Ledger.AtMostEra Ledger.MaryEra ledgerera - , Ledger.AtMostEra Ledger.AlonzoEra ledgerera - ) - => ProtocolParameters - -> Either ProtocolParametersConversionError (PParams ledgerera) -toShelleyPParams - protocolParameters@ProtocolParameters - { protocolParamDecentralization - , protocolParamExtraPraosEntropy - , protocolParamMinUTxOValue - } = do - ppCommon <- toShelleyCommonPParams protocolParameters - d <- - boundRationalEither "D" - =<< maybeToRight (PpceMissingParameter "decentralization") protocolParamDecentralization - minUTxOValue <- - maybeToRight (PpceMissingParameter "protocolParamMinUTxOValue") protocolParamMinUTxOValue - let ppShelley = - ppCommon - & ppDL .~ d - & ppExtraEntropyL .~ toLedgerNonce protocolParamExtraPraosEntropy - & ppMinUTxOValueL .~ minUTxOValue - pure ppShelley - -toAlonzoCommonPParams - :: AlonzoEraPParams ledgerera - => ProtocolParameters - -> Either ProtocolParametersConversionError (PParams ledgerera) -toAlonzoCommonPParams - protocolParameters@ProtocolParameters - { protocolParamCostModels - , protocolParamPrices - , protocolParamMaxTxExUnits - , protocolParamMaxBlockExUnits - , protocolParamMaxValueSize - , protocolParamCollateralPercent - , protocolParamMaxCollateralInputs - } = do - ppShelleyCommon <- toShelleyCommonPParams protocolParameters - costModels <- toAlonzoCostModels protocolParamCostModels - prices <- - requireParam "protocolParamPrices" toAlonzoPrices protocolParamPrices - maxTxExUnits <- - requireParam "protocolParamMaxTxExUnits" Right protocolParamMaxTxExUnits - maxBlockExUnits <- - requireParam "protocolParamMaxBlockExUnits" Right protocolParamMaxBlockExUnits - maxValueSize <- - requireParam "protocolParamMaxBlockExUnits" Right protocolParamMaxValueSize - collateralPercent <- - requireParam "protocolParamCollateralPercent" Right protocolParamCollateralPercent - maxCollateralInputs <- - requireParam "protocolParamMaxCollateralInputs" Right protocolParamMaxCollateralInputs - let ppAlonzoCommon = - ppShelleyCommon - & ppCostModelsL .~ costModels - & ppPricesL .~ prices - & ppMaxTxExUnitsL .~ toAlonzoExUnits maxTxExUnits - & ppMaxBlockExUnitsL .~ toAlonzoExUnits maxBlockExUnits - & ppMaxValSizeL .~ maxValueSize - & ppCollateralPercentageL .~ collateralPercent - & ppMaxCollateralInputsL .~ maxCollateralInputs - pure ppAlonzoCommon - -toAlonzoPParams - :: Ledger.Crypto crypto - => ProtocolParameters - -> Either ProtocolParametersConversionError (PParams (Ledger.AlonzoEra crypto)) -toAlonzoPParams - protocolParameters@ProtocolParameters - { protocolParamDecentralization - } = do - ppAlonzoCommon <- toAlonzoCommonPParams protocolParameters - d <- - requireParam - "protocolParamDecentralization" - (boundRationalEither "D") - protocolParamDecentralization - let ppAlonzo = - ppAlonzoCommon - & ppDL .~ d - pure ppAlonzo - -toBabbagePParams - :: BabbageEraPParams ledgerera - => ProtocolParameters - -> Either ProtocolParametersConversionError (PParams ledgerera) -toBabbagePParams - protocolParameters@ProtocolParameters - { protocolParamUTxOCostPerByte - } = do - ppAlonzoCommon <- toAlonzoCommonPParams protocolParameters - utxoCostPerByte <- - requireParam "protocolParamUTxOCostPerByte" Right protocolParamUTxOCostPerByte - let ppBabbage = - ppAlonzoCommon - & ppCoinsPerUTxOByteL .~ CoinPerByte utxoCostPerByte - pure ppBabbage - -toConwayPParams - :: BabbageEraPParams ledgerera - => ProtocolParameters - -> Either ProtocolParametersConversionError (PParams ledgerera) -toConwayPParams = toBabbagePParams - --- ---------------------------------------------------------------------------- --- Conversion functions: protocol parameters from ledger types --- - -{-# DEPRECATED - fromLedgerPParams - "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork." - #-} -fromLedgerPParams - :: ShelleyBasedEra era - -> Ledger.PParams (ShelleyLedgerEra era) - -> ProtocolParameters -fromLedgerPParams ShelleyBasedEraShelley = fromShelleyPParams -fromLedgerPParams ShelleyBasedEraAllegra = fromShelleyPParams -fromLedgerPParams ShelleyBasedEraMary = fromShelleyPParams -fromLedgerPParams ShelleyBasedEraAlonzo = fromExactlyAlonzoPParams -fromLedgerPParams ShelleyBasedEraBabbage = fromBabbagePParams -fromLedgerPParams ShelleyBasedEraConway = fromConwayPParams - -{-# DEPRECATED - fromShelleyCommonPParams - "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork." - #-} -fromShelleyCommonPParams - :: EraPParams ledgerera - => PParams ledgerera - -> ProtocolParameters -fromShelleyCommonPParams pp = - ProtocolParameters - { protocolParamProtocolVersion = case pp ^. ppProtocolVersionL of - Ledger.ProtVer a b -> (Ledger.getVersion a, b) - , protocolParamMaxBlockHeaderSize = fromIntegral $ pp ^. ppMaxBHSizeL - , protocolParamMaxBlockBodySize = fromIntegral $ pp ^. ppMaxBBSizeL - , protocolParamMaxTxSize = fromIntegral $ pp ^. ppMaxTxSizeL - , protocolParamTxFeeFixed = pp ^. ppMinFeeBL - , protocolParamTxFeePerByte = pp ^. ppMinFeeAL - , protocolParamStakeAddressDeposit = pp ^. ppKeyDepositL - , protocolParamStakePoolDeposit = pp ^. ppPoolDepositL - , protocolParamMinPoolCost = pp ^. ppMinPoolCostL - , protocolParamPoolRetireMaxEpoch = pp ^. ppEMaxL - , protocolParamStakePoolTargetNum = pp ^. ppNOptL - , protocolParamPoolPledgeInfluence = Ledger.unboundRational (pp ^. ppA0L) - , protocolParamMonetaryExpansion = Ledger.unboundRational (pp ^. ppRhoL) - , protocolParamTreasuryCut = Ledger.unboundRational (pp ^. ppTauL) - , protocolParamCostModels = mempty -- Only from Alonzo onwards - , protocolParamPrices = Nothing -- Only from Alonzo onwards - , protocolParamMaxTxExUnits = Nothing -- Only from Alonzo onwards - , protocolParamMaxBlockExUnits = Nothing -- Only from Alonzo onwards - , protocolParamMaxValueSize = Nothing -- Only from Alonzo onwards - , protocolParamCollateralPercent = Nothing -- Only from Alonzo onwards - , protocolParamMaxCollateralInputs = Nothing -- Only from Alonzo onwards - , protocolParamUTxOCostPerByte = Nothing -- Only from Babbage onwards - , protocolParamDecentralization = Nothing -- Obsolete from Babbage onwards - , protocolParamExtraPraosEntropy = Nothing -- Obsolete from Alonzo onwards - , protocolParamMinUTxOValue = Nothing -- Obsolete from Alonzo onwards - } - -{-# DEPRECATED - fromShelleyPParams - "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork." - #-} -fromShelleyPParams - :: ( EraPParams ledgerera - , Ledger.AtMostEra Ledger.MaryEra ledgerera - , Ledger.AtMostEra Ledger.AlonzoEra ledgerera - ) - => PParams ledgerera - -> ProtocolParameters -fromShelleyPParams pp = - (fromShelleyCommonPParams pp) - { protocolParamDecentralization = Just . Ledger.unboundRational $ pp ^. ppDL - , protocolParamExtraPraosEntropy = fromLedgerNonce $ pp ^. ppExtraEntropyL - , protocolParamMinUTxOValue = Just $ pp ^. ppMinUTxOValueL - } - -{-# DEPRECATED - fromAlonzoPParams - "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork." - #-} -fromAlonzoPParams - :: AlonzoEraPParams ledgerera - => PParams ledgerera - -> ProtocolParameters -fromAlonzoPParams pp = - (fromShelleyCommonPParams pp) - { protocolParamCostModels = fromAlonzoCostModels $ pp ^. ppCostModelsL - , protocolParamDecentralization = Just . Ledger.unboundRational $ pp ^. ppDG - , protocolParamPrices = Just . fromAlonzoPrices $ pp ^. ppPricesL - , protocolParamMaxTxExUnits = Just . fromAlonzoExUnits $ pp ^. ppMaxTxExUnitsL - , protocolParamMaxBlockExUnits = Just . fromAlonzoExUnits $ pp ^. ppMaxBlockExUnitsL - , protocolParamMaxValueSize = Just $ pp ^. ppMaxValSizeL - , protocolParamCollateralPercent = Just $ pp ^. ppCollateralPercentageL - , protocolParamMaxCollateralInputs = Just $ pp ^. ppMaxCollateralInputsL - } - -{-# DEPRECATED - fromExactlyAlonzoPParams - "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork." - #-} -fromExactlyAlonzoPParams - :: (AlonzoEraPParams ledgerera, Ledger.ExactEra Ledger.AlonzoEra ledgerera) - => PParams ledgerera - -> ProtocolParameters -fromExactlyAlonzoPParams pp = - (fromAlonzoPParams pp) - { protocolParamUTxOCostPerByte = Just . unCoinPerWord $ pp ^. ppCoinsPerUTxOWordL - } - -{-# DEPRECATED - fromBabbagePParams - "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork." - #-} -fromBabbagePParams - :: BabbageEraPParams ledgerera - => PParams ledgerera - -> ProtocolParameters -fromBabbagePParams pp = - (fromAlonzoPParams pp) - { protocolParamUTxOCostPerByte = Just . unCoinPerByte $ pp ^. ppCoinsPerUTxOByteL - , protocolParamDecentralization = Nothing - } - -{-# DEPRECATED - fromConwayPParams - "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork." - #-} -fromConwayPParams - :: BabbageEraPParams ledgerera - => PParams ledgerera - -> ProtocolParameters -fromConwayPParams = fromBabbagePParams - -{-# DEPRECATED - checkProtocolParameters - "Use the ledger's PParams (from module Cardano.Api.Ledger) type instead of ProtocolParameters. The type will be removed after Chang hard fork. PParams natively enforce these checks." - #-} -checkProtocolParameters - :: () - => ShelleyBasedEra era - -> ProtocolParameters - -> Either ProtocolParametersError () -checkProtocolParameters sbe ProtocolParameters{..} = - case sbe of - ShelleyBasedEraShelley -> checkMinUTxOVal - ShelleyBasedEraAllegra -> checkMinUTxOVal - ShelleyBasedEraMary -> checkMinUTxOVal - ShelleyBasedEraAlonzo -> checkAlonzoParams - ShelleyBasedEraBabbage -> checkBabbageParams - ShelleyBasedEraConway -> checkBabbageParams - where - era = toCardanoEra sbe - - cModel = not $ Map.null protocolParamCostModels - prices = isJust protocolParamPrices - maxTxUnits = isJust protocolParamMaxTxExUnits - maxBlockExUnits = isJust protocolParamMaxBlockExUnits - maxValueSize = isJust protocolParamMaxValueSize - collateralPercent = isJust protocolParamCollateralPercent - maxCollateralInputs = isJust protocolParamMaxCollateralInputs - costPerByte = isJust protocolParamUTxOCostPerByte - decentralization = isJust protocolParamDecentralization - extraPraosEntropy = isJust protocolParamExtraPraosEntropy - - alonzoPParamFieldsRequirements :: [Bool] - alonzoPParamFieldsRequirements = - [ cModel - , prices - , maxTxUnits - , maxBlockExUnits - , maxValueSize - , collateralPercent - , maxCollateralInputs - , not costPerByte - ] - - babbagePParamFieldsRequirements :: [Bool] - babbagePParamFieldsRequirements = - [ cModel - , prices - , maxTxUnits - , maxBlockExUnits - , maxValueSize - , collateralPercent - , maxCollateralInputs - , costPerByte - , not decentralization - , not extraPraosEntropy - ] - - checkAlonzoParams :: Either ProtocolParametersError () - checkAlonzoParams = do - if all (== True) alonzoPParamFieldsRequirements - then return () - else Left PParamsErrorMissingAlonzoProtocolParameter - - checkBabbageParams :: Either ProtocolParametersError () - checkBabbageParams = - if all (== True) babbagePParamFieldsRequirements - then return () - else Left PParamsErrorMissingAlonzoProtocolParameter - - checkMinUTxOVal :: Either ProtocolParametersError () - checkMinUTxOVal = - if isJust protocolParamMinUTxOValue - then return () - else Left . PParamsErrorMissingMinUTxoValue $ cardanoEraConstraints era $ AnyCardanoEra era - data ProtocolParametersError = PParamsErrorMissingMinUTxoValue !AnyCardanoEra | PParamsErrorMissingAlonzoProtocolParameter diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 017a98ebdd..7ee6c04fec 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -120,9 +120,6 @@ module Cardano.Api.Shelley , IntroducedInBabbagePParams (..) , IntroducedInConwayPParams (..) , createEraBasedProtocolParamUpdate - , convertToLedgerProtocolParameters - , ProtocolParameters (..) - , checkProtocolParameters , ProtocolParametersError (..) -- * Scripts diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/ProtocolParameters.hs b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/ProtocolParameters.hs deleted file mode 100644 index 0c10427190..0000000000 --- a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/ProtocolParameters.hs +++ /dev/null @@ -1,145 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MonoLocalBinds #-} -{-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE ScopedTypeVariables #-} --- TODO remove me when ProtocolParameters is deleted -{-# OPTIONS_GHC -Wno-deprecations #-} - -module Test.Golden.Cardano.Api.ProtocolParameters - ( test_golden_ProtocolParameters - , test_golden_ProtocolParameters_to_PParams - ) -where - -import Cardano.Api (AnyPlutusScriptVersion (AnyPlutusScriptVersion), CostModel (..), - ExecutionUnits (..), PlutusScriptVersion (..), makePraosNonce) -import Cardano.Api.Internal.ProtocolParameters (ExecutionUnitPrices (..), - ProtocolParameters (..)) -import Cardano.Api.Ledger (Coin (..), EpochInterval (EpochInterval), StandardCrypto) - -import Cardano.Ledger.Alonzo (AlonzoEra) -import Cardano.Ledger.Alonzo.PParams (AlonzoPParams (..)) -import Cardano.Ledger.Babbage (BabbageEra) -import Cardano.Ledger.Babbage.PParams (BabbagePParams (..)) -import Cardano.Ledger.Plutus.CostModels (costModelParamsCount) -import Cardano.Ledger.Plutus.Language (Language (..)) -import Cardano.Ledger.Shelley (ShelleyEra) -import Cardano.Ledger.Shelley.PParams (ShelleyPParams (..)) - -import Data.Aeson (FromJSON, eitherDecode, encode) -import Data.ByteString.Lazy (ByteString) -import Data.Functor.Identity (Identity) -import Data.Int (Int64) -import Data.Map (Map) -import Data.Proxy (Proxy (..)) -import GHC.Exts (IsList (..)) - -import Hedgehog (Property, property, success) -import qualified Hedgehog.Extras.Aeson as H -import Hedgehog.Internal.Property (failWith) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Hedgehog (testProperty) - -test_golden_ProtocolParameters :: TestTree -test_golden_ProtocolParameters = testProperty "golden ProtocolParameters" $ do - H.goldenTestJsonValuePretty - legacyCardanoApiProtocolParameters - "test/cardano-api-golden/files/golden/LegacyProtocolParameters.json" - -test_golden_ProtocolParameters_to_PParams :: TestTree -test_golden_ProtocolParameters_to_PParams = - testGroup - "golden ProtocolParameter tests" - [ testProperty "ShelleyPParams" $ - goldenLegacyProtocolParametersToPParams - (Proxy :: Proxy (ShelleyPParams Identity (ShelleyEra StandardCrypto))) - , testProperty "AlonzoPParams" $ - goldenLegacyProtocolParametersToPParams - (Proxy :: Proxy (AlonzoPParams Identity (AlonzoEra StandardCrypto))) - , testProperty "BabbagePParams" $ - goldenLegacyProtocolParametersToPParams - (Proxy :: Proxy (BabbagePParams Identity (BabbageEra StandardCrypto))) - ] - --- Test that tries decoding the legacy protocol parameters golden file --- 'legacyCardanoApiProtocolParameters' as the type provided as a 'Proxy'. -goldenLegacyProtocolParametersToPParams :: forall pp. FromJSON pp => Proxy pp -> Property -goldenLegacyProtocolParametersToPParams proxy = - property $ case decodedLegacyCardanoApiProtocolParameters of - Left err -> - failWith - Nothing - ( "goldenLegacyProtocolParametersToPParams could not decode golden file as " - <> show proxy - <> ": " - <> show err - ) - Right _ -> success - where - bytestringLegacyCardanoApiProtocolParameters :: ByteString - bytestringLegacyCardanoApiProtocolParameters = encode legacyCardanoApiProtocolParameters - - decodedLegacyCardanoApiProtocolParameters :: Either String pp - decodedLegacyCardanoApiProtocolParameters = eitherDecode bytestringLegacyCardanoApiProtocolParameters - -legacyCardanoApiProtocolParameters :: ProtocolParameters -legacyCardanoApiProtocolParameters = - ProtocolParameters - { protocolParamUTxOCostPerByte = Just $ Coin 1_000_000 - , protocolParamTxFeePerByte = Coin 2_000_000 - , protocolParamTxFeeFixed = Coin 1_500_000 - , protocolParamTreasuryCut = 0.1 - , protocolParamStakePoolTargetNum = 100 - , protocolParamStakePoolDeposit = Coin 1_000_000_000 - , protocolParamStakeAddressDeposit = Coin 10_000_000 - , protocolParamProtocolVersion = (2, 3) - , protocolParamPrices = Just executionUnitPrices - , protocolParamPoolRetireMaxEpoch = Cardano.Api.Ledger.EpochInterval 4 - , protocolParamPoolPledgeInfluence = 0.54 - , protocolParamMonetaryExpansion = 0.23 - , protocolParamMinUTxOValue = Just $ Coin 3_000_000 - , protocolParamMinPoolCost = Coin 3_500_000 - , protocolParamMaxValueSize = Just 10 - , protocolParamMaxTxSize = 3_000 - , protocolParamMaxTxExUnits = Just executionUnits - , protocolParamMaxCollateralInputs = Just 10 - , protocolParamMaxBlockHeaderSize = 1_200 - , protocolParamMaxBlockExUnits = Just executionUnits2 - , protocolParamMaxBlockBodySize = 5_000 - , protocolParamExtraPraosEntropy = Just $ makePraosNonce "entropyEntropy" - , protocolParamDecentralization = Just 0.52 - , protocolParamCostModels = costModels - , protocolParamCollateralPercent = Just 23 - } - where - executionUnitPrices :: ExecutionUnitPrices - executionUnitPrices = - ExecutionUnitPrices - { priceExecutionSteps = 0.3 - , priceExecutionMemory = 0.2 - } - - costModels :: Map AnyPlutusScriptVersion CostModel - costModels = - fromList - [ (AnyPlutusScriptVersion PlutusScriptV3, CostModel [1 .. numParams PlutusV3]) - , (AnyPlutusScriptVersion PlutusScriptV2, CostModel [1 .. numParams PlutusV2]) - , (AnyPlutusScriptVersion PlutusScriptV1, CostModel [1 .. numParams PlutusV1]) - ] - - numParams :: Language -> Int64 - numParams = fromIntegral . costModelParamsCount - - executionUnits :: ExecutionUnits - executionUnits = - ExecutionUnits - { executionSteps = 4_300 - , executionMemory = 2_300 - } - - executionUnits2 :: ExecutionUnits - executionUnits2 = - ExecutionUnits - { executionSteps = 5_600 - , executionMemory = 3_400 - } diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs index 57f1333a4e..f084b7da84 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs @@ -65,12 +65,6 @@ prop_roundtrip_praos_nonce_JSON = H.property $ do pNonce <- forAll $ Gen.just genMaybePraosNonce tripping pNonce encode eitherDecode -prop_roundtrip_protocol_parameters_JSON :: Property -prop_roundtrip_protocol_parameters_JSON = H.property $ do - AnyCardanoEra era <- forAll $ Gen.element [minBound .. maxBound] - pp <- forAll (genProtocolParameters era) - tripping pp encode eitherDecode - tests :: TestTree tests = testGroup @@ -83,5 +77,4 @@ tests = , testProperty "json roundtrip txout utxo context" prop_json_roundtrip_txout_utxo_context , testProperty "json roundtrip scriptdata detailed json" prop_json_roundtrip_scriptdata_detailed_json , testProperty "json roundtrip praos nonce" prop_roundtrip_praos_nonce_JSON - , testProperty "json roundtrip protocol parameters" prop_roundtrip_protocol_parameters_JSON ] diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/ProtocolParameters.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/ProtocolParameters.hs deleted file mode 100644 index 480d5291e8..0000000000 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/ProtocolParameters.hs +++ /dev/null @@ -1,220 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} --- TODO remove me when ProtocolParameters is deleted -{-# OPTIONS_GHC -Wno-deprecations #-} - -module Test.Cardano.Api.ProtocolParameters - ( tests - ) -where - -import Cardano.Api (CardanoEra (..), ProtocolParametersConversionError, inEonForEra, - prettyPrintJSON) -import Cardano.Api.Internal.Eon.ShelleyBasedEra (ShelleyBasedEra (..), ShelleyLedgerEra) -import Cardano.Api.Internal.ProtocolParameters (LedgerProtocolParameters (..), - convertToLedgerProtocolParameters, fromLedgerPParams) -import Cardano.Api.Ledger (PParams (..)) - -import Control.Monad (void) -import Data.Aeson (FromJSON, Object, ToJSON, eitherDecode) -import qualified Data.Aeson.Key as Aeson -import qualified Data.Aeson.KeyMap as Aeson -import qualified Data.ByteString.Lazy as LBS -import Data.Foldable as Foldable (foldl') - -import Test.Gen.Cardano.Api.Typed (genProtocolParameters) - -import Hedgehog (Gen, MonadTest, Property, forAll, property, success, (===)) -import Hedgehog.Extras (leftFail) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Hedgehog (testProperty) - --- Originally, cardano-api used a different type than cardano-ledger to represent --- protocol parameters. From conway on, we aim to unify those types and use PParams. --- These tests aim to ensure backwards compatibility between the legacy type ProtocolParams --- and PParams for eras before conway. Conway should use PParams directly, so we don't --- provide any tests for it. -tests :: TestTree -tests = - testGroup - "ProtocolParameter tests" - [ testGroup - "ToJSON instances produce the same" - [ testProperty "ShelleyEra" $ protocolParametersSerializeTheSame ShelleyEra - , testProperty "AlonzoEra" $ protocolParametersSerializeTheSame AlonzoEra - , testProperty "BabbageEra" $ protocolParametersSerializeTheSame BabbageEra - ] - , testGroup - "ProtocolParameters ToJSON can be read by PParams FromJSON" - [ testProperty "ShelleyEra" $ protocolParametersAreCompatible ShelleyEra - , testProperty "AlonzoEra" $ protocolParametersAreCompatible AlonzoEra - , testProperty "BabbageEra" $ protocolParametersAreCompatible BabbageEra - ] - , testGroup - "PParams roundtrip" - [ testProperty "ShelleyEra" $ roundtripBetweenPParamsAndLegacyProtocolParameters ShelleyEra - , testProperty "AlonzoEra" $ roundtripBetweenPParamsAndLegacyProtocolParameters AlonzoEra - , testProperty "BabbageEra" $ roundtripBetweenPParamsAndLegacyProtocolParameters BabbageEra - ] - ] - --- | Compares the JSON serialization of cardano-ledger's PParams and cardano-api's ProtocolParameters and --- | ensures that they are the same (except for the agreed changes specified in `patchProtocolParamsJSONOrFail`) -protocolParametersSerializeTheSame - :: forall era. ToJSON (PParams (ShelleyLedgerEra era)) => CardanoEra era -> Property -protocolParametersSerializeTheSame era = - property $ do - ValidatedSerializedPair - { serializedProtocolParameters - , serializedPParams - } <- - forAll $ genValidSerializedPair era - patchedserializedProtocolParameters <- - patchProtocolParamsJSONOrFail era serializedProtocolParameters - serializedPParams === patchedserializedProtocolParameters - --- | Ensure that cardano-api's legacy ProtocolParameter serialization can be deserialized by cardano-ledger's PParams FromJSON instance -protocolParametersAreCompatible - :: forall era - . ( ToJSON (PParams (ShelleyLedgerEra era)) - , FromJSON (PParams (ShelleyLedgerEra era)) - ) - => CardanoEra era -> Property -protocolParametersAreCompatible era = - property $ do - ValidatedSerializedPair - { serializedProtocolParameters - , serializedPParams = _ - } <- - forAll $ genValidSerializedPair era - void - ( leftFail - (eitherDecode serializedProtocolParameters :: Either String (PParams (ShelleyLedgerEra era))) - ) - success - --- | This tests that, for protocol parameter sets that can roundtrip between PParams and ProtocolParameters --- (i.e. sets of parameters that are valid/work according to the constraints in both PParams and ProtocolParameters --- and their conversion functions), deserializing them using PParams FromJSON instance and then serializing --- again using PParams ToJSON instance results in the same thing. -roundtripBetweenPParamsAndLegacyProtocolParameters - :: forall era - . ( FromJSON (PParams (ShelleyLedgerEra era)) - , ToJSON (PParams (ShelleyLedgerEra era)) - ) - => CardanoEra era -> Property -roundtripBetweenPParamsAndLegacyProtocolParameters era = - property $ do - ValidatedSerializedPair - { serializedProtocolParameters - , serializedPParams = _ - } <- - forAll $ genValidSerializedPair era - patchedserializedProtocolParameters <- - patchProtocolParamsJSONOrFail era serializedProtocolParameters - case eitherDecode serializedProtocolParameters :: Either String (PParams (ShelleyLedgerEra era)) of - Left err -> fail err - Right pParams -> prettyPrintJSON pParams === LBS.toStrict patchedserializedProtocolParameters - -------------------------- --- Auxiliary generator -- -------------------------- - --- | Represents a corresponding pair of serialized protocol parameters in two formats -data ValidatedSerializedPair era = ValidatedSerializedPair - { serializedProtocolParameters :: LBS.ByteString - -- ^ Serialized cardano-api's legacy `ProtocolParameters` as a ByteString. - , serializedPParams :: LBS.ByteString - -- ^ Serialized cardano-ledger's `PParams` as a ByteString. - } - deriving Show - --- | Produces a pair of a valid cardano-api's legacy ProtocolParameters and corresponding cardano-ledger's PParams by doing a round trip -genValidSerializedPair - :: forall era - . ToJSON (PParams (ShelleyLedgerEra era)) => CardanoEra era -> Gen (ValidatedSerializedPair era) -genValidSerializedPair era = do - unrefinedProtocolParameters <- genProtocolParameters era - let mValidatedSerializedPair = - do - unrefinedPParams <- - convertToLedgerProtocolParameters sbe unrefinedProtocolParameters - :: (Either ProtocolParametersConversionError (LedgerProtocolParameters era)) - let refinedProtocolParams = fromLedgerPParams sbe $ unLedgerProtocolParameters unrefinedPParams - refinedPParams <- convertToLedgerProtocolParameters sbe refinedProtocolParams - return $ - ValidatedSerializedPair - { serializedProtocolParameters = LBS.fromStrict $ prettyPrintJSON refinedProtocolParams - , serializedPParams = LBS.fromStrict $ prettyPrintJSON . unLedgerProtocolParameters $ refinedPParams - } - case mValidatedSerializedPair of - Right result -> return result - Left _ -> genValidSerializedPair era - where - sbe :: ShelleyBasedEra era - sbe = toShelleyBased era - - toShelleyBased :: CardanoEra era -> ShelleyBasedEra era - toShelleyBased = inEonForEra (error "Not a Shelley-based era") id - --- Legacy representation of 'ProtocolParameters' in cardano-api is not 100% compatible with --- the 'PParams' representation in cardano-ledger. This functions modifies the JSON object --- produced by the serialization of 'ProtocolParameters' type to match 'PParams' serialization --- format. -patchProtocolParamsJSONOrFail - :: (MonadTest m, MonadFail m) => CardanoEra era -> LBS.ByteString -> m LBS.ByteString -patchProtocolParamsJSONOrFail era s = - LBS.fromStrict . prettyPrintJSON - <$> ( patchProtocolParamRepresentation - =<< leftFail (eitherDecode s) - ) - where - -- We are renaming two of the fields to match the spec. Based on discussion here: - -- https://github.com/IntersectMBO/cardano-ledger/pull/4129#discussion_r1507373498 - patchProtocolParamRepresentation :: MonadFail m => Object -> m Object - patchProtocolParamRepresentation o = do - filters <- filtersForEra era - renameKey "committeeTermLength" "committeeMaxTermLength" - =<< renameKey - "minCommitteeSize" - "committeeMinSize" - (applyFilters filters o) - - -- Legacy ProtocolParams ToJSON renders all fields from all eras in all eras, - -- because it is the same data type for every era. But this is not backwards compatible - -- because it means that new eras can modify the fields in old eras. For this reason, when - -- comparing to PParams we use this function to filter fields that don't belong to - -- particular era we are testing. - filtersForEra :: MonadFail m => CardanoEra era -> m [String] - filtersForEra ShelleyEra = - return - [ "collateralPercentage" - , "costModels" - , "executionUnitPrices" - , "maxBlockExecutionUnits" - , "maxCollateralInputs" - , "maxTxExecutionUnits" - , "maxValueSize" - , "utxoCostPerByte" - ] - filtersForEra AlonzoEra = return ["minUTxOValue"] - filtersForEra BabbageEra = return ["decentralization", "extraPraosEntropy", "minUTxOValue"] - filtersForEra era' = fail $ "filtersForEra is not defined for: " <> show era' - - applyFilters :: [String] -> Object -> Object - applyFilters filters o = Foldable.foldl' (flip Aeson.delete) o (map Aeson.fromString filters) - - -- Renames the key of an entry in a JSON object. - -- If there already is a key with the new name in the object the function fails. - renameKey :: MonadFail m => String -> String -> Object -> m Object - renameKey src dest o = - let srcKey = Aeson.fromString src - destKey = Aeson.fromString dest - in case Aeson.lookup srcKey o of - Nothing -> return o - Just v -> - if Aeson.member destKey o - then fail $ "renameKey failed because there is already an entry with the new name: " <> dest - else return $ Aeson.insert destKey v $ Aeson.delete srcKey o diff --git a/cardano-api/test/cardano-api-test/cardano-api-test.hs b/cardano-api/test/cardano-api-test/cardano-api-test.hs index a386d624c0..1ce3262b39 100644 --- a/cardano-api/test/cardano-api-test/cardano-api-test.hs +++ b/cardano-api/test/cardano-api-test/cardano-api-test.hs @@ -21,7 +21,6 @@ import qualified Test.Cardano.Api.KeysByron import qualified Test.Cardano.Api.Ledger import qualified Test.Cardano.Api.Metadata import qualified Test.Cardano.Api.Ord -import qualified Test.Cardano.Api.ProtocolParameters import qualified Test.Cardano.Api.RawBytes import qualified Test.Cardano.Api.Transaction.Autobalance import qualified Test.Cardano.Api.TxBody @@ -57,7 +56,6 @@ tests = , Test.Cardano.Api.Ledger.tests , Test.Cardano.Api.Metadata.tests , Test.Cardano.Api.Ord.tests - , Test.Cardano.Api.ProtocolParameters.tests , Test.Cardano.Api.RawBytes.tests , Test.Cardano.Api.Transaction.Autobalance.tests , Test.Cardano.Api.TxBody.tests