Skip to content

Instantly share code, notes, and snippets.

@shmish111

shmish111/Main.hs

Created January 6, 2021 12:32
Show Gist options
  • Save shmish111/602fa4ca20ad45898cfa6e31bf5a7c60 to your computer and use it in GitHub Desktop.
Save shmish111/602fa4ca20ad45898cfa6e31bf5a7c60 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="5XX`6S3=6*K+KE9]^eX}"><field name="timeout">10</field><statement name="case"><block type="DepositActionType" id="LD-F;(,b[),6V]rFY7=1"><value name="from_party"><block type="RolePartyType" id="$kJEhYi3Yo%.%N+83,b2"><field name="role">alice</field></block></value><value name="value"><block type="ConstantValueType" id="9_.p7=EqhiS4PY!kIgyy"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="uxVJWXN5KDBKW^bbe5-l"/></value><value name="party"><block type="RolePartyType" id="Kvz*4{`B?CKB6$8-KgQ6"><field name="role">alice</field></block></value><statement name="contract"><block type="WhenContractType" id="n$#*Eq8u7J)]ZbOb15}R"><field name="timeout">40</field><statement name="case"><block type="ChoiceActionType" id="O?ghVIv{No4Kj4}hc9#X"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="Ly7DaP_?-R/BYuM}YKZ2"><field name="role">alice</field></block></value><statement name="bounds"><block type="BoundsType" id="^r1X#D/hhU~HH+([q-n~"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="WhenContractType" id="QD}17ZdN-;k3qCC^z9-]"><field name="timeout">60</field><statement name="case"><block type="ChoiceActionType" id="nPgbr$6R=e|FSZHj+_oo"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="[Dd`D=:;Ps$}V2oIBVZS"><field name="role">bob</field></block></value><statement name="bounds"><block type="BoundsType" id="gB_C7^^sb.!TpxcArZy`"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="IfContractType" id=")6xQ^eTNQfr].9hyxr*="><value name="observation"><block type="ValueEQObservationType" id="zdjNb6*o7}s^^Q_P(1rc"><value name="value1"><block type="ChoiceValueValueType" id="%.+4v4+.y)8+tec]M6E)"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="d$w(E}Gu}BT,}jhZGA8,"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ChoiceValueValueType" id="k5lo!7*zG]uPvH%?nhla"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="BxKN.Gr6CbA}K8u__BNK"><field name="role">bob</field></block></value></block></value></block></value><statement name="contract1"><block type="IfContractType" id="p(cR(VK]9rCg-5ujSPs0"><value name="observation"><block type="ValueEQObservationType" id="|#+7,VnOg;dq2twyz5#|"><value name="value1"><block type="ChoiceValueValueType" id="?iMyjbk}36$4A$J8*p(#"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="rs!i=e;trI_54ODS;ejZ"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ConstantValueType" id="Ua$nGiv)iN565sWNi]Ea"><field name="constant">0</field></block></value></block></value><statement name="contract1"><block type="PayContractType" id="i=}_)$+9k!hochs`GLQB"><value name="payee"><block type="PartyPayeeType" id="C)G,wkN+5oM^hRq5!r81"><value name="party"><block type="RolePartyType" id="??N+3E%PP-m`zHV~nop`"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="]T8nCY[*{{m~cR5O.VVZ"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="FV`reRBwIU5AUijhSn3q"/></value><value name="party"><block type="RolePartyType" id="S#pimo4*Ez4l[BKD56;~"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="eq!Ob+o.i)uJDNxSQ~W="/></statement></block></statement><statement name="contract2"><block type="CloseContractType" id="he+~9{KngDZK:a1(W[s$"/></statement></block></statement><statement name="contract2"><block type="WhenContractType" id="oPT!vUiyzJwy2n^e8CA`"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="_=~N2I^LJ3|P]qMze[^R"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="?P9)u$GJ5jG|*W4GOc1b"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="RdJSTTu@yWaQgW]tsR05"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id=";5#n=4=I+%uukmJO%v{+"/></statement><next><block type="ChoiceActionType" id="qz7ol,/_!#Q:GXZ([rW@"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="`;m*acc9Z.BY@#rPvZKU"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="Y1(XlJ+^JQe5f,W`Fn%Q"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="]sHI20Li2QWY1K@6`WK."><value name="payee"><block type="PartyPayeeType" id="MAVxEA+#?4P0NQMCrHtD"><value name="party"><block type="RolePartyType" id="1)v=1Hp%[z``VxQxyqbL"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="H3kW{g|49PxB%@F.cg~$"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="Qf7)]qc~f3L0EULi+(an"/></value><value name="party"><block type="RolePartyType" id=")qQi6~h{)ZAM1LRBIwr^"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="=(Y5onN6{=s2M[~5~`~p"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="+riTf_VvK^Ky_.rlq~_}"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="ajGfmvR)qfhG`BVp8@~Y"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="~nx0P{a7C+jy!`,n5p(B"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="k~GCYqw^Y,1dy%9JIF~:"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="]T1My^YsMa|%C0h%K/va"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="a1H[Lg()F?-okn$Xo%5u"/></statement><next><block type="ChoiceActionType" id="%`YLWSEsk~%{N}VR;1F6"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="%0QWrH[Il(13v89g6rGE"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="D;8]kkI=J{L;~P^*y8ih"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="eOM$9#n(5),AfDkNorkB"><value name="payee"><block type="PartyPayeeType" id="Co,{8Ps~JXfF(Ui-aF(v"><value name="party"><block type="RolePartyType" id="T-I18%i2K6}HbZ1WwdK)"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="UyUQ.k-=l}f-Qp{9Hpt|"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="t@!-7$JW=?i[X]f_%hr|"/></value><value name="party"><block type="RolePartyType" id="C82IY,Ode[=SRIzB;4j5"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id=";oe182_?3+-F(Y!l[2jL"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="ZJxRl|:)ZL!H6z|fp{HM"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="j+0nxzGuOh^(3t}pR8IQ"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="xI5K0GKBA_fdRnwy;S5-"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="w~#-;hnF,n[|#f0tK=.v"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="RxrQZVCvqYfS4nS|VUc#"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="yrPieB6bT#HWGM!y0y=e"/></statement><next><block type="ChoiceActionType" id="[5-MND[|T^b$yz1+)fG:"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="_$z33)%OkzB-GAj0Mwwy"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="h,n;(;.=?E*J*J8%@sT("><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="ug77lVNZOZ-r-klqA06v"><value name="payee"><block type="PartyPayeeType" id="3Eb?O+]*B1Xz8?qdA7g;"><value name="party"><block type="RolePartyType" id="b$|/#hXx.?y;58cq%y0v"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="|{R4[$2_2@M)e7Yb@k!d"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="DTTemNU|:pD5*2psld/u"/></value><value name="party"><block type="RolePartyType" id="i:M@mU~g)X|_*FHk+z9_"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="FPE-niQF|~0D]37i[C^r"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="pS241G}rR!VmgrHdnr]r"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="CloseContractType" id="z#C@bKkEB!TA_!BCN5c7"/></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