Last active
May 19, 2023 16:34
-
-
Save jhbertra/3dead99b79a61d29669035d6bbfc188c to your computer and use it in GitHub Desktop.
New Project
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE OverloadedStrings #-} | |
module Escrow where | |
import Language.Marlowe.Extended.V1 | |
main :: IO () | |
main = printJSON escrow | |
-- We can set explicitRefunds True to run Close refund analysis | |
-- but we get a shorter contract if we set it to False | |
explicitRefunds :: Bool | |
explicitRefunds = False | |
seller, buyer, arbiter :: Party | |
buyer = Role "Buyer" | |
seller = Role "Seller" | |
arbiter = Role "Mediator" | |
price :: Value | |
price = ConstantParam "Price" | |
depositTimeout, disputeTimeout, answerTimeout, arbitrageTimeout :: Timeout | |
depositTimeout = TimeParam "Payment deadline" | |
disputeTimeout = TimeParam "Complaint deadline" | |
answerTimeout = TimeParam "Complaint response deadline" | |
arbitrageTimeout = TimeParam "Mediation deadline" | |
choice :: ChoiceName -> Party -> Integer -> Contract -> Case | |
choice choiceName chooser choiceValue = Case (Choice (ChoiceId choiceName chooser) | |
[Bound choiceValue choiceValue]) | |
deposit :: Timeout -> Contract -> Contract -> Contract | |
deposit timeout timeoutContinuation continuation = | |
When [Case (Deposit seller buyer ada price) continuation] | |
timeout | |
timeoutContinuation | |
choices :: Timeout -> Party -> Contract -> [(Integer, ChoiceName, Contract)] -> Contract | |
choices timeout chooser timeoutContinuation list = | |
When [choice choiceName chooser choiceValue continuation | |
| (choiceValue, choiceName, continuation) <- list] | |
timeout | |
timeoutContinuation | |
sellerToBuyer, paySeller :: Contract -> Contract | |
sellerToBuyer = Pay seller (Account buyer) ada price | |
paySeller = Pay buyer (Party seller) ada price | |
refundBuyer :: Contract | |
refundBuyer | |
| explicitRefunds = Pay buyer (Party buyer) ada price Close | |
| otherwise = Close | |
refundSeller :: Contract | |
refundSeller | |
| explicitRefunds = Pay seller (Party seller) ada price Close | |
| otherwise = Close | |
escrow :: Contract | |
escrow = deposit depositTimeout Close $ | |
choices disputeTimeout buyer refundSeller | |
[ (0, "Everything is alright" | |
, refundSeller | |
) | |
, (1, "Report problem" | |
, sellerToBuyer $ | |
choices answerTimeout seller refundBuyer | |
[ (1, "Confirm problem" | |
, refundBuyer | |
) | |
, (0, "Dispute problem" | |
, choices arbitrageTimeout arbiter refundBuyer | |
[ (0, "Dismiss claim" | |
, paySeller | |
Close | |
) | |
, (1, "Confirm problem" | |
, refundBuyer | |
) | |
] | |
) | |
] | |
) | |
] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{"valueParameterInfo":[["Price",{"valueParameterFormat":{"contents":[6,"₳"],"tag":"DecimalFormat"},"valueParameterDescription":"The price of the item."}]],"timeParameterDescriptions":[["Payment deadline","The _**buyer**_ must pay the _price_ of the item by this time, otherwise the contract is cancelled."],["Complaint deadline","The _**buyer**_ can only complain until this deadline, otherwise the contract will assume the transaction went smoothly and pay the _**seller**_."],["Complaint response deadline","If the _**buyer**_ complained, the _**seller**_ must respond before this deadline, otherwise the contract will assume there was a problem with the transaction and refund the _**buyer**_."],["Mediation deadline","If the _**buyer**_ and the _**seller**_ disagree, the _**mediator**_ must weigh in before this deadline, otherwise the contract will assume there was a problem with the transaction and refund the _**buyer**_."]],"roleDescriptions":[["Buyer","The buyer of the item."],["Mediator","The mediator decides who is right in the case of dispute."],["Seller","The seller of the item."]],"contractType":"Escrow","contractShortDescription":"In this contract a _**seller**_ wants to sell an item (like a bicycle) to a _**buyer**_ for a _price_.","contractName":"Purchase","contractLongDescription":"Neither trusts each other, but they both trust a _**mediator**_. The _**buyer**_ pays the _price_ into the contract account: if both the _**buyer**_ and the _**seller**_ agree that the _**buyer**_ has received the item, then the _**seller**_ receives the _price_; if not, then the _**mediator**_ ensures that the _**buyer**_ gets their money back.","choiceInfo":[["Confirm problem",{"choiceFormat":{"contents":null,"tag":"DefaultFormat"},"choiceDescription":"Acknowledge there was a problem and a refund must be granted."}],["Dismiss claim",{"choiceFormat":{"contents":null,"tag":"DefaultFormat"},"choiceDescription":"The _**Mediator**_ does not see any problem with the exchange and the _**Seller**_ must be paid."}],["Dispute problem",{"choiceFormat":{"contents":null,"tag":"DefaultFormat"},"choiceDescription":"The _**Seller**_ disagrees with the _**Buyer**_ about the claim that something went wrong."}],["Everything is alright",{"choiceFormat":{"contents":null,"tag":"DefaultFormat"},"choiceDescription":"The transaction was uneventful, _**Buyer**_ agrees to pay the _**Seller**_."}],["Report problem",{"choiceFormat":{"contents":null,"tag":"DefaultFormat"},"choiceDescription":"The _**Buyer**_ claims not having received the product that was paid for as agreed and would like a refund."}]]} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment