Skip to content

Instantly share code, notes, and snippets.

@shmish111

shmish111/Main.hs

Created January 6, 2021 15:35
Show Gist options
  • Save shmish111/23913e8e1ac1d4008813ebf24cc1d7ec to your computer and use it in GitHub Desktop.
Save shmish111/23913e8e1ac1d4008813ebf24cc1d7ec 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="30" y="70"><statement name="BaseContractType"><block type="WhenContractType" id="L=,9{!Ur;?f5wyz;B$5a"><field name="timeout">10</field><statement name="case"><block type="DepositActionType" id="ML|]l6G|QMMW:s*Zmo5c"><value name="from_party"><block type="RolePartyType" id="I`dnY@Q+0j9at0Yr:ee2"><field name="role">alice</field></block></value><value name="value"><block type="ConstantValueType" id="u%[.Y^Z/ku|F9JtNRw9,"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="2?)XR/hgUOUQGsh_t+bE"/></value><value name="party"><block type="RolePartyType" id="-V+4`a,Q0Jc{PHF24ZQ1"><field name="role">alice</field></block></value><statement name="contract"><block type="WhenContractType" id="I/nf#?YtWu!X-}V;IZw3"><field name="timeout">40</field><statement name="case"><block type="ChoiceActionType" id="6H9gT;K25$?G~s}oC,dI"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="gZ?f@MIrbdz#%H9ajI9e"><field name="role">alice</field></block></value><statement name="bounds"><block type="BoundsType" id="$$Hj?ebe}HC!+k*Jq8:p"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="WhenContractType" id=":h)h[`BT~:CuIm]Ms8ri"><field name="timeout">60</field><statement name="case"><block type="ChoiceActionType" id="_CL52G`SN7ek52sla5CS"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="_)))Mm.^:99b8pG1!xfx"><field name="role">bob</field></block></value><statement name="bounds"><block type="BoundsType" id="(,Qg==B)imJ]2.,Mt=Hj"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="IfContractType" id="x}/,q{YRYB_BZM,g*$H~"><value name="observation"><block type="ValueEQObservationType" id="[]!6(s8.9PS[yxY%T.UO"><value name="value1"><block type="ChoiceValueValueType" id="1~j=CxG3s(kF{ZbmQ8R["><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="c6=F2|~S^J(p.7uy=j[D"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ChoiceValueValueType" id=",tGE|PGn=3pHYjZT3#Xj"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="Q_)RGDLXj%K%Qrdy=gIK"><field name="role">bob</field></block></value></block></value></block></value><statement name="contract1"><block type="IfContractType" id="F!{YQ;rH8!:2FlomMQ||"><value name="observation"><block type="ValueEQObservationType" id="[3vui{(wlvx`6H/jPjXZ"><value name="value1"><block type="ChoiceValueValueType" id="Ldx:)e6TIDfy`Gf+l~7r"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="%FJv8!f;kE35`ftNo(9F"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ConstantValueType" id="U-u:|p@uG7|c^FZ2R)b`"><field name="constant">0</field></block></value></block></value><statement name="contract1"><block type="PayContractType" id="s3I~,/FL=x]*8W=V,|3:"><value name="payee"><block type="PartyPayeeType" id="JCcc*skN`YOflUn(/*fZ"><value name="party"><block type="RolePartyType" id="f{PyaMj;b0@@g:9;]3tq"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="I%q0+9E!v%mCn=TC{um-"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="LycZGHCN`dtGS,l{,?pS"/></value><value name="party"><block type="RolePartyType" id="Rxh}7S6q:tG=qaJ@yEvn"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="|hs?qsg;j0sX?S+]ge;@"/></statement></block></statement><statement name="contract2"><block type="CloseContractType" id="c[IQ%:B=h.@[s$rO7H5b"/></statement></block></statement><statement name="contract2"><block type="WhenContractType" id="E_YI1Vgck)PK?{7m$gd4"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="?,UUSY#km:T=B~fIyebu"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="uS[PGsQ?lU1YQJl:SluZ"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="OF)=,#-2+@KyPuOH^P($"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id=":E{Oil)W-QUIz#Iv8}-l"/></statement><next><block type="ChoiceActionType" id="R`8,Rge.-I$qCiK`G7Dp"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="xJ38at!J=+s:Yn]s*~5B"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="j=1:J!xtB|b{?c!]]MYd"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="aUG8|HqS+s(;MM*P8E-x"><value name="payee"><block type="PartyPayeeType" id="Vq8NPy$a0^0~%HmG21AI"><value name="party"><block type="RolePartyType" id="u9Y?1A2w(Gn78=otr0Pd"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="!Io,Qx4:]n(:r3[==ql^"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="u^#1WQm,jK6,RCIX7H/z"/></value><value name="party"><block type="RolePartyType" id="o@jhOP~%HQE;A*D~LUmC"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="a~1BXSW=ryU5~A7{RU%z"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="?^w;3V5VDjiy2}F[KNO9"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="cC(*r?9X]8g9o)([#ar-"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="D+J#b:_Uqf3s@t+K3j*K"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="3#7?V4|#=Oy8W[``jIe+"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="!p-P1U5rfFQ|jM3~pF!Q"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="U:K9HG%3.Vy%$VU`Y[B}"/></statement><next><block type="ChoiceActionType" id="0g70-CyiN)ilaLYiJU3o"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="P$Gzj:o.lyI@GLoJqIKf"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id=";Ig{jMd(IKI93Ib]E?/j"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="@mNr_`4!K%qW`|oa_NZ!"><value name="payee"><block type="PartyPayeeType" id="?F%([LJnX,odT;7~/i|H"><value name="party"><block type="RolePartyType" id="xzbR81]:JZN5lxoyht2Q"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="]%nBcXA9r{)s-tmh8O0="><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="n_n0D/$N,/Fsscy$(@QS"/></value><value name="party"><block type="RolePartyType" id="VAsD8TFo9gbCw^T9=}QF"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="*:|4}nh3R!keL}AO,cEs"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="0hBz[u!g_`|WF*QDNmio"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="67spU_9EB85!A3C940SA"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="{cjKcW(O0{QevhY1v3t%"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="ic$K|.7X[R*pIZC8*o:G"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="TWxh_[rW:k7a0{0x:1dJ"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="SAWY[oJhD~iKEN7CGwdF"/></statement><next><block type="ChoiceActionType" id="RB49s`cje;~`h_Ahrt,w"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="6o{JC9^^mxNwG$!U[7+["><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="EP`ktG5wuWwpMz*f{,IV"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="u%I9dueu.N)([ymhd=Cz"><value name="payee"><block type="PartyPayeeType" id="J8;h``jGS4y$[AYb9x?o"><value name="party"><block type="RolePartyType" id="s[_N[w6uNSo8(/Eb48E9"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="Y)Cb,uMN:Uy2Kr,XGi#*"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="$-v|mGTEeWs*f*b4e2Nr"/></value><value name="party"><block type="RolePartyType" id="Q;d{*yS[?J0xM/%a1wvq"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="PRWB$!/J|O]$]?oOl$@V"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="YYqEKtRcY1q2sj(fYF-3"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="CloseContractType" id="3;cHkN(LxHAR)h};^#Ak"/></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