New Project

Main.hs

{-# 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
                              )
                            ]
                       )
                     ]
                )
              ]

metadata.json

{"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."}]]}

playground.marlowe.json

{}