New Project

Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Escrow where

import           Language.Marlowe.Extended

main :: IO ()
main = print . pretty $ contract

-- 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 "Arbiter"


price :: Value
price = ConstantParam "Price"

depositTimeout, disputeTimeout, answerTimeout, arbitrageTimeout :: Timeout
depositTimeout = SlotParam "Buyer's deposit timeout"
disputeTimeout = SlotParam "Buyer's dispute timeout"
answerTimeout = SlotParam "Seller's response timeout"
arbitrageTimeout = SlotParam "Timeout for arbitrage"

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

contract :: Contract
contract = 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

{"valueParameterDescriptions":[["Price","Amount of Lovelace to be paid by the *Buyer* for the item."]],"slotParameterDescriptions":[["Buyer's deposit timeout","Deadline by which the *Buyer* must deposit the selling *Price* in the contract."],["Buyer's dispute timeout","Deadline by which, if the *Buyer* has not opened a dispute, the *Seller* will be paid."],["Seller's response timeout","Deadline by which, if the *Seller* has not responded to the dispute, the *Buyer* will be refunded."],["Timeout for arbitrage","Deadline by which, if the *Arbiter* has not resolved the dispute, the *Buyer* will be refunded."]],"roleDescriptions":[["Arbiter","The party that will choose who gets the money in the event of a disagreement between the *Buyer* and the *Seller* about the outcome."],["Buyer","The party that wants to buy the item. Payment is made to the *Seller* if they acknowledge receiving the item."],["Seller","The party that wants to sell the item. They receive the payment if the exchange is uneventful."]],"contractType":"ES","contractName":"Simple escrow","contractDescription":"Regulates a money exchange between a *Buyer* and a *Seller*. If there is a disagreement, an *Arbiter* will decide whether the money is refunded or paid to the *Seller*.","choiceDescriptions":[["Confirm problem","Acknowledge there was a problem and a refund must be granted."],["Dismiss claim","The *Arbiter* does not see any problem with the exchange and the *Seller* must be paid."],["Dispute problem","The *Seller* disagrees with the *Buyer* about the claim that something went wrong."],["Everything is alright","The transaction was uneventful, *Buyer* agrees to pay the *Seller*."],["Report problem","The *Buyer* claims not having received the product that was paid for as agreed and would like a refund."]]}

playground.marlowe.json

{}