Skip to content

Instantly share code, notes, and snippets.

@shmish111

shmish111/Main.hs

Created January 6, 2021 15:54
Show Gist options
  • Save shmish111/6adfdcbd7489b40e1d43a011a2feafd7 to your computer and use it in GitHub Desktop.
Save shmish111/6adfdcbd7489b40e1d43a011a2feafd7 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="a,Z4+~M2;$/{w.ec5l)?"><field name="timeout">10</field><statement name="case"><block type="DepositActionType" id="JUpTfYhXZ4a-pVyXQ4Ec"><value name="from_party"><block type="RolePartyType" id="{Q`7dn9qBU0rf;X`X@5`"><field name="role">alice</field></block></value><value name="value"><block type="ConstantValueType" id="^w?Cx2B-:-r?0{S3bR^4"><field name="constant">350</field></block></value><value name="token"><block type="AdaTokenType" id="_-z:+uv?sCZmD]_r8;L~"/></value><value name="party"><block type="RolePartyType" id="@tpXwFU@zoWG!:Hfx@wl"><field name="role">alice</field></block></value><statement name="contract"><block type="WhenContractType" id="nJ5xzqe;v1XIw~QQJg[h"><field name="timeout">40</field><statement name="case"><block type="ChoiceActionType" id="9Q_PJ48.7)5qVPHz~Oxn"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="R_]#4_fz7=F??iR)H@}W"><field name="role">alice</field></block></value><statement name="bounds"><block type="BoundsType" id="4GBNIeA0Bf_KpQpT#P1n"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="WhenContractType" id="G5Pz:TWG@x7]FjD@mhx$"><field name="timeout">60</field><statement name="case"><block type="ChoiceActionType" id="e3E1V`:8Tg5k,GhTdFn)"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="D*MXZJL+O#{LmtFkXLhN"><field name="role">bob</field></block></value><statement name="bounds"><block type="BoundsType" id="[lW]pb4epM]ks/v]{ws@"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="IfContractType" id="yqJ-T8dCP|-$b~+)nucQ"><value name="observation"><block type="ValueEQObservationType" id="@*m=!td#p($`y6bf}9]r"><value name="value1"><block type="ChoiceValueValueType" id=":HCFWeJJ).U|O=0-,-Ah"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="$1!g.l@Lf-n?oN3-Sw6`"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ChoiceValueValueType" id="qg@CWxBhGco?#|l7{crH"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="LCJzt(Q.V`.q`4P*3Mty"><field name="role">bob</field></block></value></block></value></block></value><statement name="contract1"><block type="IfContractType" id=".PX/soS{+i?xkUOAGSvo"><value name="observation"><block type="ValueEQObservationType" id="YfO@s?uD{u/MH;*}P;eI"><value name="value1"><block type="ChoiceValueValueType" id="9mX01=O3]}8?=caj~K_;"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="kKA;JYG+u+XhYo.I4)cO"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ConstantValueType" id="7a!zfy%p:omSb-g|,~uA"><field name="constant">0</field></block></value></block></value><statement name="contract1"><block type="PayContractType" id="%T;pTQroFmW-;Crg;042"><value name="payee"><block type="PartyPayeeType" id="@7GO=y{kA%.G{@ZNI$x?"><value name="party"><block type="RolePartyType" id="1k}hxG`VWhzQ/KzTd/C{"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="gH]V=YBjUmKs:Qe2f3Cy"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="7Q$%q*dzMWm]7EcMS5X5"/></value><value name="party"><block type="RolePartyType" id=",N){P]Y.]@^T;J(y7ij*"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="?]0LOMXaS*h+Tzv)=oll"/></statement></block></statement><statement name="contract2"><block type="CloseContractType" id="a,)c=8cLe9b363pVw]x?"/></statement></block></statement><statement name="contract2"><block type="WhenContractType" id="=pn4$N:%3}ruxanP@LWz"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="wWDWr%Is:g+-dK)1[:D3"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="6t/FIIDuD2L}[x(YL+uA"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="DU|{]UWL/cB^em~TkIAw"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id=":bWugq/}4:S6^cO!1s]P"/></statement><next><block type="ChoiceActionType" id="bS1z)33m.j5gL]9alKsi"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="q$fQPXhRqGlFt#sHc(jm"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id=".y$KF)4/}AlcHSUc=:9Y"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="z}porCdgvKFB{PXf#RWV"><value name="payee"><block type="PartyPayeeType" id="CH-(mR~cpn}$z6(qlVY9"><value name="party"><block type="RolePartyType" id="Vx1|eA!d{Sx9.m#U[[pe"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="f/iyj7[g`2)3Z~N%DLkN"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="-o%-fQzLF/_(xypy?nF9"/></value><value name="party"><block type="RolePartyType" id="0#IXA?OZ6xoG.Y^4Fj+l"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="Tkc+z2bhfRC[jx]C/3@b"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="fPUbfh8haU3ZmoaW`qpH"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="x|~rF:wY(49c(SKTX[#T"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="R;MPAcVwq05W*U+wdpfm"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="w8w4RS~ojpOOijCj,/85"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="nKWY?53~=D)j0qS*fb-!"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="d84b#uU[TL8K^.I!w`hF"/></statement><next><block type="ChoiceActionType" id="lvN^8P/+LHwJ.tugL_hC"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="?BI;N3*?~elU2A_3Q0IP"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="1]nNZVS}k|L,U{g3(_Al"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="JiCM2.dTKXgP!hm,`Tu3"><value name="payee"><block type="PartyPayeeType" id=".G0cQs5E[]df#D_eYXHr"><value name="party"><block type="RolePartyType" id="$NKxlNGx|lCY?glx_a9{"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="o+}*BzQZ~ZxH;uFRD3m@"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="J*Po_p)!:?s+`0o;keLk"/></value><value name="party"><block type="RolePartyType" id="g:guBn^$l)/,:tBQQnS_"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="9,?kfl/Z(=[2{xR-pH2n"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="9QJC-hI709f$#bXC6u.#"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="%)87^0coBhrfv@,Uif=,"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="sbaMyL1w6fHaDvtJ|`O:"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="/r7CxxZv6i!xIZI@K+2,"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="{~QSeb?`3.q7~4Z[qStl"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="#nVQh?;{x*fNqafuBY}G"/></statement><next><block type="ChoiceActionType" id="Ow]TPU,DDk.@u[ideR9U"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="AloDZIH4exL]Iw~[}*m^"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id=";!czM^H{_^t4Ms~FTcO:"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="V|?Tk]$z8)oKe_~?3Z@5"><value name="payee"><block type="PartyPayeeType" id="VL@r@GpSA_fdP3}f]CBh"><value name="party"><block type="RolePartyType" id="5tSkQ/WuKR^2Zn!f6ic^"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="f~bM}-*a$+k3Za,4Y@0S"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="vCF%CN=muXrST[7i@5WY"/></value><value name="party"><block type="RolePartyType" id="ITyQ@DZoa]}u,Xb@]2T0"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="j@1#i`B-uo4T43qOvNzw"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="*!1=bC_A#;owFqO4lH8N"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="CloseContractType" id="f6x@b}{94F3g*{H!jg-n"/></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