118 lines
3.2 KiB
Plaintext
118 lines
3.2 KiB
Plaintext
|
-- 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)
|