diff --git a/doc/read-the-docs-site/howtos/Cip57Blueprint.hs b/doc/read-the-docs-site/howtos/Cip57Blueprint.hs new file mode 100644 index 00000000000..4093df6bfba --- /dev/null +++ b/doc/read-the-docs-site/howtos/Cip57Blueprint.hs @@ -0,0 +1,165 @@ +-- BEGIN pragmas +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} + +-- END pragmas + +module Cip57Blueprint where + +-- BEGIN imports +import PlutusTx.Blueprint + +import Data.ByteString (ByteString) +import Data.Kind (Type) +import Data.List.NonEmpty (NonEmpty) +import Data.Set (Set) +import Data.Set qualified as Set +import Data.Text (Text) +import GHC.Generics (Generic) +import PlutusLedgerApi.V3 (BuiltinData, ScriptContext, UnsafeFromData (..)) +import PlutusTx.Blueprint.TH (makeIsDataSchemaIndexed) +import PlutusTx.Lift (makeLift) +import PlutusTx.Prelude (check) + +-- END imports +-- BEGIN MyParams annotations + +{-# ANN MkMyParams (SchemaTitle "Title for the MyParams definition") #-} +{-# ANN MkMyParams (SchemaDescription "Description for the MyParams definition") #-} + +-- END MyParams annotations +-- BEGIN MyRedeemer annotations + +{-# ANN R1 (SchemaComment "Left redeemer") #-} +{-# ANN R2 (SchemaComment "Right redeemer") #-} + +-- END MyRedeemer annotations +-- BEGIN interface types + +type MyDatum = Integer + +data MyRedeemer = R1 | R2 + +data MyParams = MkMyParams + { myBool :: Bool + , myInteger :: Integer + } + +$(makeLift ''MyParams) + +-- END interface types +-- BEGIN makeIsDataSchemaIndexed MyParams + +$(makeIsDataSchemaIndexed ''MyParams [('MkMyParams, 0)]) +$(makeIsDataSchemaIndexed ''MyRedeemer [('R1, 0), ('R2, 1)]) + +-- END makeIsDataSchemaIndexed MyParams +-- BEGIN generic instances + +deriving stock instance (Generic MyParams) +deriving stock instance (Generic MyRedeemer) + +-- END generic instances +-- BEGIN AsDefinitionId instances + +deriving anyclass instance (AsDefinitionId MyParams) +deriving anyclass instance (AsDefinitionId MyRedeemer) + +-- END AsDefinitionId instances +-- BEGIN validator + +typedValidator :: MyParams -> MyDatum -> MyRedeemer -> ScriptContext -> Bool +typedValidator MkMyParams{..} datum redeemer _scriptContext = + case redeemer of + R1 -> myBool + R2 -> myInteger == datum + +untypedValidator :: MyParams -> BuiltinData -> BuiltinData -> BuiltinData -> () +untypedValidator params datum redeemer scriptContext = + check $ typedValidator params datum' redeemer' scriptContext' + where + datum' = unsafeFromBuiltinData datum + redeemer' = unsafeFromBuiltinData redeemer + scriptContext' = unsafeFromBuiltinData scriptContext + +-- END validator +-- BEGIN contract blueprint declaration + +myContractBlueprint :: ContractBlueprint +myContractBlueprint = + MkContractBlueprint + { contractId = Just "my-contract" + , contractPreamble = myPreamble -- defined below + , contractValidators = Set.singleton myValidator -- defined below + , contractDefinitions = deriveDefinitions @[MyParams, MyDatum, MyRedeemer] + } + +-- END contract blueprint declaration +-- BEGIN preamble declaration + +myPreamble :: Preamble +myPreamble = + MkPreamble + { preambleTitle = "My Contract" + , preambleDescription = Just "A simple contract" + , preambleVersion = "1.0.0" + , preamblePlutusVersion = PlutusV2 + , preambleLicense = Just "MIT" + } + +-- END preamble declaration +-- BEGIN validator blueprint declaration + +myValidator = + MkValidatorBlueprint + { validatorTitle = "My Validator" + , validatorDescription = Just "An example validator" + , validatorParameters = + [ MkParameterBlueprint + { parameterTitle = Just "My Validator Parameters" + , parameterDescription = Just "Compile-time validator parameters" + , parameterPurpose = Set.singleton Spend + , parameterSchema = definitionRef @MyParams + } + ] + , validatorRedeemer = + MkArgumentBlueprint + { argumentTitle = Just "My Redeemer" + , argumentDescription = Just "A redeemer that does something awesome" + , argumentPurpose = Set.fromList [Spend, Mint] + , argumentSchema = definitionRef @MyRedeemer + } + , validatorDatum = + Just + MkArgumentBlueprint + { argumentTitle = Just "My Datum" + , argumentDescription = Just "A datum that contains something awesome" + , argumentPurpose = Set.singleton Spend + , argumentSchema = definitionRef @MyDatum + } + , validatorCompiledCode = Nothing -- you can optionally provide the compiled code here + } + +-- END validator blueprint declaration +-- BEGIN write blueprint to file + +-- >>> writeBlueprintToFile "plutus.json" +writeBlueprintToFile :: FilePath -> IO () +writeBlueprintToFile path = writeBlueprint path myContractBlueprint + +-- END write blueprint to file + diff --git a/doc/read-the-docs-site/howtos/exporting-a-blueprint.rst b/doc/read-the-docs-site/howtos/exporting-a-blueprint.rst new file mode 100644 index 00000000000..a48da0cb28a --- /dev/null +++ b/doc/read-the-docs-site/howtos/exporting-a-blueprint.rst @@ -0,0 +1,310 @@ +.. highlight:: haskell +.. _exporting_a_blueprint: + +How to produce a Plutus Contract Blueprint +========================================== + +Plutus Contract Blueprints (`CIP-0057`_) are used to document the binary interface of a +Plutus contract in a machine-readable format (JSON schema). + +A contract Blueprint can be produced by using the +`writeBlueprint` function exported by the `PlutusTx.Blueprint` module:: + + writeBlueprint + :: FilePath + -- ^ The file path where the blueprint will be written to, + -- e.g. '/tmp/plutus.json' + -> ContractBlueprint + -- ^ Contains all the necessary information to generate + -- a blueprint for a Plutus contract. + -> IO () + +In order to demonstrate the usage of the `writeBlueprint` function, +Let's consider the following example validator function and its interface: + +.. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN interface types + :end-before: END interface types + +.. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN validator + :end-before: END validator + +First of all we need to import required functionality: + +.. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN imports + :end-before: END imports + +Next we define a contract blueprint value of the following type: + +.. code-block:: haskell + + data ContractBlueprint where + MkContractBlueprint + :: forall referencedTypes + . { contractId :: Maybe Text + -- ^ An optional identifier for the contract. + , contractPreamble :: Preamble + -- ^ An object with meta-information about the contract. + , contractValidators :: Set (ValidatorBlueprint referencedTypes) + -- ^ A set of validator blueprints that are part of the contract. + , contractDefinitions :: Definitions referencedTypes + -- ^ A registry of schema definitions used across the blueprint. + } + -> ContractBlueprint + +.. note:: + + The 'referencedTypes' type parameter is used to track the types used in the contract + making sure their schemas are included in the blueprint and that they are referenced + in a type-safe way. + + The blueprint will contain JSON schema definitions for all the types used in the contract, + including the types **nested** within the top-level types (`MyParams`, `MyDatum`, `MyRedeemer`): + + * ``Integer`` - nested within `MyDatum` and `MyParams`. + * ``Bool`` - nested within `MyParams`. + + This way, the `referencedTypes` type variable is inferred to be the following list: + + .. code-block:: haskell + + '[ MyParams -- top-level type + , MyDatum -- top-level type + , MyRedeemer -- top-level type + , Integer -- nested type + , Bool -- nested type + ] + +We can construct a value of this type like in this: + +.. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN contract blueprint declaration + :end-before: END contract blueprint declaration + +The `contractId` field is optional and can be used to give a unique identifier to the contract. + +The `contractPreamble` field is a value of type `PlutusTx.Blueprint.Preamble` +contains a meta-information about the contract: + +.. code-block:: haskell + + data Preamble = MkPreamble + { preambleTitle :: Text + -- ^ A short and descriptive title of the contract application + , preambleDescription :: Maybe Text + -- ^ A more elaborate description + , preambleVersion :: Text + -- ^ A version number for the project. + , preamblePlutusVersion :: PlutusVersion + -- ^ The Plutus version assumed for all validators + , preambleLicense :: Maybe Text + -- ^ A license under which the specification + -- and contract code is distributed + } + +Here is an example construction: + +.. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN preamble declaration + :end-before: END preamble declaration + +The ``contractDefinitions`` field is a registry of schema definitions used across the blueprint. +It can be constructed using the ``deriveDefinitions`` function which automatically +constructs schema definitions for all the types its applied to inluding the types +nested within them. + +Since every type in the ``referencedTypes`` list is going to have its derived JSON-schema in the +``contractDefinitions`` registry under a certain unique ``DefinitionId`` key, we need to make sure +that it has: + +* an instance of the ``GHC.Generics.Generic`` type class: + + .. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN generic instances + :end-before: END generic instances + +* an instance of the ``AsDefinitionId`` type class. Most of the times it could be derived + generically with the ``anyclass`` strategy, for example: + + .. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN AsDefinitionId instances + :end-before: END AsDefinitionId instances + +* an instance of the ``HasSchema`` type class. If your validator exposes standard supported types + like ``Integer`` or ``Bool`` you don't need to define this instance. If your validator uses + custom types then you should be deriving it using the ``makeIsDataSchemaIndexed`` Template Haskell function, + which derives it alongside with the corresponding `ToBuiltinData`/`FromBuiltinData` instances, + for example: + + .. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN makeIsDataSchemaIndexed MyParams + :end-before: END makeIsDataSchemaIndexed MyParams + +Finally, we need to define a validator blueprint for each validator used in the contract. + +Our contract can contain one or more validators and for each one we need to provide +a description as a value of the following type: + + .. code-block:: haskell + + data ValidatorBlueprint (referencedTypes :: [Type]) = MkValidatorBlueprint + { validatorTitle :: Text + -- ^ A short and descriptive name for the validator. + , validatorDescription :: Maybe Text + -- ^ An informative description of the validator. + , validatorRedeemer :: ArgumentBlueprint referencedTypes + -- ^ A description of the redeemer format expected by this validator. + , validatorDatum :: Maybe (ArgumentBlueprint referencedTypes) + -- ^ A description of the datum format expected by this validator. + , validatorParameters :: Maybe (NonEmpty (ParameterBlueprint referencedTypes)) + -- ^ A list of parameters required by the script. + , validatorCompiledCode :: Maybe ByteString + -- ^ A full compiled and CBOR-encoded serialized flat script. + } + +In our example this would be: + +.. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN validator blueprint declaration + :end-before: END validator blueprint declaration + +The ``definitionRef`` function is used to reference a schema definition of a given type. It is +smart enough to discover the schema definition from the ``referencedType`` list and +fails to compile if the referenced type is not included. + +With all the pieces in place, we can now write the blueprint to a file: + +.. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN write blueprint to file + :end-before: END write blueprint to file + +Annotations +----------- + +Any `CIP-0057`_ blueprint type definition may include `optional keywords`_ to provide +additional information: + +* title +* description +* $comment + +Its possible to add these keywords to a Blueprint type definition by annotating the +Haskell type from which its derived with a corresponding annotation: + +* ``SchemaTitle`` +* ``SchemaDescription`` +* ``SchemaComment`` + +For example, to add a title and description to the ``MyParams`` type, +we can use the ``SchemaTitle`` and ``SchemaDescription`` annotations: + +.. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN MyParams annotations + :end-before: END MyParams annotations + +results in the following JSON schema definition: + +.. code-block:: json + + { + "title": "Title for the MyParams definition", + "description": "Description for the MyParams definition", + "dataType": "constructor", + "fields": [ + { "$ref": "#/definitions/Bool" }, + { "$ref": "#/definitions/Integer" } + ], + "index": 0 + } + +For sum-types its possible to annotate constructors: + +.. literalinclude:: Cip57Blueprint.hs + :start-after: BEGIN MyRedeemer annotations + :end-before: END MyRedeemer annotations + +to produce the JSON schema definition: + +.. code-block:: json + + { + "oneOf": [ + { + "$comment": "Left redeemer", + "dataType": "constructor", + "fields": [], + "index": 0 + }, + { + "$comment": "Right redeemer", + "dataType": "constructor", + "fields": [], + "index": 1 + } + ] + } + +It is also possible to annotate validator's parameter or argument **type** +(as opposed to annotating *constructors*): + +.. code-block:: haskell + + {-# ANN type MyParams (SchemaTitle "Example parameter title") #-} + {-# ANN type MyRedeemer (SchemaTitle "Example redeemer title") #-} + +and then instead of providing them literally + +.. code-block:: haskell + + myValidator = + MkValidatorBlueprint + { ... elided + , validatorParameters = + [ MkParameterBlueprint + { parameterTitle = Just "My Validator Parameters" + , parameterDescription = Just "Compile-time validator parameters" + , parameterPurpose = Set.singleton Spend + , parameterSchema = definitionRef @MyParams + } + ] + , validatorRedeemer = + MkArgumentBlueprint + { argumentTitle = Just "My Redeemer" + , argumentDescription = Just "A redeemer that does something awesome" + , argumentPurpose = Set.fromList [Spend, Mint] + , argumentSchema = definitionRef @MyRedeemer + } + , ... elided + } + +use TH to have a more concise version : + +.. code-block:: haskell + + myValidator = + MkValidatorBlueprint + { ... elided + , validatorParameters = + [ $(deriveParameterBlueprint ''MyParams (Set.singleton Purpose.Spend)) ] + , validatorRedeemer = + $(deriveArgumentBlueprint ''MyRedeemer (Set.fromList [Purpose.Spend, Purpose.Mint])) + , ... elided + } + + +Result +------ + +Here is the full `CIP-0057`_ blueprint produced by this "howto" example: + +.. literalinclude:: plutus.json + +.. note:: + You can find a more elaborate example of a contract blueprint in the ``Blueprint.Tests`` + module of the plutus repository. + +.. _CIP-0057: https://cips.cardano.org/cip/CIP-0057 +.. _optional keywords: https://cips.cardano.org/cip/CIP-0057#for-any-data-type + diff --git a/doc/read-the-docs-site/howtos/index.rst b/doc/read-the-docs-site/howtos/index.rst index 16978e01925..270e01c3280 100644 --- a/doc/read-the-docs-site/howtos/index.rst +++ b/doc/read-the-docs-site/howtos/index.rst @@ -9,4 +9,5 @@ How-to guides asdata exporting-a-script + exporting-a-blueprint profiling-scripts diff --git a/doc/read-the-docs-site/howtos/plutus.json b/doc/read-the-docs-site/howtos/plutus.json new file mode 100644 index 00000000000..542a1ed4301 --- /dev/null +++ b/doc/read-the-docs-site/howtos/plutus.json @@ -0,0 +1,92 @@ +{ + "$id": "my-contract", + "$schema": "https://cips.cardano.org/cips/cip57/schemas/plutus-blueprint.json", + "$vocabulary": { + "https://cips.cardano.org/cips/cip57": true, + "https://json-schema.org/draft/2020-12/vocab/applicator": true, + "https://json-schema.org/draft/2020-12/vocab/core": true, + "https://json-schema.org/draft/2020-12/vocab/validation": true + }, + "preamble": { + "title": "My Contract", + "description": "A simple contract", + "version": "1.0.0", + "plutusVersion": "v2", + "license": "MIT" + }, + "validators": [ + { + "title": "My Validator", + "description": "An example validator", + "redeemer": { + "title": "My Redeemer", + "description": "A redeemer that does something awesome", + "purpose": { + "oneOf": [ + "spend", + "mint" + ] + }, + "schema": { + "$ref": "#/definitions/MyRedeemer" + } + }, + "datum": { + "title": "My Datum", + "description": "A datum that contains something awesome", + "purpose": "spend", + "schema": { + "$ref": "#/definitions/Integer" + } + }, + "parameters": [ + { + "title": "My Validator Parameters", + "description": "Compile-time validator parameters", + "purpose": "spend", + "schema": { + "$ref": "#/definitions/MyParams" + } + } + ] + } + ], + "definitions": { + "Bool": { + "dataType": "#boolean" + }, + "Integer": { + "dataType": "integer" + }, + "MyParams": { + "title": "Title for the MyParams definition", + "description": "Description for the MyParams definition", + "dataType": "constructor", + "fields": [ + { + "$ref": "#/definitions/Bool" + }, + { + "$ref": "#/definitions/Integer" + } + ], + "index": 0 + }, + "MyRedeemer": { + "oneOf": [ + { + "$comment": "Left redeemer", + "dataType": "constructor", + "fields": [], + "index": 0 + }, + { + "$comment": "Right redeemer", + "dataType": "constructor", + "fields": [], + "index": 1 + } + ] + } + } +} diff --git a/doc/read-the-docs-site/plutus-doc.cabal b/doc/read-the-docs-site/plutus-doc.cabal index f1e88f394e9..0d12729d7a1 100644 --- a/doc/read-the-docs-site/plutus-doc.cabal +++ b/doc/read-the-docs-site/plutus-doc.cabal @@ -69,6 +69,7 @@ executable doc-doctests BasicPlutusTx BasicPolicies BasicValidators + Cip57Blueprint build-depends: , aeson diff --git a/plutus-tx/changelog.d/20240325_114314_Yuriy.Lazaryev_cip57_howto.md b/plutus-tx/changelog.d/20240325_114314_Yuriy.Lazaryev_cip57_howto.md new file mode 100644 index 00000000000..4f8f7f09ebf --- /dev/null +++ b/plutus-tx/changelog.d/20240325_114314_Yuriy.Lazaryev_cip57_howto.md @@ -0,0 +1,3 @@ +### Added + +- CIP-0057 Blueprint generation is supported.