Skip to content

Commit

Permalink
Update contract for differences without oracle example to support two…
Browse files Browse the repository at this point in the history 
… different commitments
  • Loading branch information
@palas
palas committed Jul 26, 2021
1 parent 3b8c249 commit 74442e0
Show file tree
Hide file tree
Showing 3 changed files with 70 additions and 58 deletions.
44 changes: 24 additions & 20 deletions marlowe-playground-client/src/Examples/JS/Contracts.purs
View file
Expand Up @@ -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,
Expand All @@ -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 {
Expand All @@ -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) {
Expand All @@ -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
))))));
Expand Down
50 changes: 26 additions & 24 deletions marlowe-playground-server/contracts/ContractForDifferences.hs
View file
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -57,47 +59,47 @@ 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
| explicitRefunds = Pay who (Party who) ada 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
34 changes: 20 additions & 14 deletions web-common-marlowe/src/Examples/PureScript/ContractForDifferences.purs
View file
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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

0 comments on commit 74442e0

Please sign in to comment.