Add the ability to export serialised PLC programs with Cardano API en…

…velopes (#3358)

doc/plutus-doc.cabal

@@ -53,6 +53,7 @@ executable doc-doctests
       base >=4.9 && <5,
       template-haskell >=2.13.0.0,
       bytestring -any,
+      cardano-api -any,
       plutus-core -any,
       plutus-tx -any,
       plutus-ledger -any,

doc/plutus/howtos/exporting-a-script.rst

@@ -13,8 +13,6 @@ For example, you might want to submit it as part of a manually created transacti
 Fortunately, it is quite simple to do this.
 You can either translate directly into CBOR using the `Serialise` typeclass from the `serialise` package, or you can create an envelope of the sort used by the Cardano node CLI.
 
-.. TODO: include instructions on the latter once we have support for it
-
 .. literalinclude:: ../tutorials/BasicValidators.hs
    :start-after: BLOCK8
    :end-before: BLOCK9

doc/plutus/tutorials/BasicValidators.hs

@@ -17,14 +17,15 @@ import           Ledger.Ada
 import           Ledger.Typed.Scripts
 import           Ledger.Value
 
+import           Cardano.Api          (HasTextEnvelope, TextEnvelope, TextEnvelopeDescr, serialiseToTextEnvelope)
+
 import qualified Data.ByteString.Lazy as BSL
 
 import           Codec.Serialise
 
 import           Prelude              (IO, print, show)
 import qualified Prelude              as Haskell
 
-
 myKeyHash :: PubKeyHash
 myKeyHash = Haskell.undefined
 
@@ -113,6 +114,13 @@ dateValidator = validatorScript dateInstance
 serializedDateValidator :: BSL.ByteString
 serializedDateValidator = serialise dateValidator
 
+-- The module 'Ledger.Scripts' (also exported via 'Ledger') includes instances
+-- related to typeclass 'Cardano.Api.HasTextEnvelope'
+envelopeDateValidator :: TextEnvelope
+envelopeDateValidator = serialiseToTextEnvelope Nothing (getValidator dateValidator)
+
 main :: IO ()
-main = print serializedDateValidator
+main = do
+  print serializedDateValidator
+  print envelopeDateValidator
 -- BLOCK9

plutus-ledger-api/src/Plutus/V1/Ledger/Api.hs

@@ -75,6 +75,7 @@ import           Data.ByteString.Lazy                             (fromStrict)
 import           Data.ByteString.Short
 import           Data.Either
 import           Data.Maybe                                       (isJust)
+import           Data.Text                                        (Text)
 import qualified Data.Text                                        as Text
 import           Data.Text.Prettyprint.Doc
 import           Data.Tuple
@@ -101,7 +102,7 @@ import qualified PlutusTx.Lift                                    as PlutusTx
 import qualified UntypedPlutusCore                                as UPLC
 import qualified UntypedPlutusCore.Evaluation.Machine.Cek         as UPLC
 
-plutusScriptEnvelopeType :: Text.Text
+plutusScriptEnvelopeType :: Text
 plutusScriptEnvelopeType = "PlutusV1Script"
 
 {- Note [Abstract types in the ledger API]
@@ -131,7 +132,7 @@ validateCostModelParams = isJust . applyCostModelParams PLC.defaultCekCostModel
 data VerboseMode = Verbose | Quiet
     deriving (Eq)
 
-type LogOutput = [Text.Text]
+type LogOutput = [Text]
 
 -- | Scripts to the ledger are serialised bytestrings.
 type SerializedScript = ShortByteString

plutus-ledger/plutus-ledger.cabal

@@ -52,6 +52,7 @@ library
         Ledger.Oracle
         Ledger.Orphans
         Ledger.Index
+        Ledger.Scripts
         Ledger.TimeSlot
         Ledger.Tokens
         Ledger.Typed.Scripts
@@ -71,7 +72,9 @@ library
         Plutus.V1.Ledger.DCert as Ledger.DCert,
         Plutus.V1.Ledger.Crypto as Ledger.Crypto,
         Plutus.V1.Ledger.Interval as Ledger.Interval,
-        Plutus.V1.Ledger.Scripts as Ledger.Scripts,
+        -- We manually re-export that module so we can include some extra
+        -- instances
+        -- Plutus.V1.Ledger.Scripts as Ledger.Scripts,
         Plutus.V1.Ledger.Slot as Ledger.Slot,
         Plutus.V1.Ledger.Tx as Ledger.Tx,
         Plutus.V1.Ledger.TxId as Ledger.TxId,
@@ -107,6 +110,8 @@ library
         deriving-compat -any,
         newtype-generics -any,
         http-api-data -any,
+        cardano-api -any,
+        cardano-binary -any,
         cardano-crypto -any,
         deepseq -any,
         freer-simple -any,

plutus-ledger/src/Ledger.hs

@@ -10,13 +10,15 @@ module Ledger (
 import           Ledger.Blockchain         as Export
 import           Ledger.Index              as Export
 import           Ledger.Orphans            ()
+-- We manually re-export 'Plutus.V1.Ledger.Scripts' so we can include some
+-- extra instances
+import           Ledger.Scripts            as Export
 import           Plutus.V1.Ledger.Ada      (Ada)
 import           Plutus.V1.Ledger.Address  as Export
 import           Plutus.V1.Ledger.Contexts as Export
 import           Plutus.V1.Ledger.Crypto   as Export
 import           Plutus.V1.Ledger.Interval as Export
 import           Plutus.V1.Ledger.Orphans  ()
-import           Plutus.V1.Ledger.Scripts  as Export
 import           Plutus.V1.Ledger.Slot     as Export
 import           Plutus.V1.Ledger.Time     as Export
 import           Plutus.V1.Ledger.Tx       as Export

plutus-ledger/src/Ledger/Scripts.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-|
+This module re-exports the module 'Plutus.V1.Ledger.Scripts', but with
+additionnal functionality.
+
+This module contains orphan instances of 'Cardano.Api.HasTextEnvelope', since
+the Cardano Node CLI expects serialised binary values to be wrapped with a
+'Cardano.Api.TextEnvelope'.
+-}
+module Ledger.Scripts (
+  module Export
+  ) where
+
+import           Cardano.Api              (AsType, HasTextEnvelope (textEnvelopeType), HasTypeProxy (proxyToAsType),
+                                           SerialiseAsCBOR, TextEnvelopeType (TextEnvelopeType))
+import           Cardano.Binary           (FromCBOR (fromCBOR), ToCBOR (toCBOR))
+import           Codec.Serialise          (decode, encode)
+import qualified Data.Text                as Text
+import           Plutus.V1.Ledger.Api     (plutusScriptEnvelopeType)
+import           Plutus.V1.Ledger.Scripts as Export
+
+instance HasTextEnvelope Script where
+    textEnvelopeType _ = TextEnvelopeType $ Text.unpack plutusScriptEnvelopeType
+
+instance SerialiseAsCBOR Script
+
+instance FromCBOR Script where
+    fromCBOR = decode
+
+instance ToCBOR Script where
+    toCBOR = encode
+
+instance HasTypeProxy Script where
+    data AsType Script = AsScript
+    proxyToAsType _ = AsScript