From 5f005f857c021f13b381b3e597217663e0c977f1 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 22 Sep 2023 21:27:20 +1000 Subject: [PATCH] Replace CertificatesSupportedInEra with ShelleyBasedEra --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 24 ++--- cardano-api/internal/Cardano/Api/TxBody.hs | 102 +++--------------- cardano-api/src/Cardano/Api.hs | 2 - 3 files changed, 23 insertions(+), 105 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index fd631451f6..acbaf2d087 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -592,19 +592,17 @@ genTxWithdrawals era = ] genTxCertificates :: CardanoEra era -> Gen (TxCertificates BuildTx era) -genTxCertificates era = - case certificatesSupportedInEra era of - Nothing -> pure TxCertificatesNone - Just supported -> - case cardanoEraStyle era of - LegacyByronEra -> pure TxCertificatesNone - ShelleyBasedEra sbe -> do - certs <- Gen.list (Range.constant 0 3) $ genCertificate sbe - Gen.choice - [ pure TxCertificatesNone - , pure (TxCertificates supported certs $ BuildTxWith mempty) - -- TODO: Generate certificates - ] +genTxCertificates = + inEonForEra + (pure TxCertificatesNone) + (\w -> do + certs <- Gen.list (Range.constant 0 3) $ genCertificate w + Gen.choice + [ pure TxCertificatesNone + , pure (TxCertificates w certs $ BuildTxWith mempty) + -- TODO: Generate certificates + ] + ) -- TODO: Add remaining certificates -- TODO: This should be parameterised on ShelleyBasedEra diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 4af91ad5ca..0c6faf5a2a 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -125,7 +125,6 @@ module Cardano.Api.TxBody ( TxExtraKeyWitnessesSupportedInEra(..), ScriptDataSupportedInEra(..), WithdrawalsSupportedInEra(..), - CertificatesSupportedInEra(..), UpdateProposalSupportedInEra(..), TxTotalAndReturnCollateralSupportedInEra(..), @@ -140,7 +139,6 @@ module Cardano.Api.TxBody ( extraKeyWitnessesSupportedInEra, scriptDataSupportedInEra, withdrawalsSupportedInEra, - certificatesSupportedInEra, updateProposalSupportedInEra, txScriptValiditySupportedInShelleyBasedEra, txScriptValiditySupportedInCardanoEra, @@ -1252,35 +1250,6 @@ withdrawalsSupportedInEra AlonzoEra = Just WithdrawalsInAlonzoEra withdrawalsSupportedInEra BabbageEra = Just WithdrawalsInBabbageEra withdrawalsSupportedInEra ConwayEra = Just WithdrawalsInConwayEra - --- | A representation of whether the era supports 'Certificate's embedded in --- transactions. --- --- The Shelley and subsequent eras support such certificates. --- -data CertificatesSupportedInEra era where - - CertificatesInShelleyEra :: CertificatesSupportedInEra ShelleyEra - CertificatesInAllegraEra :: CertificatesSupportedInEra AllegraEra - CertificatesInMaryEra :: CertificatesSupportedInEra MaryEra - CertificatesInAlonzoEra :: CertificatesSupportedInEra AlonzoEra - CertificatesInBabbageEra :: CertificatesSupportedInEra BabbageEra - CertificatesInConwayEra :: CertificatesSupportedInEra ConwayEra - -deriving instance Eq (CertificatesSupportedInEra era) -deriving instance Show (CertificatesSupportedInEra era) - -certificatesSupportedInEra :: CardanoEra era - -> Maybe (CertificatesSupportedInEra era) -certificatesSupportedInEra ByronEra = Nothing -certificatesSupportedInEra ShelleyEra = Just CertificatesInShelleyEra -certificatesSupportedInEra AllegraEra = Just CertificatesInAllegraEra -certificatesSupportedInEra MaryEra = Just CertificatesInMaryEra -certificatesSupportedInEra AlonzoEra = Just CertificatesInAlonzoEra -certificatesSupportedInEra BabbageEra = Just CertificatesInBabbageEra -certificatesSupportedInEra ConwayEra = Just CertificatesInConwayEra - - -- | A representation of whether the era supports 'UpdateProposal's embedded in -- transactions. -- @@ -1687,13 +1656,14 @@ deriving instance Show (TxWithdrawals build era) data TxCertificates build era where - TxCertificatesNone :: TxCertificates build era + TxCertificatesNone + :: TxCertificates build era - TxCertificates :: CertificatesSupportedInEra era - -> [Certificate era] - -> BuildTxWith build - (Map StakeCredential (Witness WitCtxStake era)) - -> TxCertificates build era + TxCertificates + :: ShelleyBasedEra era + -> [Certificate era] + -> BuildTxWith build (Map StakeCredential (Witness WitCtxStake era)) + -> TxCertificates build era deriving instance Eq (TxCertificates build era) deriving instance Show (TxCertificates build era) @@ -3210,59 +3180,11 @@ fromLedgerTxCertificates -> Ledger.TxBody (ShelleyLedgerEra era) -> TxCertificates ViewTx era fromLedgerTxCertificates sbe body = - case sbe of - ShelleyBasedEraShelley - | null certificates -> TxCertificatesNone - | otherwise -> - TxCertificates - CertificatesInShelleyEra - (map (fromShelleyCertificate sbe) $ toList certificates) - ViewTx - where - certificates = body ^. L.certsTxBodyL - - ShelleyBasedEraAllegra - | null certificates -> TxCertificatesNone - | otherwise -> - TxCertificates - CertificatesInAllegraEra - (map (fromShelleyCertificate sbe) $ toList certificates) - ViewTx - where - certificates = body ^. L.certsTxBodyL - - ShelleyBasedEraMary - | null certificates -> TxCertificatesNone - | otherwise -> - TxCertificates - CertificatesInMaryEra - (map (fromShelleyCertificate sbe) $ toList certificates) - ViewTx - where - certificates = body ^. L.certsTxBodyL - - ShelleyBasedEraAlonzo - | null certificates -> TxCertificatesNone - | otherwise -> - TxCertificates - CertificatesInAlonzoEra - (map (fromShelleyCertificate sbe) $ toList certificates) - ViewTx - where - certificates = body ^. L.certsTxBodyL - - ShelleyBasedEraBabbage - | null certificates -> TxCertificatesNone - | otherwise -> - TxCertificates - CertificatesInBabbageEra - (map (fromShelleyCertificate sbe) $ toList certificates) - ViewTx - where - certificates = body ^. L.certsTxBodyL - - -- TODO: Implement once certificates are done in Conway. - ShelleyBasedEraConway -> TxCertificatesNone + shelleyBasedEraConstraints sbe $ + let certificates = body ^. L.certsTxBodyL in + if null certificates + then TxCertificatesNone + else TxCertificates sbe (map (fromShelleyCertificate sbe) $ toList certificates) ViewTx fromLedgerTxUpdateProposal :: ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 8e9bf7f3f9..a14bf96962 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -352,7 +352,6 @@ module Cardano.Api ( TxExtraKeyWitnessesSupportedInEra(..), ScriptDataSupportedInEra(..), WithdrawalsSupportedInEra(..), - CertificatesSupportedInEra(..), UpdateProposalSupportedInEra(..), TxTotalAndReturnCollateralSupportedInEra(..), @@ -366,7 +365,6 @@ module Cardano.Api ( auxScriptsSupportedInEra, extraKeyWitnessesSupportedInEra, withdrawalsSupportedInEra, - certificatesSupportedInEra, updateProposalSupportedInEra, scriptDataSupportedInEra, totalAndReturnCollateralSupportedInEra,