Initial commit

This commit is contained in:
Ryan Trinkle 2023-05-04 14:52:52 -04:00
commit ab9a40dc27
23 changed files with 2086 additions and 0 deletions

3
.gitignore vendored Normal file
View File

@ -0,0 +1,3 @@
**/*.log
.daml
log

2
README.md Normal file
View File

@ -0,0 +1,2 @@
# upgrading-daml-training
Code snippets for the upgrading daml training workshop

11
daml.yaml Normal file
View File

@ -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

View File

@ -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 ()
)

View File

@ -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 ()
)

27
daml/Exercise1/KYC.daml Normal file
View File

@ -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 ()

View File

@ -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]
)

108
daml/Exercise2/Cash.daml Normal file
View File

@ -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

102
daml/Exercise2/Scripts.daml Normal file
View File

@ -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)

122
daml/Exercise2/Upgrade.daml Normal file
View File

@ -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.

View File

@ -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 ()

View File

@ -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; ..

View File

@ -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 ()

View File

@ -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 ()

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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 ()

View File

@ -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)

View File

@ -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 ()

275
daml/Exercise3/Swaps.daml Normal file
View File

@ -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 ()

78
daml/Initial/Cash.daml Normal file
View File

@ -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

86
daml/Initial/Scripts.daml Normal file
View File

@ -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)