Skip to content

Instantly share code, notes, and snippets.

@shmish111

shmish111/Main.hs

Created January 6, 2021 14:32
Show Gist options
  • Save shmish111/e90fa8da1ca1ba27118dd6c5f0b6fe9a to your computer and use it in GitHub Desktop.
Save shmish111/e90fa8da1ca1ba27118dd6c5f0b6fe9a 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="13" y="187"><statement name="BaseContractType"><block type="WhenContractType" id="?rWRIpwQN6Lh(howZmcr"><field name="timeout">10</field><statement name="case"><block type="DepositActionType" id="f_{lW^],]^)LD`Ce^#HS"><value name="from_party"><block type="RolePartyType" id="`pCu2WvMEhUvz)og-IcC"><field name="role">alice</field></block></value><value name="value"><block type="ConstantValueType" id="`3V0L[[ndPM-Xq3%_GC{"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="RD8!jdnHQ%Oj0DjPa`jg"/></value><value name="party"><block type="RolePartyType" id=":#x,[n-JO/,]N@RoHK=l"><field name="role">alice</field></block></value><statement name="contract"><block type="WhenContractType" id="nbG8E}f5?NjRY4R%Z+2T"><field name="timeout">40</field><statement name="case"><block type="ChoiceActionType" id="tP%|(y-voZiTkn*+G):Z"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="b-pD7u~R8?S4y{yn[jK4"><field name="role">alice</field></block></value><statement name="bounds"><block type="BoundsType" id="yia/TJ~d1S}vgyD|btvJ"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="WhenContractType" id="1kTQhCV~@j6K3{ot94!,"><field name="timeout">60</field><statement name="case"><block type="ChoiceActionType" id="S(Ay+yr@Q9)B7GdayxFy"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="c~adUm~(csz:mk79JS0F"><field name="role">bob</field></block></value><statement name="bounds"><block type="BoundsType" id="M2gR?Lwt]Y16Wo!z6LdD"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="IfContractType" id="jYM$,^QiFl1v2Q8z7v/A"><value name="observation"><block type="ValueEQObservationType" id="L*37U0;}W@H);)X;b^}`"><value name="value1"><block type="ChoiceValueValueType" id="v?c68eg5^xRGSNkj9;n|"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id=")U_$#(sc`;Q/%Z^GFV2;"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ChoiceValueValueType" id="]}Ql#q@,mp24S]W4:ULR"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="(`@y0VfJ^:53zj;fCH(M"><field name="role">bob</field></block></value></block></value></block></value><statement name="contract1"><block type="IfContractType" id="(G_-P?-R$Sx^;D72zO%U"><value name="observation"><block type="ValueEQObservationType" id="AYvFGXi}Xu74vboy_oJW"><value name="value1"><block type="ChoiceValueValueType" id="6)g3u[2(KXGAfOWZj4;d"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="Ba6${v?yUm[LsnR7b7Oc"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ConstantValueType" id="o)$na2X#qJQL~!9cq@,r"><field name="constant">0</field></block></value></block></value><statement name="contract1"><block type="PayContractType" id="gkw[,M:rn;Igklq+bfu}"><value name="payee"><block type="PartyPayeeType" id="@UJ:VWdfD|]xaQ1TPf4="><value name="party"><block type="RolePartyType" id="9/wKEan3I/..U6??x8;y"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="pM(OE3D|EavK;Eai{uWm"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="Nqu9BI/N3tOB,GCj-b,4"/></value><value name="party"><block type="RolePartyType" id="BeTF[{#OO7EoCxUKeZW5"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="%vPhYzz|!fb4l2@I/%)-"/></statement></block></statement><statement name="contract2"><block type="CloseContractType" id="{pAJyY)8;17i-tkj=4IH"/></statement></block></statement><statement name="contract2"><block type="WhenContractType" id="N%bj{=/6kdT.(~ATGYh@"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="[tmt(PRzhs$@h0sl.[aV"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="*UFwr3OR!{c)9qP*J!dR"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="!g;s[bQL}eaM`fCfA6j]"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="Mr7F@Sb=mVGR,W6N96-f"/></statement><next><block type="ChoiceActionType" id="LXcSP=hWA@/#Wa57+{eq"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="0@T!cTXt8.z[]BT;6p%-"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="8?XhB4!Shn~H=LcQie|`"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="M;3,EL#F!@f?]x56]QM="><value name="payee"><block type="PartyPayeeType" id="L`F6C0`11;61|X@_5I2-"><value name="party"><block type="RolePartyType" id="J#b@u5!x3pv^e(o#8{n6"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="QS8%S7KCd0mXYd_O{J;3"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="86@R;in3qV@=BsOcjnj|"/></value><value name="party"><block type="RolePartyType" id="__@*8RnM$wQ^Q`HH23dR"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="VfibC}6Cy]MD!d1$Xe)o"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="a2W]%k3uAAT8.NQ$r15o"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="BQdh,7Yz?h71b+[i3Bmq"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="/|,,jr]8BiT)t^)#ez9e"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="|M#nMI*B.Vd4TtiIvhs}"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id=";Oq7qdy[E.NS1AKd8@B!"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id=")D:}@5TE-Ur5Z+(g;*SS"/></statement><next><block type="ChoiceActionType" id="1Cg/yge#g?V.jjd?eAS4"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="K7p-imehcqgk]YR67vvy"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="t7fFnD*tKw2#Yxp[,-Rq"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="JY3vdY,tl}`~l,R?R(Z("><value name="payee"><block type="PartyPayeeType" id="U[$Np3fajA8FeSy.oT)%"><value name="party"><block type="RolePartyType" id="2__h5j$TrtYIFXLMWj#D"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="I=mhF0HZV~6HP}W9Op86"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="|;uE,;B:JHD272YU%YeH"/></value><value name="party"><block type="RolePartyType" id="lnl8.A9L/.=3~SolA@|-"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="_S*$,Wz#hQ51=CJl{A_["/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="wn/OVG#Iv}J?t0{B|K59"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="r%g6DwF}wj$x|@1+P!%7"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="8^%0MSQTSsTMsClQa,P#"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="OhG|LJr=:8=kq0_7]Ab{"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="*r7pS#7v(jpMTh_5-1zk"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="BdkW[ZzB%1N4et#)x2wp"/></statement><next><block type="ChoiceActionType" id="y;rs+{VwXAF[p;t.qK1M"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="^tiLX`VIMFVwB+k4[8/v"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="e#(o?6Ji.YiI{`TMXH7="><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="yd#)EDB+%?8vDm-t7QIh"><value name="payee"><block type="PartyPayeeType" id="13!!M`3C:g3Uk+liOMU("><value name="party"><block type="RolePartyType" id="sxnt!Co%DQsX8G3^D7Nv"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="Fp(9AaSsF#XK1:}?*,V2"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="x2XtofQm2f-Eh8k^Ao}0"/></value><value name="party"><block type="RolePartyType" id="xg-K~2LC.}l}aZwQ8w/u"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="!LwzpOCXt0HcH/mBaDmc"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="c5RJK9;}WID;#%D]NYfu"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="CloseContractType" id="P{B},=wh=+hk_3teimU-"/></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