diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 40bb01183b..17833e6f21 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -150,6 +150,7 @@ import qualified Data.ByteString.Short as SBS import Data.Coerce import Data.Int (Int64) import Data.Map.Strict (Map) +import Data.Maybe import Data.Ratio (Ratio, (%)) import Data.String import Data.Word (Word64) @@ -624,14 +625,12 @@ genStakeAddressRequirements = <*> 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 - ] +genTxUpdateProposal sbe = + Gen.choice $ catMaybes + [ Just $ pure TxUpdateProposalNone + , forEraInEon sbe Nothing $ \w -> + Just $ TxUpdateProposal w <$> genUpdateProposal (toCardanoEra w) + ] genTxMintValue :: CardanoEra era -> Gen (TxMintValue BuildTx era) genTxMintValue = diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index eeb183bd3a..8e2ca6a7ed 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -123,7 +123,6 @@ module Cardano.Api.TxBody ( TxExtraKeyWitnessesSupportedInEra(..), AlonzoEraOnwards(..), WithdrawalsSupportedInEra(..), - UpdateProposalSupportedInEra(..), TxTotalAndReturnCollateralSupportedInEra(..), -- ** Feature availability functions @@ -135,7 +134,6 @@ module Cardano.Api.TxBody ( auxScriptsSupportedInEra, extraKeyWitnessesSupportedInEra, withdrawalsSupportedInEra, - updateProposalSupportedInEra, txScriptValiditySupportedInShelleyBasedEra, txScriptValiditySupportedInCardanoEra, totalAndReturnCollateralSupportedInEra, @@ -184,6 +182,7 @@ import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra +import Cardano.Api.Eon.ShelleyToBabbageEra import Cardano.Api.EraCast import Cardano.Api.Eras.Case import Cardano.Api.Eras.Constraints @@ -1114,35 +1113,6 @@ withdrawalsSupportedInEra AlonzoEra = Just WithdrawalsInAlonzoEra withdrawalsSupportedInEra BabbageEra = Just WithdrawalsInBabbageEra withdrawalsSupportedInEra ConwayEra = Just WithdrawalsInConwayEra --- | A representation of whether the era supports 'UpdateProposal's embedded in --- transactions. --- --- The Shelley and subsequent eras support such update proposals. They Byron --- 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 - -- ---------------------------------------------------------------------------- -- Building vs viewing transactions -- @@ -1542,12 +1512,8 @@ deriving instance Show (TxCertificates build era) -- data TxUpdateProposal era where - - TxUpdateProposalNone :: TxUpdateProposal era - - TxUpdateProposal :: UpdateProposalSupportedInEra era - -> UpdateProposal - -> TxUpdateProposal era + TxUpdateProposalNone :: TxUpdateProposal era + TxUpdateProposal :: ShelleyToBabbageEra era -> UpdateProposal -> TxUpdateProposal era deriving instance Eq (TxUpdateProposal era) deriving instance Show (TxUpdateProposal era) @@ -2530,19 +2496,19 @@ fromLedgerTxBody -> TxBodyContent ViewTx era fromLedgerTxBody sbe scriptValidity body scriptdata mAux = TxBodyContent - { txIns = fromLedgerTxIns sbe body - , txInsCollateral = fromLedgerTxInsCollateral sbe body - , txInsReference = fromLedgerTxInsReference sbe body - , txOuts = fromLedgerTxOuts sbe body scriptdata - , txTotalCollateral = fromLedgerTxTotalCollateral sbe body - , txReturnCollateral = fromLedgerTxReturnCollateral sbe body - , txFee = fromLedgerTxFee sbe body - , txValidityRange = fromLedgerTxValidityRange sbe body - , txWithdrawals = fromLedgerTxWithdrawals sbe body - , txCertificates = fromLedgerTxCertificates sbe body - , txUpdateProposal = fromLedgerTxUpdateProposal sbe body - , txMintValue = fromLedgerTxMintValue sbe body - , txExtraKeyWits = fromLedgerTxExtraKeyWitnesses sbe body + { txIns = fromLedgerTxIns sbe body + , txInsCollateral = fromLedgerTxInsCollateral sbe body + , txInsReference = fromLedgerTxInsReference sbe body + , txOuts = fromLedgerTxOuts sbe body scriptdata + , txTotalCollateral = fromLedgerTxTotalCollateral sbe body + , txReturnCollateral = fromLedgerTxReturnCollateral sbe body + , txFee = fromLedgerTxFee sbe body + , txValidityRange = fromLedgerTxValidityRange sbe body + , txWithdrawals = fromLedgerTxWithdrawals sbe body + , txCertificates = fromLedgerTxCertificates sbe body + , txUpdateProposal = maybeFromLedgerTxUpdateProposal sbe body + , txMintValue = fromLedgerTxMintValue sbe body + , txExtraKeyWits = fromLedgerTxExtraKeyWitnesses sbe body , txProtocolParams = ViewTx , txMetadata , txAuxScripts @@ -3044,48 +3010,19 @@ fromLedgerTxCertificates sbe body = then TxCertificatesNone else TxCertificates sbe (map (fromShelleyCertificate sbe) $ toList certificates) ViewTx -fromLedgerTxUpdateProposal - :: ShelleyBasedEra era +maybeFromLedgerTxUpdateProposal :: () + => ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxUpdateProposal era -fromLedgerTxUpdateProposal sbe body = - case sbe of - ShelleyBasedEraShelley -> - case body ^. L.updateTxBodyL of - SNothing -> TxUpdateProposalNone - SJust p -> - TxUpdateProposal UpdateProposalInShelleyEra - (fromLedgerUpdate sbe p) - - ShelleyBasedEraAllegra -> - case body ^. L.updateTxBodyL of - SNothing -> TxUpdateProposalNone - SJust p -> - TxUpdateProposal UpdateProposalInAllegraEra - (fromLedgerUpdate sbe p) - - ShelleyBasedEraMary -> - case body ^. L.updateTxBodyL of - SNothing -> TxUpdateProposalNone - SJust p -> - TxUpdateProposal UpdateProposalInMaryEra - (fromLedgerUpdate sbe p) - - ShelleyBasedEraAlonzo -> - case body ^. L.updateTxBodyL of - SNothing -> TxUpdateProposalNone - SJust p -> - TxUpdateProposal UpdateProposalInAlonzoEra - (fromLedgerUpdate sbe p) - - ShelleyBasedEraBabbage -> +maybeFromLedgerTxUpdateProposal sbe body = + caseShelleyToBabbageOrConwayEraOnwards + (\w -> case body ^. L.updateTxBodyL of SNothing -> TxUpdateProposalNone - SJust p -> - TxUpdateProposal UpdateProposalInBabbageEra - (fromLedgerUpdate sbe p) - - ShelleyBasedEraConway -> TxUpdateProposalNone + SJust p -> TxUpdateProposal w (fromLedgerUpdate sbe p) + ) + (const TxUpdateProposalNone) + sbe fromLedgerTxMintValue :: ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index b8fc96c719..16f4a359e4 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -390,7 +390,6 @@ module Cardano.Api ( AuxScriptsSupportedInEra(..), TxExtraKeyWitnessesSupportedInEra(..), WithdrawalsSupportedInEra(..), - UpdateProposalSupportedInEra(..), TxTotalAndReturnCollateralSupportedInEra(..), -- ** Feature availability functions @@ -402,7 +401,6 @@ module Cardano.Api ( auxScriptsSupportedInEra, extraKeyWitnessesSupportedInEra, withdrawalsSupportedInEra, - updateProposalSupportedInEra, totalAndReturnCollateralSupportedInEra, -- ** Era-dependent protocol features