Add serialisation instances for PlutusScriptInEra

Author: Jimbo4350

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

@@ -1,11 +1,12 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Api.Experimental.Plutus.Internal.Script
   ( PlutusScriptInEra (..)
@@ -16,13 +17,24 @@ module Cardano.Api.Experimental.Plutus.Internal.Script
   )
 where
 
+import Cardano.Api.HasTypeProxy
 import Cardano.Api.Ledger.Internal.Reexport qualified as L
+import Cardano.Api.Plutus.Internal.Script (removePlutusScriptDoubleEncoding)
+import Cardano.Api.Serialise.Cbor
+import Cardano.Api.Serialise.TextEnvelope.Internal
 import Cardano.Api.Tx.Internal.TxIn (TxIn)
 
+import Cardano.Binary qualified as CBOR
+import Cardano.Ledger.Core qualified as L
 import Cardano.Ledger.Plutus.Language (PlutusRunnable)
 import Cardano.Ledger.Plutus.Language qualified as L
+import Cardano.Ledger.Plutus.Language qualified as Plutus
 
-import Data.Proxy
+import Data.ByteString.Lazy qualified as LBS
+import Data.ByteString.Short qualified as SBS
+import Data.Text qualified as Text
+import Data.Typeable
+import Prettyprinter
 
 -- | A Plutus script in a particular era.
 -- Why PlutusRunnable? Mainly for deserialization benefits.
@@ -47,6 +59,44 @@ 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
+  (Plutus.PlutusLanguage lang, L.Era era)
+  => HasTextEnvelope (PlutusScriptInEra lang era)
+  where
+  textEnvelopeType _ =
+    case L.plutusLanguage (Proxy @lang) of
+      L.PlutusV1 -> "PlutusScriptV1"
+      L.PlutusV2 -> "PlutusScriptV2"
+      L.PlutusV3 -> "PlutusScriptV3"
+      L.PlutusV4 -> "PlutusScriptV4"
+
+instance
+  ( L.Era era
+  , Typeable era
+  , Typeable lang
+  , Plutus.PlutusLanguage lang
+  )
+  => SerialiseAsCBOR (PlutusScriptInEra (lang :: L.Language) era)
+  where
+  serialiseToCBOR (PlutusScriptInEra s) =
+    L.serialize' (L.eraProtVerHigh @era) s
+
+  deserialiseFromCBOR _ bs = do
+    let v = L.eraProtVerLow @era
+        scriptShortBs = SBS.toShort $ removePlutusScriptDoubleEncoding $ LBS.fromStrict bs
+    let plutusScript :: Plutus.Plutus lang
+        plutusScript = L.Plutus $ L.PlutusBinary scriptShortBs
+
+    case Plutus.decodePlutusRunnable v plutusScript of
+      Left e ->
+        Left $
+          CBOR.DecoderErrorCustom "PlutusLedgerApi.Common.ScriptDecodeError" (Text.pack . show $ pretty e)
+      Right s -> Right $ PlutusScriptInEra s
+
 plutusScriptInEraSLanguage
   :: forall lang era. L.PlutusLanguage lang => PlutusScriptInEra lang era -> L.SLanguage lang
 plutusScriptInEraSLanguage (PlutusScriptInEra _) =