Add Classy versions of Era witness functions

cardano-api/CHANGELOG.md

@@ -1,5 +1,10 @@
 # Changelog for cardano-api
 
+## 9.0.1.0
+
+- - Add `IsAllegraBasedEra`, `IsAlonzoBasedEra`, `IsBabbageBasedEra`, `IsConwayBasedEra`, `IsMaryBasedEra` type classes.
+  - Add `ToAlonzoScript` and `HasScriptLanguageInEra` type classes.
+
 ## 9.0.0.0
 
 - - Remove redundant era conversion functions. Use `toCardanoEra` instead.

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

@@ -13,6 +13,7 @@ module Cardano.Api.Eon.AllegraEraOnwards
   , allegraEraOnwardsConstraints
   , allegraEraOnwardsToShelleyBasedEra
   , AllegraEraOnwardsConstraints
+  , IsAllegraBasedEra (..)
   )
 where
 
@@ -107,3 +108,21 @@ allegraEraOnwardsToShelleyBasedEra = \case
   AllegraEraOnwardsAlonzo -> ShelleyBasedEraAlonzo
   AllegraEraOnwardsBabbage -> ShelleyBasedEraBabbage
   AllegraEraOnwardsConway -> ShelleyBasedEraConway
+
+class IsAllegraBasedEra era where
+  allegraBasedEra :: AllegraEraOnwards era
+
+instance IsAllegraBasedEra AllegraEra where
+  allegraBasedEra = AllegraEraOnwardsAllegra
+
+instance IsAllegraBasedEra MaryEra where
+  allegraBasedEra = AllegraEraOnwardsMary
+
+instance IsAllegraBasedEra AlonzoEra where
+  allegraBasedEra = AllegraEraOnwardsAlonzo
+
+instance IsAllegraBasedEra BabbageEra where
+  allegraBasedEra = AllegraEraOnwardsBabbage
+
+instance IsAllegraBasedEra ConwayEra where
+  allegraBasedEra = AllegraEraOnwardsConway

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

@@ -13,6 +13,7 @@ module Cardano.Api.Eon.AlonzoEraOnwards
   , alonzoEraOnwardsConstraints
   , alonzoEraOnwardsToShelleyBasedEra
   , AlonzoEraOnwardsConstraints
+  , IsAlonzoBasedEra (..)
   )
 where
 
@@ -115,3 +116,15 @@ alonzoEraOnwardsToShelleyBasedEra = \case
   AlonzoEraOnwardsAlonzo -> ShelleyBasedEraAlonzo
   AlonzoEraOnwardsBabbage -> ShelleyBasedEraBabbage
   AlonzoEraOnwardsConway -> ShelleyBasedEraConway
+
+class IsAlonzoBasedEra era where
+  alonzoBasedEra :: AlonzoEraOnwards era
+
+instance IsAlonzoBasedEra AlonzoEra where
+  alonzoBasedEra = AlonzoEraOnwardsAlonzo
+
+instance IsAlonzoBasedEra BabbageEra where
+  alonzoBasedEra = AlonzoEraOnwardsBabbage
+
+instance IsAlonzoBasedEra ConwayEra where
+  alonzoBasedEra = AlonzoEraOnwardsConway

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

@@ -13,6 +13,7 @@ module Cardano.Api.Eon.BabbageEraOnwards
   , babbageEraOnwardsConstraints
   , babbageEraOnwardsToShelleyBasedEra
   , BabbageEraOnwardsConstraints
+  , IsBabbageBasedEra (..)
   )
 where
 
@@ -109,3 +110,12 @@ babbageEraOnwardsToShelleyBasedEra :: BabbageEraOnwards era -> ShelleyBasedEra e
 babbageEraOnwardsToShelleyBasedEra = \case
   BabbageEraOnwardsBabbage -> ShelleyBasedEraBabbage
   BabbageEraOnwardsConway -> ShelleyBasedEraConway
+
+class IsBabbageBasedEra era where
+  babbageBasedEra :: BabbageEraOnwards era
+
+instance IsBabbageBasedEra BabbageEra where
+  babbageBasedEra = BabbageEraOnwardsBabbage
+
+instance IsBabbageBasedEra ConwayEra where
+  babbageBasedEra = BabbageEraOnwardsConway

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

@@ -13,6 +13,7 @@ module Cardano.Api.Eon.ConwayEraOnwards
   , conwayEraOnwardsConstraints
   , conwayEraOnwardsToShelleyBasedEra
   , ConwayEraOnwardsConstraints
+  , IsConwayBasedEra (..)
   )
 where
 
@@ -110,3 +111,9 @@ conwayEraOnwardsConstraints = \case
 conwayEraOnwardsToShelleyBasedEra :: ConwayEraOnwards era -> ShelleyBasedEra era
 conwayEraOnwardsToShelleyBasedEra = \case
   ConwayEraOnwardsConway -> ShelleyBasedEraConway
+
+class IsConwayBasedEra era where
+  conwayBasedEra :: ConwayEraOnwards era
+
+instance IsConwayBasedEra ConwayEra where
+  conwayBasedEra = ConwayEraOnwardsConway

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

@@ -13,6 +13,7 @@ module Cardano.Api.Eon.MaryEraOnwards
   , maryEraOnwardsConstraints
   , maryEraOnwardsToShelleyBasedEra
   , MaryEraOnwardsConstraints
+  , IsMaryBasedEra (..)
   )
 where
 
@@ -107,3 +108,18 @@ maryEraOnwardsToShelleyBasedEra = \case
   MaryEraOnwardsAlonzo -> ShelleyBasedEraAlonzo
   MaryEraOnwardsBabbage -> ShelleyBasedEraBabbage
   MaryEraOnwardsConway -> ShelleyBasedEraConway
+
+class IsMaryBasedEra era where
+  maryBasedEra :: MaryEraOnwards era
+
+instance IsMaryBasedEra MaryEra where
+  maryBasedEra = MaryEraOnwardsMary
+
+instance IsMaryBasedEra AlonzoEra where
+  maryBasedEra = MaryEraOnwardsAlonzo
+
+instance IsMaryBasedEra BabbageEra where
+  maryBasedEra = MaryEraOnwardsBabbage
+
+instance IsMaryBasedEra ConwayEra where
+  maryBasedEra = MaryEraOnwardsConway

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

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -40,6 +41,8 @@ module Cardano.Api.Script
   , ScriptInEra (..)
   , toScriptInEra
   , eraOfScriptInEra
+  , HasScriptLanguageInEra (..)
+  , ToAlonzoScript (..)
 
     -- * Reference scripts
   , ReferenceScript (..)
@@ -1019,6 +1022,54 @@ instance IsPlutusScriptLanguage lang => HasTextEnvelope (PlutusScript lang) wher
       PlutusScriptV2 -> "PlutusScriptV2"
       PlutusScriptV3 -> "PlutusScriptV3"
 
+-- | Smart-constructor for 'ScriptLanguageInEra' to write functions
+-- manipulating scripts that do not commit to a particular era.
+class HasScriptLanguageInEra lang era where
+  scriptLanguageInEra :: ScriptLanguageInEra lang era
+
+instance HasScriptLanguageInEra PlutusScriptV1 AlonzoEra where
+  scriptLanguageInEra = PlutusScriptV1InAlonzo
+
+instance HasScriptLanguageInEra PlutusScriptV1 BabbageEra where
+  scriptLanguageInEra = PlutusScriptV1InBabbage
+
+instance HasScriptLanguageInEra PlutusScriptV2 BabbageEra where
+  scriptLanguageInEra = PlutusScriptV2InBabbage
+
+instance HasScriptLanguageInEra PlutusScriptV1 ConwayEra where
+  scriptLanguageInEra = PlutusScriptV1InConway
+
+instance HasScriptLanguageInEra PlutusScriptV2 ConwayEra where
+  scriptLanguageInEra = PlutusScriptV2InConway
+
+instance HasScriptLanguageInEra PlutusScriptV3 ConwayEra where
+  scriptLanguageInEra = PlutusScriptV3InConway
+
+class ToAlonzoScript lang era where
+  toLedgerScript
+    :: PlutusScript lang
+    -> Conway.AlonzoScript (ShelleyLedgerEra era)
+
+instance ToAlonzoScript PlutusScriptV1 BabbageEra where
+  toLedgerScript (PlutusScriptSerialised bytes) =
+    Conway.PlutusScript $ Conway.BabbagePlutusV1 $ Plutus.Plutus $ Plutus.PlutusBinary bytes
+
+instance ToAlonzoScript PlutusScriptV2 BabbageEra where
+  toLedgerScript (PlutusScriptSerialised bytes) =
+    Conway.PlutusScript $ Conway.BabbagePlutusV2 $ Plutus.Plutus $ Plutus.PlutusBinary bytes
+
+instance ToAlonzoScript PlutusScriptV1 ConwayEra where
+  toLedgerScript (PlutusScriptSerialised bytes) =
+    Conway.PlutusScript $ Conway.ConwayPlutusV1 $ Plutus.Plutus $ Plutus.PlutusBinary bytes
+
+instance ToAlonzoScript PlutusScriptV2 ConwayEra where
+  toLedgerScript (PlutusScriptSerialised bytes) =
+    Conway.PlutusScript $ Conway.ConwayPlutusV2 $ Plutus.Plutus $ Plutus.PlutusBinary bytes
+
+instance ToAlonzoScript PlutusScriptV3 ConwayEra where
+  toLedgerScript (PlutusScriptSerialised bytes) =
+    Conway.PlutusScript $ Conway.ConwayPlutusV3 $ Plutus.Plutus $ Plutus.PlutusBinary bytes
+
 -- | An example Plutus script that always succeeds, irrespective of inputs.
 --
 -- For example, if one were to use this for a payment address then it would

cardano-api/src/Cardano/Api.hs

@@ -79,26 +79,31 @@ module Cardano.Api
 
     -- ** From Allegra
   , AllegraEraOnwards (..)
+  , IsAllegraBasedEra (..)
 
     -- ** From Mary
   , MaryEraOnwards (..)
   , maryEraOnwardsConstraints
   , maryEraOnwardsToShelleyBasedEra
+  , IsMaryBasedEra (..)
 
     -- ** From Alonzo
   , AlonzoEraOnwards (..)
   , alonzoEraOnwardsConstraints
   , alonzoEraOnwardsToShelleyBasedEra
+  , IsAlonzoBasedEra (..)
 
     -- ** From Babbage
   , BabbageEraOnwards (..)
   , babbageEraOnwardsConstraints
   , babbageEraOnwardsToShelleyBasedEra
+  , IsBabbageBasedEra (..)
 
     -- ** From Conway
   , ConwayEraOnwards (..)
   , conwayEraOnwardsConstraints
   , conwayEraOnwardsToShelleyBasedEra
+  , IsConwayBasedEra (..)
 
     -- * Era case handling
 
@@ -501,6 +506,8 @@ module Cardano.Api
   , ScriptInEra (..)
   , toScriptInEra
   , eraOfScriptInEra
+  , HasScriptLanguageInEra (..)
+  , ToAlonzoScript (..)
 
     -- ** Use of a script in an era as a witness
   , WitCtxTxIn