-
Notifications
You must be signed in to change notification settings - Fork 2
/
multi-pay.hs
28 lines (22 loc) · 904 Bytes
/
multi-pay.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
{-# LANGUAGE OverloadedStrings #-}
import Language.Marlowe.Extended
main :: IO ()
main = printJSON $ contract ["Giver1", "Giver2", "Giver3", "Giver4", "Giver5"] "Receiver" (ConstantParam "Deposit") (TimeParam "Deadline")
contract :: [Party] -> Party -> Value -> Timeout -> Contract
contract givers receiver amount deadline = go givers
where
go :: [Party] -> Contract
go ps = case picks' of
[] -> payments givers
_ : _ -> When [Case (deposit q) $ go qs | (q, qs) <- picks'] deadline Close
where
picks' :: [(Party, [Party])]
picks' = picks ps
deposit :: Party -> Action
deposit p = Deposit p p ada amount
payments :: [Party] -> Contract
payments [] = Close
payments (q : qs) = Pay q (Party receiver) ada amount $ payments qs
picks :: [a] -> [(a, [a])]
picks [] = []
picks (x : xs) = (x, xs) : [(y, x : ys) | (y, ys) <- picks xs]