From 74442e054a42deeff3a316879fe5f1bd4e9d12b8 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 26 Jul 2021 16:22:03 +0100 Subject: [PATCH] Update contract for differences without oracle example to support two different commitments --- .../src/Examples/JS/Contracts.purs | 44 ++++++++-------- .../contracts/ContractForDifferences.hs | 50 ++++++++++--------- .../PureScript/ContractForDifferences.purs | 34 +++++++------ 3 files changed, 70 insertions(+), 58 deletions(-) diff --git a/marlowe-playground-client/src/Examples/JS/Contracts.purs b/marlowe-playground-client/src/Examples/JS/Contracts.purs index 193e7f00edf..313b219d5f6 100644 --- a/marlowe-playground-client/src/Examples/JS/Contracts.purs +++ b/marlowe-playground-client/src/Examples/JS/Contracts.purs @@ -355,17 +355,22 @@ contractForDifferences = const counterparty: Party = Role("Counterparty"); const oracle: Party = Role("Oracle"); - const depositAmount: bigint = 100_000_000n; - const deposit: Value = Constant(depositAmount); - const doubleDeposit: Value = Constant(depositAmount * 2n); + const partyDepositAmount: bigint = 100_000_000n; + const counterpartyDepositAmount: bigint = 100_000_000n; + const partyDeposit: Value = Constant(partyDepositAmount); + const counterpartyDeposit: Value = Constant(counterpartyDepositAmount); + const bothDeposits: Value = Constant(partyDepositAmount + counterpartyDepositAmount); const priceBeginning: ChoiceId = ChoiceId("Price at beginning", oracle); const priceEnd: ChoiceId = ChoiceId("Price at end", oracle); + const exchangeBeginning: ChoiceId = ChoiceId("dir-adausd", oracle); + const exchangeEnd: ChoiceId = ChoiceId("inv-adausd", oracle); + const decreaseInPrice: ValueId = "Decrease in price"; const increaseInPrice: ValueId = "Increase in price"; - function initialDeposit(by: Party, timeout: ETimeout, timeoutContinuation: Contract, + function initialDeposit(by: Party, deposit: Value, timeout: ETimeout, timeoutContinuation: Contract, continuation: Contract): Contract { return When([Case(Deposit(by, by, ada, deposit), continuation)], timeout, @@ -391,12 +396,11 @@ contractForDifferences = function recordDifference(name: ValueId, choiceId1: ChoiceId, choiceId2: ChoiceId, continuation: Contract): Contract { - return Let(name, SubValue(ChoiceValue(choiceId1), ChoiceValue(choiceId2)), - continuation); + return Let(name, SubValue(ChoiceValue(choiceId1), ChoiceValue(choiceId2)), continuation); } - function transferUpToDeposit(from: Party, to: Party, amount: Value, continuation: Contract): Contract { - return Pay(from, Account(to), ada, Cond(ValueLT(amount, deposit), amount, deposit), continuation); + function transferUpToDeposit(from: Party, payerDeposit: Value, to: Party, amount: Value, continuation: Contract): Contract { + return Pay(from, Account(to), ada, Cond(ValueLT(amount, payerDeposit), amount, payerDeposit), continuation); } function refund(who: Party, amount: Value, continuation: Contract): Contract { @@ -408,7 +412,7 @@ contractForDifferences = } } - const refundBoth: Contract = refund(party, deposit, refund(counterparty, deposit, Close)); + const refundBoth: Contract = refund(party, partyDeposit, refund(counterparty, counterpartyDeposit, Close)); function refundIfGtZero(who: Party, amount: Value, continuation: Contract): Contract { if (explicitRefunds) { @@ -418,34 +422,34 @@ contractForDifferences = } } - function refundUpToDoubleOfDeposit(who: Party, amount: Value, continuation: Contract): Contract { + function refundUpToBothDeposits(who: Party, amount: Value, continuation: Contract): Contract { if (explicitRefunds) { - return refund(who, Cond(ValueGT(amount, doubleDeposit), doubleDeposit, amount), + return refund(who, Cond(ValueGT(amount, bothDeposits), bothDeposits, amount), continuation); } else { return continuation; } } - function refundAfterDifference(payer: Party, payee: Party, difference: Value): Contract { - return refundIfGtZero(payer, SubValue(deposit, difference), - refundUpToDoubleOfDeposit(payee, AddValue(deposit, difference), + function refundAfterDifference(payer: Party, payerDeposit: Value, payee: Party, payeeDeposit: Value, difference: Value): Contract { + return refundIfGtZero(payer, SubValue(payerDeposit, difference), + refundUpToBothDeposits(payee, AddValue(payeeDeposit, difference), Close)); } const contract: Contract = - initialDeposit(party, 300n, Close, - initialDeposit(counterparty, 600n, refund(party, deposit, Close), + initialDeposit(party, partyDeposit, 300n, Close, + initialDeposit(counterparty, counterpartyDeposit, 600n, refund(party, partyDeposit, Close), oracleInput(priceBeginning, 900n, refundBoth, wait(1500n, oracleInput(priceEnd, 1800n, refundBoth, gtLtEq(ChoiceValue(priceBeginning), ChoiceValue(priceEnd), recordDifference(decreaseInPrice, priceBeginning, priceEnd, - transferUpToDeposit(counterparty, party, UseValue(decreaseInPrice), - refundAfterDifference(counterparty, party, UseValue(decreaseInPrice)))), + transferUpToDeposit(counterparty, counterpartyDeposit, party, UseValue(decreaseInPrice), + refundAfterDifference(counterparty, counterpartyDeposit, party, partyDeposit, UseValue(decreaseInPrice)))), recordDifference(increaseInPrice, priceEnd, priceBeginning, - transferUpToDeposit(party, counterparty, UseValue(increaseInPrice), - refundAfterDifference(party, counterparty, UseValue(increaseInPrice)))), + transferUpToDeposit(party, partyDeposit, counterparty, UseValue(increaseInPrice), + refundAfterDifference(party, partyDeposit, counterparty, counterpartyDeposit, UseValue(increaseInPrice)))), refundBoth )))))); diff --git a/marlowe-playground-server/contracts/ContractForDifferences.hs b/marlowe-playground-server/contracts/ContractForDifferences.hs index bb73f371bf2..bb00259d1c0 100644 --- a/marlowe-playground-server/contracts/ContractForDifferences.hs +++ b/marlowe-playground-server/contracts/ContractForDifferences.hs @@ -17,12 +17,14 @@ party = Role "Party" counterparty = Role "Counterparty" oracle = Role "Oracle" -depositAmount :: Integer -depositAmount = 100_000_000 +partyDepositAmount, counterpartyDepositAmount :: Integer +partyDepositAmount = 100_000_000 +counterpartyDepositAmount = 100_000_000 -deposit, doubleDeposit :: Value -deposit = Constant depositAmount -doubleDeposit = Constant (depositAmount * 2) +partyDeposit, counterpartyDeposit, bothDeposits :: Value +partyDeposit = Constant partyDepositAmount +counterpartyDeposit = Constant counterpartyDepositAmount +bothDeposits = Constant (partyDepositAmount + counterpartyDepositAmount) priceBeginning, priceEnd :: ChoiceId priceBeginning = ChoiceId "Price at beginning" oracle @@ -32,8 +34,8 @@ decreaseInPrice, increaseInPrice :: ValueId decreaseInPrice = "Decrease in price" increaseInPrice = "Increase in price" -initialDeposit :: Party -> Timeout -> Contract -> Contract -> Contract -initialDeposit by timeout timeoutContinuation continuation = +initialDeposit :: Party -> Value -> Timeout -> Contract -> Contract -> Contract +initialDeposit by deposit timeout timeoutContinuation continuation = When [Case (Deposit by by ada deposit) continuation] timeout timeoutContinuation @@ -57,9 +59,9 @@ recordDifference :: ValueId -> ChoiceId -> ChoiceId -> Contract -> Contract recordDifference name choiceId1 choiceId2 = Let name (SubValue (ChoiceValue choiceId1) (ChoiceValue choiceId2)) -transferUpToDeposit :: Party -> Party -> Value -> Contract -> Contract -transferUpToDeposit from to amount = - Pay from (Account to) ada (Cond (ValueLT amount deposit) amount deposit) +transferUpToDeposit :: Party -> Value -> Party -> Value -> Contract -> Contract +transferUpToDeposit from payerDeposit to amount = + Pay from (Account to) ada (Cond (ValueLT amount payerDeposit) amount payerDeposit) refund :: Party -> Value -> Contract -> Contract refund who amount @@ -67,37 +69,37 @@ refund who amount | otherwise = id refundBoth :: Contract -refundBoth = refund party deposit (refund counterparty deposit Close) +refundBoth = refund party partyDeposit (refund counterparty counterpartyDeposit Close) refundIfGtZero :: Party -> Value -> Contract -> Contract refundIfGtZero who amount continuation | explicitRefunds = If (ValueGT amount (Constant 0)) (refund who amount continuation) continuation | otherwise = continuation -refundUpToDoubleOfDeposit :: Party -> Value -> Contract -> Contract -refundUpToDoubleOfDeposit who amount - | explicitRefunds = refund who $ Cond (ValueGT amount doubleDeposit) doubleDeposit amount +refundUpToBothDeposits :: Party -> Value -> Contract -> Contract +refundUpToBothDeposits who amount + | explicitRefunds = refund who $ Cond (ValueGT amount bothDeposits) bothDeposits amount | otherwise = id -refundAfterDifference :: Party -> Party -> Value -> Contract -refundAfterDifference payer payee difference = - refundIfGtZero payer (SubValue deposit difference) - $ refundUpToDoubleOfDeposit payee (AddValue deposit difference) +refundAfterDifference :: Party -> Value -> Party -> Value -> Value -> Contract +refundAfterDifference payer payerDeposit payee payeeDeposit difference = + refundIfGtZero payer (SubValue payerDeposit difference) + $ refundUpToBothDeposits payee (AddValue payeeDeposit difference) Close contract :: Contract -contract = initialDeposit party 300 Close - $ initialDeposit counterparty 600 (refund party deposit Close) +contract = initialDeposit party partyDeposit 300 Close + $ initialDeposit counterparty counterpartyDeposit 600 (refund party partyDeposit Close) $ oracleInput priceBeginning 900 refundBoth $ wait 1500 $ oracleInput priceEnd 1800 refundBoth $ gtLtEq (ChoiceValue priceBeginning) (ChoiceValue priceEnd) ( recordDifference decreaseInPrice priceBeginning priceEnd - $ transferUpToDeposit counterparty party (UseValue decreaseInPrice) - $ refundAfterDifference counterparty party (UseValue decreaseInPrice) + $ transferUpToDeposit counterparty counterpartyDeposit party (UseValue decreaseInPrice) + $ refundAfterDifference counterparty counterpartyDeposit party partyDeposit (UseValue decreaseInPrice) ) ( recordDifference increaseInPrice priceEnd priceBeginning - $ transferUpToDeposit party counterparty (UseValue increaseInPrice) - $ refundAfterDifference party counterparty (UseValue increaseInPrice) + $ transferUpToDeposit party partyDeposit counterparty (UseValue increaseInPrice) + $ refundAfterDifference party partyDeposit counterparty counterpartyDeposit (UseValue increaseInPrice) ) refundBoth diff --git a/web-common-marlowe/src/Examples/PureScript/ContractForDifferences.purs b/web-common-marlowe/src/Examples/PureScript/ContractForDifferences.purs index 9215c845146..0893b46baef 100644 --- a/web-common-marlowe/src/Examples/PureScript/ContractForDifferences.purs +++ b/web-common-marlowe/src/Examples/PureScript/ContractForDifferences.purs @@ -29,14 +29,20 @@ counterparty = Role "Counterparty" oracle :: Party oracle = Role "Oracle" -depositAmount :: BigInteger -depositAmount = fromInt 100000000 +partyDepositAmount :: BigInteger +partyDepositAmount = (fromInt 100000000) -deposit :: Value -deposit = Constant depositAmount +counterpartyDepositAmount :: BigInteger +counterpartyDepositAmount = (fromInt 100000000) -doubleDeposit :: Value -doubleDeposit = Constant (depositAmount * fromInt 2) +partyDeposit :: Value +partyDeposit = Constant partyDepositAmount + +counterpartyDeposit :: Value +counterpartyDeposit = Constant counterpartyDepositAmount + +bothDeposits :: Value +bothDeposits = Constant (partyDepositAmount + counterpartyDepositAmount) priceBeginning :: ChoiceId priceBeginning = ChoiceId "Price at beginning" oracle @@ -50,8 +56,8 @@ decreaseInPrice = ValueId "Decrease in price" increaseInPrice :: ValueId increaseInPrice = ValueId "Increase in price" -initialDeposit :: Party -> Timeout -> Contract -> Contract -> Contract -initialDeposit by timeout timeoutContinuation continuation = +initialDeposit :: Party -> Value -> Timeout -> Contract -> Contract -> Contract +initialDeposit by deposit timeout timeoutContinuation continuation = When [ Case (Deposit by by ada deposit) continuation ] timeout timeoutContinuation @@ -74,23 +80,23 @@ gtLtEq value1 value2 gtContinuation ltContinuation eqContinuation = recordDifference :: ValueId -> ChoiceId -> ChoiceId -> Contract -> Contract recordDifference name choiceId1 choiceId2 = Let name (SubValue (ChoiceValue choiceId1) (ChoiceValue choiceId2)) -transferUpToDeposit :: Party -> Party -> Value -> Contract -> Contract -transferUpToDeposit from to amount = Pay from (Account to) ada (Cond (ValueLT amount deposit) amount deposit) +transferUpToDeposit :: Party -> Value -> Party -> Value -> Contract -> Contract +transferUpToDeposit from payerDeposit to amount = Pay from (Account to) ada (Cond (ValueLT amount payerDeposit) amount payerDeposit) extendedContract :: Contract extendedContract = - initialDeposit party (Slot $ fromInt 300) Close - $ initialDeposit counterparty (Slot $ fromInt 600) Close + initialDeposit party partyDeposit (Slot $ fromInt 300) Close + $ initialDeposit counterparty counterpartyDeposit (Slot $ fromInt 600) Close $ oracleInput priceBeginning (Slot $ fromInt 900) Close $ wait (Slot $ fromInt 1500) $ oracleInput priceEnd (Slot $ fromInt 1800) Close $ gtLtEq (ChoiceValue priceBeginning) (ChoiceValue priceEnd) ( recordDifference decreaseInPrice priceBeginning priceEnd - $ transferUpToDeposit counterparty party (UseValue decreaseInPrice) + $ transferUpToDeposit counterparty counterpartyDeposit party (UseValue decreaseInPrice) Close ) ( recordDifference increaseInPrice priceEnd priceBeginning - $ transferUpToDeposit party counterparty (UseValue increaseInPrice) + $ transferUpToDeposit party partyDeposit counterparty (UseValue increaseInPrice) Close ) Close