86 lines
2.0 KiB
Plaintext
86 lines
2.0 KiB
Plaintext
module Initial.Scripts where
|
|
|
|
import Initial.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
|
|
|
|
-- 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 p = do
|
|
proposals <- queryFilter @TransferProposal p (\tp -> tp.newOwner == p)
|
|
submit p do
|
|
forA_ proposals (\(cid, _) -> exerciseCmd cid Accept)
|
|
forA_ [pAlice, 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 cid Propose_Transfer with
|
|
newOwner = pBob
|
|
)
|
|
|
|
return (ps, us) |