mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-22 06:42:00 +01:00
solution for week 9
This commit is contained in:
parent
9c86f2370b
commit
0ed63b526d
4 changed files with 88 additions and 0 deletions
10
README.md
10
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.
|
||||
|
|
47
code/week09/app/solution.hs
Normal file
47
code/week09/app/solution.hs
Normal file
|
@ -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
|
||||
)
|
6
code/week09/hie.yaml
Normal file
6
code/week09/hie.yaml
Normal file
|
@ -0,0 +1,6 @@
|
|||
cradle:
|
||||
cabal:
|
||||
- path: "./app/marlowe.hs"
|
||||
component: "exe:marlowe"
|
||||
- path: "./app/solution.hs"
|
||||
component: "exe:solution"
|
25
code/week09/plutus-pioneer-program-week09.cabal
Normal file
25
code/week09/plutus-pioneer-program-week09.cabal
Normal file
|
@ -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
|
Loading…
Reference in a new issue