Add Classy versions of Era witness functions

cardano-api/cardano-api.cabal

@@ -63,6 +63,12 @@ library internal
     Cardano.Api.Anchor
     Cardano.Api.Block
     Cardano.Api.Certificate
+    Cardano.Api.Class.HasScriptLanguageInEra
+    Cardano.Api.Class.IsAllegraEraOnwards
+    Cardano.Api.Class.IsAlonzoEraOnwards
+    Cardano.Api.Class.IsBabbageEraOnwards
+    Cardano.Api.Class.IsMaryEraOnwards
+    Cardano.Api.Class.ToAlonzoScript
     Cardano.Api.Convenience.Construction
     Cardano.Api.Convenience.Query
     Cardano.Api.DRepMetadata

cardano-api/internal/Cardano/Api/Class/HasScriptLanguageInEra.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Cardano.Api.Class.HasScriptLanguageInEra where
+
+import Cardano.Api.Eras (AlonzoEra, BabbageEra, ConwayEra)
+import Cardano.Api.Script (PlutusScriptV1, PlutusScriptV2, PlutusScriptV3, ScriptLanguageInEra (..))
+
+-- | 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

cardano-api/internal/Cardano/Api/Class/IsAllegraEraOnwards.hs

@@ -0,0 +1,24 @@
+module Cardano.Api.Class.IsAllegraEraOnwards where
+
+import Cardano.Api.Eon.AllegraEraOnwards (AllegraEraOnwards (..))
+import Cardano.Api.Eras (AllegraEra, AlonzoEra, BabbageEra, ConwayEra, MaryEra)
+
+-- | Type class to produce 'AllegraEraOnwards' witness values while staying
+-- parameterized by era.
+class IsAllegraEraOnwards era where
+  allegraEraOnwards :: AllegraEraOnwards era
+
+instance IsAllegraEraOnwards AllegraEra where
+  allegraEraOnwards = AllegraEraOnwardsAllegra
+
+instance IsAllegraEraOnwards MaryEra where
+  allegraEraOnwards = AllegraEraOnwardsMary
+
+instance IsAllegraEraOnwards AlonzoEra where
+  allegraEraOnwards = AllegraEraOnwardsAlonzo
+
+instance IsAllegraEraOnwards BabbageEra where
+  allegraEraOnwards = AllegraEraOnwardsBabbage
+
+instance IsAllegraEraOnwards ConwayEra where
+  allegraEraOnwards = AllegraEraOnwardsConway

cardano-api/internal/Cardano/Api/Class/IsAlonzoEraOnwards.hs

@@ -0,0 +1,18 @@
+module Cardano.Api.Class.IsAlonzoEraOnwards where
+
+import Cardano.Api.Eon.AlonzoEraOnwards (AlonzoEraOnwards (..))
+import Cardano.Api.Eras (AlonzoEra, BabbageEra, ConwayEra)
+
+-- | Type class to produce 'AlonzoEraOnwards' witness values while staying
+-- parameterized by era.
+class IsAlonzoEraOnwards era where
+  alonzoEraOnwards :: AlonzoEraOnwards era
+
+instance IsAlonzoEraOnwards AlonzoEra where
+  alonzoEraOnwards = AlonzoEraOnwardsAlonzo
+
+instance IsAlonzoEraOnwards BabbageEra where
+  alonzoEraOnwards = AlonzoEraOnwardsBabbage
+
+instance IsAlonzoEraOnwards ConwayEra where
+  alonzoEraOnwards = AlonzoEraOnwardsConway

cardano-api/internal/Cardano/Api/Class/IsBabbageEraOnwards.hs

@@ -0,0 +1,15 @@
+module Cardano.Api.Class.IsBabbageEraOnwards where
+
+import Cardano.Api.Eon.BabbageEraOnwards (BabbageEraOnwards (..))
+import Cardano.Api.Eras (BabbageEra, ConwayEra)
+
+-- | Type class to produce 'BabbageEraOnwards' witness values while staying
+-- parameterized by era.
+class IsBabbageEraOnwards era where
+  babbageEraOnwards :: BabbageEraOnwards era
+
+instance IsBabbageEraOnwards BabbageEra where
+  babbageEraOnwards = BabbageEraOnwardsBabbage
+
+instance IsBabbageEraOnwards ConwayEra where
+  babbageEraOnwards = BabbageEraOnwardsConway

cardano-api/internal/Cardano/Api/Class/IsMaryEraOnwards.hs

@@ -0,0 +1,21 @@
+module Cardano.Api.Class.IsMaryEraOnwards where
+
+import Cardano.Api.Eon.MaryEraOnwards (MaryEraOnwards (..))
+import Cardano.Api.Eras (AlonzoEra, BabbageEra, ConwayEra, MaryEra)
+
+-- | Type class to produce 'MaryEraOnwards' witness values while staying
+-- parameterized by era.
+class IsMaryEraOnwards era where
+  maryEraOnwards :: MaryEraOnwards era
+
+instance IsMaryEraOnwards MaryEra where
+  maryEraOnwards = MaryEraOnwardsMary
+
+instance IsMaryEraOnwards AlonzoEra where
+  maryEraOnwards = MaryEraOnwardsAlonzo
+
+instance IsMaryEraOnwards BabbageEra where
+  maryEraOnwards = MaryEraOnwardsBabbage
+
+instance IsMaryEraOnwards ConwayEra where
+  maryEraOnwards = MaryEraOnwardsConway

cardano-api/internal/Cardano/Api/Class/ToAlonzoScript.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Cardano.Api.Class.ToAlonzoScript where
+
+import Cardano.Api.Eon.ShelleyBasedEra (ShelleyLedgerEra)
+import Cardano.Api.Eras (BabbageEra, ConwayEra)
+import Cardano.Api.Script as Script
+  ( PlutusScript (..)
+  , PlutusScriptV1
+  , PlutusScriptV2
+  , PlutusScriptV3
+  )
+import Cardano.Ledger.Alonzo.Scripts (AlonzoScript (..))
+import Cardano.Ledger.Conway.Scripts (PlutusScript (..))
+import Cardano.Ledger.Plutus.Language (Plutus (..), PlutusBinary (..))
+
+class ToAlonzoScript lang era where
+  toLedgerScript
+    :: Script.PlutusScript lang
+    -> AlonzoScript (ShelleyLedgerEra era)
+
+instance ToAlonzoScript PlutusScriptV1 BabbageEra where
+  toLedgerScript (PlutusScriptSerialised bytes) =
+    PlutusScript $ BabbagePlutusV1 $ Plutus $ PlutusBinary bytes
+
+instance ToAlonzoScript PlutusScriptV2 BabbageEra where
+  toLedgerScript (PlutusScriptSerialised bytes) =
+    PlutusScript $ BabbagePlutusV2 $ Plutus $ PlutusBinary bytes
+
+instance ToAlonzoScript PlutusScriptV1 ConwayEra where
+  toLedgerScript (PlutusScriptSerialised bytes) =
+    PlutusScript $ ConwayPlutusV1 $ Plutus $ PlutusBinary bytes
+
+instance ToAlonzoScript PlutusScriptV2 ConwayEra where
+  toLedgerScript (PlutusScriptSerialised bytes) =
+    PlutusScript $ ConwayPlutusV2 $ Plutus $ PlutusBinary bytes
+
+instance ToAlonzoScript PlutusScriptV3 ConwayEra where
+  toLedgerScript (PlutusScriptSerialised bytes) =
+    PlutusScript $ ConwayPlutusV3 $ Plutus $ PlutusBinary bytes

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,22 @@ 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/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