102 lines
2.5 KiB
Plaintext
102 lines
2.5 KiB
Plaintext
|
module Exercise2.Scripts where
|
||
|
|
|
||
|
|
import Exercise2.Cash
|
||
|
|
|
||
|
|
import Daml.Script
|
||
|
|
import DA.Action
|
||
|
|
import DA.Foldable (forA_)
|
||
|
|
|
||
|
|
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
|
||
|
|
|
||
|
|
-- 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
|
||
|
|
|
||
|
|
-- Issue some cash in the form of transfer proposals.
|
||
|
|
let position = Position with
|
||
|
|
issuer = pBank
|
||
|
|
owner = pBank
|
||
|
|
obs = []
|
||
|
|
quantity = 1.0
|
||
|
|
|
||
|
|
-- 200 positions of $1 for Alice
|
||
|
|
replicateA_ 20 $ submitUser uBank do
|
||
|
|
replicateA_ 10 $ createCmd TransferProposal with
|
||
|
|
position
|
||
|
|
newOwner = pAlice
|
||
|
|
|
||
|
|
-- 100 positions for Bob
|
||
|
|
replicateA_ 10 $ submitUser uBank do
|
||
|
|
replicateA_ 10 $ createCmd TransferProposal with
|
||
|
|
position
|
||
|
|
newOwner = pBob
|
||
|
|
|
||
|
|
-- Accept all transfer proposals
|
||
|
|
let
|
||
|
|
accept_all (u, p) = do
|
||
|
|
proposals <- queryFilter @TransferProposal p (\tp -> tp.newOwner == p)
|
||
|
|
submitUser u do
|
||
|
|
forA_ proposals (\(cid, _) ->
|
||
|
|
exerciseCmd rules Accept_TransferProposal with
|
||
|
|
tpCid = cid
|
||
|
|
newOwner = p
|
||
|
|
)
|
||
|
|
forA_ [(uAlice, pAlice), (uBob, pBob)] accept_all
|
||
|
|
|
||
|
|
-- Alice transfers 50 of her positions to Bob
|
||
|
|
alicePositions <- query @Position pAlice
|
||
|
|
forA_ (take 50 alicePositions) (\(cid, _) -> do
|
||
|
|
submitUser uAlice do
|
||
|
|
exerciseCmd rules Propose_Transfer with
|
||
|
|
owner = pAlice
|
||
|
|
newOwner = pBob
|
||
|
|
cid
|
||
|
|
)
|
||
|
|
|
||
|
|
return (ps, us)
|