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