From f25d117e145dc3d7a72af16f3ebeebf6de689e1b Mon Sep 17 00:00:00 2001 From: John Ky Date: Mon, 5 Jun 2023 16:04:37 +1000 Subject: [PATCH] Convert UpdateProposalFeatureSupportedInEra to UpdateProposalFeature using new Feature API. --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 13 +-- cardano-api/internal/Cardano/Api/Fees.hs | 4 +- cardano-api/internal/Cardano/Api/TxBody.hs | 108 +++++++----------- cardano-api/src/Cardano/Api.hs | 4 +- 4 files changed, 44 insertions(+), 85 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index c1c8f14dcd..7f9a24ae16 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -98,7 +98,6 @@ module Test.Gen.Cardano.Api.Typed , genTxOutValue , genTxReturnCollateral , genTxTotalCollateral - , genTxUpdateProposal , genTxValidityLowerBound , genTxValidityRange , genTxValidityUpperBound @@ -604,16 +603,6 @@ genCertificate = , StakeAddressDeregistrationCertificate <$> genStakeCredential ] -genTxUpdateProposal :: CardanoEra era -> Gen (TxUpdateProposal era) -genTxUpdateProposal era = - case updateProposalSupportedInEra era of - Nothing -> pure TxUpdateProposalNone - Just supported -> - Gen.choice - [ pure TxUpdateProposalNone - , TxUpdateProposal supported <$> genUpdateProposal era - ] - genTxMintValue :: CardanoEra era -> Gen (TxMintValue BuildTx era) genTxMintValue era = case multiAssetSupportedInEra era of @@ -640,7 +629,7 @@ genTxBodyContent era = do txProtocolParams <- BuildTxWith <$> Gen.maybe (genValidProtocolParameters era) txWithdrawals <- genTxWithdrawals era txCertificates <- genTxCertificates era - txUpdateProposal <- genTxUpdateProposal era + txUpdateProposal <- genFeatureValueInEra (genUpdateProposal era) era txMintValue <- genTxMintValue era txScriptValidity <- genFeatureValueInEra genScriptValidity era diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 6c204e340f..3a1761a3fa 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -304,9 +304,9 @@ estimateTransactionKeyWitnessCount TxBodyContent { _ -> 0 + case txUpdateProposal of - TxUpdateProposal _ (UpdateProposal updatePerGenesisKey _) + FeatureValue _ (UpdateProposal updatePerGenesisKey _) -> Map.size updatePerGenesisKey - _ -> 0 + NoFeatureValue -> 0 -- ---------------------------------------------------------------------------- diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 98f5db54b4..90cb639b0e 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -104,7 +104,6 @@ module Cardano.Api.TxBody ( TxExtraKeyWitnesses(..), TxWithdrawals(..), TxCertificates(..), - TxUpdateProposal(..), TxMintValue(..), -- ** Building vs viewing transactions @@ -127,7 +126,7 @@ module Cardano.Api.TxBody ( ScriptDataSupportedInEra(..), WithdrawalsSupportedInEra(..), CertificatesSupportedInEra(..), - UpdateProposalSupportedInEra(..), + UpdateProposalFeature(..), TxTotalAndReturnCollateralSupportedInEra(..), -- ** Feature availability functions @@ -143,7 +142,6 @@ module Cardano.Api.TxBody ( scriptDataSupportedInEra, withdrawalsSupportedInEra, certificatesSupportedInEra, - updateProposalSupportedInEra, totalAndReturnCollateralSupportedInEra, -- * Inspecting 'ScriptWitness'es @@ -1247,27 +1245,26 @@ certificatesSupportedInEra ConwayEra = Just CertificatesInConwayEra -- era has a notion of an update proposal, but it is a standalone chain object -- and not embedded in a transaction. -- -data UpdateProposalSupportedInEra era where - - UpdateProposalInShelleyEra :: UpdateProposalSupportedInEra ShelleyEra - UpdateProposalInAllegraEra :: UpdateProposalSupportedInEra AllegraEra - UpdateProposalInMaryEra :: UpdateProposalSupportedInEra MaryEra - UpdateProposalInAlonzoEra :: UpdateProposalSupportedInEra AlonzoEra - UpdateProposalInBabbageEra :: UpdateProposalSupportedInEra BabbageEra - UpdateProposalInConwayEra :: UpdateProposalSupportedInEra ConwayEra - -deriving instance Eq (UpdateProposalSupportedInEra era) -deriving instance Show (UpdateProposalSupportedInEra era) - -updateProposalSupportedInEra :: CardanoEra era - -> Maybe (UpdateProposalSupportedInEra era) -updateProposalSupportedInEra ByronEra = Nothing -updateProposalSupportedInEra ShelleyEra = Just UpdateProposalInShelleyEra -updateProposalSupportedInEra AllegraEra = Just UpdateProposalInAllegraEra -updateProposalSupportedInEra MaryEra = Just UpdateProposalInMaryEra -updateProposalSupportedInEra AlonzoEra = Just UpdateProposalInAlonzoEra -updateProposalSupportedInEra BabbageEra = Just UpdateProposalInBabbageEra -updateProposalSupportedInEra ConwayEra = Just UpdateProposalInConwayEra +data UpdateProposalFeature era where + UpdateProposalInShelleyEra :: UpdateProposalFeature ShelleyEra + UpdateProposalInAllegraEra :: UpdateProposalFeature AllegraEra + UpdateProposalInMaryEra :: UpdateProposalFeature MaryEra + UpdateProposalInAlonzoEra :: UpdateProposalFeature AlonzoEra + UpdateProposalInBabbageEra :: UpdateProposalFeature BabbageEra + UpdateProposalInConwayEra :: UpdateProposalFeature ConwayEra + +deriving instance Eq (UpdateProposalFeature era) +deriving instance Show (UpdateProposalFeature era) + +instance FeatureInEra UpdateProposalFeature where + featureInEra no yes = \case + ByronEra -> no + ShelleyEra -> yes UpdateProposalInShelleyEra + AllegraEra -> yes UpdateProposalInAllegraEra + MaryEra -> yes UpdateProposalInMaryEra + AlonzoEra -> yes UpdateProposalInAlonzoEra + BabbageEra -> yes UpdateProposalInBabbageEra + ConwayEra -> yes UpdateProposalInConwayEra -- ---------------------------------------------------------------------------- -- Building vs viewing transactions @@ -1662,21 +1659,6 @@ data TxCertificates build era where deriving instance Eq (TxCertificates build era) deriving instance Show (TxCertificates build era) --- ---------------------------------------------------------------------------- --- Transaction update proposal (era-dependent) --- - -data TxUpdateProposal era where - - TxUpdateProposalNone :: TxUpdateProposal era - - TxUpdateProposal :: UpdateProposalSupportedInEra era - -> UpdateProposal - -> TxUpdateProposal era - -deriving instance Eq (TxUpdateProposal era) -deriving instance Show (TxUpdateProposal era) - -- ---------------------------------------------------------------------------- -- Value minting within transactions (era-dependent) -- @@ -1715,7 +1697,7 @@ data TxBodyContent build era = txProtocolParams :: BuildTxWith build (Maybe ProtocolParameters), txWithdrawals :: TxWithdrawals build era, txCertificates :: TxCertificates build era, - txUpdateProposal :: TxUpdateProposal era, + txUpdateProposal :: FeatureValue UpdateProposalFeature era UpdateProposal, txMintValue :: TxMintValue build era, txScriptValidity :: FeatureValue TxScriptValidityFeature era ScriptValidity } @@ -1737,7 +1719,7 @@ defaultTxBodyContent = TxBodyContent , txProtocolParams = BuildTxWith Nothing , txWithdrawals = TxWithdrawalsNone , txCertificates = TxCertificatesNone - , txUpdateProposal = TxUpdateProposalNone + , txUpdateProposal = NoFeatureValue , txMintValue = TxMintNone , txScriptValidity = NoFeatureValue } @@ -1796,7 +1778,7 @@ setTxWithdrawals v txBodyContent = txBodyContent { txWithdrawals = v } setTxCertificates :: TxCertificates build era -> TxBodyContent build era -> TxBodyContent build era setTxCertificates v txBodyContent = txBodyContent { txCertificates = v } -setTxUpdateProposal :: TxUpdateProposal era -> TxBodyContent build era -> TxBodyContent build era +setTxUpdateProposal :: FeatureValue UpdateProposalFeature era UpdateProposal -> TxBodyContent build era -> TxBodyContent build era setTxUpdateProposal v txBodyContent = txBodyContent { txUpdateProposal = v } setTxMintValue :: TxMintValue build era -> TxBodyContent build era -> TxBodyContent build era @@ -3251,45 +3233,35 @@ fromLedgerTxCertificates era body = fromLedgerTxUpdateProposal :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) - -> TxUpdateProposal era + -> FeatureValue UpdateProposalFeature era UpdateProposal fromLedgerTxUpdateProposal era body = case era of ShelleyBasedEraShelley -> case body ^. L.updateTxBodyL of - SNothing -> TxUpdateProposalNone - SJust p -> - TxUpdateProposal UpdateProposalInShelleyEra - (fromLedgerUpdate era p) + SNothing -> NoFeatureValue + SJust p -> FeatureValue UpdateProposalInShelleyEra (fromLedgerUpdate era p) ShelleyBasedEraAllegra -> case body ^. L.updateTxBodyL of - SNothing -> TxUpdateProposalNone - SJust p -> - TxUpdateProposal UpdateProposalInAllegraEra - (fromLedgerUpdate era p) + SNothing -> NoFeatureValue + SJust p -> FeatureValue UpdateProposalInAllegraEra (fromLedgerUpdate era p) ShelleyBasedEraMary -> case body ^. L.updateTxBodyL of - SNothing -> TxUpdateProposalNone - SJust p -> - TxUpdateProposal UpdateProposalInMaryEra - (fromLedgerUpdate era p) + SNothing -> NoFeatureValue + SJust p -> FeatureValue UpdateProposalInMaryEra (fromLedgerUpdate era p) ShelleyBasedEraAlonzo -> case body ^. L.updateTxBodyL of - SNothing -> TxUpdateProposalNone - SJust p -> - TxUpdateProposal UpdateProposalInAlonzoEra - (fromLedgerUpdate era p) + SNothing -> NoFeatureValue + SJust p -> FeatureValue UpdateProposalInAlonzoEra (fromLedgerUpdate era p) ShelleyBasedEraBabbage -> case body ^. L.updateTxBodyL of - SNothing -> TxUpdateProposalNone - SJust p -> - TxUpdateProposal UpdateProposalInBabbageEra - (fromLedgerUpdate era p) + SNothing -> NoFeatureValue + SJust p -> FeatureValue UpdateProposalInBabbageEra (fromLedgerUpdate era p) - ShelleyBasedEraConway -> TxUpdateProposalNone + ShelleyBasedEraConway -> NoFeatureValue fromLedgerTxMintValue :: ShelleyBasedEra era @@ -3368,7 +3340,7 @@ getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) = , txProtocolParams = ViewTx , txWithdrawals = TxWithdrawalsNone , txCertificates = TxCertificatesNone - , txUpdateProposal = TxUpdateProposalNone + , txUpdateProposal = NoFeatureValue , txMintValue = TxMintNone , txScriptValidity = NoFeatureValue } @@ -3463,13 +3435,13 @@ convTxUpdateProposal :: forall era ledgerera. ShelleyLedgerEra era ~ ledgerera => Ledger.EraCrypto ledgerera ~ StandardCrypto => ShelleyBasedEra era - -> TxUpdateProposal era + -> FeatureValue UpdateProposalFeature era UpdateProposal -> Either TxBodyError (StrictMaybe (Ledger.Update ledgerera)) -- ^ 'Left' when there's protocol params conversion error, 'Right' otherwise, 'Right SNothing' means that -- there's no update proposal convTxUpdateProposal era = \case - TxUpdateProposalNone -> Right SNothing - TxUpdateProposal _ p -> bimap TxBodyProtocolParamsConversionError pure $ toLedgerUpdate era p + NoFeatureValue -> Right SNothing + FeatureValue _ p -> bimap TxBodyProtocolParamsConversionError pure $ toLedgerUpdate era p convMintValue :: TxMintValue build era -> MultiAsset StandardCrypto convMintValue txMintValue = diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index e1d0cdcaa8..c5ab84f6c2 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -252,7 +252,6 @@ module Cardano.Api ( TxExtraKeyWitnesses(..), TxWithdrawals(..), TxCertificates(..), - TxUpdateProposal(..), TxMintValue(..), -- ** Building vs viewing transactions @@ -275,7 +274,7 @@ module Cardano.Api ( ScriptDataSupportedInEra(..), WithdrawalsSupportedInEra(..), CertificatesSupportedInEra(..), - UpdateProposalSupportedInEra(..), + UpdateProposalFeature(..), TxTotalAndReturnCollateralSupportedInEra(..), FeatureInEra(..), @@ -291,7 +290,6 @@ module Cardano.Api ( extraKeyWitnessesSupportedInEra, withdrawalsSupportedInEra, certificatesSupportedInEra, - updateProposalSupportedInEra, scriptDataSupportedInEra, totalAndReturnCollateralSupportedInEra,