Add Inject instances for Eons

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)

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

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

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

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

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

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

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

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.

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

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