Skip to content

Commit

Permalink
Update contract for differences with oracle example to support two di…
Browse files Browse the repository at this point in the history 
…fferent commitments
  • Loading branch information
@palas
palas committed Jul 22, 2021
1 parent 982dd8b commit 3b8c249
Show file tree
Hide file tree
Showing 3 changed files with 71 additions and 61 deletions.
44 changes: 23 additions & 21 deletions marlowe-playground-client/src/Examples/JS/Contracts.purs
View file
Expand Up @@ -465,9 +465,11 @@ contractForDifferencesWithOracle =
const counterparty: Party = Role("Counterparty");
const oracle: Party = Role("kraken");
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: Value = Constant(100_000_000n);
const priceEnd: ValueId = ValueId("Price at end");
Expand All @@ -478,7 +480,7 @@ contractForDifferencesWithOracle =
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 @@ -502,9 +504,9 @@ contractForDifferencesWithOracle =
eqContinuation))
}
function recordDelta(name: ValueId, choiceId1: ChoiceId, choiceId2: ChoiceId,
function recordEndPrice(name: ValueId, choiceId1: ChoiceId, choiceId2: ChoiceId,
continuation: Contract): Contract {
return Let(name, Scale(1n, 100_000_000n, MulValue(ChoiceValue(choiceId1), ChoiceValue(choiceId2))),
return Let(name, Scale(1n, 10_000_000_000_000_000n, MulValue(priceBeginning, MulValue(ChoiceValue(choiceId1), ChoiceValue(choiceId2)))),
continuation);
}
Expand All @@ -513,8 +515,8 @@ contractForDifferencesWithOracle =
return Let(name, SubValue(val1, val2), 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 @@ -526,7 +528,7 @@ contractForDifferencesWithOracle =
}
}
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 @@ -536,35 +538,35 @@ contractForDifferencesWithOracle =
}
}
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(exchangeBeginning, 900n, refundBoth,
wait(1500n,
oracleInput(exchangeEnd, 1800n, refundBoth,
recordDelta(priceEnd, exchangeBeginning, exchangeEnd,
recordEndPrice(priceEnd, exchangeBeginning, exchangeEnd,
gtLtEq(priceBeginning, UseValue(priceEnd),
recordDifference(decreaseInPrice, priceBeginning, UseValue(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, UseValue(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
52 changes: 27 additions & 25 deletions marlowe-playground-server/contracts/ContractForDifferencesWithOracle.hs
View file
Expand Up @@ -17,12 +17,14 @@ party = Role "Party"
counterparty = Role "Counterparty"
oracle = Role "kraken"

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 :: Value
priceBeginning = Constant 100_000_000
Expand All @@ -38,8 +40,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 @@ -61,53 +63,53 @@ gtLtEq value1 value2 gtContinuation ltContinuation eqContinuation =

recordEndPrice :: ValueId -> ChoiceId -> ChoiceId -> Contract -> Contract
recordEndPrice name choiceId1 choiceId2 =
Let name (Scale (1%100_000_000) (MulValue (ChoiceValue choiceId1) (ChoiceValue choiceId2)))
Let name (Scale (1%10_000_000_000_000_000) (MulValue priceBeginning (MulValue (ChoiceValue choiceId1) (ChoiceValue choiceId2))))

recordDifference :: ValueId -> Value -> Value -> Contract -> Contract
recordDifference name val1 val2 = Let name (SubValue val1 val2)

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 exchangeBeginning 900 refundBoth
$ wait 1500
$ oracleInput exchangeEnd 1800 refundBoth
$ recordEndPrice priceEnd exchangeBeginning exchangeEnd
$ gtLtEq priceBeginning (UseValue priceEnd)
( recordDifference decreaseInPrice priceBeginning (UseValue 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 (UseValue 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
36 changes: 21 additions & 15 deletions web-common-marlowe/src/Examples/PureScript/ContractForDifferencesWithOracle.purs
View file
Expand Up @@ -29,14 +29,20 @@ counterparty = Role "Counterparty"
oracle :: Party
oracle = Role "kraken"

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 :: Value
priceBeginning = Constant (fromInt 100000000)
Expand All @@ -56,8 +62,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 @@ -78,29 +84,29 @@ gtLtEq value1 value2 gtContinuation ltContinuation eqContinuation =
eqContinuation

recordEndPrice :: ValueId -> ChoiceId -> ChoiceId -> Contract -> Contract
recordEndPrice name choiceId1 choiceId2 = Let name (Scale (Rational one (fromInt 100000000)) (MulValue (ChoiceValue choiceId1) (ChoiceValue choiceId2)))
recordEndPrice name choiceId1 choiceId2 = Let name (Scale (Rational one ((fromInt 100000000) * (fromInt 100000000))) (MulValue priceBeginning (MulValue (ChoiceValue choiceId1) (ChoiceValue choiceId2))))

recordDifference :: ValueId -> Value -> Value -> Contract -> Contract
recordDifference name val1 val2 = Let name (SubValue val1 val2)

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 exchangeBeginning (Slot $ fromInt 900) Close
$ wait (Slot $ fromInt 1500)
$ oracleInput exchangeEnd (Slot $ fromInt 1800) Close
$ recordEndPrice priceEnd exchangeBeginning exchangeEnd
$ gtLtEq priceBeginning (UseValue priceEnd)
( recordDifference decreaseInPrice priceBeginning (UseValue priceEnd)
$ transferUpToDeposit counterparty party (UseValue decreaseInPrice)
$ transferUpToDeposit counterparty counterpartyDeposit party (UseValue decreaseInPrice)
Close
)
( recordDifference increaseInPrice (UseValue priceEnd) priceBeginning
$ transferUpToDeposit party counterparty (UseValue increaseInPrice)
$ transferUpToDeposit party partyDeposit counterparty (UseValue increaseInPrice)
Close
)
Close

0 comments on commit 3b8c249

Please sign in to comment.