From 2e81c812e1f4dd0b5f7ec715ddacd299397ce571 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 | 20 +++++-- .../Cardano/Api/Eon/ByronToAlonzoEra.hs | 4 ++ .../Cardano/Api/Eon/ConwayEraOnwards.hs | 20 +++++-- .../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 ++++---- .../internal/Cardano/Api/Tx/Compatible.hs | 5 +- cardano-api/src/Cardano/Api.hs | 1 + .../Cardano/Api/Transaction/Autobalance.hs | 20 +++---- 24 files changed, 234 insertions(+), 110 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index aa4c05787d..4a1f5caaa1 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -134,7 +134,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 @@ -392,7 +391,7 @@ genLedgerValue w genAId genQuant = genValueDefault :: MaryEraOnwards era -> Gen (L.Value (ShelleyLedgerEra era)) genValueDefault w = genLedgerValue w genAssetId genSignedNonZeroQuantity -genValueForRole :: MaryEraOnwards era -> ParserValueRole -> Gen Value +genValueForRole :: forall era. MaryEraOnwards era -> ParserValueRole -> Gen Value genValueForRole w = \case RoleMint -> @@ -400,7 +399,7 @@ genValueForRole w = RoleUTxO -> fromLedgerValue sbe <$> genValueForTxOut sbe where - sbe = maryEraOnwardsToShelleyBasedEra w + sbe = inject w :: ShelleyBasedEra era -- | Generate a 'Value' suitable for minting, i.e. non-ADA asset ID and a -- positive or negative quantity. @@ -600,7 +599,7 @@ genTxAuxScripts era = TxAuxScripts w <$> Gen.list (Range.linear 0 3) - (genScriptInEra (allegraEraOnwardsToShelleyBasedEra w)) + (genScriptInEra (inject w)) ) genTxWithdrawals :: CardanoEra era -> Gen (TxWithdrawals build era) @@ -1163,7 +1162,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 @@ -1178,7 +1177,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 dc1c7ee494..4b0a3b8218 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -515,10 +515,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 1bc8c80856..d4864efc33 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 IsShelleyBasedEra era => 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 b4997b90e1..b4272aa92d 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 #-} @@ -70,6 +71,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 @@ -114,11 +124,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 IsMaryBasedEra era => 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 32fe98c4b4..baab37a13f 100644 --- a/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs @@ -3,8 +3,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -18,6 +21,7 @@ module Cardano.Api.Eon.BabbageEraOnwards where import Cardano.Api.Eon.AlonzoEraOnwards +import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes @@ -66,6 +70,17 @@ 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 = inject @(MaryEraOnwards era) . inject + +instance Inject (BabbageEraOnwards era) (MaryEraOnwards era) where + inject = \case + BabbageEraOnwardsBabbage -> MaryEraOnwardsBabbage + BabbageEraOnwardsConway -> MaryEraOnwardsConway + type BabbageEraOnwardsConstraints era = ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed @@ -109,10 +124,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 IsAlonzoBasedEra era => 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 ae8dfbd998..17923ce828 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 #-} @@ -66,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 @@ -113,13 +125,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 = \case - ConwayEraOnwardsConway -> BabbageEraOnwardsConway +conwayEraOnwardsToBabbageEraOnwards = inject class IsBabbageBasedEra era => 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 fd4f1ab85c..a6f4979b34 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 #-} @@ -67,6 +68,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 @@ -105,12 +116,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 IsAllegraBasedEra era => 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 c492713e4c..fab704c474 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 b0c8f9cb9e..2b2e40cd0a 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 aff02992e1..f7cd681018 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 @@ -139,7 +139,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 eb0b917714..1e6d69ad8d 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -236,7 +236,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 $ @@ -1302,7 +1302,7 @@ calcReturnAndTotalCollateral -> (TxReturnCollateral CtxTx era, TxTotalCollateral era) calcReturnAndTotalCollateral _ _ _ TxInsCollateralNone _ _ _ _ = (TxReturnCollateralNone, TxTotalCollateralNone) calcReturnAndTotalCollateral w fee pp' TxInsCollateral{} txReturnCollateral txTotalCollateral cAddr totalAvailableCollateral = babbageEraOnwardsConstraints w $ do - let sbe = babbageEraOnwardsToShelleyBasedEra w + let sbe = inject w colPerc = pp' ^. Ledger.ppCollateralPercentageL -- We must first figure out how much lovelace we have committed -- as collateral and we must determine if we have enough lovelace at our diff --git a/cardano-api/internal/Cardano/Api/Query/Expr.hs b/cardano-api/internal/Cardano/Api/Query/Expr.hs index 43415793ce..ca737dd685 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 :: ShelleyBasedEra era = inject 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 :: ShelleyBasedEra era = inject 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 :: ShelleyBasedEra era = inject 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 18a2e3da3a..4189434b60 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -195,7 +195,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 @@ -965,16 +964,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 ) @@ -2051,8 +2050,8 @@ selectTxDatums TxBodyNoScriptData = Map.empty selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats' datums) _) = datums fromAlonzoTxOut - :: () - => AlonzoEraOnwards era + :: forall era ledgerera + . AlonzoEraOnwards era -> Map (L.DataHash StandardCrypto) (L.Data ledgerera) -> L.TxOut (ShelleyLedgerEra era) -> TxOut CtxTx era @@ -2064,7 +2063,7 @@ fromAlonzoTxOut w txdatums txOut = (fromAlonzoTxOutDatum w txdatums (txOut ^. L.dataHashTxOutL)) ReferenceScriptNone where - sbe = alonzoEraOnwardsToShelleyBasedEra w + sbe :: ShelleyBasedEra era = inject w fromAlonzoTxOutDatum :: () @@ -2081,8 +2080,7 @@ fromAlonzoTxOutDatum w txdatums = \case fromBabbageTxOut :: forall era - . () - => BabbageEraOnwards era + . BabbageEraOnwards era -> Map (L.DataHash StandardCrypto) (L.Data (ShelleyLedgerEra era)) -> L.TxOut (ShelleyLedgerEra era) -> TxOut CtxTx era @@ -2097,7 +2095,7 @@ fromBabbageTxOut w txdatums txout = SJust rScript -> fromShelleyScriptToReferenceScript shelleyBasedEra rScript ) where - sbe = babbageEraOnwardsToShelleyBasedEra w + sbe :: ShelleyBasedEra era = inject w -- NOTE: This is different to 'fromBabbageTxOutDatum' as it may resolve -- 'DatumHash' values using the datums included in the transaction. diff --git a/cardano-api/internal/Cardano/Api/Tx/Compatible.hs b/cardano-api/internal/Cardano/Api/Tx/Compatible.hs index b1f43db8fe..e22ba70b4b 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Compatible.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Compatible.hs @@ -16,6 +16,7 @@ where import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eon.ShelleyToBabbageEra +import Cardano.Api.Experimental.Eras import Cardano.Api.ProtocolParameters import Cardano.Api.Script import Cardano.Api.Tx.Body @@ -66,7 +67,7 @@ createCompatibleSignedTx sbeF ins outs witnesses txFee' anyProtocolUpdate anyVot shelleyBasedEraConstraints sbeF $ do tx <- case anyProtocolUpdate of ProtocolUpdate shelleyToBabbageEra updateProposal -> do - let sbe = shelleyToBabbageEraToShelleyBasedEra shelleyToBabbageEra + let sbe = inject shelleyToBabbageEra ledgerPParamsUpdate <- toLedgerUpdate sbe updateProposal @@ -85,7 +86,7 @@ createCompatibleSignedTx sbeF ins outs witnesses txFee' anyProtocolUpdate anyVot return $ ShelleyTx sbe finalTx ProposalProcedures conwayOnwards proposalProcedures -> do - let sbe = conwayEraOnwardsToShelleyBasedEra conwayOnwards + let sbe = inject conwayOnwards proposals = convProposalProcedures proposalProcedures apiScriptWitnesses = scriptWitnessesProposing proposalProcedures ledgerScripts = convScripts apiScriptWitnesses diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index f8a0238c4d..b98b2eb3eb 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 diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs index 6a82255176..207cec7c25 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs @@ -56,9 +56,9 @@ import Test.Tasty.Hedgehog (testProperty) prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset :: Property prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.propertyOnce $ do let ceo = ConwayEraOnwardsConway - beo = conwayEraOnwardsToBabbageEraOnwards ceo - meo = babbageEraOnwardsToMaryEraOnwards beo - sbe = conwayEraOnwardsToShelleyBasedEra ceo + beo = inject ceo + meo = inject beo + sbe = inject ceo era = toCardanoEra sbe aeo <- H.nothingFail $ forEraMaybeEon @AlonzoEraOnwards era @@ -141,9 +141,9 @@ prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.pr prop_make_transaction_body_autobalance_multi_asset_collateral :: Property prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $ do let ceo = ConwayEraOnwardsConway - beo = conwayEraOnwardsToBabbageEraOnwards ceo - sbe = babbageEraOnwardsToShelleyBasedEra beo - meo = babbageEraOnwardsToMaryEraOnwards beo + beo = inject ceo + sbe = inject beo + meo = inject beo era = toCardanoEra sbe aeo <- H.nothingFail $ forEraMaybeEon @AlonzoEraOnwards era @@ -207,8 +207,8 @@ prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $ prop_calcReturnAndTotalCollateral :: Property prop_calcReturnAndTotalCollateral = H.withTests 400 . H.property $ do let beo = BabbageEraOnwardsConway - sbe = babbageEraOnwardsToShelleyBasedEra beo - era = toCardanoEra beo + sbe = inject beo + era = inject beo feeCoin@(L.Coin fee) <- forAll genLovelace totalCollateral <- forAll $ genValueForTxOut sbe let totalCollateralAda = totalCollateral ^. L.adaAssetL sbe @@ -310,7 +310,7 @@ textEnvTypes = mkUtxos :: BabbageEraOnwards era -> L.ScriptHash L.StandardCrypto -> UTxO era mkUtxos beo scriptHash = babbageEraOnwardsConstraints beo $ do - let sbe = babbageEraOnwardsToShelleyBasedEra beo + let sbe = inject beo UTxO [ ( TxIn @@ -358,7 +358,7 @@ mkTxOutput -- ^ there will be an asset in the txout if provided -> [TxOut CtxTx era] mkTxOutput beo address mScriptHash = babbageEraOnwardsConstraints beo $ do - let sbe = babbageEraOnwardsToShelleyBasedEra beo + let sbe = inject beo [ TxOut address ( TxOutValueShelleyBased