Parameterise Certificate type with phantom era type argument

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

@@ -598,7 +598,7 @@ genTxCertificates era =
         ]
 
 -- TODO: Add remaining certificates
-genCertificate :: Gen Certificate
+genCertificate :: Gen (Certificate era)
 genCertificate =
   Gen.choice
     [ StakeAddressRegistrationCertificate <$> genStakeCredential

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -45,6 +46,8 @@ module Cardano.Api.Certificate (
 
 import           Cardano.Api.Address
 import           Cardano.Api.DRepMetadata
+import           Cardano.Api.EraCast
+import           Cardano.Api.Eras
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Praos
 import           Cardano.Api.Keys.Shelley
@@ -73,14 +76,15 @@ import qualified Data.Sequence.Strict as Seq
 import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text.Encoding as Text
+import           Data.Typeable
 import           Network.Socket (PortNumber)
 
 
 -- ----------------------------------------------------------------------------
 -- Certificates embedded in transactions
 --
 
-data Certificate =
+data Certificate era =
 
      -- Stake address certificates
      StakeAddressRegistrationCertificate   StakeCredential
@@ -109,28 +113,49 @@ data Certificate =
   deriving stock (Eq, Show)
   deriving anyclass SerialiseAsCBOR
 
-instance HasTypeProxy Certificate where
-    data AsType Certificate = AsCertificate
+instance Typeable era => HasTypeProxy (Certificate era) where
+    data AsType (Certificate era) = AsCertificate
     proxyToAsType _ = AsCertificate
 
-instance ToCBOR Certificate where
+instance Typeable era => ToCBOR (Certificate era) where
     toCBOR = Shelley.toEraCBOR @Shelley.Shelley . toShelleyCertificate
 
-instance FromCBOR Certificate where
+instance Typeable era => FromCBOR (Certificate era) where
     fromCBOR = fromShelleyCertificate <$> Shelley.fromEraCBOR @Shelley.Shelley
 
-instance HasTextEnvelope Certificate where
+instance Typeable era => HasTextEnvelope (Certificate era) where
     textEnvelopeType _ = "CertificateShelley"
     textEnvelopeDefaultDescr cert = case cert of
-      StakeAddressRegistrationCertificate{}   -> "Stake address registration"
-      StakeAddressDeregistrationCertificate{} -> "Stake address deregistration"
-      StakeAddressPoolDelegationCertificate{} -> "Stake address stake pool delegation"
-      StakePoolRegistrationCertificate{}      -> "Pool registration"
-      StakePoolRetirementCertificate{}        -> "Pool retirement"
-      GenesisKeyDelegationCertificate{}       -> "Genesis key delegation"
-      CommitteeDelegationCertificate{} -> "Constitution committee member key delegation"
-      CommitteeHotKeyDeregistrationCertificate{} -> "Constitution committee member hot key deregistration"
-      MIRCertificate{}                        -> "MIR"
+      StakeAddressRegistrationCertificate{}       -> "Stake address registration"
+      StakeAddressDeregistrationCertificate{}     -> "Stake address deregistration"
+      StakeAddressPoolDelegationCertificate{}     -> "Stake address stake pool delegation"
+      StakePoolRegistrationCertificate{}          -> "Pool registration"
+      StakePoolRetirementCertificate{}            -> "Pool retirement"
+      GenesisKeyDelegationCertificate{}           -> "Genesis key delegation"
+      CommitteeDelegationCertificate{}            -> "Constitution committee member key delegation"
+      CommitteeHotKeyDeregistrationCertificate{}  -> "Constitution committee member hot key deregistration"
+      MIRCertificate{}                            -> "MIR"
+
+instance EraCast Certificate where
+  eraCast _ = \case
+    StakeAddressRegistrationCertificate c ->
+      pure $ StakeAddressRegistrationCertificate c
+    StakeAddressDeregistrationCertificate stakeCredential ->
+      pure $ StakeAddressDeregistrationCertificate stakeCredential
+    StakeAddressPoolDelegationCertificate stakeCredential poolId ->
+      pure $ StakeAddressPoolDelegationCertificate stakeCredential poolId
+    StakePoolRegistrationCertificate stakePoolParameters ->
+      pure $ StakePoolRegistrationCertificate stakePoolParameters
+    StakePoolRetirementCertificate poolId epochNo ->
+      pure $ StakePoolRetirementCertificate poolId epochNo
+    GenesisKeyDelegationCertificate genesisKH genesisDelegateKH vrfKH ->
+      pure $ GenesisKeyDelegationCertificate genesisKH genesisDelegateKH vrfKH
+    CommitteeDelegationCertificate coldKeyHash hotKeyHash ->
+      pure $ CommitteeDelegationCertificate coldKeyHash hotKeyHash
+    CommitteeHotKeyDeregistrationCertificate coldKeyHash ->
+      pure $ CommitteeHotKeyDeregistrationCertificate coldKeyHash
+    MIRCertificate mirPot mirTarget ->
+      pure $ MIRCertificate mirPot mirTarget
 
 -- | The 'MIRTarget' determines the target of a 'MIRCertificate'.
 -- A 'MIRCertificate' moves lovelace from either the reserves or the treasury
@@ -209,47 +234,81 @@ data DRepMetadataReference =
 -- Constructor functions
 --
 
-makeStakeAddressRegistrationCertificate :: StakeCredential -> Certificate
-makeStakeAddressRegistrationCertificate = StakeAddressRegistrationCertificate
-
-makeStakeAddressDeregistrationCertificate :: StakeCredential -> Certificate
-makeStakeAddressDeregistrationCertificate = StakeAddressDeregistrationCertificate
-
-makeStakeAddressPoolDelegationCertificate :: StakeCredential -> PoolId -> Certificate
-makeStakeAddressPoolDelegationCertificate = StakeAddressPoolDelegationCertificate
-
-makeStakePoolRegistrationCertificate :: StakePoolParameters -> Certificate
-makeStakePoolRegistrationCertificate = StakePoolRegistrationCertificate
-
-makeStakePoolRetirementCertificate :: PoolId -> EpochNo -> Certificate
-makeStakePoolRetirementCertificate = StakePoolRetirementCertificate
-
-makeGenesisKeyDelegationCertificate :: Hash GenesisKey
-                                    -> Hash GenesisDelegateKey
-                                    -> Hash VrfKey
-                                    -> Certificate
-makeGenesisKeyDelegationCertificate = GenesisKeyDelegationCertificate
+makeStakeAddressRegistrationCertificate :: ()
+  => CardanoEra era
+  -> StakeCredential
+  -> Certificate era
+makeStakeAddressRegistrationCertificate _ =
+  StakeAddressRegistrationCertificate
+
+makeStakeAddressDeregistrationCertificate :: ()
+  => CardanoEra era
+  -> StakeCredential
+  -> Certificate era
+makeStakeAddressDeregistrationCertificate _ =
+  StakeAddressDeregistrationCertificate
+
+makeStakeAddressPoolDelegationCertificate :: ()
+  => CardanoEra era
+  -> StakeCredential
+  -> PoolId
+  -> Certificate era
+makeStakeAddressPoolDelegationCertificate _ =
+  StakeAddressPoolDelegationCertificate
+
+makeStakePoolRegistrationCertificate :: ()
+  => CardanoEra era
+  -> StakePoolParameters
+  -> Certificate era
+makeStakePoolRegistrationCertificate _ =
+  StakePoolRegistrationCertificate
+
+makeStakePoolRetirementCertificate :: ()
+  => CardanoEra era
+  -> PoolId
+  -> EpochNo
+  -> Certificate era
+makeStakePoolRetirementCertificate _ =
+  StakePoolRetirementCertificate
+
+makeGenesisKeyDelegationCertificate :: ()
+  => CardanoEra era
+  -> Hash GenesisKey
+  -> Hash GenesisDelegateKey
+  -> Hash VrfKey
+  -> Certificate era
+makeGenesisKeyDelegationCertificate _ =
+  GenesisKeyDelegationCertificate
 
 makeCommitteeDelegationCertificate :: ()
-  => Hash CommitteeColdKey
+  => CardanoEra era
+  -> Hash CommitteeColdKey
   -> Hash CommitteeHotKey
-  -> Certificate
-makeCommitteeDelegationCertificate = CommitteeDelegationCertificate
+  -> Certificate era
+makeCommitteeDelegationCertificate _ =
+  CommitteeDelegationCertificate
 
 makeCommitteeHotKeyUnregistrationCertificate :: ()
-  => Hash CommitteeColdKey
-  -> Certificate
-makeCommitteeHotKeyUnregistrationCertificate = CommitteeHotKeyDeregistrationCertificate
+  => CardanoEra era
+  -> Hash CommitteeColdKey
+  -> Certificate era
+makeCommitteeHotKeyUnregistrationCertificate _ =
+  CommitteeHotKeyDeregistrationCertificate
 
-makeMIRCertificate :: MIRPot -> MIRTarget -> Certificate
-makeMIRCertificate = MIRCertificate
+makeMIRCertificate :: ()
+  => CardanoEra era
+  -> MIRPot
+  -> MIRTarget
+  -> Certificate era
+makeMIRCertificate _ =
+  MIRCertificate
 
 
 -- ----------------------------------------------------------------------------
 -- Internal conversion functions
 --
 
-toShelleyCertificate :: Certificate -> Shelley.DCert StandardCrypto
+toShelleyCertificate :: Certificate era -> Shelley.DCert StandardCrypto
 toShelleyCertificate (StakeAddressRegistrationCertificate stakecred) =
     Shelley.DCertDeleg $
       Shelley.RegKey
@@ -330,7 +389,7 @@ toShelleyCertificate (MIRCertificate mirPot (SendToTreasuryMIR amount)) =
         error "toShelleyCertificate: Incorrect MIRPot specified. Expected ReservesMIR but got TreasuryMIR"
 
 
-fromShelleyCertificate :: Shelley.DCert StandardCrypto -> Certificate
+fromShelleyCertificate :: Shelley.DCert StandardCrypto -> Certificate era
 fromShelleyCertificate (Shelley.DCertDeleg (Shelley.RegKey stakecred)) =
     StakeAddressRegistrationCertificate
       (fromShelleyStakeCredential stakecred)

cardano-api/internal/Cardano/Api/Convenience/Query.hs

@@ -71,7 +71,7 @@ renderQueryConvenienceError (QceUnsupportedNtcVersion (UnsupportedNtcVersionErro
 queryStateForBalancedTx :: ()
   => CardanoEra era
   -> [TxIn]
-  -> [Certificate]
+  -> [Certificate era]
   -> LocalStateQueryExpr block point (QueryInMode CardanoMode) r IO
       ( Either
           QueryConvenienceError

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

@@ -25,6 +25,7 @@ module Cardano.Api.Eras
   , IsCardanoEra(..)
   , AnyCardanoEra(..)
   , anyCardanoEra
+  , cardanoEraConstraints
   , InAnyCardanoEra(..)
 
     -- * Deprecated aliases
@@ -69,6 +70,7 @@ import           Control.DeepSeq
 import           Data.Aeson (FromJSON (..), ToJSON, toJSON, withText)
 import qualified Data.Text as Text
 import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
+import           Data.Typeable (Typeable)
 
 -- | A type used as a tag to distinguish the Byron era.
 data ByronEra
@@ -558,3 +560,13 @@ withShelleyBasedEraConstraintsForLedger = \case
   ShelleyBasedEraAlonzo  -> id
   ShelleyBasedEraBabbage -> id
   ShelleyBasedEraConway  -> id
+
+cardanoEraConstraints :: CardanoEra era -> (Typeable era => IsCardanoEra era => a) -> a
+cardanoEraConstraints = \case
+  ByronEra   -> id
+  ShelleyEra -> id
+  AllegraEra -> id
+  MaryEra    -> id
+  AlonzoEra  -> id
+  BabbageEra -> id
+  ConwayEra  -> id

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

@@ -19,7 +19,6 @@ where
 
 import           Cardano.Api.Address (StakeCredential, fromShelleyStakeCredential)
 import           Cardano.Api.Block (EpochNo)
-import           Cardano.Api.Certificate (Certificate)
 import           Cardano.Api.Keys.Shelley (Hash (StakePoolKeyHash), StakePoolKey)
 import           Cardano.Api.Value (Lovelace, fromShelleyDeltaLovelace, fromShelleyLovelace)
 
@@ -60,9 +59,9 @@ import           Data.SOP.Strict
 
 data LedgerEvent
   = -- | The given pool is being registered for the first time on chain.
-    PoolRegistration Certificate
+    PoolRegistration
   | -- | The given pool already exists and is being re-registered.
-    PoolReRegistration Certificate
+    PoolReRegistration
   | -- | Incremental rewards are being computed.
     IncrementalRewardsDistribution EpochNo (Map StakeCredential (Set (Reward StandardCrypto)))
   | -- | Reward distribution has completed.

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

@@ -11,6 +11,7 @@
 --
 module Cardano.Api.SerialiseTextEnvelope
   ( HasTextEnvelope(..)
+  , textEnvelopeTypeInEra
   , TextEnvelope(..)
   , TextEnvelopeType(..)
   , TextEnvelopeDescr(..)
@@ -33,6 +34,7 @@ module Cardano.Api.SerialiseTextEnvelope
   , AsType(..)
   ) where
 
+import           Cardano.Api.Eras
 import           Cardano.Api.Error
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.IO
@@ -165,6 +167,13 @@ class SerialiseAsCBOR a => HasTextEnvelope a where
     textEnvelopeDefaultDescr :: a -> TextEnvelopeDescr
     textEnvelopeDefaultDescr _ = ""
 
+textEnvelopeTypeInEra :: ()
+  => HasTextEnvelope (f era)
+  => CardanoEra era
+  -> AsType (f era)
+  -> TextEnvelopeType
+textEnvelopeTypeInEra _ =
+  textEnvelopeType
 
 serialiseToTextEnvelope :: forall a. HasTextEnvelope a
                         => Maybe TextEnvelopeDescr -> a -> TextEnvelope

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

@@ -1693,7 +1693,7 @@ data TxCertificates build era where
      TxCertificatesNone :: TxCertificates build era
 
      TxCertificates     :: CertificatesSupportedInEra era
-                        -> [Certificate]
+                        -> [Certificate era]
                         -> BuildTxWith build
                              (Map StakeCredential (Witness WitCtxStake era))
                         -> TxCertificates build era

cardano-api/src/Cardano/Api.hs

@@ -23,6 +23,7 @@ module Cardano.Api (
     IsCardanoEra(..),
     AnyCardanoEra(..),
     anyCardanoEra,
+    cardanoEraConstraints,
     InAnyCardanoEra(..),
 
     -- ** Shelley-based eras
@@ -564,6 +565,7 @@ module Cardano.Api (
     TextEnvelopeType(..),
     TextEnvelopeDescr,
     TextEnvelopeError(..),
+    textEnvelopeTypeInEra,
     textEnvelopeRawCBOR,
     textEnvelopeToJSON,
     serialiseToTextEnvelope,