From ca0fb359290c826523126bcfe28af49e251a896b Mon Sep 17 00:00:00 2001 From: koslambrou Date: Thu, 23 Jun 2022 18:46:45 -0400 Subject: [PATCH] PLT-47 Add tutorial for using tx constraint API (#529) --- doc/plutus/tutorials/BasicAppConstraints.hs | 90 +++++++++++++++++++ doc/plutus/tutorials/BasicApps.hs | 4 +- .../tutorials/basic-apps-constraints.rst | 33 +++++++ doc/plutus/tutorials/index.rst | 3 +- 4 files changed, 127 insertions(+), 3 deletions(-) create mode 100644 doc/plutus/tutorials/BasicAppConstraints.hs create mode 100644 doc/plutus/tutorials/basic-apps-constraints.rst diff --git a/doc/plutus/tutorials/BasicAppConstraints.hs b/doc/plutus/tutorials/BasicAppConstraints.hs new file mode 100644 index 0000000000..af23e9269b --- /dev/null +++ b/doc/plutus/tutorials/BasicAppConstraints.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +module BasicAppConstraints where + +-- BLOCK0 + +import BasicApps (SplitData (SplitData, amount, recipient1, recipient2), SplitSchema, mkSplitData) +import Ledger (Ada, ChainIndexTxOut, PaymentPubKeyHash, ScriptContext, TxOutRef) +import Ledger.Ada qualified as Ada +import Ledger.Constraints (MkTxError, TxConstraints, UnbalancedTx) +import Ledger.Constraints qualified as Constraints +import Ledger.Typed.Scripts qualified as Scripts +import Plutus.Contract (Contract, Promise, collectFromScript, endpoint, submitTxConstraintsSpending, utxosAt) + +import Control.Monad (void) +import Data.Either (Either) +import Data.Foldable (foldMap) +import Data.Map (Map) +import Data.Map qualified as Map +import Data.Text qualified as T +import GHC.Generics (Generic) +import PlutusTx qualified +import PlutusTx.Prelude (Bool, mappend, ($), (-), (.)) +import Prelude (Show, flip, (<>)) + +-- BLOCK1 + +-- | Create constraints that will be used to spend a locked transaction output +-- from the script address. +-- +-- These constraints will be used in the validation script as well as in the +-- transaction creation step. +{-# INLINABLE splitDataConstraints #-} +splitDataConstraints :: SplitData -> TxConstraints () SplitData +splitDataConstraints SplitData{recipient1, recipient2, amount} = + Constraints.mustPayToPubKey recipient1 (Ada.toValue half) + `mappend` Constraints.mustPayToPubKey recipient2 (Ada.toValue $ amount - half) + where + half = Ada.divide amount 2 + +-- BLOCK2 + +-- | The validation logic is generated with `checkScriptContext` based on the set +-- of constraints. +{-# INLINABLE validateSplit #-} +validateSplit :: SplitData -> () -> ScriptContext -> Bool +validateSplit splitData _ = + Constraints.checkScriptContext (splitDataConstraints splitData) + +-- BLOCK3 + +splitValidator :: Scripts.TypedValidator Split +splitValidator = Scripts.mkTypedValidator @Split + $$(PlutusTx.compile [|| validateSplit ||]) + $$(PlutusTx.compile [|| wrap ||]) where + wrap = Scripts.mkUntypedValidator @SplitData @() + +-- BLOCK4 + +unlock :: Promise () SplitSchema T.Text () +unlock = endpoint @"unlock" (unlockFunds . mkSplitData) + +-- | Creates a transaction which spends all script outputs from a script address, +-- sums the value of the scripts outputs and splits it between two payment keys. +unlockFunds :: SplitData -> Contract () SplitSchema T.Text () +unlockFunds splitData = do + -- Get the address of the Split validator + let contractAddress = Scripts.validatorAddress splitValidator + -- Get all utxos that are locked by the Split validator + utxos <- utxosAt contractAddress + -- Generate constraints which will spend all utxos locked by the Split + -- validator and split the value evenly between the two payment keys. + let constraints = collectFromScript utxos () + <> splitDataConstraints splitData + -- Create, Balance and submit the transaction + void $ submitTxConstraintsSpending splitValidator utxos constraints + +-- BLOCK5 diff --git a/doc/plutus/tutorials/BasicApps.hs b/doc/plutus/tutorials/BasicApps.hs index db81036620..fc97315b8f 100644 --- a/doc/plutus/tutorials/BasicApps.hs +++ b/doc/plutus/tutorials/BasicApps.hs @@ -106,8 +106,8 @@ mkSplitData LockArgs{recipient1Wallet, recipient2Wallet, totalAda} = lockFunds :: SplitData -> Contract () SplitSchema T.Text () lockFunds s@SplitData{amount} = do logInfo $ "Locking " <> Haskell.show amount - let tx = Constraints.mustPayToTheScript s (Ada.toValue amount) - void $ submitTxConstraints splitValidator tx + let constraints = Constraints.mustPayToTheScript s (Ada.toValue amount) + void $ submitTxConstraints splitValidator constraints -- BLOCK8 diff --git a/doc/plutus/tutorials/basic-apps-constraints.rst b/doc/plutus/tutorials/basic-apps-constraints.rst new file mode 100644 index 0000000000..d10cd5a313 --- /dev/null +++ b/doc/plutus/tutorials/basic-apps-constraints.rst @@ -0,0 +1,33 @@ +.. highlight:: haskell +.. _basic_apps_constraints_tutorial: + +Extending the basic Plutus app with the constraints API +======================================================= + +The previous tutorial (see :ref:`basic_apps_tutorial`) showed you how to write a Plutus app that locks some Ada in a script output and splits them evenly between two recipients. +In this tutorial, we will reuse the same example, but we will use instead the constraints API which will be used to generate the on-chain and off-chain part of the Plutus app. +This will allow your application to create a transaction which is *mostly* consistent with the validator function. + +Given a `SplitData`, let's start by defining a function which generates the constraints to unlock funds locked by the split validator. + +.. literalinclude:: BasicAppConstraints.hs + :start-after: BLOCK1 + :end-before: BLOCK2 + +With the constraints, let's start by defining the validator function. + +.. literalinclude:: BasicAppConstraints.hs + :start-after: BLOCK2 + :end-before: BLOCK3 + +As you can see, it's much simpler than the original version. + +Now to the off-chain part. +The `lock` endpoint doesn't change. +However, we can change the `unlock` endpoint to use the constraints we defined above. + +.. literalinclude:: BasicAppConstraints.hs + :start-after: BLOCK4 + :end-before: BLOCK5 + +That's it! The rest of the contract is the same as the previous tutorial. diff --git a/doc/plutus/tutorials/index.rst b/doc/plutus/tutorials/index.rst index 6c8d171460..ce386ba84e 100644 --- a/doc/plutus/tutorials/index.rst +++ b/doc/plutus/tutorials/index.rst @@ -9,9 +9,10 @@ Tutorials plutus-playground basic-apps + basic-apps-constraints plutus-tx basic-validators basic-minting-policies contract-testing contract-models - +