mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 01:07:18 +03:00
Replace damlpatterns tarballs by a proper template (#5273)
There is no reason why patterns should be a tarball and the current tarballs are broken anyway. Why do we even have 2 … changelog_begin changelog_end
This commit is contained in:
parent
38a5fea7a0
commit
19496482f6
@ -71,6 +71,7 @@ tests tmpDir damlTypesDir = withSdkResource $ \_ -> testGroup "Integration tests
|
|||||||
, packagingTests
|
, packagingTests
|
||||||
, quickstartTests quickstartDir mvnDir
|
, quickstartTests quickstartDir mvnDir
|
||||||
, cleanTests cleanDir
|
, cleanTests cleanDir
|
||||||
|
, templateTests
|
||||||
, deployTest deployDir
|
, deployTest deployDir
|
||||||
, fetchTest tmpDir
|
, fetchTest tmpDir
|
||||||
, codegenTests codegenDir damlTypesDir
|
, codegenTests codegenDir damlTypesDir
|
||||||
@ -466,6 +467,29 @@ cleanTests baseDir = testGroup "daml clean"
|
|||||||
, unlines (map (" "++) filesAtEnd)
|
, unlines (map (" "++) filesAtEnd)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
templateTests :: TestTree
|
||||||
|
templateTests = testGroup "templates"
|
||||||
|
[ testCase name $ do
|
||||||
|
withTempDir $ \dir -> withCurrentDirectory dir $ do
|
||||||
|
callCommandQuiet $ unwords ["daml", "new", "foobar", name]
|
||||||
|
withCurrentDirectory (dir </> "foobar") $ callCommandQuiet "daml build"
|
||||||
|
| name <- templateNames
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
-- NOTE (MK) We might want to autogenerate this list at some point but for now
|
||||||
|
-- this should be good enough.
|
||||||
|
where templateNames =
|
||||||
|
[ "copy-trigger"
|
||||||
|
-- daml-intro-1 - daml-intro-6 are not full projects.
|
||||||
|
, "daml-intro-7"
|
||||||
|
, "daml-patterns"
|
||||||
|
, "quickstart-java"
|
||||||
|
, "quickstart-scala"
|
||||||
|
, "script-example"
|
||||||
|
, "skeleton"
|
||||||
|
]
|
||||||
|
|
||||||
-- | Check we can generate language bindings.
|
-- | Check we can generate language bindings.
|
||||||
codegenTests :: FilePath -> FilePath -> TestTree
|
codegenTests :: FilePath -> FilePath -> TestTree
|
||||||
codegenTests codegenDir damlTypes = testGroup "daml codegen" (
|
codegenTests codegenDir damlTypes = testGroup "daml codegen" (
|
||||||
|
@ -570,6 +570,13 @@ daml_test(
|
|||||||
srcs = glob(["source/daml/patterns/daml/**/*.daml"]),
|
srcs = glob(["source/daml/patterns/daml/**/*.daml"]),
|
||||||
)
|
)
|
||||||
|
|
||||||
|
pkg_tar(
|
||||||
|
name = "daml-patterns",
|
||||||
|
srcs = glob(["source/daml/patterns/daml/**/*.daml"]) + ["source/daml/patterns/daml.yaml.template"],
|
||||||
|
strip_prefix = "/docs/source/daml/patterns",
|
||||||
|
visibility = ["//visibility:public"],
|
||||||
|
)
|
||||||
|
|
||||||
daml_test(
|
daml_test(
|
||||||
name = "daml-studio-daml-test",
|
name = "daml-studio-daml-test",
|
||||||
srcs = glob(["source/daml/daml-studio/daml/**/*.daml"]),
|
srcs = glob(["source/daml/daml-studio/daml/**/*.daml"]),
|
||||||
|
@ -6,7 +6,7 @@ Good design patterns
|
|||||||
|
|
||||||
Patterns have been useful in the programming world, as both a source of design inspiration, and a document of good design practices. This document is a catalog of DAML patterns intended to provide the same facility in the DA/DAML application world.
|
Patterns have been useful in the programming world, as both a source of design inspiration, and a document of good design practices. This document is a catalog of DAML patterns intended to provide the same facility in the DA/DAML application world.
|
||||||
|
|
||||||
:download:`Download all the example code <patterns/damlpatterns.tar.gz>`
|
You can checkout the examples locally via ``daml new daml-patterns daml-patterns``.
|
||||||
|
|
||||||
:doc:`patterns/initaccept`
|
:doc:`patterns/initaccept`
|
||||||
The Initiate and Accept pattern demonstrates how to start a bilateral workflow. One party initiates by creating a proposal or an invite contract. This gives another party the chance to accept, reject or renegotiate.
|
The Initiate and Accept pattern demonstrates how to start a bilateral workflow. One party initiates by creating a proposal or an invite contract. This gives another party the chance to accept, reject or renegotiate.
|
||||||
|
Binary file not shown.
12
docs/source/daml/patterns/daml.yaml.template
Normal file
12
docs/source/daml/patterns/daml.yaml.template
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
sdk-version: __VERSION__
|
||||||
|
name: daml-patterns
|
||||||
|
source: daml
|
||||||
|
parties:
|
||||||
|
- Alice
|
||||||
|
- Bob
|
||||||
|
version: 0.0.1
|
||||||
|
dependencies:
|
||||||
|
- daml-prim
|
||||||
|
- daml-stdlib
|
||||||
|
sandbox-options:
|
||||||
|
- --wall-clock-time
|
@ -1,651 +0,0 @@
|
|||||||
daml/0000755000076500000240000000000013420147215010616 5ustar paulstaffdaml/CoinDelegation.daml0000644000076500000240000000407313420146362014347 0ustar paulstaff
|
|
||||||
{-# LANGUAGE PartialTypeSignatures #-}
|
|
||||||
|
|
||||||
daml 1.2
|
|
||||||
module CoinDelegation where
|
|
||||||
|
|
||||||
import CoinIssuance
|
|
||||||
import Utilities
|
|
||||||
|
|
||||||
-- Delegation pattern gives A the right to exercise a choice on behalf of B
|
|
||||||
-- Party A can control a contract instance on the ledger that allows an action
|
|
||||||
-- to be performed on behalf of a second party B without B explicitly committing the action.
|
|
||||||
-- Before such delegation takes place, DAML obligable computation will make sure party B has agreed to it.
|
|
||||||
-- This is to ensure all contracts on the ledger are well-authroized
|
|
||||||
|
|
||||||
template CoinPoA
|
|
||||||
with
|
|
||||||
attorney: Party
|
|
||||||
principal: Party
|
|
||||||
where
|
|
||||||
signatory principal
|
|
||||||
|
|
||||||
controller principal can
|
|
||||||
WithdrawPoA
|
|
||||||
: ()
|
|
||||||
do return ()
|
|
||||||
|
|
||||||
-- attorney has the delegated right to Transfer
|
|
||||||
-- principle as the signatory on this contract ensures the right to Transfer is delegated voluntarily
|
|
||||||
controller attorney can
|
|
||||||
nonconsuming TransferCoin
|
|
||||||
: ContractId TransferProposal
|
|
||||||
with
|
|
||||||
coinId: ContractId Coin
|
|
||||||
newOwner: Party
|
|
||||||
do
|
|
||||||
exercise coinId Transfer with newOwner
|
|
||||||
|
|
||||||
delegate : Scenario () -- test
|
|
||||||
delegate =
|
|
||||||
scenario do
|
|
||||||
|
|
||||||
[issuer, owner, receiver, attorney] <- makePartiesFrom ["Bank", "Me", "You", "Lawyer"]
|
|
||||||
|
|
||||||
--coin is created without attorney
|
|
||||||
newCoinId <- createCoin issuer owner 100.0
|
|
||||||
|
|
||||||
--poa is created between owner and attorney
|
|
||||||
poa <- owner `submit` do create CoinPoA with principal = owner; attorney
|
|
||||||
|
|
||||||
--owner chooses to disclose coin to the attorney. This is how he devulge his coin to attorney
|
|
||||||
disclosedCoinId <- owner `submit` do exercise newCoinId Disclose with p = attorney
|
|
||||||
|
|
||||||
--attorney now can Transfer coin on behalf of the owner
|
|
||||||
tprop <- attorney `submit` do exercise poa TransferCoin with coinId = disclosedCoinId; newOwner = receiver
|
|
||||||
|
|
||||||
--receives can accept
|
|
||||||
receiver `submit` do
|
|
||||||
newCoinId <- exercise tprop AcceptTransfer
|
|
||||||
newCoin <- fetch newCoinId
|
|
||||||
|
|
||||||
assert (newCoin.owner == receiver)
|
|
||||||
assert (newCoin.issuer == issuer)
|
|
||||||
assert (newCoin.amount == 100.0)
|
|
||||||
daml/MultiplePartyAgreement.daml0000644000076500000240000000343313420153260016120 0ustar paulstaff
|
|
||||||
{-# LANGUAGE PartialTypeSignatures #-}
|
|
||||||
|
|
||||||
daml 1.2
|
|
||||||
module MultiplePartyAgreement where
|
|
||||||
|
|
||||||
import Utilities
|
|
||||||
import DA.List
|
|
||||||
|
|
||||||
-- start snippet: agreement template
|
|
||||||
template ContractPlaceholder
|
|
||||||
with
|
|
||||||
signatories: [Party]
|
|
||||||
where
|
|
||||||
signatory signatories
|
|
||||||
ensure
|
|
||||||
unique signatories
|
|
||||||
-- The rest of the template to be agreed to would follow here
|
|
||||||
-- end snippet: agreement template
|
|
||||||
|
|
||||||
-- start snippet: first half pending template
|
|
||||||
template Pending
|
|
||||||
with
|
|
||||||
finalContract: ContractPlaceholder
|
|
||||||
alreadySigned: [Party]
|
|
||||||
where
|
|
||||||
signatory alreadySigned
|
|
||||||
observer finalContract.signatories
|
|
||||||
ensure
|
|
||||||
-- Can't have duplicate signatories
|
|
||||||
unique alreadySigned
|
|
||||||
|
|
||||||
-- The parties who need to sign is the finalContract.signatories with alreadySigned filtered out
|
|
||||||
let toSign = filter (`notElem` alreadySigned) finalContract.signatories
|
|
||||||
|
|
||||||
choice Sign : ContractId Pending with
|
|
||||||
signer : Party
|
|
||||||
controller signer
|
|
||||||
do
|
|
||||||
-- Check the controller is in the toSign list, and if they are, sign the Pending contract
|
|
||||||
assert (signer `elem` toSign)
|
|
||||||
create this with alreadySigned = signer :: alreadySigned
|
|
||||||
-- end snippet: first half pending template
|
|
||||||
-- start snippet: second half pending template
|
|
||||||
choice Finalize : ContractId ContractPlaceholder with
|
|
||||||
signer : Party
|
|
||||||
controller signer
|
|
||||||
do
|
|
||||||
-- Check that all the required signatories have signed Pending
|
|
||||||
assert (sort alreadySigned == sort finalContract.signatories)
|
|
||||||
create finalContract
|
|
||||||
-- end snippet: second half pending template
|
|
||||||
|
|
||||||
multiplePartyAgreementTest : Scenario (ContractId ContractPlaceholder) -- test
|
|
||||||
multiplePartyAgreementTest = do
|
|
||||||
|
|
||||||
-- start snippet: testing setup
|
|
||||||
parties@[person1, person2, person3, person4] <- makePartiesFrom ["Alice", "Bob", "Clare", "Dave"]
|
|
||||||
let finalContract = ContractPlaceholder with signatories = parties
|
|
||||||
|
|
||||||
-- Parties cannot create a contract already signed by someone else
|
|
||||||
initialFailTest <- person1 `submitMustFail` do
|
|
||||||
create Pending with finalContract; alreadySigned = [person1, person2]
|
|
||||||
|
|
||||||
-- Any party can create a Pending contract provided they list themselves as the only signatory
|
|
||||||
pending <- person1 `submit` do
|
|
||||||
create Pending with finalContract; alreadySigned = [person1]
|
|
||||||
-- end snippet: testing setup
|
|
||||||
-- start snippet: testing add agreements
|
|
||||||
-- Each signatory of the finalContract can Sign the Pending contract
|
|
||||||
pending <- person2 `submit` do
|
|
||||||
exercise pending Sign with signer = person2
|
|
||||||
pending <- person3 `submit` do
|
|
||||||
exercise pending Sign with signer = person3
|
|
||||||
pending <- person4 `submit` do
|
|
||||||
exercise pending Sign with signer = person4
|
|
||||||
|
|
||||||
-- A party can't sign the Pending contract twice
|
|
||||||
pendingFailTest <- person3 `submitMustFail` do
|
|
||||||
exercise pending Sign with signer = person3
|
|
||||||
-- A party can't sign on behalf of someone else
|
|
||||||
pendingFailTest <- person3 `submitMustFail` do
|
|
||||||
exercise pending Sign with signer = person4
|
|
||||||
-- end snippet: testing add agreements
|
|
||||||
|
|
||||||
-- start snippet: testing finalize
|
|
||||||
person1 `submit` do
|
|
||||||
exercise pending Finalize with signer = person1
|
|
||||||
-- end snippet: testing finalize
|
|
||||||
daml/CoinCommitment.daml0000644000076500000240000000205113420144747014407 0ustar paulstaff
|
|
||||||
{-# LANGUAGE PartialTypeSignatures #-}
|
|
||||||
|
|
||||||
daml 1.2
|
|
||||||
module CoinCommitment where
|
|
||||||
|
|
||||||
import CoinIssuance
|
|
||||||
|
|
||||||
--owner can commit to lock. Once he commits, the original coin is archived.
|
|
||||||
template CoinCommitment
|
|
||||||
with
|
|
||||||
owner: Party
|
|
||||||
issuer: Party
|
|
||||||
amount: Decimal
|
|
||||||
where
|
|
||||||
signatory issuer
|
|
||||||
|
|
||||||
controller owner can
|
|
||||||
nonconsuming LockCoin
|
|
||||||
: ContractId LockedCoin
|
|
||||||
with coinCid: ContractId Coin
|
|
||||||
maturity: Time
|
|
||||||
locker: Party
|
|
||||||
do
|
|
||||||
inputCoin <- fetch coinCid
|
|
||||||
assert (inputCoin.owner == owner && inputCoin.issuer == issuer && inputCoin.amount == amount )
|
|
||||||
--the original coin firstly transferred to issuer and then archivaed
|
|
||||||
prop <- exercise coinCid Transfer with newOwner = issuer
|
|
||||||
do
|
|
||||||
id <- exercise prop AcceptTransfer
|
|
||||||
exercise id Archives
|
|
||||||
--create a lockedCoin to represent the coin in locked state
|
|
||||||
create LockedCoin with
|
|
||||||
coin=inputCoin with owner; issuer; amount
|
|
||||||
maturity; locker
|
|
||||||
|
|
||||||
daml/CoinIssuance.daml0000644000076500000240000001042513420152016014035 0ustar paulstaff
|
|
||||||
{-# LANGUAGE PartialTypeSignatures #-}
|
|
||||||
|
|
||||||
daml 1.2
|
|
||||||
module CoinIssuance where
|
|
||||||
|
|
||||||
import DA.Time
|
|
||||||
import Utilities
|
|
||||||
|
|
||||||
template CoinMaster
|
|
||||||
with
|
|
||||||
issuer: Party
|
|
||||||
where
|
|
||||||
signatory issuer
|
|
||||||
|
|
||||||
controller issuer can
|
|
||||||
nonconsuming Invite : ContractId CoinIssueProposal
|
|
||||||
with owner: Party
|
|
||||||
do create CoinIssueProposal
|
|
||||||
with coinAgreement = CoinIssueAgreement with issuer; owner
|
|
||||||
|
|
||||||
--the initiate/accept pattern moves the workflow forward
|
|
||||||
template CoinIssueProposal
|
|
||||||
with
|
|
||||||
coinAgreement: CoinIssueAgreement
|
|
||||||
where
|
|
||||||
signatory coinAgreement.issuer
|
|
||||||
|
|
||||||
controller coinAgreement.owner can
|
|
||||||
AcceptCoinProposal
|
|
||||||
: ContractId CoinIssueAgreement
|
|
||||||
do create coinAgreement
|
|
||||||
|
|
||||||
--the result contract of Initiate/Accept pattern
|
|
||||||
template CoinIssueAgreement
|
|
||||||
with
|
|
||||||
issuer: Party
|
|
||||||
owner: Party
|
|
||||||
where
|
|
||||||
signatory issuer, owner
|
|
||||||
|
|
||||||
controller issuer can
|
|
||||||
nonconsuming Issue : ContractId Coin
|
|
||||||
with amount: Decimal
|
|
||||||
do create Coin with issuer; owner; amount; delegates = []
|
|
||||||
|
|
||||||
|
|
||||||
--the original contract
|
|
||||||
template Coin
|
|
||||||
with
|
|
||||||
owner: Party
|
|
||||||
issuer: Party
|
|
||||||
amount: Decimal
|
|
||||||
delegates : [Party]
|
|
||||||
where
|
|
||||||
signatory issuer, owner
|
|
||||||
observer delegates
|
|
||||||
|
|
||||||
controller owner can
|
|
||||||
|
|
||||||
Transfer : ContractId TransferProposal
|
|
||||||
with newOwner: Party
|
|
||||||
do
|
|
||||||
create TransferProposal
|
|
||||||
with coin=this; newOwner
|
|
||||||
|
|
||||||
Lock : ContractId LockedCoin
|
|
||||||
with maturity: Time; locker: Party
|
|
||||||
do create LockedCoin with coin=this; maturity; locker
|
|
||||||
|
|
||||||
Disclose : ContractId Coin
|
|
||||||
with p : Party
|
|
||||||
do create this with delegates = p :: delegates
|
|
||||||
|
|
||||||
--a coin can only be archived by the issuer under the condition that the issuer is the owner of the coin. This ensures the issuer cannot archive coins at will.
|
|
||||||
controller issuer can
|
|
||||||
Archives
|
|
||||||
: ()
|
|
||||||
do assert (issuer == owner)
|
|
||||||
|
|
||||||
|
|
||||||
--the Coin contract in the locked state
|
|
||||||
template LockedCoin
|
|
||||||
with
|
|
||||||
coin: Coin
|
|
||||||
maturity: Time
|
|
||||||
locker: Party
|
|
||||||
where
|
|
||||||
signatory coin.issuer, coin.owner
|
|
||||||
|
|
||||||
controller locker can
|
|
||||||
Unlock
|
|
||||||
: ContractId Coin
|
|
||||||
do create coin
|
|
||||||
|
|
||||||
controller coin.owner can
|
|
||||||
Clawback
|
|
||||||
: ContractId Coin
|
|
||||||
do
|
|
||||||
currTime <- getTime
|
|
||||||
assert (currTime >= maturity)
|
|
||||||
create coin
|
|
||||||
|
|
||||||
|
|
||||||
--TransferProposal
|
|
||||||
template TransferProposal
|
|
||||||
with
|
|
||||||
coin: Coin
|
|
||||||
newOwner: Party
|
|
||||||
where
|
|
||||||
signatory coin.owner, coin.issuer
|
|
||||||
|
|
||||||
controller coin.owner can
|
|
||||||
WithdrawProposal
|
|
||||||
: ContractId Coin
|
|
||||||
do create coin
|
|
||||||
|
|
||||||
controller newOwner can
|
|
||||||
AcceptTransfer
|
|
||||||
: ContractId Coin
|
|
||||||
do create coin with owner = newOwner
|
|
||||||
|
|
||||||
RejectTransfer
|
|
||||||
: ()
|
|
||||||
do return ()
|
|
||||||
|
|
||||||
createCoin : Party -> Party -> Decimal -> Scenario (ContractId Coin)
|
|
||||||
createCoin issuer owner amount =
|
|
||||||
do
|
|
||||||
masterId <- issuer `submit` create CoinMaster with issuer
|
|
||||||
coinAgmProp <- issuer `submit` exercise masterId Invite with owner
|
|
||||||
coinAgmId <- owner `submit` exercise coinAgmProp AcceptCoinProposal
|
|
||||||
coinId <- issuer `submit` exercise coinAgmId Issue with amount
|
|
||||||
return coinId
|
|
||||||
|
|
||||||
coinIssuance : Scenario (ContractId TransferProposal) -- test
|
|
||||||
coinIssuance =
|
|
||||||
scenario
|
|
||||||
do
|
|
||||||
|
|
||||||
[issuer, owner, newOwner] <- makePartiesFrom ["Bank", "Me", "You"]
|
|
||||||
now <- pass (days 0)
|
|
||||||
--CoinMaster
|
|
||||||
masterId <- issuer `submit` do create CoinMaster with issuer
|
|
||||||
coinAgmProp <- issuer `submit` do exercise masterId Invite with owner
|
|
||||||
coinAgmId <- owner `submit` do exercise coinAgmProp AcceptCoinProposal
|
|
||||||
coinId <- issuer `submit` do exercise coinAgmId Issue with amount = 100.0
|
|
||||||
|
|
||||||
--Coin transfer test
|
|
||||||
coinTransferPropId <- owner `submit` do exercise coinId Transfer with newOwner
|
|
||||||
coinId <- newOwner `submit` do exercise coinTransferPropId AcceptTransfer
|
|
||||||
|
|
||||||
--Coin lock test
|
|
||||||
lockedCoinId <- newOwner `submit` do exercise coinId Lock with maturity= (addRelTime now (days 2)); locker=issuer
|
|
||||||
|
|
||||||
--since it is locked and maturity time hasn't elapsed yet, owner cannot clawback
|
|
||||||
newOwner `submitMustFail` do exercise lockedCoinId Clawback
|
|
||||||
|
|
||||||
--only after unlock, owner can access the coin
|
|
||||||
unlockedCoin <- issuer `submit` do exercise lockedCoinId Unlock
|
|
||||||
newOwner `submit` do exercise unlockedCoin Transfer with newOwner=owner
|
|
||||||
daml/LockingByChangingState.daml0000644000076500000240000000507613420147507016012 0ustar paulstaff
|
|
||||||
{-# LANGUAGE PartialTypeSignatures #-}
|
|
||||||
|
|
||||||
daml 1.2
|
|
||||||
module LockingByChangingState where
|
|
||||||
|
|
||||||
import Utilities
|
|
||||||
|
|
||||||
template LockableCoin
|
|
||||||
with
|
|
||||||
owner: Party
|
|
||||||
issuer: Party
|
|
||||||
amount: Decimal
|
|
||||||
locker: Party
|
|
||||||
where
|
|
||||||
signatory issuer
|
|
||||||
signatory owner
|
|
||||||
|
|
||||||
ensure amount > 0.0
|
|
||||||
|
|
||||||
--Transfer can happen only if it is not locked
|
|
||||||
controller owner can
|
|
||||||
Transfer : ContractId TransferProposal
|
|
||||||
with newOwner: Party
|
|
||||||
do
|
|
||||||
assert (locker == owner)
|
|
||||||
create TransferProposal
|
|
||||||
with coin=this; newOwner
|
|
||||||
|
|
||||||
--Lock can be done if owner decides to bring a locker on board
|
|
||||||
Lock : ContractId LockableCoin
|
|
||||||
with newLocker: Party
|
|
||||||
do
|
|
||||||
assert (newLocker /= owner)
|
|
||||||
create this with locker = newLocker
|
|
||||||
|
|
||||||
--Unlock only makes sense if the coin is in locked state
|
|
||||||
controller locker can
|
|
||||||
Unlock
|
|
||||||
: ContractId LockableCoin
|
|
||||||
do
|
|
||||||
assert (locker /= owner)
|
|
||||||
create this with locker = owner
|
|
||||||
|
|
||||||
|
|
||||||
--TransferProposal
|
|
||||||
template TransferProposal
|
|
||||||
with
|
|
||||||
coin: LockableCoin
|
|
||||||
newOwner: Party
|
|
||||||
where
|
|
||||||
signatory coin.owner, coin.issuer
|
|
||||||
|
|
||||||
controller coin.owner can
|
|
||||||
WithdrawTransfer
|
|
||||||
: ContractId LockableCoin
|
|
||||||
do create coin
|
|
||||||
|
|
||||||
controller newOwner can
|
|
||||||
AcceptTransfer
|
|
||||||
: ContractId LockableCoin
|
|
||||||
do create coin with owner = newOwner; locker = newOwner
|
|
||||||
|
|
||||||
RejectTransfer
|
|
||||||
: ()
|
|
||||||
do return ()
|
|
||||||
|
|
||||||
template CoinProposal
|
|
||||||
with
|
|
||||||
owner: Party
|
|
||||||
issuer: Party
|
|
||||||
amount: Decimal
|
|
||||||
where
|
|
||||||
signatory issuer
|
|
||||||
|
|
||||||
controller owner can
|
|
||||||
AcceptProposal
|
|
||||||
: ContractId LockableCoin
|
|
||||||
do create LockableCoin with issuer; owner; amount; locker=owner
|
|
||||||
|
|
||||||
|
|
||||||
locking : Scenario (ContractId LockableCoin) -- test
|
|
||||||
locking =
|
|
||||||
do
|
|
||||||
|
|
||||||
[issuer, owner, newOwner, locker] <- makePartiesFrom ["Bank", "Me", "You", "Custodian Bank"]
|
|
||||||
--when coin is created, owner = locker. it is unlocked
|
|
||||||
|
|
||||||
propId <- issuer `submit` do create CoinProposal with owner; issuer; amount=100.0
|
|
||||||
coinCid <- owner `submit` do exercise propId AcceptProposal
|
|
||||||
|
|
||||||
--owner can choose to lock it with his custodian bank
|
|
||||||
lockedCid <- owner `submit` do exercise coinCid Lock with newLocker=locker
|
|
||||||
--since coin is locked, owner cannot transfer
|
|
||||||
owner `submitMustFail` do exercise lockedCid Transfer with newOwner
|
|
||||||
|
|
||||||
unlockedCid <- locker `submit` do exercise lockedCid Unlock
|
|
||||||
|
|
||||||
propId <- owner `submit` do exercise unlockedCid Transfer with newOwner
|
|
||||||
newOwner `submit` do exercise propId AcceptTransfer
|
|
||||||
daml/Utilities.daml0000644000076500000240000000020513420127526013430 0ustar paulstaffdaml 1.2
|
|
||||||
module Utilities where
|
|
||||||
|
|
||||||
makePartiesFrom names =
|
|
||||||
mapA getParty names
|
|
||||||
|
|
||||||
makeParties =
|
|
||||||
makePartiesFrom ["Me", "You", "Bank"]daml/LockingBySafekeeping.daml0000644000076500000240000000511113420152352015474 0ustar paulstaff
|
|
||||||
{-# LANGUAGE PartialTypeSignatures #-}
|
|
||||||
|
|
||||||
daml 1.2
|
|
||||||
module LockingBySafekeeping where
|
|
||||||
|
|
||||||
import CoinIssuance
|
|
||||||
import Utilities
|
|
||||||
import DA.Time
|
|
||||||
|
|
||||||
data LockResult = LockResult {
|
|
||||||
coinCid : ContractId Coin;
|
|
||||||
lockCid : ContractId LockedCoinV2
|
|
||||||
}
|
|
||||||
|
|
||||||
template LockedCoinV2
|
|
||||||
with
|
|
||||||
coin: Coin
|
|
||||||
maturity: Time
|
|
||||||
locker: Party
|
|
||||||
where
|
|
||||||
signatory locker, coin.owner
|
|
||||||
|
|
||||||
controller locker can
|
|
||||||
UnlockV2
|
|
||||||
: ContractId Coin
|
|
||||||
with coinCid : ContractId Coin
|
|
||||||
do
|
|
||||||
inputCoin <- fetch coinCid
|
|
||||||
assert (inputCoin.owner == locker)
|
|
||||||
tpCid <- exercise coinCid Transfer with newOwner = coin.owner
|
|
||||||
exercise tpCid AcceptTransfer
|
|
||||||
|
|
||||||
controller coin.owner can
|
|
||||||
ClawbackV2
|
|
||||||
: ContractId Coin
|
|
||||||
with coinCid : ContractId Coin
|
|
||||||
do
|
|
||||||
currTime <- getTime
|
|
||||||
assert (currTime >= maturity)
|
|
||||||
inputCoin <- fetch coinCid
|
|
||||||
assert (inputCoin == coin with owner=locker)
|
|
||||||
tpCid <- exercise coinCid Transfer with newOwner = coin.owner
|
|
||||||
exercise tpCid AcceptTransfer
|
|
||||||
|
|
||||||
template LockRequest
|
|
||||||
with
|
|
||||||
locker: Party
|
|
||||||
maturity: Time
|
|
||||||
coin: Coin
|
|
||||||
where
|
|
||||||
signatory locker
|
|
||||||
|
|
||||||
controller coin.owner can
|
|
||||||
Accept : LockResult
|
|
||||||
with coinCid : ContractId Coin
|
|
||||||
do
|
|
||||||
inputCoin <- fetch coinCid
|
|
||||||
assert (inputCoin == coin)
|
|
||||||
tpCid <- exercise coinCid Transfer with newOwner = locker
|
|
||||||
coinCid <- exercise tpCid AcceptTransfer
|
|
||||||
lockCid <- create LockedCoinV2 with locker; maturity; coin
|
|
||||||
return LockResult {coinCid; lockCid}
|
|
||||||
|
|
||||||
|
|
||||||
locking : Scenario (ContractId Coin) -- test
|
|
||||||
locking =
|
|
||||||
scenario do
|
|
||||||
|
|
||||||
[issuer, owner, newOwner, locker] <- makePartiesFrom ["Bank", "Me", "You", "Custodian Bank"]
|
|
||||||
|
|
||||||
now <- pass (days 0)
|
|
||||||
|
|
||||||
--when coin is created, owner = locker. it is unlocked
|
|
||||||
coinId <- createCoin issuer owner 100.0
|
|
||||||
|
|
||||||
coin <- issuer `submit` do fetch coinId
|
|
||||||
lockRequestCid <- locker `submit` do
|
|
||||||
create LockRequest with locker; maturity= (addRelTime now (days 2)); coin
|
|
||||||
lockResult <- owner `submit` do exercise lockRequestCid Accept with coinCid = coinId
|
|
||||||
|
|
||||||
--since it is locked and maturity time hasn't elapsed yet, owner cannot clawback
|
|
||||||
owner `submitMustFail` do exercise lockResult.lockCid ClawbackV2 with coinCid = lockResult.coinCid
|
|
||||||
|
|
||||||
--only after unlock, owner can access the coin
|
|
||||||
unlockedCoin <- locker `submit` exercise lockResult.lockCid UnlockV2 with coinCid = lockResult.coinCid
|
|
||||||
propId <- owner `submit` exercise unlockedCoin Transfer with newOwner
|
|
||||||
newOwner `submit` exercise propId AcceptTransfer
|
|
||||||
daml/CoinTransferWithAuthorization.daml0000644000076500000240000000562613420147167017506 0ustar paulstaff
|
|
||||||
{-# LANGUAGE PartialTypeSignatures #-}
|
|
||||||
|
|
||||||
daml 1.2
|
|
||||||
module CoinTransferWithAuthorization where
|
|
||||||
|
|
||||||
import Utilities
|
|
||||||
--authorization contract allows more control on a choice
|
|
||||||
--in the example below, issuer grants access to the newOwner. which is checked on Accept choice to ensure he is legit coin owner.
|
|
||||||
|
|
||||||
-- original contract with no changes needed.
|
|
||||||
template Coin
|
|
||||||
with
|
|
||||||
owner: Party
|
|
||||||
issuer: Party
|
|
||||||
amount: Decimal
|
|
||||||
where
|
|
||||||
signatory issuer
|
|
||||||
signatory owner
|
|
||||||
|
|
||||||
ensure amount > 0.0
|
|
||||||
|
|
||||||
controller owner can
|
|
||||||
Transfer : ContractId TransferProposal
|
|
||||||
with newOwner: Party
|
|
||||||
do create TransferProposal
|
|
||||||
with coin=this; newOwner
|
|
||||||
|
|
||||||
template CoinProposal
|
|
||||||
with
|
|
||||||
owner: Party
|
|
||||||
issuer: Party
|
|
||||||
amount: Decimal
|
|
||||||
where
|
|
||||||
signatory issuer
|
|
||||||
|
|
||||||
controller owner can
|
|
||||||
AcceptProposal
|
|
||||||
: ContractId Coin
|
|
||||||
do create Coin with issuer; owner; amount
|
|
||||||
|
|
||||||
|
|
||||||
-- authorization contract
|
|
||||||
template CoinOwnerAuthorization
|
|
||||||
with
|
|
||||||
owner: Party
|
|
||||||
issuer: Party
|
|
||||||
where
|
|
||||||
signatory issuer
|
|
||||||
observer owner
|
|
||||||
|
|
||||||
controller issuer can
|
|
||||||
WithdrawAuthorization
|
|
||||||
: ()
|
|
||||||
do return ()
|
|
||||||
|
|
||||||
-- TransferProposal contract needs additional logic to ensure the newOwner is authorized to exercise Accept
|
|
||||||
template TransferProposal
|
|
||||||
with
|
|
||||||
coin: Coin
|
|
||||||
newOwner: Party
|
|
||||||
where
|
|
||||||
signatory coin.owner
|
|
||||||
signatory coin.issuer
|
|
||||||
|
|
||||||
controller coin.owner can
|
|
||||||
WithdrawTransfer
|
|
||||||
: ContractId Coin
|
|
||||||
do create coin
|
|
||||||
|
|
||||||
controller newOwner can
|
|
||||||
AcceptTransfer
|
|
||||||
: ContractId Coin
|
|
||||||
with token: ContractId CoinOwnerAuthorization
|
|
||||||
do
|
|
||||||
t <- fetch token
|
|
||||||
assert (coin.issuer == t.issuer)
|
|
||||||
assert (newOwner == t.owner)
|
|
||||||
create coin with owner = newOwner
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
tokenAccept : Scenario () -- test
|
|
||||||
tokenAccept =
|
|
||||||
scenario do
|
|
||||||
|
|
||||||
[issuer, owner, newOwner] <- makePartiesFrom ["Bank", "Me", "You"]
|
|
||||||
|
|
||||||
--test 1: token is active, allowing new owner to accept
|
|
||||||
|
|
||||||
creatProp <- issuer `submit` do create CoinProposal with owner; issuer; amount=100.0
|
|
||||||
coinId <- owner `submit` do exercise creatProp AcceptProposal
|
|
||||||
coinProp <- owner `submit` do exercise coinId Transfer with newOwner
|
|
||||||
|
|
||||||
tokenId <- issuer `submit` do create CoinOwnerAuthorization with owner = newOwner; issuer
|
|
||||||
newOwner `submit` do exercise coinProp AcceptTransfer with token = tokenId
|
|
||||||
|
|
||||||
--test 2: token is withdraw before new owner accpet. Hence the accept will fail
|
|
||||||
creatProp <- issuer `submit` do create CoinProposal with owner; issuer; amount=100.0
|
|
||||||
coinId <- owner `submit` do exercise creatProp AcceptProposal
|
|
||||||
coinProp <- owner `submit` do exercise coinId Transfer with newOwner
|
|
||||||
|
|
||||||
tokenId <- issuer `submit` do create CoinOwnerAuthorization with owner = newOwner; issuer
|
|
||||||
issuer `submit` do exercise tokenId WithdrawAuthorization
|
|
||||||
newOwner `submitMustFail` do exercise coinProp AcceptTransfer with token = tokenId
|
|
||||||
|
|
@ -12,6 +12,7 @@ genrule(
|
|||||||
]) + [
|
]) + [
|
||||||
"//docs:quickstart-java.tar.gz",
|
"//docs:quickstart-java.tar.gz",
|
||||||
"//docs:daml-intro-templates",
|
"//docs:daml-intro-templates",
|
||||||
|
"//docs:daml-patterns",
|
||||||
"//docs:copy-trigger-template",
|
"//docs:copy-trigger-template",
|
||||||
"//docs:script-example-template",
|
"//docs:script-example-template",
|
||||||
"//language-support/scala/examples:quickstart-scala-dir",
|
"//language-support/scala/examples:quickstart-scala-dir",
|
||||||
@ -49,6 +50,9 @@ genrule(
|
|||||||
mkdir -p $$OUT/script-example
|
mkdir -p $$OUT/script-example
|
||||||
tar xf $(location //docs:script-example-template) -C $$OUT/script-example
|
tar xf $(location //docs:script-example-template) -C $$OUT/script-example
|
||||||
|
|
||||||
|
mkdir -p $$OUT/daml-patterns
|
||||||
|
tar xf $(location //docs:daml-patterns) --strip-components=1 -C $$OUT/daml-patterns
|
||||||
|
|
||||||
tar zcf $(location :templates-tarball.tar.gz) templates-tarball
|
tar zcf $(location :templates-tarball.tar.gz) templates-tarball
|
||||||
""",
|
""",
|
||||||
visibility = ["//visibility:public"],
|
visibility = ["//visibility:public"],
|
||||||
|
Loading…
Reference in New Issue
Block a user