Skip to content

Instantly share code, notes, and snippets.

@zackrw
Last active January 30, 2021 02:19
Show Gist options
  • Save zackrw/6ecf1559e55e352d3df1940d3e9f0f83 to your computer and use it in GitHub Desktop.
Save zackrw/6ecf1559e55e352d3df1940d3e9f0f83 to your computer and use it in GitHub Desktop.
buyreleaserefund
<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="7x%i.vpICTxpvJl.ei6O"><field name="timeout">10</field><statement name="case"><block type="DepositActionType" id="sAo_|zMgLw~5(}O|8[rT"><value name="from_party"><block type="RolePartyType" id="Sc/224n*%a5QHrm:,SgU"><field name="role">investor</field></block></value><value name="value"><block type="ConstantValueType" id="1o]Rv6^Nut^8COa/Etj#"><field name="constant">850</field></block></value><value name="token"><block type="AdaTokenType" id="M?IQx$*Ntmjr:@ser_-~"/></value><value name="party"><block type="RolePartyType" id="1+S3HSIj6G{1A0yIozDX"><field name="role">investor</field></block></value><statement name="contract"><block type="PayContractType" id="4G~moP^U(e3Hbv%k9=VO"><value name="payee"><block type="PartyPayeeType" id="}h/KFUH.fO-F{xvR}/$i"><value name="party"><block type="RolePartyType" id="5a9i0[)Zk)F8GHIZ^@p+"><field name="role">issuer</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="s;wu@hm%/DnW^g~bzGs9"><field name="constant">850</field></block></value><value name="token"><block type="AdaTokenType" id="TaN+-A8iHBW49Z3`j,|c"/></value><value name="party"><block type="RolePartyType" id=":E=4Q~fKfl#3e[ldZ:`8"><field name="role">investor</field></block></value><statement name="contract"><block type="WhenContractType" id="rf~*#fVWfcEo5J{GdU`7"><field name="timeout">20</field><statement name="case"><block type="DepositActionType" id="r5aa[%j2{OSx4PReid;b"><value name="from_party"><block type="RolePartyType" id="Y]2lz{f+EZC5sVaY!e#i"><field name="role">issuer</field></block></value><value name="value"><block type="ConstantValueType" id="Ef5qidY7YS%NjB9r_2Mc"><field name="constant">1000</field></block></value><value name="token"><block type="AdaTokenType" id="[]d0R+/tz3Av`0.~vFB9"/></value><value name="party"><block type="RolePartyType" id="[;ly|nuWRE!@Chc+mq^+"><field name="role">investor</field></block></value><statement name="contract"><block type="PayContractType" id="OiINrB?`XX=q*_MAV-Xd"><value name="payee"><block type="PartyPayeeType" id=",PRUFdAVCWR[ejb%J!jZ"><value name="party"><block type="RolePartyType" id="G?Ywq(2MV[PR|7-cgweC"><field name="role">investor</field></block></value></block></value><value name="value"><block type="ConstantValueType" id="-r(,8abZNmc~x,AL5EgS"><field name="constant">1000</field></block></value><value name="token"><block type="AdaTokenType" id="jT[ekSP-@_bYgD,o/S(g"/></value><value name="party"><block type="RolePartyType" id="{:vMxA_=%~8bu}rps#:w"><field name="role">investor</field></block></value><statement name="contract"><block type="CloseContractType" id="T(YbMj*1P+~)hTZo+vo]"/></statement></block></statement></block></statement><statement name="contract"><block type="CloseContractType" id="=Q27YUs?0/E?UoTDlE/A"/></statement></block></statement></block></statement></block></statement><statement name="contract"><block type="CloseContractType" id="PlT-@Hln:3y#|b-#]r)N"/></statement></block></statement></block></xml>
{-# LANGUAGE OverloadedStrings #-}
module ZeroCouponBond where
import Language.Marlowe
main :: IO ()
main = print . pretty $ contract
contract :: Contract
contract = When [ Case
(Deposit "investor" "investor" ada (Constant 850))
(Pay "investor" (Party "issuer") ada (Constant 850)
(When
[ Case (Deposit "investor" "issuer" ada (Constant 1000))
(Pay "investor" (Party "investor") ada (Constant 1000) Close)
]
(Slot 20)
Close
)
)
]
(Slot 10)
Close
/* Parties */
const buyer : Party = Role("buyer");
const seller : Party = Role("seller");
/* helper function to build Actions */
const choiceName : string = "price";
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 buyerPay : Action = choiceBy(buyer, pay);
const buyerRefund : Action = choiceBy(buyer, refund);
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;
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment