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

Deprecate shelleyCertificateConstraints and conwayCertificateConstraints #155

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
34 changes: 15 additions & 19 deletions cardano-api/internal/Cardano/Api/Certificate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -331,10 +331,10 @@ makeStakeAddressRegistrationCertificate :: StakeAddressRequirements era -> Certi
makeStakeAddressRegistrationCertificate req =
case req of
StakeAddrRegistrationPreConway atMostEra scred ->
shelleyCertificateConstraints atMostEra
shelleyToBabbageEraConstraints atMostEra
$ makeStakeAddressRegistrationCertificatePreConway atMostEra scred
StakeAddrRegistrationConway cOnwards ll scred ->
conwayCertificateConstraints cOnwards
conwayEraOnwardsConstraints cOnwards
$ makeStakeAddressRegistrationCertificatePostConway cOnwards scred ll
where
makeStakeAddressRegistrationCertificatePreConway :: ()
Expand Down Expand Up @@ -365,11 +365,11 @@ makeStakeAddressUnregistrationCertificate :: StakeAddressRequirements era -> Cer
makeStakeAddressUnregistrationCertificate req =
case req of
StakeAddrRegistrationConway cOnwards ll scred ->
conwayCertificateConstraints cOnwards
conwayEraOnwardsConstraints cOnwards
$ makeStakeAddressDeregistrationCertificatePostConway cOnwards scred ll

StakeAddrRegistrationPreConway atMostEra scred ->
shelleyCertificateConstraints atMostEra
shelleyToBabbageEraConstraints atMostEra
$ makeStakeAddressDeregistrationCertificatePreConway atMostEra scred
where
makeStakeAddressDeregistrationCertificatePreConway
Expand Down Expand Up @@ -442,12 +442,12 @@ makeStakeAddressDelegationCertificate :: StakeDelegationRequirements era -> Cert
makeStakeAddressDelegationCertificate req =
case req of
StakeDelegationRequirementsConwayOnwards cOnwards scred delegatee ->
conwayCertificateConstraints cOnwards
conwayEraOnwardsConstraints cOnwards
$ ConwayCertificate cOnwards
$ Ledger.mkDelegTxCert (toShelleyStakeCredential scred) delegatee

StakeDelegationRequirementsPreConway atMostBabbage scred pid ->
shelleyCertificateConstraints atMostBabbage
shelleyToBabbageEraConstraints atMostBabbage
$ ShelleyRelatedCertificate atMostBabbage
$ Ledger.mkDelegStakeTxCert (toShelleyStakeCredential scred) (unStakePoolKeyHash pid)

Expand All @@ -468,11 +468,11 @@ makeStakePoolRegistrationCertificate :: ()
makeStakePoolRegistrationCertificate req =
case req of
StakePoolRegistrationRequirementsConwayOnwards cOnwards poolParams ->
conwayCertificateConstraints cOnwards
conwayEraOnwardsConstraints cOnwards
$ ConwayCertificate cOnwards
$ Ledger.mkRegPoolTxCert poolParams
StakePoolRegistrationRequirementsPreConway atMostBab poolParams ->
shelleyCertificateConstraints atMostBab
shelleyToBabbageEraConstraints atMostBab
$ ShelleyRelatedCertificate atMostBab
$ Ledger.mkRegPoolTxCert poolParams

Expand All @@ -495,11 +495,11 @@ makeStakePoolRetirementCertificate :: ()
makeStakePoolRetirementCertificate req =
case req of
StakePoolRetirementRequirementsPreConway atMostBab poolId retirementEpoch ->
shelleyCertificateConstraints atMostBab
shelleyToBabbageEraConstraints atMostBab
$ ShelleyRelatedCertificate atMostBab
$ Ledger.mkRetirePoolTxCert (unStakePoolKeyHash poolId) retirementEpoch
StakePoolRetirementRequirementsConwayOnwards atMostBab poolId retirementEpoch ->
conwayCertificateConstraints atMostBab
conwayEraOnwardsConstraints atMostBab
$ ConwayCertificate atMostBab
$ Ledger.mkRetirePoolTxCert (unStakePoolKeyHash poolId) retirementEpoch

Expand All @@ -515,7 +515,7 @@ makeGenesisKeyDelegationCertificate :: GenesisKeyDelegationRequirements era -> C
makeGenesisKeyDelegationCertificate (GenesisKeyDelegationRequirements atMostEra
(GenesisKeyHash hGenKey) (GenesisDelegateKeyHash hGenDelegKey) (VrfKeyHash hVrfKey)) =
ShelleyRelatedCertificate atMostEra
$ shelleyCertificateConstraints atMostEra
$ shelleyToBabbageEraConstraints atMostEra
$ Ledger.ShelleyTxCertGenesisDeleg $ Ledger.GenesisDelegCert hGenKey hGenDelegKey hVrfKey

data MirCertificateRequirements era where
Expand Down Expand Up @@ -820,12 +820,8 @@ shelleyCertificateConstraints
, IsShelleyBasedEra era
) => a)
-> a
shelleyCertificateConstraints = \case
ShelleyToBabbageEraBabbage -> id
ShelleyToBabbageEraAlonzo -> id
ShelleyToBabbageEraMary -> id
ShelleyToBabbageEraAllegra -> id
ShelleyToBabbageEraShelley -> id
shelleyCertificateConstraints w f = shelleyToBabbageEraConstraints w f {- HLINT ignore "Eta reduce" -}
Copy link
Collaborator Author

Choose a reason for hiding this comment

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

Strangely ETA reduction doesn't work.

Not an issue for these functions are planned for deletion anyway

{-# DEPRECATED shelleyCertificateConstraints "Please use 'shelleyToBabbageEraConstraints' instead." #-}

conwayCertificateConstraints
:: ConwayEraOnwards era
Expand All @@ -835,5 +831,5 @@ conwayCertificateConstraints
, IsShelleyBasedEra era
) => a)
-> a
conwayCertificateConstraints = \case
ConwayEraOnwardsConway -> id
conwayCertificateConstraints w f = conwayEraOnwardsConstraints w f {- HLINT ignore "Eta reduce" -}
{-# DEPRECATED conwayCertificateConstraints "Please use 'conwayEraOnwardsConstraints' instead." #-}
31 changes: 15 additions & 16 deletions cardano-api/internal/Cardano/Api/Feature/ShelleyToBabbageEra.hs
Original file line number Diff line number Diff line change
Expand Up @@ -55,22 +55,22 @@ instance FeatureInEra ShelleyToBabbageEra where
BabbageEra -> yes ShelleyToBabbageEraBabbage
ConwayEra -> no

type ShelleyToBabbageEraConstraints era ledgerera =
( C.HashAlgorithm (L.HASH (L.EraCrypto ledgerera))
, C.Signable (L.VRF (L.EraCrypto ledgerera)) L.Seed
type ShelleyToBabbageEraConstraints era =
( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era)))
Copy link
Contributor

Choose a reason for hiding this comment

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

Why not ShelleyLedgerEra era ~ ledgerera? It would be a little bit more readable imo.

, C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed
, Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
, Consensus.ShelleyCompatible (ConsensusProtocol era) ledgerera
, Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era)
, L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224
, L.Crypto (L.EraCrypto ledgerera)
, L.Era ledgerera
, L.EraCrypto ledgerera ~ L.StandardCrypto
, L.EraPParams ledgerera
, L.EraTx ledgerera
, L.EraTxBody ledgerera
, L.HashAnnotated (L.TxBody ledgerera) L.EraIndependentTxBody L.StandardCrypto
, L.ShelleyEraTxBody ledgerera
, L.ShelleyEraTxCert ledgerera
, L.TxCert ledgerera ~ L.ShelleyTxCert ledgerera
, L.Crypto (L.EraCrypto (ShelleyLedgerEra era))
, L.Era (ShelleyLedgerEra era)
, L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
, L.EraPParams (ShelleyLedgerEra era)
, L.EraTx (ShelleyLedgerEra era)
, L.EraTxBody (ShelleyLedgerEra era)
, L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
, L.ShelleyEraTxBody (ShelleyLedgerEra era)
, L.ShelleyEraTxCert (ShelleyLedgerEra era)
, L.TxCert (ShelleyLedgerEra era) ~ L.ShelleyTxCert (ShelleyLedgerEra era)
, FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
, FromCBOR (DebugLedgerState era)
, IsShelleyBasedEra era
Expand All @@ -84,9 +84,8 @@ data AnyShelleyToBabbageEra where
deriving instance Show AnyShelleyToBabbageEra

shelleyToBabbageEraConstraints :: ()
=> ShelleyLedgerEra era ~ ledgerera
=> ShelleyToBabbageEra era
-> (ShelleyToBabbageEraConstraints era ledgerera => a)
-> (ShelleyToBabbageEraConstraints era => a)
-> a
shelleyToBabbageEraConstraints = \case
ShelleyToBabbageEraShelley -> id
Expand Down