upgrading-daml-training/daml/Exercise2/Upgrade.daml

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.