From 058936a964e27b6395c8281408af53b944abf068 Mon Sep 17 00:00:00 2001 From: Daniel Firth Date: Thu, 16 May 2024 18:41:22 +0000 Subject: [PATCH] Add Classy versions of Era witness functions --- cardano-api/cardano-api.cabal | 6 ++++ .../Api/Class/HasScriptLanguageInEra.hs | 29 ++++++++++++++++ .../Cardano/Api/Class/IsAllegraEraOnwards.hs | 24 +++++++++++++ .../Cardano/Api/Class/IsAlonzoEraOnwards.hs | 18 ++++++++++ .../Cardano/Api/Class/IsBabbageEraOnwards.hs | 15 ++++++++ .../Cardano/Api/Class/IsMaryEraOnwards.hs | 21 ++++++++++++ .../Cardano/Api/Class/ToAlonzoScript.hs | 34 +++++++++++++++++++ cardano-api/src/Cardano/Api.hs | 16 +++++++++ 8 files changed, 163 insertions(+) create mode 100644 cardano-api/internal/Cardano/Api/Class/HasScriptLanguageInEra.hs create mode 100644 cardano-api/internal/Cardano/Api/Class/IsAllegraEraOnwards.hs create mode 100644 cardano-api/internal/Cardano/Api/Class/IsAlonzoEraOnwards.hs create mode 100644 cardano-api/internal/Cardano/Api/Class/IsBabbageEraOnwards.hs create mode 100644 cardano-api/internal/Cardano/Api/Class/IsMaryEraOnwards.hs create mode 100644 cardano-api/internal/Cardano/Api/Class/ToAlonzoScript.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 2fbd3c7c4c..b864385b38 100644 --- a/cardano-api/cardano-api.cabal +++ b/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 diff --git a/cardano-api/internal/Cardano/Api/Class/HasScriptLanguageInEra.hs b/cardano-api/internal/Cardano/Api/Class/HasScriptLanguageInEra.hs new file mode 100644 index 0000000000..1dd6311e7a --- /dev/null +++ b/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 diff --git a/cardano-api/internal/Cardano/Api/Class/IsAllegraEraOnwards.hs b/cardano-api/internal/Cardano/Api/Class/IsAllegraEraOnwards.hs new file mode 100644 index 0000000000..e0ec7ee491 --- /dev/null +++ b/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 diff --git a/cardano-api/internal/Cardano/Api/Class/IsAlonzoEraOnwards.hs b/cardano-api/internal/Cardano/Api/Class/IsAlonzoEraOnwards.hs new file mode 100644 index 0000000000..d13ddf2f2d --- /dev/null +++ b/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 diff --git a/cardano-api/internal/Cardano/Api/Class/IsBabbageEraOnwards.hs b/cardano-api/internal/Cardano/Api/Class/IsBabbageEraOnwards.hs new file mode 100644 index 0000000000..91f754be89 --- /dev/null +++ b/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 diff --git a/cardano-api/internal/Cardano/Api/Class/IsMaryEraOnwards.hs b/cardano-api/internal/Cardano/Api/Class/IsMaryEraOnwards.hs new file mode 100644 index 0000000000..1bfa5dd397 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Class/IsMaryEraOnwards.hs @@ -0,0 +1,21 @@ +module Cardano.Api.Class.IsMaryEraOnwards where + +import Cardano.Api.Eras (AlonzoEra, BabbageEra, ConwayEra, MaryEra) +import Cardano.Api.Eon.MaryEraOnwards (MaryEraOnwards (..)) + +-- | 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 diff --git a/cardano-api/internal/Cardano/Api/Class/ToAlonzoScript.hs b/cardano-api/internal/Cardano/Api/Class/ToAlonzoScript.hs new file mode 100644 index 0000000000..3c221e1f50 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Class/ToAlonzoScript.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +module Cardano.Api.Class.ToAlonzoScript where + +import Cardano.Api.Eras (BabbageEra, ConwayEra) +import Cardano.Api.Eon.ShelleyBasedEra (ShelleyLedgerEra) +import Cardano.Api.Script as Script (PlutusScriptV1, PlutusScriptV2, PlutusScriptV3, PlutusScript(..)) +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 diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 46f22bfcd1..e666400b7d 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -92,24 +92,31 @@ module Cardano.Api ( -- ** From Allegra AllegraEraOnwards(..), + + IsAllegraEraOnwards(..), -- ** From Mary MaryEraOnwards(..), maryEraOnwardsConstraints, maryEraOnwardsToShelleyBasedEra, + IsMaryEraOnwards(..), + -- ** From Alonzo AlonzoEraOnwards(..), alonzoEraOnwardsConstraints, alonzoEraOnwardsToShelleyBasedEra, + IsAlonzoEraOnwards(..), + -- ** From Babbage BabbageEraOnwards(..), babbageEraOnwardsConstraints, babbageEraOnwardsToShelleyBasedEra, + IsBabbageEraOnwards(..), -- ** From Conway ConwayEraOnwards(..), @@ -988,6 +995,9 @@ module Cardano.Api ( ResolvablePointers(..), unsafeBoundedRational, + + ToAlonzoScript(..), + HasScriptLanguageInEra(..), -- ** Supporting modules module Cardano.Api.Monad.Error, module Cardano.Api.Pretty @@ -1001,6 +1011,12 @@ import Cardano.Api.Convenience.Construction import Cardano.Api.Convenience.Query import Cardano.Api.DeserialiseAnyOf import Cardano.Api.DRepMetadata +import Cardano.Api.Class.HasScriptLanguageInEra +import Cardano.Api.Class.IsAllegraEraOnwards +import Cardano.Api.Class.IsAlonzoEraOnwards +import Cardano.Api.Class.IsBabbageEraOnwards +import Cardano.Api.Class.IsMaryEraOnwards +import Cardano.Api.Class.ToAlonzoScript import Cardano.Api.Eon.AllegraEraOnwards import Cardano.Api.Eon.AlonzoEraOnwards import Cardano.Api.Eon.BabbageEraOnwards