Plutus Tuto – Part 3

We now have some basic understanding of the wallet API and how to simply interact with the on-chained Plutus code. Let’s dive into some more advanced code!


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
-- | Crowdfunding contract implemented using the [[Plutus]] interface.
-- This is the fully parallel version that collects all contributions
-- in a single transaction.
--
-- Note [Transactions in the crowdfunding campaign] explains the structure of
-- this contract on the blockchain.
module Language.PlutusTx.Coordination.Contracts.CrowdFunding where

import qualified Language.PlutusTx            as PlutusTx
import qualified Language.PlutusTx.Prelude    as P
import           Ledger
import           Ledger.Validation
import           Playground.Contract
import           Wallet

-- | A crowdfunding campaign.
data Campaign = Campaign
    { campaignDeadline           :: Height
    -- ^ The date by which the campaign target has to be met. (Blocks have a
    --   fixed length, so we can use them to measure time)
    , campaignTarget             :: Value
    -- ^ Target amount of funds
    , campaignCollectionDeadline :: Height
    -- ^ The date by which the campaign owner has to collect the funds
    , campaignOwner              :: PubKey
    -- ^ Public key of the campaign owner. This key is entitled to retrieve the
    --   funds if the campaign is successful.
    } deriving (Generic, ToJSON, FromJSON, ToSchema)

PlutusTx.makeLift ''Campaign

-- | Action that can be taken by the participants in this contract. A value of
--   `CampaignAction` is provided as the redeemer. The validator script then
--   checks if the conditions for performing this action are met.
--  
data CampaignAction = Collect | Refund
    deriving (Generic, ToJSON, FromJSON, ToSchema)

PlutusTx.makeLift ''CampaignAction

-- | The validator script that determines whether the campaign owner can
--   retrieve the funds or the contributors can claim a refund.
--
contributionScript :: Campaign -> ValidatorScript
contributionScript cmp  = ValidatorScript val where
    val = Ledger.applyScript mkValidator (Ledger.lifted cmp)
    mkValidator = Ledger.fromCompiledCode $(PlutusTx.compile [||

        -- The validator script is a function of four arguments:
        -- 1. The 'Campaign' definition. This argument is provided by the Plutus client, using 'Ledger.applyScript'.
        --    As a result, the 'Campaign' definition is part of the script address, and different campaigns have different addresses.
        --    The Campaign{..} syntax means that all fields of the 'Campaign' value are in scope (for example 'campaignDeadline' in l. 70).
        --    See note [RecordWildCards].
        --
        -- 2. A 'CampaignAction'. This is the redeemer script. It is provided by the redeeming transaction.
        --
        -- 3. A 'PubKey'. This is the data script. It is provided by the producing transaction (the contribution)
        --
        -- 4. A 'PendingTx' value. It contains information about the current transaction and is provided by the slot leader.
        --    See note [PendingTx]
        \Campaign{..} (act :: CampaignAction) (con :: PubKey) (p :: PendingTx') ->
            let

                -- In Haskell we can define new operators. We import
                -- `PlutusTx.and` from the Prelude here so that we can use it
                -- in infix position rather than prefix (which would require a
                -- lot of additional brackets)
                infixr 3 &&
                (&&) :: Bool -> Bool -> Bool
                (&&) = $(PlutusTx.and)
               
                -- We pattern match on the pending transaction `p` to get the
                -- information we need:
                -- `ps` is the list of inputs of the transaction
                -- `outs` is the list of outputs
                -- `h` is the current block height
                PendingTx ps outs _ _ (Height h) _ _ = p

                -- `deadline` is the campaign deadline, but we need it as an
                -- `Int` so that we can compare it with other integers.
                deadline :: Int
                deadline = let Height h' = campaignDeadline in h'


                -- `collectionDeadline` is the campaign collection deadline as
                -- an `Int`
                collectionDeadline :: Int
                collectionDeadline = let Height h' = campaignCollectionDeadline in h'

                -- `target` is the campaign target as
                -- an `Int`
                target :: Int
                target = let Value v = campaignTarget in v

               
                -- `totalInputs` is the sum of the values of all transation
                -- inputs. We ise `foldr` from the Prelude to go through the
                -- list and sum up the values.
                totalInputs :: Int
                totalInputs =
                    let v (PendingTxIn _ _ (Value vl)) = vl in
                    $(P.foldr) (\i total -> total + v i) 0 ps

                isValid = case act of
                    Refund -> -- the "refund" branch
                        let

                            contributorTxOut :: PendingTxOut -> Bool
                            contributorTxOut o = case $(pubKeyOutput) o of
                                Nothing -> False
                                Just pk -> $(eqPubKey) pk con

                            -- Check that all outputs are paid to the public key
                            -- of the contributor (this key is provided as the data script `con`)
                            contributorOnly = $(P.all) contributorTxOut outs

                            refundable = h >= collectionDeadline && contributorOnly && $(txSignedBy) p con

                        in refundable
                    Collect -> -- the "successful campaign" branch
                        let
                            payToOwner = h >= deadline && h < collectionDeadline && totalInputs >= target && $(txSignedBy) p campaignOwner
                        in payToOwner
            in
            if isValid then () else $(P.error) () ||])

-- | The address of a [[Campaign]]
campaignAddress :: Campaign -> Ledger.Address'
campaignAddress = Ledger.scriptAddress . contributionScript

-- | Contribute funds to the campaign (contributor)
--
contribute :: Campaign -> Value -> MockWallet ()
contribute cmp value = do
    _ <- if value <= 0 then throwOtherError "Must contribute a positive value" else pure ()
    ownPK <- ownPubKey
    let ds = DataScript (Ledger.lifted ownPK)

    -- `payToScript` is a function of the wallet API. It takes a campaign
    -- address, value, and data script, and generates a transaction that
    -- pays the value to the script. `tx` is bound to this transaction. We need
    -- to hold on to it because we are going to use it in the refund handler.
    -- If we were not interested in the transaction produced by `payToScript`
    -- we could have used `payeToScript_`, which has the same effect but
    -- discards the result.
    tx <- payToScript (campaignAddress cmp) value ds
   
    logMsg "Submitted contribution"

    -- `register` adds a blockchain event handler on the `refundTrigger`
    -- event. It instructs the wallet to start watching the addresses mentioned
    -- in the trigger definition and run the handler when the refund condition
    -- is true.
    register (refundTrigger cmp) (refundHandler (Ledger.hashTx tx) cmp)


    logMsg "Registered refund trigger"

-- | Register a [[EventHandler]] to collect all the funds of a campaign
--
scheduleCollection :: Campaign -> MockWallet ()
scheduleCollection cmp = register (collectFundsTrigger cmp) (EventHandler (\_ -> do
        logMsg "Collecting funds"
        let redeemerScript = Ledger.RedeemerScript (Ledger.lifted Collect)
        collectFromScript (contributionScript cmp) redeemerScript))

-- | An event trigger that fires when a refund of campaign contributions can be claimed
refundTrigger :: Campaign -> EventTrigger
refundTrigger c = andT
    (fundsAtAddressT (campaignAddress c) (GEQ 1))
    (blockHeightT (GEQ (succ (campaignCollectionDeadline c))))

-- | An event trigger that fires when the funds for a campaign can be collected
collectFundsTrigger :: Campaign -> EventTrigger
collectFundsTrigger c = andT
    (fundsAtAddressT (campaignAddress c) (GEQ (campaignTarget c)))
    (blockHeightT (Interval (campaignDeadline c) (campaignCollectionDeadline c)))

-- | Claim a refund of our campaign contribution
refundHandler :: TxId' -> Campaign -> EventHandler MockWallet
refundHandler txid cmp = EventHandler (\_ -> do
    logMsg "Claiming refund"
    let validatorScript = contributionScript cmp
        redeemerScript  = Ledger.RedeemerScript (Ledger.lifted Refund)
       
    collectFromScriptTxn validatorScript redeemerScript txid)

$(mkFunction 'scheduleCollection)
$(mkFunction 'contribute)

First thing we have to do, as we do for any functional programming language: thing to our problem and write the data structures that will represent its different components.

Let’s start by thinking about what we want to do here. We want to create campaigns through which one can raise funds and others can contribute. We want the funds to be locked until a certain deadline, and the campaign owner to collect only if a certain target is reached. If the target is not reached (meaning the project didn’t get enough traction and that they don’t have enough funds to carry it, or whatever), we want the users to be refunded. In order to have this refund capability, it means we have to keep track of what each user contributed to the campaign (in other word, we need to attach the public key of the person who transfer fund to the campaign).

Data structures used in the crowdfunding contract

As explain in the previous article, we can find the different components that are essential in a Plutus contract:

  • Validator Scrip : This is the core the smart contract, which carries out the necessary computation to keep the funds safe.
  • The Data Script: They are attached to a particular transaction sent to a Validator Script and which enabled to carry meta data.
  • The Redeemer Script: They are used to collect the UTx0 located at the addresses of a Validator Script.

This is how the script will be working and it gives us straight away the different data structure that will be involved in this script.

One big feature that we have out of the box with the Wallet API and Plutus living in the same space is the possibility to subscribe to events and to react to what is happening on the chain. This is something that is essentially done through services like Ethereum Alarm Clock, which calls a contract regularly. This is the idea that was developed during the presentation of Plutus during the PlutusFest by P. Wadler, that on chain and off chain computation and very tight together and we need a way to make the communication painless between the 2.

We will use this feature to give life to our contract, and we can modelize it by the sequence diagram bellow:

Events flow for the campaign lifetime

In essence, what we are doing here is quite simple and will be representing how a lot of smart contract would work in reality: scheduling events, subscribing to events, react to events and push/retrieve data from the blockchain.

Let’s now dive into the code!


1
2
3
4
5
6
7
8
9
10
11
12
data Campaign = Campaign
    { campaignDeadline           :: Height
    , campaignTarget             :: Value
    , campaignCollectionDeadline :: Height
    , campaignOwner              :: PubKey
    } deriving (Generic, ToJSON, FromJSON, ToSchema)

PlutusTx.makeLift ''Campaign<br>
data CampaignAction = Collect | Refund
    deriving (Generic, ToJSON, FromJSON, ToSchema)

PlutusTx.makeLift ''CampaignAction

Up to the line 39, what we are defining is the data structure of a campaign and what are the different interactions we can have with it. A campaign will be in our case defined by 2 deadlines (that appear on the sequence diagram – campaignDeadline and campaignCollectionDeadline tell us from when the campaign owner can collect the funds and from when when contributor can get a refund (if they haven’t been collected before). The campaignTarget indicates how much need to be raised for the campaignOwner to collect the funds, and campaignOwner is the public key of the wallet which will be authorised to collect the funds.

Note that there are no particular ID for the campaign, and that a campaign is essentially represented by its attributes (that need to be filed each time). It means you can’t have 2 different campaigns with the same attributes!

The CampaignAction here are representing what an actor can go with the ValidatorScript – it speaks for itself.

Let’s now look at the Plutus code itself. The first thing that we notice is that, compared to the previous contract we had a look at, is that we are here compiling a lambda function taking 4 arguments, not 3. This is because we want to have a ValidatorScript for each campaign, each having their own address. If you don’t do it this way, you would probably need to carry this information in the DataScript and RedeemerScript each time you want to interact with the contract, which would probably result in spending more gas as you store more data on the chain on the user side (along side with the fact that it looks more messy).


1
2
3
4
contributionScript :: Campaign -> ValidatorScript
contributionScript cmp  = ValidatorScript val where
    val = Ledger.applyScript mkValidator (Ledger.lifted cmp)
    mkValidator = Ledger.fromCompiledCode $(PlutusTx.compile [||

That’s what these 4 lines are doing, with applyScript :: Script -> Script -> Script giving you the capability to compose Scripts together (same way you would compose functions in a functional programming (mkValidator and Ledger.lifted cmp both being a script)).

Note that the ValidatorScript is called for every transaction that payed to this contract address. This is something that took me quite a while to get my head around (and I had to go through the repository to find it out, looking at the extended UTxO model here), but each time you’re paying on the script, you have to pay with a DataScript attached to the transaction. Then, when you are building a new transaction (to collect all the funds of the script for example), the validator script is ran through every input in the pending transaction (to see if you are allowed to do so) and will provide the script with the DataScript associated to this input.


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
\Campaign{..} (act :: CampaignAction) (con :: PubKey) (p :: PendingTx') ->
            let
                infixr 3 &&
                (&&) :: Bool -> Bool -> Bool
                (&&) = $(PlutusTx.and)
               
                PendingTx ps outs _ _ (Height h) _ _ = p

                deadline :: Int
                deadline = let Height h' = campaignDeadline in h'

                collectionDeadline :: Int
                collectionDeadline = let Height h' = campaignCollectionDeadline in h'

                target :: Int
                target = let Value v = campaignTarget in v

                totalInputs :: Int
                totalInputs =
                    let v (PendingTxIn _ _ (Value vl)) = vl in
                    $(P.foldr) (\i total -> total + v i) 0 ps

                isValid = case act of
                    Refund -> -- the "refund" branch
                        let

                            contributorTxOut :: PendingTxOut -> Bool
                            contributorTxOut o = case $(pubKeyOutput) o of
                                Nothing -> False
                                Just pk -> $(eqPubKey) pk con

                            contributorOnly = $(P.all) contributorTxOut outs

                            refundable = h >= collectionDeadline && contributorOnly && $(txSignedBy) p con

                        in refundable
                    Collect -> -- the "successful campaign" branch
                        let
                            payToOwner = h >= deadline && h < collectionDeadline && totalInputs >= target && $(txSignedBy) p campaignOwner
                        in payToOwner
            in
            if isValid then () else $(P.error) ()

We first redefine the && operator to have less pain writing conditions in Plutus. You could imagine having this kind of definition in a different module later on, but for now, Plutus doesn’t support this. Then we use pattern matching on the pending transactions p. One thing to understand is: what is p in our case?

When you’ll try to collect UTxO which belong to the script through collectFromScript or collectFromScriptTxn (the only difference is that the first one collect all the transactions on the contract address and the second one accept a Transaction ID to get only a specific transaction), you’ll implicitly build a transaction approximately the same way Bitcoin is doing: you’ll have a set of inputs (which are effectively unspent output transaction which were paid to the script) and a set of outputs (which is the address you want to send the money to).


1
2
3
4
5
6
7
8
9
data PendingTx a = PendingTx
    { pendingTxInputs      :: [PendingTxIn] -- ^ Transaction inputs
    , pendingTxOutputs     :: [PendingTxOut]
    , pendingTxFee         :: Value
    , pendingTxForge       :: Value
    , pendingTxBlockHeight :: Height
    , pendingTxSignatures  :: [Signature]
    , pendingTxOwnHash     :: a -- ^ Hash of the validator script that is currently running
    } deriving (Functor, Generic)

So using pattern matching on the type defined above, we are getting all the set of inputs, outputs and the height of the transaction in the blockchain (counted in terms of block). We don’t really need to pay attention to what is a in our case, but it is the reason why we use PendingTx' and not PendingTx (here is the type definition:type PendingTx' = PendingTx ValidatorHash)

We then use so more pattern matching to extract the different attributes of the campaign in a type we can manipulate more easily, in our case Int: deadline, collectionDeadline and target

totalInputs is a bit different but not more complicated than normal Haskell code: we use foldr on the set of inputs of the transaction, as we would on any other collection, using the lambda v (PendingTxIn _ _ (Value vl)) = vl in order to extract the value of a specific input. Here is the type on which we are pattern matching:


1
2
3
4
5
data PendingTxIn = PendingTxIn
    { pendingTxInRef       :: PendingTxOutRef
    , pendingTxInRefHashes :: Maybe (ValidatorHash, RedeemerHash) -- ^ Hashes of validator and redeemer scripts
    , pendingTxInValue     :: Value -- ^ Value consumed by this txn input
    } deriving (Generic)

All these variables that were just defined above are then use to compute the isValid variable.


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
isValid = case act of
    Refund ->
        let

            contributorTxOut :: PendingTxOut -> Bool
            contributorTxOut o = case $(pubKeyOutput) o of
                Nothing -> False
                Just pk -> $(eqPubKey) pk con

 
            contributorOnly = $(P.all) contributorTxOut outs

            refundable = h >= collectionDeadline && contributorOnly && $(txSignedBy) p con

        in refundable
    Collect ->
        let
            = h >= deadline && h < collectionDeadline && totalInputs >= target && $(txSignedBy) p campaignOwner
        in payToOwner

We split in 2 different cases (which correct to the only 2 way a use can interact with the ValidatorScript).

  • Refund: We check that the address we are sending the value to (we get this key by calling pubKeyOutput on every output of the transaction) is equal to the same key stored in the DataScript (the one which sent the money to the ValidatorScript). That means that the value can only go back to their original owner, and no one else. We also need to check that the key trying to validate the refund transaction is the same as the one which contributed the money (otherwise anyone could trigger anyone else’s contribution) by using txSignedBy on the transaction. We also check that all of this happens in after the collectionDeadline is passed.
  • Collect: This is easiest as we don’t need to check any element of the transaction, except that it has been sign by the campaignOwner as he is the only one authorised to collect the funds after the deadline is passed and that the target is reached.

The last step of the ValidatorScript is to check if the transaction which is attempted is valid, and if not, raise an error (In Plutus, you have to raise errors in the ValidatorScript if a transaction is not valid, and when this happens, the transaction will be aborted).

We’ve been through the first component of this application – the on-chain operation. Now, we need to go through the off-chain computation, which will be mainly composed of events and event handlers.


1
2
campaignAddress :: Campaign -> Ledger.Address'
campaignAddress = Ledger.scriptAddress . contributionScript

We first define a helper function to be able to retrieve the address of the ValidatorScript (as we have 1 address per campaign).


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
contribute :: Campaign -> Value -> MockWallet ()
contribute cmp value = do
    _ <- if value <= 0 then throwOtherError "Must contribute a positive value" else pure ()
    ownPK <- ownPubKey
    let ds = DataScript (Ledger.lifted ownPK)

    tx <- payToScript (campaignAddress cmp) value ds
   
    logMsg "Submitted contribution"
    register (refundTrigger cmp) (refundHandler (Ledger.hashTx tx) cmp)


    logMsg "Registered refund trigger"

refundTrigger :: Campaign -> EventTrigger
refundTrigger c = andT
    (fundsAtAddressT (campaignAddress c) (GEQ 1))
    (blockHeightT (GEQ (succ (campaignCollectionDeadline c))))

refundHandler :: TxId' -> Campaign -> EventHandler MockWallet
refundHandler txid cmp = EventHandler (\_ -> do
    logMsg "Claiming refund"
    let validatorScript = contributionScript cmp
        redeemerScript  = Ledger.RedeemerScript (Ledger.lifted Refund)
       
    collectFromScriptTxn validatorScript redeemerScript txid)

Most of the code present in the contribute function should be quite easy to understand as we already have been through it in the previous article. The only difference here is that we store the transaction that is validated, instead of discarding it by using payToScript_ (as we did previously). The other new part is the use of register :: EventTrigger -> EventHandler m -> m (). Thanks to this function, which uses the Wallet API, we can subscribe to an event and run an operation when the event has been triggered.


data Range a =
    Interval a a -- ^ inclusive-exclusive
    | GEQ a
    | LT a
    deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Generic)

fundsAtAddressT :: Address' -> Range Value -> EventTrigger

blockHeightT :: Range Height -> EventTrigger

andT :: EventTrigger -> EventTrigger -> EventTrigger

collectFromScriptTxn :: (Monad m, WalletAPI m) => ValidatorScript -> RedeemerScript -> TxId' -> m ()

These are the elements that are useful in our case because the only events we are interested in being notified when the blockchain reaches a specific blockchain Height and when the funds on a specific address are high enough. You can find more about the different events available here: 

https://input-output-hk.github.io/plutus/Wallet-API.html#v:andT

The last element of interest here is the creation of the  EventHandler. This data constructor takes a lambda that will capture the variables passed to the function (ie. txid and cmp). Here again, nothing fancy inside this function, maybe apart from collectFromScriptTxn which works in a similar way as collectFromScript, except that it takes one more argument: the Tx ID of the transaction that we want to collect from the script (rather than collecting everything from the script). Btw, when you see a ' next to a datatype, it means that it corresponds to the hashed version in our case, which is why we use Ledger.hashTx to get the hash of the transaction.


scheduleCollection :: Campaign -> MockWallet ()
scheduleCollection cmp = register (collectFundsTrigger cmp) (EventHandler (\_ -> do
        logMsg "Collecting funds"
        let redeemerScript = Ledger.RedeemerScript (Ledger.lifted Collect)
        collectFromScript (contributionScript cmp) redeemerScript))

collectFundsTrigger :: Campaign -> EventTrigger
collectFundsTrigger c = andT
    (fundsAtAddressT (campaignAddress c) (GEQ (campaignTarget c)))
    (blockHeightT (Interval (campaignDeadline c) (campaignCollectionDeadline c)))

We do as well the same thing on the campaign owner side – nothing new on this side, except the range defined by Interval, used to say that we want the event to be fired only between the campaign deadline and the collection deadline.

That was quite a lot to explore in this article in terms of code! Let now see how it plays in the playground! 🙂

In here, we test 2 scenarios:

  • Successful campaign: The target has been reached and the campaign owner claims the funds before the collection deadline
  • Failed campaign: The target is reached but the campaign owner failed to collect the funds

Feel free to test in the playground a 3rd scenario where the target is not reached for example.

Successful Campaign – Actions

Successful Campaign – Logs

Successful Campaign – Final Balances

Failed Campaign – Actions

Failed Campaign – Logs

Failed Campaign – Final Balances

Leave a Reply

Your email address will not be published. Required fields are marked *