Skip to content
Permalink
Browse files

plutus-tutorial: Solutions

Add solutions to the exercises in wallet API tutorials I and II.
  • Loading branch information...
j-mueller committed Mar 14, 2019
1 parent 073ceb7 commit f42025fc612c0f7128859584c730458c0b8aeb69
@@ -16,7 +16,7 @@
- error: {lhs: "maybe mempty", rhs: "foldMap", name: "Use foldMap"}
- error: {lhs: "mconcat", rhs: "fold", name: "Generalize mconcat"}

- ignore: {name: Reduce duplication, within: [Language.PlutusCore.Renamer, Language.PlutusCore.Constant.Prelude, Language.PlutusCore.StdLib.Data.Bool, Language.PlutusCore.StdLib.Data.ChurchNat, Language.PlutusCore.StdLib.Data.Function, Language.PlutusCore.StdLib.Data.List, Language.PlutusCore.StdLib.Data.Sum, Language.PlutusCore.StdLib.Data.Nat, Language.PlutusCore.Pretty.Readable, Language.PlutusCore.Examples.Data.InterList, Language.PlutusCore.Examples.Data.TreeForest, Language.PlutusTx.Compiler.Binders, Language.PlutusTx.Compiler.Type, Evaluation.CkMachine, Spec.Crowdfunding, Spec.Vesting, Language.PlutusTx.Lift, OptimizerSpec, TransformSpec]}
- ignore: {name: Reduce duplication, within: [Language.PlutusCore.Renamer, Language.PlutusCore.Constant.Prelude, Language.PlutusCore.StdLib.Data.Bool, Language.PlutusCore.StdLib.Data.ChurchNat, Language.PlutusCore.StdLib.Data.Function, Language.PlutusCore.StdLib.Data.List, Language.PlutusCore.StdLib.Data.Sum, Language.PlutusCore.StdLib.Data.Nat, Language.PlutusCore.Pretty.Readable, Language.PlutusCore.Examples.Data.InterList, Language.PlutusCore.Examples.Data.TreeForest, Language.PlutusTx.Compiler.Binders, Language.PlutusTx.Compiler.Type, Evaluation.CkMachine, Spec.Crowdfunding, Spec.Vesting, Language.PlutusTx.Lift, OptimizerSpec, TransformSpec, Tutorial.Solutions0Mockchain]}
- ignore: {name: Redundant $, within: [Evaluation.Constant.Success, Language.PlutusCore.Generators.Internal.TypedBuiltinGen]}
- ignore: {name: Redundant bracket, within: [Language.PlutusTx.TH]}
# this is rarely an improvement, also ignored in cardano
@@ -416,9 +416,12 @@ You can run the test suite with `nix build -f default.nix localPackages.plutus-u
```
data Campaign = Campaign {
fundingTargets :: [(Slot, Ada)],
collectionDeadline :: Slot,
campaignOwner :: PubKey
}
```

where `fundingTargets` is a list of slot numbers with associated Ada amounts. The campaign is successful if the funding target for one of the slots has been reached *before* that slot begins. For example, campaign with
`Campaign [(Slot 20, Ada 100), (Slot 30, Ada 200)]` is successful if the contributions amount to 100 Ada or more by slot 20, or 200 Ada or more by slot 30.

Solutions to these problems can be found [`Solutions0.hs`](../../tutorial/Tutorial/Solutions0.hs).
@@ -41,6 +41,8 @@ library
Tutorial.Emulator
Tutorial.Vesting
Tutorial.ExUtil
Tutorial.Solutions0
Tutorial.Solutions0Mockchain
Tutorial.Solutions1
Tutorial.Solutions2
ghc-options: -Wno-unused-imports
@@ -3,8 +3,10 @@ module Tutorial.ExUtil(
initialTx
, w1
, w2
, w3
, pk1
, pk2
, pk3
, runTrace
, runTraceDist
, runTraceLog
@@ -26,25 +28,28 @@ initialTx =
, txOutputs =
[ pubKeyTxOut oneThousand pk1
, pubKeyTxOut oneThousand pk2
, pubKeyTxOut oneThousand pk3
]
, txForge = oneThousand `Value.plus` oneThousand
, txForge = oneThousand `Value.plus` oneThousand `Value.plus` oneThousand
, txFee = Ada.zero
, txValidRange = WAPI.defaultSlotRange
}

-- Some wallets used for testing. Wallets are identified by an 'Int'. (Note.
-- This will change soon! In the near future each wallet will be identified by
-- a cryptographic key)
w1, w2 :: EM.Wallet
w1, w2, w3 :: EM.Wallet
w1 = EM.Wallet 1
w2 = EM.Wallet 2
w3 = EM.Wallet 3

-- To send money to a wallet we need to know its public key. We currently use
-- 'Int's to represent public keys in the mockchain. (Note. This will change
-- soon!)
pk1, pk2 :: WAPI.PubKey
pk1, pk2, pk3 :: WAPI.PubKey
pk1 = WAPI.PubKey 1
pk2 = WAPI.PubKey 2
pk3 = WAPI.PubKey 3

-- | A helper function for running traces. 'runTrace'
-- * Forges some funds using the initial transaction from Ledger.ExUtils, to
@@ -59,7 +64,7 @@ runTrace trc = EM.runTraceTxPool [initialTx] $ do
-- transaction and notify all wallets. If we don't do that, then the wallets
-- will assume that they don't own any unspent transaction outputs, and all
-- attempts to make non-zero payments will fail.
_ <- EM.addBlocksAndNotify [w1, w2] 1
_ <- EM.addBlocksAndNotify [w1, w2, w3] 1

-- now we can run 'trc'.
trc
@@ -0,0 +1,281 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -O0 #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Tutorial.Solutions0 where

import Data.Foldable (traverse_)
import qualified Language.PlutusTx as P
import qualified Ledger.Interval as P
import Ledger (Address, DataScript(..), PubKey(..), RedeemerScript(..), Signature(..), Slot(..), TxId, ValidatorScript(..))
import qualified Ledger as L
import qualified Ledger.Ada.TH as Ada
import Ledger.Ada.TH (Ada)
import qualified Ledger.Interval as Interval
import Ledger.Validation (PendingTx(..), PendingTxIn(..), PendingTxOut)
import qualified Ledger.Validation as V
import Wallet (WalletAPI(..), WalletDiagnostics(..), MonadWallet, EventHandler(..), EventTrigger)
import qualified Wallet as W
import Prelude hiding ((&&))
import GHC.Generics (Generic)

{-
Solutions for the wallet API tutorials
-}

-- 1. Wallet API I (guessing game)


-- 1. Run traces for a successful game and a failed game in the Playground, and examine the logs after each trace.
-- (the logs should show the error message for the failed trace)
-- 2. Change the error case of the validator script to `($$(P.traceH) "WRONG!" ($$(P.error) ()))` and run the trace again with a wrong guess. Note how this time the log does not include the error message.
-- (there should be a failed transaction without log message)
-- 1. Look at the trace shown below. What will the logs say after running "Evaluate"?
-- Wallet 1's transaction attempts to unlock both outputs with the same redeemer ("plutus"). This fails for the second output (which expects "pluto"), making the entire transaction invalid.

-- 2. Wallet API II (crowdfunding)

-- 1. Run traces for successful and failed campaigns
-- In the logs for the succesful trace you should see the "collect funds"
-- trigger being activated after the `endDate` slot. (Make sure to include a
-- wait action to add some empty blocks). The trace of the failed campaign
-- should end with refunds being claimed after the `collectionDeadline` slot.

-- 2. Change the validator script to produce more detailed log messages using
-- `P.traceH`
-- The log messages are only printed when validation of the script output
-- fails. The triggers for both outcomes (successful campaign and refund)
-- are set up to ensure that they only submit valid transactions to the
-- chain. An easy way to get the handler code to produce an invalid
-- transaction is by changing the last line of `refundHandler` to
--
-- W.collectFromScript_ range (mkValidatorScript cmp) redeemer)
--
-- that is, to attempt to collect refunds for all contributions.

-- 3. Write a variation of the crowdfunding campaign that uses

-- ```
-- data Campaign = Campaign {
-- fundingTargets :: [(Slot, Ada)],
-- campaignOwner :: PubKey
-- }
-- ```

-- where `fundingTargets` is a list of slot numbers with associated Ada amounts. The campaign is successful if the funding target for one of the slots has been reached before that slot begins. For example, a campaign with
-- `Campaign [(Slot 20, Ada 100), (Slot 30, Ada 200)]` is successful if the contributions amount to 100 Ada or more by slot 20, or 200 Ada or more by slot 30.

-- SOLUTION
-- For this solution we use a `Campaign` type that also has the
-- `collectionDeadline` field from the original crowdfunding campaign (this was
-- on oversight on my part)
--
-- The remaining types are the same. We can re-use the code from the original
-- crowdfunder that deals with refunds. Only the code that deals with a
-- successful campaign needs to be changed. Below is the full contract. I added
-- comments where the code differs from the original.

data Campaign = Campaign {
fundingTargets :: [(Slot, Ada)],
collectionDeadline :: Slot,
campaignOwner :: PubKey
}

P.makeLift ''Campaign

data CampaignAction = Collect | Refund
P.makeLift ''CampaignAction

type CampaignRedeemer = (CampaignAction, Signature)

data Contributor = Contributor PubKey
P.makeLift ''Contributor

mkValidatorScript :: Campaign -> ValidatorScript
mkValidatorScript campaign = ValidatorScript val where
val = L.applyScript mkValidator (L.lifted campaign)
mkValidator = L.fromCompiledCode $$(P.compile [||
\(c :: Campaign) (con :: Contributor) (act :: CampaignRedeemer) (p :: PendingTx) ->
let
infixr 3 &&
(&&) :: Bool -> Bool -> Bool
(&&) = $$(P.and)


signedBy :: PubKey -> Signature -> Bool
signedBy (PubKey pk) (Signature s) = $$(P.eq) pk s

PendingTx ins outs _ _ _ txnValidRange = p
-- p is bound to the pending transaction.

Campaign targets collectionDeadline campaignOwner = c

totalInputs :: Ada
totalInputs =
-- define a function "addToTotal" that adds the ada
-- value of a 'PendingTxIn' to the total
let addToTotal (PendingTxIn _ _ vl) total =
let adaVl = $$(Ada.fromValue) vl
in $$(Ada.plus) total adaVl

-- Apply "addToTotal" to each transaction input,
-- summing up the results
in $$(P.foldr) addToTotal $$(Ada.zero) ins

isValid = case act of
(Refund, sig) ->
let
Contributor pkCon = con

contribTxOut :: PendingTxOut -> Bool
contribTxOut o =
case $$(V.pubKeyOutput) o of
Nothing -> False
Just pk -> $$(V.eqPubKey) pk pkCon

contributorOnly = $$(P.all) contribTxOut outs

refundable =
$$(P.before) collectionDeadline txnValidRange &&
contributorOnly &&
pkCon `signedBy` sig

in refundable

-- START OF NEW CODE
(Collect, sig) ->
let

-- | Check whether a given 'Slot' is after the current
-- transaction's valid range
isFutureSlot :: Slot -> Bool
isFutureSlot sl = $$(Interval.after) sl txnValidRange

-- | Return the smaller of two 'Ada' values
-- (NB this should be in the standard library)
minAda :: Ada -> Ada -> Ada
minAda l r = if $$(Ada.lt) l r then l else r

-- | Return the minimum of a list of 'Ada' values, if
-- it exists
minimumAda :: [Ada] -> Maybe Ada
minimumAda slts = case slts of
[] -> Nothing
x:xs -> Just ($$(P.foldr) minAda x xs)

-- | The list of 'targets' filtered to those targets
-- that are in the future
futureTargets :: [(Slot, Ada)]
futureTargets = $$(P.filter) (\(a, _) -> isFutureSlot a) targets

-- | The amount we have to exceed if we want to collect
-- all the contributions now. It is the smallest of
-- all target amounts that are in the future.
currentTarget :: Maybe Ada
currentTarget = minimumAda ($$(P.map) (\(_, a) -> a) futureTargets)

-- We may collect the contributions if the
-- 'currentTarget' is defined and the sum of all
-- inputs meets it.
targetMet =
case currentTarget of
Nothing -> False
Just a -> $$(Ada.geq) totalInputs a

in
-- note that we don't need to check the pending
-- transaction's validity interval separately.
-- 'targetMet' is only true if the interval ends
-- before at least one of the targets.
targetMet &&
campaignOwner `signedBy` sig

-- END OF NEW CODE
in if isValid then () else ($$(P.error) ()) ||])

campaignAddress :: Campaign -> Address
campaignAddress cmp = L.scriptAddress (mkValidatorScript cmp)

mkDataScript :: PubKey -> DataScript
mkDataScript pk = DataScript (L.lifted (Contributor pk))

mkRedeemer :: CampaignRedeemer -> RedeemerScript
mkRedeemer action = RedeemerScript (L.lifted (action))

refundHandler :: MonadWallet m => TxId -> Campaign -> EventHandler m
refundHandler txid cmp = EventHandler (\_ -> do
W.logMsg "Claiming refund"
sig <- W.ownSignature
currentSlot <- W.slot
let redeemer = mkRedeemer (Refund, sig)
range = W.intervalFrom currentSlot
W.collectFromScriptTxn range (mkValidatorScript cmp) redeemer txid)

refundTrigger :: Campaign -> EventTrigger
refundTrigger c = W.andT
(W.fundsAtAddressT (campaignAddress c) (W.intervalFrom ($$(Ada.toValue) 1)))
(W.slotRangeT (W.intervalFrom (collectionDeadline c)))

contribute :: MonadWallet m => Campaign -> Ada -> m ()
contribute cmp adaAmount = do
pk <- W.ownPubKey
let dataScript = mkDataScript pk
amount = $$(Ada.toValue) adaAmount

-- payToScript returns the transaction that was submitted
-- (unlike payToScript_ which returns unit)
tx <- W.payToScript W.defaultSlotRange (campaignAddress cmp) amount dataScript
W.logMsg "Submitted contribution"

-- L.hashTx gives the `TxId` of a transaction
let txId = L.hashTx tx

W.register (refundTrigger cmp) (refundHandler txId cmp)
W.logMsg "Registered refund trigger"

{-
We will define a collection trigger for each '(Slot, Ada)' entry in the
'fundingTargets' list. This trigger fires if the specified amount has been
contributed before the slot.
That means we collect the funds as soon as the validator script allows it.
-}
mkCollectTrigger :: Address -> Slot -> Ada -> EventTrigger
mkCollectTrigger addr sl target = W.andT
-- We use `W.intervalFrom` to create an open-ended interval that starts
-- at the funding target.
(W.fundsAtAddressT addr (W.intervalFrom ($$(Ada.toValue) target)))
-- With `W.intervalTo` we create an interval from now to the target slot 'sl'
(W.slotRangeT (W.intervalTo sl))

{-
Each '(Slot, Ada)' entry in 'fundingTargets' also gets its own handler. In
the handler we create a transaction that must be validated before the slot,
using 'W.interval'
-}
collectionHandler :: MonadWallet m => Campaign -> Slot -> EventHandler m
collectionHandler cmp targetSlot = EventHandler (\_ -> do
W.logMsg "Collecting funds"
sig <- W.ownSignature
currentSlot <- W.slot
let redeemerScript = mkRedeemer (Collect, sig)
range = W.interval currentSlot targetSlot
W.collectFromScript range (mkValidatorScript cmp) redeemerScript)

scheduleCollection :: MonadWallet m => Campaign -> m ()
scheduleCollection cmp =
let
addr = campaignAddress cmp
ts = fundingTargets cmp
regTarget (targetSlot, ada) = W.register (mkCollectTrigger addr targetSlot ada) (collectionHandler cmp targetSlot)
in
traverse_ regTarget ts
Oops, something went wrong.

0 comments on commit f42025f

Please sign in to comment.
You can’t perform that action at this time.