From 0ed63b526d2218f7652911654386d35bddabeb29 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Lars=20Br=C3=BCnjes?= <brunjlar@gmail.com>
Date: Thu, 3 Jun 2021 01:15:15 +0200
Subject: [PATCH] solution for week 9

---
 README.md                                     | 10 ++++
 code/week09/app/solution.hs                   | 47 +++++++++++++++++++
 code/week09/hie.yaml                          |  6 +++
 .../plutus-pioneer-program-week09.cabal       | 25 ++++++++++
 4 files changed, 88 insertions(+)
 create mode 100644 code/week09/app/solution.hs
 create mode 100644 code/week09/hie.yaml
 create mode 100644 code/week09/plutus-pioneer-program-week09.cabal

diff --git a/README.md b/README.md
index 9fc4ee3..09b8d5e 100644
--- a/README.md
+++ b/README.md
@@ -138,6 +138,16 @@
   - [`RockPaperScissors`](code/week07/src/Week07/RockPaperScissors.hs)
   - [`TestRockPaperScissors`](code/week07/src/Week07/TestRockPaperScissors.hs)
 
+- Week #8
+
+  - [`TokenSaleWithClose`](code/week08/src/Week08/TokenSaleWithClose.hs)
+  - [`ModelWithClose`](code/week08/test/Spec/ModelWithClose.hs)
+  - [`TraceWithClose`](code/week08/test/Spec/TraceWithClose.hs)
+
+- Week #9
+
+  - [`solution`](code/week09/app/solution.hs)
+
 ## Some Plutus Modules
 
 - [`Plutus.Contract.StateMachine`](https://github.com/input-output-hk/plutus/blob/master/plutus-contract/src/Plutus/Contract/StateMachine.hs), contains types and functions for using state machines.
diff --git a/code/week09/app/solution.hs b/code/week09/app/solution.hs
new file mode 100644
index 0000000..0cfe0df
--- /dev/null
+++ b/code/week09/app/solution.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+import Language.Marlowe.Extended
+
+main :: IO ()
+main = print . pretty $ contract "Alice" "Bob" "Charlie" $ Constant 10
+
+choiceId :: Party -> ChoiceId
+choiceId = ChoiceId "Winner"
+
+contract :: Party -> Party -> Party -> Value -> Contract
+contract alice bob charlie deposit =
+    When
+        [Case (Deposit charlie charlie ada $ AddValue deposit deposit) $
+            When
+                [ f alice bob
+                , f bob alice
+                ]
+                20 Close
+        ]
+        10 Close
+  where
+    f :: Party -> Party -> Case
+    f x y =
+        Case
+            (Deposit x x ada deposit
+            )
+            (When
+                [Case
+                    (Deposit y y ada deposit
+                    )
+                    (When
+                        [Case
+                            (Choice (choiceId charlie) [Bound 1 2]
+                            )
+                            (If
+                                (ValueEQ (ChoiceValue $ choiceId charlie) (Constant 1)
+                                )
+                                (Pay bob (Account alice) ada deposit Close)
+                                (Pay alice (Account bob) ada deposit Close)
+                            )]
+                        40
+                        (Pay charlie (Account alice) ada deposit $
+                         Pay charlie (Account bob)   ada deposit
+                         Close)
+                    )]
+                30 Close
+            )
diff --git a/code/week09/hie.yaml b/code/week09/hie.yaml
new file mode 100644
index 0000000..a9ce8cc
--- /dev/null
+++ b/code/week09/hie.yaml
@@ -0,0 +1,6 @@
+cradle:
+  cabal:
+    - path: "./app/marlowe.hs"
+      component: "exe:marlowe"
+    - path: "./app/solution.hs"
+      component: "exe:solution"
diff --git a/code/week09/plutus-pioneer-program-week09.cabal b/code/week09/plutus-pioneer-program-week09.cabal
new file mode 100644
index 0000000..e1ae9da
--- /dev/null
+++ b/code/week09/plutus-pioneer-program-week09.cabal
@@ -0,0 +1,25 @@
+Cabal-Version:      2.4
+Name:               plutus-pioneer-program-week09
+Version:            0.1.0.0
+Author:              Lars Bruenjes
+Maintainer:          brunjlar@gmail.com
+Build-Type:          Simple
+Copyright:           © 2021 Lars Bruenjes
+License:             Apache-2.0
+License-files:       LICENSE
+
+executable marlowe
+  hs-source-dirs:      app
+  main-is:             marlowe.hs
+  build-depends:       base ^>=4.14.1.0
+                     , marlowe
+  default-language:    Haskell2010
+  ghc-options:         -Wall -O2
+
+executable solution
+  hs-source-dirs:      app
+  main-is:             solution.hs
+  build-depends:       base ^>=4.14.1.0
+                     , marlowe
+  default-language:    Haskell2010
+  ghc-options:         -Wall -O2