From 44704ba89475e9fc1397926247f62c43c0443374 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 13 Apr 2023 10:18:41 +1000 Subject: [PATCH] Unified SupportedInEra --- cardano-api/cardano-api.cabal | 1 + cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 8 +-- cardano-api/src/Cardano/Api.hs | 12 ++--- cardano-api/src/Cardano/Api/Features.hs | 54 +++++++++++++++++++ cardano-api/src/Cardano/Api/TxBody.hs | 53 ------------------ 5 files changed, 63 insertions(+), 65 deletions(-) create mode 100644 cardano-api/src/Cardano/Api/Features.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 2d1dbdb109c..ff454e6e1e7 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -65,6 +65,7 @@ library Cardano.Api.EraCast Cardano.Api.Eras Cardano.Api.Error + Cardano.Api.Features Cardano.Api.Fees Cardano.Api.Genesis Cardano.Api.GenesisParameters diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 788e9c5fc85..4131aa02fd4 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -851,7 +851,7 @@ genProtocolParameters era = do protocolParamPoolPledgeInfluence <- genRationalInt64 protocolParamMonetaryExpansion <- genRational protocolParamTreasuryCut <- genRational - protocolParamUTxOCostPerWord <- sequence $ protocolUTxOCostPerWordSupportedInEra era $> genLovelace + protocolParamUTxOCostPerWord <- sequence $ supportedInEra ProtocolParameterUTxOCostPerWord era $> genLovelace protocolParamCostModels <- pure mempty --TODO: Babbage figure out how to deal with -- asymmetric cost model JSON instances @@ -861,7 +861,7 @@ genProtocolParameters era = do protocolParamMaxValueSize <- Gen.maybe genNat protocolParamCollateralPercent <- Gen.maybe genNat protocolParamMaxCollateralInputs <- Gen.maybe genNat - protocolParamUTxOCostPerByte <- sequence $ protocolUTxOCostPerByteSupportedInEra era $> genLovelace + protocolParamUTxOCostPerByte <- sequence $ supportedInEra ProtocolParameterUTxOCostPerByte era $> genLovelace pure ProtocolParameters {..} @@ -884,7 +884,7 @@ genProtocolParametersUpdate era = do protocolUpdatePoolPledgeInfluence <- Gen.maybe genRationalInt64 protocolUpdateMonetaryExpansion <- Gen.maybe genRational protocolUpdateTreasuryCut <- Gen.maybe genRational - protocolUpdateUTxOCostPerWord <- sequence $ protocolUTxOCostPerWordSupportedInEra era $> genLovelace + protocolUpdateUTxOCostPerWord <- sequence $ supportedInEra ProtocolParameterUTxOCostPerWord era $> genLovelace let protocolUpdateCostModels = mempty -- genCostModels --TODO: Babbage figure out how to deal with -- asymmetric cost model JSON instances @@ -894,7 +894,7 @@ genProtocolParametersUpdate era = do protocolUpdateMaxValueSize <- Gen.maybe genNat protocolUpdateCollateralPercent <- Gen.maybe genNat protocolUpdateMaxCollateralInputs <- Gen.maybe genNat - protocolUpdateUTxOCostPerByte <- sequence $ protocolUTxOCostPerByteSupportedInEra era $> genLovelace + protocolUpdateUTxOCostPerByte <- sequence $ supportedInEra ProtocolParameterUTxOCostPerByte era $> genLovelace pure ProtocolParametersUpdate{..} diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 4b29174353e..02bbde5a2bd 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -269,6 +269,8 @@ module Cardano.Api ( CertificatesSupportedInEra(..), UpdateProposalSupportedInEra(..), TxTotalAndReturnCollateralSupportedInEra(..), + Feature(..), + SupportedInEra(..), -- ** Feature availability functions collateralSupportedInEra, @@ -285,14 +287,7 @@ module Cardano.Api ( updateProposalSupportedInEra, scriptDataSupportedInEra, totalAndReturnCollateralSupportedInEra, - - -- ** Era-dependent protocol features - ProtocolUTxOCostPerByteSupportedInEra(..), - ProtocolUTxOCostPerWordSupportedInEra(..), - - -- ** Era-dependent protocol feature availability functions - protocolUTxOCostPerByteSupportedInEra, - protocolUTxOCostPerWordSupportedInEra, + supportedInEra, -- ** Fee calculation LedgerEpochInfo(..), @@ -830,6 +825,7 @@ import Cardano.Api.Environment import Cardano.Api.EraCast import Cardano.Api.Eras import Cardano.Api.Error +import Cardano.Api.Features import Cardano.Api.Fees import Cardano.Api.GenesisParameters import Cardano.Api.Hash diff --git a/cardano-api/src/Cardano/Api/Features.hs b/cardano-api/src/Cardano/Api/Features.hs new file mode 100644 index 00000000000..f85ebe83f75 --- /dev/null +++ b/cardano-api/src/Cardano/Api/Features.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Cardano.Api.Features + ( Feature(..) + , SupportedInEra(..) + , supportedInEra + ) where + +import Cardano.Api.Eras +import Data.Aeson (ToJSON (..)) + +data ProtocolParameterUTxOCostPerWord + +data ProtocolParameterUTxOCostPerByte + +-- | A representation of a feature that is supported in a given era. +data Feature f where + ProtocolParameterUTxOCostPerWord :: Feature ProtocolParameterUTxOCostPerWord + ProtocolParameterUTxOCostPerByte :: Feature ProtocolParameterUTxOCostPerByte + +deriving instance Eq (Feature f) +deriving instance Show (Feature f) + +instance ToJSON (Feature f) where + toJSON = toJSON . show + +-- | A representation of a feature whether a feature is supported in a given era. +data SupportedInEra f era where + ProtocolParameterUTxOCostPerWordSupportedInAlonzoEra :: SupportedInEra ProtocolParameterUTxOCostPerWord AlonzoEra + + ProtocolParameterUTxOCostPerByteSupportedInBabbageEra :: SupportedInEra ProtocolParameterUTxOCostPerByte BabbageEra + ProtocolParameterUTxOCostPerByteSupportedInConwayEra :: SupportedInEra ProtocolParameterUTxOCostPerByte ConwayEra + +deriving instance Eq (SupportedInEra f era) +deriving instance Show (SupportedInEra f era) + +instance ToJSON (SupportedInEra f era) where + toJSON = toJSON . show + +-- | Determine whether a feature is supported in a given era. +-- +-- If the feature is not supported in the given era, 'Nothing' is returned. +supportedInEra + :: Feature f + -> CardanoEra era + -> Maybe (SupportedInEra f era) + +supportedInEra ProtocolParameterUTxOCostPerWord AlonzoEra = Just ProtocolParameterUTxOCostPerWordSupportedInAlonzoEra + +supportedInEra ProtocolParameterUTxOCostPerByte BabbageEra = Just ProtocolParameterUTxOCostPerByteSupportedInBabbageEra +supportedInEra ProtocolParameterUTxOCostPerByte ConwayEra = Just ProtocolParameterUTxOCostPerByteSupportedInConwayEra + +supportedInEra _ _ = Nothing diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index db7dd382159..85c1610953d 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -148,14 +148,6 @@ module Cardano.Api.TxBody ( txScriptValiditySupportedInCardanoEra, totalAndReturnCollateralSupportedInEra, - -- ** Era-dependent protocol features - ProtocolUTxOCostPerByteSupportedInEra(..), - ProtocolUTxOCostPerWordSupportedInEra(..), - - -- ** Era-dependent protocol feature availability functions - protocolUTxOCostPerByteSupportedInEra, - protocolUTxOCostPerWordSupportedInEra, - -- * Inspecting 'ScriptWitness'es AnyScriptWitness(..), ScriptWitnessIndex(..), @@ -1317,51 +1309,6 @@ updateProposalSupportedInEra AlonzoEra = Just UpdateProposalInAlonzoEra updateProposalSupportedInEra BabbageEra = Just UpdateProposalInBabbageEra updateProposalSupportedInEra ConwayEra = Just UpdateProposalInConwayEra --- | 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 ProtocolUTxOCostPerWordSupportedInEra era where - ProtocolUpdateUTxOCostPerWordInAlonzoEra :: ProtocolUTxOCostPerWordSupportedInEra AlonzoEra - -deriving instance Eq (ProtocolUTxOCostPerWordSupportedInEra era) -deriving instance Show (ProtocolUTxOCostPerWordSupportedInEra era) - -protocolUTxOCostPerWordSupportedInEra - :: CardanoEra era - -> Maybe (ProtocolUTxOCostPerWordSupportedInEra era) -protocolUTxOCostPerWordSupportedInEra ByronEra = Nothing -protocolUTxOCostPerWordSupportedInEra ShelleyEra = Nothing -protocolUTxOCostPerWordSupportedInEra AllegraEra = Nothing -protocolUTxOCostPerWordSupportedInEra MaryEra = Nothing -protocolUTxOCostPerWordSupportedInEra AlonzoEra = Just ProtocolUpdateUTxOCostPerWordInAlonzoEra -protocolUTxOCostPerWordSupportedInEra BabbageEra = Nothing -protocolUTxOCostPerWordSupportedInEra ConwayEra = Nothing - --- | A representation of whether the era supports the 'UTxO Cost Per Byte' --- protocol parameter. --- --- The Babbage and subsequent eras support such a protocol parameter. --- -data ProtocolUTxOCostPerByteSupportedInEra era where - ProtocolUpdateUTxOCostPerByteInBabbageEra :: ProtocolUTxOCostPerByteSupportedInEra BabbageEra - ProtocolUpdateUTxOCostPerByteInConwayEra :: ProtocolUTxOCostPerByteSupportedInEra ConwayEra - -deriving instance Eq (ProtocolUTxOCostPerByteSupportedInEra era) -deriving instance Show (ProtocolUTxOCostPerByteSupportedInEra era) - -protocolUTxOCostPerByteSupportedInEra - :: CardanoEra era - -> Maybe (ProtocolUTxOCostPerByteSupportedInEra era) -protocolUTxOCostPerByteSupportedInEra ByronEra = Nothing -protocolUTxOCostPerByteSupportedInEra ShelleyEra = Nothing -protocolUTxOCostPerByteSupportedInEra AllegraEra = Nothing -protocolUTxOCostPerByteSupportedInEra MaryEra = Nothing -protocolUTxOCostPerByteSupportedInEra AlonzoEra = Nothing -protocolUTxOCostPerByteSupportedInEra BabbageEra = Just ProtocolUpdateUTxOCostPerByteInBabbageEra -protocolUTxOCostPerByteSupportedInEra ConwayEra = Just ProtocolUpdateUTxOCostPerByteInConwayEra - -- ---------------------------------------------------------------------------- -- Building vs viewing transactions --