upgrading-daml-training/daml/Exercise3/Solutions/Bonds.daml

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