122 lines
3.2 KiB
Plaintext
122 lines
3.2 KiB
Plaintext
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. |