Skip to content

Instantly share code, notes, and snippets.

@shmish111

shmish111/Main.hs

Created January 6, 2021 14:29
Show Gist options
  • Save shmish111/48cdd6f9f6dc55d2f73e9eaf340130fd to your computer and use it in GitHub Desktop.
Save shmish111/48cdd6f9f6dc55d2f73e9eaf340130fd to your computer and use it in GitHub Desktop.
Download ZIP
Untitled Project
Raw
blockly.xml
<xml xmlns="https://developers.google.com/blockly/xml"><block type="BaseContractType" id="root_contract" deletable="false" x="10" y="50"><statement name="BaseContractType"><block type="WhenContractType" id="3~qQ4c41Wyr{Pti`y{3o"><field name="timeout">10</field><statement name="case"><block type="DepositActionType" id="|c#RE4y.10DDC6w6hcb*"><value name="from_party"><block type="RolePartyType" id="wW|}RrkG3=bt~Bp|ww|K"><field name="role">alice</field></block></value><value name="value"><block type="ConstantValueType" id="X-!na%oj)-KDc,dVpu!0"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id=",4!h-ip.s:b@if)j8,[W"/></value><value name="party"><block type="RolePartyType" id="k{r,FWUfsILrM5F|NZ9("><field name="role">alice</field></block></value><statement name="contract"><block type="WhenContractType" id="yYq9,iYiTKJj2d[::nCP"><field name="timeout">40</field><statement name="case"><block type="ChoiceActionType" id="Jw36?~VSBY5!.L?~8{)z"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="r/I-,;1[E3:O0W7o5+[N"><field name="role">alice</field></block></value><statement name="bounds"><block type="BoundsType" id="aQTlD~ei%!:|OD-b2m[,"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="WhenContractType" id="!WSA{UmXvdaVecKjEJP$"><field name="timeout">60</field><statement name="case"><block type="ChoiceActionType" id="z^FE0UrJM@ui7|:+a:J*"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="#c+!|Ux{wQTN.Yt$YWN}"><field name="role">bob</field></block></value><statement name="bounds"><block type="BoundsType" id="@;ttsS~2g=($Y%dp7,=w"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="IfContractType" id="fy}yhDYvZ(ER5.mJ2/js"><value name="observation"><block type="ValueEQObservationType" id="EqHmq2A-V4za:A0^4I`B"><value name="value1"><block type="ChoiceValueValueType" id="*P-@9i4kK%{rUwq0YcZ;"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="Ex#5eTLzS^9d%{yVI]!r"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ChoiceValueValueType" id="Y#1d$`,gOm+g1w,Y/io="><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="fVZj3|WyMytD?4)j9Uj$"><field name="role">bob</field></block></value></block></value></block></value><statement name="contract1"><block type="IfContractType" id="cQelPFPkpC@p/IX0VU4c"><value name="observation"><block type="ValueEQObservationType" id="+UC7!IpzNEYQvf/TRA3q"><value name="value1"><block type="ChoiceValueValueType" id="4MbCLDRe.*gM_I6XmQ(V"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="%vpIv8yXI`+iPMCJ@ub/"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ConstantValueType" id="}JCH?gzZS57}oj5inkD{"><field name="constant">0</field></block></value></block></value><statement name="contract1"><block type="PayContractType" id="D_eLb/Ii~uo6Eq*l-s;T"><value name="payee"><block type="PartyPayeeType" id="TPwBch0~l:v}K0cReg;x"><value name="party"><block type="RolePartyType" id="W~~8)A{jh.ADAs82yW~L"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="mDx-rPqN/xIqv?{tL@,x"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="T.$#Cyx:_zp/#Nf3f1Q,"/></value><value name="party"><block type="RolePartyType" id="Sc9F6F^,rRJJ;/v@xNfL"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="vQW2cBa41?mj_P{lc_r7"/></statement></block></statement><statement name="contract2"><block type="CloseContractType" id="io{oomBY@])9^NIXjqdI"/></statement></block></statement><statement name="contract2"><block type="WhenContractType" id="E[[Lh*jy1gJzfz|aWtjA"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="/B^wfP8{dI.t2sRke7*R"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="Q6a]?XU2Sz9Z+Zq!!(Gs"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="S4|La9DP+hmOx-4G(Lnn"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="[)%??2_@wy}Clrs9-g]u"/></statement><next><block type="ChoiceActionType" id="!H}hxJpgso@pIATVl#Ui"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="{C?CZ!eB6T6nph}lYQ)l"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="/QMh=M_nagNBj|fSDI:c"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="[28)Z^2E$c?3U],4-^v{"><value name="payee"><block type="PartyPayeeType" id="S+d+Y#VgtxL,m|aa]E{Z"><value name="party"><block type="RolePartyType" id="^rn)AovIKxyAC$THl}}!"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="OuJC*dQ+J5C9g`Onc~Be"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="5^/_8fyh1Rjv%T|P%n(2"/></value><value name="party"><block type="RolePartyType" id="~/j`d)R?AZM/+noieVX4"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="!Kj^X3SMi%ge2J{1FkE2"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id=",Ctc78xKN4^/7tuMZBAM"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="t[M=k]/AXpN]s7`d6o+b"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="*a^FN?54Y/H]_S|4Zyng"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="9kBduFR#NsdJ%X?S@d;i"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="yVDNk@NL4u}lpk#I5;B?"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="h=O_!#k!H4^b:,|oP?0b"/></statement><next><block type="ChoiceActionType" id="7Kao!(AugViqXs]TLG{G"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="q}i7ZW9_saxAD^;UKD8G"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="sE8[J5wb[df`W7}Os|p8"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="-H;h:dv.Hg60PN@-3uip"><value name="payee"><block type="PartyPayeeType" id="]NmQhn1zG.f9UjF4I$[S"><value name="party"><block type="RolePartyType" id="ZN}ecN/`.JTLFB_I,1zu"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="Qg5S`2w;qyUT~IlNXl-$"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="+PRC7n}|PcLcbO:k3DHP"/></value><value name="party"><block type="RolePartyType" id="kmY6mx{:T$Icm5lIn+#n"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id=")/y;x|$R4D7CV=d^S_N~"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="GDF=^DENZd$4ptuP17;w"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="8Re,Rj*s.bv*Bz*|e2B_"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="Ec;^NB%Xeh0Vza]k,}PW"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="LW4Qd%In`TQBin5nv^5]"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="v`PF-U%^]w!,+Z@Bg3Sh"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="@QcI2s7s;*oz0Fdc=tr!"/></statement><next><block type="ChoiceActionType" id="5+cq_F]S,DsbW1.sY2#6"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="OIh-c.DM3nadJWa1Icj?"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="[?4Im1^W{^aH$RkHc~DZ"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="IK1Hf^AxyP%DrFU@ej!9"><value name="payee"><block type="PartyPayeeType" id="jQ.=[cwn/hIjk=kJzey|"><value name="party"><block type="RolePartyType" id="}v438Lb_R_wI~H9-ADqN"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id=".[a*N3XiglA/U?tHkMA%"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="T]x#(7O#FB/}Ql{2hs!v"/></value><value name="party"><block type="RolePartyType" id="OFwda5@DQeb..Ds3#VY4"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id=":~%)s2^{jSCN`14xW}u("/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="fuBQRkrt_SF).V27T!mW"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="CloseContractType" id="w?4~t!BTrX7b4loV)hH("/></statement></block></statement></block></xml>
Raw
Main.hs
{-# LANGUAGE OverloadedStrings #-}
module Escrow where
import Language.Marlowe
main :: IO ()
main = print . pretty $ contract
{- What does the vanilla contract look like?
- if Alice and Bob choose
- and agree: do it
- and disagree: Carol decides
- Carol also decides if timeout after one choice has been made;
- refund if no choices are made.
-}
contract :: Contract
contract = When [Case (Deposit "alice" "alice" ada price) inner]
10
Close
inner :: Contract
inner =
When [ Case aliceChoice
(When [ Case bobChoice
(If (aliceChosen `ValueEQ` bobChosen)
agreement
arbitrate) ]
60
arbitrate)
]
40
arbitrate
-- The contract to follow when Alice and Bob have made the same choice.
agreement :: Contract
agreement =
If
(aliceChosen `ValueEQ` Constant 0)
(Pay "alice" (Party "bob") ada price Close)
Close
-- The contract to follow when Alice and Bob disagree, or if
-- Carol has to intervene after a single choice from Alice or Bob.
arbitrate :: Contract
arbitrate =
When [ Case carolRefund Close,
Case carolPay (Pay "alice" (Party "bob") ada price Close) ]
100
Close
-- Names for choices
pay,refund,both :: [Bound]
pay = [Bound 0 0]
refund = [Bound 1 1]
both = [Bound 0 1]
-- helper function to build Actions
choiceName :: ChoiceName
choiceName = "choice"
choice :: Party -> [Bound] -> Action
choice party = Choice (ChoiceId choiceName party)
-- Name choices according to person making choice and choice made
alicePay, aliceRefund, aliceChoice, bobPay, bobRefund, bobChoice, carolPay, carolRefund, carolChoice :: Action
alicePay = choice "alice" pay
aliceRefund = choice "alice" refund
aliceChoice = choice "alice" both
bobPay = choice "bob" pay
bobRefund = choice "bob" refund
bobChoice = choice "bob" both
carolPay = choice "carol" pay
carolRefund = choice "carol" refund
carolChoice = choice "carol" both
-- the values chosen in choices
aliceChosen, bobChosen :: (Value Observation)
aliceChosen = ChoiceValue (ChoiceId choiceName "alice")
bobChosen = ChoiceValue (ChoiceId choiceName "bob")
defValue :: (Value Observation)
defValue = Constant 42
-- Value under escrow
price :: (Value Observation)
price = Constant 450
Raw
playground.js
/* Parties */
const alice : Party = Role("alice");
const bob : Party = Role("bob");
const carol : Party = Role("carol");
/* Value under escrow */
const price : SomeNumber = 450n;
/* helper function to build Actions */
const choiceName : string = "choice";
const choiceIdBy = function (party : Party) : ChoiceId {
return ChoiceId(choiceName, party);
}
const choiceBy = function(party : Party, bounds : [Bound]) : Action {
return Choice(choiceIdBy(party), bounds);
};
const choiceValueBy = function(party : Party) : Value {
return ChoiceValue(choiceIdBy(party));
};
/* Names for choices */
const pay : [Bound] = [Bound(0n, 0n)];
const refund : [Bound] = [Bound(1n, 1n)];
const both : [Bound] = [Bound(0n, 1n)];
/* Name choices according to person making choice and choice made */
const alicePay : Action = choiceBy(alice, pay);
const aliceRefund : Action = choiceBy(alice, refund);
const aliceChoice : Action = choiceBy(alice, both);
const bobPay : Action = choiceBy(bob, pay);
const bobRefund : Action = choiceBy(bob, refund);
const bobChoice : Action = choiceBy(bob, both);
const carolPay : Action = choiceBy(carol, pay);
const carolRefund : Action = choiceBy(carol, refund);
const carolChoice : Action = choiceBy(carol, both);
/* the values chosen in choices */
const aliceChosen : Value = choiceValueBy(alice);
const bobChosen : Value = choiceValueBy(bob);
/* The contract to follow when Alice and Bob disagree, or if
Carol has to intervene after a single choice from Alice or Bob. */
const arbitrate : Contract = When([Case(carolRefund, Close),
Case(carolPay, Pay(alice, Party(bob), ada, price, Close))],
100n, Close);
/* The contract to follow when Alice and Bob have made the same choice. */
const agreement : Contract = If(ValueEQ(aliceChosen, 0n),
Pay(alice, Party(bob), ada, price, Close),
Close);
/* Inner part of contract */
const inner : Contract = When([Case(aliceChoice,
When([Case(bobChoice,
If(ValueEQ(aliceChosen, bobChosen),
agreement,
arbitrate))],
60n, arbitrate))],
40n, Close);
/* What does the vanilla contract look like?
- if Alice and Bob choose
- and agree: do it
- and disagree: Carol decides
- Carol also decides if timeout after one choice has been made;
- refund if no choices are made. */
const contract : Contract = When([Case(Deposit(alice, alice, ada, price), inner)],
10n,
Close)
return contract;
Raw
playground.marlowe
When
[Case
(Deposit
(Role "alice")
(Role "alice")
(Token "" "")
(Constant 450)
)
(When
[Case
(Choice
(ChoiceId
"choice"
(Role "alice")
)
[Bound 0 1]
)
(When
[Case
(Choice
(ChoiceId
"choice"
(Role "bob")
)
[Bound 0 1]
)
(If
(ValueEQ
(ChoiceValue
(ChoiceId
"choice"
(Role "alice")
))
(ChoiceValue
(ChoiceId
"choice"
(Role "bob")
))
)
(If
(ValueEQ
(ChoiceValue
(ChoiceId
"choice"
(Role "alice")
))
(Constant 0)
)
(Pay
(Role "alice")
(Party (Role "bob"))
(Token "" "")
(Constant 450)
Close
)
Close
)
(When
[Case
(Choice
(ChoiceId
"choice"
(Role "carol")
)
[Bound 1 1]
)
Close , Case
(Choice
(ChoiceId
"choice"
(Role "carol")
)
[Bound 0 0]
)
(Pay
(Role "alice")
(Party (Role "bob"))
(Token "" "")
(Constant 450)
Close
)]
100 Close
)
)]
60
(When
[Case
(Choice
(ChoiceId
"choice"
(Role "carol")
)
[Bound 1 1]
)
Close , Case
(Choice
(ChoiceId
"choice"
(Role "carol")
)
[Bound 0 0]
)
(Pay
(Role "alice")
(Party (Role "bob"))
(Token "" "")
(Constant 450)
Close
)]
100 Close
)
)]
40 Close
)]
10 Close
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment