From 353db1bf97035de9fd0ed753a8e545d94368d8fc Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 13 Sep 2024 09:31:13 +0200 Subject: [PATCH] Add Inject instances for Eons --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 11 ++-- .../internal/Cardano/Api/Certificate.hs | 4 +- .../Cardano/Api/Eon/AllegraEraOnwards.hs | 20 ++++--- .../Cardano/Api/Eon/AlonzoEraOnwards.hs | 16 ++++-- .../Cardano/Api/Eon/BabbageEraOnwards.hs | 14 +++-- .../Cardano/Api/Eon/ByronToAlonzoEra.hs | 4 ++ .../Cardano/Api/Eon/ConwayEraOnwards.hs | 22 +++++++- .../Cardano/Api/Eon/MaryEraOnwards.hs | 18 +++++-- .../Cardano/Api/Eon/ShelleyBasedEra.hs | 5 ++ .../Cardano/Api/Eon/ShelleyEraOnly.hs | 12 ++++- .../Cardano/Api/Eon/ShelleyToAllegraEra.hs | 14 +++-- .../Cardano/Api/Eon/ShelleyToAlonzoEra.hs | 17 ++++-- .../Cardano/Api/Eon/ShelleyToBabbageEra.hs | 20 ++++--- .../Cardano/Api/Eon/ShelleyToMaryEra.hs | 16 ++++-- cardano-api/internal/Cardano/Api/Eras.hs | 1 + cardano-api/internal/Cardano/Api/Eras/Core.hs | 2 + .../internal/Cardano/Api/Experimental/Eras.hs | 35 +++++++++--- .../internal/Cardano/Api/Experimental/Tx.hs | 4 +- cardano-api/internal/Cardano/Api/Fees.hs | 4 +- .../internal/Cardano/Api/Query/Expr.hs | 53 ++++++++++--------- cardano-api/internal/Cardano/Api/Tx/Body.hs | 22 ++++---- cardano-api/src/Cardano/Api.hs | 1 + 22 files changed, 219 insertions(+), 96 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 2f432702fa..25db595cb3 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -132,7 +132,6 @@ import qualified Cardano.Api as Api import Cardano.Api.Byron (KeyWitness (ByronKeyWitness), WitnessNetworkIdOrByronAddress (..)) import qualified Cardano.Api.Byron as Byron -import Cardano.Api.Eon.AllegraEraOnwards (allegraEraOnwardsToShelleyBasedEra) import Cardano.Api.Error import qualified Cardano.Api.Ledger as L import qualified Cardano.Api.Ledger.Lens as A @@ -389,11 +388,11 @@ genValueDefault w = genValue w genAssetId genSignedNonZeroQuantity -- | Generate a 'Value' suitable for minting, i.e. non-ADA asset ID and a -- positive or negative quantity. -genValueForMinting :: MaryEraOnwards era -> Gen Value +genValueForMinting :: forall era. MaryEraOnwards era -> Gen Value genValueForMinting w = fromLedgerValue sbe <$> genValue w genAssetIdNoAda genSignedNonZeroQuantity where - sbe = maryEraOnwardsToShelleyBasedEra w + sbe = inject w :: ShelleyBasedEra era genAssetIdNoAda :: Gen AssetId genAssetIdNoAda = AssetId <$> genPolicyId <*> genAssetName @@ -586,7 +585,7 @@ genTxAuxScripts era = TxAuxScripts w <$> Gen.list (Range.linear 0 3) - (genScriptInEra (allegraEraOnwardsToShelleyBasedEra w)) + (genScriptInEra (inject w)) ) genTxWithdrawals :: CardanoEra era -> Gen (TxWithdrawals build era) @@ -1149,7 +1148,7 @@ genProposals w = conwayEraOnwardsConstraints w $ do -- We're doing it for the complete representation of possible values space of TxProposalProcedures. -- Proposal procedures code in cardano-api should handle such invalid values just fine. extraProposals <- Gen.list (Range.constant 0 10) (genProposal w) - let sbe = conwayEraOnwardsToShelleyBasedEra w + let sbe = inject w proposalsWithWitnesses <- forM (extraProposals <> proposalsToBeWitnessed) $ \proposal -> (proposal,) <$> genScriptWitnessForStake sbe @@ -1164,7 +1163,7 @@ genVotingProcedures :: Applicative (BuildTxWith build) -> Gen (Api.TxVotingProcedures build era) genVotingProcedures w = conwayEraOnwardsConstraints w $ do voters <- Gen.list (Range.constant 0 10) Q.arbitrary - let sbe = conwayEraOnwardsToShelleyBasedEra w + let sbe = inject w votersWithWitnesses <- fmap fromList . forM voters $ \voter -> (voter,) <$> genScriptWitnessForStake sbe Api.TxVotingProcedures <$> Q.arbitrary <*> pure (pure votersWithWitnesses) diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index b4f442faa0..29ecb67873 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -506,10 +506,10 @@ selectStakeCredentialWitness selectStakeCredentialWitness = \case ShelleyRelatedCertificate stbEra shelleyCert -> shelleyToBabbageEraConstraints stbEra $ - getTxCertWitness (shelleyToBabbageEraToShelleyBasedEra stbEra) shelleyCert + getTxCertWitness (inject stbEra) shelleyCert ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $ - getTxCertWitness (conwayEraOnwardsToShelleyBasedEra cEra) conwayCert + getTxCertWitness (inject cEra) conwayCert filterUnRegCreds :: Certificate era -> Maybe StakeCredential diff --git a/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs index e7adbc0979..5d8fea9a94 100644 --- a/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -66,6 +67,17 @@ instance ToCardanoEra AllegraEraOnwards where AllegraEraOnwardsBabbage -> BabbageEra AllegraEraOnwardsConway -> ConwayEra +instance Inject (AllegraEraOnwards era) (CardanoEra era) where + inject = toCardanoEra + +instance Inject (AllegraEraOnwards era) (ShelleyBasedEra era) where + inject = \case + AllegraEraOnwardsAllegra -> ShelleyBasedEraAllegra + AllegraEraOnwardsMary -> ShelleyBasedEraMary + AllegraEraOnwardsAlonzo -> ShelleyBasedEraAlonzo + AllegraEraOnwardsBabbage -> ShelleyBasedEraBabbage + AllegraEraOnwardsConway -> ShelleyBasedEraConway + type AllegraEraOnwardsConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -103,13 +115,9 @@ allegraEraOnwardsConstraints = \case AllegraEraOnwardsBabbage -> id AllegraEraOnwardsConway -> id +{-# DEPRECATED allegraEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-} allegraEraOnwardsToShelleyBasedEra :: AllegraEraOnwards era -> ShelleyBasedEra era -allegraEraOnwardsToShelleyBasedEra = \case - AllegraEraOnwardsAllegra -> ShelleyBasedEraAllegra - AllegraEraOnwardsMary -> ShelleyBasedEraMary - AllegraEraOnwardsAlonzo -> ShelleyBasedEraAlonzo - AllegraEraOnwardsBabbage -> ShelleyBasedEraBabbage - AllegraEraOnwardsConway -> ShelleyBasedEraConway +allegraEraOnwardsToShelleyBasedEra = inject class IsAllegraBasedEra era where allegraBasedEra :: AllegraEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs index 150f9a6ca2..03a3a132bc 100644 --- a/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -69,6 +70,15 @@ instance ToCardanoEra AlonzoEraOnwards where AlonzoEraOnwardsBabbage -> BabbageEra AlonzoEraOnwardsConway -> ConwayEra +instance Inject (AlonzoEraOnwards era) (CardanoEra era) where + inject = toCardanoEra + +instance Inject (AlonzoEraOnwards era) (ShelleyBasedEra era) where + inject = \case + AlonzoEraOnwardsAlonzo -> ShelleyBasedEraAlonzo + AlonzoEraOnwardsBabbage -> ShelleyBasedEraBabbage + AlonzoEraOnwardsConway -> ShelleyBasedEraConway + type AlonzoEraOnwardsConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -113,11 +123,9 @@ alonzoEraOnwardsConstraints = \case AlonzoEraOnwardsBabbage -> id AlonzoEraOnwardsConway -> id +{-# DEPRECATED alonzoEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-} alonzoEraOnwardsToShelleyBasedEra :: AlonzoEraOnwards era -> ShelleyBasedEra era -alonzoEraOnwardsToShelleyBasedEra = \case - AlonzoEraOnwardsAlonzo -> ShelleyBasedEraAlonzo - AlonzoEraOnwardsBabbage -> ShelleyBasedEraBabbage - AlonzoEraOnwardsConway -> ShelleyBasedEraConway +alonzoEraOnwardsToShelleyBasedEra = inject class IsAlonzoBasedEra era where alonzoBasedEra :: AlonzoEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs index 979e144f18..e7788c677d 100644 --- a/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -65,6 +66,14 @@ instance ToCardanoEra BabbageEraOnwards where BabbageEraOnwardsBabbage -> BabbageEra BabbageEraOnwardsConway -> ConwayEra +instance Inject (BabbageEraOnwards era) (CardanoEra era) where + inject = toCardanoEra + +instance Inject (BabbageEraOnwards era) (ShelleyBasedEra era) where + inject = \case + BabbageEraOnwardsBabbage -> ShelleyBasedEraBabbage + BabbageEraOnwardsConway -> ShelleyBasedEraConway + type BabbageEraOnwardsConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -108,10 +117,9 @@ babbageEraOnwardsConstraints = \case BabbageEraOnwardsBabbage -> id BabbageEraOnwardsConway -> id +{-# DEPRECATED babbageEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-} babbageEraOnwardsToShelleyBasedEra :: BabbageEraOnwards era -> ShelleyBasedEra era -babbageEraOnwardsToShelleyBasedEra = \case - BabbageEraOnwardsBabbage -> ShelleyBasedEraBabbage - BabbageEraOnwardsConway -> ShelleyBasedEraConway +babbageEraOnwardsToShelleyBasedEra = inject class IsBabbageBasedEra era where babbageBasedEra :: BabbageEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs b/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs index d53b780a48..23701d8bd3 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -47,6 +48,9 @@ instance ToCardanoEra ByronToAlonzoEra where ByronToAlonzoEraMary -> MaryEra ByronToAlonzoEraAlonzo -> AlonzoEra +instance Inject (ByronToAlonzoEra era) (CardanoEra era) where + inject = toCardanoEra + type ByronToAlonzoEraConstraints era = ( IsCardanoEra era , Typeable era diff --git a/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs index 06fa98fc0a..f2b6fc54c8 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -12,11 +13,13 @@ module Cardano.Api.Eon.ConwayEraOnwards ( ConwayEraOnwards (..) , conwayEraOnwardsConstraints , conwayEraOnwardsToShelleyBasedEra + , conwayEraOnwardsToBabbageEraOnwards , ConwayEraOnwardsConstraints , IsConwayBasedEra (..) ) where +import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes @@ -64,6 +67,17 @@ instance ToCardanoEra ConwayEraOnwards where toCardanoEra = \case ConwayEraOnwardsConway -> ConwayEra +instance Inject (ConwayEraOnwards era) (CardanoEra era) where + inject = toCardanoEra + +instance Inject (ConwayEraOnwards era) (ShelleyBasedEra era) where + inject = \case + ConwayEraOnwardsConway -> ShelleyBasedEraConway + +instance Inject (ConwayEraOnwards era) (BabbageEraOnwards era) where + inject = \case + ConwayEraOnwardsConway -> BabbageEraOnwardsConway + type ConwayEraOnwardsConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -110,9 +124,13 @@ conwayEraOnwardsConstraints conwayEraOnwardsConstraints = \case ConwayEraOnwardsConway -> id +{-# DEPRECATED conwayEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-} conwayEraOnwardsToShelleyBasedEra :: ConwayEraOnwards era -> ShelleyBasedEra era -conwayEraOnwardsToShelleyBasedEra = \case - ConwayEraOnwardsConway -> ShelleyBasedEraConway +conwayEraOnwardsToShelleyBasedEra = inject + +{-# DEPRECATED conwayEraOnwardsToBabbageEraOnwards "Use 'inject' instead." #-} +conwayEraOnwardsToBabbageEraOnwards :: ConwayEraOnwards era -> BabbageEraOnwards era +conwayEraOnwardsToBabbageEraOnwards = inject class IsConwayBasedEra era where conwayBasedEra :: ConwayEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs index 3f59847306..9ea4191fc3 100644 --- a/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -66,6 +67,16 @@ instance ToCardanoEra MaryEraOnwards where MaryEraOnwardsBabbage -> BabbageEra MaryEraOnwardsConway -> ConwayEra +instance Inject (MaryEraOnwards era) (CardanoEra era) where + inject = toCardanoEra + +instance Inject (MaryEraOnwards era) (ShelleyBasedEra era) where + inject = \case + MaryEraOnwardsMary -> ShelleyBasedEraMary + MaryEraOnwardsAlonzo -> ShelleyBasedEraAlonzo + MaryEraOnwardsBabbage -> ShelleyBasedEraBabbage + MaryEraOnwardsConway -> ShelleyBasedEraConway + type MaryEraOnwardsConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -104,12 +115,9 @@ maryEraOnwardsConstraints = \case MaryEraOnwardsBabbage -> id MaryEraOnwardsConway -> id +{-# DEPRECATED maryEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-} maryEraOnwardsToShelleyBasedEra :: MaryEraOnwards era -> ShelleyBasedEra era -maryEraOnwardsToShelleyBasedEra = \case - MaryEraOnwardsMary -> ShelleyBasedEraMary - MaryEraOnwardsAlonzo -> ShelleyBasedEraAlonzo - MaryEraOnwardsBabbage -> ShelleyBasedEraBabbage - MaryEraOnwardsConway -> ShelleyBasedEraConway +maryEraOnwardsToShelleyBasedEra = inject class IsMaryBasedEra era where maryBasedEra :: MaryEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs index aa279c2afc..d16e97f565 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs @@ -1,8 +1,10 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -177,6 +179,9 @@ instance ToCardanoEra ShelleyBasedEra where ShelleyBasedEraBabbage -> BabbageEra ShelleyBasedEraConway -> ConwayEra +instance Inject (ShelleyBasedEra era) (CardanoEra era) where + inject = toCardanoEra + -- | The class of eras that are based on Shelley. This allows uniform handling -- of Shelley-based eras, but also non-uniform by making case distinctions on -- the 'ShelleyBasedEra' constructors. diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs index 027088ddc1..fbafc1d902 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -59,6 +60,13 @@ instance ToCardanoEra ShelleyEraOnly where toCardanoEra = \case ShelleyEraOnlyShelley -> ShelleyEra +instance Inject (ShelleyEraOnly era) (CardanoEra era) where + inject = toCardanoEra + +instance Inject (ShelleyEraOnly era) (ShelleyBasedEra era) where + inject = \case + ShelleyEraOnlyShelley -> ShelleyBasedEraShelley + type ShelleyEraOnlyConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -99,6 +107,6 @@ shelleyEraOnlyConstraints shelleyEraOnlyConstraints = \case ShelleyEraOnlyShelley -> id +{-# DEPRECATED shelleyEraOnlyToShelleyBasedEra "Use 'inject' instead." #-} shelleyEraOnlyToShelleyBasedEra :: ShelleyEraOnly era -> ShelleyBasedEra era -shelleyEraOnlyToShelleyBasedEra = \case - ShelleyEraOnlyShelley -> ShelleyBasedEraShelley +shelleyEraOnlyToShelleyBasedEra = inject diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs index 3fe4232c17..fefccda7c8 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -62,6 +63,14 @@ instance ToCardanoEra ShelleyToAllegraEra where ShelleyToAllegraEraShelley -> ShelleyEra ShelleyToAllegraEraAllegra -> AllegraEra +instance Inject (ShelleyToAllegraEra era) (CardanoEra era) where + inject = toCardanoEra + +instance Inject (ShelleyToAllegraEra era) (ShelleyBasedEra era) where + inject = \case + ShelleyToAllegraEraShelley -> ShelleyBasedEraShelley + ShelleyToAllegraEraAllegra -> ShelleyBasedEraAllegra + type ShelleyToAllegraEraConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -102,7 +111,6 @@ shelleyToAllegraEraConstraints = \case ShelleyToAllegraEraShelley -> id ShelleyToAllegraEraAllegra -> id +{-# DEPRECATED shelleyToAllegraEraToShelleyBasedEra "Use 'inject' instead." #-} shelleyToAllegraEraToShelleyBasedEra :: ShelleyToAllegraEra era -> ShelleyBasedEra era -shelleyToAllegraEraToShelleyBasedEra = \case - ShelleyToAllegraEraShelley -> ShelleyBasedEraShelley - ShelleyToAllegraEraAllegra -> ShelleyBasedEraAllegra +shelleyToAllegraEraToShelleyBasedEra = inject diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyToAlonzoEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyToAlonzoEra.hs index c428d2a6f3..8271355f90 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyToAlonzoEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyToAlonzoEra.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -64,6 +65,16 @@ instance ToCardanoEra ShelleyToAlonzoEra where ShelleyToAlonzoEraMary -> MaryEra ShelleyToAlonzoEraAlonzo -> AlonzoEra +instance Inject (ShelleyToAlonzoEra era) (CardanoEra era) where + inject = toCardanoEra + +instance Inject (ShelleyToAlonzoEra era) (ShelleyBasedEra era) where + inject = \case + ShelleyToAlonzoEraShelley -> ShelleyBasedEraShelley + ShelleyToAlonzoEraAllegra -> ShelleyBasedEraAllegra + ShelleyToAlonzoEraMary -> ShelleyBasedEraMary + ShelleyToAlonzoEraAlonzo -> ShelleyBasedEraAlonzo + type ShelleyToAlonzoEraConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -104,8 +115,4 @@ shelleyToAlonzoEraConstraints = \case ShelleyToAlonzoEraAlonzo -> id shelleyToAlonzoEraToShelleyBasedEra :: ShelleyToAlonzoEra era -> ShelleyBasedEra era -shelleyToAlonzoEraToShelleyBasedEra = \case - ShelleyToAlonzoEraShelley -> ShelleyBasedEraShelley - ShelleyToAlonzoEraAllegra -> ShelleyBasedEraAllegra - ShelleyToAlonzoEraMary -> ShelleyBasedEraMary - ShelleyToAlonzoEraAlonzo -> ShelleyBasedEraAlonzo +shelleyToAlonzoEraToShelleyBasedEra = inject diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyToBabbageEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyToBabbageEra.hs index b2deca73bc..43d6fed433 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyToBabbageEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyToBabbageEra.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -66,6 +67,17 @@ instance ToCardanoEra ShelleyToBabbageEra where ShelleyToBabbageEraAlonzo -> AlonzoEra ShelleyToBabbageEraBabbage -> BabbageEra +instance Inject (ShelleyToBabbageEra era) (CardanoEra era) where + inject = toCardanoEra + +instance Inject (ShelleyToBabbageEra era) (ShelleyBasedEra era) where + inject = \case + ShelleyToBabbageEraShelley -> ShelleyBasedEraShelley + ShelleyToBabbageEraAllegra -> ShelleyBasedEraAllegra + ShelleyToBabbageEraMary -> ShelleyBasedEraMary + ShelleyToBabbageEraAlonzo -> ShelleyBasedEraAlonzo + ShelleyToBabbageEraBabbage -> ShelleyBasedEraBabbage + type ShelleyToBabbageEraConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -105,10 +117,6 @@ shelleyToBabbageEraConstraints = \case ShelleyToBabbageEraAlonzo -> id ShelleyToBabbageEraBabbage -> id +{-# DEPRECATED shelleyToBabbageEraToShelleyBasedEra "Use 'inject' instead." #-} shelleyToBabbageEraToShelleyBasedEra :: ShelleyToBabbageEra era -> ShelleyBasedEra era -shelleyToBabbageEraToShelleyBasedEra = \case - ShelleyToBabbageEraShelley -> ShelleyBasedEraShelley - ShelleyToBabbageEraAllegra -> ShelleyBasedEraAllegra - ShelleyToBabbageEraMary -> ShelleyBasedEraMary - ShelleyToBabbageEraAlonzo -> ShelleyBasedEraAlonzo - ShelleyToBabbageEraBabbage -> ShelleyBasedEraBabbage +shelleyToBabbageEraToShelleyBasedEra = inject diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyToMaryEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyToMaryEra.hs index 9c3f064562..a92cc8c57d 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyToMaryEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyToMaryEra.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -62,6 +63,15 @@ instance ToCardanoEra ShelleyToMaryEra where ShelleyToMaryEraAllegra -> AllegraEra ShelleyToMaryEraMary -> MaryEra +instance Inject (ShelleyToMaryEra era) (CardanoEra era) where + inject = toCardanoEra + +instance Inject (ShelleyToMaryEra era) (ShelleyBasedEra era) where + inject = \case + ShelleyToMaryEraShelley -> ShelleyBasedEraShelley + ShelleyToMaryEraAllegra -> ShelleyBasedEraAllegra + ShelleyToMaryEraMary -> ShelleyBasedEraMary + type ShelleyToMaryEraConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -101,8 +111,6 @@ shelleyToMaryEraConstraints = \case ShelleyToMaryEraAllegra -> id ShelleyToMaryEraMary -> id +{-# DEPRECATED shelleyToMaryEraToShelleyBasedEra "Use 'inject' instead." #-} shelleyToMaryEraToShelleyBasedEra :: ShelleyToMaryEra era -> ShelleyBasedEra era -shelleyToMaryEraToShelleyBasedEra = \case - ShelleyToMaryEraShelley -> ShelleyBasedEraShelley - ShelleyToMaryEraAllegra -> ShelleyBasedEraAllegra - ShelleyToMaryEraMary -> ShelleyBasedEraMary +shelleyToMaryEraToShelleyBasedEra = inject diff --git a/cardano-api/internal/Cardano/Api/Eras.hs b/cardano-api/internal/Cardano/Api/Eras.hs index b54554bb9c..f436ea1aa3 100644 --- a/cardano-api/internal/Cardano/Api/Eras.hs +++ b/cardano-api/internal/Cardano/Api/Eras.hs @@ -30,6 +30,7 @@ module Cardano.Api.Eras , maybeEon , monoidForEraInEon , monoidForEraInEonA + , Inject (..) -- * Data family instances , AsType (AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra, AsBabbageEra, AsConwayEra) diff --git a/cardano-api/internal/Cardano/Api/Eras/Core.hs b/cardano-api/internal/Cardano/Api/Eras/Core.hs index 3167b67854..62e11ab616 100644 --- a/cardano-api/internal/Cardano/Api/Eras/Core.hs +++ b/cardano-api/internal/Cardano/Api/Eras/Core.hs @@ -40,6 +40,7 @@ module Cardano.Api.Eras.Core , maybeEon , monoidForEraInEon , monoidForEraInEonA + , Inject (..) -- * Data family instances , AsType (AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra, AsBabbageEra, AsConwayEra) @@ -52,6 +53,7 @@ import Cardano.Api.HasTypeProxy import Cardano.Api.Pretty import qualified Cardano.Ledger.Api as L +import Cardano.Ledger.BaseTypes (Inject (..)) import Data.Aeson (FromJSON (..), ToJSON, toJSON, withText) import Data.Kind diff --git a/cardano-api/internal/Cardano/Api/Experimental/Eras.hs b/cardano-api/internal/Cardano/Api/Experimental/Eras.hs index 90279ee8a5..f7eee2f5ca 100644 --- a/cardano-api/internal/Cardano/Api/Experimental/Eras.hs +++ b/cardano-api/internal/Cardano/Api/Experimental/Eras.hs @@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -19,6 +20,7 @@ module Cardano.Api.Experimental.Eras , Era (..) , IsEra (..) , Some (..) + , Inject (..) , LedgerEra , DeprecatedEra (..) , EraCommonConstraints @@ -39,6 +41,7 @@ import Cardano.Api.Via.ShowOf import qualified Cardano.Ledger.Api as L import qualified Cardano.Ledger.Babbage as Ledger +import Cardano.Ledger.BaseTypes (Inject (..)) import qualified Cardano.Ledger.Conway as Ledger import qualified Cardano.Ledger.Core as Ledger import Cardano.Ledger.Hashes @@ -184,11 +187,31 @@ eraFromStringLike = \case -- instance IsEra ConwayEra where -- useEra = ConwayEra -- @ +{-# DEPRECATED eraToSbe "Use 'inject' instead." #-} eraToSbe :: Era era -> ShelleyBasedEra era -eraToSbe BabbageEra = ShelleyBasedEraBabbage -eraToSbe ConwayEra = ShelleyBasedEraConway +eraToSbe = inject + +instance Inject (Era era) (Api.CardanoEra era) where + inject = \case + BabbageEra -> Api.BabbageEra + ConwayEra -> Api.ConwayEra + +instance Inject (Era era) (ShelleyBasedEra era) where + inject = \case + BabbageEra -> ShelleyBasedEraBabbage + ConwayEra -> ShelleyBasedEraConway + +instance Inject (Era era) (BabbageEraOnwards era) where + inject = \case + BabbageEra -> BabbageEraOnwardsBabbage + ConwayEra -> BabbageEraOnwardsConway + +instance Inject (BabbageEraOnwards era) (Era era) where + inject = \case + BabbageEraOnwardsBabbage -> BabbageEra + BabbageEraOnwardsConway -> ConwayEra newtype DeprecatedEra era = DeprecatedEra (ShelleyBasedEra era) @@ -207,13 +230,13 @@ sbeToEra e@ShelleyBasedEraMary = throwError $ DeprecatedEra e sbeToEra e@ShelleyBasedEraAllegra = throwError $ DeprecatedEra e sbeToEra e@ShelleyBasedEraShelley = throwError $ DeprecatedEra e +{-# DEPRECATED babbageEraOnwardsToEra "Use 'inject' instead." #-} babbageEraOnwardsToEra :: BabbageEraOnwards era -> Era era -babbageEraOnwardsToEra BabbageEraOnwardsBabbage = BabbageEra -babbageEraOnwardsToEra BabbageEraOnwardsConway = ConwayEra +babbageEraOnwardsToEra = inject +{-# DEPRECATED eraToBabbageEraOnwards "Use 'inject' instead." #-} eraToBabbageEraOnwards :: Era era -> BabbageEraOnwards era -eraToBabbageEraOnwards BabbageEra = BabbageEraOnwardsBabbage -eraToBabbageEraOnwards ConwayEra = BabbageEraOnwardsConway +eraToBabbageEraOnwards = inject ------------------------------------------------------------------------- diff --git a/cardano-api/internal/Cardano/Api/Experimental/Tx.hs b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs index 7356cb2046..72fcbde171 100644 --- a/cardano-api/internal/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs @@ -63,7 +63,7 @@ makeUnsignedTx -> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era) makeUnsignedTx era bc = obtainCommonConstraints era $ do - let sbe = eraToSbe era + let sbe = inject era -- cardano-api types let apiTxOuts = txOuts bc @@ -138,7 +138,7 @@ eraSpecificLedgerTxBody -> TxBodyContent BuildTx era -> Either TxBodyError (Ledger.TxBody (LedgerEra era)) eraSpecificLedgerTxBody BabbageEra ledgerbody bc = do - let sbe = eraToSbe BabbageEra + let sbe = inject BabbageEra setUpdateProposal <- convTxUpdateProposal sbe (txUpdateProposal bc) diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 7f736b6f53..7bcef9ecc1 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -234,7 +234,7 @@ estimateBalancedTxBody totalUTxOValue = do -- Step 1. Substitute those execution units into the tx - let sbe = maryEraOnwardsToShelleyBasedEra w + let sbe = inject w txbodycontent1 <- maryEraOnwardsConstraints w $ first TxFeeEstimationScriptExecutionError $ @@ -1331,7 +1331,7 @@ calcReturnAndTotalCollateral retColSup fee pp' TxInsCollateral{} txReturnCollate retColSup ( TxOut cAddr - (lovelaceToTxOutValue (babbageEraOnwardsToShelleyBasedEra retColSup) returnCollateral) + (lovelaceToTxOutValue (inject retColSup) returnCollateral) TxOutDatumNone ReferenceScriptNone ) diff --git a/cardano-api/internal/Cardano/Api/Query/Expr.hs b/cardano-api/internal/Cardano/Api/Query/Expr.hs index 43415793ce..71fb159624 100644 --- a/cardano-api/internal/Cardano/Api/Query/Expr.hs +++ b/cardano-api/internal/Cardano/Api/Query/Expr.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} module Cardano.Api.Query.Expr ( queryAccountState @@ -163,7 +164,7 @@ queryPoolDistribution IO (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedPoolDistribution era))) queryPoolDistribution era mPoolIds = do - let sbe = babbageEraOnwardsToShelleyBasedEra era + let sbe = inject era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryPoolDistribution mPoolIds queryPoolState @@ -178,7 +179,7 @@ queryPoolState IO (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedPoolState era))) queryPoolState era mPoolIds = do - let sbe = babbageEraOnwardsToShelleyBasedEra era + let sbe = inject era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryPoolState mPoolIds queryProtocolParameters @@ -261,8 +262,8 @@ queryStakeAddresses sbe stakeCredentials networkId = queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakeAddresses stakeCredentials networkId queryStakeDelegDeposits - :: () - => BabbageEraOnwards era + :: forall era block point r + . BabbageEraOnwards era -> Set StakeCredential -> LocalStateQueryExpr block @@ -274,7 +275,7 @@ queryStakeDelegDeposits queryStakeDelegDeposits era stakeCreds | S.null stakeCreds = pure . pure $ pure mempty | otherwise = do - let sbe = babbageEraOnwardsToShelleyBasedEra era + let sbe = inject era :: ShelleyBasedEra era queryExpr $ QueryInEra . QueryInShelleyBasedEra sbe $ QueryStakeDelegDeposits stakeCreds queryStakeDistribution @@ -331,7 +332,7 @@ queryStakeSnapshot IO (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedStakeSnapshots era))) queryStakeSnapshot era mPoolIds = do - let sbe = babbageEraOnwardsToShelleyBasedEra era + let sbe = inject era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakeSnapshot mPoolIds querySystemStart @@ -365,7 +366,7 @@ queryConstitution IO (Either UnsupportedNtcVersionError (Either EraMismatch (L.Constitution (ShelleyLedgerEra era)))) queryConstitution era = do - let sbe = conwayEraOnwardsToShelleyBasedEra era + let sbe = inject era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe QueryConstitution queryGovState @@ -379,12 +380,12 @@ queryGovState IO (Either UnsupportedNtcVersionError (Either EraMismatch (L.GovState (ShelleyLedgerEra era)))) queryGovState era = do - let sbe = conwayEraOnwardsToShelleyBasedEra era + let sbe = inject era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe QueryGovState queryDRepState - :: () - => ConwayEraOnwards era + :: forall era block point r + . ConwayEraOnwards era -> Set (L.Credential L.DRepRole L.StandardCrypto) -- ^ An empty credentials set means that states for all DReps will be returned -> LocalStateQueryExpr @@ -398,12 +399,12 @@ queryDRepState (Either EraMismatch (Map (L.Credential L.DRepRole L.StandardCrypto) (L.DRepState L.StandardCrypto))) ) queryDRepState era drepCreds = do - let sbe = conwayEraOnwardsToShelleyBasedEra era + let sbe = inject era :: ShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryDRepState drepCreds queryDRepStakeDistribution - :: () - => ConwayEraOnwards era + :: forall era block point r + . ConwayEraOnwards era -> Set (L.DRep L.StandardCrypto) -- ^ An empty DRep set means that distributions for all DReps will be returned -> LocalStateQueryExpr @@ -414,12 +415,12 @@ queryDRepStakeDistribution IO (Either UnsupportedNtcVersionError (Either EraMismatch (Map (L.DRep L.StandardCrypto) L.Coin))) queryDRepStakeDistribution era dreps = do - let sbe = conwayEraOnwardsToShelleyBasedEra era + let sbe = inject era :: ShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryDRepStakeDistr dreps querySPOStakeDistribution - :: () - => ConwayEraOnwards era + :: forall era block point r + . ConwayEraOnwards era -> Set (L.KeyHash 'L.StakePool L.StandardCrypto) -- ^ An empty SPO key hash set means that distributions for all SPOs will be returned -> LocalStateQueryExpr @@ -433,14 +434,14 @@ querySPOStakeDistribution (Either EraMismatch (Map (L.KeyHash 'L.StakePool L.StandardCrypto) L.Coin)) ) querySPOStakeDistribution era spos = do - let sbe = conwayEraOnwardsToShelleyBasedEra era + let sbe = inject era :: ShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QuerySPOStakeDistr spos -- | Returns info about committee members filtered by: cold credentials, hot credentials and statuses. -- If empty sets are passed as filters, then no filtering is done. queryCommitteeMembersState - :: () - => ConwayEraOnwards era + :: forall era block point r + . ConwayEraOnwards era -> Set (L.Credential L.ColdCommitteeRole L.StandardCrypto) -> Set (L.Credential L.HotCommitteeRole L.StandardCrypto) -> Set L.MemberStatus @@ -452,14 +453,14 @@ queryCommitteeMembersState IO (Either UnsupportedNtcVersionError (Either EraMismatch (L.CommitteeMembersState L.StandardCrypto))) queryCommitteeMembersState era coldCreds hotCreds statuses = do - let sbe = conwayEraOnwardsToShelleyBasedEra era + let sbe = inject era :: ShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe (QueryCommitteeMembersState coldCreds hotCreds statuses) queryStakeVoteDelegatees - :: () - => ConwayEraOnwards era + :: forall era block point r + . ConwayEraOnwards era -> Set StakeCredential -> LocalStateQueryExpr block @@ -472,12 +473,12 @@ queryStakeVoteDelegatees (Either EraMismatch (Map StakeCredential (L.DRep L.StandardCrypto))) ) queryStakeVoteDelegatees era stakeCredentials = do - let sbe = conwayEraOnwardsToShelleyBasedEra era + let sbe = inject era :: ShelleyBasedEra era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakeVoteDelegatees stakeCredentials queryAccountState - :: () - => ConwayEraOnwards era + :: forall era block point r + . ConwayEraOnwards era -> LocalStateQueryExpr block point @@ -487,5 +488,5 @@ queryAccountState (Either UnsupportedNtcVersionError (Either EraMismatch L.AccountState)) queryAccountState cOnwards = queryExpr $ - QueryInEra . QueryInShelleyBasedEra (conwayEraOnwardsToShelleyBasedEra cOnwards) $ + QueryInEra . QueryInShelleyBasedEra (inject cOnwards :: ShelleyBasedEra era) $ QueryAccountState diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 0e40356f0c..e074e00982 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -194,7 +194,6 @@ import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra -import Cardano.Api.Eon.ShelleyToAllegraEra import Cardano.Api.Eon.ShelleyToBabbageEra import Cardano.Api.Eras.Case import Cardano.Api.Eras.Core @@ -942,16 +941,16 @@ instance IsShelleyBasedEra era => FromJSON (TxOutValue era) where ( \shelleyToAlleg -> do ll <- o .: "lovelace" pure $ - shelleyBasedEraConstraints (shelleyToAllegraEraToShelleyBasedEra shelleyToAlleg) $ - TxOutValueShelleyBased (shelleyToAllegraEraToShelleyBasedEra shelleyToAlleg) $ - A.mkAdaValue (shelleyToAllegraEraToShelleyBasedEra shelleyToAlleg) ll + shelleyBasedEraConstraints (inject shelleyToAlleg :: ShelleyBasedEra era) $ + TxOutValueShelleyBased (inject shelleyToAlleg) $ + A.mkAdaValue (inject shelleyToAlleg :: ShelleyBasedEra era) ll ) ( \w -> do let l = toList o vals <- mapM decodeAssetId l pure $ - shelleyBasedEraConstraints (maryEraOnwardsToShelleyBasedEra w) $ - TxOutValueShelleyBased (maryEraOnwardsToShelleyBasedEra w) $ + shelleyBasedEraConstraints (inject w :: ShelleyBasedEra era) $ + TxOutValueShelleyBased (inject w) $ toLedgerValue w $ mconcat vals ) @@ -2037,8 +2036,8 @@ selectTxDatums TxBodyNoScriptData = Map.empty selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats' datums) _) = datums fromAlonzoTxOut - :: () - => AlonzoEraOnwards era + :: forall era + . AlonzoEraOnwards era -> L.TxOut (ShelleyLedgerEra era) -> TxOut CtxTx era fromAlonzoTxOut w txOut = @@ -2049,12 +2048,11 @@ fromAlonzoTxOut w txOut = (fromAlonzoTxOutDatumHash w (txOut ^. L.dataHashTxOutL)) ReferenceScriptNone where - sbe = alonzoEraOnwardsToShelleyBasedEra w + sbe = inject w :: ShelleyBasedEra era fromBabbageTxOut :: forall era - . () - => BabbageEraOnwards era + . BabbageEraOnwards era -> Map (L.DataHash StandardCrypto) (L.Data (ShelleyLedgerEra era)) -> L.TxOut (ShelleyLedgerEra era) -> TxOut CtxTx era @@ -2069,7 +2067,7 @@ fromBabbageTxOut w txdatums txout = SJust rScript -> fromShelleyScriptToReferenceScript shelleyBasedEra rScript ) where - sbe = babbageEraOnwardsToShelleyBasedEra w + sbe = inject w :: ShelleyBasedEra era -- NOTE: This is different to 'fromBabbageTxOutDatum' as it may resolve -- 'DatumHash' values using the datums included in the transaction. diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index c168cc0cc9..d602e8a6c7 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -48,6 +48,7 @@ module Cardano.Api , unFeatured , asFeaturedInEra , asFeaturedInShelleyBasedEra + , Inject (..) -- * Eons