Merge pull request #690 from IntersectMBO/jordan/inject-era-class

Implement Convert typeclass

cardano-api/cardano-api.cabal

@@ -71,6 +71,7 @@ library internal
     Cardano.Api.Eon.AlonzoEraOnwards
     Cardano.Api.Eon.BabbageEraOnwards
     Cardano.Api.Eon.ByronToAlonzoEra
+    Cardano.Api.Eon.Convert
     Cardano.Api.Eon.ConwayEraOnwards
     Cardano.Api.Eon.MaryEraOnwards
     Cardano.Api.Eon.ShelleyBasedEra

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -145,6 +145,7 @@ import qualified Cardano.Binary as CBOR
 import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Crypto.Hash.Class as CRYPTO
 import qualified Cardano.Crypto.Seed as Crypto
+import           Cardano.Api.Eon.Convert
 import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 import qualified Cardano.Ledger.BaseTypes as Ledger
 import qualified Cardano.Ledger.Core as Ledger
@@ -391,15 +392,13 @@ genLedgerValue w genAId genQuant =
 genValueDefault :: MaryEraOnwards era -> Gen (L.Value (ShelleyLedgerEra era))
 genValueDefault w = genLedgerValue w genAssetId genSignedNonZeroQuantity
 
-genValueForRole :: forall era. MaryEraOnwards era -> ParserValueRole -> Gen Value
+genValueForRole :: MaryEraOnwards era -> ParserValueRole -> Gen Value
 genValueForRole w =
   \case
     RoleMint ->
       genValueForMinting
     RoleUTxO ->
-      fromLedgerValue sbe <$> genValueForTxOut sbe
- where
-  sbe = inject w :: ShelleyBasedEra era
+      fromLedgerValue (convert w) <$> genValueForTxOut (convert w)
 
 -- | Generate a 'Value' suitable for minting, i.e. non-ADA asset ID and a
 -- positive or negative quantity.
@@ -468,7 +467,7 @@ genOperationalCertificateWithCounter = do
     Gen.either (genSigningKey AsStakePoolKey) (genSigningKey AsGenesisDelegateExtendedKey)
   kesP <- genKESPeriod
   c <- Gen.integral $ Range.linear 0 1000
-  let stakePoolVer = either getVerificationKey (convert . getVerificationKey) stkPoolOrGenDelExtSign
+  let stakePoolVer = either getVerificationKey (convert' . getVerificationKey) stkPoolOrGenDelExtSign
       iCounter = OperationalCertificateIssueCounter c stakePoolVer
 
   case issueOperationalCertificate kesVKey stkPoolOrGenDelExtSign kesP iCounter of
@@ -477,10 +476,10 @@ genOperationalCertificateWithCounter = do
     Left err -> error $ docToString $ prettyError err
     Right pair -> return pair
  where
-  convert
+  convert'
     :: VerificationKey GenesisDelegateExtendedKey
     -> VerificationKey StakePoolKey
-  convert =
+  convert' =
     ( castVerificationKey
         :: VerificationKey GenesisDelegateKey
         -> VerificationKey StakePoolKey
@@ -599,7 +598,7 @@ genTxAuxScripts era =
         TxAuxScripts w
           <$> Gen.list
             (Range.linear 0 3)
-            (genScriptInEra (inject w))
+            (genScriptInEra $ convert w)
     )
 
 genTxWithdrawals :: CardanoEra era -> Gen (TxWithdrawals build era)
@@ -1169,7 +1168,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 = inject w
+  let sbe = convert w
   proposalsWithWitnesses <-
     forM (extraProposals <> proposalsToBeWitnessed) $ \proposal ->
       (proposal,) <$> genScriptWitnessForStake sbe
@@ -1184,7 +1183,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 = inject w
+  let sbe = convert w
   votersWithWitnesses <- fmap fromList . forM voters $ \voter ->
     (voter,) <$> genScriptWitnessForStake sbe
   Api.TxVotingProcedures <$> Q.arbitrary <*> pure (pure votersWithWitnesses)

cardano-api/internal/Cardano/Api/Certificate.hs

@@ -78,6 +78,7 @@ where
 
 import           Cardano.Api.Address
 import           Cardano.Api.DRepMetadata
+import           Cardano.Api.Eon.Convert
 import           Cardano.Api.Eon.ConwayEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eon.ShelleyToBabbageEra
@@ -515,10 +516,10 @@ selectStakeCredentialWitness
 selectStakeCredentialWitness = \case
   ShelleyRelatedCertificate stbEra shelleyCert ->
     shelleyToBabbageEraConstraints stbEra $
-      getTxCertWitness (inject stbEra) shelleyCert
+      getTxCertWitness (convert stbEra) shelleyCert
   ConwayCertificate cEra conwayCert ->
     conwayEraOnwardsConstraints cEra $
-      getTxCertWitness (inject cEra) conwayCert
+      getTxCertWitness (convert cEra) conwayCert
 
 filterUnRegCreds
   :: Certificate era -> Maybe StakeCredential

cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs

@@ -18,6 +18,7 @@ module Cardano.Api.Eon.AllegraEraOnwards
   )
 where
 
+import           Cardano.Api.Eon.Convert
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras.Core
 import           Cardano.Api.Modes
@@ -67,11 +68,11 @@ instance ToCardanoEra AllegraEraOnwards where
     AllegraEraOnwardsBabbage -> BabbageEra
     AllegraEraOnwardsConway -> ConwayEra
 
-instance Inject (AllegraEraOnwards era) (CardanoEra era) where
-  inject = toCardanoEra
+instance Convert AllegraEraOnwards CardanoEra where
+  convert = toCardanoEra
 
-instance Inject (AllegraEraOnwards era) (ShelleyBasedEra era) where
-  inject = \case
+instance Convert AllegraEraOnwards ShelleyBasedEra where
+  convert = \case
     AllegraEraOnwardsAllegra -> ShelleyBasedEraAllegra
     AllegraEraOnwardsMary -> ShelleyBasedEraMary
     AllegraEraOnwardsAlonzo -> ShelleyBasedEraAlonzo
@@ -115,9 +116,9 @@ allegraEraOnwardsConstraints = \case
   AllegraEraOnwardsBabbage -> id
   AllegraEraOnwardsConway -> id
 
-{-# DEPRECATED allegraEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-}
+{-# DEPRECATED allegraEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
 allegraEraOnwardsToShelleyBasedEra :: AllegraEraOnwards era -> ShelleyBasedEra era
-allegraEraOnwardsToShelleyBasedEra = inject
+allegraEraOnwardsToShelleyBasedEra = convert
 
 class IsShelleyBasedEra era => IsAllegraBasedEra era where
   allegraBasedEra :: AllegraEraOnwards era

cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs

@@ -18,6 +18,7 @@ module Cardano.Api.Eon.AlonzoEraOnwards
   )
 where
 
+import           Cardano.Api.Eon.Convert
 import           Cardano.Api.Eon.MaryEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras.Core
@@ -71,11 +72,11 @@ instance ToCardanoEra AlonzoEraOnwards where
     AlonzoEraOnwardsBabbage -> BabbageEra
     AlonzoEraOnwardsConway -> ConwayEra
 
-instance Inject (AlonzoEraOnwards era) (CardanoEra era) where
-  inject = toCardanoEra
+instance Convert AlonzoEraOnwards CardanoEra where
+  convert = toCardanoEra
 
-instance Inject (AlonzoEraOnwards era) (ShelleyBasedEra era) where
-  inject = \case
+instance Convert AlonzoEraOnwards ShelleyBasedEra where
+  convert = \case
     AlonzoEraOnwardsAlonzo -> ShelleyBasedEraAlonzo
     AlonzoEraOnwardsBabbage -> ShelleyBasedEraBabbage
     AlonzoEraOnwardsConway -> ShelleyBasedEraConway
@@ -124,9 +125,9 @@ alonzoEraOnwardsConstraints = \case
   AlonzoEraOnwardsBabbage -> id
   AlonzoEraOnwardsConway -> id
 
-{-# DEPRECATED alonzoEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-}
+{-# DEPRECATED alonzoEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
 alonzoEraOnwardsToShelleyBasedEra :: AlonzoEraOnwards era -> ShelleyBasedEra era
-alonzoEraOnwardsToShelleyBasedEra = inject
+alonzoEraOnwardsToShelleyBasedEra = convert
 
 class IsMaryBasedEra era => IsAlonzoBasedEra era where
   alonzoBasedEra :: AlonzoEraOnwards era

cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -21,6 +20,7 @@ module Cardano.Api.Eon.BabbageEraOnwards
 where
 
 import           Cardano.Api.Eon.AlonzoEraOnwards
+import           Cardano.Api.Eon.Convert
 import           Cardano.Api.Eon.MaryEraOnwards
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras.Core
@@ -70,14 +70,16 @@ instance ToCardanoEra BabbageEraOnwards where
     BabbageEraOnwardsBabbage -> BabbageEra
     BabbageEraOnwardsConway -> ConwayEra
 
-instance Inject (BabbageEraOnwards era) (CardanoEra era) where
-  inject = toCardanoEra
+instance Convert BabbageEraOnwards CardanoEra where
+  convert = toCardanoEra
 
-instance Inject (BabbageEraOnwards era) (ShelleyBasedEra era) where
-  inject = inject @(MaryEraOnwards era) . inject
+instance Convert BabbageEraOnwards ShelleyBasedEra where
+  convert = \case
+    BabbageEraOnwardsBabbage -> ShelleyBasedEraBabbage
+    BabbageEraOnwardsConway -> ShelleyBasedEraConway
 
-instance Inject (BabbageEraOnwards era) (MaryEraOnwards era) where
-  inject = \case
+instance Convert BabbageEraOnwards MaryEraOnwards where
+  convert = \case
     BabbageEraOnwardsBabbage -> MaryEraOnwardsBabbage
     BabbageEraOnwardsConway -> MaryEraOnwardsConway
 
@@ -124,9 +126,9 @@ babbageEraOnwardsConstraints = \case
   BabbageEraOnwardsBabbage -> id
   BabbageEraOnwardsConway -> id
 
-{-# DEPRECATED babbageEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-}
+{-# DEPRECATED babbageEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
 babbageEraOnwardsToShelleyBasedEra :: BabbageEraOnwards era -> ShelleyBasedEra era
-babbageEraOnwardsToShelleyBasedEra = inject
+babbageEraOnwardsToShelleyBasedEra = convert
 
 class IsAlonzoBasedEra era => IsBabbageBasedEra era where
   babbageBasedEra :: BabbageEraOnwards era

cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs

@@ -15,6 +15,7 @@ module Cardano.Api.Eon.ByronToAlonzoEra
   )
 where
 
+import           Cardano.Api.Eon.Convert
 import           Cardano.Api.Eras.Core
 
 import           Data.Typeable (Typeable)
@@ -48,8 +49,8 @@ instance ToCardanoEra ByronToAlonzoEra where
     ByronToAlonzoEraMary -> MaryEra
     ByronToAlonzoEraAlonzo -> AlonzoEra
 
-instance Inject (ByronToAlonzoEra era) (CardanoEra era) where
-  inject = toCardanoEra
+instance Convert ByronToAlonzoEra CardanoEra where
+  convert = toCardanoEra
 
 type ByronToAlonzoEraConstraints era =
   ( IsCardanoEra era

cardano-api/internal/Cardano/Api/Eon/Convert.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Cardano.Api.Eon.Convert
+  ( Convert (..)
+  )
+where
+
+import           Data.Kind (Type)
+
+-- | The Convert class is aimed at exposing a single interface that lets us
+-- convert between eons. However this is generalizable to any injective
+-- relationship between types.
+class Convert (f :: a -> Type) (g :: a -> Type) where
+  convert :: forall era. f era -> g era

cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs

@@ -20,6 +20,7 @@ module Cardano.Api.Eon.ConwayEraOnwards
 where
 
 import           Cardano.Api.Eon.BabbageEraOnwards
+import           Cardano.Api.Eon.Convert
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras.Core
 import           Cardano.Api.Modes
@@ -67,15 +68,15 @@ instance ToCardanoEra ConwayEraOnwards where
   toCardanoEra = \case
     ConwayEraOnwardsConway -> ConwayEra
 
-instance Inject (ConwayEraOnwards era) (CardanoEra era) where
-  inject = toCardanoEra
+instance Convert ConwayEraOnwards CardanoEra where
+  convert = toCardanoEra
 
-instance Inject (ConwayEraOnwards era) (ShelleyBasedEra era) where
-  inject = \case
+instance Convert ConwayEraOnwards ShelleyBasedEra where
+  convert = \case
     ConwayEraOnwardsConway -> ShelleyBasedEraConway
 
-instance Inject (ConwayEraOnwards era) (BabbageEraOnwards era) where
-  inject = \case
+instance Convert ConwayEraOnwards BabbageEraOnwards where
+  convert = \case
     ConwayEraOnwardsConway -> BabbageEraOnwardsConway
 
 type ConwayEraOnwardsConstraints era =
@@ -125,13 +126,13 @@ conwayEraOnwardsConstraints
 conwayEraOnwardsConstraints = \case
   ConwayEraOnwardsConway -> id
 
-{-# DEPRECATED conwayEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-}
+{-# DEPRECATED conwayEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
 conwayEraOnwardsToShelleyBasedEra :: ConwayEraOnwards era -> ShelleyBasedEra era
-conwayEraOnwardsToShelleyBasedEra = inject
+conwayEraOnwardsToShelleyBasedEra = convert
 
-{-# DEPRECATED conwayEraOnwardsToBabbageEraOnwards "Use 'inject' instead." #-}
+{-# DEPRECATED conwayEraOnwardsToBabbageEraOnwards "Use 'convert' instead." #-}
 conwayEraOnwardsToBabbageEraOnwards :: ConwayEraOnwards era -> BabbageEraOnwards era
-conwayEraOnwardsToBabbageEraOnwards = inject
+conwayEraOnwardsToBabbageEraOnwards = convert
 
 class IsBabbageBasedEra era => IsConwayBasedEra era where
   conwayBasedEra :: ConwayEraOnwards era

cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs

@@ -19,6 +19,7 @@ module Cardano.Api.Eon.MaryEraOnwards
 where
 
 import           Cardano.Api.Eon.AllegraEraOnwards
+import           Cardano.Api.Eon.Convert
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras.Core
 import           Cardano.Api.Modes
@@ -68,11 +69,11 @@ instance ToCardanoEra MaryEraOnwards where
     MaryEraOnwardsBabbage -> BabbageEra
     MaryEraOnwardsConway -> ConwayEra
 
-instance Inject (MaryEraOnwards era) (CardanoEra era) where
-  inject = toCardanoEra
+instance Convert MaryEraOnwards CardanoEra where
+  convert = toCardanoEra
 
-instance Inject (MaryEraOnwards era) (ShelleyBasedEra era) where
-  inject = \case
+instance Convert MaryEraOnwards ShelleyBasedEra where
+  convert = \case
     MaryEraOnwardsMary -> ShelleyBasedEraMary
     MaryEraOnwardsAlonzo -> ShelleyBasedEraAlonzo
     MaryEraOnwardsBabbage -> ShelleyBasedEraBabbage
@@ -116,9 +117,9 @@ maryEraOnwardsConstraints = \case
   MaryEraOnwardsBabbage -> id
   MaryEraOnwardsConway -> id
 
-{-# DEPRECATED maryEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-}
+{-# DEPRECATED maryEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-}
 maryEraOnwardsToShelleyBasedEra :: MaryEraOnwards era -> ShelleyBasedEra era
-maryEraOnwardsToShelleyBasedEra = inject
+maryEraOnwardsToShelleyBasedEra = convert
 
 class IsAllegraBasedEra era => IsMaryBasedEra era where
   maryBasedEra :: MaryEraOnwards era

cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs

@@ -36,6 +36,7 @@ module Cardano.Api.Eon.ShelleyBasedEra
   )
 where
 
+import           Cardano.Api.Eon.Convert
 import           Cardano.Api.Eras.Core
 import           Cardano.Api.Modes
 import           Cardano.Api.Orphans ()
@@ -179,8 +180,8 @@ instance ToCardanoEra ShelleyBasedEra where
     ShelleyBasedEraBabbage -> BabbageEra
     ShelleyBasedEraConway -> ConwayEra
 
-instance Inject (ShelleyBasedEra era) (CardanoEra era) where
-  inject = toCardanoEra
+instance Convert ShelleyBasedEra CardanoEra where
+  convert = 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

cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs

@@ -17,6 +17,7 @@ module Cardano.Api.Eon.ShelleyEraOnly
   )
 where
 
+import           Cardano.Api.Eon.Convert
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Eras.Core
 import           Cardano.Api.Modes
@@ -60,11 +61,11 @@ instance ToCardanoEra ShelleyEraOnly where
   toCardanoEra = \case
     ShelleyEraOnlyShelley -> ShelleyEra
 
-instance Inject (ShelleyEraOnly era) (CardanoEra era) where
-  inject = toCardanoEra
+instance Convert ShelleyEraOnly CardanoEra where
+  convert = toCardanoEra
 
-instance Inject (ShelleyEraOnly era) (ShelleyBasedEra era) where
-  inject = \case
+instance Convert ShelleyEraOnly ShelleyBasedEra where
+  convert = \case
     ShelleyEraOnlyShelley -> ShelleyBasedEraShelley
 
 type ShelleyEraOnlyConstraints era =
@@ -107,6 +108,6 @@ shelleyEraOnlyConstraints
 shelleyEraOnlyConstraints = \case
   ShelleyEraOnlyShelley -> id
 
-{-# DEPRECATED shelleyEraOnlyToShelleyBasedEra "Use 'inject' instead." #-}
+{-# DEPRECATED shelleyEraOnlyToShelleyBasedEra "Use 'convert' instead." #-}
 shelleyEraOnlyToShelleyBasedEra :: ShelleyEraOnly era -> ShelleyBasedEra era
-shelleyEraOnlyToShelleyBasedEra = inject
+shelleyEraOnlyToShelleyBasedEra = convert