From ab9a40dc271d326f57f686dde372218c4f4be21e Mon Sep 17 00:00:00 2001 From: Ryan Trinkle Date: Thu, 4 May 2023 14:52:52 -0400 Subject: [PATCH] Initial commit --- .gitignore | 3 + README.md | 2 + daml.yaml | 11 + daml/Exercise1/Currency.daml | 185 ++++++++++++ daml/Exercise1/Decimals.daml | 220 ++++++++++++++ daml/Exercise1/KYC.daml | 27 ++ daml/Exercise1/Observers.daml | 55 ++++ daml/Exercise2/Cash.daml | 108 +++++++ daml/Exercise2/Scripts.daml | 102 +++++++ daml/Exercise2/Upgrade.daml | 122 ++++++++ daml/Exercise3/Solutions/Bonds.daml | 116 ++++++++ .../Solutions/Currency/Bonus/Interfaces.daml | 133 +++++++++ .../Solutions/Currency/Bonus/Scripts.daml | 67 +++++ .../Solutions/Currency/Bonus/Swap.daml | 49 ++++ daml/Exercise3/Solutions/Currency/Cash.daml | 46 +++ .../Exercise3/Solutions/Currency/Scripts.daml | 109 +++++++ .../Exercise3/Solutions/Modularized/Cash.daml | 41 +++ .../Solutions/Modularized/Interfaces.daml | 88 ++++++ .../Solutions/Modularized/Scripts.daml | 118 ++++++++ .../Exercise3/Solutions/Modularized/Swap.daml | 45 +++ daml/Exercise3/Swaps.daml | 275 ++++++++++++++++++ daml/Initial/Cash.daml | 78 +++++ daml/Initial/Scripts.daml | 86 ++++++ 23 files changed, 2086 insertions(+) create mode 100644 .gitignore create mode 100644 README.md create mode 100644 daml.yaml create mode 100644 daml/Exercise1/Currency.daml create mode 100644 daml/Exercise1/Decimals.daml create mode 100644 daml/Exercise1/KYC.daml create mode 100644 daml/Exercise1/Observers.daml create mode 100644 daml/Exercise2/Cash.daml create mode 100644 daml/Exercise2/Scripts.daml create mode 100644 daml/Exercise2/Upgrade.daml create mode 100644 daml/Exercise3/Solutions/Bonds.daml create mode 100644 daml/Exercise3/Solutions/Currency/Bonus/Interfaces.daml create mode 100644 daml/Exercise3/Solutions/Currency/Bonus/Scripts.daml create mode 100644 daml/Exercise3/Solutions/Currency/Bonus/Swap.daml create mode 100644 daml/Exercise3/Solutions/Currency/Cash.daml create mode 100644 daml/Exercise3/Solutions/Currency/Scripts.daml create mode 100644 daml/Exercise3/Solutions/Modularized/Cash.daml create mode 100644 daml/Exercise3/Solutions/Modularized/Interfaces.daml create mode 100644 daml/Exercise3/Solutions/Modularized/Scripts.daml create mode 100644 daml/Exercise3/Solutions/Modularized/Swap.daml create mode 100644 daml/Exercise3/Swaps.daml create mode 100644 daml/Initial/Cash.daml create mode 100644 daml/Initial/Scripts.daml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7fedfa0 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +**/*.log +.daml +log diff --git a/README.md b/README.md new file mode 100644 index 0000000..8664787 --- /dev/null +++ b/README.md @@ -0,0 +1,2 @@ +# upgrading-daml-training +Code snippets for the upgrading daml training workshop diff --git a/daml.yaml b/daml.yaml new file mode 100644 index 0000000..ce03e04 --- /dev/null +++ b/daml.yaml @@ -0,0 +1,11 @@ +sdk-version: 2.4.0 +name: upgrading-daml-training +version: 1.0.0 +source: daml +start-navigator: false +dependencies: +- daml-prim +- daml-stdlib +- daml-script +build-options: +- --target=1.15 \ No newline at end of file diff --git a/daml/Exercise1/Currency.daml b/daml/Exercise1/Currency.daml new file mode 100644 index 0000000..54fd54b --- /dev/null +++ b/daml/Exercise1/Currency.daml @@ -0,0 +1,185 @@ +{-# LANGUAGE ApplicativeDo #-} + +module Exercise1.Currency where + +import Initial.Cash qualified as Old +import Initial.Scripts + +import DA.Action +import DA.Assert +import DA.Foldable (forA_) +import Daml.Script + +template Position + with + issuer : Party + owner : Party + quantity : Decimal + currency : Text + obs : [Party] + where + signatory [issuer, owner] + observer obs + + choice Transfer : ContractId Position + with + newOwner : Party + controller [owner, newOwner] + do + create this with + owner = newOwner + obs = [] + + choice Propose_Transfer : ContractId TransferProposal + with + newOwner : Party + controller owner + do + create TransferProposal with + position = this + newOwner + + choice Split : (ContractId Position, [ContractId Position]) + with + splitQuantities : [Decimal] + controller owner + do + remCid <- create this with quantity = this.quantity - sum splitQuantities + splitCids <- forA splitQuantities (\splitQuantity -> create this with + quantity = splitQuantity + ) + return (remCid, splitCids) + + choice Merge : ContractId Position + with + otherCids : [ContractId Position] + controller owner + do + quantities <- forA otherCids (\otherCid -> do + other <- fetch otherCid + other === this with + quantity = other.quantity + obs = other.obs + archive otherCid + return other.quantity) + create this with + quantity = quantity + sum quantities + +template TransferProposal + with + position : Position + newOwner : Party + where + signatory (signatory position) + observer newOwner::(observer position) + + choice Accept : ContractId Position + controller newOwner + do + create position with + owner = newOwner + obs = [] + + choice Cancel : ContractId Position + controller position.owner + do + create position + +-- In a separate package: + +template UpgradeProposal + with + bank : Party + counterparty : Party + where + signatory bank + observer counterparty + + choice Accept_Upgrade : ContractId Upgrader + controller counterparty + do + create Upgrader with .. + +-- As part of the upgrade we have to decide what to do with the +-- extra decimal places. +-- In this example, we collect them up and issue a new position, +-- rounded to two decimals. +-- Any additional left-over is left non-upgraded. +template Upgrader + with + bank : Party + counterparty : Party + where + signatory bank, counterparty + + nonconsuming choice Run_Upgrade : () + with + positionCids : [ContractId Old.Position] + tpCids : [ContractId Old.TransferProposal] + controller bank + do + forA_ positionCids (\positionCid -> do + Old.Position{..} <- fetch positionCid + owner === counterparty + issuer === bank + archive positionCid + create Position with currency = "USD"; .. + ) + + forA_ tpCids (\tpCid -> do + Old.TransferProposal{position = Old.Position{..}; ..} <- fetch tpCid + owner === counterparty + issuer === bank + archive tpCid + create TransferProposal with + position = Position with currency = "USD"; .. + .. + ) + + + +while : (Action m) => m Bool -> m () +while run = do + continue <- run + when continue (while run) + +test_upgrade : Script () +test_upgrade = do + (tps@TestParties{..}, tus@TestUsers{..}) <- init_cash + + -- Bank proposes the upgrade + submitUser uBank do + createCmd UpgradeProposal with + bank = pBank + counterparty = pAlice + createCmd UpgradeProposal with + bank = pBank + counterparty = pBob + return () + + -- Alice and Bob accept + [(pa, _)] <- query @UpgradeProposal pAlice + submitUser uAlice do exerciseCmd pa Accept_Upgrade + [(pb, _)] <- query @UpgradeProposal pBob + submitUser uBob do exerciseCmd pb Accept_Upgrade + + -- Run upgrade in batches of some reasonable size. + let batchSize = 10 + upgraders <- query @Upgrader pBank + forA_ upgraders (\(upgraderCid, upgrader) -> do + while do + poss <- take batchSize <$> queryFilter @Old.Position pBank + (\pos -> pos.issuer == pBank && pos.owner == upgrader.counterparty) + tps <- take (batchSize - length poss) <$> queryFilter @Old.TransferProposal pBank + (\tp -> tp.position.issuer == pBank && tp.position.owner == upgrader.counterparty) + + if (length poss + length tps > 0) + then do + submitUser uBank do + exerciseCmd upgraderCid Run_Upgrade with + positionCids = map fst poss + tpCids = map fst tps + return True + else return False + return () + ) \ No newline at end of file diff --git a/daml/Exercise1/Decimals.daml b/daml/Exercise1/Decimals.daml new file mode 100644 index 0000000..66b13c6 --- /dev/null +++ b/daml/Exercise1/Decimals.daml @@ -0,0 +1,220 @@ +{-# LANGUAGE ApplicativeDo #-} + +module Exercise1.Decimals where + +import Initial.Cash qualified as Old +import Initial.Scripts + +import DA.Action +import DA.Assert +import DA.Foldable (forA_) +import Daml.Script + +roundDown : Decimal -> Decimal +roundDown (d : Decimal) = (intToDecimal (truncate (d * 100.0))) / 100.0 + +template Position + with + issuer : Party + owner : Party + quantity : Decimal + obs : [Party] + where + signatory [issuer, owner] + observer obs + ensure quantity > 0.0 && (roundDown quantity == quantity) + + choice Transfer : ContractId Position + with + newOwner : Party + controller [owner, newOwner] + do + create this with + owner = newOwner + obs = [] + + choice Propose_Transfer : ContractId TransferProposal + with + newOwner : Party + controller owner + do + create TransferProposal with + position = this + newOwner + + choice Split : (ContractId Position, [ContractId Position]) + with + splitQuantities : [Decimal] + controller owner + do + remCid <- create this with quantity = this.quantity - sum splitQuantities + splitCids <- forA splitQuantities (\splitQuantity -> create this with + quantity = splitQuantity + ) + return (remCid, splitCids) + + choice Merge : ContractId Position + with + otherCids : [ContractId Position] + controller owner + do + quantities <- forA otherCids (\otherCid -> do + other <- fetch otherCid + other === this with + quantity = other.quantity + obs = other.obs + archive otherCid + return other.quantity) + create this with + quantity = quantity + sum quantities + +template TransferProposal + with + position : Position + newOwner : Party + where + signatory (signatory position) + observer newOwner::(observer position) + + choice Accept : ContractId Position + controller newOwner + do + create position with + owner = newOwner + obs = [] + + choice Cancel : ContractId Position + controller position.owner + do + create position + +-- In a separate package: + +template UpgradeProposal + with + bank : Party + counterparty : Party + where + signatory bank + observer counterparty + + choice Accept_Upgrade : ContractId Upgrader + controller counterparty + do + create Upgrader with .. + +-- As part of the upgrade we have to decide what to do with the +-- extra decimal places. +-- In this example, we collect them up and issue a new position, +-- rounded to two decimals. +-- Any additional left-over is left non-upgraded. +template Upgrader + with + bank : Party + counterparty : Party + where + signatory bank, counterparty + + nonconsuming choice Run_Upgrade : () + with + positionCids : [ContractId Old.Position] + tpCids : [ContractId Old.TransferProposal] + controller bank + do + let + splitPosition Old.Position{..} = + let newQuantity = roundDown quantity + newPosition = Position with quantity = newQuantity; .. + rem = quantity - newQuantity + in (newPosition, rem) + cyclePosition p = do + let (newPosition, rem) = splitPosition p + create newPosition + return rem + cycleTp Old.TransferProposal{..} = do + let (newPosition, rem) = splitPosition position + create TransferProposal with position = newPosition; .. + return rem + + posRems <- forA positionCids (\positionCid -> do + position <- fetch positionCid + position.owner === counterparty + position.issuer === bank + archive positionCid + cyclePosition position + ) + + tpRems <- forA tpCids (\tpCid -> do + tp <- fetch tpCid + tp.position.owner === counterparty + tp.position.issuer === bank + archive tpCid + cycleTp tp + ) + + let + totalRem = sum posRems + sum tpRems + roundedRems = roundDown totalRem + remRem = totalRem - roundedRems + + + when (roundedRems > 0.0) do + void $ create Position with + issuer = bank + owner = counterparty + quantity = roundedRems + obs = [] + + when (remRem > 0.0) do + void $ create Old.Position with + issuer = bank + owner = counterparty + quantity = remRem + obs = [] + + +while : (Action m) => m Bool -> m () +while run = do + continue <- run + when continue (while run) + +test_upgrade : Script () +test_upgrade = do + (tps@TestParties{..}, tus@TestUsers{..}) <- init_cash + + -- Bank proposes the upgrade + submitUser uBank do + createCmd UpgradeProposal with + bank = pBank + counterparty = pAlice + createCmd UpgradeProposal with + bank = pBank + counterparty = pBob + return () + + -- Alice and Bob accept + [(pa, _)] <- query @UpgradeProposal pAlice + submitUser uAlice do exerciseCmd pa Accept_Upgrade + [(pb, _)] <- query @UpgradeProposal pBob + submitUser uBob do exerciseCmd pb Accept_Upgrade + + -- Run upgrade in batches of some reasonable size. + let batchSize = 10 + upgraders <- query @Upgrader pBank + forA_ upgraders (\(upgraderCid, upgrader) -> do + while do + poss <- take batchSize <$> queryFilter @Old.Position pBank + (\pos -> pos.issuer == pBank && pos.owner == upgrader.counterparty) + tps <- take (batchSize - length poss) <$> queryFilter @Old.TransferProposal pBank + (\tp -> tp.position.issuer == pBank && tp.position.owner == upgrader.counterparty) + + if (length poss + length tps > 0) + then do + submitUser uBank do + exerciseCmd upgraderCid Run_Upgrade with + positionCids = map fst poss + tpCids = map fst tps + return True + else return False + return () + ) \ No newline at end of file diff --git a/daml/Exercise1/KYC.daml b/daml/Exercise1/KYC.daml new file mode 100644 index 0000000..4dee1a9 --- /dev/null +++ b/daml/Exercise1/KYC.daml @@ -0,0 +1,27 @@ +module Exercise1.KYC where + +import Initial.Scripts + +import Daml.Script + +template KYC + with + bank : Party + counterparty : Party + address : Text + where + signatory bank + observer counterparty + +test_set_obs : Script () +test_set_obs = script do + (tps@TestParties{..}, tus@TestUsers{..}) <- init_cash + + -- Bank captures KYC data + rules <- submitUser uBank do + createCmd KYC with + bank = pBank + counterparty = pAlice + address = "Earth" + + return () \ No newline at end of file diff --git a/daml/Exercise1/Observers.daml b/daml/Exercise1/Observers.daml new file mode 100644 index 0000000..bd7218e --- /dev/null +++ b/daml/Exercise1/Observers.daml @@ -0,0 +1,55 @@ +module Exercise1.Observers where + +import Initial.Cash +import Initial.Scripts + +import DA.Assert +import DA.Foldable (forA_) +import Daml.Script + +template AdditionalRules + with + bank : Party + bankReader : Party + where + signatory bank + observer bankReader + + nonconsuming choice Set_Observers : ContractId Position + with + owner : Party + positionCid : ContractId Position + new_obs : [Party] + controller owner + do + position <- fetch positionCid + owner === position.owner + bank === position.issuer + + archive positionCid + create position with obs = new_obs + +test_set_obs : Script () +test_set_obs = script do + (tps@TestParties{..}, tus@TestUsers{..}) <- init_cash + + -- Create a reader party and give access to Alice and Bob + pBankReader <- allocateParty "BankReader" + grantUserRights uAlice [CanReadAs pBankReader] + grantUserRights uBob [CanReadAs pBankReader] + + -- Bank Issues the new rule + rules <- submitUser uBank do + createCmd AdditionalRules with + bank = pBank + bankReader = pBankReader + + -- Alice can make Bob observer on all her positions + alicePositions <- query @Position pAlice + forA_ (alicePositions) (\(cid, _) -> do + submitUser uAlice do + exerciseCmd rules Set_Observers with + owner = pAlice + positionCid = cid + new_obs = [pBob] + ) diff --git a/daml/Exercise2/Cash.daml b/daml/Exercise2/Cash.daml new file mode 100644 index 0000000..95881db --- /dev/null +++ b/daml/Exercise2/Cash.daml @@ -0,0 +1,108 @@ +module Exercise2.Cash where + +import DA.Assert + +template Position + with + issuer : Party + owner : Party + quantity : Decimal + obs : [Party] + where + signatory [issuer, owner] + observer obs + ensure quantity > 0.0 + +template TransferProposal + with + position : Position + newOwner : Party + where + signatory (signatory position) + observer newOwner::(observer position) + +template CashRules + with + bank : Party + bankReader : Party + where + signatory bank + observer bankReader + + nonconsuming choice Transfer : ContractId Position + with + owner : Party + newOwner : Party + cid : ContractId Position + controller [owner, newOwner] + do + pos <- fetch cid + pos.issuer === bank + pos.owner === owner + create pos with + owner = newOwner + obs = [] + + nonconsuming choice Propose_Transfer : ContractId TransferProposal + with + owner : Party + newOwner : Party + cid : ContractId Position + controller owner + do + pos <- fetch cid + pos.issuer === bank + pos.owner === owner + create TransferProposal with + position = pos + newOwner + + nonconsuming choice Redistribute : (ContractId Position, [ContractId Position]) + with + owner : Party + cids : [ContractId Position] + splitQuantities : [Decimal] + controller owner + do + qs <- forA cids (\cid -> do + pos <- fetch cid + pos.issuer === bank + pos.owner === owner + archive cid + return pos.quantity + ) + let + total = sum qs + issuer = bank + obs = [] + remCid <- create Position with quantity = total - sum splitQuantities; .. + splitCids <- forA splitQuantities (\splitQuantity -> create Position with + quantity = splitQuantity + .. + ) + return (remCid, splitCids) + + nonconsuming choice Accept_TransferProposal : ContractId Position + with + newOwner : Party + tpCid : ContractId TransferProposal + controller newOwner + do + tp <- fetch tpCid + tp.position.issuer === bank + tp.newOwner === newOwner + create tp.position with + owner = newOwner + obs = [] + + nonconsuming choice Cancel : ContractId Position + with + owner : Party + tpCid : ContractId TransferProposal + controller owner + do + tp <- fetch tpCid + tp.position.issuer === bank + tp.position.owner === owner + create tp.position + diff --git a/daml/Exercise2/Scripts.daml b/daml/Exercise2/Scripts.daml new file mode 100644 index 0000000..6b3d4a3 --- /dev/null +++ b/daml/Exercise2/Scripts.daml @@ -0,0 +1,102 @@ +module Exercise2.Scripts where + +import Exercise2.Cash + +import Daml.Script +import DA.Action +import DA.Foldable (forA_) + +data TestParties = TestParties with + pBank : Party + pAlice : Party + pBob : Party + +data TestUsers = TestUsers with + uBank : UserId + uAlice : UserId + uBob : UserId + +init_parties : Script TestParties +init_parties = do + let allocate t = allocatePartyWithHint t (PartyIdHint t) + pBank <- allocate "Bank" + pAlice <- allocate "Alice" + pBob <- allocate "Bob" + + return (TestParties with ..) + +init_users : TestParties -> Script TestUsers +init_users TestParties{..} = do + let + makeUser t p rs = do + uid <- validateUserId t + let + u = User with + userId = uid + primaryParty = Some p + createUser u (CanActAs p :: rs) + return uid + uBank <- makeUser "bank" pBank [] + uAlice <- makeUser "alice" pAlice [] + uBob <- makeUser "bob" pBob [] + + return (TestUsers with ..) + +init_cash : Script (TestParties, TestUsers) +init_cash = do + ps@TestParties{..} <- init_parties + us@TestUsers{..} <- init_users ps + + -- Create a reader party and give access to Alice and Bob + pBankReader <- allocateParty "BankReader" + grantUserRights uAlice [CanReadAs pBankReader] + grantUserRights uBob [CanReadAs pBankReader] + + -- Bank Issues the new rule + rules <- submitUser uBank do + createCmd CashRules with + bank = pBank + bankReader = pBankReader + + -- Issue some cash in the form of transfer proposals. + let position = Position with + issuer = pBank + owner = pBank + obs = [] + quantity = 1.0 + + -- 200 positions of $1 for Alice + replicateA_ 20 $ submitUser uBank do + replicateA_ 10 $ createCmd TransferProposal with + position + newOwner = pAlice + + -- 100 positions for Bob + replicateA_ 10 $ submitUser uBank do + replicateA_ 10 $ createCmd TransferProposal with + position + newOwner = pBob + + -- Accept all transfer proposals + let + accept_all (u, p) = do + proposals <- queryFilter @TransferProposal p (\tp -> tp.newOwner == p) + submitUser u do + forA_ proposals (\(cid, _) -> + exerciseCmd rules Accept_TransferProposal with + tpCid = cid + newOwner = p + ) + forA_ [(uAlice, pAlice), (uBob, pBob)] accept_all + + -- Alice transfers 50 of her positions to Bob + alicePositions <- query @Position pAlice + forA_ (take 50 alicePositions) (\(cid, _) -> do + submitUser uAlice do + exerciseCmd rules Propose_Transfer with + owner = pAlice + newOwner = pBob + cid + ) + + return (ps, us) \ No newline at end of file diff --git a/daml/Exercise2/Upgrade.daml b/daml/Exercise2/Upgrade.daml new file mode 100644 index 0000000..0b5ef75 --- /dev/null +++ b/daml/Exercise2/Upgrade.daml @@ -0,0 +1,122 @@ +module Exercise2.Upgrade where + + +import Exercise2.Cash qualified as Old (CashRules(..)) +import Exercise2.Cash (Position(..), TransferProposal(..)) +import Exercise2.Scripts + +import DA.Assert +import Daml.Script + +roundDown : Decimal -> Decimal +roundDown (d : Decimal) = (intToDecimal (truncate (d * 100.0))) / 100.0 + +template CashRules + with + bank : Party + bankReader : Party + where + signatory bank + observer bankReader + + nonconsuming choice Transfer : ContractId Position + with + owner : Party + newOwner : Party + cid : ContractId Position + controller [owner, newOwner] + do + pos <- fetch cid + pos.issuer === bank + pos.owner === owner + create pos with + owner = newOwner + obs = [] + + nonconsuming choice Propose_Transfer : ContractId TransferProposal + with + owner : Party + newOwner : Party + cid : ContractId Position + controller owner + do + pos <- fetch cid + pos.issuer === bank + pos.owner === owner + create TransferProposal with + position = pos + newOwner + + nonconsuming choice Redistribute : (ContractId Position, [ContractId Position]) + with + owner : Party + cids : [ContractId Position] + splitQuantities : [Decimal] + controller owner + do + qs <- forA cids (\cid -> do + pos <- fetch cid + pos.issuer === bank + pos.owner === owner + archive cid + return pos.quantity + ) + let + total = sum qs + issuer = bank + obs = [] + remCid <- create Position with quantity = total - sum splitQuantities; .. + splitCids <- forA splitQuantities (\splitQuantity -> do + splitQuantity === roundDown splitQuantity + create Position with + quantity = splitQuantity + .. + ) + return (remCid, splitCids) + + nonconsuming choice Accept_TransferProposal : ContractId Position + with + newOwner : Party + tpCid : ContractId TransferProposal + controller newOwner + do + tp <- fetch tpCid + tp.position.issuer === bank + tp.newOwner === newOwner + create tp.position with + owner = newOwner + obs = [] + + nonconsuming choice Cancel : ContractId Position + with + owner : Party + tpCid : ContractId TransferProposal + controller owner + do + tp <- fetch tpCid + tp.position.issuer === bank + tp.position.owner === owner + create tp.position + +test_upgrade : Script () +test_upgrade = script do + (tps@TestParties{..}, tus@TestUsers{..}) <- init_cash + + -- Create a reader party and give access to Alice and Bob + pBankReader <- allocateParty "BankReader" + grantUserRights uAlice [CanReadAs pBankReader] + grantUserRights uBob [CanReadAs pBankReader] + + -- Bank Issues the new rule + rules <- submitUser uBank do + createCmd CashRules with + bank = pBank + bankReader = pBankReader + + -- Bank removes the old rules + [(cid, _)] <- query @Old.CashRules pBank + submitUser uBank do + archiveCmd cid + + -- No further upgrade needed as there are no existing assets with + -- More than two decimals. \ No newline at end of file diff --git a/daml/Exercise3/Solutions/Bonds.daml b/daml/Exercise3/Solutions/Bonds.daml new file mode 100644 index 0000000..8838f89 --- /dev/null +++ b/daml/Exercise3/Solutions/Bonds.daml @@ -0,0 +1,116 @@ +module Exercise3.Solutions.Bonds where + +import Exercise3.Solutions.Modularized.Interfaces +import Exercise3.Solutions.Modularized.Swap +import Exercise3.Solutions.Modularized.Cash +import Exercise3.Solutions.Modularized.Scripts + +import Daml.Script + +import DA.Action +import DA.Foldable (forA_) + +template Bond + with + issuer : Party + owner : Party + quantity : Decimal + obs : [Party] + where + signatory [issuer, owner] + observer obs + + interface instance IAsset for Bond where + view = VAsset with + assetType = "Bond" + .. + set_obs newObs = toInterface (this with obs = newObs) + set_owner newOwner = toInterface (this with owner = newOwner) + set_quantity newQuantity = toInterface (this with quantity = newQuantity) + transfer_for newOwner = toInterface $ BondTransferProposal with bond = this; .. + +-- Workaround for https://github.com/digital-asset/daml/issues/15459 +myView2 = view + +template BondTransferProposal + with + newOwner : Party + bond : Bond + where + signatory (signatory bond) + observer newOwner + + interface instance IAssetTransferProposal for BondTransferProposal where + view = VAssetTransferProposal with + newOwner = newOwner + vasset = myView2 (toInterface @IAsset bond) + asset = toInterface @IAsset bond + + +init_bonds : TestParties -> TestUsers -> Script () +init_bonds TestParties{..} TestUsers{..} = do + -- Issue some bonds in the form of transfer proposals. + let bond = Bond with + issuer = pBank + owner = pBank + obs = [] + quantity = 1.0 + + -- 2 positions for Alice + replicateA_ 1 $ submitUser uBank do + replicateA_ 2 $ createCmd BondTransferProposal with + bond + newOwner = pAlice + + -- 1 positionsfor Bob + replicateA_ 1 $ submitUser uBank do + replicateA_ 1 $ createCmd BondTransferProposal with + bond + newOwner = pBob + + -- Accept all transfer proposals + let + accept_all p = do + proposals <- queryFilter @BondTransferProposal p (\tp -> tp.newOwner == p) + submit p do + forA_ proposals (\(cid, _) -> exerciseCmd (toInterfaceContractId @IAssetTransferProposal cid) Accept_TransferProposal) + forA_ [pAlice, pBob] accept_all + + -- Alice transfers 1 of her positions to Bob + alicePositions <- query @Bond pAlice + forA_ (take 1 alicePositions) (\(cid, _) -> do + submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Propose_Transfer with + newOwner = pBob + ) + + +test_bond : Script () +test_bond = script do + (tps@TestParties{..}, tus@TestUsers{..}) <- test_swap + + init_bonds tps tus + + -- Swap cash for bond + -- Alice proposes a new swap, Cash for Bond + (cid, posa)::_ <- query @Cash pAlice + cid <- submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Set_Observers with newObs = [pBob] + + let offerSpec = (pBank, "Cash", posa.quantity) + requestedSpec = (pBank, "Bond", posa.quantity) + swapCid <- submitUser uAlice do + createCmd AssetSwapProposal with + requester = pAlice + receiver = pBob + offerSpec + requestedSpec + offerCid = toInterfaceContractId @IAsset cid + + -- Bob accepts using a Bond. + (cid, _)::_ <- queryFilter @Bond pBob (\posb -> posb.owner == pBob && posb.quantity == posa.quantity) + submitUser uBob do + exerciseCmd swapCid Settle with requestedCid = toInterfaceContractId @IAsset cid + + + return () \ No newline at end of file diff --git a/daml/Exercise3/Solutions/Currency/Bonus/Interfaces.daml b/daml/Exercise3/Solutions/Currency/Bonus/Interfaces.daml new file mode 100644 index 0000000..565c10c --- /dev/null +++ b/daml/Exercise3/Solutions/Currency/Bonus/Interfaces.daml @@ -0,0 +1,133 @@ +-- This should be its own package! + +module Exercise3.Solutions.Currency.Bonus.Interfaces where + +-- This module is not really needed as part of the solution. +-- It demonstrates how to also upgrade in such a way that +-- "Cash" becomes "USD" and "Cash_V2 CHF" becomes merely "CHF". + +import Exercise3.Solutions.Modularized.Cash qualified as V1 +import Exercise3.Solutions.Currency.Cash qualified as V2 + +import DA.Assert + +data VAsset = VAsset with + issuer : Party + owner : Party + assetType : Text + quantity : Decimal + obs : [Party] + deriving (Eq, Show) + +data VAssetTransferProposal = VAssetTransferProposal with + vasset : VAsset + newOwner : Party + deriving (Eq, Show) + +-- Workaround for https://github.com/digital-asset/daml/issues/15459 +myView = view + +interface IAssetTransferProposal where + viewtype VAssetTransferProposal + asset : IAsset + + choice Accept_TransferProposal : ContractId IAsset + controller (view this).newOwner + do + create $ set_owner (asset this) (view this).newOwner + + choice Reject_TransferProposal : ContractId IAsset + controller (view this).newOwner + do + create $ asset this + + -- Implement the new interface for old transfer proposals. + interface instance IAssetTransferProposal for V1.CashTransferProposal where + view = VAssetTransferProposal with + newOwner = newOwner + vasset = myView (toInterface @IAsset cash) + asset = toInterface @IAsset cash + + -- Implement the new interface for new transfer proposals. + interface instance IAssetTransferProposal for V2.CashTransferProposal where + view = VAssetTransferProposal with + newOwner = newOwner + vasset = myView (toInterface @IAsset cash) + asset = toInterface @IAsset cash + + +interface IAsset where + viewtype VAsset + set_owner : Party -> IAsset + set_obs : [Party] -> IAsset + set_quantity : Decimal -> IAsset + transfer_for : Party -> IAssetTransferProposal + + choice Transfer : ContractId IAsset + with + newOwner : Party + controller [(view this).owner, newOwner] + do + create $ set_owner (set_obs this []) newOwner + + choice Split : (ContractId IAsset, [ContractId IAsset]) + with + splitQuantities : [Decimal] + controller (view this).owner + do + remCid <- create $ set_quantity this ((view this).quantity - sum splitQuantities) + splitCids <- forA splitQuantities (\splitQuantity -> create$ set_quantity this splitQuantity) + return (remCid, splitCids) + + choice Merge : ContractId IAsset + with + otherCids : [ContractId IAsset] + controller (view this).owner + do + quantities <- forA otherCids (\otherCid -> do + other <- fetch otherCid + let vo = view other + vo === (view this) with + quantity = vo.quantity + obs = vo.obs + exercise otherCid Archive_Asset + return vo.quantity) + create $ set_quantity this ((view this).quantity + sum quantities) + + choice Propose_Transfer : ContractId IAssetTransferProposal + with + newOwner : Party + controller (view this).owner + do + create (transfer_for this newOwner) + + choice Set_Observers : ContractId IAsset + with + newObs : [Party] + controller (view this).owner + do + create $ set_obs this newObs + + choice Archive_Asset : () + controller (signatory this) + do return () + + -- Implement the new interface for old cash, setting currency to USD. + interface instance IAsset for V1.Cash where + view = VAsset with + assetType = "USD" + .. + set_obs newObs = toInterface (this with obs = newObs) + set_owner newOwner = toInterface (this with owner = newOwner) + set_quantity newQuantity = toInterface (this with quantity = newQuantity) + transfer_for newOwner = toInterface $ V1.CashTransferProposal with cash = this; .. + + -- Implement the new interface for new cash + interface instance IAsset for V2.Cash where + view = VAsset with + assetType = currency + .. + set_obs newObs = toInterface (this with obs = newObs) + set_owner newOwner = toInterface (this with owner = newOwner) + set_quantity newQuantity = toInterface (this with quantity = newQuantity) + transfer_for newOwner = toInterface $ V2.CashTransferProposal with cash = this; .. \ No newline at end of file diff --git a/daml/Exercise3/Solutions/Currency/Bonus/Scripts.daml b/daml/Exercise3/Solutions/Currency/Bonus/Scripts.daml new file mode 100644 index 0000000..360e27f --- /dev/null +++ b/daml/Exercise3/Solutions/Currency/Bonus/Scripts.daml @@ -0,0 +1,67 @@ +module Exercise3.Solutions.Currency.Bonus.Scripts where + +import Exercise3.Solutions.Currency.Cash qualified as V2.Cash +import Exercise3.Solutions.Modularized.Cash qualified as V1.Cash +import Exercise3.Solutions.Modularized.Scripts +import Exercise3.Solutions.Currency.Scripts +import Exercise3.Solutions.Currency.Bonus.Interfaces +import Exercise3.Solutions.Currency.Bonus.Swap + +import Daml.Script + +test_bonus : Script () +test_bonus = script do + (tps@TestParties{..}, tus@TestUsers{..}) <- test_upgrade + + -- Optional extra to change the ugly "V2_Cash CHF" and "Cash" to "CHF" and "USD" + + -- NEW SWAP, OLD ASSETS + -- Alice proposes a new swap, USD for USD, but allocates using an old asset. + (cid, posa)::_ <- query @V1.Cash.Cash pAlice + cid <- submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Set_Observers with newObs = [pBob] + + let assetSpec = (pBank, "USD", posa.quantity) + swapCid <- submitUser uAlice do + createCmd AssetSwapProposal with + requester = pAlice + receiver = pBob + offerSpec = assetSpec + requestedSpec = assetSpec + offerCid = toInterfaceContractId @IAsset cid + + -- Bob accepts using an old asset. + (cid, _)::_ <- queryFilter @V1.Cash.Cash pBob (\posb -> posb.owner == pBob && posb.quantity == posa.quantity) + submitUser uBob do + exerciseCmd swapCid Settle with requestedCid = toInterfaceContractId @IAsset cid + + -- NEW SWAP, MIX OF ASSETS, MIX OF CURRENCIES + -- Alice proposes a new swap, USD for CHF, but allocates using an old asset. + (cid, posa)::_ <- queryFilter @V1.Cash.Cash pAlice (\pos -> pos.owner == pAlice) + cid <- submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Set_Observers with newObs = [pBob] + + let offerSpec = (pBank, "USD", posa.quantity) + requestedSpec = (pBank, "CHF", posa.quantity) + swapCid <- submitUser uAlice do + createCmd AssetSwapProposal with + requester = pAlice + receiver = pBob + offerSpec + requestedSpec + offerCid = toInterfaceContractId @IAsset cid + + -- Bob accepts using a new asset. + (cid, _)::_ <- queryFilter @V2.Cash.Cash pBob (\posb -> posb.owner == pBob && posb.quantity == posa.quantity && posb.currency == "CHF") + submitUser uBob do + exerciseCmd swapCid Settle with requestedCid = toInterfaceContractId @IAsset cid + + -- Bob can merge his old cash positions into the new cash. + [(new_cid, _)] <- queryFilter @V2.Cash.Cash pBob (\posb -> posb.owner == pBob && posb.currency == "USD") + old_cids <- map (toInterfaceContractId @IAsset . fst) <$> + queryFilter @V1.Cash.Cash pBob (\posb -> posb.owner == pBob) + submitUser uBob do + exerciseCmd (toInterfaceContractId @IAsset new_cid) Merge with + otherCids = old_cids + + return () \ No newline at end of file diff --git a/daml/Exercise3/Solutions/Currency/Bonus/Swap.daml b/daml/Exercise3/Solutions/Currency/Bonus/Swap.daml new file mode 100644 index 0000000..4d8bf9b --- /dev/null +++ b/daml/Exercise3/Solutions/Currency/Bonus/Swap.daml @@ -0,0 +1,49 @@ +-- This should be its own package! + +module Exercise3.Solutions.Currency.Bonus.Swap where + +import Exercise3.Solutions.Currency.Bonus.Interfaces + +import DA.Assert + +-- This module is not really needed as part of the solution. +-- It demonstrates how to also upgrade in such a way that +-- "Cash" becomes "USD" and "Cash_V2 CHF" becomes merely "CHF". + +template AssetSwapProposal + with + requester : Party + receiver : Party + -- Triples of issuer, assetType, quantity + offerSpec : (Party, Text, Decimal) + offerCid : ContractId IAsset + requestedSpec : (Party, Text, Decimal) + where + signatory requester + observer receiver + + choice Settle : () + with + requestedCid : ContractId IAsset + controller receiver + do + actualOffer <- fetch offerCid + actualRequested <- fetch requestedCid + let + vo = view actualOffer + vr = view actualRequested + + -- Check signatories. Needed for safety! + assertMsg "Offer Asset not signed by issuer!" (vo.issuer `elem` signatory actualOffer) + assertMsg "Requested Asset not signed by issuer!" (vr.issuer `elem` signatory actualRequested) + + -- Check against spec + (vo.issuer, vo.assetType, vo.quantity) === offerSpec + (vr.issuer, vr.assetType, vr.quantity) === requestedSpec + + -- Transfer + exercise offerCid Transfer with newOwner = receiver + exercise requestedCid Transfer with newOwner = requester + + return () + diff --git a/daml/Exercise3/Solutions/Currency/Cash.daml b/daml/Exercise3/Solutions/Currency/Cash.daml new file mode 100644 index 0000000..cc21c6a --- /dev/null +++ b/daml/Exercise3/Solutions/Currency/Cash.daml @@ -0,0 +1,46 @@ +-- This should be its own package! + +module Exercise3.Solutions.Currency.Cash where + +import Exercise3.Solutions.Modularized.Interfaces + +template Cash + with + issuer : Party + owner : Party + quantity : Decimal + currency : Text + obs : [Party] + where + signatory [issuer, owner] + observer obs + + + + -- Make new cash backwards compatible in case currency is USD. + interface instance IAsset for Cash where + view = VAsset with + assetType = if currency == "USD" then "Cash" else "V2_Cash " <> currency + .. + set_obs newObs = toInterface (this with obs = newObs) + set_owner newOwner = toInterface (this with owner = newOwner) + set_quantity newQuantity = toInterface (this with quantity = newQuantity) + transfer_for newOwner = toInterface $ CashTransferProposal with cash = this; .. + +-- Workaround for https://github.com/digital-asset/daml/issues/15459 +myView = view + +template CashTransferProposal + with + newOwner : Party + cash : Cash + where + signatory (signatory cash) + observer newOwner + + -- Make new transfer proposals backwards compatible in case currency is USD. + interface instance IAssetTransferProposal for CashTransferProposal where + view = VAssetTransferProposal with + newOwner = newOwner + vasset = myView (toInterface @IAsset cash) + asset = toInterface @IAsset cash \ No newline at end of file diff --git a/daml/Exercise3/Solutions/Currency/Scripts.daml b/daml/Exercise3/Solutions/Currency/Scripts.daml new file mode 100644 index 0000000..3dd2e51 --- /dev/null +++ b/daml/Exercise3/Solutions/Currency/Scripts.daml @@ -0,0 +1,109 @@ +-- This should be its own package! + +module Exercise3.Solutions.Currency.Scripts where + +import Exercise3.Solutions.Currency.Cash qualified as V2.Cash +import Exercise3.Solutions.Modularized.Cash qualified as V1.Cash +import Exercise3.Solutions.Modularized.Interfaces +import Exercise3.Solutions.Modularized.Scripts +import Exercise3.Solutions.Modularized.Swap + +import Daml.Script + +import DA.Action +import DA.Foldable (forA_) + +-- Scripts + +init_cash_v2 : TestParties -> TestUsers -> Script () +init_cash_v2 TestParties{..} TestUsers{..} = do + -- Bank issues some new assets in both USD and CHF + + forA_ ["USD", "CHF"] (\currency -> do + -- Issue some cash in the form of transfer proposals. + let cash = V2.Cash.Cash with + issuer = pBank + owner = pBank + obs = [] + quantity = 1.0 + currency + + -- 2 positions for Alice + replicateA_ 1 $ submitUser uBank do + replicateA_ 2 $ createCmd V2.Cash.CashTransferProposal with + cash + newOwner = pAlice + + -- 2 positionsfor Bob + replicateA_ 1 $ submitUser uBank do + replicateA_ 2 $ createCmd V2.Cash.CashTransferProposal with + cash + newOwner = pBob + + -- Accept all transfer proposals + let + accept_all p = do + proposals <- queryFilter @V2.Cash.CashTransferProposal p (\tp -> tp.newOwner == p) + submit p do + forA_ proposals (\(cid, _) -> exerciseCmd (toInterfaceContractId @IAssetTransferProposal cid) Accept_TransferProposal) + forA_ [pAlice, pBob] accept_all + + -- Alice transfers 1 of her positions to Bob + alicePositions <- queryFilter @V2.Cash.Cash pAlice (\pos -> pos.currency == currency) + forA_ (take 1 alicePositions) (\(cid, _) -> do + submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Propose_Transfer with + newOwner = pBob + ) + ) + + +test_upgrade : Script (TestParties, TestUsers) +test_upgrade = script do + (tps@TestParties{..}, tus@TestUsers{..}) <- test_swap + + init_cash_v2 tps tus + + -- OLD SWAP, NEW ASSETS + -- Alice proposes an old swap, Cash for Cash, but allocates using a new asset. + (cid, posa)::_ <- queryFilter @V2.Cash.Cash pAlice (\pos -> pos.owner == pAlice && pos.currency == "CHF") + cid <- submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Set_Observers with newObs = [pBob] + + let offerSpec = (pBank, "V2_Cash CHF", posa.quantity) + requestedSpec = (pBank, "Cash", posa.quantity) + swapCid <- submitUser uAlice do + createCmd AssetSwapProposal with + requester = pAlice + receiver = pBob + offerSpec + requestedSpec + offerCid = toInterfaceContractId @IAsset cid + + -- Bob accepts using a new asset. + (cid, _)::_ <- queryFilter @V2.Cash.Cash pBob (\posb -> posb.owner == pBob && posb.quantity == posa.quantity && posb.currency == "USD") + submitUser uBob do + exerciseCmd swapCid Settle with requestedCid = toInterfaceContractId @IAsset cid + + -- OLD SWAP, MIX OF ASSETS + -- Alice proposes an old swap, Cash for Cash, and allocates using an old asset. + (cid, posa)::_ <- queryFilter @V1.Cash.Cash pAlice (\pos -> pos.owner == pAlice) + cid <- submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Set_Observers with newObs = [pBob] + + let assetSpec = (pBank, "Cash", posa.quantity) + swapCid <- submitUser uAlice do + createCmd AssetSwapProposal with + requester = pAlice + receiver = pBob + offerSpec = assetSpec + requestedSpec = assetSpec + offerCid = toInterfaceContractId @IAsset cid + + -- Bob accepts using a new asset. + (cid, _)::_ <- queryFilter @V2.Cash.Cash pBob (\posb -> posb.owner == pBob && posb.quantity == posa.quantity && posb.currency == "USD") + submitUser uBob do + exerciseCmd swapCid Settle with requestedCid = toInterfaceContractId @IAsset cid + + + return (tps, tus) \ No newline at end of file diff --git a/daml/Exercise3/Solutions/Modularized/Cash.daml b/daml/Exercise3/Solutions/Modularized/Cash.daml new file mode 100644 index 0000000..a30fdcc --- /dev/null +++ b/daml/Exercise3/Solutions/Modularized/Cash.daml @@ -0,0 +1,41 @@ +-- This should be its own package! + +module Exercise3.Solutions.Modularized.Cash where + +import Exercise3.Solutions.Modularized.Interfaces + +template Cash + with + issuer : Party + owner : Party + quantity : Decimal + obs : [Party] + where + signatory [issuer, owner] + observer obs + + interface instance IAsset for Cash where + view = VAsset with + assetType = "Cash" + .. + set_obs newObs = toInterface (this with obs = newObs) + set_owner newOwner = toInterface (this with owner = newOwner) + set_quantity newQuantity = toInterface (this with quantity = newQuantity) + transfer_for newOwner = toInterface $ CashTransferProposal with cash = this; .. + +-- Workaround for https://github.com/digital-asset/daml/issues/15459 +myView = view + +template CashTransferProposal + with + newOwner : Party + cash : Cash + where + signatory (signatory cash) + observer newOwner + + interface instance IAssetTransferProposal for CashTransferProposal where + view = VAssetTransferProposal with + newOwner = newOwner + vasset = myView (toInterface @IAsset cash) + asset = toInterface @IAsset cash \ No newline at end of file diff --git a/daml/Exercise3/Solutions/Modularized/Interfaces.daml b/daml/Exercise3/Solutions/Modularized/Interfaces.daml new file mode 100644 index 0000000..a6bd989 --- /dev/null +++ b/daml/Exercise3/Solutions/Modularized/Interfaces.daml @@ -0,0 +1,88 @@ +-- This should be its own package! + +module Exercise3.Solutions.Modularized.Interfaces where + +import DA.Assert + +data VAsset = VAsset with + issuer : Party + owner : Party + assetType : Text + quantity : Decimal + obs : [Party] + deriving (Eq, Show) + +data VAssetTransferProposal = VAssetTransferProposal with + vasset : VAsset + newOwner : Party + deriving (Eq, Show) + +interface IAssetTransferProposal where + viewtype VAssetTransferProposal + asset : IAsset + + choice Accept_TransferProposal : ContractId IAsset + controller (view this).newOwner + do + create $ set_owner (asset this) (view this).newOwner + + choice Reject_TransferProposal : ContractId IAsset + controller (view this).newOwner + do + create $ asset this + +interface IAsset where + viewtype VAsset + set_owner : Party -> IAsset + set_obs : [Party] -> IAsset + set_quantity : Decimal -> IAsset + transfer_for : Party -> IAssetTransferProposal + + choice Transfer : ContractId IAsset + with + newOwner : Party + controller [(view this).owner, newOwner] + do + create $ set_owner (set_obs this []) newOwner + + choice Split : (ContractId IAsset, [ContractId IAsset]) + with + splitQuantities : [Decimal] + controller (view this).owner + do + remCid <- create $ set_quantity this ((view this).quantity - sum splitQuantities) + splitCids <- forA splitQuantities (\splitQuantity -> create$ set_quantity this splitQuantity) + return (remCid, splitCids) + + choice Merge : ContractId IAsset + with + otherCids : [ContractId IAsset] + controller (view this).owner + do + quantities <- forA otherCids (\otherCid -> do + other <- fetch otherCid + let vo = view other + vo === (view this) with + quantity = vo.quantity + obs = vo.obs + exercise otherCid Archive_Asset + return vo.quantity) + create $ set_quantity this ((view this).quantity + sum quantities) + + choice Propose_Transfer : ContractId IAssetTransferProposal + with + newOwner : Party + controller (view this).owner + do + create (transfer_for this newOwner) + + choice Set_Observers : ContractId IAsset + with + newObs : [Party] + controller (view this).owner + do + create $ set_obs this newObs + + choice Archive_Asset : () + controller (signatory this) + do return () \ No newline at end of file diff --git a/daml/Exercise3/Solutions/Modularized/Scripts.daml b/daml/Exercise3/Solutions/Modularized/Scripts.daml new file mode 100644 index 0000000..e7d2c95 --- /dev/null +++ b/daml/Exercise3/Solutions/Modularized/Scripts.daml @@ -0,0 +1,118 @@ +-- This should be its own package! + +module Exercise3.Solutions.Modularized.Scripts where + +import Exercise3.Solutions.Modularized.Cash +import Exercise3.Solutions.Modularized.Interfaces +import Exercise3.Solutions.Modularized.Swap + +import Daml.Script + +import DA.Action +import DA.Foldable (forA_) + +-- Scripts +data TestParties = TestParties with + pBank : Party + pAlice : Party + pBob : Party + +data TestUsers = TestUsers with + uBank : UserId + uAlice : UserId + uBob : UserId + +init_parties : Script TestParties +init_parties = do + let allocate t = allocatePartyWithHint t (PartyIdHint t) + pBank <- allocate "Bank" + pAlice <- allocate "Alice" + pBob <- allocate "Bob" + + return (TestParties with ..) + +init_users : TestParties -> Script TestUsers +init_users TestParties{..} = do + let + makeUser t p rs = do + uid <- validateUserId t + let + u = User with + userId = uid + primaryParty = Some p + createUser u (CanActAs p :: rs) + return uid + uBank <- makeUser "bank" pBank [] + uAlice <- makeUser "alice" pAlice [] + uBob <- makeUser "bob" pBob [] + + return (TestUsers with ..) + +init_cash : Script (TestParties, TestUsers) +init_cash = do + ps@TestParties{..} <- init_parties + us@TestUsers{..} <- init_users ps + + -- Issue some cash in the form of transfer proposals. + let cash = Cash with + issuer = pBank + owner = pBank + obs = [] + quantity = 1.0 + + -- 3 positions of $1 for Alice + replicateA_ 1 $ submitUser uBank do + replicateA_ 3 $ createCmd CashTransferProposal with + cash + newOwner = pAlice + + -- 2 positions for Bob + replicateA_ 1 $ submitUser uBank do + replicateA_ 2 $ createCmd CashTransferProposal with + cash + newOwner = pBob + + -- Accept all transfer proposals + let + accept_all p = do + proposals <- queryFilter @CashTransferProposal p (\tp -> tp.newOwner == p) + submit p do + forA_ proposals (\(cid, _) -> exerciseCmd (toInterfaceContractId @IAssetTransferProposal cid) Accept_TransferProposal) + forA_ [pAlice, pBob] accept_all + + + -- Alice transfers 1 of her positions to Bob + alicePositions <- query @Cash pAlice + forA_ (take 1 alicePositions) (\(cid, _) -> do + submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Propose_Transfer with + newOwner = pBob + ) + + return (ps, us) + +test_swap : Script (TestParties, TestUsers) +test_swap = script do + (tps@TestParties{..}, tus@TestUsers{..}) <- init_cash + + -- Alice proposes a swap + (cid, posa)::_ <- query @Cash pAlice + cid <- submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Set_Observers with newObs = [pBob] + + -- Cash for cash is all we can do... + let assetSpec = (pBank, "Cash", posa.quantity) + swapCid <- submitUser uAlice do + createCmd AssetSwapProposal with + requester = pAlice + receiver = pBob + offerSpec = assetSpec + requestedSpec = assetSpec + offerCid = toInterfaceContractId @IAsset cid + + -- Bob accepts + (cid, _)::_ <- queryFilter @Cash pBob (\posb -> posb.owner == pBob && posb.quantity == posa.quantity) + submitUser uBob do + exerciseCmd swapCid Settle with requestedCid = toInterfaceContractId @IAsset cid + + return (tps, tus) \ No newline at end of file diff --git a/daml/Exercise3/Solutions/Modularized/Swap.daml b/daml/Exercise3/Solutions/Modularized/Swap.daml new file mode 100644 index 0000000..f43d564 --- /dev/null +++ b/daml/Exercise3/Solutions/Modularized/Swap.daml @@ -0,0 +1,45 @@ +-- This should be its own package! + +module Exercise3.Solutions.Modularized.Swap where + +import Exercise3.Solutions.Modularized.Interfaces + +import DA.Assert + +template AssetSwapProposal + with + requester : Party + receiver : Party + -- Triples of issuer, assetType, quantity + offerSpec : (Party, Text, Decimal) + offerCid : ContractId IAsset + requestedSpec : (Party, Text, Decimal) + where + signatory requester + observer receiver + + choice Settle : () + with + requestedCid : ContractId IAsset + controller receiver + do + actualOffer <- fetch offerCid + actualRequested <- fetch requestedCid + let + vo = view actualOffer + vr = view actualRequested + + -- Check signatories. Needed for safety! + assertMsg "Offer Asset not signed by issuer!" (vo.issuer `elem` signatory actualOffer) + assertMsg "Requested Asset not signed by issuer!" (vr.issuer `elem` signatory actualRequested) + + -- Check against spec + (vo.issuer, vo.assetType, vo.quantity) === offerSpec + (vr.issuer, vr.assetType, vr.quantity) === requestedSpec + + -- Transfer + exercise offerCid Transfer with newOwner = receiver + exercise requestedCid Transfer with newOwner = requester + + return () + diff --git a/daml/Exercise3/Swaps.daml b/daml/Exercise3/Swaps.daml new file mode 100644 index 0000000..252b1ce --- /dev/null +++ b/daml/Exercise3/Swaps.daml @@ -0,0 +1,275 @@ +module Exercise3.Swaps where + +import DA.Assert +import DA.Action +import DA.Foldable (forA_) + +import Daml.Script + +data VAsset = VAsset with + issuer : Party + owner : Party + assetType : Text + quantity : Decimal + obs : [Party] + deriving (Eq, Show) + +data VAssetTransferProposal = VAssetTransferProposal with + vasset : VAsset + newOwner : Party + deriving (Eq, Show) + +interface IAssetTransferProposal where + viewtype VAssetTransferProposal + asset : IAsset + + choice Accept_TransferProposal : ContractId IAsset + controller (view this).newOwner + do + create $ set_owner (asset this) (view this).newOwner + + choice Reject_TransferProposal : ContractId IAsset + controller (view this).newOwner + do + create $ asset this + +interface IAsset where + viewtype VAsset + set_owner : Party -> IAsset + set_obs : [Party] -> IAsset + set_quantity : Decimal -> IAsset + transfer_for : Party -> IAssetTransferProposal + + + choice Transfer : ContractId IAsset + with + newOwner : Party + controller [(view this).owner, newOwner] + do + create $ set_owner (set_obs this []) newOwner + + choice Split : (ContractId IAsset, [ContractId IAsset]) + with + splitQuantities : [Decimal] + controller (view this).owner + do + remCid <- create $ set_quantity this ((view this).quantity - sum splitQuantities) + splitCids <- forA splitQuantities (\splitQuantity -> create$ set_quantity this splitQuantity) + return (remCid, splitCids) + + choice Merge : ContractId IAsset + with + otherCids : [ContractId IAsset] + controller (view this).owner + do + quantities <- forA otherCids (\otherCid -> do + other <- fetch otherCid + let vo = view other + vo === (view this) with + quantity = vo.quantity + obs = vo.obs + exercise otherCid Archive_Asset + return vo.quantity) + create $ set_quantity this ((view this).quantity + sum quantities) + + choice Propose_Transfer : ContractId IAssetTransferProposal + with + newOwner : Party + controller (view this).owner + do + create (transfer_for this newOwner) + + choice Set_Observers : ContractId IAsset + with + newObs : [Party] + controller (view this).owner + do + create $ set_obs this newObs + + choice Archive_Asset : () + controller (signatory this) + do return () + +template Cash + with + _issuer : Party + _owner : Party + _quantity : Decimal + _obs : [Party] + where + signatory [_issuer, _owner] + observer _obs + + interface instance IAsset for Cash where + view = VAsset with + issuer = _issuer + owner = _owner + obs = _obs + quantity = _quantity + assetType = "Cash" + set_obs newObs = toInterface (this with _obs = newObs) + set_owner newOwner = toInterface (this with _owner = newOwner) + set_quantity newQuantity = toInterface (this with _quantity = newQuantity) + transfer_for newOwner = toInterface $ CashTransferProposal with cash = this; .. + +-- Workaround for https://github.com/digital-asset/daml/issues/15459 +myView = view + +template CashTransferProposal + with + newOwner : Party + cash : Cash + where + signatory (signatory cash) + observer newOwner + + interface instance IAssetTransferProposal for CashTransferProposal where + view = VAssetTransferProposal with + newOwner = newOwner + vasset = myView (toInterface @IAsset cash) + asset = toInterface @IAsset cash + +template AssetSwapProposal + with + requester : Party + receiver : Party + -- Triples of issuer, assetType, quantity + offerSpec : (Party, Text, Decimal) + offerCid : ContractId IAsset + requestedSpec : (Party, Text, Decimal) + where + signatory requester + observer receiver + + choice Settle : () + with + requestedCid : ContractId IAsset + controller receiver + do + actualOffer <- fetch offerCid + actualRequested <- fetch requestedCid + let + vo = view actualOffer + vr = view actualRequested + + -- Check signatories. Needed for safety! + assertMsg "Offer Asset not signed by issuer!" (vo.issuer `elem` signatory actualOffer) + assertMsg "Requested Asset not signed by issuer!" (vr.issuer `elem` signatory actualRequested) + + -- Check against spec + (vo.issuer, vo.assetType, vo.quantity) === offerSpec + (vr.issuer, vr.assetType, vr.quantity) === requestedSpec + + -- Transfer + exercise offerCid Transfer with newOwner = receiver + exercise requestedCid Transfer with newOwner = requester + + return () + + +-- Scripts +data TestParties = TestParties with + pBank : Party + pAlice : Party + pBob : Party + +data TestUsers = TestUsers with + uBank : UserId + uAlice : UserId + uBob : UserId + +init_parties : Script TestParties +init_parties = do + let allocate t = allocatePartyWithHint t (PartyIdHint t) + pBank <- allocate "Bank" + pAlice <- allocate "Alice" + pBob <- allocate "Bob" + + return (TestParties with ..) + +init_users : TestParties -> Script TestUsers +init_users TestParties{..} = do + let + makeUser t p rs = do + uid <- validateUserId t + let + u = User with + userId = uid + primaryParty = Some p + createUser u (CanActAs p :: rs) + return uid + uBank <- makeUser "bank" pBank [] + uAlice <- makeUser "alice" pAlice [] + uBob <- makeUser "bob" pBob [] + + return (TestUsers with ..) + +init_cash : Script (TestParties, TestUsers) +init_cash = do + ps@TestParties{..} <- init_parties + us@TestUsers{..} <- init_users ps + + -- Issue some cash in the form of transfer proposals. + let cash = Cash with + _issuer = pBank + _owner = pBank + _obs = [] + _quantity = 1.0 + + -- 2 positions of $1 for Alice + replicateA_ 1 $ submitUser uBank do + replicateA_ 2 $ createCmd CashTransferProposal with + cash + newOwner = pAlice + + -- 1 positions for Bob + replicateA_ 1 $ submitUser uBank do + replicateA_ 1 $ createCmd CashTransferProposal with + cash + newOwner = pBob + + -- Accept all transfer proposals + let + accept_all p = do + proposals <- queryFilter @CashTransferProposal p (\tp -> tp.newOwner == p) + submit p do + forA_ proposals (\(cid, _) -> exerciseCmd (toInterfaceContractId @IAssetTransferProposal cid) Accept_TransferProposal) + forA_ [pAlice, pBob] accept_all + + + -- Alice transfers 1 of her positions to Bob + alicePositions <- query @Cash pAlice + forA_ (take 1 alicePositions) (\(cid, _) -> do + submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Propose_Transfer with + newOwner = pBob + ) + + return (ps, us) + +test_swap : Script () +test_swap = script do + (tps@TestParties{..}, tus@TestUsers{..}) <- init_cash + + -- Alice proposes a swap + (cid, posa)::_ <- query @Cash pAlice + cid <- submitUser uAlice do + exerciseCmd (toInterfaceContractId @IAsset cid) Set_Observers with newObs = [pBob] + + -- Cash for cash is all we can do... + let assetSpec = (pBank, "Cash", posa._quantity) + swapCid <- submitUser uAlice do + createCmd AssetSwapProposal with + requester = pAlice + receiver = pBob + offerSpec = assetSpec + requestedSpec = assetSpec + offerCid = toInterfaceContractId @IAsset cid + + -- Bob accepts + (cid, _)::_ <- queryFilter @Cash pBob (\posb -> posb._owner == pBob && posb._quantity == posa._quantity) + submitUser uBob do + exerciseCmd swapCid Settle with requestedCid = toInterfaceContractId @IAsset cid + + (cid, asset)::_ <- queryFilter @Cash pBob (\posb -> posb._owner == pBob && posb._quantity == posa._quantity) + return () \ No newline at end of file diff --git a/daml/Initial/Cash.daml b/daml/Initial/Cash.daml new file mode 100644 index 0000000..28dd2fe --- /dev/null +++ b/daml/Initial/Cash.daml @@ -0,0 +1,78 @@ +module Initial.Cash where + +import DA.Assert + +template Position + with + issuer : Party + owner : Party + quantity : Decimal + obs : [Party] + where + signatory [issuer, owner] + observer obs + ensure quantity > 0.0 + + choice Transfer : ContractId Position + with + newOwner : Party + controller [owner, newOwner] + do + create this with + owner = newOwner + obs = [] + + choice Propose_Transfer : ContractId TransferProposal + with + newOwner : Party + controller owner + do + create TransferProposal with + position = this + newOwner + + choice Split : (ContractId Position, [ContractId Position]) + with + splitQuantities : [Decimal] + controller owner + do + remCid <- create this with quantity = this.quantity - sum splitQuantities + splitCids <- forA splitQuantities (\splitQuantity -> create this with + quantity = splitQuantity + ) + return (remCid, splitCids) + + choice Merge : ContractId Position + with + otherCids : [ContractId Position] + controller owner + do + quantities <- forA otherCids (\otherCid -> do + other <- fetch otherCid + other === this with + quantity = other.quantity + obs = other.obs + archive otherCid + return other.quantity) + create this with + quantity = quantity + sum quantities + +template TransferProposal + with + position : Position + newOwner : Party + where + signatory (signatory position) + observer newOwner::(observer position) + + choice Accept : ContractId Position + controller newOwner + do + create position with + owner = newOwner + obs = [] + + choice Cancel : ContractId Position + controller position.owner + do + create position diff --git a/daml/Initial/Scripts.daml b/daml/Initial/Scripts.daml new file mode 100644 index 0000000..bab177b --- /dev/null +++ b/daml/Initial/Scripts.daml @@ -0,0 +1,86 @@ +module Initial.Scripts where + +import Initial.Cash + +import Daml.Script +import DA.Action +import DA.Foldable (forA_) + +data TestParties = TestParties with + pBank : Party + pAlice : Party + pBob : Party + +data TestUsers = TestUsers with + uBank : UserId + uAlice : UserId + uBob : UserId + +init_parties : Script TestParties +init_parties = do + let allocate t = allocatePartyWithHint t (PartyIdHint t) + pBank <- allocate "Bank" + pAlice <- allocate "Alice" + pBob <- allocate "Bob" + + return (TestParties with ..) + +init_users : TestParties -> Script TestUsers +init_users TestParties{..} = do + let + makeUser t p rs = do + uid <- validateUserId t + let + u = User with + userId = uid + primaryParty = Some p + createUser u (CanActAs p :: rs) + return uid + uBank <- makeUser "bank" pBank [] + uAlice <- makeUser "alice" pAlice [] + uBob <- makeUser "bob" pBob [] + + return (TestUsers with ..) + +init_cash : Script (TestParties, TestUsers) +init_cash = do + ps@TestParties{..} <- init_parties + us@TestUsers{..} <- init_users ps + + -- Issue some cash in the form of transfer proposals. + let position = Position with + issuer = pBank + owner = pBank + obs = [] + quantity = 1.0 + + -- 200 positions of $1 for Alice + replicateA_ 20 $ submitUser uBank do + replicateA_ 10 $ createCmd TransferProposal with + position + newOwner = pAlice + + -- 100 positions for Bob + replicateA_ 10 $ submitUser uBank do + replicateA_ 10 $ createCmd TransferProposal with + position + newOwner = pBob + + -- Accept all transfer proposals + let + accept_all p = do + proposals <- queryFilter @TransferProposal p (\tp -> tp.newOwner == p) + submit p do + forA_ proposals (\(cid, _) -> exerciseCmd cid Accept) + forA_ [pAlice, pBob] accept_all + + + -- Alice transfers 50 of her positions to Bob + alicePositions <- query @Position pAlice + forA_ (take 50 alicePositions) (\(cid, _) -> do + submitUser uAlice do + exerciseCmd cid Propose_Transfer with + newOwner = pBob + ) + + return (ps, us) \ No newline at end of file