Implement deserialisePlutusScriptInEra

Author: Jimbo4350

cardano-api/src/Cardano/Api/Certificate/Internal.hs

@@ -10,7 +10,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
 
 -- | Certificates embedded in transactions
 module Cardano.Api.Certificate.Internal
@@ -105,7 +104,6 @@ import Data.Maybe
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
-import Data.Type.Equality (TestEquality (..))
 import Data.Typeable
 import GHC.Exts (IsList (..), fromString)
 import Network.Socket (PortNumber)
@@ -153,19 +151,19 @@ deriving instance Show (Certificate era)
 --  testEquality ShelleyRelatedCertificate{} ConwayCertificate{} = Nothing
 --  testEquality ConwayCertificate{} ShelleyRelatedCertificate{} = Nothing
 
-conwayCertTypeEquality
-  :: (Typeable eraA, Typeable eraB)
-  => Ledger.ConwayTxCert (ShelleyLedgerEra eraA)
-  -> Ledger.ConwayTxCert (ShelleyLedgerEra eraB)
-  -> Maybe (eraA :~: eraB)
-conwayCertTypeEquality _ _ = eqT
-
-shelleyCertTypeEquality
-  :: (Typeable eraA, Typeable eraB)
-  => Ledger.ShelleyTxCert (ShelleyLedgerEra eraA)
-  -> Ledger.ShelleyTxCert (ShelleyLedgerEra eraB)
-  -> Maybe (eraA :~: eraB)
-shelleyCertTypeEquality _ _ = eqT
+-- conwayCertTypeEquality
+--   :: (Typeable eraA, Typeable eraB)
+--   => Ledger.ConwayTxCert (ShelleyLedgerEra eraA)
+--   -> Ledger.ConwayTxCert (ShelleyLedgerEra eraB)
+--   -> Maybe (eraA :~: eraB)
+-- conwayCertTypeEquality _ _ = eqT
+--
+-- shelleyCertTypeEquality
+--   :: (Typeable eraA, Typeable eraB)
+--   => Ledger.ShelleyTxCert (ShelleyLedgerEra eraA)
+--   -> Ledger.ShelleyTxCert (ShelleyLedgerEra eraB)
+--   -> Maybe (eraA :~: eraB)
+-- shelleyCertTypeEquality _ _ = eqT
 
 instance Typeable era => HasTypeProxy (Certificate era) where
   data AsType (Certificate era) = AsCertificate

cardano-api/src/Cardano/Api/Experimental/Plutus.hs

@@ -1,6 +1,7 @@
 module Cardano.Api.Experimental.Plutus
   ( -- * Plutus Script
     PlutusScriptInEra (..)
+  , deserialisePlutusScriptInEra
   , plutusScriptInEraLanguage
   , plutusScriptInEraSLanguage
   , plutusScriptInEraToScript

cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Script.hs

@@ -1,16 +1,18 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Api.Experimental.Plutus.Internal.Script
   ( PlutusScriptInEra (..)
   , PlutusScriptOrReferenceInput (..)
+  , HasTypeProxy (..)
+  , deserialisePlutusScriptInEra
   , plutusScriptInEraLanguage
   , plutusScriptInEraSLanguage
   , plutusScriptInEraToScript
@@ -30,6 +32,7 @@ import Cardano.Ledger.Plutus.Language (PlutusRunnable)
 import Cardano.Ledger.Plutus.Language qualified as L
 import Cardano.Ledger.Plutus.Language qualified as Plutus
 
+import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as LBS
 import Data.ByteString.Short qualified as SBS
 import Data.Text qualified as Text
@@ -59,12 +62,15 @@ deriving instance Show (PlutusScriptInEra lang era)
 
 deriving instance Eq (PlutusScriptInEra lang era)
 
-instance (Typeable era, Typeable lang) => HasTypeProxy (PlutusScriptInEra lang era) where
-  data AsType (PlutusScriptInEra lang era) = AsPlutusScriptInEra
-  proxyToAsType _ = AsPlutusScriptInEra
+instance
+  (Typeable era, Typeable lang, HasTypeProxy (Plutus.SLanguage lang))
+  => HasTypeProxy (PlutusScriptInEra lang era)
+  where
+  data AsType (PlutusScriptInEra lang era) = AsPlutusScriptInEra (AsType (L.SLanguage lang))
+  proxyToAsType _ = AsPlutusScriptInEra (proxyToAsType (Proxy @(L.SLanguage lang)))
 
 instance
-  (Plutus.PlutusLanguage lang, L.Era era)
+  (Plutus.PlutusLanguage lang, L.Era era, HasTypeProxy (Plutus.SLanguage lang))
   => HasTextEnvelope (PlutusScriptInEra lang era)
   where
   textEnvelopeType _ =
@@ -79,6 +85,7 @@ instance
   , Typeable era
   , Typeable lang
   , Plutus.PlutusLanguage lang
+  , HasTypeProxy (Plutus.SLanguage lang)
   )
   => SerialiseAsCBOR (PlutusScriptInEra (lang :: L.Language) era)
   where
@@ -97,6 +104,13 @@ instance
           CBOR.DecoderErrorCustom "PlutusLedgerApi.Common.ScriptDecodeError" (Text.pack . show $ pretty e)
       Right s -> Right $ PlutusScriptInEra s
 
+deserialisePlutusScriptInEra
+  :: forall era lang
+   . (L.Era era, Plutus.PlutusLanguage lang, HasTypeProxy (Plutus.SLanguage lang))
+  => L.SLanguage lang -> BS.ByteString -> Either CBOR.DecoderError (PlutusScriptInEra lang era)
+deserialisePlutusScriptInEra _ bs =
+  deserialiseFromCBOR (AsPlutusScriptInEra (proxyToAsType (Proxy @(L.SLanguage lang)))) bs
+
 plutusScriptInEraSLanguage
   :: forall lang era. L.PlutusLanguage lang => PlutusScriptInEra lang era -> L.SLanguage lang
 plutusScriptInEraSLanguage (PlutusScriptInEra _) =

cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs

@@ -67,6 +67,7 @@ import Cardano.Ledger.HKD (NoUpdate (..))
 import Cardano.Ledger.Hashes qualified as L hiding (KeyHash)
 import Cardano.Ledger.Keys qualified as L.Keys
 import Cardano.Ledger.Mary.Value qualified as L
+import Cardano.Ledger.Plutus.Language qualified as L
 import Cardano.Ledger.Shelley.API.Mempool qualified as L
 import Cardano.Ledger.Shelley.PParams qualified as Ledger
 import Cardano.Ledger.Shelley.Rules qualified as L
@@ -470,3 +471,19 @@ instance SerialiseAsRawBytes L.GovActionId where
     L.GovActionId . toShelleyTxId
       <$> deserialiseFromRawBytes AsTxId txIdBs
       <*> deserialiseFromRawBytes AsGovActionIx index
+
+instance HasTypeProxy (L.SLanguage L.PlutusV1) where
+  data AsType (L.SLanguage L.PlutusV1) = AsPlutusScriptV1
+  proxyToAsType _ = AsPlutusScriptV1
+
+instance HasTypeProxy (L.SLanguage L.PlutusV2) where
+  data AsType (L.SLanguage L.PlutusV2) = AsPlutusScriptV2
+  proxyToAsType _ = AsPlutusScriptV2
+
+instance HasTypeProxy (L.SLanguage L.PlutusV3) where
+  data AsType (L.SLanguage L.PlutusV3) = AsPlutusScriptV3
+  proxyToAsType _ = AsPlutusScriptV3
+
+instance HasTypeProxy (L.SLanguage L.PlutusV4) where
+  data AsType (L.SLanguage L.PlutusV4) = AsPlutusScriptV4
+  proxyToAsType _ = AsPlutusScriptV4