From 18d5f03c0f893e42e11748f4ff780c4786e93eb4 Mon Sep 17 00:00:00 2001
From: Michael Peyton Jones <michael.peyton-jones@iohk.io>
Date: Tue, 4 Jun 2019 23:41:18 +0100
Subject: [PATCH 1/8] plutus-tutorial: use callouts and admonitions

These can help where we are explaining several bits of a piece of code.
The alternative can require breaking it up painfully small, and
sometimes having to order things weirdly in order to get the text in a
logical order. Callouts don't have this problem.

Admonitions are nice for asides that would otherwise break up the flow
of the text.

I may have gone a bit overboard with both.
---
 plutus-tutorial/doc/01-plutus-tx.adoc         |  90 +++++----
 plutus-tutorial/doc/02-validator-scripts.adoc | 168 +++++++---------
 plutus-tutorial/doc/03-wallet-api.adoc        | 189 +++++++++---------
 plutus-tutorial/doc/index.adoc                |   1 +
 plutus-tutorial/doc/overview.adoc             |  18 +-
 5 files changed, 216 insertions(+), 250 deletions(-)

diff --git a/plutus-tutorial/doc/01-plutus-tx.adoc b/plutus-tutorial/doc/01-plutus-tx.adoc
index f1a6aafe0c4..886ef56d221 100644
--- a/plutus-tutorial/doc/01-plutus-tx.adoc
+++ b/plutus-tutorial/doc/01-plutus-tx.adoc
@@ -14,7 +14,7 @@ in a transaction, hence the "Tx").
 This means that Plutus Tx _is just Haskell_. Strictly, only a subset of
 Haskell is supported, but most simple Haskell should work, and the
 compiler will tell you if you use something that is unsupported. (See
-link:../../../plutus-tx/README.md#haskell-language-support[Haskell
+link:../../plutus-tx/README.md#haskell-language-support[Haskell
 language support] for more details on what is supported.)
 
 The key technique that the Plutus Platform uses is called _staged
@@ -35,20 +35,20 @@ share types and defintions between the two.
 {-# LANGUAGE ScopedTypeVariables #-}
 module Tutorial.PlutusTx where
 
--- Main Plutus Tx module
-import Language.PlutusTx
--- Additional support for lifting
-import Language.PlutusTx.Lift
--- Builtin functions
-import Language.PlutusTx.Builtins
+import Language.PlutusTx -- <1>
+import Language.PlutusTx.Lift -- <2>
+import Language.PlutusTx.Builtins -- <3>
 
--- Used for examples
 import Language.PlutusCore
 import Language.PlutusCore.Pretty
 import Language.PlutusCore.Quote
 import Language.PlutusCore.Evaluation.CkMachine
-import Data.Text.Prettyprint.Doc
+import Data.Text.Prettyprint.Doc -- <4>
 ----
+<1> Main Plutus Tx module.
+<2> Additional support for lifting.
+<3> Builtin functions.
+<4> Used for examples.
 
 Plutus Tx makes some use of Template Haskell. There are a few reasons
 for this: - Template Haskell allows us to do work at compile time, which
@@ -62,12 +62,12 @@ expression of type `a`, which lives in the `Q` type of quotes. You can
 splice a definition with this type into your program using the `$$`
 operator.
 
-(There is also an abbreviation `TExpQ a` for `Q (TExp a)`, which avoids
-some parentheses.)
+NOTE: There is also an abbreviation `TExpQ a` for `Q (TExp a)`, which avoids
+some parentheses.
 
 The key function we will use is the `compile` function. `compile` has
-type `Q (TExp a) -> Q (TExp (CompiledCode a))`. What does this mean? -
-`Q` and `TExp` we have already seen - `CompiledCode a` is a compiled
+type `TExpQ a -> TExpQ (CompiledCode a)`. What does this mean? -
+`TExpQ` we have already seen - `CompiledCode a` is a compiled
 Plutus Core program corresponding to a Haskell program of type `a`
 
 What this means is that `compile` lets you take a (quoted) Haskell
@@ -103,16 +103,16 @@ instructive to look at it to get a vague idea of what’s going on.
 )
 -}
 integerOne :: CompiledCode Integer
-integerOne = $$( -- The splice inserts the `Q (CompiledCode Integer)` into the program
-    -- compile turns the `Q Integer` into a `Q (CompiledCode Integer)`
-    compile
-        -- The quote has type `Q Integer`
-        [||
-          -- We always use unbounded integers in Plutus Core, so we have to pin
-          -- down this numeric literal to an `Integer` rather than an `Int`
-          (1 :: Integer)
-        ||])
+integerOne = $$(compile -- <3> <4>
+    [|| -- <2>
+        (1 :: Integer) -- <1>
+    ||])
 ----
+<1> We always use unbounded integers in Plutus Core, so we have to pin
+down this numeric literal to an `Integer` rather than an `Int`.
+<2> The quote has type `TExpQ Integer`.
+<3> `compile` turns the `TExpQ Integer` into a `TExpQ (CompiledCode Integer)`.
+<4> The splice inserts the `TExpQ (CompiledCode Integer)` into the program.
 
 We can see how the metaprogramming works here: the Haskell program `1`
 was turned into a `CompiledCode Integer` at compile time, which we
@@ -145,36 +145,33 @@ So far, so familiar: we compiled a lambda into a lambda (the "lam").
 == Functions and datatypes
 
 You can also use functions inside your expression. In practice, you may
-well want to define the entirety of your Plutus Tx program as a
+will usually want to define the entirety of your Plutus Tx program as a
 definition outside the quote, and then simply call it inside the quote.
 
 [source,haskell]
 ----
-{-# INLINABLE plusOne #-}
+{-# INLINABLE plusOne #-} -- <2>
 plusOne :: Integer -> Integer
-plusOne x = x `addInteger` 1
+plusOne x = x `addInteger` 1 -- <1>
 
-{-# INLINABLE myProgram #-}
+{-# INLINABLE myProgram #-} -- <2>
 myProgram :: Integer
 myProgram =
     let
         plusOneLocal :: Integer -> Integer
-        plusOneLocal x = x `addInteger` 1
+        plusOneLocal x = x `addInteger` 1 -- <1>
 
         localPlus = plusOneLocal 1
         externalPlus = plusOne 1
-    in localPlus `addInteger` externalPlus
+    in localPlus `addInteger` externalPlus -- <1>
 
 functions :: CompiledCode Integer
 functions = $$(compile [|| myProgram ||])
 ----
-
-Here we used the function `addInteger` from
-`Language.PlutusTx.Builtins`, which is mapped on the builtin integer
-addition in Plutus Core.
-
-The previous example marked the functions that we used using GHC’s
-`INLINABLE` pragma. This is usually necessary for non-local functions to
+<1> `addInteger` comes from `Language.PlutusTx.Builtins`, and is
+which is mapped to the builtin integer addition in Plutus Core.
+<2> Functions for reuse are marked with GHC’s `INLINABLE` pragma.
+This is usually necessary for non-local functions to
 be usable in Plutus Tx blocks, as it instructs GHC to keep the
 information that the Plutus Tx compiler needs. While this is not always
 necessary, it is a good idea to simply mark all such functions as
@@ -191,8 +188,9 @@ matchMaybe = $$(compile [|| \(x:: Maybe Integer) -> case x of
    ||])
 ----
 
-Unlike functions, datatypes do not need to be defined inside the
-expression, hence why we can use types like `Maybe` from the `Prelude`.
+Unlike functions, datatypes do not need any kind of special annotation to be
+used inside the
+expression, hence we can use types like `Maybe` from the `Prelude`.
 This works for your own datatypes too!
 
 Here’s a small example with a datatype of our own representing a
@@ -255,7 +253,8 @@ program that computes to `5`. Well, we need to _lift_ the argument (`4`)
 from Haskell to Plutus Core, and then we need to apply the function to
 it.
 
-....
+[source,haskell]
+----
 {- |
 >>> let program = addOneToN 4
 >>> pretty program
@@ -276,17 +275,22 @@ it.
 (con 8 ! 5)
 -}
 addOneToN :: Integer -> CompiledCode Integer
-addOneToN n = addOne `applyCode` unsafeLiftCode n
-....
+addOneToN n =
+    addOne
+    `applyCode` -- <1>
+    unsafeLiftCode n -- <2>
+----
+<1> `applyCode` applies one `CompiledCode` to another.
+<2> `unsafeLiftCode` lifts the argument `n` into a `CompiledCode Integer`.
 
-We lifted the argument `n` using the `unsafeLiftCode` function
-("unsafe" because we’re ignoring any errors that might occur from
-lifting something that we don’t support). In order to use this, a type
+We lifted the argument using the `unsafeLiftCode` function. In order to use this, a type
 must have an instance of the `Lift` class. In practice, you should
 generate these with the `makeLift` TH function from
 `Language.PlutusTx.Lift`. Lifting makes it easy to use the same types
 both inside your Plutus Tx program and in the external code that uses
 it.
+NOTE: `unsafeLiftCode` is "unsafe" because it ignores any errors that might occur from
+lifting something that isn't supported.
 
 The combined program applies the original compiled lambda to the lifted
 value (notice that the lambda is a bit complicated now since we have
diff --git a/plutus-tutorial/doc/02-validator-scripts.adoc b/plutus-tutorial/doc/02-validator-scripts.adoc
index eb133858738..905c3144225 100644
--- a/plutus-tutorial/doc/02-validator-scripts.adoc
+++ b/plutus-tutorial/doc/02-validator-scripts.adoc
@@ -25,63 +25,47 @@ We need some language extensions and imports:
 ----
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE TemplateHaskell     #-}
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE ScopedTypeVariables #-} -- <1>
+
+{-# LANGUAGE DeriveGeneric       #-} -- <2>
+
+{-# LANGUAGE OverloadedStrings   #-} -- <3>
+
+{-# LANGUAGE NoImplicitPrelude   #-} -- <4>
 module Tutorial.ValidatorScripts where
-----
 
-The language extensions fall into three categories. The first category
-is extensions required by the plugin that translates Haskell Core to
-Plutus IR (Intermediate Representation - a more abstract form of Plutus
-Core). This category includes
-https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/glasgow_exts.html#datatype-promotion[`DataKinds`],
-https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/glasgow_exts.html#template-haskell[`TemplateHaskell`],
-https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/glasgow_exts.html#lexically-scoped-type-variables[`ScopedTypeVariables`].
-
-The second category is extensions that contract endpoints to be
-automatically generated in the Plutus Playground, and it contains only
-the
-https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/glasgow_exts.html#deriving-representations[`DeriveGeneric`]
-extension.
-
-The final category is extensions that make the code look nicer. These
-include
-https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/glasgow_exts.html#overloaded-string-literals[`OverloadedStrings`]
-which allows us to write log messages as string literals without having
-to convert them to `Text` values first.
+import           Language.PlutusTx.Prelude -- <5>
 
-[source,haskell]
-----
-import           Language.PlutusTx.Prelude
+import qualified Language.PlutusTx            as PlutusTx -- <6>
 
-import qualified Language.PlutusTx            as PlutusTx
 import qualified Ledger.Interval              as I
 import           Ledger                       (Address, DataScript(..), PubKey(..), RedeemerScript(..),
                                                Signature(..), Slot(..), TxId, ValidatorScript(..))
-import qualified Ledger                       as L
+import qualified Ledger                       as L -- <7>
 import qualified Ledger.Ada                   as Ada
 import           Ledger.Ada                   (Ada)
 import           Ledger.Validation            (PendingTx(..), PendingTxIn(..), PendingTxOut)
-import qualified Ledger.Validation            as V
+import qualified Ledger.Validation            as V -- <8>
+
 import           Wallet                       (WalletAPI(..), WalletDiagnostics(..), MonadWallet,
                                                EventHandler(..), EventTrigger)
-import qualified Wallet                       as W
+import qualified Wallet                       as W -- <9>
+
 import           GHC.Generics                 (Generic)
 
 import qualified Data.ByteString.Lazy.Char8   as C
 ----
-
-The module
-{wallet-api-haddock}/Ledger-Validation.html[`Ledger.Validation`],
-imported as `V`, contains types and functions that can be used in
-on-chain code. `Language.PlutusTx` lets us translate code between
-Haskell and Plutus Core (see the xref:01-plutus-tx#plutus-tx[PlutusTx
-tutorial]).
-{wallet-api-haddock}/Ledger.html[`Ledger`]
-has data types for the ledger model and
-{wallet-api-haddock}/Wallet.html[`Wallet`]
+<1> Needed by the Plutus Tx compiler plugin.
+<2> Needed to allow contract endpoints to be automatically generated in the Plutus Playground.
+<3> Allows us to use string literals for log messages without having to convert them to `Text` first.
+<4> Allows us to use the Plutus Tx Prelude as a replacement for the Haskell Prelude.
+<5> The Plutus Tx Prelude.
+<6> `Language.PlutusTx` lets us translate code between
+Haskell and Plutus Core (see the xref:01-plutus-tx#plutus-tx[PlutusTx tutorial]).
+<7> {wallet-api-haddock}/Ledger.html[`Ledger`] has data types for the ledger model.
+<8> {wallet-api-haddock}/Ledger-Validation.html[`Ledger.Validation`] contains types and
+functions that can be used in on-chain code.
+<9> {wallet-api-haddock}/Wallet.html[`Wallet`]
 is the wallet API. It covers interactions with the wallet, for example
 generating the transactions that actually get the crowdfunding contract
 onto the blockchain.
@@ -98,47 +82,32 @@ Both the hashed secret and the cleartext guess are represented as
 `ByteString` values in on-chain code. `ByteString` represents the usual
 Haskell bytestrings in on-chain code.
 
-To avoid any confusion between cleartext and hash we wrap them in data
-types called `HashedText` and `ClearText`, respectively.
-
 [source,haskell]
 ----
 data HashedText = HashedText ByteString
-data ClearText = ClearText ByteString
-----
-
-One of the strengths of PlutusTx is the ability to use the same
-definitions for on-chain and off-chain code, which includes lifting
-values from Haskell to Plutus Core. To enable values of our string types
-to be lifted, we need to call `makeLift` from the `PlutusTx` module.
+data ClearText = ClearText ByteString -- <1>
 
-[source,haskell]
-----
 PlutusTx.makeLift ''HashedText
-PlutusTx.makeLift ''ClearText
-----
+PlutusTx.makeLift ''ClearText -- <2>
 
-`mkDataScript` creates a data script for the guessing game by hashing
-the string and lifting the hash to its on-chain representation.
-
-[source,haskell]
-----
 mkDataScript :: String -> DataScript
 mkDataScript word =
     let hashedWord = V.plcSHA2_256 (C.pack word)
-    in  DataScript (L.lifted (HashedText hashedWord))
-----
-
-`mkRedeemerScript` creates a redeemer script for the guessing game by
-lifting the string to its on-chain representation
+    in  DataScript (L.lifted (HashedText hashedWord)) -- <3>
 
-[source,haskell]
-----
 mkRedeemerScript :: String -> RedeemerScript
 mkRedeemerScript word =
     let clearWord = C.pack word
-    in RedeemerScript (L.lifted (ClearText clearWord))
+    in RedeemerScript (L.lifted (ClearText clearWord)) -- <4>
 ----
+<1> To avoid any confusion between cleartext and hash we wrap them in data
+types called `HashedText` and `ClearText`, respectively.
+<2> To enable values of our string types to be lifted to Plutus Core, we
+need to call `makeLift`.
+<3> `mkDataScript` creates a data script for the guessing game by hashing
+the string and lifting the hash to its on-chain representation.
+<4> `mkRedeemerScript` creates a redeemer script for the guessing game by
+lifting the string to its on-chain representation
 
 === The Validator Script
 
@@ -159,25 +128,29 @@ In our case, the data script is a `HashedText`, and the redeemer is a
 [source,haskell]
 ----
 -- | The validator script of the game.
-validator :: HashedText -> ClearText -> PendingTx -> Bool
-validator (HashedText actual) (ClearText guessed) _ =
+validator
+  :: HashedText -- <1>
+  -> ClearText -- <2>
+  -> PendingTx
+  -> Bool
 ----
+<1> The type of the data script is `HashedText`.
+<2> The type of the redeemer is `ClearText`.
 
 The actual game logic is very simple: We compare the hash of the
 `guessed` argument with the `actual` secret hash, and throw an error if
-the two don’t match. In on-chain code, we can use the `$$()` splicing
-operator to access functions from the Plutus prelude, imported as `P`.
-For example, `equalsByteString {2c} ByteString -> ByteString -> Bool`
-compares two `ByteString` values for equality.
+the two don’t match. We can use functions from the Plutus prelude, imported as `P`.
 
 [source,haskell]
 ----
-    if equalsByteString actual (sha2_256 guessed)
-    then (traceH "RIGHT!" True)
-    else (traceH "WRONG!" False)
+validator (HashedText actual) (ClearText guessed) _ =
+    if equalsByteString actual (sha2_256 guessed) -- <1>
+    then traceH "RIGHT!" True -- <2>
+    else traceH "WRONG!" False
 ----
-
-`traceH {2c} String -> a -> a` returns its second argument after adding
+<1> `equalsByteString {2c} ByteString -> ByteString -> Bool`
+compares two `ByteString` values for equality.
+<2> `traceH {2c} String -> a -> a` returns its second argument after adding
 its first argument to the log output of this script. The log output is
 only available in the emulator and on the playground, and will be
 ignored when the code is run on the real blockchain.
@@ -193,7 +166,7 @@ understand how Template Haskell works in detail.
 ----
 -- | The validator script of the game.
 gameValidator :: ValidatorScript
-gameValidator = ValidatorScript ($$(L.compileScript [|| validator ||]))
+gameValidator = ValidatorScript $$(L.compileScript [|| validator ||])
 ----
 
 === Contract endpoints
@@ -222,6 +195,11 @@ return a value of type `MonadWallet m => m ()`. This type indicates that
 the function uses the wallet API to produce and spend transaction
 outputs on the blockchain.
 
+Since `MonadWallet` is a sub-class of `Monad` we can use Haskell’s `do`
+notation, allowing us to list our instructions to the wallet in a
+sequence (see https://en.wikibooks.org/wiki/Haskell/do_notation[here]
+for more information).
+
 The first endpoint we need for our game is the function `lock`. It pays
 the specified amount of Ada to the script address. Paying to a script
 address is a common task at the beginning of a contract, and the wallet
@@ -233,11 +211,6 @@ is a variant of
 {wallet-api-haddock}/Wallet-API.html#v:payToScript[`payToScript`]
 which ignores its return value and produces a `()` instead.
 
-Since `MonadWallet` is a sub-class of `Monad` we can use Haskell’s `do`
-notation, allowing us to list our instructions to the wallet in a
-sequence (see https://en.wikibooks.org/wiki/Haskell/do_notation[here]
-for more information).
-
 [source,haskell]
 ----
 -- | The "lock" contract endpoint.
@@ -253,13 +226,12 @@ output using the guessed word as a redeemer.
 ----
 -- | The "guess" contract endpoint.
 guess :: MonadWallet m => String -> m ()
-guess word =
-    -- 'collectFromScript' is a function of the wallet API. It consumes the
-    -- unspent transaction outputs at a script address and pays them to a
-    -- public key address owned by this wallet. It takes the validator script
-    -- and the redeemer scripts as arguments.
-    W.collectFromScript W.defaultSlotRange gameValidator (mkRedeemerScript word)
+guess word = W.collectFromScript W.defaultSlotRange gameValidator (mkRedeemerScript word) -- <1>
 ----
+<1> `collectFromScript` is a function of the wallet API. It consumes the
+unspent transaction outputs at a script address and pays them to a
+public key address owned by this wallet. It takes the validator script
+and the redeemer scripts as arguments.
 
 If we run `guess` now, nothing will happen. Why? Because in order to
 spend all outputs at the script address, the wallet needs to be aware of
@@ -274,13 +246,13 @@ action:
 -- | The "startGame" contract endpoint, telling the wallet to start watching
 --   the address of the game script.
 startGame :: MonadWallet m => m ()
-startGame =
-    -- 'startWatching' is a function of the wallet API. It instructs the wallet
-    -- to keep track of all outputs at the address. Player 2 needs to call
-    -- 'startGame' before Player 1 uses the 'lock' endpoint, to ensure that
-    -- Player 2's wallet is aware of the game address.
-    W.startWatching gameAddress
+startGame = W.startWatching gameAddress -- <1>
 ----
+<1> `startWatching` is a function of the wallet API. It instructs the wallet
+to keep track of all outputs at the address.
+
+Player 2 needs to call `startGame` before Player 1 uses the `lock` endpoint,
+to ensure that Player 2's wallet is aware of the game address.
 
 Endpoints can have any number of parameters: `lock` has two parameters,
 `guess` has one and `startGame` has none. For each endpoint we include a
@@ -331,7 +303,7 @@ image:game-logs.PNG[Emulator log for a failed attempt]
 . Run traces for a successful game and a failed game in the Playground,
 and examine the logs after each trace.
 . Change the error case of the validator script to
-`(traceH "WRONG!" (error ()))` and run the trace again with a wrong
+`traceH "WRONG!" (error ())` and run the trace again with a wrong
 guess. Note how this time the log does not include the error message.
 . Look at the trace shown below. What will the logs say after running
 "Evaluate"?
diff --git a/plutus-tutorial/doc/03-wallet-api.adoc b/plutus-tutorial/doc/03-wallet-api.adoc
index c2a509c6fa9..a4fa5fa02c5 100644
--- a/plutus-tutorial/doc/03-wallet-api.adoc
+++ b/plutus-tutorial/doc/03-wallet-api.adoc
@@ -34,7 +34,6 @@ xref:02-validator-scripts#validator-scripts[before]:
 module Tutorial.WalletAPI where
 
 import           Language.PlutusTx.Prelude
-
 import qualified Language.PlutusTx            as PlutusTx
 import qualified Ledger.Interval              as I
 import qualified Ledger.Slot                  as S
@@ -73,27 +72,22 @@ In Haskell:
 [source,haskell]
 ----
 data Campaign = Campaign {
-      fundingTarget      :: Ada,
-      endDate            :: Slot,
-      collectionDeadline :: Slot,
-      campaignOwner      :: PubKey
+      fundingTarget      :: Ada, -- <1>
+      endDate            :: Slot, -- <2>
+      collectionDeadline :: Slot, -- <2>
+      campaignOwner      :: PubKey -- <3>
  }
-----
 
-The type of Ada values is
+PlutusTx.makeLift ''Campaign -- <4>
+----
+<1> The type of Ada values is
 {wallet-api-haddock}/Ledger-Ada.html#v:Ada[`Ada`].
-Dates are expressed in terms of slots, and their type is
+<2> Dates are expressed in terms of slots, and their type is
 {wallet-api-haddock}/Ledger-Slot.html#v:Slot[`Slot`].
-The campaign owner is identified by their public key.
-
-Just like we did in the xref:02-validator-scripts#validator-scripts[guessing game],
-we need to call `makeLift` for data types that we want to convert to
-Plutus at Haskell runtime:
-
-[source,haskell]
-----
-PlutusTx.makeLift ''Campaign
-----
+<3> The campaign owner is identified by their public key.
+<4> Just like we did in the xref:02-validator-scripts#validator-scripts[guessing game],
+we need to call `makeLift` for data types that we want to lift to
+Plutus Core.
 
 Now we need to figure out what the campaign will look like on the
 blockchain. Which transactions are involved, who submits them, and in
@@ -156,8 +150,14 @@ respectively, so the signature of the validator script is:
 
 [source,haskell]
 ----
-type CampaignValidator = Contributor -> CampaignAction -> PendingTx -> Bool
+type CampaignValidator =
+     Contributor -- <1>
+     -> CampaignAction -- <2>
+     -> PendingTx
+     -> Bool
 ----
+<1> The type of the data script is `Contributor`.
+<2> The type of the redeemer is `CampaignAction`.
 
 If we want to implement `CampaignValidator` we need to have access to
 the parameters of the campaign, so that we can check if the selected
@@ -166,22 +166,23 @@ function `mkValidator {2c} Campaign -> CampaignValidator` that takes a
 `Campaign` and produces a `CampaignValidator`.
 
 We then need to compile this into on-chain code using `L.compileScript`,
-which we do in `mkValidatorScript`. To apply the compiled `mkValidator`
-function to the `campaign {2c} Campaign` argument that is provided at
-runtime, we use `Ledger.lifted` to get the on-chain representation of
-`campaign`, and apply `mkValidator` to it with `Ledger.applyScript`:
+which we do in `mkValidatorScript`.
 
 [source,haskell]
 ----
 mkValidatorScript :: Campaign -> ValidatorScript
 mkValidatorScript campaign = ValidatorScript val where
-  val = $$(L.compileScript [|| mkValidator ||]) `L.applyScript` L.lifted campaign
+  val =
+      $$(L.compileScript [|| mkValidator ||])
+      `L.applyScript` -- <1>
+      L.lifted campaign -- <2>
 
 mkValidator :: Campaign -> CampaignValidator
-mkValidator campaign con act p =
 ----
+<1> `applyScript` applies one `Script` to another.
+<2> `Ledger.lifted campaign` gives us the on-chain representation of `campaign`.
 
-You may wonder why we use `L.applyScript` to supply the `Campaign`
+NOTE: You may wonder why we have to use `L.applyScript` to supply the `Campaign`
 argument. Why can we not write `$$(L.lifted campaign)` inside the
 validator script? The reason is that `campaign` is not known at the time
 the validator script is compiled. The names of `lifted` and `compile`
@@ -196,22 +197,29 @@ intermediate values that will make the checking code much more readable.
 These definitions are placed inside a `let` block, which is closed by a
 corresponding `in` below.
 
-First we pattern match on the structure of the
-{wallet-api-haddock}/Ledger-Validation.html#t:PendingTx[`PendingTx`]
-value `p` to get the Validation information we care about:
+In the declaration of the function we pattern match on the arguments
+to get the information we care about:
 
 [source,haskell]
 ----
-    let
-        PendingTx ins outs _ _ _ txnValidRange _  _ = p
-        -- p is bound to the pending transaction.
+mkValidator
+    (Campaign target deadline collectionDeadline campaignOwner) -- <3>
+    con
+    act
+    p@(PendingTx ins outs _ _ _ txnValidRange _ _) = -- <1> <2>
 ----
-
-This binds `ins` to the list of all inputs of the current transaction,
+<1> This binds `ins` to the list of all inputs of the current transaction,
 `outs` to the list of all its outputs, and `txnValidRange` to the
 validity interval of the pending transaction.
+<2> The underscores in the match stand for fields whose values are not
+we are not interested int. The fields are
+`pendingTxFee` (the fee of this transaction), `pendingTxForge` (how
+much, if any, value was forged) and `PendingTxIn` (the current
+{wallet-api-haddock}/Ledger-Validation.html#t:PendingTxIn[transaction
+input]) respectively.
+<3> This binds the parameters of the `Campaign`.
 
-In the extended UTXO model with scripts that underlies Plutus, each
+NOTE: In the extended UTXO model with scripts that underlies Plutus, each
 transaction has a validity range, an interval of slots during which it
 may be validated by core nodes. The validity interval is passed to
 validator scripts via the `PendingTx` argument, and it is the only
@@ -222,25 +230,10 @@ less than 20 (the interval is inclusive-exclusive). In terms of clock
 time we could say that the current time is between the beginning of slot
 10 and the end of slot 19.
 
-The three underscores in the match stand for fields whose values are not
-relevant for validating the crowdfunding transaction. The fields are
-`pendingTxFee` (the fee of this transaction), `pendingTxForge` (how
-much, if any, value was forged) and `PendingTxIn` (the current
-{wallet-api-haddock}/Ledger-Validation.html#t:PendingTxIn[transaction
-input]) respectively. You can click the link
-{wallet-api-haddock}/Ledger-Validation.html#t:PendingTx[`PendingTx`]
-to learn more about the data that is available.
-
-We also need the parameters of the campaign, which we can get by pattern
-matching on `campaign`.
-
-[source,haskell]
-----
-        Campaign target deadline collectionDeadline campaignOwner = campaign
-----
-
 Then we compute the total value of all transaction inputs, using `foldr`
-on the list of inputs `ins`. Note that there is a limit on the number of
+on the list of inputs `ins`.
+
+NOTE: There is a limit on the number of
 inputs a transaction may have, and thus on the number of contributions
 in this crowdfunding campaign. In this tutorial we ignore that limit,
 because it depends on the details of the implementation of Plutus on the
@@ -248,18 +241,18 @@ Cardano chain, and that implementation has not happened yet.
 
 [source,haskell]
 ----
+    let
         totalInputs :: Ada
         totalInputs =
-            -- define a function "addToTotal" that adds the ada
-            -- value of a 'PendingTxIn' to the total
-            let addToTotal (PendingTxIn _ _ vl) total =
+            let addToTotal (PendingTxIn _ _ vl) total = -- <1>
                   let adaVl = Ada.fromValue vl
                   in Ada.plus total adaVl
-
-            -- Apply "addToTotal" to each transaction input,
-            -- summing up the results
-            in foldr addToTotal Ada.zero ins
+            in foldr addToTotal Ada.zero ins -- <2>
 ----
+<1> Defines a function that adds the Ada
+value of a `PendingTxIn` to the total.
+<2> Applies `addToTotal` to each transaction input,
+summing up the results.
 
 We now have all the information we need to check whether the action
 `act` is allowed. This will be computed as
@@ -300,17 +293,16 @@ transaction:
 For the contribution to be refundable, three conditions must hold. The
 collection deadline must have passed, all outputs of this transaction
 must go to the contributor `con`, and the transaction was signed by the
-contributor. To check whether the collection deadline has passed, we use
-`S.before {2c} Slot -> SlotRange -> Bool`. `before` is exported by the
-`Ledger.Slot` module, alongside other useful functions for working with
-`SlotRange` values.
+contributor.
 
 [source,haskell]
 ----
-            in S.before collectionDeadline txnValidRange &&
+            in S.before collectionDeadline txnValidRange && -- <1>
                contributorOnly &&
                p `V.txSignedBy` pkCon
 ----
+<1> To check whether the collection deadline has passed, we use
+`before {2c} Slot -> SlotRange -> Bool`.
 
 The second branch represents a successful campaign.
 
@@ -321,19 +313,21 @@ The second branch represents a successful campaign.
 
 In the `Collect` case, the current slot must be between `deadline` and
 `collectionDeadline`, the target must have been met, and and transaction
-has to be signed by the campaign owner. We use
-`interval {2c} Slot -> Slot -> SlotRange` and
-`contains {2c} SlotRange -> SlotRange -> Bool` from the `Ledger.Slot`
-module to ensure that the spending transactions validity range,
-`txnValidRange`, is completely contained in the time between campaign
-deadline and collection deadline.
+has to be signed by the campaign owner.
 
 [source,haskell]
 ----
-            S.contains (I.interval deadline collectionDeadline) txnValidRange &&
+            S.contains (I.interval deadline collectionDeadline) txnValidRange && -- <1>
             Ada.geq totalInputs target &&
             p `V.txSignedBy` campaignOwner
 ----
+<1> We use
+`interval {2c} Slot -> Slot -> SlotRange` and
+`contains {2c} SlotRange -> SlotRange -> Bool`
+to ensure that the transaction's validity range,
+`txnValidRange`, is completely contained in the time between campaign
+deadline and collection deadline.
+
 
 === Contract Endpoints
 
@@ -410,23 +404,18 @@ target has been reached. The function `collectFundsTrigger` gives us the
 ----
 collectFundsTrigger :: Campaign -> EventTrigger
 collectFundsTrigger c = W.andT
-    -- We use `W.intervalFrom` to create an open-ended interval that starts
-    -- at the funding target.
-    (W.fundsAtAddressGeqT (campaignAddress c) (Ada.toValue (fundingTarget c)))
-
-    -- With `W.interval` we create an interval from the campaign's end date
-    -- (inclusive) to the collection deadline (exclusive)
-    (W.slotRangeT (W.interval (endDate c) (collectionDeadline c)))
+    (W.fundsAtAddressGeqT (campaignAddress c) (Ada.toValue (fundingTarget c))) -- <1>
+    (W.slotRangeT (W.interval (endDate c) (collectionDeadline c))) -- <2>
 ----
+<1> We use `W.intervalFrom` to create an open-ended interval that starts
+at the funding target.
+<2> With `W.interval` we create an interval from the campaign's end date
+(inclusive) to the collection deadline (exclusive).
 
 `fundsAtAddressGeqT` and `slotRangeT` take `Value` and `Interval Slot`
 arguments respectively. The
 {wallet-api-haddock}/Wallet-API.html#t:Interval[`Interval`]
-type is part of the `wallet-api` package. The
-{wallet-api-haddock}/Ledger-Interval.html#v:Interval[`Ledger.Interval`]
-module that originally defines it illustrates how to write a data type
-and associated operations that can be used both in off-chain and in
-on-chain code.
+type is part of the `wallet-api` package.
 
 The campaign owner can collect contributions when two conditions hold:
 The funds at the address must have reached the target, and the current
@@ -438,7 +427,7 @@ Now we can define an event handler that collects the contributions:
 [source,haskell]
 ----
 collectionHandler :: MonadWallet m => Campaign -> EventHandler m
-collectionHandler cmp = EventHandler (\_ -> do
+collectionHandler cmp = EventHandler $ \_ -> do
 ----
 
 `EventHandler` is a function of one argument, which we ignore in this
@@ -454,19 +443,19 @@ conditions hold when the event handler is run, so we can call
 {wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`]
 immediately.
 
-To collect the funds we use
-{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`],
-which expects a validator script and a redeemer script.
 
 [source,haskell]
 ----
     W.logMsg "Collecting funds"
     let redeemerScript = mkRedeemer Collect
         range          = W.interval (endDate cmp) (collectionDeadline cmp)
-    W.collectFromScript range (mkValidatorScript cmp) redeemerScript)
+    W.collectFromScript range (mkValidatorScript cmp) redeemerScript -- <1>
 ----
+<1> To collect the funds we use
+{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`],
+which expects a validator script and a redeemer script.
 
-Note that the trigger mechanism is a feature of the wallet, not of the
+NOTE: The trigger mechanism is a feature of the wallet, not of the
 blockchain. That means that the wallet needs to be running when the
 condition becomes true, so that it can react to it and submit
 transactions. Anything that happens in an
@@ -530,15 +519,15 @@ do with
 [source,haskell]
 ----
 refundHandler :: MonadWallet m => TxId -> Campaign -> EventHandler m
-refundHandler txid cmp = EventHandler (\_ -> do
+refundHandler txid cmp = EventHandler $ \_ -> do
     W.logMsg "Claiming refund"
     let redeemer  = mkRedeemer Refund
         range     = W.intervalFrom (collectionDeadline cmp)
-    W.collectFromScriptTxn range (mkValidatorScript cmp) redeemer txid)
+    W.collectFromScriptTxn range (mkValidatorScript cmp) redeemer txid
 ----
 
 Now we can register the refund handler when we make the contribution.
-The condition for being able to claim a refund is
+The condition for being able to claim a refund is:
 
 [source,haskell]
 ----
@@ -560,17 +549,17 @@ contribute cmp adaAmount = do
     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
+    tx <- W.payToScript W.defaultSlotRange (campaignAddress cmp) amount dataScript -- <1>
     W.logMsg "Submitted contribution"
 
-    -- L.hashTx gives the `TxId` of a transaction
-    let txId = L.hashTx tx
+    let txId = L.hashTx tx -- <2>
 
     W.register (refundTrigger cmp) (refundHandler txId cmp)
     W.logMsg "Registered refund trigger"
 ----
+<1> `payToScript` returns the transaction that was submitted
+(unlike `payToScript_` which returns unit).
+<2> `L.hashTx` gives the `TxId` of a transaction.
 
 [#testing-contract-03]
 == Testing the Contract
@@ -597,12 +586,12 @@ for the endpoints to the end of the script:
 $(mkFunctions ['scheduleCollection, 'contribute])
 ....
 
-(We can’t use the usual Haskell syntax highlighting for this line
+NOTE: We can’t use the usual Haskell syntax highlighting for this line
 because the entire script is compiled and executed as part of the test
 suite for the `wallet-api` project. The Playground-specific
 {haddock}/plutus-playground-lib-0.1.0.0/html/Playground-Contract.html#v:mkFunctions[`mkFunctions`]
 is defined in a different library (`plutus-playground-lib`) and it is
-not available for this tutorial.)
+not available for this tutorial.
 
 Alternatively, you can click the "Crowdfunding" button in the
 Playground to load the sample contract including the `mkFunctions` line.
diff --git a/plutus-tutorial/doc/index.adoc b/plutus-tutorial/doc/index.adoc
index e60e0ed4db7..67798318656 100644
--- a/plutus-tutorial/doc/index.adoc
+++ b/plutus-tutorial/doc/index.adoc
@@ -3,6 +3,7 @@
 :numbered:
 :source-highlighter: pygments
 :imagesdir: images
+:icons: font
 
 // unfortunately, asciidoctor likes to parse these as definition lists :(
 // https://github.com/asciidoctor/asciidoctor/issues/1066
diff --git a/plutus-tutorial/doc/overview.adoc b/plutus-tutorial/doc/overview.adoc
index c6483c0831d..3d6fa36f2b1 100644
--- a/plutus-tutorial/doc/overview.adoc
+++ b/plutus-tutorial/doc/overview.adoc
@@ -4,18 +4,18 @@ This document is a series of tutorials that explain various
 aspects of the Plutus smart contract platform.
 
 [arabic]
-. xref:intro#intro[Introduction to Plutus] introduces smart
+. xref:intro#intro[] introduces smart
 contracts and related terms
-. xref:01-plutus-tx#plutus-tx[Plutus Tx] explains the basics of using
+. xref:01-plutus-tx#plutus-tx[] explains the basics of using
 the Plutus Tx compiler to create embedded (on-chain) programs
-. xref:02-validator-scripts#validator-scripts[A guessing game] implements a
+. xref:02-validator-scripts#validator-scripts[] implements a
 guessing game. Topics covered:
     * Signature of validator script
     * `Ledger.makeLift`, `Ledger.compileScript`
     * Contract endpoints
     * `Wallet.payToScript_`, `Wallet.collectFromScript`
     * Playground
-. xref:03-wallet-api#wallet-api[A crowdfunding campaign] implements a
+. xref:03-wallet-api#wallet-api[] implements a
 crowdfunding campaign. Topics covered:
     * Parameterising a contract through partial application using
     `Ledger.applyScript`
@@ -35,7 +35,7 @@ a vesting scheme. Topics covered:
 Note that (5) and (6) are written as regular Haskell modules and include
 exercises (marked by `error`). They are intended to be edited
 interactively with the help of GHCi. See
-link:../tutorial/Tutorial/Emulator.hs[4.1] for details. Solutions for the
+link:../tutorial/Tutorial/Emulator.hs[the first such tutorial] for details. Solutions for the
 exercises are located in `Solutions0.hs`.
 
 Additional documentation will be added for the following
@@ -47,8 +47,8 @@ work-in-progress features, when they are available on the mockchain:
 
 == Prerequisites
 
-To follow the xref:02-validator-scripts#validator-scripts[Wallet API, Part I]
-and xref:03-wallet-api#wallet-api[Wallet API, Part II] tutorials you
+To follow the xref:02-validator-scripts#validator-scripts[]
+and xref:03-wallet-api#wallet-api[] tutorials you
 should have access to a recent version of the Plutus Playground.
 
 To follow the link:../tutorial/Tutorial/Emulator.hs[mockchain tutorial], you should
@@ -70,8 +70,8 @@ To install the emulator (not the Playground) locally, follow these steps.
 . Install the nix package manager following the instructions on
 https://nixos.org/nix/.
 +
-IMPORTANT: Add the IOHK binary cache to your Nix configuration. See
-link:../README.md#binary-caches[here] for details.
+IMPORTANT: Make sure to add the IOHK binary cache to your Nix configuration. See
+link:../README.md#binary-caches[the repository README] for details.
 . Move to the plutus-tutorial folder.
 . Type `nix-shell`. This will download all of the dependencies and
 populate the PATH with a correctly configured cabal. If `nix-shell`

From 3cc7f04e47f331858b5e7699007bb79603d2e7d8 Mon Sep 17 00:00:00 2001
From: Michael Peyton Jones <michael.peyton-jones@iohk.io>
Date: Wed, 5 Jun 2019 11:48:04 +0100
Subject: [PATCH 2/8] plutus-tutorial: Use link macros everywhere

This is more robust to the prefix not starting with a common scheme,
e.g. if it's a relative path.
---
 plutus-tutorial/doc/02-validator-scripts.adoc | 18 +++---
 plutus-tutorial/doc/03-wallet-api.adoc        | 58 +++++++++----------
 2 files changed, 38 insertions(+), 38 deletions(-)

diff --git a/plutus-tutorial/doc/02-validator-scripts.adoc b/plutus-tutorial/doc/02-validator-scripts.adoc
index 905c3144225..f206d55b184 100644
--- a/plutus-tutorial/doc/02-validator-scripts.adoc
+++ b/plutus-tutorial/doc/02-validator-scripts.adoc
@@ -6,7 +6,7 @@ This tutorial explains how to get Plutus onto the blockchain, using a
 simple guessing game as an example.
 
 You can run this code in the
-{playground}[Plutus Playground] - see <<testing-contract-02>>.
+link:{playground}[Plutus Playground] - see <<testing-contract-02>>.
 
 WARNING: The wallet API and by extension the wallet API tutorial is a
 work in progress and may be changed without notice.
@@ -62,10 +62,10 @@ import qualified Data.ByteString.Lazy.Char8   as C
 <5> The Plutus Tx Prelude.
 <6> `Language.PlutusTx` lets us translate code between
 Haskell and Plutus Core (see the xref:01-plutus-tx#plutus-tx[PlutusTx tutorial]).
-<7> {wallet-api-haddock}/Ledger.html[`Ledger`] has data types for the ledger model.
-<8> {wallet-api-haddock}/Ledger-Validation.html[`Ledger.Validation`] contains types and
+<7> link:{wallet-api-haddock}/Ledger.html[`Ledger`] has data types for the ledger model.
+<8> link:{wallet-api-haddock}/Ledger-Validation.html[`Ledger.Validation`] contains types and
 functions that can be used in on-chain code.
-<9> {wallet-api-haddock}/Wallet.html[`Wallet`]
+<9> link:{wallet-api-haddock}/Wallet.html[`Wallet`]
 is the wallet API. It covers interactions with the wallet, for example
 generating the transactions that actually get the crowdfunding contract
 onto the blockchain.
@@ -117,7 +117,7 @@ script is a function of three arguments that produces a value of type
 `Bool` indicating whether the validation was a success (or fails with an
 error). As contract authors we can freely choose the types of
 `DataScript`, `Redeemer`. The third argument has to be of type
-{wallet-api-haddock}/Ledger-Validation.html#t:PendingTx[`PendingTx`]
+link:{wallet-api-haddock}/Ledger-Validation.html#t:PendingTx[`PendingTx`]
 because that is the information about the current transaction, provided
 by the slot leader.
 
@@ -204,11 +204,11 @@ The first endpoint we need for our game is the function `lock`. It pays
 the specified amount of Ada to the script address. Paying to a script
 address is a common task at the beginning of a contract, and the wallet
 API implements it in
-{wallet-api-haddock}/Wallet-API.html#v:payToScript_[`payToScript_`].
+link:{wallet-api-haddock}/Wallet-API.html#v:payToScript_[`payToScript_`].
 The underscore is a Haskell naming convention, indicating that
-{wallet-api-haddock}/Wallet-API.html#v:payToScript_[`payToScript_`]
+link:{wallet-api-haddock}/Wallet-API.html#v:payToScript_[`payToScript_`]
 is a variant of
-{wallet-api-haddock}/Wallet-API.html#v:payToScript[`payToScript`]
+link:{wallet-api-haddock}/Wallet-API.html#v:payToScript[`payToScript`]
 which ignores its return value and produces a `()` instead.
 
 [source,haskell]
@@ -267,7 +267,7 @@ where the parameters can be entered.
 == Testing the contract in the Playground
 
 To test this contract, open the
-{playground}[Plutus Playground] and click
+link:{playground}[Plutus Playground] and click
 the "Game" button above the editor field. Then click "Compile".
 
 You can now create a trace using the endpoints `lock`, `guess` and
diff --git a/plutus-tutorial/doc/03-wallet-api.adoc b/plutus-tutorial/doc/03-wallet-api.adoc
index a4fa5fa02c5..be228cc783e 100644
--- a/plutus-tutorial/doc/03-wallet-api.adoc
+++ b/plutus-tutorial/doc/03-wallet-api.adoc
@@ -7,7 +7,7 @@ contract, using the wallet API to submit it to the blockchain. It is the
 third in a series of tutorials on Plutus smart contracts.
 
 You can run this code in the
-{playground}[Plutus Playground] - see <<testing-contract-03>>.
+link:{playground}[Plutus Playground] - see <<testing-contract-03>>.
 
 WARNING: The wallet API and by extension the wallet API tutorial is a
 work in progress and may be changed without much warning.
@@ -81,9 +81,9 @@ data Campaign = Campaign {
 PlutusTx.makeLift ''Campaign -- <4>
 ----
 <1> The type of Ada values is
-{wallet-api-haddock}/Ledger-Ada.html#v:Ada[`Ada`].
+link:{wallet-api-haddock}/Ledger-Ada.html#v:Ada[`Ada`].
 <2> Dates are expressed in terms of slots, and their type is
-{wallet-api-haddock}/Ledger-Slot.html#v:Slot[`Slot`].
+link:{wallet-api-haddock}/Ledger-Slot.html#v:Slot[`Slot`].
 <3> The campaign owner is identified by their public key.
 <4> Just like we did in the xref:02-validator-scripts#validator-scripts[guessing game],
 we need to call `makeLift` for data types that we want to lift to
@@ -215,7 +215,7 @@ validity interval of the pending transaction.
 we are not interested int. The fields are
 `pendingTxFee` (the fee of this transaction), `pendingTxForge` (how
 much, if any, value was forged) and `PendingTxIn` (the current
-{wallet-api-haddock}/Ledger-Validation.html#t:PendingTxIn[transaction
+link:{wallet-api-haddock}/Ledger-Validation.html#t:PendingTxIn[transaction
 input]) respectively.
 <3> This binds the parameters of the `Campaign`.
 
@@ -345,25 +345,25 @@ Both tasks can be implemented using _blockchain triggers_.
 ==== Blockchain Triggers
 
 The wallet API allows us to specify a pair of
-{wallet-api-haddock}/Wallet-API.html#t:EventTrigger[`EventTrigger`]
+link:{wallet-api-haddock}/Wallet-API.html#t:EventTrigger[`EventTrigger`]
 and
-{wallet-api-haddock}/Wallet-API.html#v:EventHandler[`EventHandler`]
+link:{wallet-api-haddock}/Wallet-API.html#v:EventHandler[`EventHandler`]
 to automatically run `collect`. An event trigger describes a condition
 of the blockchain and can be true or false. There are four basic
 triggers:
-{wallet-api-haddock}/Wallet-API.html#v:slotRangeT[`slotRangeT`]
+link:{wallet-api-haddock}/Wallet-API.html#v:slotRangeT[`slotRangeT`]
 is true when the slot number is in a specific range,
-{wallet-api-haddock}/Wallet-API.html#v:fundsAtAddressGeqT[`fundsAtAddressGeqT`]
+link:{wallet-api-haddock}/Wallet-API.html#v:fundsAtAddressGeqT[`fundsAtAddressGeqT`]
 is true when the total value of unspent outputs at an address is within
 a range,
-{wallet-api-haddock}/Wallet-API.html#v:alwaysT[`alwaysT`]
+link:{wallet-api-haddock}/Wallet-API.html#v:alwaysT[`alwaysT`]
 is always true and
-{wallet-api-haddock}/Wallet-API.html#v:neverT[`neverT`]
+link:{wallet-api-haddock}/Wallet-API.html#v:neverT[`neverT`]
 is never true. We also have boolean connectives
-{wallet-api-haddock}/Wallet-API.html#v:andT[`andT`],
-{wallet-api-haddock}/Wallet-API.html#v:orT[`orT`]
+link:{wallet-api-haddock}/Wallet-API.html#v:andT[`andT`],
+link:{wallet-api-haddock}/Wallet-API.html#v:orT[`orT`]
 and
-{wallet-api-haddock}/Wallet-API.html#v:notT[`notT`]
+link:{wallet-api-haddock}/Wallet-API.html#v:notT[`notT`]
 to describe more complex conditions.
 
 We will need to know the address of a campaign, which amounts to hashing
@@ -384,7 +384,7 @@ mkDataScript pk = DataScript (L.lifted (Contributor pk))
 ----
 
 When we want to spend the contributions we need to provide a
-{wallet-api-haddock}/Ledger-Scripts.html#v:RedeemerScript[`RedeemerScript`]
+link:{wallet-api-haddock}/Ledger-Scripts.html#v:RedeemerScript[`RedeemerScript`]
 value. In our case this is just the `CampaignAction`:
 
 [source,haskell]
@@ -414,7 +414,7 @@ at the funding target.
 
 `fundsAtAddressGeqT` and `slotRangeT` take `Value` and `Interval Slot`
 arguments respectively. The
-{wallet-api-haddock}/Wallet-API.html#t:Interval[`Interval`]
+link:{wallet-api-haddock}/Wallet-API.html#t:Interval[`Interval`]
 type is part of the `wallet-api` package.
 
 The campaign owner can collect contributions when two conditions hold:
@@ -433,14 +433,14 @@ collectionHandler cmp = EventHandler $ \_ -> do
 `EventHandler` is a function of one argument, which we ignore in this
 case (the argument tells us which of the conditions in the trigger are
 true, which can be useful if we used
-{wallet-api-haddock}/Wallet-API.html#v:orT[`orT`]
+link:{wallet-api-haddock}/Wallet-API.html#v:orT[`orT`]
 to build a complex condition). In our case we don’t need this
 information because we know that both the
-{wallet-api-haddock}/Wallet-API.html#v:fundsAtAddressGeqT[`fundsAtAddressGeqT`]
+link:{wallet-api-haddock}/Wallet-API.html#v:fundsAtAddressGeqT[`fundsAtAddressGeqT`]
 and the
-{wallet-api-haddock}/Wallet-API.html#v:slotRangeT[`slotRangeT`]
+link:{wallet-api-haddock}/Wallet-API.html#v:slotRangeT[`slotRangeT`]
 conditions hold when the event handler is run, so we can call
-{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`]
+link:{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`]
 immediately.
 
 
@@ -452,14 +452,14 @@ immediately.
     W.collectFromScript range (mkValidatorScript cmp) redeemerScript -- <1>
 ----
 <1> To collect the funds we use
-{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`],
+link:{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`],
 which expects a validator script and a redeemer script.
 
 NOTE: The trigger mechanism is a feature of the wallet, not of the
 blockchain. That means that the wallet needs to be running when the
 condition becomes true, so that it can react to it and submit
 transactions. Anything that happens in an
-{wallet-api-haddock}/Wallet-API.html#t:EventHandler[`EventHandler`]
+link:{wallet-api-haddock}/Wallet-API.html#t:EventHandler[`EventHandler`]
 is a normal interaction with the blockchain facilitated by the wallet.
 
 With that, we can write the `scheduleCollection` endpoint to register a
@@ -491,12 +491,12 @@ refund.
 To contribute to a campaign we need to pay the desired amount to a
 script address, and provide our own public key as the data script. In
 the link:./02-validator-scripts.md[guessing game] we used
-{wallet-api-haddock}/Wallet-API.html#v:payToScript_[`payToScript_`],
+link:{wallet-api-haddock}/Wallet-API.html#v:payToScript_[`payToScript_`],
 which returns `()` instead of the transaction that was submitted. For
 the crowdfunding contribution we need to hold on the transaction. Why?
 
 Think back to the `guess` action of the game. We used
-{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`]
+link:{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`]
 to collect _all_ outputs at the game address. This works only if all all
 outputs are unlocked by the same redeemer (see also exercise 3 of the
 previous tutorial).
@@ -507,14 +507,14 @@ us to unlock our own contribution. But if we try to use the same
 redeemer to unlock other contributions the script will fail,
 invalidating the entire transaction. We therefore need a way to restrict
 the outputs that
-{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`]
+link:{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`]
 spends. To achieve this, the wallet API provides
-{wallet-api-haddock}/Wallet-API.html#v:collectFromScriptTxn[`collectFromScriptTxn`],
+link:{wallet-api-haddock}/Wallet-API.html#v:collectFromScriptTxn[`collectFromScriptTxn`],
 which takes an additional `TxId` parameter and only collects outputs
 produced by that transaction. To get the `TxId` parameter we need to
 hold on to the transaction that commits our contribution, which we can
 do with
-{wallet-api-haddock}/Wallet-API.html#v:payToScript[`payToScript`].
+link:{wallet-api-haddock}/Wallet-API.html#v:payToScript[`payToScript`].
 
 [source,haskell]
 ----
@@ -566,7 +566,7 @@ contribute cmp adaAmount = do
 
 There are two ways to test a Plutus contract. We can run it
 interactively in the
-{playground}[Playground], or test it like
+link:{playground}[Playground], or test it like
 any other program by writing some unit and property tests. Both methods
 give the same results because they do the same thing behind the scenes:
 Generate some transactions and evaluate them on the mockchain. The
@@ -579,7 +579,7 @@ it.
 
 We need to tell the Playground what our contract endpoints are, so that
 it can generate a UI for them. This is done by adding a call to
-{haddock}/plutus-playground-lib-0.1.0.0/html/Playground-Contract.html#v:mkFunctions[`mkFunctions`]
+link:{haddock}/plutus-playground-lib-0.1.0.0/html/Playground-Contract.html#v:mkFunctions[`mkFunctions`]
 for the endpoints to the end of the script:
 
 ....
@@ -589,7 +589,7 @@ $(mkFunctions ['scheduleCollection, 'contribute])
 NOTE: We can’t use the usual Haskell syntax highlighting for this line
 because the entire script is compiled and executed as part of the test
 suite for the `wallet-api` project. The Playground-specific
-{haddock}/plutus-playground-lib-0.1.0.0/html/Playground-Contract.html#v:mkFunctions[`mkFunctions`]
+link:{haddock}/plutus-playground-lib-0.1.0.0/html/Playground-Contract.html#v:mkFunctions[`mkFunctions`]
 is defined in a different library (`plutus-playground-lib`) and it is
 not available for this tutorial.
 

From fff6bd10348a913ab68122b672c8fe8ed4cc9a52 Mon Sep 17 00:00:00 2001
From: Michael Peyton Jones <michael.peyton-jones@iohk.io>
Date: Wed, 5 Jun 2019 11:49:34 +0100
Subject: [PATCH 3/8] plutus-tutorial: fix wallet-api haddock links

The package has been renamed.
---
 plutus-tutorial/doc/index.adoc | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/plutus-tutorial/doc/index.adoc b/plutus-tutorial/doc/index.adoc
index 67798318656..b7101a2e70b 100644
--- a/plutus-tutorial/doc/index.adoc
+++ b/plutus-tutorial/doc/index.adoc
@@ -10,7 +10,7 @@
 :2c: ::
 :playground: https://prod.playground.plutus.iohkdev.io/
 :haddock: https://input-output-hk.github.io/plutus/
-:wallet-api-haddock: https://input-output-hk.github.io/plutus/wallet-api-0.1.0.0/html
+:wallet-api-haddock: {haddock}/plutus-wallet-api-0.1.0.0/html
 
 include::overview.adoc[leveloffset=+ 1]
 include::intro.adoc[leveloffset=+ 1]

From 0d3606da73f6610cec45acea358c3115b668dd85 Mon Sep 17 00:00:00 2001
From: Michael Peyton Jones <michael.peyton-jones@iohk.io>
Date: Wed, 5 Jun 2019 12:34:21 +0100
Subject: [PATCH 4/8] plutus-tutorial: add vesting tutorial

Moved from the Haskell examples.
---
 plutus-tutorial/doc/02-validator-scripts.adoc |   8 +-
 plutus-tutorial/doc/03-wallet-api.adoc        |  14 +-
 plutus-tutorial/doc/04-vesting.adoc           | 269 ++++++++++++++++++
 plutus-tutorial/doc/index.adoc                |   1 +
 plutus-tutorial/doc/overview.adoc             |  32 +--
 plutus-tutorial/doctest/Tutorial/Vesting.lhs  |   1 +
 plutus-tutorial/plutus-tutorial.cabal         |   1 +
 7 files changed, 290 insertions(+), 36 deletions(-)
 create mode 100644 plutus-tutorial/doc/04-vesting.adoc
 create mode 120000 plutus-tutorial/doctest/Tutorial/Vesting.lhs

diff --git a/plutus-tutorial/doc/02-validator-scripts.adoc b/plutus-tutorial/doc/02-validator-scripts.adoc
index f206d55b184..83eac46a03a 100644
--- a/plutus-tutorial/doc/02-validator-scripts.adoc
+++ b/plutus-tutorial/doc/02-validator-scripts.adoc
@@ -17,7 +17,7 @@ endpoints that handle the interactions between wallet and blockchain. In
 part 2 we show how to test the contract. Part 3 contains a number of
 questions and exercises.
 
-== Contract Definition
+== Contract definition
 
 We need some language extensions and imports:
 
@@ -70,7 +70,7 @@ is the wallet API. It covers interactions with the wallet, for example
 generating the transactions that actually get the crowdfunding contract
 onto the blockchain.
 
-=== Data Types
+=== Datatypes
 
 The guessing game involves two moves: First, player A chooses a secret
 word, and uses the game validator script to lock some Ada (the prize),
@@ -109,7 +109,7 @@ the string and lifting the hash to its on-chain representation.
 <4> `mkRedeemerScript` creates a redeemer script for the guessing game by
 lifting the string to its on-chain representation
 
-=== The Validator Script
+=== The validator script
 
 The general form of a validator script is
 `DataScript -> Redeemer -> PendingTx -> Bool`. That is, the validator
@@ -297,7 +297,7 @@ If you change the word "plutus" in the third item of the trace to
 
 image:game-logs.PNG[Emulator log for a failed attempt]
 
-== Problems / Questions
+== Exercises
 
 [arabic]
 . Run traces for a successful game and a failed game in the Playground,
diff --git a/plutus-tutorial/doc/03-wallet-api.adoc b/plutus-tutorial/doc/03-wallet-api.adoc
index be228cc783e..420b43c0281 100644
--- a/plutus-tutorial/doc/03-wallet-api.adoc
+++ b/plutus-tutorial/doc/03-wallet-api.adoc
@@ -18,7 +18,7 @@ that handle the interactions between wallet and blockchain. In part 2 we
 show how to test the contract. Part 3 contains a number of questions and
 exercises related to this contract.
 
-== Contract Definition
+== Contract definition
 
 We need the same language extensions and imports as
 xref:02-validator-scripts#validator-scripts[before]:
@@ -53,7 +53,7 @@ import qualified Wallet                       as W
 import           GHC.Generics                 (Generic)
 ----
 
-=== Data Types
+=== Datatypes
 
 The crowdfunding campaign has the following parameters:
 
@@ -141,7 +141,7 @@ was part of the validator script, then each contribution would go to a
 unique address, and the campaign owner would have to be informed of all
 the addresses through some other mechanism.
 
-=== The Validator Script
+=== The validator script
 
 The general form of a validator script is
 `DataScript -> RedeemerScript -> PendingTx -> Bool`. The types of data
@@ -329,7 +329,7 @@ to ensure that the transaction's validity range,
 deadline and collection deadline.
 
 
-=== Contract Endpoints
+=== Contract endpoints
 
 Now that we have the validator script, we need to set up contract
 endpoints for contributors and the campaign owner. The endpoints for the
@@ -342,7 +342,7 @@ deadline has passed.
 
 Both tasks can be implemented using _blockchain triggers_.
 
-==== Blockchain Triggers
+==== Blockchain triggers
 
 The wallet API allows us to specify a pair of
 link:{wallet-api-haddock}/Wallet-API.html#t:EventTrigger[`EventTrigger`]
@@ -562,7 +562,7 @@ contribute cmp adaAmount = do
 <2> `L.hashTx` gives the `TxId` of a transaction.
 
 [#testing-contract-03]
-== Testing the Contract
+== Testing the contract
 
 There are two ways to test a Plutus contract. We can run it
 interactively in the
@@ -638,7 +638,7 @@ You can run the test suite with
 `nix build -f default.nix localPackages.plutus-use-cases` or
 `cabal test plutus-use-cases`.
 
-== Problems / Questions
+== Exercises
 
 [arabic]
 . Run traces for successful and failed campaigns
diff --git a/plutus-tutorial/doc/04-vesting.adoc b/plutus-tutorial/doc/04-vesting.adoc
new file mode 100644
index 00000000000..5e559084cbd
--- /dev/null
+++ b/plutus-tutorial/doc/04-vesting.adoc
@@ -0,0 +1,269 @@
+[#multi-stage]
+= Multi-stage contracts
+
+In this part of the tutorial we will implement a simple vesting scheme,
+where money is locked by a contract and may only be retrieved after some
+time has passed.
+
+This is our first example of a contract that covers multiple transactions,
+with a contract state that changes over time.
+
+== Contract definition
+
+We need similar language extensions and imports to
+xref:02-validator-scripts#validator-scripts[before]:
+
+[source,haskell]
+----
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE NoImplicitPrelude   #-}
+module Tutorial.Vesting where
+
+import           Language.PlutusTx.Prelude
+
+import qualified Language.PlutusTx         as PlutusTx
+
+import           Ledger                    (Address, DataScript(..), RedeemerScript(..), Slot, TxOutRef, TxIn, ValidatorScript(..))
+import qualified Ledger                    as L
+import           Ledger.Ada                (Ada)
+import qualified Ledger.Ada                as Ada
+import qualified Ledger.Ada                as ATH
+import qualified Ledger.Interval           as Interval
+import qualified Ledger.Slot               as Slot
+import           Ledger.Validation         (PendingTx(..))
+import qualified Ledger.Validation         as V
+import           Ledger.Value              (Value)
+import qualified Ledger.Value              as Value
+
+import           Wallet                    (MonadWallet(..), PubKey)
+import qualified Wallet                    as W
+import qualified Wallet.API                as WAPI
+import qualified Wallet.Emulator.Types     as EM
+
+import qualified Data.Map                  as Map
+import qualified Data.Set                  as Set -- <1>
+
+import           GHC.Generics              (Generic)
+----
+<1> We need a few more standard Haskell data structures for this tutorial.
+
+In our vesting scheme the money will be released in two _tranches_ (parts):
+A smaller part will be available after an initial number of slots have
+passed, and the entire amount will be released at the end. The owner of the
+vesting scheme does not have to take out all the money at once: They can take out
+any amount up to the total that has been released so far. The remaining
+funds stay locked and can be retrieved later.
+
+=== Datatypes
+
+Let's start with the data types.
+
+[source,haskell]
+----
+-- | Tranche of a vesting scheme.
+data VestingTranche = VestingTranche {
+    vestingTrancheDate   :: Slot,
+    -- ^ When this tranche is released
+    vestingTrancheAmount :: Value
+    -- ^ How much money is locked in this tranche
+    } deriving (Generic)
+
+PlutusTx.makeLift ''VestingTranche
+
+-- | A vesting scheme consisting of two tranches. Each tranche defines a date
+--   (slot) after which an additional amount of money can be spent.
+data Vesting = Vesting {
+    vestingTranche1 :: VestingTranche,
+    -- ^ First tranche
+    vestingTranche2 :: VestingTranche,
+    -- ^ Second tranche
+    vestingOwner    :: PubKey
+    -- ^ The recipient of the scheme (who is authorised to take out money once
+    --   it has been released)
+    } deriving (Generic)
+
+PlutusTx.makeLift ''Vesting
+
+-- | The total amount vested
+totalAmount :: Vesting -> Value
+totalAmount (Vesting tranche1 tranche2 _) =
+    vestingTrancheAmount tranche1 `Value.plus` vestingTrancheAmount tranche2
+
+-- | The amount guaranteed to be available from a given tranche in a given slot range.
+availableFrom :: VestingTranche -> Slot.SlotRange -> Value
+availableFrom (VestingTranche d v) range =
+    -- The valid range is an open-ended range starting from the tranche vesting date
+    let validRange = Interval.from d
+    -- If the valid range completely contains the argument range (meaning in particular
+    -- that the start slot of the argument range is after the tranche vesting date), then
+    -- the money in the tranche is available, otherwise nothing is available.
+    in if validRange `Slot.contains` range then v else Value.zero
+----
+
+=== The validator script
+
+What should our data and redeemer scripts be? The vesting scheme only has a
+single piece of information that we need to keep track of, namely how much
+money is still locked in the contract. We can get this information from the
+contract's transaction output, so we don't need to store it in the data
+script. The type of our data script is therefore the unit type `()`.
+
+The redeemer script usually carries the parameters of the action that is
+performed on the contract. In this vesting scheme however, there is only
+a single action (withdraw), and its only parameter is the amount withdrawn,
+which we obtain by comparing the amounts locked in the scheme before and
+after the transaction. Therefore the redeemer script is also of type `()`.
+
+That gives our validator script the signature: `Vesting -> () -> () -> PendingTx -> Bool`
+
+[source,haskell]
+----
+vestingValidatorScript :: Vesting -> ValidatorScript
+vestingValidatorScript v = ValidatorScript $
+    $$(L.compileScript [|| vestingValidator ||]) `L.applyScript` L.lifted v
+
+vestingValidator :: Vesting -> () -> () -> PendingTx -> Bool
+vestingValidator v@(Vesting vestingTranche1 vestingTranche2 owner) _ _ p@PendingTx{pendingTxValidRange = range} =
+    let
+        -- We need the hash of this validator script in order to ensure
+        -- that the pending transaction locks the remaining amount of funds
+        -- at the contract address.
+        ownHash = V.ownHash p
+
+        -- Value that has been released so far under the scheme.
+        released = availableFrom vestingTranche1 range
+            `Value.plus` availableFrom vestingTranche2 range
+
+        -- Value that has not been released yet.
+        unreleased :: Value
+        unreleased = totalAmount v `Value.minus` released
+----
+
+To check whether the withdrawal is legitimate we need to:
+. Ensure that the amount taken out does not exceed the current limit
+. Check whether the transaction has been signed by the vesting owner
+
+We will call these conditions `con1` and `con2`.
+
+[source,haskell]
+----
+        -- 'con1' is true if the amount that remains locked in the contract
+        -- is greater than or equal to 'unreleased'.
+        con1 :: Bool
+        con1 =
+            let remaining = V.valueLockedBy p ownHash -- <1>
+            in remaining `Value.geq` unreleased
+
+        -- 'con2' is true if the pending transaction 'p' has  been signed
+        -- by the owner of the vesting scheme
+        con2 :: Bool
+        con2 = V.txSignedBy p owner
+
+    in con1 && con2
+----
+<1> We use the `valueLockedBy` function to get the amount of value paid by pending
+transaction `p` to the script address `ownHash`.
+
+=== Contract endpoints
+
+We need three endpoints:
+
+* `vestFunds` to lock the funds in a vesting scheme
+* `registerVestingScheme`, used by the owner to start watching the scheme's address
+* `withdraw`, used by the owner to take out some funds.
+
+The first two are very similar to endpoints we defined for earlier
+contracts.
+
+[source,haskell]
+----
+contractAddress :: Vesting -> Address
+contractAddress vst = L.scriptAddress (vestingValidatorScript vst)
+
+vestFunds :: MonadWallet m => Vesting -> m ()
+vestFunds vst = do
+    let amt = totalAmount vst
+        adr = contractAddress vst
+        dataScript = DataScript (L.lifted ())
+    W.payToScript_ W.defaultSlotRange adr amt dataScript
+
+registerVestingScheme :: MonadWallet m =>  Vesting -> m ()
+registerVestingScheme vst = WAPI.startWatching (contractAddress vst)
+----
+
+The last endpoint, `withdraw`, is different. We need to create a
+transaction that spends the contract's current unspent transaction output
+*and* puts the Ada that remains back at the script address.
+
+We are going to use the wallet API to build the transaction "by hand",
+that is without using `collectFromScript`.
+The signature of `createTxAndSubmit` is
+`WalletAPI m => SlotRange -> Set.Set TxIn -> [TxOut] -> m Tx`. So we need a slot range,
+a set of inputs and a list of outputs.
+
+[source,haskell]
+----
+withdraw :: (MonadWallet m) => Vesting -> Value -> m ()
+withdraw vst vl = do
+
+    let address = contractAddress vst
+        validator = vestingValidatorScript vst
+
+    -- The transaction's validity range should begin with the current slot and
+    -- last indefinitely.
+    range <- fmap WAPI.intervalFrom WAPI.slot
+
+    -- The input should be the UTXO of the vesting scheme.
+    utxos <- WAPI.outputsAt address -- <1>
+
+    let
+        -- the redeemer script containing the unit value ()
+        redeemer  = RedeemerScript (L.lifted ())
+
+        -- Turn the 'utxos' map into a set of 'TxIn' values
+        mkIn :: TxOutRef -> TxIn
+        mkIn r = L.scriptTxIn r validator redeemer
+
+        ins = Set.map mkIn (Map.keysSet utxos)
+----
+<1> We can get the outputs at an address (as far as they are known by the wallet) with
+`outputsAt`, which returns a map of `TxOutRef` to `TxOut`.
+
+Our transaction has either one or two outputs.
+If the scheme is finished (no money is left in it) then
+there is only one output, a pay-to-pubkey output owned by
+us.
+If any money is left in the scheme then there will be an additional
+pay-to-script output locked by the vesting scheme's validator script
+that keeps the remaining value.
+
+[source,haskell]
+----
+    ownOutput <- W.ownPubKeyTxOut vl -- <1>
+
+    -- Now to compute the difference between 'vl' and what is currently in the
+    -- scheme:
+    let
+        currentlyLocked = Map.foldr (\txo vl' -> vl' `Value.plus` L.txOutValue txo) Value.zero utxos
+        remaining = currentlyLocked `Value.minus` vl
+
+        otherOutputs = if Value.eq Value.zero remaining
+                       then []
+                       else [L.scriptTxOut remaining validator (DataScript (L.lifted ()))]
+
+    -- Finally we have everything we need for `createTxAndSubmit`
+    _ <- WAPI.createTxAndSubmit range ins (ownOutput:otherOutputs)
+
+    pure ()
+----
+<1> We can create a public key output to our own key with `ownPubKeyTxOut`.
+
+
+== Exercises
+
+* Write an extended version of `registerVestingScheme` that also
+registers a trigger to collect the remaining funds at the end of the
+scheme.
diff --git a/plutus-tutorial/doc/index.adoc b/plutus-tutorial/doc/index.adoc
index b7101a2e70b..1b6fb8c3125 100644
--- a/plutus-tutorial/doc/index.adoc
+++ b/plutus-tutorial/doc/index.adoc
@@ -17,4 +17,5 @@ include::intro.adoc[leveloffset=+ 1]
 include::01-plutus-tx.adoc[leveloffset=+1]
 include::02-validator-scripts.adoc[leveloffset=+1]
 include::03-wallet-api.adoc[leveloffset=+1]
+include::04-vesting.adoc[leveloffset=+1]
 include::glossary.adoc[leveloffset=+1]
diff --git a/plutus-tutorial/doc/overview.adoc b/plutus-tutorial/doc/overview.adoc
index 3d6fa36f2b1..ea98749a342 100644
--- a/plutus-tutorial/doc/overview.adoc
+++ b/plutus-tutorial/doc/overview.adoc
@@ -23,21 +23,9 @@ crowdfunding campaign. Topics covered:
     * On-chain time (slot intervals)
     * Working with Ada values
     * Blockchain triggers
-. link:../tutorial/Tutorial/Emulator.hs[Mockchain (emulator)] deals
-with developing contracts off-line, as Haskell modules. Topics covered:
-    * Developing contracts in GHCi
-    * How does the mockchain work
-    * Writing and running traces from the terminal
-. link:../tutorial/Tutorial/Vesting.hs[A multi-stage contract] implements
-a vesting scheme. Topics covered:
+. xref:04-vesting#multi-stage[] implements a vesting scheme. Topics covered:
     * Writing a contract that extends over multiple transactions
 
-Note that (5) and (6) are written as regular Haskell modules and include
-exercises (marked by `error`). They are intended to be edited
-interactively with the help of GHCi. See
-link:../tutorial/Tutorial/Emulator.hs[the first such tutorial] for details. Solutions for the
-exercises are located in `Solutions0.hs`.
-
 Additional documentation will be added for the following
 work-in-progress features, when they are available on the mockchain:
 
@@ -47,31 +35,25 @@ work-in-progress features, when they are available on the mockchain:
 
 == Prerequisites
 
-To follow the xref:02-validator-scripts#validator-scripts[]
-and xref:03-wallet-api#wallet-api[] tutorials you
+To follow the xref:02-validator-scripts#validator-scripts[],
+xref:03-wallet-api#wallet-api[], and xref:04-vesting#multi-stage[] tutorials you
 should have access to a recent version of the Plutus Playground.
 
-To follow the link:../tutorial/Tutorial/Emulator.hs[mockchain tutorial], you should
-have a local copy of the source code, and a recent GHC and cabal in your
-environment. See below for instructions on setting this up on Windows
-and Ubunutu systems.
-
-The link:../tutorial/Tutorial/Vesting.hs[multi-stage contract] code works
-in the Playground and in GHCi alike.
+The examples can all be run in GHCi using a local copy of the Plutus repository.
 
-== Installing the emulator locally
+== Using the libraries locally
 
-To install the emulator (not the Playground) locally, follow these steps.
+To use the libraries (not the Playground) locally, follow these steps.
 
 === Linux/macOS
 
 [arabic]
-. Clone this repository.
 . Install the nix package manager following the instructions on
 https://nixos.org/nix/.
 +
 IMPORTANT: Make sure to add the IOHK binary cache to your Nix configuration. See
 link:../README.md#binary-caches[the repository README] for details.
+. Clone https://github.com/input-output-hk/plutus.
 . Move to the plutus-tutorial folder.
 . Type `nix-shell`. This will download all of the dependencies and
 populate the PATH with a correctly configured cabal. If `nix-shell`
diff --git a/plutus-tutorial/doctest/Tutorial/Vesting.lhs b/plutus-tutorial/doctest/Tutorial/Vesting.lhs
new file mode 120000
index 00000000000..85b6684bee1
--- /dev/null
+++ b/plutus-tutorial/doctest/Tutorial/Vesting.lhs
@@ -0,0 +1 @@
+../../doc/04-vesting.adoc
\ No newline at end of file
diff --git a/plutus-tutorial/plutus-tutorial.cabal b/plutus-tutorial/plutus-tutorial.cabal
index 6ec8ce9f149..cc1314e20f4 100644
--- a/plutus-tutorial/plutus-tutorial.cabal
+++ b/plutus-tutorial/plutus-tutorial.cabal
@@ -77,6 +77,7 @@ test-suite tutorial-doctests
       Tutorial.PlutusTx
       Tutorial.WalletAPI
       Tutorial.ValidatorScripts
+      Tutorial.Vesting
     build-depends:
       base >=4.9 && <5,
       template-haskell >=2.13.0.0,

From dd3c21c3e7fd9cca6b92616bddf12266841b7761 Mon Sep 17 00:00:00 2001
From: Michael Peyton Jones <michael.peyton-jones@iohk.io>
Date: Wed, 5 Jun 2019 12:35:12 +0100
Subject: [PATCH 5/8] plutus-tutorial: misc editing and improvements

---
 plutus-tutorial/.gitignore                    |   2 ++
 plutus-tutorial/doc/01-plutus-tx.adoc         |  10 ++--------
 plutus-tutorial/doc/02-validator-scripts.adoc |  10 ++--------
 plutus-tutorial/doc/03-wallet-api.adoc        |   5 ++---
 plutus-tutorial/doc/04-vesting.adoc           |   5 ++++-
 plutus-tutorial/doc/default.nix               |   7 ++++---
 plutus-tutorial/doc/images/favicon.ico        | Bin 0 -> 14082 bytes
 plutus-tutorial/doc/index.adoc                |  16 +++++++++++++++-
 plutus-tutorial/doc/intro.adoc                |   3 ---
 plutus-tutorial/doc/overview.adoc             |  16 ++++++++--------
 10 files changed, 39 insertions(+), 35 deletions(-)
 create mode 100644 plutus-tutorial/doc/images/favicon.ico

diff --git a/plutus-tutorial/.gitignore b/plutus-tutorial/.gitignore
index 2d19fc766d9..7cb551067fd 100644
--- a/plutus-tutorial/.gitignore
+++ b/plutus-tutorial/.gitignore
@@ -1 +1,3 @@
 *.html
+asciidoctor.css
+pygments-tango.css
diff --git a/plutus-tutorial/doc/01-plutus-tx.adoc b/plutus-tutorial/doc/01-plutus-tx.adoc
index 886ef56d221..bce4ee1a022 100644
--- a/plutus-tutorial/doc/01-plutus-tx.adoc
+++ b/plutus-tutorial/doc/01-plutus-tx.adoc
@@ -13,9 +13,7 @@ in a transaction, hence the "Tx").
 
 This means that Plutus Tx _is just Haskell_. Strictly, only a subset of
 Haskell is supported, but most simple Haskell should work, and the
-compiler will tell you if you use something that is unsupported. (See
-link:../../plutus-tx/README.md#haskell-language-support[Haskell
-language support] for more details on what is supported.)
+compiler will tell you if you use something that is unsupported.
 
 The key technique that the Plutus Platform uses is called _staged
 metaprogramming_. What that means is that the main Haskell program
@@ -89,7 +87,7 @@ write inside the quote is just normal Haskell.
 Here’s the most basic program we can write: one that just evaluates to
 the integer `1`.
 
-The Plutus Core syntax will look unfamiliar. This is fine, since it is
+NOTE: The Plutus Core syntax will look unfamiliar. This is fine, since it is
 the "assembly language" and you won’t need to inspect the output of
 the compiler. However, for the purposes of this tutorial it’s
 instructive to look at it to get a vague idea of what’s going on.
@@ -320,7 +318,3 @@ pastEndAt end current =
     `applyCode`
     unsafeLiftCode current
 ----
-
-The xref:02-validator-scripts#validator-scripts[next part] of the tutorial explains
-how to get Plutus onto the blockchain, using a simple guessing game as
-an example.
diff --git a/plutus-tutorial/doc/02-validator-scripts.adoc b/plutus-tutorial/doc/02-validator-scripts.adoc
index 83eac46a03a..c4a50bd18a0 100644
--- a/plutus-tutorial/doc/02-validator-scripts.adoc
+++ b/plutus-tutorial/doc/02-validator-scripts.adoc
@@ -1,5 +1,5 @@
 [#validator-scripts]
-= Wallet API I: Basics
+= Ledger and Wallet basics
 ifndef::imagesdir[:imagesdir: ./images]
 
 This tutorial explains how to get Plutus onto the blockchain, using a
@@ -264,7 +264,7 @@ Playground then uses this schema to present an HTML form to the user
 where the parameters can be entered.
 
 [#testing-contract-02]
-== Testing the contract in the Playground
+== Testing the contract
 
 To test this contract, open the
 link:{playground}[Plutus Playground] and click
@@ -309,9 +309,3 @@ guess. Note how this time the log does not include the error message.
 "Evaluate"?
 
 image:game-actions-2.PNG[A trace for the guessing game]
-
-== Next steps
-
-The xref:03-wallet-api#wallet-api[next part] of the tutorial shows how to
-implement a crowdfunding campaign. It covers blockchain triggers and the
-validity range of transactions.
diff --git a/plutus-tutorial/doc/03-wallet-api.adoc b/plutus-tutorial/doc/03-wallet-api.adoc
index 420b43c0281..ce87d008558 100644
--- a/plutus-tutorial/doc/03-wallet-api.adoc
+++ b/plutus-tutorial/doc/03-wallet-api.adoc
@@ -1,10 +1,9 @@
 [#wallet-api]
-= Wallet API II: Smart Contracts
+= Smart Contracts
 ifndef::imagesdir[:imagesdir: ./images]
 
 This tutorial shows how to implement a crowdfunding campaign as a Plutus
-contract, using the wallet API to submit it to the blockchain. It is the
-third in a series of tutorials on Plutus smart contracts.
+contract, using the wallet API to submit it to the blockchain.
 
 You can run this code in the
 link:{playground}[Plutus Playground] - see <<testing-contract-03>>.
diff --git a/plutus-tutorial/doc/04-vesting.adoc b/plutus-tutorial/doc/04-vesting.adoc
index 5e559084cbd..e056ffe0e0c 100644
--- a/plutus-tutorial/doc/04-vesting.adoc
+++ b/plutus-tutorial/doc/04-vesting.adoc
@@ -67,7 +67,7 @@ Let's start with the data types.
 data VestingTranche = VestingTranche {
     vestingTrancheDate   :: Slot,
     -- ^ When this tranche is released
-    vestingTrancheAmount :: Value
+    vestingTrancheAmount :: Value -- <1>
     -- ^ How much money is locked in this tranche
     } deriving (Generic)
 
@@ -102,6 +102,9 @@ availableFrom (VestingTranche d v) range =
     -- the money in the tranche is available, otherwise nothing is available.
     in if validRange `Slot.contains` range then v else Value.zero
 ----
+<1> `Value` is the general type of assets on chain, which includes tokens other than `Ada`.
+Most of the functions work very similarly, so there is usually little reason not
+to use `Value` instead of `Ada`.
 
 === The validator script
 
diff --git a/plutus-tutorial/doc/default.nix b/plutus-tutorial/doc/default.nix
index 631822c2466..bdc9ba291ca 100644
--- a/plutus-tutorial/doc/default.nix
+++ b/plutus-tutorial/doc/default.nix
@@ -1,15 +1,16 @@
-{ stdenv, lib, asciidoctor, python, playgroundUrl ? null, haddockUrl ? null }:
+{ stdenv, lib, asciidoctor, python2, playgroundUrl ? null, haddockUrl ? null }:
 
 let
   extraArgs = (lib.optionals (playgroundUrl != null) [ "-a" "playground=${playgroundUrl}" ]) ++ (lib.optionals (haddockUrl != null) [ "-a" "haddock=${haddockUrl}" ]);
 in stdenv.mkDerivation {
   name = "plutus-tutorial";
-  src = lib.sourceFilesBySuffices ./. [ ".adoc" ".png" ".PNG" ".gif" ];
-  buildInputs = [ asciidoctor python ];
+  src = lib.sourceFilesBySuffices ./. [ ".adoc" ".png" ".PNG" ".gif" ".ico" ".css" ];
+  buildInputs = [ asciidoctor python2 ];
   buildPhase = "asciidoctor ${toString extraArgs} index.adoc";
   installPhase = ''
     mkdir -p $out
     install -t $out *.html 
     cp -aR images $out
+    cp -aR css $out
   '';
 }
diff --git a/plutus-tutorial/doc/images/favicon.ico b/plutus-tutorial/doc/images/favicon.ico
new file mode 100644
index 0000000000000000000000000000000000000000..e8dfec8c049d5355067c9d4220b278c2627bbb51
GIT binary patch
literal 14082
zcmb_@X*^VI{P%UvoMC2cV_#!1_BFDl%-D($WvwhzX(tqAi!);>N<`sKMY}e%lJ%fn
zMJq*&6pAuMjBVyQy6^wzdGWk>o)?exd}glmJHO?+zQ1(<fbj2yF9^`Us5Jlz_;r@g
z>Xi}{6$*YS;qK<LcH!NHUy=y^FL+P+RsgJTySq60#ee*9Iw?YJ<(a<wjcs3Z!`WiH
zrL=T@3XX|I-)FijY;&<g9I15G2K}d61`>VwChKnLcoarHD~w!sOa0!;{2vF_-#T-T
zuioI6eaq!T_5C;$Bqc18u}xL>=qYtyT{p!0xhJdP<mu#V*Ag$))?KZwt;;;sKS$xS
z=p`zvrzWO+o38$>*uC@IiX0WIoo~z6od3UGct(Eseod_P<25g%k1Lwqf3yy;TK`@$
zHS$AK<JyqM@#fB|<)*wz539!KVT3v?7n8E!Isa0B_a)+looH{R#ZYsG;ocok&Dt#v
zK!bD5e{0RNBj_vfBkVDD-_=4O5UC-oa>=>16)Kw#ZksdUE0D{iof`wTmQ&ouy!X%`
z>S4KkAy}u0`BKL`IX94g9y{1tAvQ3B+);M>?GUhuW{?L+b=bkS{oQ5NAIyW--_z8z
z9@}Mfuu9HNgbpYNJh_o+yJZJ+465=URGn73<3v-=1NsyD*xst6Udry;*|r8<B=%8N
z8K!fFgIAYCb7ac%MOToG`J5|%mlnG4{LfbZ=r`f0OMG|BdvTOp-;_anP0`dMsOaW_
z?^mmBCMFCBmEyGq*MIn9t0YAXiqoljgsT)c;Bl_HGb2<r-mA;Y@khCqJ8@&alZ<ll
zRd}hSJ2<SK>>Cv&ow%7>kY4|0+a1cGsnuGdX;hh~n4f$e$?d-dvWdRjyN-eBv2E~1
zBhdotg^kYF#XbF@EEK64ZnpU|>F%tdxGzM%+LRWs$xR!{`R`31%jUp|$t?WMcz@d7
zm?JT@#=KPPpUWd3(xMK#lP+!KTrs3c=YgHN{A0bnS`(MB4H=&-x;~Ms6f!b!HFZ3p
z?eJ&GIktK!<b$3JMgs3d!-3#oujR?M!8_7E7342DM>^b0Pj|8C@FUV;8FZXm>7|_P
zAElu`wmEUS=FIXPHA#!|{HUu8wlC<Tm8yAyRM?2Pfh(<1hEqAs-mkhxoHP{qU1)CL
z@Lsp5VkO7o3wbUgm#)%sNQEg@Ot^g2{V3Js?%q(v#F45E>Gge!1NL;dIU1!czKsj%
zC?j2*Nu;A9^30mfYW*qgiz)fN4m*Y;TPnmxnDTB~xU%w}(ALUdkYnFd3EI;N%P<E+
z`}}@BCicDU-f%EfHoiMAYW$yQPbWLNJZEQd*$s+JHq**D=;S-*Co;GF;o3)!v0qnj
zuc+ELY}=UpGSN}B%l!EV{jMd+YNE2+#z~h$Iy8sFkElOxe)_@i$@Gy$j~!opD;z#H
zyyb|-${^0fK_$}7oW*Ci);Y&EZ7%t2DUt55H@>86-(+@V;S{?mtd>4^V0g?oRbxM8
zZVVHyo*Ns!DLrPtxv%u`qyA_6yLB5!{=8m{9X)vWb65G##r&l;#1vPU`<xvxq*1JL
z_v3+}RZ{x-zzw{019Tt*tYiQgJu12L@Ad!hzvxL>ti9RYoFpj{q#a}*8~tHvmHHjF
zMC+*>)*D{);A3p?SlWvp9LWy5#HxhDETbpvikoRKK5^7L+LRbwJ)$#20;~H$^WcwD
zg^!zMIg5xdSMx5g6bC*w7k=UzG{502@3c!Iwv#3o?^cWWU=|+`&HQZl$Se12yGK2B
zlTUN=hIh_?W?M?#XX*vk@!i@{rA;pc4y@VDrFU}A9Gg__J}7YbGxcjX)IBBGf72Ih
z)E3$&)&CAj>>EM(M`s^Sy=)YQ#w_DM7O`Kw=W|W};||)<%YFC;B8JGt=4^e~E79+t
zcrjyXt61!AiRIzWq3O46?sN^JcZvrmvt%UIU&^vpvTw^SGw6C)6VSpAYH@s;u)b<&
z={B?Y6;<s+E6AeDht@Si&3liOsFQp$6zL+)YV{WfT_2aHtmNN*QtCT1C$LWF9*P>d
zEh7-{rj9kWPg3gV4JL0iRqhw-+RshZvnP($B|0VV&mA9olXjq*a5lqZ{^6=5r^5w<
z&ki3`aFomg3Z6ia|0$EV7pf6Y{mL{D?UNF&HkjMP+po&ekW96m$mVXy=+zxI^M_Oo
zhSRCX*mr)28oP4Gx-ZLXvHBjHo<JyxWbq)6GSVI#L1?hgjm{`pf#hM{lrA~7SuN#$
zXWw2gjpW1Xj5WgpEh%n~!=2>Dr1eBjQ{_&uZyNe!u_~RAn0J`u6_xm48Al6pH1x#{
zyi>$fT)$PuFZE8y5g7Mtn5T!W`@Lae=6!S170E`g;kz3Zn-6^81TJ|nZ+}AVdU{@!
zVV-N%SY}EP%U2@2h$;P8mdt8K$|yn+FMfAizlN7w%0N70_jR+Wnb{>@8zXTLwjuUf
zcR5t9r%tIaU`koOV}w6dra2{z6#EX{=SDrLn5Pkc4yW}6kjt*ZJ{e(F-?mYN0iylY
zhSQr94|K0(s3rS*m(qFG5JSyb#c>#?!QR=()Pdhr(JEB*rO3vE#LqfDh+W?DmAfh|
z+`uFEra1SlbDLZG3Kq}R<})ffy;bMjqDswqp@%L{)Njq2TyA^;2e-C<_Ma+R0Gyq`
z4wun~tKlGLxXNfg$5L>1h-b2%|L1GUXYTCAR~Zg6d<0_Tqb_^g^a-DMn4iS5ZR;e8
zGm&pP7_no333eS+T0T6Q?VqTyaS;XE*%K90TWK_by|~bC<2Cthm7pe+v4&^jr17)A
zAboB-oc~NSOFUM~cDp9L#VR@^OyYq%>);6_JC7+D-u|jqQv@-0fvcAHMOh7KkcGvQ
zex?3=uYm*izvPbmc_R|0I8%eIY*`l4{|8Z%kkvj&w{X+u)a=A?ZSKuvYO}STK>Oh!
zQHY<b8x;gy&oZ0W&i(Q}qv=|9f3?B%K;pb#b6|R?D!({S!^82q+LE=03LI6WANUjc
zH67QI%QFcleA9m-RVjyF5whoAeR-+j5xNaNw7jo0`gOZhYS@XEO5<r0+%nv2iL-RJ
zR7QM8`!Bgesk?MU){#~y<G@{^V(!jW-X^2}Ip`UC)NZHhCO24Vrw??&VBTvW<<mEZ
zPp%FXtx?@0kBMRLy4%inA`aHWdP>!@c|PJX7C!z&Ypp|9L?)c!%QE^LwP-!mn#5`t
zp6gjvb_QXsnW=t!TyRM_)tA42eR|)L50{M=WV+rgHTCmY*)I5i1=0NrZe4$Wsu73&
z4t-dU-bJ(m#T81b?PRdbjVpY>?t^d~4ZVJ`X-^M+`pPHTRZ`x>GrTG_RFj>(qbT*J
z&!a9pSS6`oaY){A`*v!eM3*EvLWg%@J$#P92D*E&)4*C>v0<S1fV|HDTvhXG<+_=u
zEL^yPl-jl=-^?)k-lEp1(LYw3lf9y%#2dUi`ktdXO0l?|;O?E+5_+^5ZX{eYA8ns=
zVb<ehCcOG8nn*=kUo&>UHcJi+yTminosHFL>KPe%HebW-#?3YP4<%{~GezUHQtUhS
zRl|-fY>9E6PV{z&US+Ap-Xw;gojAcI&xf0TRZy`G8AWFN=k~hyjGvs+bj8^RFZkCg
zcyGM;IufbDm8ClT+Kz*SN=l3a;pQfDKT$n73pYCKYQ<8Kxp0EX-K6=|3U*cV*iEb=
z!(IAE4^+#P$3cEqCURA$uI(OmR}t{SOTC^}e*ZK7ba@ERTc4vrZqVgjrItSXE2sHi
z6J8T}y^5=xgY4Ty=ee9cwAnz^Vu<wEw$&JoaAvE>qgSV@8{RV_zeSy#coWh;q&0W-
zX5-n;YD#0zn-W-q{Ok1V>^I6;vd*W(#kCH-ln#0>Q9MYzPLKX%%pU#+B9-N}UL!z9
z%oAzsbNhShD&d{$fP13w!fioJK}x1-(ydJ47B9ZPPLtZ)=FGK>9z1Y~lAW|v&MM%n
z5xLaQcD16~)1T<G8$`%{y2Qh_g*_zJIEer&tr4Tmrn4j{v`bUo%YW$=3A#70N_}&o
zbZ}YfRo*U-l#u&T%E=)(&I;}kJ}&@Ch%43J*hhkFv5LDc2WdHcR78(>m?qjoW{tZY
zTQucg4)62_AA5ynH??<fKIloCBc?Z@JVmMiZV6-Z#Ym}8zZq@rRPQes@j(HF%7hyJ
zed*tIye;y)uQB^VjJRSZ+`}eZF;i}vDc56Y8DWw=Z$q&)r`WntNQ|0w7~2<v{IF&}
z%<*A@bUh-;F4D8BL<5NjFH>xT>{eoH9>qeU_)oQ{<i3|#-KPpTHdx7#e_)QUrkU;6
zy_Zq0zpeJKdzt&g9W1Cb>)s`uCikaGPTrquFD~L$r$u&_Y_jjmyVu<<wW;*bfiFMI
z?)4qbo{x7K^}UxWb@;&ivkSsSp4?eJ($^OFk51VcxmZ1PQaY20x#5Rywb=V&@Ht6n
z$Gh>q@t;eDlQ&ncUy21dzT7r<tWdpvk}|`aa;TR?e+-;@{MgppbJ^?PU;eCIzb_-6
zG72Rr+dMGpk~;ISPb#>m=GT+oio8C_P{k^ScZ?)EaEaPKgKDSqiwEnEGD=S+h7*HQ
z^5+xQW5T31Rjya`&cS1ab0PI9>7BX!YwbIPf7C;NS#IMEjdAuj+kf^K%-Vk*Q|C|b
zAN$anBB)zDHYS|^(J@3x4oI-?64s5owQcY{@xyfNaCdKM(d_I{@trYv)^~I$&}jC+
z!^1WuG&UnBW&0k7Mj5y0tz{M(KIzB;M10f)0e@=oZMg<qx+#33w$H`LD5rdl#~W(O
zBSZ5suSehMyn07?(7joUo=5mV>{#5Ahj8mD<(g1e&b&K#dyC9H;f^oWNXqt!BfJuH
z9ZsjAyQrAees~xKA0MtWtM+H!AY)y#d!akd;0GP-G$8W6)6>Mb@`p!|{FkEU&}b&u
zXHR7g>1)$bA9>95=(QxMt9`Bjly8y6`f=)Rtk8sg%)Nv)On7h_RKr~`6nj*m;daQ+
zYv_6zX2e)Ku>*o)^FaAUc}#Aze6daF;_X%j<!Tf;O}5$-Q`BTBbi`N_qT7x2Il^Uy
zYe1#f;u;`%utI5Bcpmz~)hQTu%_ICoFm>B!6>&E!;OlyXU9P|x=T=M`)%HE&pNA!X
z*`yf;-y4U%--dC|6L<WqG+JO-rjD4)$T5euUpu_5(sx%hq{arZQ<4u}iYi@0|2ny@
z@5}d`>f;UGqXdORbR*#hohF>@2P8T+yO|hGk0q?>xls0L9qtaF<XF%lTih6q;C%x_
z5mO+s#K`FS^^m7!fFnHqtd7*`%r1&J2<L-ICy=y=f-?5hhhK+ZpO(1}LG-%5QiN$z
z0zyl-UWdoob)*yH(3O{z8d+wik~SS&E?^(lM`Nq!^8f1f<_-}>Y~<{QtlQ#5Ls<?k
zz9i9nE0uX^Bhy5TX(%+hHvfF%$~(87O7DF8`i?vmqv)cW8^NXX)zW%Pji^`P9<eep
z_(@jxrvg97$^;EBNEOTr{*^5G<W0)+qE1;idpVy#$kmM|dP}S<>BzBA@T(Pdm0|vV
z+LR6U;A__*(Ix$4R>n?8X@7aD5t}IwpdJ+L#(B0uFopYMH|(i-StgMhI$BUU*-FgQ
zhI~8>P}yqbYglr^X~%14(Kz{qs44_3*M)4AMU2mZ*Egm_p(Bo9b1dE0Lk}&eR^9?3
zI%QPc!#?vzH$W5Na%h556$uV1NSwnr4iSpADg^6O<14THY4~vIy~d~6#F3<_!hv>^
z8{3qp)~|2x|8pQZG}<xxm%~s#_ZIird|^}yFD6e)r(!F&mHK<E=J(C1y0+3*VeqJB
zXr9AV!p-FobuT{+bWishcMmo_oMc-<r_#Zkl}PRm1tqUQqMV~7E}<0CVWLnQXD=RP
z3<Vt#p8v||hE@}42VORb3LyS+(W<HGI&Nq1k1m`g;u#>KiQ4h(T7-5myp^$%<*+i^
zRuOwRd&+~;#xa^=tfVql((E)=1xt)S9qLoNh0X`_`<{)B2u<fgCuiGA9||J`+Zt#N
zvp9E0_HMFo@10e?mmrEC4x8PUHDGmsf=XNv5oc>msg;Hn8<v?Oc@g)=>_!g-SlfN(
z?X3Vp>19CJ28|vNEV?&deX`S54qOAhbw#2&$hq`r^n(m%t<(1Zc>1d*892y^y1>$(
z=?m#hQRRCqw`Tuu2j=?*gu9a^Clj8P{>VoU42o@1eR=rDrc<)rNeaL1M|?mOLZk+5
zvE3k#5u>pT@JRU^k;)JcVnN|X!fQHc6vu95`-Z9MF_JLKULISg3H<qHZv9OcNU65`
zJxnjQ#!ZZ#ajmo~3tJ7R#lOHMjKU@C%_~$3^deol0v7{GTLq>W(xF{gTcndWf3EBy
zmC1RN`s%Jg)fa5jME6p$btKGst~M0+$R#ktaQvXm>r@-EqrdzUEgyeEDDiwgHcIOj
z{XjHt4I+|V5N<gI4*?rv@Tj;#0sYyFCd#3c>r&~!6rIB9c>;2)#?L>k&ACV@Wu}<8
zadCM#Rl%`brRq3_llh0pdoPZ|mKg(mu+Nkk7gx3lv^#=!ljFcR6S6Wum*mcFf`{24
zQN;^PrGu^GA9*8q#LjIyD|Ilb2fjfS*UGyFCAhH)F<R&%G1jFE*Wu81KOz&@Xrd)Q
zkq%L4B3mzHG5O1*;1>krDzG+J*p@r9(-W%V4R9ata<J&v%V4bi-PYep?33e@Jz|}z
zq#fhksD;cetFavL+fv*Vt-kO$@BTHohg_C=N?IPRd&3sfN4s!n|HUA4>#69u(ZI~G
zcOwVWDkbJ}J^GA;T2kKA2`5PT9xN)puX+{Hvy?nNLYQTbHdO{ZfgZz3W;!Y&Z!ZCH
zS@hR{@R0&W)C8Z3`{V@2ig~mB5~8ywbz&^?T=N28MNRbZ)NL{DTXAiD^sPU-M~NE>
z=BdmuC#Wk#s;U@vTP7HShciH;swWuA0H#c!=zOs$jvv=-g9vJM43*Pe%dU!i(PXcN
z@yua2F`5GNN>@e5VX?0_;&~ma3W>YH(Tk<3hG92L!I&ZAd);Cp){>j1(ciwZB~?dv
zZck<9$gendQ!~GM@pjyL>|i`4q9yM`aq+?xv2XTA^1zZ-utlC~FOKg8C=IL)lcE-r
zf|(FqSvU)mCIwDl;KnGNl_`Vi=%Ts*AitlvH(kJ09!8m~R<ilw^Ngm&k&_{X8h;4@
zm&cwv!#Z__v{&Y3*|?@2hDzl{XhpM;yl~iuA&82Af;qs{AEA<)mUTy|3Ve9lXPdUT
zyNIYrKY53)f}K^!(ftw}Lkdgxt2qlo%vsu~pDbI<0DUftMu`5!_VM!)M&M0NnAM=v
zLB{KmgB&x_q_u;&bSI&=W*SP$Uqy>Ojh4eAzfOjLZ9mPgBUMgy0q7F(LoW#n5GK!L
zw2Vm+@>e6@1I0pd=T-tDf}!9{VCoEt?t|kOQ@MVnuKf8>JUh1I`4;lmk`7}UDmZ(q
zVQmT-IS5m+$3Ky15!m*?<uA!f+_j+lk@6bo!fDcVWr*GY=M@PfM3-Cw6>cyuNhoF2
z(B#j*7|Ni|`BYstd6mVi5Q)$!E0t1uu<HcTd|;D0b{6O=B|?0E=8PpIW{h6g1~?1*
z3M4Yp8I?cg{RdJ)_+LZ&#(w#qZHmltM^=#2^+Y86G0~$4Z*o!QT@XMo6)nF7#K*zY
zcEq?0<Ojpo&wz;SQ1bXQJpl8WF@dF5rvknB2CW*DMzzs@N*`>NbF5O)_u!s%f`2(f
z)o{EjY)gQY4nmi7TJLlc<cc)Xfn@Lccqpip9OMSo+((L|;#(=)flE>S+?8XcHj{$d
z*I`Gd30s;B=2B|Lg7DJ8D%eI|Mqi0eZD4Mv;>T4+lJE?!`5FMaX(*%$A=kiRU$zw;
z<y(T_g=3JKM&=SUQ7KQj<G7&HxuMB$u9lk`?ieHzAk!gE^xQ@aCUZ~Qi>CpLc7mTH
zkPQYY^4y<(TqiQ^oeY-_!hpsqxa#}7)y33cert2n$oLhJ4APgKOl@f7EHelMs``L#
zdDtz{uquF<H!Q~rOA`Y$Wcon^!)Tr`kmAfIG_S<Q)|JWNycdX&A5gFYR2xcuKq7OG
zwq-H*!(F?n%#*(CI3qMv6HSo;is+8tW|yX<a;J^@%@TWvQx0FBXVz5mqXg}}^LO-n
z2Lk2E>6wJAtLPJR>;~v%gWeUqNIm#Rl=%7}D0WM&0!x}$m4)Q30+)U>c8rCQh0f6;
z{e2wTe$9>$lFd*fB;59s{4=GNIOa?8gYP-B`5PC|k;2vXfO=LZ>Y`%YheSDMMFo-<
zFHe&JvY7vA;Q6)b($rLo1{Dir$v&B|)1*G?e-e#dq8yUNI`n=byb5Q?#f)sq`6!Rg
zWXNDmuShHcnH7VS{h0rtBruxjEn%*Jl0T-e;zlQ|<{sT@N{fy}za3$+l(;LvSb#e)
zGrIuPg2nyD;o;XLRvDWZeS*wX5zYn*{&^<ckZm-t1@kA2ko~exbkQUyFm)lT+0!4}
zL}ux>-3331RSgt4s7?vqzL$=&MP#u&IvDxYbY)IzLJ(oycN%OBp>U-}yn&g?EwHqR
zgNIpYhAehD7~G~}5i6kQ&tU$N6eT8HrHI`#B(WsOWiN@`O><#H==n@1>4`r|fW!;%
z$}b&VD$gvZ<aLUZ`gE^1x^^{y-ebh*gNTn6bX^<55l`=(EOy-)>hY$b8|bJlbSH1&
zHoRIa0c|Jw2={_UpzA9RWo{=iVH&h#aveB{L{OoQIPfQ75jZV!y>bM64*)qSI;?zE
zb_Bu<gkNVc#k4@JoNWWhOoozA{SM#~YZNg>X3dmMufp8GMQt>(R*_}$N&GE$KS4wR
zVuO@hS)X1Mxr5QIWp#x%1cM}@MxbyvrW0eC_rnra9N*1+lL)?@Au~sy8Y;RTZbIy-
zy;~=^H`H%)W<|E@bT!?d-67VJsw<PCSWO6<zhK=-i1)v#4n9eGigAoTa%lIAU}7i2
zmv@?FP<u-?A26JY?eKdk_`U77QXdQES2Ctu!;ks6jz!(I-R^arBqxLZ$Yz?o&Sw7X
zMCj0kAX)RRjy?%GtWSyPZ56)}xYxZ-r6YGBKqS-_>NttwDaLS`<4U|KavDSg60Mg@
zJXs>wVIrQ`c}J;y;}$M2%}KYlUEK5SY+%Bgj(=u?<(9l6IDNYhJbb~G0Fn2`l2?;-
zu@H$E56-SY==FqPaAmsH;9jWk(JgMFx5)PkdISSvw9eNw$5?0RG!pAgyp=$6<Hv^e
z?BTi>B9%pYga*GGdIWdajTc@vcrxCi<9m9p$oXvqLnK-Q=0BL*UUk7+wDw|xe);$N
zXiP3r@@koek9>;nx2Qzs_7`O4ecJXv>Jo)tKA=BhI)S)JORHmn!=hq@Mn;#bz5V?S
zyEH`jxC$H8JbTldB)MESSUKgID93N8zif4><g#_D-l9LRf4xk&d|%CWCCnpsBr3x-
z$qXrSIk8NYlI|_`Xt|E9G3Q(HN=}Ko#P09YKT65NlfSqNK8aXWKd3IXJ4xDS)E_-e
zN0%rPraR#Y>vCY~0oRB_5B#B+ambKd?ouY(a_93lx#nugru!2^-HAlFW^E+Y^KvOP
z90Uf$Z-aZ68cExa5%UJuqbuYw9Zl3D7#uTX+Q?Pqp`nPAh@s|jf^g-D(uRv<VVpDn
zPtm+cQYuNRd)bpgr&DC^5`<O><$aamK0Dv+L29&z#E)3Mh28d0d=5x3BT2OWE0|pe
zMa3Hwr2|t(P-{qA4gZd&1xu8>M0@BEUAY%KRwmBV`!(KYmPU@#qK(1OK&mOKc$JR!
z;^wd^g@f@znyqY^JQg%S;c6k#H?`0`@+?aYmJa0V8vTZrQF67zh*NozCw8#UXXY@k
zsOr;hBzi{DSrh1eO?3rkwsK4c!WD>PFa;~ZYSXvD_wvCqC^#IhX(vX%5_2}NkgGa@
z?sTIarqR>f;(X4$l8OnDO>XMUJu+?8FEu47dN^qT1@F;EeJ#h?y?t3=cOi8S4>F#A
zRYqN@%&XlTf(!~C(a@WZWU!2Nrfjj>@=$puyq=t{E7JB3bwV~OckS_#Pj;=WlxVuQ
zV24-7!0H#~=iq2xfmuDs_XHyC!1xw;?S)uh0xxkRns1=^K|AOy8Qh;4E-n{@IZ7w{
zKV{6gpTwIL!Lj;iy)oGK6;GJQso1zA(!qF1qLkS`L|7%a<|-FK^kUK}!i}<<2v1;K
z3BMGB(siOAu7w487@d>lQyjS_!=Y!S?ea|Q7NO`f-t9>B@LAgJzacO19Sie-htoih
zH!#fvGNCf{8HkSpxCZwg1TSY{HyZniPV3p7EMvKkS>}uY>dZeehq-zZ!i#(O9$h~T
z$=rR<4yPXfno4dqGfmxnmYBB_j%E|{CiA&0`Ho`P)}~DdLwJpfnXBYk+R*f|&xX>)
z;jFeGk}vO_;!JT1Zj|1$pqB%_^!CYOvG0HP$uh+dfM?TDr!*0ky`cIG2zG%kge@vx
zOpKm1RmAQm1p{63lfCfO!x?^B=1;N0HUAWI^`scxgO2y4EX24slr!;Ur#CF_mv{7J
zX+~2z*BRJc)kg0Oq=tcAT90?+kgybWmgF7IBUxO~mrh{l=ZOe9_5Nxs0JmMx+4$UO
zo_|B*0sbd3t``YAfEQn)Q8G8v9-43h%MB2gsZh}a7z{#lBT%i19~g54+cE%7$DK~C
z5b@ONAU9|7lEgE%^5y%@L>Wu_6~%>ij~X2D96su$ISuU|4`>kXifKp<0ycP!#+J&g
zG(&H08s(?%{rpR)MWW3vV{WE!S2}?)GBix5l`g80(}qrv@RVhv+pF$foXQ`6;`)cW
zmyy&+T<gv9EsQY9)N{S5uiwrVQIo6TVF@zLrm$iz_oz^D9SG<o9C7)#2v7!k(?ALW
z)$gx79t0aoyBKj8L?LncWGM~%Rx=ZmA+=m!$=^IzQJNS$&A-f7V>}${50(j*3of2F
zxR*BWVEedc$~R&}V{={7DH1oQ`$!q+`6CDh?M|S*mWnBz7wtFOsv^9WB>X6gKKzC~
zlEb9NZt*Oozx-Nnv5IL$Kcwg=J<5z0T89cH>3Q&+{a9ai;LE7b^G!cvz7A9l>`!g@
z^V=9NLTJ^{V$|!+Z1<0ibgg)qG?hZAk;U9e7-MX#V#-XDk7s<cdg!roFxn=3D93y@
z3-39fV}NS(eD%kqG*OLSlM_0;Gj#S|3i-hyX1=3zY+X?F`S+@vb`lBm8Z#ra7)Vv$
zF_1`yl-h(3286CM=q-vH4ei-(w0#*AT?0PT^IVW%5!a3%pHpT}Dq>_!RF;Y+zi2w#
zTY9sJ0uN_`Tc-rRxx!uU;Qcm&iZAF>g!v8#kDv)oAfK<|2CEUzF6(~y<6hjtt=O+`
z(_OC_31edc;L~RD9AHr-JZyscwW14{=?OGq$mUS8MzfHO6)>}RG8Ler1+HtlD+Y<t
z$tU~Cw6!zae#{?$M(fVtg*?2fQ)4DnTm!NWLfR50sC-}Do3}H|N!%ojufNu3yJ449
z@?5DW{v&~dq&R%YXue=dpo27Z{r0rNYn*eHR#1=xL1isyYZ8N!r*^-|9!ohcs&feS
z;LcLWU599fX<EbkVs3lgu$h=S;@@@vN^ecI-SSOC0kgzW$m)>~iT39O<E}3H;9n`c
z!C3E>_PbL^*>UtP>9~bHXSbqF_uKmaDt7NLHci(zsR?8_VG$ojg24S(n`(QT3W<4l
zD8mzU94_Kl%3yWDU<;Y=%yF|~Q62sM>VN%gtu(eq7ZhC-N+<}j!Q@gZbNBIMj^O6w
z9XG^iYl(PUzat*zo!ObB*YtT&x-f+8Z&mic@5Zh7$^b81Se0I#u=!U5w;taF_ng3P
zJ>gClaIHX+umU$=lrxw+7LYLZ&!i_jrjNsMvy_z<_pcO1AK&MIqfGEoEamg6RIjln
z#ZhUv3vW7Z7(nt8e^+MWwImBFti%Q@R6M{o8fZLopf{=Pq8{5`C(??lu7FRjn5Hji
z^Gf6kG42z*hRb18s!eql3cmN2igCZ~vcse24VtJ46`jR(g0MpVlZxB6ZZE`_Aq5iL
zU45jTq_u{(PN^CvK=sxSxv-nX&s?+lb$kz!04B5Ivq-dce__|El^DHKcWin4&pUZ2
z-UyVCXtCfr;pW))=2gBT)^G5)pnbR0>szG^=1awVC6THv$2Af2&$V-vdXRV^(jf`m
zu_*?>shB~ONnQQak`mvAqr`eRwd6la_hVW~+;>l>{RUF@j)gh#K8cmd!qH)Z&O9)B
z4aJZC1}Za@gx=Vax+;3<3MBiiql-v#u@CZTbkBf}85*dk91QmGB?eO3UN>o>pQzYw
zQFvHw3lnHRG@KCp(M9{Sfi=!TZ#v+w-<J?&Fj9|Cx8QQL;(8SE2m_U#76I((F5a%k
z^I!K0`g?JtSKP4gz6?fMz@dP%Q<aX;gFt9+7db}{#R+w-4WMEruLrJ2y0Y>iMJMUl
zv`5ldTO*L`x5=6PbCDsIO70(myZrHz;Zf-oZs292P(>CEkvA75FE|TK^-Y9MNqu$R
zMRy!Li^H)DTo~G$q2T_I>l3e{IDMkIpQn~(_bGlk@?b}^!K3HryN*(#$i3k`DRSK}
z><nz7quxoz43SVpwJn~@Yv)Mu5^7sL9kTO<Ymm}kkw~g4|Jv|{KChBp^KloOsLZon
zzr!{0{#Dr`IJ$4P^D1~?;CL6Ip&Lo8nwv<p6N!6)it0f*BtLn!yGSs}wL`*!!j+W8
zR@4jB#%5hnOPR|$t6%s%5$lzye_At7yjQe$Z8WS_I;d76*km^l7kzy3A7YD;*wSt%
z9(wvqJsdj87fTlg23QJeW14FJ!&!%ghRB`&QD&L^k~3g+qS(4GZ6jTJ(*HgfZ=4`l
zWxyyRrQI|TOA_vVS~_L&aG;j3Ys#a2tUz&`H}<Wl@<*r1=*Fa4vkx_WQg|%0n#8*7
z3`Jyuo>NnmiqQ7Id*<f1OYdcS4~$OlA$@jX84*kog)S3X3E;oWUer753a9Gvm0Qkw
zQ|GW&`>z`k2U=3~o$;=GO6bg9XjBgF>SuzIl}gL?=MVc2&+qaBgN6%^K2sL0&U?6+
zgh@G`B1LS$GBCIsx<y9AZgllGgz@)(v1({A;Gd0~&1p#CK2m=tpYp3e@Fl-Qcm7Ov
z`ogwit3u1HTTqbsmuxWDNnUatAPEX+HX^Q7bpldsF>BtM=LJSLUG%kF#67#1w`Vw~
zS?a{BbwgwFX79T#m4@>P{QKZc@e@cCR@yp2n{zdr+npp-QNVVl0c$2u#a+Oh`o0yt
z_Iy{RXLt=3Id+w)O)yQb#B?XW^mxKtMWZ<M;CIZ(snYOI&es&r%1YHS)vdEPTAPMW
z?(PYb#$;t57C!z&LM7rHUBLovMLZj%VpPQZZ4hj`^he*LlT$GFpyn0QgcF|<!IFCU
zoDNcMt`&{nE}rZe6}2eYx3W^K>H9Lg2qj;TQm55#ra2c3a_!}?6(pu)Q%P@AC=zX@
zj}HQr-DpOl5!lw^>F&)hl0+F|oK;9nE1`kfh>U#LJ8nTn8T%^<%a(|Qc6J+i9Ps5i
zH#Am!X_pZ+WVMWu%MxZ?B*PgFi{BF0KsDdyN0{K1VOb23_mN(gV>PyDE=8$DD?UV%
zQzh=_WScN6)V#3k!{*xyRQFx`k7^00^kQdVXm5$dT%CV^B?&Z}Sx2RTdv<b|2#F~#
zcqGl7zQa}9=VY|q7~<J?DJ6_?r_!j@W<M8Xm9kpt(ac{668(E}=VaG)T)DZQz5}To
zc4vlzJI|}3(Tgu-OA#Jr;=t;FnEzY>R5O(mq3gR5yfXElzb+7jL?oDjl<8}->~n_Z
zlz#q%(Dejw(Y~vT3jp7D|59G4ls`LHqT%Y>T%##Gp1kxW4CST$+B6OjbMrIve3y%L
z5v@K_p@;oRsf);ETI_{5zyr*QD6D8yg9}KW7Cz+uu8A=13qr%&fbVRxl$Rn!*vPoV
z7sr#JG{z26<AF+z;%_z~UpC7MPJiSTQRg=8Wgs16ZXlA1C6ZXDZ)Y_nDq!y($zyHm
z_=yTVftM%of;Ba?RIn?3BJ9>K3ANzL4)#=1xnzChurGoaw?`h$UNV|H-ruxUvdIj^
z`}=)of%#jaJXG^ze#8?5!+Xo({yEQjmjfipkQxWfQT1I}crBIsY%QO`4Xb*SBUuqR
zjLj|+PoFRUY^m?ekncG|Z}#5syX56~_rzQ?uju3~4Rs)uwVws=9l_7mu!C^Wr!qMH
zScWh_R&u6Z5p`axANuMkYn2Jk>QT>mdHztu!=8w3M)mUh?J?)g+(@TVYyQ>HKHWKQ
zJ+aiXiOTd+u`)$?7#}Bza~9V`uhD_@+kilgnhJ#X+N<6Pq>v=Zq4$nC9-)So%y{tH
zyRz^9<DeH7Q@ya61kuCeR}yEBHwRA6SP#r!@1G)e*o*vauzkq&7LRk3(hty_qoa5X
z((JB~@|RqTmhF-qdN_NM-t$C0Vc*qP&EK9$@;a9CYI_|bd67v6e&j44{2(aCrA?xt
z>ZG#A8KA-<kt*0E-{K9I<Hh*i@cwO;xKUbg{9vylC1>=cK3i?Ib>`Hl-`D=9lJyRE
zB<oEl)}`U&9dQK*3i|_(PPg@IZ0k3(+V2cLQJK{Qh|7oQXr>}2W^*42MR8N89p@Z#
z!L#^!i|M9j#>Q=`YNskj7xr~Exxtl}^R=;WWJA$hwrW!TL0n^E@UY6>xa3KI&+m$H
zr%Qt2c4u5wB04Qvq&AvydbwPe#k$;EmJ+zG82%q1brnLCY+?y_SKEAXXqZiJXIQVQ
zMoJh6p)!vmOgLH}sEwXMcqh#ca*1SLeDDX!Wr#Mlzg!aT5Rxz)AR1pTQ5QLU_hRGO
z9-Ev$UwxDDsjwuzNALOiz31&F!^7|qOuQ2#S;gzaMsn)+^B9Vw67T#SwKV78WYut4
z%%k@Tu45n7$!Koe*+8NY%lU#&w>^zI`E4kW|Mc?A9GTHHI@KEX`^=X*dAMs8UX!bl
z!SJdedn7&s%mI=#63*jXvLFSDt}&QXo73KRNwfRgvkgc78ZPE+;GfA_Zpot=d}nRF
z#K429&ue<^CWFit_&N<H#UMVEm*jjx{EW>Lnqh`0R|8kght+|JmksTkog=%f*qujz
z_~V1VJpZpLAM+Oo^rkKQ2P}2RYleYvSMKlB(v^*B;J(eBW9+L=<%jyApr?P8V;4Ve
z&u!wgFAMeIB~z0FnseH#B;?P?j}~?9KRtegRmsZ51H@C8k-BEn75$b->229j>ayly
zzIeY-ym=^sKo~fc(xErJX!hS1V%a^z+ei-E#D>-8qwoSKif~th*^XJp-qQ_(ZOco0
zR8_XHs7|gFDQwlgOU-zRar3lTb>rDD(=?MKL%TVurwE*FI+Grwb)o&rRe@D2c@tJI
zeP!^c^TOG;eXE>#Nc^cc^@}1ldnOb5hbGb-I>Ztm*?!`f=Bdt$v<M~AOW!<Inl2f=
zpMqCQ@y=5fZ|u*LB9G88WOjGgQ>G^3F8=q??DapEEDYX?p&6;UR4jByy{cYX71eJo
zcT+qFz}34jor|uQ#m?;VGVyi>-eGM;-jP4n9HP+(9-7hWOvDJfxUl!i?Vx2L+jk~V
z;CQ_4<sG@WMGK$jeo3gx_p)BA4dJ8OUclQC)M+lnnZB>TnVb-xR0=OU&e6*hW$D<z
zVdg9lv4WO8MbM3yDT!4b8``}>Bt{+{!i}V>dgT~i`Ms-;h7c!DPML;(&@tV4^B8_=
z*BC4VMjyhp7siLn-Xm4#F`X(|IDT#Ik#{Tba~Qvt^q-Y|{xY!!*o%!?g*B$fU8Zwx
ziBr}nm#0%tv=FLfe7-M8iq8oT$OgmSo?qH*Dn|2MsD+L}Btrw_ArD+fjxSw!$RuKZ
zl&4rs`rZ3!r#C6qqDtDyXTgrvuiXBVAwo53XG(p?+xi1q?LYm-qt=-m#?I$?k{lN=
z@apm}uOh^%h;A3(aeSt)B)09UF|PG}a_2_h^61FlAAHZ?3Rw<`GeKDbYuVVR(#FVh
zoYlBSobqsum24|pfgi88=fDi!>mZe-*5C5Ua1>dk>2krRknr!#>!1loP<CGm9xhP0
zbmR$UjNFh@FXdZS<)4oH_wG~R(aFL;PM~3PLX^%&hpdz|YKuH)1%;(PN*rO9Sl-*A
zq$Ksavdp_<#PZR%W5Wuu(?{-E4Ivwd8<5kSqtdJESeEfe7WdqXC}5pu5w>p@ziYC=
zEJ*adMa4an4cb8=R_{5M+(0_ILV?-7{mm^LhDBl4$g4jy>ESGG#Q!2TO-cTCb2+iw
z^GIq|pXx=1OW2{%M@pAhp4-r&b4>MX#EC8~d`dkzi@WzDv4of_k&0hgQ>;lJGaFra
zb|c8H=9AY>z4IR`@~1G!Wfe$=1Qd&-^X3zGhYutxcaa?Rh&S|&s}juK4Utj<QdN_i
zpLTaGT7T%xh9kblPn3g?-*(d5d?CH#U-FAH@o;0Cb{B2C>gVf<*9oK2pWY>`8r$Ru
zmy1EMjv!>Sm+kQQ*R(K67Z;JmYdf+ukFt*oE4<SpxnDc>8#pytsm;hW_iZONY6z@6
z4FCEprX&pTo94Ju#B<#=<g{F(MDwVn+j%o$!{UuLe}4COs3y(6S~XlC!cY^$dED#N
zgWjG7_wdA46TLx2Q+aLd;Z^#`MI||o+mX-niN-CvRpUd3ah&_e6@50Z^I@a_d|wSt
zQ}OMa<`Cw<|LXH)6Fwa5bV@C_Ba$Y=7hk~Dl7wMd(bR8KGq@X-Wj=O$gAWLc9%xiU
zO*B27I@~o^ORjr0-x%H1%Jx=Cbd4&t<9jgvWq&sM%`Hh%83E==r6^>sHc->mEPjxu
zYT2e~ay4(HrP2S_bU}Kk|DZ3=9eAt&C7S3y5}q*eqy$H)F*xaF{e#DgQ`!}LyX4u`
zq=uW-m$^8@p&-{0PZUl@cMK7rytK1&oD8`L;zp02v0+aoKK-oJ#AHmf#?CJbYu&+%
z5*mK|D-(p=DNb1ddo^Y0V)`+cbJ35HPfK~(9o>_YZwK&&A;9)YN#SC0gxbqCi1Y;a
zp!Buo*)1|9QxUo3x+_IeQxjKjHeCH54pcMmBY5Dy2UruYkTwRHAO%VveM#C+XCtgL
zLS*AZ5-N>;`EPL`mLfhvd~mk~lFIzerlu!7@KRXY;V-r${H7grwrm42G_ZHXsZynH
zK?8ASf2VX;I#A(9nLcj#fVF(u3Yn}mO_zUKx;X5z<+(e1H!LT!+$lKXp2nAP{%GPD
zROKkUBu(wqtyh?c^EwU5daq#vJ{{FDK<_#`B#f06rBU_po%8t%m-1=M|G;WruE7Kz
zcqo8gu`dmTGek_Pbt%z$ZPhX70MDlV2U;-SVRs;5gubI<-=#imdyzEOq?>MxY%u7e
zXqjB<t9~iBkFpF036=s==_1wm0?X*og$MH$ceAm|v)Dpw?i<3=CZ1NxciR+lGFmk;
z?(b?J9f&TSwpPX<Xfu>iu@T{oun^pfdyCE~^QFoj-UI<C0}4aKY|)1Hrj`8EYZTaa
zG&=R<x&ri_%c7Rw6QvJ+;Z4Bn_h+nLZ4j#SXOHq1X)1J{pv)fW6A^adV?Qa1-NKQ!
z9x-n9qA~AtH>VfH%-Q@ue9Y_r{3uvqz^pLDbe}rq&l)EFDK_Bly4t0}iN*O}_(y-v

literal 0
HcmV?d00001

diff --git a/plutus-tutorial/doc/index.adoc b/plutus-tutorial/doc/index.adoc
index 1b6fb8c3125..ce0f89a8c58 100644
--- a/plutus-tutorial/doc/index.adoc
+++ b/plutus-tutorial/doc/index.adoc
@@ -1,9 +1,23 @@
 = Plutus Tutorial
+:email: plutus@iohk.io
+:orgname: IOHK
+:doctype: article
 :toc: left
-:numbered:
+:sectnums:
 :source-highlighter: pygments
+// Considerations:
+// - Shouldn't mess up alignment (weirdly some of them do, including the default)
+// - Shouldn't have a dark background, otherwise callouts don't show up (otherwise I'd pick monokai)
+// - Should have a non-white background, to distinguish code blocks
+:pygments-style: tango
 :imagesdir: images
+// uses fontawesome, seems okay for now, could use real icons later
 :icons: font
+:favicon: {imagesdir}/favicon.ico
+:stylesdir: css
+:linkcss:
+// prevents setting the last-updated-label etc.
+:reproducible:
 
 // unfortunately, asciidoctor likes to parse these as definition lists :(
 // https://github.com/asciidoctor/asciidoctor/issues/1066
diff --git a/plutus-tutorial/doc/intro.adoc b/plutus-tutorial/doc/intro.adoc
index dd1a47a4421..e0ee7f4ee8e 100644
--- a/plutus-tutorial/doc/intro.adoc
+++ b/plutus-tutorial/doc/intro.adoc
@@ -29,6 +29,3 @@ authors do not write Plutus Core directly. The Plutus Platform is a
 software development kit to enable smart contract authors to easily
 write smart contracts, including the logic that will eventually be run
 on the blockchain as Plutus Core.
-
-In the xref:01-plutus-tx.md#plutus-tx[first tutorial] we will
-go over the basics of using Plutus Tx to write smart contract logic.
diff --git a/plutus-tutorial/doc/overview.adoc b/plutus-tutorial/doc/overview.adoc
index ea98749a342..69252b0df6d 100644
--- a/plutus-tutorial/doc/overview.adoc
+++ b/plutus-tutorial/doc/overview.adoc
@@ -10,21 +10,21 @@ contracts and related terms
 the Plutus Tx compiler to create embedded (on-chain) programs
 . xref:02-validator-scripts#validator-scripts[] implements a
 guessing game. Topics covered:
-    * Signature of validator script
-    * `Ledger.makeLift`, `Ledger.compileScript`
+    * Validation scripts
+    * Lifting and compiling with the `Ledger` functions
     * Contract endpoints
-    * `Wallet.payToScript_`, `Wallet.collectFromScript`
-    * Playground
+    * Paying to and collecting from a script with the `Wallet` functions
+    * Using the playground
 . xref:03-wallet-api#wallet-api[] implements a
 crowdfunding campaign. Topics covered:
-    * Parameterising a contract through partial application using
-    `Ledger.applyScript`
-    * Operators in on-chain code
+    * Parameterising a validator through partial application
     * On-chain time (slot intervals)
-    * Working with Ada values
+    * Working with `Ada`
     * Blockchain triggers
 . xref:04-vesting#multi-stage[] implements a vesting scheme. Topics covered:
     * Writing a contract that extends over multiple transactions
+    * Working with `Value`
+    * Creating and submitting complex transactions
 
 Additional documentation will be added for the following
 work-in-progress features, when they are available on the mockchain:

From 0f4db4b8640b1c163a84f10d0c7396f0c262d028 Mon Sep 17 00:00:00 2001
From: Michael Peyton Jones <michael.peyton-jones@iohk.io>
Date: Wed, 5 Jun 2019 12:38:31 +0100
Subject: [PATCH 6/8] plutus-tutorial: delete Haskell tutorials

There is little in these now, they're a pain to deploy, and if we want
such a thing in future we're likely to rewrite them anyway.

The vesting example has been extracted to a tutorial already.
---
 pkgs/default.nix                              |  14 +-
 plutus-tutorial/doc/03-wallet-api.adoc        |   3 -
 plutus-tutorial/plutus-tutorial.cabal         |  23 --
 plutus-tutorial/tutorial/Tutorial/Emulator.hs | 331 ----------------
 plutus-tutorial/tutorial/Tutorial/ExUtil.hs   |  83 ----
 .../tutorial/Tutorial/Solutions0.hs           | 275 --------------
 .../tutorial/Tutorial/Solutions0Mockchain.hs  |  92 -----
 .../tutorial/Tutorial/Solutions1.hs           |  49 ---
 plutus-tutorial/tutorial/Tutorial/Vesting.hs  | 355 ------------------
 9 files changed, 2 insertions(+), 1223 deletions(-)
 delete mode 100644 plutus-tutorial/tutorial/Tutorial/Emulator.hs
 delete mode 100644 plutus-tutorial/tutorial/Tutorial/ExUtil.hs
 delete mode 100644 plutus-tutorial/tutorial/Tutorial/Solutions0.hs
 delete mode 100644 plutus-tutorial/tutorial/Tutorial/Solutions0Mockchain.hs
 delete mode 100644 plutus-tutorial/tutorial/Tutorial/Solutions1.hs
 delete mode 100644 plutus-tutorial/tutorial/Tutorial/Vesting.hs

diff --git a/pkgs/default.nix b/pkgs/default.nix
index 6dd15d6f7f2..61fd6042a3f 100644
--- a/pkgs/default.nix
+++ b/pkgs/default.nix
@@ -53936,18 +53936,8 @@ mkDerivation {
 pname = "plutus-tutorial";
 version = "0.1.0.0";
 src = .././plutus-tutorial;
-libraryHaskellDepends = [
-base
-containers
-language-plutus-core
-plutus-emulator
-plutus-tx
-plutus-wallet-api
-template-haskell
-];
-libraryToolDepends = [
-doctest
-];
+isLibrary = false;
+isExecutable = false;
 testHaskellDepends = [
 base
 bytestring
diff --git a/plutus-tutorial/doc/03-wallet-api.adoc b/plutus-tutorial/doc/03-wallet-api.adoc
index ce87d008558..e7f074bd9b5 100644
--- a/plutus-tutorial/doc/03-wallet-api.adoc
+++ b/plutus-tutorial/doc/03-wallet-api.adoc
@@ -659,6 +659,3 @@ 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
-link:../../tutorial/Tutorial/Solutions0.hs[`Solutions0.hs`].
diff --git a/plutus-tutorial/plutus-tutorial.cabal b/plutus-tutorial/plutus-tutorial.cabal
index cc1314e20f4..b55f49ee334 100644
--- a/plutus-tutorial/plutus-tutorial.cabal
+++ b/plutus-tutorial/plutus-tutorial.cabal
@@ -44,28 +44,6 @@ common lang
     if flag(defer-plugin-errors)
         ghc-options: -fplugin-opt Language.PlutusTx.Plugin:defer-errors
 
-library
-    import: lang
-    hs-source-dirs: tutorial
-    default-language: Haskell2010
-    exposed-modules:
-        Tutorial.Emulator
-        Tutorial.Vesting
-        Tutorial.ExUtil
-        Tutorial.Solutions0
-        Tutorial.Solutions0Mockchain
-        Tutorial.Solutions1
-    ghc-options: -Wno-unused-imports
-    build-tool-depends: doctest:doctest -any
-    build-depends:
-        base >=4.9 && <5,
-        template-haskell >=2.13.0.0,
-        language-plutus-core -any,
-        plutus-tx -any,
-        plutus-wallet-api -any,
-        plutus-emulator -any,
-        containers -any
-
 test-suite tutorial-doctests
     type: exitcode-stdio-1.0
     hs-source-dirs: doctest
@@ -86,6 +64,5 @@ test-suite tutorial-doctests
       plutus-tx -any,
       plutus-wallet-api -any,
       plutus-emulator -any,
-      plutus-tutorial -any,
       prettyprinter -any,
       containers -any
diff --git a/plutus-tutorial/tutorial/Tutorial/Emulator.hs b/plutus-tutorial/tutorial/Tutorial/Emulator.hs
deleted file mode 100644
index 2bf60dfa786..00000000000
--- a/plutus-tutorial/tutorial/Tutorial/Emulator.hs
+++ /dev/null
@@ -1,331 +0,0 @@
-{-# LANGUAGE DataKinds       #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-
-    A Plutus emulator (mockchain) tutorial. This is the fourth in a series of
-    tutorials:
-
-    1. [Plutus Tx](../../doctest/Tutorial/01-plutus-tx.md)
-    2. [A guessing game](../../doctest/Tutorial/02-validator-scripts.md)
-    3. [A crowdfunding campaign](../../doctest/Tutorial/03-plutus-wallet-api.md)
-    4. Working with the emulator (this tutorial)
-    5. [A multi-stage contract](./Vesting.hs)
-
--}
-module Tutorial.Emulator where
-
-import qualified Data.Map              as Map
-
-import qualified Language.PlutusTx     as P
-import           Ledger                (Address, DataScript (..), RedeemerScript (..), ValidatorScript (..), Value)
-import qualified Ledger                as L
-import           Ledger.Ada            (Ada)
-import qualified Ledger.Ada            as Ada
-import           Ledger.Validation     (PendingTx)
-import           Wallet                (WalletAPI (..), WalletDiagnostics (..))
-import qualified Wallet                as W
-import qualified Wallet.API            as WAPI
-import qualified Wallet.Emulator.Types as EM
-import qualified Wallet.Generators     as Gen
-
-import qualified Tutorial.ExUtil       as EXU
-
--- | $setup
--- >>> import Tutorial.Emulator
--- >>> import qualified Wallet.Emulator.Types as EM
-
-{- |
-  In this module we will implement a function and in `Tutorial.Emulator` we will
-  use this function in a smart contract.
-
-  Both modules are intended to be loaded in GHCi, GHC's interactive environment
-  (https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html).
-
-  The problems in this module follow the numbering scheme E1, E2, etc. In many
-  places the `error` function is used to mark the spot where you need to fill
-  in the implementation.
-
-  Some of the comments in this module contain GHCi commands. Each GHCi command
-  is placed in a separate line prefixed by >>>, and its expected output (if any)
-  is written in the following line.
-
-  After making changes to the source file (TH.hs) you can type `:r` in
-  GHCi to load the changes.
-
-  The topics covered by the exercises are
-  * GHCi
-  * Compiling plutus programs
-  * Testing smart contracts in GHCi
-    Testing smart contracts in GHCi, using the mockchain
-
-    E1: Below is the outline of a contract similar to the guessing game. It
-        uses `EXU.encode` instead of `hash`. Fill in the missing
-        definitions in `intGameValidator` and the `lock` and `guess` endpoints.
-
--}
-
-data SecretNumber = SecretNumber Integer
-P.makeLift ''SecretNumber
-
-data ClearNumber = ClearNumber Integer
-P.makeLift ''ClearNumber
-
-intGameValidator :: ValidatorScript
-intGameValidator = error "exercise"
-
-gameAddress :: Address
-gameAddress = L.scriptAddress intGameValidator
-
-lock :: (WalletAPI m, WalletDiagnostics m) => Integer -> Ada -> m ()
-lock _i adaVl = do
-    let secretInt = error "exercise"
-        vl = Ada.toValue adaVl
-        ds = DataScript (L.lifted (SecretNumber secretInt))
-    W.payToScript_ W.defaultSlotRange gameAddress vl ds
-
-guess :: (WalletAPI m, WalletDiagnostics m) => Integer -> m ()
-guess i = do
-    let redeemer = RedeemerScript (L.lifted (ClearNumber i))
-    W.collectFromScript W.defaultSlotRange intGameValidator redeemer
-
--- | Tell the wallet to start watching the address of the game script
-startGame :: WalletAPI m => m ()
-startGame = startWatching gameAddress
-
-{- |
-
-    We now have a new contract with three endpoints, 'lock', 'guess' and
-    'startGame', very much like the existing guessing game.
-
-    Instead of using the Playground to test this contract we are going to work
-    with the mockchain directly, in GHCi.
-
-    The mockchain is a simplified model of the cardano blockchain. Its internal
-    state consists of two parts: A _global_ part containing the blockchain
-    (list of validated blocks) and a transaction pool (transactions that have
-    been submitted but have not been validated yet). And a _local_,
-    wallet-specific part with information about how much of the blockchain is
-    known to each wallet and about the amount of "own" funds. A wallet's own
-    funds are unspent pay-to-pubkey transaction outputs that can be spent by
-    the wallet.
-
-    Let's run through an example. Suppose wallet 'w1' wants to transfer 100 Ada
-    to wallet 'w2' using a transaction 't'.
-
-    The life cycle of 't' in the emulator looks like this:
-
-    1. 'w1' constructs 't' using the wallet API by calling
-       'Wallet.API.payToPublicKey', and submits 't' to the transaction pool.
-    2. The emulator validates 't', along with any other pending transactions
-       from the transaction pool, and adds a new block containing 't' to the
-       blockchain.
-    3. 'w1' and 'w2' are notified of the new block and update their internal
-       state accordingly: The "own funds" of 'w1' decrease by 100 Ada and the
-       "own funds" of 'w2' increase by the same amount.
-
-    When working with the mockchain we use the `Trace` type to build a sequence
-    of actions similar to steps (1) through (3) above. To implement the example
-    in Haskell we need two wallets 'w1' and 'w2'.
-
--}
-
--- Some wallets used for testing.
-w1, w2 :: EM.Wallet
-w1 = EM.Wallet 1
-w2 = EM.Wallet 2
-
--- To send money to a wallet we need to know its public key.
-pk1, pk2 :: WAPI.PubKey
-pk1 = EM.walletPubKey w1
-pk2 = EM.walletPubKey w2
-
-{- |
-
-    Now we can build a trace that performs the three steps. A `Trace m a` is a
-    sequence of mockchain operations, where `m` is the type in which wallet
-    actions take place (usually `m` is an instance of `WalletAPI`) and
-    `a` is the return type.
-
-    The 'Wallet.Emulator.Types' module provides all the functions we need for
-    building traces.
-
--}
-
-simpleTrace :: (Monad m, WalletAPI m) => EM.Trace m ()
-simpleTrace = do
-    -- 1. Wallet 'w1' constructs the transaction 't'.
-    _ <- EM.walletAction w1
-
-            -- The second argument to 'walletAction' is an action in
-            -- 'WalletAPI'. We call 'payToPublicKey_' here but we could
-            -- also call any number of our own contract endpoints.
-            $ W.payToPublicKey_
-
-                -- The transaction can be validated at any time
-                WAPI.defaultSlotRange
-
-                -- We want to transfer 100 Ada
-                (Ada.adaValueOf 100)
-
-                -- The recipient's public key is 'pk2'
-                pk2
-
-    -- 2. The emulator validates all pending transactions. `EM.processPending`
-    --    returns the newly added block.
-    blck <- EM.processPending
-
-    -- 3. Notify all wallets of the new block.
-    _ <- EM.walletsNotifyBlock [w1, w2] blck
-
-    -- Done!
-    pure ()
-
-
-{-
-    Note that the last two steps (process pending transactions and notify
-    wallets of the new block) can be combined using the function
-    `EM.addBlocksAndNotify`.
-
-    How can we run a `Trace`? The module `Wallet.Emulator.Types` exports the
-    function `runTraceTxPool :: TxPool -> Trace MockWallet a -> (Either
-    AssertionError a, EmulatorState)`. `runTraceTxPool` runs a complete trace
-    on a blockchain that is initially empty. Its arguments are the list of
-    pending transactions at the beginning of the simulation -- that is,
-    transactions that have been submitted to the chain but not confirmed yet --
-    and the trace itself. The `TxPool` argument can be used to supply an
-    initial transaction that forges the money we work with and distributes it to
-    the wallets.
-
-    `Ledger.ExUtil` contains such an initial transaction, called
-    `initialTx`. It assigns 1000 Ada each to wallet 1 and wallet 2.
-
-    >>> Ledger.ExUtil.initialTx
-    Tx {txInputs = fromList [], txOutputs = [TxOutOf {txOutAddress = AddressOf {getAddress = 9c12cfdc04c74584d787ac3d23772132c18524bc7ab28dec4219b8fc5b425f70}, txOutValue = Value {getValue = [(CurrencySymbol 0,1000)]}, txOutType = PayToPubKey (PubKey {getPubKey = 1})},TxOutOf {txOutAddress = AddressOf {getAddress = 1cc3adea40ebfd94433ac004777d68150cce9db4c771bc7de1b297a7b795bbba}, txOutValue = Value {getValue = [(CurrencySymbol 0,1000)]}, txOutType = PayToPubKey (PubKey {getPubKey = 2})}], txForge = Value {getValue = [(CurrencySymbol 0,2000)]}, txFee = Ada {getAda = 0}, txValidRange = Interval {ivFrom = Nothing, ivTo = Nothing}}
-
-    When the simulation starts, `initialTx` needs to be validated and added to
-    the blockchain (as the first block).
-
-    Let's define an alias that lets us run traces easily.
--}
-
--- | A helper function for running traces. 'runTrace''
---   * Forges some funds using the initial transaction from Ledger.ExUtils, to
---     ensure that the wallets have enough funds
---
---   * Instantiates the trace's type parameter 'm' with 'MockWallet', the
---     mockchain's wallet API
-runTrace' :: EM.Trace EM.MockWallet a -> (Either EM.AssertionError a, EM.EmulatorState)
-runTrace' trc = EM.runTraceTxPool [EXU.initialTx] $ do
-
-    -- before we run the argument trace 'trc' we need to validate the initial
-    -- 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
-
-    -- now we can run 'trc'.
-    trc
-
-
-{- |
-    >>> runTrace' simpleTrace
-    ...
-
-    The result of `runTrace'` as displayed by GHCi is not very meaningful
-    because it contains too much information: It includes the entire blockchain,
-    the internal states of all wallets, pending transactions, log events, and
-    so on. To only see the final distribution of funds to wallets, use `EM.fundsDistribution :: EmulatorState -> Map Wallet Value`:
-
--}
-
-simpleTraceDist :: Map.Map EM.Wallet Value
-simpleTraceDist = EM.fundsDistribution $ snd $ runTrace' simpleTrace
-{- |
-
-    >>> simpleTraceDist
-    fromList [(Wallet {getWallet = 1},Value {getValue = Map {unMap = [(,Map {unMap = [(,900)]})]}}),(Wallet {getWallet = 2},Value {getValue = Map {unMap = [(,Map {unMap = [(,1100)]})]}})]
-
-    'simpleTraceDist' shows that our transaction was successful: Wallet 1 now
-    owns 900 Ada (the currency identified by )
-
--}
-
-{- A complete trace for the new int guessing game looks like this:
--}
-
-gameSuccess :: (WalletAPI m, WalletDiagnostics m) => EM.Trace m ()
-gameSuccess = do
-
-    -- The secret
-    let secretNumber = 5
-
-    -- 1. Wallet 'w1' starts watching the game address using the 'startGame'
-    --    endpoint
-    _ <- EM.walletAction w1 startGame
-
-    -- 2. Wallet 'w2' locks some funds
-    _ <- EM.walletAction w2 (lock secretNumber (Ada.fromInt 500))
-
-    -- 3. Process this transaction and notify all wallets
-    _ <- EM.addBlocksAndNotify [w1, w2] 1
-
-    -- 4. 'w1' makes a guess
-    _ <- EM.walletAction w1 (guess secretNumber)
-
-    -- 5. Process this transaction and notify all wallets
-    _ <- EM.addBlocksAndNotify [w1, w2] 1
-
-    -- Done.
-    pure ()
-
-{- |
-    The final distribution after 'gameSuccess' looks as we would expect:
-
-    >>> EM.fundsDistribution $ snd $ runTrace' simpleTrace
-    fromList [(Wallet {getWallet = 1},Value {getValue = Map {unMap = [(,Map {unMap = [(,900)]})]}}),(Wallet {getWallet = 2},Value {getValue = Map {unMap = [(,Map {unMap = [(,1100)]})]}})]
-
--}
-
-gameFailure :: (WalletAPI m, WalletDiagnostics m) => EM.Trace m ()
-gameFailure = do
-
-    -- The secret
-    let secretNumber = 5
-
-    -- 1. Wallet 'w1' starts watching the game address using the 'startGame'
-    --    endpoint
-    _ <- EM.walletAction w1 startGame
-
-    -- 2. Wallet 'w2' locks some funds
-    _ <- EM.walletAction w2 (lock secretNumber (Ada.fromInt 500))
-
-    -- 3. Process this transaction and notify all wallets
-    _ <- EM.addBlocksAndNotify [w1, w2] 1
-
-    -- 4. 'w1' makes a guess
-    _ <- EM.walletAction w1 (guess 4)
-
-    -- 5. Process this transaction and notify all wallets
-    _ <- EM.addBlocksAndNotify [w1, w2] 1
-
-    -- Done.
-    pure ()
-
-{-
-
-    Sometimes a trace does not give the result we were expecting. In this
-    case we can inspect the emulator log to see where it went wrong. The
-    emulator log contains a list of blockchain events, telling us when a block
-    was added and when transactions were submitted to the pool and validated.
-
-    >>> emLog $ snd $ runTrace' gameFailure
-    [SlotAdd (Slot {getSlot = 3}),TxnValidationFail (TxIdOf {getTxId = d6757dbb663d0f560d553972bc44e60384dc6e5d3c12295114d30b77d27a2856}) (ScriptFailure ["Wrong number"]),TxnSubmit (TxIdOf {getTxId = d6757dbb663d0f560d553972bc44e60384dc6e5d3c12295114d30b77d27a2856}),SlotAdd (Slot {getSlot = 2}),TxnValidate (TxIdOf {getTxId = 566c02f59e744ca0fc1d2eeb424524f133e9de21331b00e655beb28a76d932b0}),TxnSubmit (TxIdOf {getTxId = 566c02f59e744ca0fc1d2eeb424524f133e9de21331b00e655beb28a76d932b0}),SlotAdd (Slot {getSlot = 1}),TxnValidate (TxIdOf {getTxId = bd9fa121a44d5b39f3ae4a259cc97866bbb8aa640156afb6ac29d3e5b3eddfd0})]
-
-    The log entries appear in reverse chronological order (newest first). The
-    second entry of the log above shows that a transaction failed with the
-    message "Wrong number".
-
-    E4. Implement the int game in the Playground and run the 'gameSuccess' and
-       'gameFailure' traces in the Playground. Compare the final distribution
-       and emulator logs.
-
--}
diff --git a/plutus-tutorial/tutorial/Tutorial/ExUtil.hs b/plutus-tutorial/tutorial/Tutorial/ExUtil.hs
deleted file mode 100644
index 7525b2a569c..00000000000
--- a/plutus-tutorial/tutorial/Tutorial/ExUtil.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
-{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
--- Some utility functions for the tutorials
-module Tutorial.ExUtil(
-      encode
-    , initialTx
-    , w1
-    , w2
-    , w3
-    , pk1
-    , pk2
-    , pk3
-    , runTrace
-    , runTraceDist
-    , runTraceLog
-    ) where
-
-import qualified Data.Map                  as Map
-import qualified Data.Set                  as S
-import qualified Language.PlutusTx.Prelude as P
-import           Ledger
-import qualified Ledger.Ada                as Ada
-import qualified Ledger.Value              as Value
-import qualified Wallet.API                as WAPI
-import qualified Wallet.Emulator.Types     as EM
-import qualified Wallet.Generators         as Gen
-
-{-# INLINABLE encode #-}
-encode :: Integer -> Integer
-encode x = x `P.multiply` 2
-
-initialTx :: Tx
-initialTx =
-    let oneThousand = Ada.adaValueOf 1000
-    in Tx
-        { txInputs = S.empty
-        , txOutputs =
-            [ pubKeyTxOut oneThousand pk1
-            , pubKeyTxOut oneThousand pk2
-            , pubKeyTxOut oneThousand pk3
-            ]
-        , txForge = oneThousand `Value.plus` oneThousand `Value.plus` oneThousand
-        , txFee = Ada.zero
-        , txValidRange = WAPI.defaultSlotRange
-        , txSignatures = Map.empty
-        }
-
--- Some wallets used for testing. The 'Wallet.Generators' module defines a
--- number of wallets for this purpose.
-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.
-pk1, pk2, pk3 :: WAPI.PubKey
-pk1 = EM.walletPubKey w1
-pk2 = EM.walletPubKey w2
-pk3 = EM.walletPubKey w3
-
--- | A helper function for running traces. 'runTrace'
---   * Forges some funds using the initial transaction from Ledger.ExUtils, to
---     ensure that the wallets have enough funds
---
---   * Instantiates the trace's type parameter 'm' with 'MockWallet', the
---     mockchain's wallet API
-runTrace :: EM.Trace EM.MockWallet a -> (Either EM.AssertionError a, EM.EmulatorState)
-runTrace trc = EM.runTraceTxPool [initialTx] $ do
-
-    -- before we run the argument trace 'trc' we need to validate the initial
-    -- 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, w3] 1
-
-    -- now we can run 'trc'.
-    trc
-
-runTraceDist :: EM.Trace EM.MockWallet a -> Map.Map EM.Wallet Value.Value
-runTraceDist = EM.fundsDistribution . snd . runTrace
-
-runTraceLog :: EM.Trace EM.MockWallet a -> [EM.EmulatorEvent]
-runTraceLog = EM.emLog . snd . runTrace
diff --git a/plutus-tutorial/tutorial/Tutorial/Solutions0.hs b/plutus-tutorial/tutorial/Tutorial/Solutions0.hs
deleted file mode 100644
index 2b6ad0b1be8..00000000000
--- a/plutus-tutorial/tutorial/Tutorial/Solutions0.hs
+++ /dev/null
@@ -1,275 +0,0 @@
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
-{-# LANGUAGE NoImplicitPrelude   #-}
-{-# OPTIONS_GHC -fno-warn-unused-matches #-}
-{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
-{-# OPTIONS_GHC -g #-}
-module Tutorial.Solutions0 where
-
-import           Data.Foldable                (traverse_)
-import           Language.PlutusTx.Prelude
-import qualified Language.PlutusTx            as PlutusTx
-import           Ledger                       (Address, DataScript(..), PubKey(..), RedeemerScript(..), Slot(..), TxId, ValidatorScript(..))
-import qualified Ledger                       as L
-import qualified Ledger.Ada                   as Ada
-import           Ledger.Ada                   (Ada)
-import qualified Ledger.Interval              as Interval
-import qualified Ledger.Slot                  as Slot
-import qualified Ledger.Value                 as Value
-import           Ledger.Value                 (Value)
-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           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 `($$(traceH) "WRONG!" ($$(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
---    `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
- }
-
-PlutusTx.makeLift ''Campaign
-
-data CampaignAction = Collect | Refund
-PlutusTx.makeLift ''CampaignAction
-
-data Contributor = Contributor PubKey
-PlutusTx.makeLift ''Contributor
-
-mkValidatorScript :: Campaign -> ValidatorScript
-mkValidatorScript campaign = ValidatorScript val where
-  val = L.applyScript mkValidator (L.lifted campaign)
-  mkValidator = L.fromCompiledCode $$(PlutusTx.compile [||
-              \(c :: Campaign) (con :: Contributor) (act :: CampaignAction) (p :: PendingTx) ->
-      let
-        signedBy :: PendingTx -> PubKey -> Bool
-        signedBy = V.txSignedBy
-
-        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 foldr addToTotal Ada.zero ins
-
-        isValid = case act of
-                    Refund ->
-                        let
-                            Contributor pkCon = con
-
-                            contribTxOut :: PendingTxOut -> Bool
-                            contribTxOut o =
-                              case V.pubKeyOutput o of
-                                Nothing -> False
-                                Just pk -> V.eqPubKey pk pkCon
-
-                            contributorOnly = all contribTxOut outs
-
-                            refundable =
-                              Slot.before collectionDeadline txnValidRange &&
-                              contributorOnly &&
-                              p `signedBy` pkCon
-
-                        in refundable
-
-                    -- START OF NEW CODE
-                    Collect ->
-                      let
-
-                        -- | Check whether a given 'Slot' is after the current
-                        --   transaction's valid range
-                        isFutureSlot :: Slot -> Bool
-                        isFutureSlot sl = Slot.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 (foldr minAda x xs)
-
-                        -- | The list of 'targets' filtered to those targets
-                        --   that are in the future
-                        futureTargets :: [(Slot, Ada)]
-                        futureTargets = 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 (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 &&
-                          p `signedBy` campaignOwner
-
-                            -- END OF NEW CODE
-      in isValid ||])
-
-campaignAddress :: Campaign -> Address
-campaignAddress cmp = L.scriptAddress (mkValidatorScript cmp)
-
-mkDataScript :: PubKey -> DataScript
-mkDataScript pk = DataScript (L.lifted (Contributor pk))
-
-mkRedeemer :: CampaignAction -> RedeemerScript
-mkRedeemer action = RedeemerScript (L.lifted (action))
-
-refundHandler :: MonadWallet m => TxId -> Campaign -> EventHandler m
-refundHandler txid cmp = EventHandler (\_ -> do
-    W.logMsg "Claiming refund"
-    currentSlot <- W.slot
-    let redeemer  = mkRedeemer Refund
-        range     = W.intervalFrom currentSlot
-    W.collectFromScriptTxn range (mkValidatorScript cmp) redeemer txid)
-
-refundTrigger :: Campaign -> EventTrigger
-refundTrigger c = W.andT
-    (W.fundsAtAddressGtT (campaignAddress c) Value.zero)
-    (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.fundsAtAddressGeqT addr (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"
-    currentSlot <- W.slot
-    let redeemerScript = mkRedeemer Collect
-        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
diff --git a/plutus-tutorial/tutorial/Tutorial/Solutions0Mockchain.hs b/plutus-tutorial/tutorial/Tutorial/Solutions0Mockchain.hs
deleted file mode 100644
index f117999943d..00000000000
--- a/plutus-tutorial/tutorial/Tutorial/Solutions0Mockchain.hs
+++ /dev/null
@@ -1,92 +0,0 @@
--- | Mockchain traces for the crowdfunding contract defined
---   in'Tutorial.Solutions0'
-module Tutorial.Solutions0Mockchain where
-
-import           Data.Foldable         (traverse_)
-import qualified Language.PlutusTx     as P
-import           Ledger                (Address, DataScript (..), PubKey (..), RedeemerScript (..), Signature (..),
-                                        Slot (..), TxId, ValidatorScript (..))
-import qualified Ledger                as L
-import           Ledger.Ada            (Ada)
-import qualified Ledger.Ada            as Ada
-import qualified Ledger.Interval       as P
-import qualified Ledger.Interval       as Interval
-import           Ledger.Validation     (PendingTx (..), PendingTxIn (..), PendingTxOut)
-import qualified Ledger.Validation     as V
-import           Wallet                (EventHandler (..), EventTrigger, MonadWallet, WalletAPI (..),
-                                        WalletDiagnostics (..))
-import qualified Wallet                as W
-
-import           Tutorial.Solutions0
-
-import qualified Tutorial.ExUtil       as ExUtil
-import qualified Wallet.Emulator.Types as EM
-
--- | A campaign for the traces
-campaign :: Campaign
-campaign =
-  Campaign
-      [(20, 100), (30, 200)]
-      35
-      ExUtil.pk1
-
---
--- The traces defined below this line can be run in GHCi
--- using the Tutorial.ExUtil module. They are of no use
--- in the Playground.
---
-campaignSuccess :: MonadWallet m => EM.Trace m ()
-campaignSuccess = do
-
-    -- 1. Wallet 'w1' starts watching the contract address using the
-    --    'registerVestingScheme' endpoint.
-    _ <- EM.walletAction ExUtil.w1 (scheduleCollection campaign)
-
-    -- 2. Wallet 'w2' contributes 80 Ada
-    _ <- EM.walletAction ExUtil.w2 (contribute campaign 80)
-
-
-    -- 2. Wallet 'w3' contributes 50 Ada
-    _ <- EM.walletAction ExUtil.w3 (contribute campaign 50)
-
-    _ <- EM.addBlocksAndNotify [ExUtil.w1, ExUtil.w2, ExUtil.w3] 25
-
-    pure ()
-
-campaignSuccess2 :: MonadWallet m => EM.Trace m ()
-campaignSuccess2 = do
-
-    -- 1. Wallet 'w1' starts watching the contract address using the
-    --    'registerVestingScheme' endpoint.
-    _ <- EM.walletAction ExUtil.w1 (scheduleCollection campaign)
-
-    -- 2. Wallet 'w2' contributes 80 Ada
-    _ <- EM.walletAction ExUtil.w2 (contribute campaign 80)
-
-    _ <- EM.addBlocksAndNotify [ExUtil.w1, ExUtil.w2, ExUtil.w3] 25
-
-    -- 2. Wallet 'w3' contributes 50 Ada
-    _ <- EM.walletAction ExUtil.w3 (contribute campaign 150)
-
-    _ <- EM.addBlocksAndNotify [ExUtil.w1, ExUtil.w2, ExUtil.w3] 5
-
-    pure ()
-
-campaignFail :: MonadWallet m => EM.Trace m ()
-campaignFail = do
-
-    -- 1. Wallet 'w1' starts watching the contract address using the
-    --    'registerVestingScheme' endpoint.
-    _ <- EM.walletAction ExUtil.w1 (scheduleCollection campaign)
-
-    -- 2. Wallet 'w2' contributes 80 Ada
-    _ <- EM.walletAction ExUtil.w2 (contribute campaign 80)
-
-    _ <- EM.addBlocksAndNotify [ExUtil.w1, ExUtil.w2, ExUtil.w3] 20
-
-    -- 2. Wallet 'w3' contributes 50 Ada
-    _ <- EM.walletAction ExUtil.w3 (contribute campaign 50)
-
-    _ <- EM.addBlocksAndNotify [ExUtil.w1, ExUtil.w2, ExUtil.w3] 20
-
-    pure ()
diff --git a/plutus-tutorial/tutorial/Tutorial/Solutions1.hs b/plutus-tutorial/tutorial/Tutorial/Solutions1.hs
deleted file mode 100644
index 76cfc7becf8..00000000000
--- a/plutus-tutorial/tutorial/Tutorial/Solutions1.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Tutorial.Solutions1 where
-
-import qualified Data.Map                     as Map
-
-import qualified Language.PlutusTx            as PlutusTx
-import           Language.PlutusTx.Prelude
-import           Ledger                       (Address, DataScript(..), RedeemerScript(..), ValidatorScript(..), Value)
-import qualified Ledger                       as L
-import           Ledger.Validation            (PendingTx)
-import qualified Ledger.Ada                   as Ada
-import           Ledger.Ada                   (Ada)
-import           Wallet                       (WalletAPI(..), WalletDiagnostics(..))
-import qualified Wallet                       as W
-import qualified Wallet.Emulator.Types        as EM
-import qualified Wallet.API                   as WAPI
-
-import qualified Tutorial.ExUtil                as EXU
-import Tutorial.Emulator (SecretNumber(..), ClearNumber(..))
-
-{-
-
-    E1 (validator script)
-
--}
-intGameValidator :: ValidatorScript
-intGameValidator = ValidatorScript $$(L.compileScript [|| val ||])
-    where
-        val = \(SecretNumber actual) (ClearNumber guess') (_ :: PendingTx) -> actual `eq` (EXU.encode guess')
-
-gameAddress :: Address
-gameAddress = L.scriptAddress intGameValidator
-
-{-
-
-      E1 (lock endpoint) Note how we use the code, EXU.encode,
-      in on-chain and off-chain code. This is how code can be shared between
-      the two. Write once, run anywhere!
-
--}
-lock :: (WalletAPI m, WalletDiagnostics m) => Integer -> Ada -> m ()
-lock i adaVl = do
-    let secretInt = EXU.encode i
-        vl = Ada.toValue adaVl
-        ds = DataScript (L.lifted (SecretNumber secretInt))
-    W.payToScript_ W.defaultSlotRange gameAddress vl ds
diff --git a/plutus-tutorial/tutorial/Tutorial/Vesting.hs b/plutus-tutorial/tutorial/Tutorial/Vesting.hs
deleted file mode 100644
index 8b2f8bbd8d8..00000000000
--- a/plutus-tutorial/tutorial/Tutorial/Vesting.hs
+++ /dev/null
@@ -1,355 +0,0 @@
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
-{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
-{-
-    A vesting contract in Plutus
-
-    This is the fifth in a series of tutorials:
-
-    1. [Plutus Tx](../../doctest/Tutorial/01-plutus-tx.md)
-    2. [A guessing game](../../doctest/Tutorial/02-validator-scripts.md)
-    3. [A crowdfunding campaign](../../doctest/Tutorial/03-plutus-wallet-api.md)
-    4. [Working with the emulator](./Emulator.hs)
-    5. A multi-stage contract (this tutorial)
-
--}
-module Tutorial.Vesting where
-
-import           GHC.Generics              (Generic)
-import qualified Data.Map                  as Map
-import qualified Data.Set                  as Set
-
-import           Language.PlutusTx.Prelude
-import qualified Language.PlutusTx         as PlutusTx
-import           Ledger                    (Address, DataScript(..), RedeemerScript(..), Slot, TxOutRef, TxIn, ValidatorScript(..))
-import qualified Ledger                    as L
-import           Ledger.Ada                (Ada)
-import qualified Ledger.Ada                as Ada
-import qualified Ledger.Ada                as ATH
-import qualified Ledger.Interval           as Interval
-import qualified Ledger.Slot               as Slot
-import qualified Ledger.Validation         as V
-import qualified Ledger.Value              as Value
-import           Wallet                    (WalletAPI(..), WalletDiagnostics, PubKey)
-import qualified Wallet                    as W
-import qualified Wallet.API                as WAPI
-import qualified Wallet.Emulator.Types     as EM
-
-import           Tutorial.ExUtil
-
--- $setup
--- >>> import Tutorial.Vesting
-
-{- |
-    A vesting contract.
-
-    In this part of the tutorial we will implement a simple vesting scheme,
-    where money is locked by a contract and may only be retrieved after some
-    time has passed.
-
-    This is our first example of a contract that covers multiple transactions,
-    with a contract state that changes over time.
-
-    In our vesting scheme the money will be released in two _tranches_ (parts):
-    A smaller part will be available after an initial number of slots have
-    passed, and the entire amount will be released at the end. The owner of the
-    vesting scheme does not have to take out all the money at once: They can take out any amount up to the total that has been released so far. The remaining funds stay locked and can be retrieved later.
-
-    Let's start with the data types.
-
--}
-
--- | Tranche of a vesting scheme.
-data VestingTranche = VestingTranche {
-    vestingTrancheDate   :: Slot,
-    -- ^ When this tranche is released
-    vestingTrancheAmount :: Ada
-    -- ^ How much money is locked in this tranche
-    } deriving (Generic)
-
-PlutusTx.makeLift ''VestingTranche
-
--- | A vesting scheme consisting of two tranches. Each tranche defines a date
---   (slot) after which an additional amount of money can be spent.
-data Vesting = Vesting {
-    vestingTranche1 :: VestingTranche,
-    -- ^ First tranche
-
-    vestingTranche2 :: VestingTranche,
-    -- ^ Second tranche
-
-    vestingOwner    :: PubKey
-    -- ^ The recipient of the scheme (who is authorised to take out money once
-    --   it has been released)
-    } deriving (Generic)
-
-PlutusTx.makeLift ''Vesting
-
--- | The total amount of Ada locked by a vesting scheme
-totalVested :: Vesting -> Ada
-totalVested (Vesting l r _) = Ada.plus (vestingTrancheAmount l) (vestingTrancheAmount r)
-
-{- |
-
-    What should our data and redeemer scripts be? The vesting scheme only has a
-    single piece of information that we need to keep track of, namely how much
-    money is still locked in the contract. We can get this information from the
-    contract's transaction output, so we don't need to store it in the data
-    script. The type of our data script is therefore '()'.
-
-    The redeemer script usually carries the parameters of the action that is
-    performed on the contract. In this vesting scheme however, there is only
-    a single action (withdraw), and its only parameter is the amount withdrawn,
-    which we obtain by comparing the amounts locked in the scheme before and
-    after the transaction. Therefore the redeemer script is also of the unit
-    type '()'.
-
-    That gives our validator script the signature
-
-    `Vesting -> () -> () -> PendingTx -> ()`
-
--}
-
-
-vestingValidator :: Vesting -> ValidatorScript
-vestingValidator v = ValidatorScript val where
-    val = L.applyScript inner (L.lifted v)
-    inner = $$(L.compileScript [|| \(scheme :: Vesting) () () (p :: V.PendingTx) ->
-        let
-
-            Vesting tranche1 tranche2 owner = scheme
-            VestingTranche d1 a1 = tranche1
-            VestingTranche d2 a2 = tranche2
-
-            V.PendingTx _ _ _ _ _ range _ _ = p
-            -- range :: SlotRange, validity range of the pending transaction
-
-            -- We need the hash of this validator script in order to ensure
-            -- that the pending transaction locks the remaining amount of funds
-            -- at the contract address.
-            ownHash = V.ownHash p
-
-            -- The total amount of Ada that has been vested:
-            totalAmount :: Ada
-            totalAmount = ATH.plus a1 a2
-
-            -- It will be useful to know the amount of money that has been
-            -- released so far. This means we need to check the current slot
-            -- against the slots 'd1' and 'd2', defined in 'tranche1' and
-            -- 'tranche2' respectively. But the only indication of the current
-            -- time that we have is the 'range' value of the pending
-            -- transaction 'p', telling us that the current slot is one of the
-            -- slots contained in 'range'.
-            --
-            -- We can think of 'd1' as an interval as well: It is
-            -- the open-ended interval starting with slot 'd1'. At any point
-            -- during this interval we may take out up to 'a1' Ada.
-            d1Intvl = Interval.from d1
-
-            -- Likewise for 'd2'
-            d2Intvl = Interval.from d2
-
-            -- Now we can compare the validity range 'range' against our two
-            -- intervals. If 'range' is completely contained in 'd1Intvl', then
-            -- we know for certain that the current slot is in 'd1Intvl', so the
-            -- amount 'a1' of the first tranche has been released.
-            inD1Intvl = Slot.contains d1Intvl range
-
-            -- Likewise for 'd2'
-            inD2Intvl = Slot.contains d2Intvl range
-
-            released :: Ada
-            released
-                -- to compute the amount that has been released we need to
-                -- consider three cases:
-
-                -- If we are in d2Intvl then the current slot is greater than
-                -- or equal to 'd2', so everything has been released:
-                | inD2Intvl = totalAmount
-
-                -- If we are not in d2Intvl but in d1Intvl then only the first
-                -- tranche 'a1' has been released:
-                | inD1Intvl = a1
-
-                -- Otherwise nothing has been released yet
-                | True      = ATH.zero
-
-            -- And the following amount has not been released yet:
-            unreleased :: Ada
-            unreleased = ATH.minus totalAmount released
-
-            -- To check whether the withdrawal is legitimate we need to
-            -- 1. Ensure that the amount taken out does not exceed the current
-            --    limit
-            -- 2. Check whether the transaction has been signed by the vesting
-            --    owner
-            -- We will call these conditions con1 and con2.
-
-            -- con1 is true if the amount that remains locked in the contract
-            -- is greater than or equal to 'unreleased'. We use the
-            -- `adaLockedBy` function to get the amount of Ada paid by pending
-            -- transaction 'p' to the script address 'ownHash'.
-            con1 :: Bool
-            con1 =
-                let remainsLocked = V.adaLockedBy p ownHash
-                in ATH.geq remainsLocked unreleased
-
-            -- con2 is true if the pending transaction 'p' has  been signed
-            -- by the owner of the vesting scheme
-            con2 :: Bool
-            con2 = V.txSignedBy p owner
-
-        in con1 && con2
-        ||])
-
-contractAddress :: Vesting -> Address
-contractAddress vst = L.scriptAddress (vestingValidator vst)
-
-{- |
-
-    We need three endpoints:
-
-    * 'vestFunds' to lock the funds in a vesting scheme
-    * 'registerVestingScheme', used by the owner to start watching the scheme's address
-    * 'withdraw', used by the owner to take out some funds.
-
-    The first two are very similar to endpoints we defined for earlier
-    contracts.
-
--}
-
-vestFunds :: (Monad m, WalletAPI m) => Vesting -> m ()
-vestFunds vst = do
-    let amt = Ada.toValue (totalVested vst)
-        adr = contractAddress vst
-        dataScript = DataScript (L.lifted ())
-    W.payToScript_ W.defaultSlotRange adr amt dataScript
-
-registerVestingScheme :: (WalletAPI m) =>  Vesting -> m ()
-registerVestingScheme vst = startWatching (contractAddress vst)
-
-{- |
-
-    The last endpoint, `withdraw`, is different. We need to create a
-    transaction that spends the contract's current unspent transaction output
-    *and* puts the Ada that remains back at the script address.
-
--}
-withdraw :: (Monad m, WalletAPI m) => Vesting -> Ada -> m ()
-withdraw vst vl = do
-
-    let address = contractAddress vst
-        validator = vestingValidator vst
-
-    -- We are going to use the wallet API to build the transaction "by hand",
-    -- that is without using 'collectFromScript'.
-    -- The signature of 'createTxAndSubmit' is
-    -- 'SlotRange -> Set.Set TxIn -> [TxOut] -> m Tx'. So we need a slot range,
-    -- a set of inputs and a list of outputs.
-
-    -- The transaction's validity range should begin with the current slot and
-    -- last indefinitely.
-    range <- fmap WAPI.intervalFrom WAPI.slot
-
-    -- The input should be the UTXO of the vesting scheme. We can get the
-    -- outputs at an address (as far as they are known by the wallet) with
-    -- `outputsAt`, which returns a map of 'TxOutRef' to 'TxOut'.
-    utxos <- WAPI.outputsAt address
-
-    let
-        -- the redeemer script containing the unit value ()
-        redeemer  = RedeemerScript (L.lifted ())
-
-        -- Turn the 'utxos' map into a set of 'TxIn' values
-        mkIn :: TxOutRef -> TxIn
-        mkIn r = L.scriptTxIn r validator redeemer
-
-        ins = Set.map mkIn (Map.keysSet utxos)
-
-    -- Our transaction has either one or two outputs.
-    -- If the scheme is finished (no money is left in it) then
-    -- there is only one output, a pay-to-pubkey output owned by
-    -- us.
-    -- If any money is left in the scheme then there will be an additional
-    -- pay-to-script output locked by the vesting scheme's validator script
-    -- that keeps the remaining value.
-
-    -- We can create a public key output to our own key with 'ownPubKeyTxOut'.
-    ownOutput <- W.ownPubKeyTxOut (Ada.toValue vl)
-
-    -- Now to compute the difference between 'vl' and what is currently in the
-    -- scheme:
-    let
-        currentlyLocked = Map.foldr (\txo vl' -> vl' `Value.plus` L.txOutValue txo) Value.zero utxos
-        remaining = currentlyLocked `Value.minus` (Ada.toValue vl)
-
-        otherOutputs = if Value.eq Value.zero remaining
-                       then []
-                       else [L.scriptTxOut remaining validator (DataScript (L.lifted ()))]
-
-    -- Finally we have everything we need for `createTxAndSubmit`
-    _ <- WAPI.createTxAndSubmit range ins (ownOutput:otherOutputs)
-
-    pure ()
-
-{- |
-
-    With the endpoints defined we can write a trace for a successful run of the
-    scheme, in which we take out a small amount after the first tranche has
-    been released.
-
--}
-
-vestingSuccess :: (WalletAPI m, WalletDiagnostics m) => EM.Trace m ()
-vestingSuccess = do
-
-    -- The scheme, saving a total of 60 Ada for pk1
-    let scheme = Vesting
-                    (VestingTranche 5  (Ada.fromInt 20))
-                    (VestingTranche 10 (Ada.fromInt 40))
-                    pk1
-
-    -- 1. Wallet 'w1' starts watching the contract address using the
-    --    'registerVestingScheme' endpoint.
-    _ <- EM.walletAction w1 (registerVestingScheme scheme)
-
-    -- -- 2. Wallet 'w2' locks 60 ada in the scheme
-    _ <- EM.walletAction w2 (vestFunds scheme)
-
-    -- 3. Process this transaction and notify all wallets. Here we add a total
-    --    of five blocks so that the first tranche is released.
-    _ <- EM.addBlocksAndNotify [w1, w2] 5
-
-    -- 4. 'w1' withdraws 10 Ada
-    _ <- EM.walletAction w1 (withdraw scheme (Ada.fromInt 10))
-
-    -- 5. Process this transaction and notify all wallets
-    _ <- EM.addBlocksAndNotify [w1, w2] 1
-
-    -- Done.
-    pure ()
-
-{- |
-
-    E8. Run the `vestingSuccess` trace in the emulator. You can use the
-        functions `runTraceDist` and `runTraceLog` from `Ledger.ExUtil`
-    >>> import Tutorial.ExUtil
-    >>> runTraceDist vestingSuccess
-    fromList [(Wallet {getWallet = 1},Value {getValue = Map {unMap = [(,Map {unMap = [(,1010)]})]}}),(Wallet {getWallet = 2},Value {getValue = Map {unMap = [(,Map {unMap = [(,940)]})]}}),(Wallet {getWallet = 3},Value {getValue = Map {unMap = [(,Map {unMap = [(,1000)]})]}})]
-
-
-    E9. Write traces similar to `vestingSuccess` that
-
-        * Take out all the funds after 10 slots
-        * Take out 10 Ada after 5 blocks and the rest at the end
-        * Take out all the funds at the beginning (inspect the logs to convince
-        yourself that it failed)
-
-    E10. Write an extended version of `registerVestingScheme` that also
-         registers a trigger to collect the remaining funds at the end of the
-         scheme.
-
--}

From ebe7cc948cb91788276ff7c1321070705315ef69 Mon Sep 17 00:00:00 2001
From: Michael Peyton Jones <michael.peyton-jones@iohk.io>
Date: Wed, 5 Jun 2019 16:16:37 +0100
Subject: [PATCH 7/8] Address review comments

---
 plutus-tutorial/doc/01-plutus-tx.adoc         | 11 +++++++----
 plutus-tutorial/doc/02-validator-scripts.adoc |  1 +
 plutus-tutorial/doc/03-wallet-api.adoc        |  4 ++--
 plutus-tutorial/doc/index.adoc                |  2 +-
 4 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/plutus-tutorial/doc/01-plutus-tx.adoc b/plutus-tutorial/doc/01-plutus-tx.adoc
index bce4ee1a022..5439847bee3 100644
--- a/plutus-tutorial/doc/01-plutus-tx.adoc
+++ b/plutus-tutorial/doc/01-plutus-tx.adoc
@@ -49,9 +49,11 @@ import Data.Text.Prettyprint.Doc -- <4>
 <4> Used for examples.
 
 Plutus Tx makes some use of Template Haskell. There are a few reasons
-for this: - Template Haskell allows us to do work at compile time, which
-is when we do Plutus Tx compilation. - It allows us to wire up the
-machinery that actually invokes the Plutus Tx compiler.
+for this:
+
+. Template Haskell allows us to do work at compile time, which
+is when we do Plutus Tx compilation.
+. It allows us to wire up the machinery that actually invokes the Plutus Tx compiler.
 
 Consequently, we will see some use of Template Haskell quotes. A
 Template Haskell quote is introduced with the special brackets `[||` and
@@ -142,7 +144,7 @@ So far, so familiar: we compiled a lambda into a lambda (the "lam").
 
 == Functions and datatypes
 
-You can also use functions inside your expression. In practice, you may
+You can also use functions inside your expression. In practice, you
 will usually want to define the entirety of your Plutus Tx program as a
 definition outside the quote, and then simply call it inside the quote.
 
@@ -287,6 +289,7 @@ generate these with the `makeLift` TH function from
 `Language.PlutusTx.Lift`. Lifting makes it easy to use the same types
 both inside your Plutus Tx program and in the external code that uses
 it.
+
 NOTE: `unsafeLiftCode` is "unsafe" because it ignores any errors that might occur from
 lifting something that isn't supported.
 
diff --git a/plutus-tutorial/doc/02-validator-scripts.adoc b/plutus-tutorial/doc/02-validator-scripts.adoc
index c4a50bd18a0..ecd5d27e397 100644
--- a/plutus-tutorial/doc/02-validator-scripts.adoc
+++ b/plutus-tutorial/doc/02-validator-scripts.adoc
@@ -297,6 +297,7 @@ If you change the word "plutus" in the third item of the trace to
 
 image:game-logs.PNG[Emulator log for a failed attempt]
 
+[#02-exercises]
 == Exercises
 
 [arabic]
diff --git a/plutus-tutorial/doc/03-wallet-api.adoc b/plutus-tutorial/doc/03-wallet-api.adoc
index e7f074bd9b5..0e18cbc0d37 100644
--- a/plutus-tutorial/doc/03-wallet-api.adoc
+++ b/plutus-tutorial/doc/03-wallet-api.adoc
@@ -497,8 +497,8 @@ the crowdfunding contribution we need to hold on the transaction. Why?
 Think back to the `guess` action of the game. We used
 link:{wallet-api-haddock}/Wallet-API.html#v:collectFromScript[`collectFromScript`]
 to collect _all_ outputs at the game address. This works only if all all
-outputs are unlocked by the same redeemer (see also exercise 3 of the
-previous tutorial).
+outputs are unlocked by the same redeemer (see also xref:02-exercises[exercise 3 of the
+previous tutorial]).
 
 In our crowdfunding campaign, the redeemer is a signed `Action`. In case
 of a refund, we sign the `Refund` action with our public key, allowing
diff --git a/plutus-tutorial/doc/index.adoc b/plutus-tutorial/doc/index.adoc
index ce0f89a8c58..bef8c7a8d96 100644
--- a/plutus-tutorial/doc/index.adoc
+++ b/plutus-tutorial/doc/index.adoc
@@ -23,7 +23,7 @@
 // https://github.com/asciidoctor/asciidoctor/issues/1066
 :2c: ::
 :playground: https://prod.playground.plutus.iohkdev.io/
-:haddock: https://input-output-hk.github.io/plutus/
+:haddock: https://input-output-hk.github.io/plutus
 :wallet-api-haddock: {haddock}/plutus-wallet-api-0.1.0.0/html
 
 include::overview.adoc[leveloffset=+ 1]

From 1c4b0ab60c1446dd3579e99c25fe15003d31d754 Mon Sep 17 00:00:00 2001
From: Michael Peyton Jones <michael.peyton-jones@iohk.io>
Date: Thu, 6 Jun 2019 11:13:50 +0100
Subject: [PATCH 8/8] Fix a couple of links

---
 plutus-tutorial/doc/03-wallet-api.adoc | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/plutus-tutorial/doc/03-wallet-api.adoc b/plutus-tutorial/doc/03-wallet-api.adoc
index 0e18cbc0d37..19e320419ca 100644
--- a/plutus-tutorial/doc/03-wallet-api.adoc
+++ b/plutus-tutorial/doc/03-wallet-api.adoc
@@ -489,7 +489,7 @@ refund.
 
 To contribute to a campaign we need to pay the desired amount to a
 script address, and provide our own public key as the data script. In
-the link:./02-validator-scripts.md[guessing game] we used
+the link:./02-validator-scripts#validator-scripts[guessing game] we used
 link:{wallet-api-haddock}/Wallet-API.html#v:payToScript_[`payToScript_`],
 which returns `()` instead of the transaction that was submitted. For
 the crowdfunding contribution we need to hold on the transaction. Why?
@@ -630,8 +630,8 @@ the same way as all other software we can use the same tools
 having to set up additional infrastructure.
 
 We plan to write a tutorial on this soon. Until then we would like to
-refer you to the test suite in
-link:../../../plutus-use-cases/test/Spec/Crowdfunding.hs[Crowdfunding.hs].
+refer you to the test suite in the `plutus-use-cases` project in the Plutus
+repository.
 
 You can run the test suite with
 `nix build -f default.nix localPackages.plutus-use-cases` or