Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Replace CertificatesSupportedInEra with ShelleyBasedEra #259

Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 11 additions & 13 deletions cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
102 changes: 12 additions & 90 deletions cardano-api/internal/Cardano/Api/TxBody.hs
Original file line number Diff line number Diff line change
Expand Up @@ -125,7 +125,6 @@ module Cardano.Api.TxBody (
TxExtraKeyWitnessesSupportedInEra(..),
ScriptDataSupportedInEra(..),
WithdrawalsSupportedInEra(..),
CertificatesSupportedInEra(..),
UpdateProposalSupportedInEra(..),
TxTotalAndReturnCollateralSupportedInEra(..),

Expand All @@ -140,7 +139,6 @@ module Cardano.Api.TxBody (
extraKeyWitnessesSupportedInEra,
scriptDataSupportedInEra,
withdrawalsSupportedInEra,
certificatesSupportedInEra,
updateProposalSupportedInEra,
txScriptValiditySupportedInShelleyBasedEra,
txScriptValiditySupportedInCardanoEra,
Expand Down Expand Up @@ -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.
--
Expand Down Expand Up @@ -1687,13 +1656,14 @@ deriving instance Show (TxWithdrawals build era)

data TxCertificates build era where
Copy link
Contributor

@carbolymer carbolymer Sep 25, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can we replace this with

Suggested change
data TxCertificates build era where
type TxCertificates build era
= Featured ShelleyBasedEra era
( [Certificate era]
, BuildTxWith build (Map StakeCredential (Witness WitCtxStake era))
)

?

Feels like it would simplify era-witness checking down the line.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yep. Can do that in a future commit.

Copy link
Contributor

@Jimbo4350 Jimbo4350 Sep 26, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Please don't. Having this as a data definition makes it clearer what it is when using it.


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)
Expand Down Expand Up @@ -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
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This function is simplified via the use of shelleyBasedEraConstraints.


fromLedgerTxUpdateProposal
:: ShelleyBasedEra era
Expand Down
2 changes: 0 additions & 2 deletions cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -352,7 +352,6 @@ module Cardano.Api (
TxExtraKeyWitnessesSupportedInEra(..),
ScriptDataSupportedInEra(..),
WithdrawalsSupportedInEra(..),
CertificatesSupportedInEra(..),
UpdateProposalSupportedInEra(..),
TxTotalAndReturnCollateralSupportedInEra(..),

Expand All @@ -366,7 +365,6 @@ module Cardano.Api (
auxScriptsSupportedInEra,
extraKeyWitnessesSupportedInEra,
withdrawalsSupportedInEra,
certificatesSupportedInEra,
updateProposalSupportedInEra,
scriptDataSupportedInEra,
totalAndReturnCollateralSupportedInEra,
Expand Down