Skip to content

Instantly share code, notes, and snippets.

@shmish111

shmish111/Main.hs

Created January 6, 2021 15:05
Show Gist options
  • Save shmish111/7c8c3986777de5fd51baf05f5ce98957 to your computer and use it in GitHub Desktop.
Save shmish111/7c8c3986777de5fd51baf05f5ce98957 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="50"><statement name="BaseContractType"><block type="WhenContractType" id="9hOcE(j}9X6.(,iwc*K#"><field name="timeout">10</field><statement name="case"><block type="DepositActionType" id="`R{cn@:i!{YlKi+-vtvn"><value name="from_party"><block type="RolePartyType" id="@H%S`+S|)]B=)mBvA6-N"><field name="role">alice</field></block></value><value name="value"><block type="ConstantValueType" id="5!Grfic8da7b/%5V(ez`"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="VggDIlw9Gbn=TRR32xml"/></value><value name="party"><block type="RolePartyType" id="6ne#n+a)C]fp~l-242cW"><field name="role">alice</field></block></value><statement name="contract"><block type="WhenContractType" id="}=1:YCv,XuZeLSZWHm-i"><field name="timeout">40</field><statement name="case"><block type="ChoiceActionType" id="P;1pja;JAsCc**.JX{Y%"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="5.uf]bYPz5v7@ym]9}(S"><field name="role">alice</field></block></value><statement name="bounds"><block type="BoundsType" id="o4EE6[Z/At7S#yf~Z06*"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="WhenContractType" id="7P*lHdCiq6(2;4pswn,H"><field name="timeout">60</field><statement name="case"><block type="ChoiceActionType" id="ML~t(^x~@4HybGquw$yn"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="gdr{,z)+*up%giPP?:il"><field name="role">bob</field></block></value><statement name="bounds"><block type="BoundsType" id="9xfwT(g2RkxIBDa6Hen?"><field name="from">0</field><field name="to">1</field></block></statement><statement name="contract"><block type="IfContractType" id="B2P#VRam6S_@gPWBfmv/"><value name="observation"><block type="ValueEQObservationType" id="Oi@Z+1bwaD2c3FNkvkoQ"><value name="value1"><block type="ChoiceValueValueType" id="wb7^[IJ^QabfDo=YyhIf"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="@#N:QPRU[O_Ti40dj?-#"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ChoiceValueValueType" id="bDGQnp+Z+|:w1MIFz3m@"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="IvZnBP]nn_|ukXQ{$?tU"><field name="role">bob</field></block></value></block></value></block></value><statement name="contract1"><block type="IfContractType" id="Ym0ePz,en}`e(!mGe:wl"><value name="observation"><block type="ValueEQObservationType" id="1ylEw-Vt38,^bKaq0iqj"><value name="value1"><block type="ChoiceValueValueType" id="t0ZT*/Su(Gu*E8J$j3jW"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="mf@{!KzX_~eoG291^Z]i"><field name="role">alice</field></block></value></block></value><value name="value2"><block type="ConstantValueType" id="h0#Sj}G?L=N]~B]_(iAT"><field name="constant">0</field></block></value></block></value><statement name="contract1"><block type="PayContractType" id="AN|@V8;5I14j6?Y]JqT~"><value name="payee"><block type="PartyPayeeType" id="?68W-Ti!M[3Rf_njz`|7"><value name="party"><block type="RolePartyType" id="mL=~vW?/AYl=ZkCktO};"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="hv@?XeUppI-:-KB2DLLl"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="x*0az`]L*M`H$,muGI7-"/></value><value name="party"><block type="RolePartyType" id="cLLt5NA~a,RgA:[fK*.3"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="yHoGO#4${eB:BpK0b4YI"/></statement></block></statement><statement name="contract2"><block type="CloseContractType" id="d}$h%T^(SfjjtS-U;jLY"/></statement></block></statement><statement name="contract2"><block type="WhenContractType" id="tkea[DDjEi~jFk!(p7y+"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="%,?51V)9*0p|Bk$h0VaF"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="IaH4+SJI2TRf9t?LX!|+"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="p^ALp6,Gc}7cJ~8P1]xQ"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="s!x]Z]]anK{`m98;:Me5"/></statement><next><block type="ChoiceActionType" id=")Nx?3o`(]M)[H!mPQ!YG"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="6E35ihy-m+q4{wfj[,cc"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="}desHBUOwUzbAPr8O+hH"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="N*Z^rgwBnL;dnv_NqceC"><value name="payee"><block type="PartyPayeeType" id="mFs3mg.0BzB;Eg.*g(U`"><value name="party"><block type="RolePartyType" id="VWy)#uWLKdQHv$}8Ed`^"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="x@;Ru=+!F*`ebmUbIwA?"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="mg%vVkoY`~G,wUX@cmHI"/></value><value name="party"><block type="RolePartyType" id="W-IMxA#F/}p3H~*Y^0bb"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="a5?;){~ix=+?,b..70po"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="|l82]ypHHS3!tvqCoMD/"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="*oHl/PXqg,4s+}ax07Cj"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="wi]A7^4_8M2+Rj5-[2@s"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="*+;7ir~Q(1!Yuj/~dlSj"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="sA,L^sD.PY+I#;1wOsa8"><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="~xBx%[lkQ_uGk=3:]J=*"/></statement><next><block type="ChoiceActionType" id="JpF}c-cq)qwXK2$#8MH$"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="p1/`i5rOBU+K(Jlqgxhm"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="~l^2E2q#IEH67K_l-cg8"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="K5xs_I^:OCV{N0KcTEBW"><value name="payee"><block type="PartyPayeeType" id="PHvT.R!;iC[x?N0%S8z["><value name="party"><block type="RolePartyType" id="H)NZ=+VtnX#qYjObv$8}"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="LUt@{%Yq8#UPNNyd}pWq"><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="_odNb(FIe+5d;*Xv;V=G"/></value><value name="party"><block type="RolePartyType" id="TR*#:+wysuc%Kf1Z%c4k"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="#}1%BP|daB;^_BY`dB5{"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="#~cf7Ly2C?5NJ0%:2Sv."/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="WhenContractType" id="[bBEbC8M}/W={I?Db]JL"><field name="timeout">100</field><statement name="case"><block type="ChoiceActionType" id="7meM;cVm@1@s4z3ui0u/"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="T.l)wYEO4Z,^hqxKl{fZ"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id="2|w#/zyeD)^qb643Y7Q("><field name="from">1</field><field name="to">1</field></block></statement><statement name="contract"><block type="CloseContractType" id="`ZQvv`we%8n7G9z{Nk/]"/></statement><next><block type="ChoiceActionType" id="{9;,XhUwr3ecI5Em9T/,"><field name="choice_name">choice</field><value name="party"><block type="RolePartyType" id="UrSjr;RK$50,MH?]HmED"><field name="role">carol</field></block></value><statement name="bounds"><block type="BoundsType" id=":hNo6P1;c(t}rGLC5*#Y"><field name="from">0</field><field name="to">0</field></block></statement><statement name="contract"><block type="PayContractType" id="RFth`L-6mWN!E7f~`x4O"><value name="payee"><block type="PartyPayeeType" id="#:$(tq?yekQN^?P=ym9t"><value name="party"><block type="RolePartyType" id="{ZX2p0PH[fOqYf,:Do,*"><field name="role">bob</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="kvDr=,Cs0W;6;EShpn#("><field name="constant">450</field></block></value><value name="token"><block type="AdaTokenType" id="rTOA^^4kaP:Bg]6ZyN-I"/></value><value name="party"><block type="RolePartyType" id="Td@229$tzDAPwZl?b!W]"><field name="role">alice</field></block></value><statement name="contract"><block type="CloseContractType" id="P$w[Abos+-SR1W*~v;~4"/></statement></block></statement></block></next></block></statement><statement name="contract"><block type="CloseContractType" id="O!L[ZG*J~8JqAp3!zbFv"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="CloseContractType" id="b7/z,]7JK}n:Pid8$eOr"/></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