From ac9b4f343de6b32ffd444c522344344d11aa81af Mon Sep 17 00:00:00 2001 From: bame-da Date: Mon, 29 Sep 2025 14:23:30 +0000 Subject: [PATCH 01/11] WIP: An experiment in evolving the token standards in a backwards compatible way. --- build.sbt | 78 ++- .../splice-api-token-allocation-v2/daml.yaml | 20 + .../daml/Splice/Api/Token/AllocationV2.daml | 223 ++++++++ .../openapi/allocation-v1.yaml | 202 +++++++ .../openapi/docker-compose.yml | 16 + .../splice-api-token-holding-v2/daml.yaml | 19 + .../daml/Splice/Api/Token/HoldingV2.daml | 64 +++ .../splice-api-token-utils-v2/daml.yaml | 23 + .../daml/Splice/Api/Token/UtilsV2.daml | 159 ++++++ .../splice-token-standard-test-v2/daml.yaml | 46 ++ .../daml/Splice/Testing/Apps/TradingApp.daml | 205 +++++++ .../Testing/Registries/AmuletRegistry.daml | 402 ++++++++++++++ .../Registries/AmuletRegistry/Parameters.daml | 164 ++++++ .../Testing/TokenStandard/RegistryApi.daml | 51 ++ .../Testing/TokenStandard/WalletClient.daml | 140 +++++ .../daml/Splice/Testing/Utils.daml | 92 ++++ .../daml/Splice/Tests/TestAmuletTokenDvP.daml | 327 ++++++++++++ .../Splice/Tests/TestAmuletTokenTransfer.daml | 498 ++++++++++++++++++ .../.vscode/settings.json | 5 + 19 files changed, 2733 insertions(+), 1 deletion(-) create mode 100644 token-standard/splice-api-token-allocation-v2/daml.yaml create mode 100644 token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml create mode 100644 token-standard/splice-api-token-allocation-v2/openapi/allocation-v1.yaml create mode 100644 token-standard/splice-api-token-allocation-v2/openapi/docker-compose.yml create mode 100644 token-standard/splice-api-token-holding-v2/daml.yaml create mode 100644 token-standard/splice-api-token-holding-v2/daml/Splice/Api/Token/HoldingV2.daml create mode 100644 token-standard/splice-api-token-utils-v2/daml.yaml create mode 100644 token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml create mode 100644 token-standard/splice-token-standard-test-v2/daml.yaml create mode 100644 token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml create mode 100644 token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml create mode 100644 token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml create mode 100644 token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml create mode 100644 token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml create mode 100644 token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Utils.daml create mode 100644 token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml create mode 100644 token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml create mode 100644 token-standard/splice-token-standard-test/.vscode/settings.json diff --git a/build.sbt b/build.sbt index e66f8da63b..678440d7ef 100644 --- a/build.sbt +++ b/build.sbt @@ -111,13 +111,17 @@ lazy val root: Project = (project in file(".")) `splice-validator-lifecycle-test-daml`, `splice-api-token-metadata-v1-daml`, `splice-api-token-holding-v1-daml`, + `splice-api-token-holding-v2-daml`, `splice-api-token-transfer-instruction-v1-daml`, `splice-api-token-allocation-v1-daml`, + `splice-api-token-allocation-v2-daml`, `splice-api-token-allocation-request-v1-daml`, `splice-api-token-allocation-instruction-v1-daml`, `splice-api-token-burn-mint-v1-daml`, + `splice-api-token-utils-v2-daml`, `splice-token-standard-test-daml`, `splice-token-test-trading-app-daml`, + `splice-token-standard-test-v2-daml`, `splice-token-test-dummy-holding-daml`, `build-tools-dar-lock-checker`, `canton-community-base`, @@ -230,11 +234,14 @@ lazy val docs = project (`splice-util-featured-app-proxies-daml` / Compile / damlBuild).value ++ (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-holding-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-burn-mint-v1-daml` / Compile / damlBuild).value + (`splice-api-token-utils-v2-daml` / Compile / damlBuild).value cacheDamlDocs( damlSources.toSet ).toSeq @@ -350,6 +357,17 @@ lazy val `splice-api-token-holding-v1-daml` = ) .dependsOn(`canton-bindings-java`) +lazy val `splice-api-token-holding-v2-daml` = + project + .in(file("token-standard/splice-api-token-holding-v2")) + .enablePlugins(DamlPlugin) + .settings( + BuildCommon.damlSettings, + Compile / damlDependencies := + (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value, + ) + .dependsOn(`canton-bindings-java`) + lazy val `splice-api-token-transfer-instruction-v1-daml` = project .in(file("token-standard/splice-api-token-transfer-instruction-v1")) @@ -385,7 +403,19 @@ lazy val `splice-api-token-allocation-v1-daml` = BuildCommon.damlSettings, Compile / damlDependencies := (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value, + (`splice-api-token-holding-v1-daml` / Compile / damlBuild).value, + ) + .dependsOn(`canton-bindings-java`) + +lazy val `splice-api-token-allocation-v2-daml` = + project + .in(file("token-standard/splice-api-token-allocation-v2")) + .enablePlugins(DamlPlugin) + .settings( + BuildCommon.damlSettings, + Compile / damlDependencies := + (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value, ) .dependsOn(`canton-bindings-java`) @@ -438,6 +468,31 @@ lazy val `splice-token-test-trading-app-daml` = (`splice-api-token-holding-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value, + (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-util-daml` / Compile / damlBuild).value ++ + (`splice-amulet-daml` / Compile / damlBuild).value, + ) + .dependsOn(`canton-bindings-java`) + +lazy val `splice-api-token-utils-v2-daml` = + project + .in(file("token-standard/splice-api-token-utils-v2")) + .enablePlugins(DamlPlugin) + .settings( + BuildCommon.damlSettings, + Compile / damlDependencies := + (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-holding-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value, + (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-util-daml` / Compile / damlBuild).value ++ + (`splice-amulet-daml` / Compile / damlBuild).value, ) .dependsOn(`canton-bindings-java`) @@ -460,6 +515,27 @@ lazy val `splice-token-standard-test-daml` = ) .dependsOn(`canton-bindings-java`) +lazy val `splice-token-standard-test-v2-daml` = + project + .in(file("token-standard/splice-token-standard-test-v2")) + .enablePlugins(DamlPlugin) + .settings( + BuildCommon.damlSettings, + Compile / damlDependencies := + (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-holding-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-utils-v2-daml` / Compile / damlBuild).value ++ + (`splice-util-daml` / Compile / damlBuild).value ++ + (`splice-amulet-daml` / Compile / damlBuild).value, + ) + .dependsOn(`canton-bindings-java`) + lazy val `splice-token-test-dummy-holding-daml` = project .in(file("token-standard/examples/splice-token-test-dummy-holding")) diff --git a/token-standard/splice-api-token-allocation-v2/daml.yaml b/token-standard/splice-api-token-allocation-v2/daml.yaml new file mode 100644 index 0000000000..93839bc85d --- /dev/null +++ b/token-standard/splice-api-token-allocation-v2/daml.yaml @@ -0,0 +1,20 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +sdk-version: 3.3.0-snapshot.20250502.13767.0.v2fc6c7e2 +name: splice-api-token-allocation-v2 +version: 2.0.0 +source: daml +dependencies: +- daml-prim +- daml-stdlib +data-dependencies: +- ../splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar +- ../splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar +build-options: + - --target=2.1 +codegen: + java: + package-prefix: org.lfdecentralizedtrust.splice.codegen.java + decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceApiTokenAllocationV1 + output-directory: target/scala-2.13/src_managed/main/daml-codegen-java diff --git a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml new file mode 100644 index 0000000000..e89344eafd --- /dev/null +++ b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml @@ -0,0 +1,223 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | This module defines the `Allocation` interface and supporting types. +-- +-- Contracts implementing the `Allocation` interface represent a reservation of +-- assets to transfer them as part of an atomic on-ledger settlement requested +-- by an app. +module Splice.Api.Token.AllocationV2 where + +import DA.TextMap + +import Splice.Api.Token.MetadataV1 +import Splice.Api.Token.HoldingV2 (Holding, InstrumentId) + +-- | A generic type to refer to data defined within an app. + +-- The interpretation of such a reference is app specific, but SHOULD be unambiguous within the context of the app. +data Reference = Reference with + id : Text + -- ^ The key that identifies the data. Can be set to the empty string if the contract-id is provided and is sufficient. + cid : Optional AnyContractId + -- ^ Optional contract-id to use for referring to contracts. + -- + -- This field is there for technical reasons, as contract-ids cannot be converted to text from within Daml, + -- which is due to their full textual representation being only known after transactions have been prepared. + deriving (Show, Eq) + +-- | The minimal set of information about a settlement that an app would like to execute. +data SettlementInfo = SettlementInfo + with + executor : Party + -- ^ The party that is responsible for executing the settlement. + settlementRef : Reference + -- ^ Reference to the settlement that app would like to execute. + requestedAt : Time + -- ^ When the settlement was requested. Provided for display and debugging purposes, + -- but SHOULD be in the past. + allocateBefore : Time + -- ^ Until when (exclusive) the senders are given time to allocate their assets. + -- This field has a particular relevance with respect to instrument versioning / corporate + -- actions, in that the settlement pertains to the instrument version resulting from the + -- processing of all corporate actions falling strictly before the `allocateBefore` time. + settleBefore : Time + -- ^ Until when (exclusive) the executor is given time to execute the settlement. + -- + -- SHOULD be strictly after `allocateBefore`. + meta : Metadata + -- ^ Additional metadata about the settlement, used for extensibility. + controllerOverride : Optional [Party] + -- ^ Additional party signatures in addition to executor that need to authorize + -- choices on the Allocation. Defaults to senders and receivers across all + -- transferLegs. + + deriving (Show, Eq) + +-- | A specification of a transfer of holdings between two parties for the +-- purpose of a settlement, which often requires the atomic execution of multiple legs. +data TransferLeg = TransferLeg with + sender : Party + -- ^ The sender of the transfer. + receiver : Party + -- ^ The receiver of the transfer. + amount : Decimal + -- ^ The amount to transfer. + instrumentId : InstrumentId + -- ^ The instrument identifier. + meta : Metadata + -- ^ Additional metadata about the transfer leg, used for extensibility. + deriving (Eq, Ord, Show) + +-- | The specification of an allocation of assets to a specific leg of a settlement. +-- +-- In contrast to an `AllocationView` this just specifies what should be allocated, +-- but not the holdings that are backing the allocation. +data AllocationSpecification = AllocationSpecification with + settlement : SettlementInfo + -- ^ The settlement for whose execution the assets are being allocated. + transferLegs: TextMap TransferLeg + -- ^ the transfers that this allocation satisfies + deriving (Show, Eq) + +-- | View of a funded allocation of assets to a specific leg of a settlement. +data AllocationView = AllocationView with + allocation : AllocationSpecification + -- ^ The settlement for whose execution the assets are being allocated. + holdingCids : [ContractId Holding] + -- ^ The holdings that are backing this allocation. + -- + -- Provided so that that wallets can correlate the allocation with the + -- holdings. + -- + -- MAY be empty for registries that do not represent their holdings on-ledger. + meta : Metadata + -- ^ Additional metadata specific to the allocation, used for extensibility. + transferExtraAuth : [Party] + -- ^ Any additional parties whose authorization that needs to be provided to + -- Allocation_ExecuteTransfer via AllocationTransferAuthorizations + deriving (Show, Eq) + +-- | View of a delegated authority from the signer to the execurot to settle given transfer legs. +-- authorizers are always the signatories so not made available in the viewtype. +data AllocationTransferAuthorizationView = AllocationTransferAuthorizationView with + allocation : AllocationSpecification + -- ^ the allocation to which this authorization applies. + + +-- Allocation +------------------------ + +-- | Convenience function to refer to the union of sender, receiver, and +-- executor of the settlement, which jointly control the execution of the +-- allocation. +allocationControllers : AllocationView -> [Party] +allocationControllers AllocationView{..} = + optional + (allocation.settlement.executor :: concat (map (\leg -> [leg._2.sender, leg._2.receiver]) (toList allocation.transferLegs))) + (\override -> allocation.settlement.executor :: override) + allocation.settlement.controllerOverride + +-- | Convenience function all senders +allocationSenders : AllocationView -> [Party] +allocationSenders AllocationView{..} = map (._2.sender) (toList allocation.transferLegs) + + + +-- | A contract representing an allocation of some amount of aasset holdings to +-- a specific leg of a settlement. +interface Allocation where + viewtype AllocationView + + allocation_executeTransferImpl : ContractId Allocation -> Allocation_ExecuteTransfer -> Update Allocation_ExecuteTransferResult + allocation_cancelImpl : ContractId Allocation -> Allocation_Cancel -> Update Allocation_CancelResult + allocation_withdrawImpl : ContractId Allocation -> Allocation_Withdraw -> Update Allocation_WithdrawResult + allocation_executeAuthorizeIncomingImpl : ContractId Allocation -> Allocation_AuthorizeIncoming -> Update (ContractId AllocationTransferAuthorization) + + choice Allocation_AuthorizeIncoming : ContractId AllocationTransferAuthorization + -- ^ Transfer the authority from this Allocation to a AllocationTransferAuthorization which + -- can then be used in another allocation's Allocation_ExecuteTransfer to authorize incoming + -- transfers. + with + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller allocationControllers (view this) + do allocation_executeAuthorizeIncomingImpl this self arg + + choice Allocation_ExecuteTransfer : Allocation_ExecuteTransferResult + -- ^ Execute the transfer of the allocated assets. Intended to be used to execute the settlement. + -- This choice SHOULD succeed provided the `settlement.settleBefore` deadline has not yet passed. + with + extraAuth : Optional [ContractId AllocationTransferAuthorization] + -- ^ Contract encapsulating extra authority needed to exercise the choice + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller allocationControllers (view this) + do allocation_executeTransferImpl this self arg + + choice Allocation_Cancel : Allocation_CancelResult + -- ^ Cancel the allocation. Requires authorization from sender, receiver, and + -- executor. + -- + -- Typically this authorization is granted by sender and receiver to the + -- executor as part of the contract coordinating the settlement, so that + -- that the executor can release the allocated assets early in case the + -- settlement is aborted or it has definitely failed. + with + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller allocationControllers (view this) + do allocation_cancelImpl this self arg + + choice Allocation_Withdraw : Allocation_WithdrawResult + -- ^ Withdraw the allocated assets. Used by the sender to withdraw the assets before settlement + -- was completed. This SHOULD not fail settlement if the sender has still time to allocate the + -- assets again; i.e., the `settlement.allocateBefore` deadline has not yet passed. + with + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller allocationSenders (view this) + do allocation_withdrawImpl this self arg + +-- AllocationTransferAuthorization +---------------------------------- + +-- | A contract representing a delegated authority from the signatories to the execuror to settle +-- given transfer legs. +interface AllocationTransferAuthorization where + viewtype AllocationTransferAuthorizationView + +-- Result types +--------------- + +-- | The result of the `Allocation_ExecuteTransfer` choice. +data Allocation_ExecuteTransferResult = Allocation_ExecuteTransferResult + with + senderHoldingCids : [ContractId Holding] + -- ^ The holdings that were created for the sender. Can be used to return + -- "change" to the sender if required. + receiverHoldingCids : [ContractId Holding] + -- ^ The holdings that were created for the receiver. + meta : Metadata + -- ^ Additional metadata specific to the transfer instruction, used for extensibility. + deriving (Show, Eq) + +-- | The result of the `Allocation_Cancel` choice. +data Allocation_CancelResult = Allocation_CancelResult + with + senderHoldingCids : [ContractId Holding] + -- ^ The holdings that were released back to the sender. + meta : Metadata + -- ^ Additional metadata specific to the allocation, used for extensibility. + deriving (Show, Eq) + +-- | The result of the `Allocation_Withdraw` choice. +data Allocation_WithdrawResult = Allocation_WithdrawResult + with + senderHoldingCids : [ContractId Holding] + -- ^ The holdings that were released back to the sender. + meta : Metadata + -- ^ Additional metadata specific to the allocation, used for extensibility. + deriving (Show, Eq) + + diff --git a/token-standard/splice-api-token-allocation-v2/openapi/allocation-v1.yaml b/token-standard/splice-api-token-allocation-v2/openapi/allocation-v1.yaml new file mode 100644 index 0000000000..19b566f896 --- /dev/null +++ b/token-standard/splice-api-token-allocation-v2/openapi/allocation-v1.yaml @@ -0,0 +1,202 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +openapi: 3.0.0 +info: + title: allocation off-ledger API + description: | + Implemented by token registries for the purpose of the use and management of + allocations by wallets and apps orchestrating the settlement of asset transfers. + version: 1.0.0 +paths: + + /registry/allocations/v1/{allocationId}/choice-contexts/execute-transfer: + post: + operationId: "getAllocationTransferContext" + description: | + Get the choice context to execute a transfer on an allocation. + parameters: + - name: allocationId + description: "The contract ID of the allocation whose transfer the caller wants to execute." + in: path + required: true + schema: + type: string + requestBody: + required: true + content: + application/json: + schema: + $ref: "#/components/schemas/GetChoiceContextRequest" + responses: + "200": + description: ok + content: + application/json: + schema: + $ref: "#/components/schemas/ChoiceContext" + "400": + $ref: "#/components/responses/400" + "404": + $ref: "#/components/responses/404" + + /registry/allocations/v1/{allocationId}/choice-contexts/withdraw: + post: + operationId: "getAllocationWithdrawContext" + description: | + Get the choice context to withdraw an allocation. + parameters: + - name: allocationId + description: "The contract ID of the allocation to withdraw." + in: path + required: true + schema: + type: string + requestBody: + required: true + content: + application/json: + schema: + $ref: "#/components/schemas/GetChoiceContextRequest" + responses: + "200": + description: ok + content: + application/json: + schema: + $ref: "#/components/schemas/ChoiceContext" + "400": + $ref: "#/components/responses/400" + "404": + $ref: "#/components/responses/404" + + /registry/allocations/v1/{allocationId}/choice-contexts/cancel: + post: + operationId: "getAllocationCancelContext" + description: | + Get the choice context to cancel an allocation. + parameters: + - name: allocationId + description: "The contract ID of the allocation to cancel." + in: path + required: true + schema: + type: string + requestBody: + required: true + content: + application/json: + schema: + $ref: "#/components/schemas/GetChoiceContextRequest" + responses: + "200": + description: ok + content: + application/json: + schema: + $ref: "#/components/schemas/ChoiceContext" + "400": + $ref: "#/components/responses/400" + "404": + $ref: "#/components/responses/404" + +components: + responses: + "400": + description: "bad request" + content: + application/json: + schema: + $ref: "#/components/schemas/ErrorResponse" + "404": + description: "not found" + content: + application/json: + schema: + $ref: "#/components/schemas/ErrorResponse" + schemas: + GetChoiceContextRequest: + description: | + A request to get the context for executing a choice on a contract. + type: object + properties: + meta: + description: | + Metadata that will be passed to the choice, and should be incorporated + into the choice context. Provided for extensibility. + type: object + additionalProperties: + type: string + + ChoiceContext: + description: | + The context required to exercise a choice on a contract via an interface. + Used to retrieve additional reference date that is passed in via disclosed contracts, + which are in turn referred to via their contract ID in the `choiceContextData`. + type: object + properties: + choiceContextData: + description: "The additional data to use when exercising the choice." + type: object + disclosedContracts: + description: | + The contracts that are required to be disclosed to the participant node for exercising + the choice. + type: array + items: + $ref: "#/components/schemas/DisclosedContract" + required: + [ + "choiceContextData", + "disclosedContracts", + ] + + # Note: intentionally not shared with the other APIs to keep the self-contained, and because not all OpenAPI codegens support such shared definitions. + DisclosedContract: + type: object + properties: + templateId: + type: string + contractId: + type: string + createdEventBlob: + type: string + synchronizerId: + description: | + The synchronizer to which the contract is currently assigned. + If the contract is in the process of being reassigned, then a "409" response is returned. + type: string + debugPackageName: + description: | + The name of the Daml package that was used to create the contract. + Use this data only if you trust the provider, as it might not match the data in the + `createdEventBlob`. + type: string + debugPayload: + description: | + The contract arguments that were used to create the contract. + Use this data only if you trust the provider, as it might not match the data in the + `createdEventBlob`. + type: object + debugCreatedAt: + description: | + The ledger effective time at which the contract was created. + Use this data only if you trust the provider, as it might not match the data in the + `createdEventBlob`. + type: string + format: date-time + required: + [ + "templateId", + "contractId", + "createdEventBlob", + "synchronizerId" + ] + + ErrorResponse: + type: object + required: + - error + properties: + error: + type: string diff --git a/token-standard/splice-api-token-allocation-v2/openapi/docker-compose.yml b/token-standard/splice-api-token-allocation-v2/openapi/docker-compose.yml new file mode 100644 index 0000000000..f429f77389 --- /dev/null +++ b/token-standard/splice-api-token-allocation-v2/openapi/docker-compose.yml @@ -0,0 +1,16 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +# Description: Docker compose file for running Swagger UI with the allocation OpenAPI specification. +# Usage: docker-compose up +version: '3.7' + +services: + swagger-ui: + image: swaggerapi/swagger-ui + ports: + - "8080:8080" + environment: + SWAGGER_JSON: /spec/allocation.yaml + volumes: + - ./allocation.yaml:/spec/allocation.yaml diff --git a/token-standard/splice-api-token-holding-v2/daml.yaml b/token-standard/splice-api-token-holding-v2/daml.yaml new file mode 100644 index 0000000000..8ac58f151c --- /dev/null +++ b/token-standard/splice-api-token-holding-v2/daml.yaml @@ -0,0 +1,19 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +sdk-version: 3.3.0-snapshot.20250502.13767.0.v2fc6c7e2 +name: splice-api-token-holding-v2 +version: 2.0.0 +source: daml +dependencies: +- daml-prim +- daml-stdlib +data-dependencies: +- ../splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar +build-options: + - --target=2.1 +codegen: + java: + package-prefix: org.lfdecentralizedtrust.splice.codegen.java + decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceApiTokenHoldingV1 + output-directory: target/scala-2.13/src_managed/main/daml-codegen-java diff --git a/token-standard/splice-api-token-holding-v2/daml/Splice/Api/Token/HoldingV2.daml b/token-standard/splice-api-token-holding-v2/daml/Splice/Api/Token/HoldingV2.daml new file mode 100644 index 0000000000..f38480fa4a --- /dev/null +++ b/token-standard/splice-api-token-holding-v2/daml/Splice/Api/Token/HoldingV2.daml @@ -0,0 +1,64 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Types and interfaces for retrieving an investor's holdings. +module Splice.Api.Token.HoldingV2 where + +import DA.Time (RelTime) + +import Splice.Api.Token.MetadataV1 + +-- | A globally unique identifier for instruments. +data InstrumentId = InstrumentId + with + admin : Party + -- ^ The party representing the registry app that administers the instrument. + id : Text + -- ^ The identifier used for the instrument by the instrument admin. + -- + -- This identifier MUST be unique and unambiguous per instrument admin. + deriving (Eq, Ord, Show) + +-- | Details of a lock. +data Lock = Lock + with + holders : [Party] + -- ^ Unique list of parties which are locking the contract. + -- (Represented as a list, as that has the better JSON encoding.) + expiresAt : Optional Time + -- ^ Absolute, inclusive deadline as of which the lock expires. + expiresAfter : Optional RelTime + -- ^ Duration after which the created lock expires. Measured relative + -- to the ledger time that the locked holding contract was created. + -- + -- If both `expiresAt` and `expiresAfter` are set, the lock expires at + -- the earlier of the two times. + context : Optional Text + -- ^ Short, human-readable description of the context of the lock. + -- Used by wallets to enable users to understand the reason for the lock. + -- + -- Note that the visibility of the content in this field might be wider + -- than the visibility of the contracts in the context. You should thus + -- carefully decide what information is safe to put in the lock context. + deriving (Eq, Ord, Show) + +-- | Holding interface. +interface Holding where viewtype HoldingView + +-- | View for `Holding`. +data HoldingView = HoldingView + with + owner : Party + -- ^ Owner of the holding. + instrumentId : InstrumentId + -- ^ Instrument being held. + amount : Decimal + -- ^ Size of the holding. + lock : Optional Lock + -- ^ Lock on the holding. + -- + -- Registries SHOULD allow holdings with expired locks as inputs to + -- transfers to enable a combined unlocking + use choice. + meta : Metadata + -- ^ Metadata. + deriving (Eq, Show) diff --git a/token-standard/splice-api-token-utils-v2/daml.yaml b/token-standard/splice-api-token-utils-v2/daml.yaml new file mode 100644 index 0000000000..d1dda92bec --- /dev/null +++ b/token-standard/splice-api-token-utils-v2/daml.yaml @@ -0,0 +1,23 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +sdk-version: 3.3.0-snapshot.20250502.13767.0.v2fc6c7e2 +name: splice-api-token-utils-v2 +version: 2.0.0 +source: daml +dependencies: +- daml-prim +- daml-stdlib +data-dependencies: +- ../splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar +- ../splice-api-token-holding-v1/.daml/dist/splice-api-token-holding-v1-current.dar +- ../splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar +- ../splice-api-token-allocation-v1/.daml/dist/splice-api-token-allocation-v1-current.dar +- ../splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar +build-options: + - --target=2.1 +codegen: + java: + package-prefix: org.lfdecentralizedtrust.splice.codegen.java + decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceApiTokenHoldingV1 + output-directory: target/scala-2.13/src_managed/main/daml-codegen-java diff --git a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml new file mode 100644 index 0000000000..d4cef4543d --- /dev/null +++ b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml @@ -0,0 +1,159 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Conversion functions and standard implementations used to +-- implement the V1 interfaces from the V2 interfaces. +module Splice.Api.Token.UtilsV2 where + +import DA.TextMap qualified as TextMap + +import Splice.Api.Token.MetadataV1 +import Splice.Api.Token.HoldingV1 qualified as HoldingV1 +import Splice.Api.Token.HoldingV2 qualified as HoldingV2 +import Splice.Api.Token.AllocationV1 qualified as AllocationV1 +import Splice.Api.Token.AllocationV2 qualified as AllocationV2 + +-- Holding +---------- + +-- Upcast +instrumentId_v1_to_v2 : HoldingV1.InstrumentId -> HoldingV2.InstrumentId +instrumentId_v1_to_v2 HoldingV1.InstrumentId{..} = HoldingV2.InstrumentId with .. + +lock_v1_to_v2 : HoldingV1.Lock -> HoldingV2.Lock +lock_v1_to_v2 HoldingV1.Lock{..} = HoldingV2.Lock with .. + +holdingv1_to_v2 : HoldingV1.HoldingView -> HoldingV2.HoldingView +holdingv1_to_v2 v1 = v2 + where + v2 = HoldingV2.HoldingView with + owner = v1.owner + instrumentId = instrumentId_v1_to_v2 v1.instrumentId + amount = v1.amount + lock = fmap lock_v1_to_v2 v1.lock + meta = v1.meta + +-- Downcast +instrumentId_v2_to_v1 : HoldingV2.InstrumentId -> HoldingV1.InstrumentId +instrumentId_v2_to_v1 HoldingV2.InstrumentId{..} = HoldingV1.InstrumentId with .. + +lock_v2_to_v1 : HoldingV2.Lock -> HoldingV1.Lock +lock_v2_to_v1 HoldingV2.Lock{..} = HoldingV1.Lock with .. + +holdingv2_to_v1 : HoldingV2.HoldingView -> HoldingV1.HoldingView +holdingv2_to_v1 v2 = v1 + where + v1 = HoldingV1.HoldingView with + owner = v2.owner + instrumentId = instrumentId_v2_to_v1 v2.instrumentId + amount = v2.amount + lock = fmap lock_v2_to_v1 v2.lock + meta = v2.meta + +-- Allocation +------------- + +-- Upcast +reference_v1_to_v2 : AllocationV1.Reference -> AllocationV2.Reference +reference_v1_to_v2 AllocationV1.Reference{..} = AllocationV2.Reference with .. + +settlement_info_v1_to_v2 : AllocationV1.SettlementInfo -> AllocationV2.SettlementInfo +settlement_info_v1_to_v2 AllocationV1.SettlementInfo{..} = v2 + where + controllerOverride = case TextMap.lookup "canton.network/controllerOverride" meta.values of + None -> None + Some co -> None -- TODO: Parse controller override. + v2 = AllocationV2.SettlementInfo with + executor + settlementRef = reference_v1_to_v2 settlementRef + requestedAt + allocateBefore + settleBefore + meta + controllerOverride = None + +transfer_leg_v1_to_v2 : AllocationV1.TransferLeg -> AllocationV2.TransferLeg +transfer_leg_v1_to_v2 AllocationV1.TransferLeg{..} = + AllocationV2.TransferLeg with + instrumentId = instrumentId_v1_to_v2 instrumentId + .. + +allocation_specification_v1_to_v2 : AllocationV1.AllocationSpecification -> AllocationV2.AllocationSpecification +allocation_specification_v1_to_v2 AllocationV1.AllocationSpecification{..} = + AllocationV2.AllocationSpecification with + settlement = settlement_info_v1_to_v2 settlement + transferLegs = TextMap.fromList ((transferLegId, transfer_leg_v1_to_v2 transferLeg)::otherLegs) + where + otherLegs = case TextMap.lookup "canton.network/otherLegs" transferLeg.meta.values of + None -> [] + Some ol -> [] -- TODO: Parse other legs. + +allocation_view_v1_to_v2 : AllocationV1.AllocationView -> AllocationV2.AllocationView +allocation_view_v1_to_v2 AllocationV1.AllocationView{..} = + AllocationV2.AllocationView with + allocation = allocation_specification_v1_to_v2 allocation + holdingCids = map coerceInterfaceContractId holdingCids + meta + transferExtraAuth + where + transferExtraAuth = case TextMap.lookup "canton.network/transferExtraAuth" meta.values of + None -> [] + Some ol -> [] -- TODO: Parse extra auth list. + + +-- Downcast +reference_v2_to_v1 : AllocationV2.Reference -> AllocationV1.Reference +reference_v2_to_v1 AllocationV2.Reference{..} = AllocationV1.Reference with .. + +settlement_info_v2_to_v1 : AllocationV2.SettlementInfo -> AllocationV1.SettlementInfo +settlement_info_v2_to_v1 AllocationV2.SettlementInfo{..} = v1 + where + meta' = Metadata with + values = + TextMap.insert "canton.network/version" "v2" $ + TextMap.insert "canton.network/controllerOverride" (show controllerOverride) $ + meta.values + v1 = AllocationV1.SettlementInfo with + executor + settlementRef = reference_v2_to_v1 settlementRef + requestedAt + allocateBefore + settleBefore + meta = meta' + +transfer_leg_v2_to_v1 : AllocationV2.TransferLeg -> AllocationV1.TransferLeg +transfer_leg_v2_to_v1 AllocationV2.TransferLeg{..} = + AllocationV1.TransferLeg with + instrumentId = instrumentId_v2_to_v1 instrumentId + .. + +allocation_specification_v2_to_v1 : AllocationV2.AllocationSpecification -> AllocationV1.AllocationSpecification +allocation_specification_v2_to_v1 AllocationV2.AllocationSpecification{..} = + AllocationV1.AllocationSpecification with + settlement = settlement_info_v2_to_v1 settlement + transferLegId + transferLeg = transfer_leg_v2_to_v1 transferLeg + where + (transferLegId, transferLeg')::other = if TextMap.size transferLegs > 0 + then TextMap.toList transferLegs + else error "Cannot downcast an allocation specification without any legs." + meta = Metadata with + values = + TextMap.insert "canton.network/version" "v2" $ + TextMap.insert "canton.network/otherLegs" (show other) $ + transferLeg'.meta.values + transferLeg = transferLeg' with meta + +allocation_view_v2_to_v1 : AllocationV2.AllocationView -> AllocationV1.AllocationView +allocation_view_v2_to_v1 AllocationV2.AllocationView{..} = + AllocationV1.AllocationView with + allocation = allocation_specification_v2_to_v1 allocation + holdingCids = map coerceInterfaceContractId holdingCids + meta = meta' + where + meta' = Metadata with + values = + TextMap.insert "canton.network/version" "v2" $ + TextMap.insert "canton.network/transferExtraAuth" (show transferExtraAuth) $ + meta.values + diff --git a/token-standard/splice-token-standard-test-v2/daml.yaml b/token-standard/splice-token-standard-test-v2/daml.yaml new file mode 100644 index 0000000000..7fdc21249a --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml.yaml @@ -0,0 +1,46 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +sdk-version: 3.3.0-snapshot.20250502.13767.0.v2fc6c7e2 +name: splice-token-standard-test-v2 +description: | + Test infrastructure for the token standard. + + Includes the setup for an amulet-based test registry; and tests + that showcase using that one to interact via Amulet using the token standard APIs. + + Also includes an OTC Trading app that demos how to use the allocation APIs to + settle DvP obligations. + + Must be consumed by copying the source-code into the downstream project, + as Daml script code can currently not be shared via .dars across SDKs. + (TODO(#594): remove this limitation) +version: 2.0.0 +source: daml +dependencies: + - daml-prim + - daml-stdlib + - daml-script +data-dependencies: + - ../splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar + - ../splice-api-token-holding-v1/.daml/dist/splice-api-token-holding-v1-current.dar + - ../splice-api-token-transfer-instruction-v1/.daml/dist/splice-api-token-transfer-instruction-v1-current.dar + - ../splice-api-token-allocation-v1/.daml/dist/splice-api-token-allocation-v1-current.dar + - ../splice-api-token-allocation-request-v1/.daml/dist/splice-api-token-allocation-request-v1-current.dar + - ../splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar + - ../../daml/splice-util/.daml/dist/splice-util-current.dar + - ../../daml/splice-amulet/.daml/dist/splice-amulet-current.dar + - ../splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar + - ../splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar + - ../splice-api-token-utils-v2/.daml/dist/splice-api-token-utils-v2-current.dar + +build-options: + - --target=2.1 + - --ghc-option=-Wunused-binds + - --ghc-option=-Wunused-matches + - -Wno-template-interface-depends-on-daml-script # This is test-only code, not intended to be uploaded to the ledger +codegen: + java: + package-prefix: org.lfdecentralizedtrust.splice.codegen.java + decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceTokenTransferTest + output-directory: target/scala-2.13/src_managed/main/daml-codegen-java diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml new file mode 100644 index 0000000000..883e77d7b9 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml @@ -0,0 +1,205 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | An example of how to build an OTC trading app for multi-leg standard token trades. +-- +-- Used as part of the testing infrastructure to test the DvP workflows based on the token standard. +module Splice.Testing.Apps.TradingApp where + +import DA.Foldable qualified as F +import DA.Optional (fromOptional, fromSomeNote) +import DA.Set as Set +import DA.TextMap as TextMap +import DA.Traversable qualified as Traversable + +import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 +import Splice.Api.Token.AllocationV1 as Api.Token.AllocationV1 +import Splice.Api.Token.AllocationRequestV1 + + +template OTCTradeProposal with + venue : Party + tradeCid : Optional (ContractId OTCTradeProposal) -- Tracking-id for the trade being proposed. Set to None for new trades. + transferLegs : TextMap Api.Token.AllocationV1.TransferLeg + approvers : [Party] -- ^ Parties that have approved the proposal + where + signatory approvers + observer venue, tradingParties transferLegs + + -- This is test code, so we don't care about the contention here. + -- Moreover, likely the number of trading parties is going to be low anyways. + choice OTCTradeProposal_Accept : ContractId OTCTradeProposal + with + approver : Party + controller approver + do + let newApprovers = approver :: approvers + let traders = tradingParties transferLegs + require "Approver is a trading party" (approver `Set.member` traders) + require "Approver is new" (approver `notElem` approvers) + create this with + approvers = newApprovers + tradeCid = Some (fromOptional self tradeCid) + + choice OTCTradeProposal_Reject : () + with + trader : Party + controller trader + do require "Trader is a trading party" (trader `Set.member` tradingParties transferLegs) + + choice OTCTradeProposal_InitiateSettlement : ContractId OTCTrade + with + prepareUntil : Time + settleBefore : Time + controller venue + do + require "All trading parties have approved" (Set.fromList approvers == tradingParties transferLegs) + now <- getTime + require "Preparation time has not passed" (now < prepareUntil) + require "Preparation time before settlement time" (prepareUntil < settleBefore) + create OTCTrade with + venue + transferLegs + tradeCid = fromOptional self tradeCid + createdAt = now + prepareUntil + settleBefore + +tradeAllocations + : SettlementInfo -> TextMap Api.Token.AllocationV1.TransferLeg + -> TextMap AllocationSpecification +tradeAllocations settlementInfo transferLegs = + TextMap.fromList $ do + (transferLegId, transferLeg) <- TextMap.toList transferLegs + let spec = AllocationSpecification with + settlement = settlementInfo + transferLegId + transferLeg + pure (transferLegId, spec) + +template OTCTrade + with + venue : Party + transferLegs : TextMap Api.Token.AllocationV1.TransferLeg + tradeCid : ContractId OTCTradeProposal + createdAt : Time + prepareUntil : Time + settleBefore : Time + where + signatory venue, tradingParties transferLegs + + choice OTCTrade_Settle : TextMap Allocation_ExecuteTransferResult + with + allocationsWithContext : TextMap (ContractId Allocation, ExtraArgs) + controller venue + do + -- check timing constraints + now <- getTime + require "Settlement deadline has not passed" (now < settleBefore) + -- validate and execute transferLegs + let settlementInfo = SettlementInfo with + executor = venue + requestedAt = createdAt + settlementRef = makeTradeRef tradeCid + allocateBefore = prepareUntil + settleBefore + meta = emptyMetadata + let expectedAllocations = tradeAllocations settlementInfo transferLegs + let mergedMaps = zipTextMaps allocationsWithContext expectedAllocations + forTextMapWithKey mergedMaps \legId (optAllocWithContext, optExpectedAlloc) -> do + let (allocCid, extraArgs) = fromSomeNote ("Allocation cid and extra arg is missing for leg " <> legId) optAllocWithContext + let expectedAlloc = fromSomeNote ("Allocation with context provided for unexpected leg " <> legId) optExpectedAlloc + -- fetch and validate the allocation instruction + instr <- fetch @Allocation allocCid + let instrView = view @Allocation instr + require "Allocation matches expected allocation" (instrView.allocation == expectedAlloc) + exercise allocCid (Allocation_ExecuteTransfer extraArgs) + + + -- NOTE: this choice is an approximation to what a real app would do. + -- As it stands, the venue can't cancel allocations that come right after + -- the first cancellation. A better approach would be to leave a marker + -- contract in place until the `settleBefore` time, so that the venue + -- retains the ability to cancel the allocations that are created. + choice OTCTrade_Cancel : TextMap (Optional Allocation_CancelResult) + with + allocationsWithContext : TextMap (ContractId Allocation, ExtraArgs) + controller venue + do + -- validate and cancel transferLegs + let settlementInfo = SettlementInfo with + executor = venue + requestedAt = createdAt + settlementRef = makeTradeRef tradeCid + allocateBefore = prepareUntil + settleBefore + meta = emptyMetadata + let expectedAllocations = tradeAllocations settlementInfo transferLegs + let mergedMaps = zipTextMaps allocationsWithContext expectedAllocations + -- fetch and validate the allocation instruction + forTextMapWithKey mergedMaps \legId (optAllocWithContext, optExpectedAlloc) -> + -- skip the leg if there is no matching allocation to cancel + Traversable.forA optAllocWithContext $ \(allocCid, extraArgs) -> do + -- fetch and validate the allocation instruction + let expectedAlloc = fromSomeNote ("Allocation with context provided for unexpected leg " <> legId) optExpectedAlloc + instr <- fetch @Allocation allocCid + let instrView = view @Allocation instr + require "Allocation matches expected allocation" (instrView.allocation == expectedAlloc) + exercise allocCid (Allocation_Cancel extraArgs) + + + interface instance AllocationRequest for OTCTrade where + view = AllocationRequestView with + settlement = SettlementInfo with + executor = venue + requestedAt = createdAt + settlementRef = makeTradeRef tradeCid + allocateBefore = prepareUntil + settleBefore + meta = emptyMetadata + transferLegs + meta = emptyMetadata + + allocationRequest_RejectImpl _self AllocationRequest_Reject{..} = do + -- Note: this corresponds to signalling early that one is going to fail to deliver one's assets. + -- A real trading app will likely demand punitive charges for this. + require "Actor is a sender" (F.any (\leg -> actor == leg.sender) transferLegs) + pure ChoiceExecutionMetadata with meta = emptyMetadata + + allocationRequest_WithdrawImpl _self _extraArgs = + -- just archiving the trade is enough + pure ChoiceExecutionMetadata with meta = emptyMetadata + + +tradingParties : TextMap Api.Token.AllocationV1.TransferLeg -> Set.Set Party +tradingParties = F.foldl (\acc t -> Set.insert t.sender (Set.insert t.receiver acc)) Set.empty + +-- | Check whether a required condition is true. If it's not, abort the +-- transaction with a message saying that the requirement was not met. +require : CanAssert m => Text -> Bool -> m () +require msg invariant = + assertMsg ("The requirement '" <> msg <> "' was not met.") invariant + +makeTradeRef : ContractId OTCTradeProposal -> Api.Token.AllocationV1.Reference +makeTradeRef tradeCid = Api.Token.AllocationV1.Reference with + id = "OTCTradeProposal" -- set to the name of the template to simplify debugging + cid = Some (coerceContractId tradeCid) + + +-- Additional text map utilities +-------------------------------- + +zipTextMaps : TextMap a -> TextMap b -> TextMap (Optional a, Optional b) +zipTextMaps m1 m2 = + TextMap.merge + (\_ v1 -> Some (Some v1, None)) + (\_ v2 -> Some (None, Some v2)) + (\_ v1 v2 -> Some (Some v1, Some v2)) + m1 + m2 + +forTextMapWithKey : Applicative f => TextMap a -> (Text -> a -> f b) -> f (TextMap b) +forTextMapWithKey m f = + TextMap.fromList <$> mapA f' (TextMap.toList m) + where + f' (k, v) = (k,) <$> f k v diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml new file mode 100644 index 0000000000..cc5a597456 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml @@ -0,0 +1,402 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Daml script functions for initializing and using an amulet registry via the +-- token standard and the amulet specific functions. +module Splice.Testing.Registries.AmuletRegistry + ( + -- * Setup + AmuletRegistryConfig(..) + , defaultAmuletRegistryConfig + + , AmuletRegistry(..) + , initialize + + -- * Amulet registry specific functions + , tapFaucet + , featureApp + , createTransferPreapproval + , beneficiariesToMetadata + + -- ** Locking + , TimeLock(..) + , createLockedAmulet + , expireLockAsOwner + , tapLockedAndUnlockedFunds + + ) where + +import DA.Action (unless) +import DA.Date +import qualified DA.TextMap as TextMap +import DA.Optional (isSome) +import DA.List.Total +import DA.Time +import DA.Text qualified as T + +import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 +import Splice.Api.Token.HoldingV1 as Api.Token.HoldingV1 +import Splice.Api.Token.AllocationV1 as Api.Token.AllocationV1 +import Splice.Api.Token.AllocationInstructionV1 +import Splice.Api.Token.TransferInstructionV1 + +import Splice.Amulet +import Splice.Amulet.TokenApiUtils +import Splice.AmuletAllocation +import Splice.AmuletTransferInstruction +import Splice.AmuletRules +import Splice.Expiry +import Splice.ExternalPartyAmuletRules +import Splice.Fees +import Splice.Round + +import Splice.Testing.Utils +import Splice.Testing.Registries.AmuletRegistry.Parameters +import Splice.Testing.TokenStandard.RegistryApi + +import Daml.Script + +-- Registry representation +-------------------------- + +-- | A reference to a mock amulet registry. +-- Use it via the the token standard functions provided by the "Splice.Testing.RegistryApi" module +-- and type-class; or via the amulet specific functions exported from this module. +data AmuletRegistry = AmuletRegistry with + dso : Party + instrumentId : InstrumentId + deriving (Eq, Ord, Show) + +instance RegistryApi AmuletRegistry where + getTransferFactory = registryApi_getTransferFactory + getAllocationFactory = registryApi_getAllocationFactory + getAllocation_TransferContext app cid _meta = registryApi_getAllocationTransferContext app cid + getAllocation_WithdrawContext app cid _meta = registryApi_getAllocation_abortTwoStepTransferContext app cid + getAllocation_CancelContext app cid _meta = registryApi_getAllocation_abortTwoStepTransferContext app cid + getTransferInstruction_AcceptContext app cid _meta = registryApi_getTransferInstruction_AcceptContext app cid + getTransferInstruction_RejectContext app cid _meta = registryApi_getTransferInstruction_abortTwoStepTransferContext app cid + getTransferInstruction_WithdrawContext app cid _meta = registryApi_getTransferInstruction_abortTwoStepTransferContext app cid + + +-- Registry initialization +-------------------------- +data AmuletRegistryConfig = AmuletRegistryConfig + with + initialAmuletPrice : Decimal + demoTime : Time + deriving (Eq, Show) + +-- | Recommended default configuration for setting up the mock amulet registry. +defaultAmuletRegistryConfig : AmuletRegistryConfig +defaultAmuletRegistryConfig = AmuletRegistryConfig with + initialAmuletPrice = 0.5 -- a non-zero price that still makes it easy to reason about fees and amounts + demoTime = time (DA.Date.date 2022 Jan 1) 0 0 0 + +-- | Initialize the mock amulet registry. +initialize : AmuletRegistryConfig -> Script AmuletRegistry +initialize config = do + -- use a time that is easy to reason about in script outputs + setTime config.demoTime + + dso <- allocateParty "dso-party" + let registry = AmuletRegistry with + dso + instrumentId = amuletInstrumentId dso + + _ <- submit dso $ createCmd AmuletRules with + configSchedule = defaultAmuletConfigSchedule + isDevNet = True + .. + + _ <- submit dso $ createCmd ExternalPartyAmuletRules with dso + + (amuletRulesCid, _) <- getAmuletRules registry + submit registry.dso $ exerciseCmd amuletRulesCid AmuletRules_Bootstrap_Rounds with + amuletPrice = config.initialAmuletPrice + round0Duration = minutes 10 -- no special setup for normal tests + + -- return the off-ledger reference to the registry for later script steps + return registry + +-- | Tap the faucet on DevNet to get a specified amount of Amulet. +tapFaucet : AmuletRegistry -> Party -> Decimal -> Script (ContractId Holding) +tapFaucet registry user amount = do + (openRound, _) <- getLatestOpenRound registry + (amuletRulesCid, _) <- getAmuletRules registry + amuletRulesD <- queryDisclosure' @AmuletRules registry.dso amuletRulesCid + openMiningRoundD <- queryDisclosure' @OpenMiningRound registry.dso openRound + let disclosures = amuletRulesD <> openMiningRoundD + result <- submitWithDisclosures' user disclosures $ exerciseCmd amuletRulesCid AmuletRules_DevNet_Tap with + receiver = user + amount + openRound + return $ toInterfaceContractId result.amuletSum.amulet + + +-- | Direct-create locked amulet -- used for testing purposes only. +createLockedAmulet : AmuletRegistry -> Party -> Decimal -> TimeLock -> Script (ContractId Holding) +createLockedAmulet registry user amount lock = do + (_, openRound) <- getLatestOpenRound registry + let transferConfigAmulet = transferConfigAmuletFromOpenRound openRound + lockedAmuletCid <- submitMulti [user, registry.dso] [] $ createCmd LockedAmulet with + lock + amulet = Amulet with + dso = registry.dso + owner = user + amount = ExpiringAmount with + initialAmount = amount + createdAt = openRound.round + ratePerRound = transferConfigAmulet.holdingFee + pure (toInterfaceContractId lockedAmuletCid) + +-- | Simulate that a validator operator created a transfer pre-approval for a party +-- for the purpose of that party being able to receive Amulet from any other party. +createTransferPreapproval : AmuletRegistry -> Party -> Party -> Time -> Script (ContractId TransferPreapproval) +createTransferPreapproval registry receiver provider expiresAt = do + now <- getTime + submitMulti [receiver, provider, registry.dso] [] $ createCmd TransferPreapproval with + receiver + provider + dso = registry.dso + validFrom = now + lastRenewedAt = now + expiresAt + +-- | Mark a particular registry provider part as featured. +featureApp : AmuletRegistry -> Party -> Script (ContractId FeaturedAppRight) +featureApp registry provider = do + (amuletRulesCid, _) <- getAmuletRules registry + result <- submitMulti [provider] [registry.dso] $ exerciseCmd amuletRulesCid AmuletRules_DevNet_FeatureApp with + provider + return result.featuredAppRightCid + +-- | Encode a list of beneficiaries as metadata to pass in via token standard choices. +-- Currently only supported for allocation execution. +beneficiariesToMetadata : [(Party, Decimal)] -> Metadata +beneficiariesToMetadata [] = emptyMetadata +beneficiariesToMetadata bs = Metadata with + values = TextMap.fromList + [ (appRewardBeneficiariesMetaKey, commaSeparated [ partyToText b._1 | b <- bs]) + , (appRewardBeneficiaryWeightsMetaKey, commaSeparated [ show b._2 | b <- bs]) + ] + where + commaSeparated = T.intercalate "," + + +-- Token standard registry implementation +----------------------------------------- + +registryApi_getTransferFactory + : AmuletRegistry -> TransferFactory_Transfer + -> Script (EnrichedFactoryChoice TransferFactory TransferFactory_Transfer) +registryApi_getTransferFactory registry arg = do + (extAmuletRulesCid, extAmuletRulesD) <- getExtAmuletRulesWithDisclosures registry + transferC <- getAmuletRulesTransferContext registry + (optPreapproval, preapprovalC) <- lookupPreapprovalWithContext registry arg.transfer.receiver + featuredAppRightC <- case optPreapproval of + None -> pure emptyOpenApiChoiceContext + Some preapproval -> getFeaturedAppRightContext registry preapproval.provider + let fullContext = withExtraDisclosures extAmuletRulesD + (transferC <> preapprovalC <> featuredAppRightC) + pure EnrichedFactoryChoice with + factoryCid = toInterfaceContractId @TransferFactory extAmuletRulesCid + arg = arg with extraArgs = arg.extraArgs with context = fullContext.choiceContext + disclosures = fullContext.disclosures + +registryApi_getAllocationFactory + : AmuletRegistry -> AllocationFactory_Allocate + -> Script (EnrichedFactoryChoice AllocationFactory AllocationFactory_Allocate) +registryApi_getAllocationFactory registry arg = do + (extAmuletRulesCid, extAmuletRulesD) <- getExtAmuletRulesWithDisclosures registry + transferC <- getAmuletRulesTransferContext registry + let fullContext = withExtraDisclosures extAmuletRulesD transferC + pure EnrichedFactoryChoice with + factoryCid = toInterfaceContractId @AllocationFactory extAmuletRulesCid + arg = arg with extraArgs = arg.extraArgs with context = fullContext.choiceContext + disclosures = fullContext.disclosures + +registryApi_getAllocationTransferContext + : AmuletRegistry -> ContractId Allocation -> Script OpenApiChoiceContext +registryApi_getAllocationTransferContext registry allocCid = do + transferC <- getAmuletRulesTransferContext registry + Some amuletAlloc <- queryContractId @AmuletAllocation registry.dso (coerceContractId allocCid) + featuredAppRightC <- getFeaturedAppRightContext registry amuletAlloc.allocation.settlement.executor + -- need to disclose the amulet contract, as the executor has no visibility into it + lockedAmuletD <- queryDisclosure' @LockedAmulet registry.dso amuletAlloc.lockedAmulet + pure $ withExtraDisclosures lockedAmuletD (transferC <> featuredAppRightC) + +registryApi_getTransferInstruction_AcceptContext + : AmuletRegistry -> ContractId TransferInstruction -> Script OpenApiChoiceContext +registryApi_getTransferInstruction_AcceptContext registry instrCid = do + transferC <- getAmuletRulesTransferContext registry + Some amuletInstr <- queryContractId @AmuletTransferInstruction registry.dso (coerceContractId instrCid) + -- need to disclose the amulet contract, as the receiver has no visibility into it + lockedAmuletD <- queryDisclosure' @LockedAmulet registry.dso amuletInstr.lockedAmulet + pure $ withExtraDisclosures lockedAmuletD transferC + +registryApi_getTransferInstruction_abortTwoStepTransferContext + : AmuletRegistry -> ContractId TransferInstruction -> Script OpenApiChoiceContext +registryApi_getTransferInstruction_abortTwoStepTransferContext registry instrCid = do + -- check whether the locked amulet is still active, so that aborts still work + -- even if the owner of the LockedAmulet expired it + Some amuletInstr <- queryContractId @AmuletTransferInstruction registry.dso (coerceContractId instrCid) + optLockedAmulet <- queryContractId @LockedAmulet registry.dso amuletInstr.lockedAmulet + let lockedAmuletActive = isSome optLockedAmulet + -- this can only happen if the locked amulet already expired + now <- getTime + unless (lockedAmuletActive || amuletInstr.transfer.executeBefore <= now) $ + fail "Invariant violation: the locked amulet is archived, but the transfer is not yet expired" + -- this context communicates whether to unlock the amulet + let expireLockC = OpenApiChoiceContext with + disclosures = mempty + choiceContext = mkAmuletContext $ TextMap.fromList [(expireLockKey, AV_Bool lockedAmuletActive)] + if lockedAmuletActive + then do + -- disclose the amulet contract, as the caller might not be able to see it + lockedAmuletD <- queryDisclosure' @LockedAmulet registry.dso amuletInstr.lockedAmulet + openRoundC <- getOpenRoundContext registry + pure $ withExtraDisclosures lockedAmuletD (openRoundC <> expireLockC) + else + pure expireLockC + +registryApi_getAllocation_abortTwoStepTransferContext + : AmuletRegistry -> ContractId Allocation -> Script OpenApiChoiceContext +registryApi_getAllocation_abortTwoStepTransferContext registry instrCid = do + -- check whether the locked amulet is still active, so that aborts still work + -- even if the owner of the LockedAmulet expired it + Some amuletAlloc <- queryContractId @AmuletAllocation registry.dso (coerceContractId instrCid) + optLockedAmulet <- queryContractId @LockedAmulet registry.dso amuletAlloc.lockedAmulet + let lockedAmuletActive = isSome optLockedAmulet + -- this can only happen if the locked amulet already expired + now <- getTime + unless (lockedAmuletActive || amuletAlloc.allocation.settlement.settleBefore <= now) $ + fail "Invariant violation: the locked amulet is archived, but the settlement is not yet expired" + -- this context communicates whether to unlock the amulet + let expireLockC = OpenApiChoiceContext with + disclosures = mempty + choiceContext = mkAmuletContext $ TextMap.fromList [(expireLockKey, AV_Bool lockedAmuletActive)] + if lockedAmuletActive + then do + -- disclose the amulet contract, as the caller might not be able to see it + lockedAmuletD <- queryDisclosure' @LockedAmulet registry.dso amuletAlloc.lockedAmulet + openRoundC <- getOpenRoundContext registry + pure $ withExtraDisclosures lockedAmuletD (openRoundC <> expireLockC) + else + pure expireLockC + + +-- Internal functions +--------------------- + +mkAmuletContext : TextMap.TextMap AnyValue -> ChoiceContext +mkAmuletContext values = ChoiceContext with + values + +getAmuletRules : AmuletRegistry -> Script (ContractId AmuletRules, AmuletRules) +getAmuletRules registry = do + rules <- query @AmuletRules registry.dso + case rules of + [rule] -> return rule + [] -> failNotInitialized "No AmuletRules found" + _ -> fail "Multiple AmuletRules found: are you initializing the Amulet registry multiple times?" + +-- Primarily used by submitters to decide against which round they should try to transact. +getLatestOpenRound : AmuletRegistry -> Script (ContractId OpenMiningRound, OpenMiningRound) +getLatestOpenRound registry = do + now <- getTime + -- only get open rounds + rounds <- queryFilter @OpenMiningRound registry.dso (\round -> now >= round.opensAt) + case maximumOn (\(_, r) -> r.round) rounds of + None -> failNotInitialized "No open open mining round found" + Some r-> pure r + +failNotInitialized : Text -> Script a +failNotInitialized problem = + fail $ problem <> ": have you called 'initialize' to initialize the Amulet registry?" + +getExtAmuletRulesWithDisclosures : AmuletRegistry -> Script (ContractId ExternalPartyAmuletRules, Disclosures') +getExtAmuletRulesWithDisclosures registry = do + [(extAmuletRulesCid, _)] <- query @ExternalPartyAmuletRules registry.dso + extAmuletRulesD <- queryDisclosure' registry.dso extAmuletRulesCid + pure (extAmuletRulesCid, extAmuletRulesD) + +getAmuletRulesContext : AmuletRegistry -> Script OpenApiChoiceContext +getAmuletRulesContext registry = do + (amuletRulesCid, _) <- getAmuletRules registry + amuletRulesD <- queryDisclosure' @AmuletRules registry.dso amuletRulesCid + pure OpenApiChoiceContext with + choiceContext = mkAmuletContext $ TextMap.fromList + [(amuletRulesContextKey, AV_ContractId $ coerceContractId amuletRulesCid)] + disclosures = amuletRulesD + +getOpenRoundContext : AmuletRegistry -> Script OpenApiChoiceContext +getOpenRoundContext registry = do + (openRoundCid, _) <- getLatestOpenRound registry + openRoundD <- queryDisclosure' @OpenMiningRound registry.dso openRoundCid + pure OpenApiChoiceContext with + choiceContext = mkAmuletContext $ TextMap.fromList + [(openRoundContextKey, AV_ContractId $ coerceContractId openRoundCid)] + disclosures = openRoundD + +-- | Context required to call an amulet rules transfer choice. +getAmuletRulesTransferContext : AmuletRegistry -> Script OpenApiChoiceContext +getAmuletRulesTransferContext registry = do + rulesC <- getAmuletRulesContext registry + roundC <- getOpenRoundContext registry + pure $ rulesC <> roundC + +lookupPreapprovalWithContext : AmuletRegistry -> Party -> Script (Optional TransferPreapproval, OpenApiChoiceContext) +lookupPreapprovalWithContext registry receiver = do + preapprovals <- queryFilter @TransferPreapproval receiver (\preapproval -> preapproval.receiver == receiver) + case preapprovals of + [] -> pure (None, emptyOpenApiChoiceContext) + (preapprovalCid, preapproval) :: _ -> do + preapprovalD <- queryDisclosure' @TransferPreapproval registry.dso preapprovalCid + pure + ( Some preapproval + , OpenApiChoiceContext with + disclosures = preapprovalD + choiceContext = mkAmuletContext $ + TextMap.fromList [(transferPreapprovalContextKey, AV_ContractId (coerceContractId preapprovalCid))] + ) + +getFeaturedAppRightContext : AmuletRegistry -> Party -> Script OpenApiChoiceContext +getFeaturedAppRightContext registry provider = do + appRights <- queryFilter @FeaturedAppRight registry.dso (\appRight -> appRight.provider == provider) + case appRights of + [] -> pure emptyOpenApiChoiceContext + (rightCid, _) :: _ -> do + rightDisc <- queryDisclosure' @FeaturedAppRight registry.dso rightCid + pure OpenApiChoiceContext with + disclosures = rightDisc + choiceContext = mkAmuletContext $ + TextMap.fromList [ (featuredAppRightContextKey, AV_ContractId (coerceContractId rightCid)) ] + +emptyOpenApiChoiceContext : OpenApiChoiceContext +emptyOpenApiChoiceContext = OpenApiChoiceContext with + disclosures = mempty + choiceContext = mkAmuletContext TextMap.empty + +expireLockAsOwner : AmuletRegistry -> ContractId Holding -> Script (ContractId Holding) +expireLockAsOwner registry lockedHoldingCid = do + let lockedAmuletCid = coerceContractId lockedHoldingCid + Some lockedAmulet <- queryContractId @LockedAmulet registry.dso lockedAmuletCid + (openRoundCid, _) <- getLatestOpenRound registry + openRoundD <- queryDisclosure' @OpenMiningRound registry.dso openRoundCid + result <- submitWithDisclosures' lockedAmulet.amulet.owner openRoundD $ exerciseCmd lockedAmuletCid + LockedAmulet_OwnerExpireLock with openRoundCid + pure (toInterfaceContractId result.amuletSum.amulet) + +-- | Get funds in equal splits as locked and unlocked holdings to test using +-- expired locked holdings as transfer inputs. +tapLockedAndUnlockedFunds : AmuletRegistry -> Party -> Decimal -> Script [ContractId Holding] +tapLockedAndUnlockedFunds registry user amount = do + let lockedAmount = amount / 2.0 + let unlockedAmount = amount - lockedAmount + unlockedCid <- tapFaucet registry user unlockedAmount + now <- getTime + lockedCid <- createLockedAmulet registry user lockedAmount TimeLock with + holders = [registry.dso] + expiresAt = now -- we want these funds to already be expired + optContext = Some "test expired lock" + pure [unlockedCid, lockedCid] diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml new file mode 100644 index 0000000000..a806f1c567 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml @@ -0,0 +1,164 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Default configuration paramaters for the amulet registry used for testing. +module Splice.Testing.Registries.AmuletRegistry.Parameters where + +import qualified DA.Set as Set +import DA.Time + + +import Splice.AmuletConfig +import Splice.Fees +import Splice.DecentralizedSynchronizer +import Splice.Issuance +import Splice.Schedule + +-- | Somewhat realistic fees to be used in test-code. +defaultTransferConfig : TransferConfig USD +defaultTransferConfig = TransferConfig with + -- Fee to create a new amulet. + -- Set to the fixed part of the transfer fee. + createFee = FixedFee 0.03 + + -- Fee for keeping a amulet around. + -- This is roughly equivalent to 1.05$/365 days but expressed as rounds + -- with one day corresponding to 24*60/10 rounds, i.e., one round + -- every 10 minutes. + -- Incentivizes users to actively merge their amulets. + holdingFee = RatePerRound 0.00002 + + -- Fee per lock holder. + -- Chosen to match the update to cover the cost of informing lock-holders about + -- actions on the locked amulet. + lockHolderFee = FixedFee 0.005 + + -- Fee for transferring some amount of amulet to a new owner. + transferFee = SteppedRate with + initialRate = 0.01 + steps = [(100.0, 0.001), (1000.0, 0.0001), (1000000.0, 0.00001)] + + -- Extra reward amount for featured apps in USD + extraFeaturedAppRewardAmount = 1.0 + + -- These should be large enough to ensure efficient batching, but not too large + -- to avoid creating very large transactions. + maxNumInputs = 100 + maxNumOutputs = 100 + + -- Maximum number of lock holders. + -- Chosen conservatively, but high enough to invite thinking about what's possible. + maxNumLockHolders = 10 + +-- | Decentralized synchronizer config to use for testing. +defaultAmuletDecentralizedSynchronizerConfig : AmuletDecentralizedSynchronizerConfig +defaultAmuletDecentralizedSynchronizerConfig = AmuletDecentralizedSynchronizerConfig with + requiredSynchronizers = Set.fromList ["decentralized-synchronizer-id-0"] + activeSynchronizer = "decentralized-synchronizer-id-0" + fees = defaultSynchronizerFeesConfig + +-- default to 1.0 for testing +defaultFeaturedAppActivityMarkerAmount : Decimal +defaultFeaturedAppActivityMarkerAmount = 1.0 + +-- | Default proposal for issuance curve and tickDuration +defaultAmuletConfig : AmuletConfig USD +defaultAmuletConfig = AmuletConfig with + transferConfig = defaultTransferConfig + + issuanceCurve = defaultIssuanceCurve + + decentralizedSynchronizer = defaultAmuletDecentralizedSynchronizerConfig + + -- Duration of one tick, which is half the target duration of one round + tickDuration = minutes 10 + packageConfig = PackageConfig with + amulet = "0.1.0" + amuletNameService = "0.1.0" + dsoGovernance = "0.1.0" + validatorLifecycle = "0.1.0" + wallet = "0.1.0" + walletPayments = "0.1.0" + + -- Fee for keeping a transfer-preapproval around. + -- Similar to holding fees, it compensates the SVs for the storage cost of the contract. + -- Roughly equal to $1/year expressed as a daily rate. + transferPreapprovalFee = Some defaultTransferPreapprovalFee + + -- Amount of the AppRewardCoupon contract that a FeaturedAppActivityMarker is converted to. + featuredAppActivityMarkerAmount = Some defaultFeaturedAppActivityMarkerAmount + +-- | Default configuration schedule with single current amulet config +defaultAmuletConfigSchedule : Schedule Time (AmuletConfig USD) +defaultAmuletConfigSchedule = Schedule with + initialValue = defaultAmuletConfig + futureValues = [] + +-- Test issuance curve +---------------------- + +issuanceConfig_0_0p5 : IssuanceConfig +issuanceConfig_0_0p5 = issuanceConfig_10plus with + amuletToIssuePerYear = 40e9 + validatorRewardPercentage = 0.05 + appRewardPercentage = 0.15 + +issuanceConfig_0p5_1p5 : IssuanceConfig +issuanceConfig_0p5_1p5 = issuanceConfig_10plus with + amuletToIssuePerYear = 20e9 + validatorRewardPercentage = 0.12 + appRewardPercentage = 0.40 + +issuanceConfig_1p5_5 : IssuanceConfig +issuanceConfig_1p5_5 = issuanceConfig_10plus with + amuletToIssuePerYear = 10e9 + validatorRewardPercentage = 0.18 + appRewardPercentage = 0.62 + +issuanceConfig_5_10 : IssuanceConfig +issuanceConfig_5_10 = issuanceConfig_10plus with + amuletToIssuePerYear = 5e9 + validatorRewardPercentage = 0.21 + appRewardPercentage = 0.69 + +issuanceConfig_10plus : IssuanceConfig +issuanceConfig_10plus = IssuanceConfig with + amuletToIssuePerYear = 2.5e9 + validatorRewardPercentage = 0.2 + appRewardPercentage = 0.75 + -- TODO(#827): move these params out of the `IssuanceConfig` to save space and bandwidth for txs referencing `AmuletRules` + validatorRewardCap = 0.2 + featuredAppRewardCap = 100.0 + unfeaturedAppRewardCap = 0.6 + optValidatorFaucetCap = None -- We use the default of 2.85 USD introduced in the upgrade for CIP-3 + + +defaultIssuanceCurve : Schedule RelTime IssuanceConfig +defaultIssuanceCurve = + Schedule with + initialValue = issuanceConfig_0_0p5 + futureValues = + [ (hours hoursPerHalfYear, issuanceConfig_0p5_1p5) + , (hours (3 * hoursPerHalfYear) , issuanceConfig_1p5_5) + , (hours (5 * hoursPerYear), issuanceConfig_5_10) + , (hours (10 * hoursPerYear), issuanceConfig_10plus) + ] + where + hoursPerHalfYear = 12 * 365 + hoursPerYear = 24 * 365 + + +-- | Default synchronizer fees configuration + +defaultBaseRateTrafficLimits : BaseRateTrafficLimits +defaultBaseRateTrafficLimits = BaseRateTrafficLimits with + -- 10txs of 20kB each within 10 minutes + burstAmount = 10 * 20 * 1000 + burstWindow = minutes 10 + +defaultSynchronizerFeesConfig : SynchronizerFeesConfig +defaultSynchronizerFeesConfig = SynchronizerFeesConfig with + baseRateTrafficLimits = defaultBaseRateTrafficLimits + minTopupAmount = 1_000_000 -- 1MB + extraTrafficPrice = 1.0 + readVsWriteScalingFactor = 4 -- charge 4 per 10,000, i.e., 0.04% of write cost for every read diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml new file mode 100644 index 0000000000..d7b41e8d76 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml @@ -0,0 +1,51 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Support for using a token compliant registry API in tests. +-- +-- These simulate the OpenAPI endpoints that would be served by the backend of the registry implementation. +module Splice.Testing.TokenStandard.RegistryApi + ( RegistryApi(..) + ) where + +import Splice.Api.Token.MetadataV1 +import Splice.Api.Token.AllocationV1 as Api.Token.AllocationV1 +import Splice.Api.Token.AllocationInstructionV1 +import Splice.Api.Token.TransferInstructionV1 + +import Splice.Testing.Utils + +import Daml.Script + + +-- | Type-class for simulating calls to the off-ledger API of a registry. +-- +-- The function names match the names of the handlers defined in the OpenAPI specification. +class RegistryApi app where + -- TODO (DACH-NY/canton-network-node#17541): add functions for simulating all OpenAPI endpoints as part of testing the unhappy paths + + getTransferFactory + : app -> TransferFactory_Transfer + -> Script (EnrichedFactoryChoice TransferFactory TransferFactory_Transfer) + + getAllocationFactory + : app -> AllocationFactory_Allocate + -> Script (EnrichedFactoryChoice AllocationFactory AllocationFactory_Allocate) + + getAllocation_TransferContext + : app -> ContractId Allocation -> Metadata -> Script OpenApiChoiceContext + + getAllocation_WithdrawContext + : app -> ContractId Allocation -> Metadata -> Script OpenApiChoiceContext + + getAllocation_CancelContext + : app -> ContractId Allocation -> Metadata -> Script OpenApiChoiceContext + + getTransferInstruction_AcceptContext + : app -> ContractId TransferInstruction -> Metadata -> Script OpenApiChoiceContext + + getTransferInstruction_RejectContext + : app -> ContractId TransferInstruction -> Metadata -> Script OpenApiChoiceContext + + getTransferInstruction_WithdrawContext + : app -> ContractId TransferInstruction -> Metadata -> Script OpenApiChoiceContext diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml new file mode 100644 index 0000000000..b19733c374 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml @@ -0,0 +1,140 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Daml script test utilities for simulating the actions of wallet client +-- based on the token standard. +-- +-- NOTE: there are likely more functions that could/should be added to this module. PRs welcome. +module Splice.Testing.TokenStandard.WalletClient + ( + -- * Reading/checking holdings + listHoldings, + listHoldingCids, + listLockedHoldings, + + checkHoldingWithAmountExists, + checkBalanceBounds, + checkBalance, + checkBalanceApprox, + checkHolding, + checkHoldingBounds, + checkHoldingApprox, + + -- * Reading transfer instructions + listTransferOffers, + + -- * Reading allocations + listRequestedAllocations, + + ) where + +import DA.Action (unless) +import DA.Optional (isSome) +import DA.TextMap qualified as TextMap + +import Splice.Api.Token.AllocationV1 qualified as AllocationV1 +import Splice.Api.Token.TransferInstructionV1 qualified as TransferInstructionV1 +import Splice.Api.Token.AllocationRequestV1 qualified as AllocationRequestV1 +import Splice.Api.Token.HoldingV1 qualified as HoldingV1 + +import Splice.Api.Token.UtilsV2 +import Splice.Api.Token.AllocationV2 qualified as AllocationV2 +import Splice.Api.Token.HoldingV2 qualified as HoldingV2 + +import Daml.Script + +-- | List the hodlings of a party of a specific instrument. +-- We always read as V1 and upcast as needed. +listHoldings : Party -> HoldingV1.InstrumentId -> Script [(ContractId HoldingV1.Holding, HoldingV1.HoldingView)] +listHoldings p instrumentId = do + holdings <- queryInterface @HoldingV1.Holding p + let instrumendHoldings = do + (cid, Some holding) <- holdings + guard (holding.instrumentId == instrumentId) + guard (holding.owner == p) + pure (cid, holding) + pure instrumendHoldings + +listLockedHoldings : Party -> HoldingV1.InstrumentId -> Script [(ContractId HoldingV1.Holding, HoldingV1.HoldingView)] +listLockedHoldings p instrumentId = + filter (\(_, holding) -> isSome (holding.lock)) <$> listHoldings p instrumentId + +-- | List the cids of the hodlings of a party of a specific instrument. +listHoldingCids : Party -> HoldingV1.InstrumentId -> Script [ContractId HoldingV1.Holding] +listHoldingCids p instrumentId = (map fst) <$> listHoldings p instrumentId + +-- | Check that a holding with a specific amount exists for the given owner. +checkHoldingWithAmountExists : Party -> HoldingV1.InstrumentId -> Decimal -> Script () +checkHoldingWithAmountExists p instrumentId amount = do + holdings <- map snd <$> listHoldings p instrumentId + unless (any (\holding -> holding.amount == amount) holdings) $ + fail (show p <> " is missing holding of value " <> show amount <> " in " <> show holdings) + +-- | Check the bounds on a party's total balance of all holdings of the given instrument. +checkBalanceBounds : Party -> HoldingV1.InstrumentId -> (Decimal, Decimal) -> Script () +checkBalanceBounds p instrumentId (lb, ub) = do + holdings <- listHoldings p instrumentId + let total = sum $ map (._2.amount) holdings + unless (total >= lb && total <= ub) $ fail $ + "Wallet " <> show p <> ": balance of " <> show total <> " for " <> show instrumentId <> + " is not within the expected range [" <> show lb <> ", " <> show ub <> "]" + +-- | Check the exact value of on an individual holding's amount. +checkHolding : Party -> ContractId HoldingV1.Holding -> Decimal -> Script () +checkHolding p holdingCid amount = checkHoldingBounds p holdingCid (amount, amount) + +-- | Check the bounds on an individual holding's amount. +checkHoldingBounds : Party -> ContractId HoldingV1.Holding -> (Decimal, Decimal) -> Script () +checkHoldingBounds p holdingCid (lb, ub) = do + holdingO <- queryInterfaceContractId p holdingCid + debug holdingO + let holding = case holdingO of + None -> error $ "Holding " <> show holdingCid <> " was not found" + Some holding -> holding + unless (holding.amount >= lb && holding.amount <= ub) $ fail $ + "Holding " <> show holding <> + " is not within the expected range [" <> show lb <> ", " <> show ub <> "]" + +-- | Check the approximate value (+/- 1.0) a party's total balance of all holdings of the given instrument. +checkBalanceApprox : Party -> HoldingV1.InstrumentId -> Decimal -> Script () +checkBalanceApprox p instrumentId approximateBalance = + checkBalanceBounds p instrumentId (approximateBalance - 1.0, approximateBalance + 1.0) + +-- | Check the approximate (+/- 1.0) amount of an individual holding. +checkHoldingApprox : Party -> ContractId HoldingV1.Holding -> Decimal -> Script () +checkHoldingApprox p holdingCid approximateAmount = checkHoldingBounds p holdingCid (approximateAmount - 1.0, approximateAmount + 1.0) + +-- | Check the exact value a party's total balance of all holdings of the given instrument. +checkBalance : Party -> HoldingV1.InstrumentId -> Decimal -> Script () +checkBalance p instrumentId balance = + checkBalanceBounds p instrumentId (balance, balance) + +-- | List pending transfer offers (as sender or receiver) +listTransferOffers : Party -> HoldingV1.InstrumentId -> Script [(ContractId TransferInstructionV1.TransferInstruction, TransferInstructionV1.TransferInstructionView)] +listTransferOffers p instrumentId = do + instrs <- queryInterface @TransferInstructionV1.TransferInstruction p + let pendingOffers = do + (cid, Some instr) <- instrs + guard (instr.transfer.instrumentId == instrumentId) + guard (instr.status == TransferInstructionV1.TransferPendingReceiverAcceptance) + guard (p == instr.transfer.sender || p == instr.transfer.receiver) + pure (cid, instr) + pure pendingOffers + +-- | List all allocations requested from the owner for a specific instrument. +-- Currently targeting V1. +-- TODO: Make this sensible. +listRequestedAllocations : Party -> HoldingV1.InstrumentId -> Script [AllocationV1.AllocationSpecification] +listRequestedAllocations p instrumentId = do + reqs <- queryInterface @AllocationRequestV1.AllocationRequest p + trace reqs $ pure () + let amuletAllocs = do + (_reqCid, Some req) <- reqs + (tfId, tf) <- TextMap.toList req.transferLegs + guard (tf.instrumentId == instrumentId) + guard (p == tf.sender) + pure AllocationV1.AllocationSpecification with + settlement = req.settlement + transferLegId = tfId + transferLeg = tf + pure amuletAllocs diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Utils.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Utils.daml new file mode 100644 index 0000000000..adb809d21c --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Utils.daml @@ -0,0 +1,92 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Testing utilities to simplify testing token standard usage and implementation. +module Splice.Testing.Utils + ( + -- * Utilities for disclosures + Disclosures'(..), + queryDisclosure', + submitWithDisclosures', + submitWithDisclosuresMustFail', + + -- * Working with OpenAPI requests and responses + emptyExtraArgs, + EnrichedFactoryChoice(..), + + OpenApiChoiceContext(..), + withExtraDisclosures, + + -- * Simpler party allocation + allocatePartyExact + ) where + +import qualified DA.Map as Map +import qualified DA.TextMap as TextMap + +import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 + +import Daml.Script + +-- | Use this to construct an empty 'ExtraArgs' record. +emptyExtraArgs : ExtraArgs +emptyExtraArgs = ExtraArgs with + context = ChoiceContext with values = TextMap.empty + meta = emptyMetadata + +-- | A representation of a ChoiceContext and disclosed contracts as they would be returned by the +-- an OpenAPI endpoint of the token standard. +data OpenApiChoiceContext = OpenApiChoiceContext with + choiceContext : ChoiceContext + disclosures : Disclosures' + +-- | Add extra disclosures to an 'OpenApiChoiceContext'. +withExtraDisclosures : Disclosures' -> OpenApiChoiceContext -> OpenApiChoiceContext +withExtraDisclosures discs ctx = + ctx with disclosures = ctx.disclosures <> discs + +instance Semigroup OpenApiChoiceContext where + ctx1 <> ctx2 = + OpenApiChoiceContext with + choiceContext = ChoiceContext with + values = ctx1.choiceContext.values <> ctx2.choiceContext.values + disclosures = ctx1.disclosures <> ctx2.disclosures + +-- | A choice on a factory contract enriched with an appropriate choice-context and disclosures. +data EnrichedFactoryChoice t ch = EnrichedFactoryChoice with + factoryCid : ContractId t + arg : ch + disclosures : Disclosures' + + +-- | A set of disclosures. Used to work around the fact that duplicate disclosures for the +-- same contract are not allowed. +data Disclosures' = Disclosures' with + disclosures : Map.Map Api.Token.MetadataV1.AnyContractId Disclosure + +instance Monoid Disclosures' where + mempty = Disclosures' with disclosures = Map.empty + +instance Semigroup Disclosures' where + (Disclosures' ds1) <> (Disclosures' ds2) = + Disclosures' with disclosures = Map.union ds1 ds2 + +-- | Retrieve a disclosed contract by its contract-id from a specific party's ACS. +queryDisclosure' : forall t. Template t => Party -> ContractId t -> Script Disclosures' +queryDisclosure' p cid = do + optDisc <- queryDisclosure @t p cid + case optDisc of + None -> fail $ "Disclosure not found for: " <> show cid + Some d -> pure Disclosures' with disclosures = Map.fromList [(coerceContractId cid, d)] + +-- | Version of 'submitWithDisclosures' that works with the simplified `Disclosures'` type. +submitWithDisclosures' : Party -> Disclosures' -> Commands a -> Script a +submitWithDisclosures' p (Disclosures' ds) cmds = submitWithDisclosures p (Map.values ds) cmds + +-- | Version of 'submitWithDisclosuresMustFail' that works with the simplified `Disclosures'` type. +submitWithDisclosuresMustFail' : Party -> Disclosures' -> Commands a -> Script () +submitWithDisclosuresMustFail' p (Disclosures' ds) cmds = submitWithDisclosuresMustFail p (Map.values ds) cmds + +-- | Allocate party with a specific name. +allocatePartyExact : Text -> Script Party +allocatePartyExact name = allocatePartyByHint (PartyIdHint name) diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml new file mode 100644 index 0000000000..281f6337de --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml @@ -0,0 +1,327 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Daml script tests showing that the token standard can be used to execute +-- DvP settlements of Amulet tokens; and how to do so. +-- +-- See this test and the 'Splice.Testing.TradingApp' module for an example of +-- how to integrate with the allocation APIs of the token standard to execute +-- DvP settlements. +-- +-- Note also that the delivery part of a DvP settelement can be both another +-- token implementing the standard, as well as the creation of on-ledger state +-- specific to your registry; e.g., a license contract. +module Splice.Tests.TestAmuletTokenDvP where + +import Daml.Script + +import DA.Action (unless) +import DA.Assert +import DA.Foldable (forA_, foldMap) +import DA.Optional (isSome) +import DA.TextMap as TextMap hiding (filter) +import DA.Time +import DA.Traversable qualified as Traversable + +import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 +import Splice.Api.Token.HoldingV1 +import Splice.Api.Token.AllocationV1 as Api.Token.AllocationV1 +import Splice.Api.Token.AllocationRequestV1 +import Splice.Api.Token.AllocationInstructionV1 + +import Splice.Amulet +import Splice.Amulet.TokenApiUtils (burnedMetaKey) + +import Splice.Testing.Apps.TradingApp hiding (require) +import Splice.Testing.Utils +import Splice.Testing.Registries.AmuletRegistry qualified as AmuletRegistry +import Splice.Testing.TokenStandard.RegistryApi qualified as RegistryApi +import Splice.Testing.TokenStandard.WalletClient qualified as WalletClient + +data AllocatedOTCTrade = AllocatedOTCTrade + with + alice : Party + bob : Party + provider : Party + providerBeneficiary1 : Party + providerBeneficiary2 : Party + providerBeneficiaries : [(Party, Decimal)] + registry : AmuletRegistry.AmuletRegistry + otcTradeCid : ContractId OTCTrade + otcTrade : OTCTrade + amuletId : InstrumentId + deriving (Show, Eq) + +setupOtcTrade : Script AllocatedOTCTrade +setupOtcTrade = do + registry <- AmuletRegistry.initialize AmuletRegistry.defaultAmuletRegistryConfig + let amuletId = registry.instrumentId + + alice <- allocatePartyExact "alice" + bob <- allocatePartyExact "bob" + + -- featured app provider + provider <- allocatePartyExact "trading-app-provider-party" + providerBeneficiary1 <- allocatePartyExact "trading-app-investor1" + providerBeneficiary2 <- allocatePartyExact "trading-app-investor2" + let providerBeneficiaries = + [ (provider, 0.8) + , (providerBeneficiary1, 0.1) + , (providerBeneficiary2, 0.1) + ] + AmuletRegistry.featureApp registry provider + + -- get some funds for alice and bob + AmuletRegistry.tapLockedAndUnlockedFunds registry alice 1000.0 + AmuletRegistry.tapLockedAndUnlockedFunds registry bob 1000.0 + + let mkTransfer sender receiver amount = Api.Token.AllocationV1.TransferLeg with + sender + receiver + amount + instrumentId = amuletId + meta = emptyMetadata + -- Note: here we use Amulet as the single asset, as that is all we have available in this repository. + -- Given that we are using only the DvP interface, that should though be a fine stand-in for + -- a DvP across two assets from different registries. + let aliceLeg = mkTransfer alice bob 100.0 + let bobLeg = mkTransfer bob alice 20.0 + + -- alice proposes trade with bob + proposalCid <- submit alice $ createCmd OTCTradeProposal with + venue = provider + tradeCid = None + transferLegs = TextMap.fromList [("leg0", aliceLeg), ("leg1", bobLeg)] + approvers = [alice] + + -- bob accepts + proposalCid <- submit bob $ exerciseCmd proposalCid OTCTradeProposal_Accept with + approver = bob + + -- provider initiates settlement + now <- getTime + let settleBefore = now `addRelTime` hours 2 + otcTradeCid <- submit provider $ + exerciseCmd proposalCid OTCTradeProposal_InitiateSettlement with + prepareUntil = now `addRelTime` hours 1 + settleBefore + + Some otcTrade <- queryContractId provider otcTradeCid + + -- Alice sees the allocation request in her wallet + [aliceAlloc] <- WalletClient.listRequestedAllocations alice amuletId + aliceAlloc.transferLeg.amount === 100.0 + + -- alice accepts allocation request directly via her wallet + inputHoldingCids <- WalletClient.listHoldingCids alice amuletId + holdings <- WalletClient.listHoldings alice amuletId + debug holdings + + now <- getTime + + -- test that using the wrong admin party fails + enrichedChoice <- RegistryApi.getAllocationFactory registry AllocationFactory_Allocate with + expectedAdmin = alice + allocation = aliceAlloc + inputHoldingCids + requestedAt = now + extraArgs = emptyExtraArgs + submitWithDisclosuresMustFail' alice enrichedChoice.disclosures $ + exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg + + -- alice accepts allocation request directly via her wallet + -- TODO(DACH-NY/canton-network-node#18633): test here and for all steps that the expected ledger time bounds are present on the submissions + debug inputHoldingCids + enrichedChoice <- RegistryApi.getAllocationFactory registry AllocationFactory_Allocate with + expectedAdmin = registry.dso + allocation = aliceAlloc + inputHoldingCids + requestedAt = now + extraArgs = emptyExtraArgs + result <- submitWithDisclosures' alice enrichedChoice.disclosures $ + exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg + + -- check metadata + expectBurn result.meta + + -- check lock context + [(_, lockedHolding)] <- WalletClient.listLockedHoldings alice registry.instrumentId + let expectedLock = Some $ Lock with + expiresAt = Some settleBefore + expiresAfter = None + holders = [registry.dso] + context = Some "allocation for transfer leg \"leg0\" to 'bob'" + lockedHolding.lock === expectedLock + + -- Bob sees the allocation request in his wallet as well + [bobAlloc] <- WalletClient.listRequestedAllocations bob amuletId + bobAlloc.transferLeg.amount === 20.0 + + -- bob accepts allocation request directly via her wallet + inputHoldingCids <- WalletClient.listHoldingCids bob amuletId + enrichedChoice <- RegistryApi.getAllocationFactory registry AllocationFactory_Allocate with + expectedAdmin = registry.dso + allocation = bobAlloc + inputHoldingCids + requestedAt = now + extraArgs = emptyExtraArgs + submitWithDisclosures' bob enrichedChoice.disclosures $ + exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg + + factoryView <- submitWithDisclosures' alice enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid AllocationFactory_PublicFetch + with + expectedAdmin = registry.dso + actor = alice + factoryView === Splice.Api.Token.AllocationInstructionV1.AllocationFactoryView registry.dso emptyMetadata + pure AllocatedOTCTrade with + alice + bob + provider + providerBeneficiary1 + providerBeneficiary2 + registry + providerBeneficiaries + otcTradeCid + otcTrade + amuletId + + +-- | Test that a DvP settlement of an OTC trade works when using Amulet via the token standard. +testDvP : Script () +testDvP = script do + AllocatedOTCTrade{..} <- setupOtcTrade + + -- assume the time given to prepare has passed + passTime (hours 1) + + -- provider runs automation that completes the settlement + let otcTradeRef = (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef + allocations <- appBackendListAllocations provider otcTradeRef + TextMap.size allocations === 2 + + let beneficiaryMetadata = AmuletRegistry.beneficiariesToMetadata providerBeneficiaries + richAllocationsWithContext <- Traversable.forA allocations $ \(allocCid, _) -> do + context <- RegistryApi.getAllocation_TransferContext registry allocCid beneficiaryMetadata + let extraArgs = ExtraArgs with + context = context.choiceContext + meta = beneficiaryMetadata + pure (context.disclosures, (allocCid, extraArgs)) + let disclosures = foldMap fst richAllocationsWithContext + + results <- submitWithDisclosures' provider disclosures $ exerciseCmd otcTradeCid OTCTrade_Settle with + allocationsWithContext = fmap snd richAllocationsWithContext + + -- check metadata + forA_ results $ \result -> expectBurn result.meta + + -- check that the expected transfers happened + WalletClient.checkHoldingWithAmountExists alice amuletId 20.0 + WalletClient.checkHoldingWithAmountExists bob amuletId 100.0 + + WalletClient.checkBalanceApprox alice amuletId 919.0 -- around 1 $ of fees paid + WalletClient.checkBalanceApprox bob amuletId 1079.8 -- around 0.2 $ of fees paid + + -- check that the provider got their featured app reward coupons + coupons <- map snd <$> query @AppRewardCoupon provider + let couponWithAmount : Decimal -> AppRewardCoupon -> Bool + couponWithAmount amount coupon = + coupon.featured && coupon.beneficiary == Some provider && coupon.amount == amount + checkCouponExists amount = + unless (any (couponWithAmount amount) coupons) $ + fail $ "Expected coupon with amount " <> show amount <> " not found: " <> show coupons + + extraAppReward = 2.0 -- 1 $ (at 0.5 Amulet per $) + providerWeight = 0.8 + aliceAmount = providerWeight * (extraAppReward + 1.06) -- 1% fees plus the 0.06 Amulet create fee (at 0.5 Amulet per $) + bobAmount = providerWeight * (extraAppReward + 0.26) -- 0.5% fees (at 0.5 Amulet per $) + + checkNumCouponsFor b expectedNumCoupons = do + let numCoupons = length $ filter (\c -> c.beneficiary == Some b) coupons + unless (numCoupons == expectedNumCoupons ) $ + fail $ "Expected " <> show expectedNumCoupons <> " coupons for " <> show b <> ", but got " <> show numCoupons + + + checkCouponExists aliceAmount + checkCouponExists bobAmount + + checkNumCouponsFor providerBeneficiary1 2 + checkNumCouponsFor providerBeneficiary2 2 + + -- TODO (DACH-NY/canton-network-node#17541):early abortion of settlement, unwinding of expired settlements, etc. + pure () + +testDvPCancel = script do + AllocatedOTCTrade{..} <- setupOtcTrade + let otcTradeRef = (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef + allocations <- appBackendListAllocations provider otcTradeRef + + [(_, aliceLockedHolding)] <- WalletClient.listLockedHoldings alice registry.instrumentId + [(bobLockedHoldingCid, _)] <- WalletClient.listLockedHoldings bob registry.instrumentId + + passTime (days 1) + + -- expire the amulet for bob to test both cases where the amulet still exists for alice and where it doesn't for bob + AmuletRegistry.expireLockAsOwner registry bobLockedHoldingCid + + richAllocationsWithContext <- Traversable.forA allocations $ \(allocCid, _) -> do + context <- RegistryApi.getAllocation_CancelContext registry allocCid emptyMetadata + let extraArgs = ExtraArgs with + context = context.choiceContext + meta = emptyMetadata + pure (context.disclosures, (allocCid, extraArgs)) + let disclosures = foldMap fst richAllocationsWithContext + + _ <- submitWithDisclosures' provider disclosures $ exerciseCmd otcTradeCid OTCTrade_Cancel with + allocationsWithContext = fmap snd richAllocationsWithContext + + [] <- WalletClient.listLockedHoldings alice registry.instrumentId + WalletClient.checkHoldingWithAmountExists alice amuletId aliceLockedHolding.amount + + [] <- queryInterface @Allocation alice + [] <- queryInterface @Allocation bob + + pure () + +testDvPWithdraw = script do + AllocatedOTCTrade{..} <- setupOtcTrade + [(aliceAllocationCid, _)] <- queryInterface @Allocation alice + context <- RegistryApi.getAllocation_WithdrawContext registry aliceAllocationCid emptyMetadata + + [(_, aliceLockedHolding)] <- WalletClient.listLockedHoldings alice registry.instrumentId + + _ <- submitWithDisclosures' alice context.disclosures $ exerciseCmd aliceAllocationCid Allocation_Withdraw with + extraArgs = ExtraArgs with + context = context.choiceContext + meta = emptyMetadata + + [] <- WalletClient.listLockedHoldings alice registry.instrumentId + WalletClient.checkHoldingWithAmountExists alice amuletId aliceLockedHolding.amount + + [] <- queryInterface @Allocation alice + + passTime (days 1) + + [(bobLockedHoldingCid, _)] <- WalletClient.listLockedHoldings bob registry.instrumentId + AmuletRegistry.expireLockAsOwner registry bobLockedHoldingCid + + pure () + + +-- utilities +------------ + +-- | List all allocations matching a particular settlement reference, sorted by their tradeLeg id. +-- This function would be run on the trading app provider's backend as part of an automation loop. +appBackendListAllocations : Party -> Reference -> Script (TextMap (ContractId Allocation, AllocationView)) +appBackendListAllocations p ref = do + allocs <- queryInterface @Allocation p + let matchingAllocs = do + (cid, Some fundedAllocation) <- allocs + guard (fundedAllocation.allocation.settlement.settlementRef == ref) + pure (fundedAllocation.allocation.transferLegId, (cid, fundedAllocation)) + pure $ TextMap.fromList matchingAllocs + +expectBurn : Metadata -> Script () +expectBurn meta = + unless (isSome $ TextMap.lookup burnedMetaKey meta.values) $ + fail $ "Expected burned meta key to be present in " <> show meta diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml new file mode 100644 index 0000000000..1960891749 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml @@ -0,0 +1,498 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Daml script tests showing that the token standard can be used to execute +-- free-of-payment transfers of Amulet tokens; and how to do so. +module Splice.Tests.TestAmuletTokenTransfer where + +import Splice.Api.Token.MetadataV1 +import Splice.Api.Token.HoldingV1 +import Splice.Api.Token.TransferInstructionV1 as Api.Token.TransferInstructionV1 + +import Daml.Script + +import DA.Action (unless) +import DA.Assert ((===)) +import DA.Foldable (forA_) +import DA.List (sortOn) +import qualified DA.Map as Map +import qualified DA.TextMap as TextMap +import DA.Optional (isSome) +import DA.Time + +import Splice.Amulet (AppRewardCoupon(..)) +import Splice.Amulet.TokenApiUtils (createdInRoundMetaKey, ratePerRoundMetaKey, burnedMetaKey) + +import Splice.Testing.Utils +import Splice.Testing.Registries.AmuletRegistry qualified as AmuletRegistry +import Splice.Testing.TokenStandard.RegistryApi qualified as RegistryApi +import Splice.Testing.TokenStandard.WalletClient qualified as WalletClient + + +-- Shared test setup +-------------------- + +data TestSetup = TestSetup with + registry : AmuletRegistry.AmuletRegistry + alice : Party + aliceValidator : Party + bob : Party + now : Time + defaultTransfer : Api.Token.TransferInstructionV1.Transfer + +setupTest : Script TestSetup +setupTest = do + registry <- AmuletRegistry.initialize AmuletRegistry.defaultAmuletRegistryConfig + alice <- allocatePartyExact "alice" + aliceValidator <- allocatePartyExact "alice-validator" + bob <- allocatePartyExact "bob" + + -- Alice creates a transfer pre-approval. This contract can be used to execute an instant transfer + -- from Bob to Alice (it needs to be disclosed as part of transfer initiation). + now <- getTime + let expiresAt = (now `addRelTime` days 30) + AmuletRegistry.createTransferPreapproval registry alice aliceValidator expiresAt + + -- feature the alice's validator party, to check that they get featured registry rewards + AmuletRegistry.featureApp registry aliceValidator + + -- also feature alice and bob so that we can easily check that their self-transfers + -- do not result in featured app rewards + AmuletRegistry.featureApp registry alice + AmuletRegistry.featureApp registry bob + + -- Bob taps coin to send to Alice. + AmuletRegistry.tapLockedAndUnlockedFunds registry bob 50.0 + + bobHoldings <- WalletClient.listHoldings bob registry.instrumentId + let bobHoldingCids = map fst bobHoldings + let actualBobHoldingViews = sortOn (.lock) $ map snd bobHoldings + let expectedBobHoldingViews = sortOn (.lock) $ + [ HoldingView with + owner = bob + instrumentId = InstrumentId with id = "Amulet", admin = registry.dso + amount = 25.0 + lock = None + meta = Metadata with + + values = TextMap.fromList + [ (createdInRoundMetaKey, "1") + , (ratePerRoundMetaKey, "0.00004") + ] + , HoldingView with + owner = bob + instrumentId = InstrumentId with id = "Amulet", admin = registry.dso + amount = 25.0 + lock = Some $ Lock with + expiresAt = Some now + expiresAfter = None + holders = [registry.dso] + context = Some "test expired lock" + meta = Metadata with + values = TextMap.fromList + [ (createdInRoundMetaKey, "1") + , (ratePerRoundMetaKey, "0.00004") + ] + ] + expectedBobHoldingViews === actualBobHoldingViews + + + -- Check initial balance setup + WalletClient.checkBalance alice registry.instrumentId 0.0 + WalletClient.checkBalance bob registry.instrumentId 50.0 + + -- Define default transfer from Bob to Alice + let + defaultTransfer = Api.Token.TransferInstructionV1.Transfer with + sender = bob + receiver = alice + amount = 10.0 + instrumentId = registry.instrumentId + requestedAt = now + executeBefore = now `addRelTime` days 1 + inputHoldingCids = bobHoldingCids + meta = Metadata with + values = TextMap.fromList [("token-metadata-v1.splice.lfdecentralizedtrust.org/correlation-id", "")] + + return TestSetup with .. + + +setupTwoStepTransfer : Script (TestSetup, ContractId TransferInstruction) +setupTwoStepTransfer = do + testSetup@TestSetup {..} <- setupTest + + -- fund alice + AmuletRegistry.tapLockedAndUnlockedFunds registry alice 1000.0 + aliceHoldingCids <- WalletClient.listHoldings alice registry.instrumentId + + WalletClient.checkBalance alice registry.instrumentId 1000.0 + WalletClient.checkBalanceApprox bob registry.instrumentId 50.0 + + -- check that the default transfer can be executed + let transfer = defaultTransfer with + sender = alice + receiver = bob -- turn this around so that the transfer is a two-step one + inputHoldingCids = map fst aliceHoldingCids + + enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with + expectedAdmin = registry.dso + transfer + extraArgs = emptyExtraArgs + + TextMap.size enrichedChoice.arg.extraArgs.context.values === 2 + Map.size enrichedChoice.disclosures.disclosures === 3 + + -- Trigger a two-step transfer + -- TODO(DACH-NY/canton-network-node#18633): test here and for all steps that the expected ledger time bounds are present on the submissions + result <- submitWithDisclosures' alice enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg + TransferInstructionResult_Pending aliceInstrCid <- pure result.output + + -- check that the change is returned as expected + [senderChangeCid] <- pure result.senderChangeCids + Some senderChange <- queryInterfaceContractId @Holding alice senderChangeCid + senderChange.lock === None + WalletClient.checkHoldingApprox alice senderChangeCid (1000.0 - transfer.amount) + expectBurn result.meta + pure (testSetup, aliceInstrCid) + +assertNoFeaturedRewards : [Party] -> Script () +assertNoFeaturedRewards parties = + forA_ parties $ \party -> do + rewards <- query @AppRewardCoupon party + filter (._2.featured) rewards === [] + +expectBurn : Metadata -> Script () +expectBurn meta = + unless (isSome $ TextMap.lookup burnedMetaKey meta.values) $ + fail $ "Expected burned meta key to be present in " <> show meta + + +-- Testing self and direct transfers +------------------------------------ + +test_happy_path_self : Script () +test_happy_path_self = script do + TestSetup {..} <- setupTest + + -- check that the default transfer can be executed + let transfer = defaultTransfer with + sender = bob + receiver = bob + + enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with + expectedAdmin = registry.dso + transfer + extraArgs = emptyExtraArgs + + TextMap.size enrichedChoice.arg.extraArgs.context.values === 2 + Map.size enrichedChoice.disclosures.disclosures === 3 + + WalletClient.checkBalanceApprox bob registry.instrumentId 50.0 + + -- Trigger a self-transfer + result <- submitWithDisclosures' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg + + -- check holdings and rewards + TransferInstructionResult_Completed [splitHoldingCid] <- pure result.output + WalletClient.checkHolding bob splitHoldingCid 10.0 + [changeHoldingCid] <- pure result.senderChangeCids + WalletClient.checkHoldingApprox bob changeHoldingCid 40.0 + expectBurn result.meta + + assertNoFeaturedRewards [alice, bob] + pure () + +test_happy_path_direct : Script () +test_happy_path_direct = script do + TestSetup {..} <- setupTest + + -- check that the default transfer can be executed + let transfer = defaultTransfer + + enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with + expectedAdmin = registry.dso + transfer + extraArgs = emptyExtraArgs + + TextMap.size enrichedChoice.arg.extraArgs.context.values === 4 + Map.size enrichedChoice.disclosures.disclosures === 5 + + WalletClient.checkBalanceApprox bob registry.instrumentId 50.0 + + -- Trigger an atomic, single-transaction transfer + result <- submitWithDisclosures' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg + TransferInstructionResult_Completed receiverHoldingCids <- pure result.output + case result.senderChangeCids of + [holdingCid] -> WalletClient.checkHoldingApprox bob holdingCid 40.0 + cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids) + case receiverHoldingCids of + [holdingCid] -> WalletClient.checkHoldingApprox alice holdingCid 10.0 + cids -> abort ("Unexpected number of receiverHoldingCids: " <> show cids) + expectBurn result.meta + + -- check balance + WalletClient.checkBalance alice registry.instrumentId 10.0 + WalletClient.checkBalanceApprox bob registry.instrumentId 40.0 + + -- there is a featured registry reward for aliceValidator that created Alice's transfer preapproval + [(_, aliceValidatorCoupon)] <- query @AppRewardCoupon aliceValidator + aliceValidatorCoupon.featured === True + aliceValidatorCoupon.amount === 2.16 + + assertNoFeaturedRewards [alice, bob] + pure () + + +-- Testing two-step transfers +----------------------------- + +test_two_step_success : Script () +test_two_step_success = do + (TestSetup {..}, aliceInstrCid) <- setupTwoStepTransfer + + -- check lock context + [(_, lockedHolding)] <- WalletClient.listLockedHoldings alice registry.instrumentId + let expectedLock = Some $ Lock with + expiresAt = Some (defaultTransfer.executeBefore) + expiresAfter = None + holders = [registry.dso] + context = Some "transfer to 'bob'" + lockedHolding.lock === expectedLock + + -- bob queries the pending transfer through their wallet + aliceHoldings <- WalletClient.listHoldings alice registry.instrumentId + [(bobInstrCid, bobInstrView)] <- WalletClient.listTransferOffers bob registry.instrumentId + bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ] + bobInstrCid === aliceInstrCid + + -- bob accepts the transfer + context <- RegistryApi.getTransferInstruction_AcceptContext registry bobInstrCid emptyMetadata + result <- submitWithDisclosures' bob context.disclosures $ exerciseCmd bobInstrCid TransferInstruction_Accept with + extraArgs = ExtraArgs with + context = context.choiceContext + meta = emptyMetadata + + TransferInstructionResult_Completed receiverHoldingCids <- pure result.output + case result.senderChangeCids of + [holdingCid] -> WalletClient.checkHoldingApprox alice holdingCid 1.0 + cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids) + case receiverHoldingCids of + [holdingCid] -> WalletClient.checkHoldingApprox bob holdingCid 10.0 + cids -> abort ("Unexpected number of receiverHoldingCids: " <> show cids) + expectBurn result.meta + + -- check balance + WalletClient.checkBalanceApprox alice registry.instrumentId 990.0 + WalletClient.checkBalance bob registry.instrumentId 60.0 + + assertNoFeaturedRewards [alice, bob] + +test_two_step_withdraw : Script () +test_two_step_withdraw = do + (TestSetup {..}, aliceInstrCid0) <- setupTwoStepTransfer + + -- alice queries the pending transfer through their wallet + [ lockedHolding ] <- WalletClient.listLockedHoldings alice registry.instrumentId + [(aliceInstrCid, aliceInstrView)] <- WalletClient.listTransferOffers alice registry.instrumentId + aliceInstrView.transfer.inputHoldingCids === [ lockedHolding._1 ] + aliceInstrCid0 === aliceInstrCid + + -- alice rejects the transfer + context <- RegistryApi.getTransferInstruction_WithdrawContext registry aliceInstrCid emptyMetadata + result <- submitWithDisclosures' alice context.disclosures $ exerciseCmd aliceInstrCid TransferInstruction_Withdraw with + extraArgs = ExtraArgs with + context = context.choiceContext + meta = emptyMetadata + + + case result.senderChangeCids of + [holdingCid] -> WalletClient.checkHoldingApprox alice holdingCid 10.0 + cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids) + TransferInstructionResult_Failed === result.output + + -- check balance + WalletClient.checkBalanceApprox alice registry.instrumentId 1000.0 + WalletClient.checkBalance bob registry.instrumentId 50.0 + + assertNoFeaturedRewards [alice, bob] + +test_two_step_withdraw_locked_amulet_gone : Script () +test_two_step_withdraw_locked_amulet_gone = do + (TestSetup {..}, aliceInstrCid0) <- setupTwoStepTransfer + + -- alice queries the pending transfer through their wallet + [ lockedHolding ] <- WalletClient.listLockedHoldings alice registry.instrumentId + [(aliceInstrCid, aliceInstrView)] <- WalletClient.listTransferOffers alice registry.instrumentId + aliceInstrView.transfer.inputHoldingCids === [ lockedHolding._1 ] + aliceInstrCid0 === aliceInstrCid + + -- pass time and unlock the amulet as the alice + let [lockedCid] = aliceInstrView.transfer.inputHoldingCids + setTime (aliceInstrView.transfer.executeBefore `addRelTime` days 1) + AmuletRegistry.expireLockAsOwner registry lockedCid + + -- locked holdings are gone + lockedHoldings <- WalletClient.listLockedHoldings alice registry.instrumentId + lockedHoldings === [] + + -- withdraw fails if the time is too early + context <- RegistryApi.getTransferInstruction_WithdrawContext registry aliceInstrCid emptyMetadata + setTime (aliceInstrView.transfer.executeBefore `addRelTime` negate (days 1)) + submitWithDisclosuresMustFail' alice context.disclosures $ exerciseCmd aliceInstrCid TransferInstruction_Withdraw with + extraArgs = ExtraArgs with + context = context.choiceContext + meta = emptyMetadata + + -- move time back to the future (TM) so withdrawal can complete + setTime (aliceInstrView.transfer.executeBefore `addRelTime` days 1) + + -- alice withdraws the transfer + context <- RegistryApi.getTransferInstruction_WithdrawContext registry aliceInstrCid emptyMetadata + result <- submitWithDisclosures' alice context.disclosures $ exerciseCmd aliceInstrCid TransferInstruction_Withdraw with + extraArgs = ExtraArgs with + context = context.choiceContext + meta = emptyMetadata + + result.senderChangeCids === [] + result.output === TransferInstructionResult_Failed + + -- check balance + WalletClient.checkBalanceApprox alice registry.instrumentId 1000.0 + WalletClient.checkBalance bob registry.instrumentId 50.0 + + assertNoFeaturedRewards [alice, bob] + + + +test_two_step_reject : Script () +test_two_step_reject = do + (TestSetup {..}, aliceInstrCid) <- setupTwoStepTransfer + + -- bob queries the pending transfer through their wallet + aliceHoldings <- WalletClient.listHoldings alice registry.instrumentId + [(bobInstrCid, bobInstrView)] <- WalletClient.listTransferOffers bob registry.instrumentId + bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ] + bobInstrCid === aliceInstrCid + + -- bob rejects the transfer + context <- RegistryApi.getTransferInstruction_RejectContext registry bobInstrCid emptyMetadata + result <- submitWithDisclosures' bob context.disclosures $ exerciseCmd bobInstrCid TransferInstruction_Reject with + extraArgs = ExtraArgs with + context = context.choiceContext + meta = emptyMetadata + + case result.senderChangeCids of + [holdingCid] -> WalletClient.checkHoldingApprox alice holdingCid 10.0 + cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids) + result.output === TransferInstructionResult_Failed + + -- check balance + WalletClient.checkBalanceApprox alice registry.instrumentId 1000.0 + WalletClient.checkBalance bob registry.instrumentId 50.0 + + assertNoFeaturedRewards [alice, bob] + +test_two_step_reject_locked_amulet_gone : Script () +test_two_step_reject_locked_amulet_gone = do + (TestSetup {..}, aliceInstrCid) <- setupTwoStepTransfer + + -- bob queries the pending transfer through their wallet + aliceHoldings <- WalletClient.listHoldings alice registry.instrumentId + [(bobInstrCid, bobInstrView)] <- WalletClient.listTransferOffers bob registry.instrumentId + bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ] + bobInstrCid === aliceInstrCid + + -- pass time and unlock the amulet as the owner + let [lockedCid] = bobInstrView.transfer.inputHoldingCids + setTime (bobInstrView.transfer.executeBefore `addRelTime` days 1) + AmuletRegistry.expireLockAsOwner registry lockedCid + + -- bob rejects the transfer + context <- RegistryApi.getTransferInstruction_RejectContext registry bobInstrCid emptyMetadata + result <- submitWithDisclosures' bob context.disclosures $ exerciseCmd bobInstrCid TransferInstruction_Reject with + extraArgs = ExtraArgs with + context = context.choiceContext + meta = emptyMetadata + + result.senderChangeCids === [] + result.output === TransferInstructionResult_Failed + + -- check balance + WalletClient.checkBalanceApprox alice registry.instrumentId 1000.0 + WalletClient.checkBalance bob registry.instrumentId 50.0 + + assertNoFeaturedRewards [alice, bob] + + +-- Testing the shared validation logic for initiating transfers +--------------------------------------------------------------- + +test_no_holdings : Script () +test_no_holdings = script do + TestSetup {..} <- setupTest + + -- check that the default transfer can be executed + let transfer = defaultTransfer with + inputHoldingCids = [] + + enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with + expectedAdmin = registry.dso + transfer + extraArgs = emptyExtraArgs + + -- Show that the actual transfer choice fails + submitWithDisclosuresMustFail' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg + + assertNoFeaturedRewards [alice, bob] + pure () + +test_expired : Script () +test_expired = script do + TestSetup {..} <- setupTest + + let transfer = defaultTransfer + setTime (transfer.executeBefore `addRelTime` days 1) + + enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with + expectedAdmin = registry.dso + transfer + extraArgs = emptyExtraArgs + + -- Show that the actual transfer choice fails + submitWithDisclosuresMustFail' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg + + assertNoFeaturedRewards [alice, bob] + pure () + + +test_wrong_admin : Script () +test_wrong_admin = script do + TestSetup {..} <- setupTest + + let transfer = defaultTransfer + setTime (transfer.executeBefore `addRelTime` days 1) + + enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with + expectedAdmin = alice -- set the wrong admin + transfer + extraArgs = emptyExtraArgs + + -- Show that the actual transfer choice fails + submitWithDisclosuresMustFail' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg + + assertNoFeaturedRewards [alice, bob] + pure () + +test_factory_PublicFetch : Script () +test_factory_PublicFetch = do + TestSetup {..} <- setupTest + -- we check that the public fetch choice works using a transfer factory's choice context + enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with + expectedAdmin = registry.dso + transfer = defaultTransfer + extraArgs = emptyExtraArgs + view <- submitWithDisclosures' alice enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid TransferFactory_PublicFetch + with + expectedAdmin = registry.dso + actor = alice + view === Api.Token.TransferInstructionV1.TransferFactoryView registry.dso emptyMetadata diff --git a/token-standard/splice-token-standard-test/.vscode/settings.json b/token-standard/splice-token-standard-test/.vscode/settings.json new file mode 100644 index 0000000000..82d9059628 --- /dev/null +++ b/token-standard/splice-token-standard-test/.vscode/settings.json @@ -0,0 +1,5 @@ +{ + "files.readonlyInclude": { + "**/.daml/unpacked-dars/**": true + } +} \ No newline at end of file From d4cf8e54d1f2b2375578288154752528cf3d2904 Mon Sep 17 00:00:00 2001 From: bame-da Date: Tue, 30 Sep 2025 13:37:06 +0000 Subject: [PATCH 02/11] Implement partial v2 in amulet and make it compile --- build.sbt | 4 +- daml/splice-amulet/daml.yaml | 3 + daml/splice-amulet/daml/Splice/Amulet.daml | 20 +++++-- .../daml/Splice/Amulet/TokenApiUtils.daml | 6 +- .../daml/Splice/Amulet/TwoStepTransfer.daml | 2 +- .../daml/Splice/AmuletAllocation.daml | 51 ++++++++++++++--- .../daml/Splice/AmuletRules.daml | 4 +- .../Splice/AmuletTransferInstruction.daml | 9 ++- .../daml/Splice/ExternalPartyAmuletRules.daml | 28 ++++----- daml/splice-amulet/daml/Splice/Types.daml | 12 ++-- daml/splice-wallet-test/daml.yaml | 5 +- .../daml/Splice/Scripts/TestWallet.daml | 17 +++--- daml/splice-wallet/daml.yaml | 5 +- .../daml/Splice/Wallet/Install.daml | 16 +++--- .../daml/Splice/Api/Token/AllocationV2.daml | 4 +- .../daml/Splice/Api/Token/UtilsV2.daml | 57 ++++++++++++++++++- .../daml/Splice/Testing/Apps/TradingApp.daml | 27 +++++---- .../Testing/Registries/AmuletRegistry.daml | 5 +- .../Testing/TokenStandard/RegistryApi.daml | 2 +- .../Testing/TokenStandard/WalletClient.daml | 31 +++++----- .../daml/Splice/Tests/TestAmuletTokenDvP.daml | 19 ++++--- .../Splice/Tests/TestAmuletTokenTransfer.daml | 41 ++++++------- .../Testing/Registries/AmuletRegistry.daml | 10 +++- 23 files changed, 253 insertions(+), 125 deletions(-) diff --git a/build.sbt b/build.sbt index 678440d7ef..97ece575c5 100644 --- a/build.sbt +++ b/build.sbt @@ -240,7 +240,7 @@ lazy val docs = project (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-burn-mint-v1-daml` / Compile / damlBuild).value + (`splice-api-token-burn-mint-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-utils-v2-daml` / Compile / damlBuild).value cacheDamlDocs( damlSources.toSet @@ -487,7 +487,6 @@ lazy val `splice-api-token-utils-v2-daml` = (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value, (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value ++ - (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ @@ -755,6 +754,7 @@ lazy val `splice-amulet-daml` = (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-utils-v2-daml` / Compile / damlBuild).value ++ (`splice-featured-app-api-v1-daml` / Compile / damlBuild).value, ) .dependsOn(`canton-bindings-java`) diff --git a/daml/splice-amulet/daml.yaml b/daml/splice-amulet/daml.yaml index e646b82cf9..49a0a19e7e 100644 --- a/daml/splice-amulet/daml.yaml +++ b/daml/splice-amulet/daml.yaml @@ -13,11 +13,14 @@ dependencies: data-dependencies: - ../../token-standard/splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar - ../../token-standard/splice-api-token-holding-v1/.daml/dist/splice-api-token-holding-v1-current.dar + - ../../token-standard/splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar - ../../token-standard/splice-api-token-transfer-instruction-v1/.daml/dist/splice-api-token-transfer-instruction-v1-current.dar - ../../token-standard/splice-api-token-allocation-v1/.daml/dist/splice-api-token-allocation-v1-current.dar + - ../../token-standard/splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar - ../../token-standard/splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar - ../splice-util/.daml/dist/splice-util-current.dar - ../splice-api-featured-app-v1/.daml/dist/splice-api-featured-app-v1-current.dar + - ../../token-standard/splice-api-token-utils-v2/.daml/dist/splice-api-token-utils-v2-current.dar build-options: - --ghc-option=-Wunused-binds - --ghc-option=-Wunused-matches diff --git a/daml/splice-amulet/daml/Splice/Amulet.daml b/daml/splice-amulet/daml/Splice/Amulet.daml index d3366d4190..bf5aa065e9 100644 --- a/daml/splice-amulet/daml/Splice/Amulet.daml +++ b/daml/splice-amulet/daml/Splice/Amulet.daml @@ -13,6 +13,8 @@ import DA.Optional (fromOptional) import Splice.Api.Token.MetadataV1 qualified as Api.Token.MetadataV1 import Splice.Api.Token.HoldingV1 qualified as Api.Token.HoldingV1 +import Splice.Api.Token.HoldingV2 qualified as Api.Token.HoldingV2 +import Splice.Api.Token.UtilsV2 import Splice.Amulet.TokenApiUtils import Splice.Expiry @@ -111,14 +113,17 @@ template Amulet meta = Some (simpleHoldingTxMeta TxKind_ExpireDust None (Some amount.initialAmount)) .. - interface instance Api.Token.HoldingV1.Holding for Amulet where - view = Api.Token.HoldingV1.HoldingView with + interface instance Api.Token.HoldingV2.Holding for Amulet where + view = Api.Token.HoldingV2.HoldingView with owner instrumentId = amuletInstrumentId dso amount = amount.initialAmount lock = None meta = amuletMetadata this + interface instance Api.Token.HoldingV1.Holding for Amulet where + view = holding_v2_to_v1 (view (toInterface @Api.Token.HoldingV2.Holding this)) + amuletMetadata : Amulet -> Api.Token.MetadataV1.Metadata amuletMetadata Amulet{..} = Api.Token.MetadataV1.Metadata with @@ -133,19 +138,22 @@ template LockedAmulet lock : TimeLock where signatory lock.holders, signatory amulet - - interface instance Api.Token.HoldingV1.Holding for LockedAmulet where - view = Api.Token.HoldingV1.HoldingView with + + interface instance Api.Token.HoldingV2.Holding for LockedAmulet where + view = Api.Token.HoldingV2.HoldingView with owner = amulet.owner instrumentId = amuletInstrumentId amulet.dso amount = amulet.amount.initialAmount - lock = Some Api.Token.HoldingV1.Lock with + lock = Some Api.Token.HoldingV2.Lock with holders = lock.holders expiresAt = Some lock.expiresAt expiresAfter = None context = lock.optContext meta = amuletMetadata amulet + interface instance Api.Token.HoldingV1.Holding for LockedAmulet where + view = holding_v2_to_v1 (view (toInterface @Api.Token.HoldingV2.Holding this)) + choice LockedAmulet_Unlock : LockedAmulet_UnlockResult with openRoundCid : ContractId OpenMiningRound diff --git a/daml/splice-amulet/daml/Splice/Amulet/TokenApiUtils.daml b/daml/splice-amulet/daml/Splice/Amulet/TokenApiUtils.daml index 1b8f738c20..76515b86a1 100644 --- a/daml/splice-amulet/daml/Splice/Amulet/TokenApiUtils.daml +++ b/daml/splice-amulet/daml/Splice/Amulet/TokenApiUtils.daml @@ -14,7 +14,7 @@ import DA.Text qualified as T import Splice.Api.Token.MetadataV1 import Splice.Api.FeaturedAppRightV1 -import Splice.Api.Token.HoldingV1 qualified as Api.Token.HoldingV1 +import Splice.Api.Token.HoldingV2 qualified as Api.Token.HoldingV2 splicePrefix : Text @@ -24,9 +24,9 @@ amuletPrefix : Text amuletPrefix = "amulet." <> splicePrefix -- | Shared definition of the instrument-id used for amulets. -amuletInstrumentId : Party -> Api.Token.HoldingV1.InstrumentId +amuletInstrumentId : Party -> Api.Token.HoldingV2.InstrumentId amuletInstrumentId dso = - Api.Token.HoldingV1.InstrumentId with admin = dso; id = "Amulet" + Api.Token.HoldingV2.InstrumentId with admin = dso; id = "Amulet" -- | Add an optional metadata entry. optionalMetadata : Text -> (a -> Text) -> Optional a -> TextMap Text -> TextMap Text diff --git a/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml b/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml index db8a885664..a956e45a5f 100644 --- a/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml +++ b/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml @@ -19,7 +19,7 @@ import DA.Assert import DA.Optional (optionalToList) import Splice.Api.Token.MetadataV1 -import Splice.Api.Token.HoldingV1 +import Splice.Api.Token.HoldingV2 import Splice.Amulet import Splice.Amulet.TokenApiUtils diff --git a/daml/splice-amulet/daml/Splice/AmuletAllocation.daml b/daml/splice-amulet/daml/Splice/AmuletAllocation.daml index 92d1160f18..c6a1f37d7f 100644 --- a/daml/splice-amulet/daml/Splice/AmuletAllocation.daml +++ b/daml/splice-amulet/daml/Splice/AmuletAllocation.daml @@ -4,13 +4,18 @@ module Splice.AmuletAllocation ( AmuletAllocation(..), allocationToTwoStepTransfer, + allocationSender, ) where import DA.Text as Text +import DA.TextMap qualified as TextMap +import DA.List (dedupSort) import Splice.Api.Token.MetadataV1 -import Splice.Api.Token.HoldingV1 -import Splice.Api.Token.AllocationV1 +import Splice.Api.Token.HoldingV2 +import Splice.Api.Token.AllocationV1 qualified as AllocationV1 +import Splice.Api.Token.AllocationV2 +import Splice.Api.Token.UtilsV2 import Splice.Amulet import Splice.Amulet.TwoStepTransfer @@ -22,14 +27,18 @@ template AmuletAllocation lockedAmulet : ContractId LockedAmulet -- ^ Locked amulet that holds the funds for the allocation allocation : AllocationSpecification where - signatory allocationInstrumentAdmin allocation, allocation.transferLeg.sender + signatory allocationInstrumentAdmin allocation, allocationSender allocation observer allocation.settlement.executor + -- Only allow a single sender. + ensure all (\(_,tl) -> tl.sender == allocationSender allocation) (TextMap.toList allocation.transferLegs) + interface instance Allocation for AmuletAllocation where view = AllocationView with allocation holdingCids = [toInterfaceContractId lockedAmulet] meta = emptyMetadata + transferExtraAuth = [allocationSender allocation] allocation_executeTransferImpl _self Allocation_ExecuteTransfer{..} = transferAmuletAllocation this extraArgs @@ -47,9 +56,29 @@ template AmuletAllocation senderHoldingCids meta = emptyMetadata + allocation_executeAuthorizeIncomingImpl = error "unimplemented" + + interface instance AllocationV1.Allocation for AmuletAllocation where + view = allocation_view_v2_to_v1 (view (toInterface @Allocation this)) + + AllocationV1.allocation_executeTransferImpl = allocation_v1_executeTransferImpl (toInterface @Allocation this) + AllocationV1.allocation_withdrawImpl = allocation_v1_withdrawImpl (toInterface @Allocation this) + AllocationV1.allocation_cancelImpl = allocation_v1_cancelImpl (toInterface @Allocation this) + allocationInstrumentAdmin : AllocationSpecification -> Party -allocationInstrumentAdmin AllocationSpecification{..} = transferLeg.instrumentId.admin +allocationInstrumentAdmin AllocationSpecification{..} = + let tl::_ = (TextMap.toList transferLegs) + in tl._2.instrumentId.admin + +-- Amulet only supports a single sender! +allocationSender : AllocationSpecification -> Party +allocationSender AllocationSpecification{..} = + let tl::_ = (TextMap.toList transferLegs) + in tl._2.sender +allocationInstrumentReceivers : AllocationSpecification -> [Party] +allocationInstrumentReceivers AllocationSpecification{..} = + dedupSort $ map ((.receiver) . snd) (TextMap.toList transferLegs) -- Allocation usage ------------------- @@ -57,17 +86,21 @@ allocationInstrumentAdmin AllocationSpecification{..} = transferLeg.instrumentId allocationToTwoStepTransfer : AllocationSpecification -> TwoStepTransfer allocationToTwoStepTransfer allocation = TwoStepTransfer with - dso = allocationInstrumentAdmin allocation - sender = allocation.transferLeg.sender - receiver = allocation.transferLeg.receiver - amount = allocation.transferLeg.amount + dso = transferLeg.instrumentId.admin + sender = transferLeg.sender + receiver = transferLeg.receiver + amount = transferLeg.amount provider = allocation.settlement.executor transferBefore = allocation.settlement.settleBefore transferBeforeDeadline = "allocation.settlement.settleBefore" allowFeaturing = True lockContext = Text.implode -- We don't show more context to avoid bloating the response here. - ["allocation for transfer leg ", show allocation.transferLegId, " to ", show allocation.transferLeg.receiver] + ["allocation for transfer leg ", show transferLegId, " to ", show transferLeg.receiver] + where + (transferLegId, transferLeg) = case TextMap.toList allocation.transferLegs of + [tl] -> tl + _ -> error "Only one leg supported" -- TODO. transferAmuletAllocation : AmuletAllocation -> ExtraArgs -> Update Allocation_ExecuteTransferResult transferAmuletAllocation amuletAllocation extraArgs = do diff --git a/daml/splice-amulet/daml/Splice/AmuletRules.daml b/daml/splice-amulet/daml/Splice/AmuletRules.daml index 392e25fa9f..758ed8bbb3 100644 --- a/daml/splice-amulet/daml/Splice/AmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/AmuletRules.daml @@ -22,7 +22,7 @@ import DA.Time import Splice.Api.FeaturedAppRightV1 (AppRewardBeneficiary(..)) import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 -import Splice.Api.Token.HoldingV1 qualified as Api.Token.HoldingV1 +import Splice.Api.Token.HoldingV2 qualified as Api.Token.HoldingV2 import Splice.Amulet import Splice.Amulet.TokenApiUtils import Splice.AmuletConfig (AmuletConfig(..), TransferConfig(..), validAmuletConfig, defaultTransferPreapprovalFee) @@ -1226,7 +1226,7 @@ data CreatedAmulet -- ^ Extension constructor (and field) to work around the current lack of upgrading for variants in Daml 3.0 deriving (Show, Eq, Ord) -createdAmuletToHolding : CreatedAmulet -> ContractId Api.Token.HoldingV1.Holding +createdAmuletToHolding : CreatedAmulet -> ContractId Api.Token.HoldingV2.Holding createdAmuletToHolding = \case TransferResultAmulet cid -> toInterfaceContractId cid TransferResultLockedAmulet cid -> toInterfaceContractId cid diff --git a/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml b/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml index 2f6702b18d..711322ad16 100644 --- a/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml +++ b/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml @@ -64,9 +64,11 @@ executeTransferInstr instr extraArgs = do (senderHoldingCids, receiverHoldingCids, meta) <- executeTwoStepTransfer twoStepTransfer instr.lockedAmulet extraArgs pure TransferInstructionResult with - senderChangeCids = senderHoldingCids + -- TODO! This will change once there's a transfer instruction v2 + senderChangeCids = (map coerceInterfaceContractId senderHoldingCids) output = TransferInstructionResult_Completed with - receiverHoldingCids + -- TODO! This will change once there's a transfer instruction v2 + receiverHoldingCids = (map coerceInterfaceContractId receiverHoldingCids) meta abortAmuletTransferInstruction : AmuletTransferInstruction -> ExtraArgs -> Update TransferInstructionResult @@ -74,6 +76,7 @@ abortAmuletTransferInstruction instr extraArgs = do let twoStepTransfer = standardTransferToTwoStepTransfer instr.transfer senderHoldingCids <- abortTwoStepTransfer twoStepTransfer instr.lockedAmulet extraArgs pure TransferInstructionResult with - senderChangeCids = senderHoldingCids + -- TODO! This will change once there's a transfer instruction v2 + senderChangeCids = (map coerceInterfaceContractId senderHoldingCids) output = TransferInstructionResult_Failed meta = emptyMetadata diff --git a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml index 3ce599fa0c..a727f4590e 100644 --- a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml @@ -12,6 +12,8 @@ import qualified DA.TextMap as TextMap import Splice.Api.Token.MetadataV1 import Splice.Api.Token.TransferInstructionV1 qualified as Api.Token.TransferInstructionV1 import Splice.Api.Token.AllocationInstructionV1 as Api.Token.AllocationInstructionV1 +import Splice.Api.Token.UtilsV2 + import Splice.Amulet.TokenApiUtils import Splice.Amulet.TwoStepTransfer @@ -266,7 +268,7 @@ amulet_transferFactory_transferImpl this _self arg = do let expectedInstrumentId = amuletInstrumentId this.dso require ("Expected instrumentId " <> show expectedInstrumentId <> " matches actual instrumentId " <> show transfer.instrumentId) - (expectedInstrumentId == transfer.instrumentId) + (expectedInstrumentId == instrumentId_v1_to_v2 transfer.instrumentId) -- TODO - remove -- amount: require "Amount must be positive" (transfer.amount > 0.0) -- requestedAt: @@ -284,8 +286,8 @@ amulet_transferFactory_transferImpl this _self arg = do | transfer.receiver == transfer.sender -> do -- execute a self-transfer paymentContext <- unfeaturedPaymentContextFromChoiceContext dso extraArgs.context - inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext transfer.inputHoldingCids - result <- exercisePaymentTransfer dso paymentContext Transfer with + inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext (map coerceInterfaceContractId transfer.inputHoldingCids) + result <- exercisePaymentTransfer paymentContext Transfer with sender = transfer.sender provider = transfer.sender inputs @@ -298,7 +300,7 @@ amulet_transferFactory_transferImpl this _self arg = do pure Api.Token.TransferInstructionV1.TransferInstructionResult with senderChangeCids = toInterfaceContractId <$> optionalToList result.senderChangeAmulet output = Api.Token.TransferInstructionV1.TransferInstructionResult_Completed with - receiverHoldingCids = createdAmuletToHolding <$> result.createdAmulets + receiverHoldingCids = map coerceInterfaceContractId $ createdAmuletToHolding <$> result.createdAmulets meta = copyOnlyBurnMeta result.meta | otherwise -> do @@ -306,7 +308,7 @@ amulet_transferFactory_transferImpl this _self arg = do let twoStepTransfer = standardTransferToTwoStepTransfer arg.transfer let requestedAt = arg.transfer.requestedAt paymentContext <- unfeaturedPaymentContextFromChoiceContext dso extraArgs.context - (lockedAmulet, senderChangeCids, meta) <- prepareTwoStepTransfer twoStepTransfer requestedAt arg.transfer.inputHoldingCids paymentContext + (lockedAmulet, senderChangeCids, meta) <- prepareTwoStepTransfer twoStepTransfer requestedAt (map coerceInterfaceContractId arg.transfer.inputHoldingCids) paymentContext -- create the transfer instruction tracking this locked amulet transferInstructionCid <- toInterfaceContractId <$> create AmuletTransferInstruction with transfer = arg.transfer with @@ -314,7 +316,7 @@ amulet_transferFactory_transferImpl this _self arg = do lockedAmulet -- return result pure Api.Token.TransferInstructionV1.TransferInstructionResult with - senderChangeCids + senderChangeCids = map coerceInterfaceContractId senderChangeCids output = Api.Token.TransferInstructionV1.TransferInstructionResult_Pending with transferInstructionCid @@ -324,7 +326,7 @@ amulet_transferFactory_transferImpl this _self arg = do -- use a payment context with featuring so the preapproval provider can be featured paymentContext <- paymentFromChoiceContext dso extraArgs.context -- execute a direct transfer - inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext transfer.inputHoldingCids + inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext (map coerceInterfaceContractId transfer.inputHoldingCids) result <- exercise preapprovalCid TransferPreapproval_Send with sender = transfer.sender @@ -337,7 +339,7 @@ amulet_transferFactory_transferImpl this _self arg = do pure Api.Token.TransferInstructionV1.TransferInstructionResult with senderChangeCids = toInterfaceContractId <$> optionalToList result.result.senderChangeAmulet output = Api.Token.TransferInstructionV1.TransferInstructionResult_Completed with - receiverHoldingCids = createdAmuletToHolding <$> result.result.createdAmulets + receiverHoldingCids = map coerceInterfaceContractId $ createdAmuletToHolding <$> result.result.createdAmulets meta = copyOnlyBurnMeta result.meta @@ -383,7 +385,7 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do -- transferLeg.amount require "Transfer amount must be positive" (transferLeg.amount > 0.0) -- transferLeg.instrumentId - require "Instrument-id must match the factory" (transferLeg.instrumentId == amuletInstrumentId dso) + require "Instrument-id must match the factory" (instrumentId_v1_to_v2 transferLeg.instrumentId == amuletInstrumentId dso) -- transferLeg.meta: no check -- requestedAt (of the allocation instruction itself): @@ -393,17 +395,17 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do require "At least one input holding must be provided" (not $ null inputHoldingCids) -- lock the funds - let twoStepTransfer = allocationToTwoStepTransfer arg.allocation + let twoStepTransfer = allocationToTwoStepTransfer (allocation_specification_v1_to_v2 arg.allocation) (lockedAmulet, senderChangeCids, meta) <- - prepareTwoStepTransfer twoStepTransfer arg.requestedAt inputHoldingCids paymentContext + prepareTwoStepTransfer twoStepTransfer arg.requestedAt (map coerceInterfaceContractId inputHoldingCids) paymentContext -- create the amulet allocation allocationCid <- toInterfaceContractId <$> create AmuletAllocation with - allocation = arg.allocation + allocation = allocation_specification_v1_to_v2 arg.allocation lockedAmulet -- finaly done: return the result pure AllocationInstructionResult with - senderChangeCids + senderChangeCids = map coerceInterfaceContractId senderChangeCids output = AllocationInstructionResult_Completed with allocationCid meta diff --git a/daml/splice-amulet/daml/Splice/Types.daml b/daml/splice-amulet/daml/Splice/Types.daml index 9c976cebd3..fcbdebb7c8 100644 --- a/daml/splice-amulet/daml/Splice/Types.daml +++ b/daml/splice-amulet/daml/Splice/Types.daml @@ -4,11 +4,13 @@ -- Base types for Amulet and all related modules. module Splice.Types where -import Splice.Api.Token.AllocationV1 -import Splice.Api.Token.HoldingV1 +import Splice.Api.Token.AllocationV2 +import Splice.Api.Token.HoldingV2 import Splice.Api.Token.TransferInstructionV1 import Splice.Util (HasCheckedFetch(..)) +import DA.TextMap qualified as TextMap + newtype Round = Round with number : Int deriving (Eq, Show, Ord) @@ -52,5 +54,7 @@ instance HasCheckedFetch TransferInstructionView ForDso where dso = transfer.instrumentId.admin instance HasCheckedFetch AllocationView ForDso where - contractGroupId AllocationView {..} = ForDso with - dso = allocation.transferLeg.instrumentId.admin + contractGroupId AllocationView {..} = + let tl::_ = (TextMap.toList allocation.transferLegs) + in ForDso with dso = tl._2.instrumentId.admin + diff --git a/daml/splice-wallet-test/daml.yaml b/daml/splice-wallet-test/daml.yaml index 596e8db18b..65ec55090b 100644 --- a/daml/splice-wallet-test/daml.yaml +++ b/daml/splice-wallet-test/daml.yaml @@ -14,10 +14,13 @@ data-dependencies: - ../splice-wallet/.daml/dist/splice-wallet-current.dar - ../../token-standard/examples/splice-token-test-trading-app/.daml/dist/splice-token-test-trading-app-current.dar - ../../token-standard/splice-token-standard-test/.daml/dist/splice-token-standard-test-current.dar +- ../../token-standard/splice-token-standard-test-v2/.daml/dist/splice-token-standard-test-v2-current.dar - ../../token-standard/splice-api-token-transfer-instruction-v1/.daml/dist/splice-api-token-transfer-instruction-v1-current.dar - ../../token-standard/splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar - ../../token-standard/splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar -- ../../token-standard/splice-api-token-allocation-v1/.daml/dist/splice-api-token-allocation-v1-current.dar +- ../../token-standard/splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar +- ../../token-standard/splice-api-token-utils-v2/.daml/dist/splice-api-token-utils-v2-current.dar + build-options: - --ghc-option=-Wunused-binds - --ghc-option=-Wunused-matches diff --git a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml index b3ab49e5ff..e58b81537a 100644 --- a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml +++ b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml @@ -30,11 +30,12 @@ import Splice.Testing.Utils import Splice.Testing.Registries.AmuletRegistry.Parameters import Splice.Testing.Registries.AmuletRegistry qualified as AmuletRegistry import Splice.Testing.TokenStandard.RegistryApi qualified as RegistryApi -import qualified Splice.Api.Token.AllocationV1 as Api.Token.AllocationV1 +import qualified Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import qualified Splice.Api.Token.AllocationInstructionV1 as Api.Token.AllocationInstructionV1 import Splice.Api.Token.TransferInstructionV1 (TransferFactory_Transfer(..)) import qualified Splice.Api.Token.TransferInstructionV1 as Api.Token.TransferInstructionV1 import Splice.Api.Token.MetadataV1 +import Splice.Api.Token.UtilsV2 import Splice.Testing.Apps.TradingApp import Splice.Testing.TokenStandard.WalletClient qualified as WalletClient @@ -1007,7 +1008,7 @@ testTokenStandardTransfer = script do sender = alice receiver = bob amount = 10.0 - instrumentId = registry.instrumentId + instrumentId = instrumentId_v2_to_v1 registry.instrumentId requestedAt = now executeBefore = now `addRelTime` days 1 inputHoldingCids = [] @@ -1016,7 +1017,7 @@ testTokenStandardTransfer = script do let transfer = defaultTransfer with sender = alice receiver = bob - inputHoldingCids = [holdingCid] + inputHoldingCids = [coerceInterfaceContractId holdingCid] enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with expectedAdmin = registry.dso @@ -1099,7 +1100,7 @@ testTokenStandardAllocate = script do validatorParty = aliceValidator let amuletId = registry.instrumentId - let mkTransfer sender receiver amount = Api.Token.AllocationV1.TransferLeg with + let mkTransfer sender receiver amount = Api.Token.AllocationV2.TransferLeg with sender receiver amount @@ -1129,7 +1130,7 @@ testTokenStandardAllocate = script do enrichedChoice <- RegistryApi.getAllocationFactory registry Api.Token.AllocationInstructionV1.AllocationFactory_Allocate with expectedAdmin = registry.dso allocation = aliceAlloc - inputHoldingCids = [holdingCid] + inputHoldingCids = [coerceInterfaceContractId holdingCid] requestedAt = now extraArgs = emptyExtraArgs @@ -1139,11 +1140,11 @@ testTokenStandardAllocate = script do Api.Token.AllocationInstructionV1.AllocationInstructionResult_Completed allocationCid <- pure result.output - context <- RegistryApi.getAllocation_WithdrawContext registry allocationCid emptyMetadata + context <- RegistryApi.getAllocation_WithdrawContext registry (coerceInterfaceContractId allocationCid) emptyMetadata _ <- submitMulti [aliceValidator] [alice, registry.dso] $ exerciseCmd aliceInstall WalletAppInstall_Allocation_Withdraw with - allocationCid = allocationCid - withdrawArg = Api.Token.AllocationV1.Allocation_Withdraw with + allocationCid = coerceInterfaceContractId allocationCid + withdrawArg = Api.Token.AllocationV2.Allocation_Withdraw with extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata diff --git a/daml/splice-wallet/daml.yaml b/daml/splice-wallet/daml.yaml index 30350d87c5..67b2ce6379 100644 --- a/daml/splice-wallet/daml.yaml +++ b/daml/splice-wallet/daml.yaml @@ -6,11 +6,12 @@ dependencies: - daml-prim - daml-stdlib data-dependencies: -- ../../token-standard/splice-api-token-holding-v1/.daml/dist/splice-api-token-holding-v1-current.dar +- ../../token-standard/splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar - ../../token-standard/splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar - ../../token-standard/splice-api-token-transfer-instruction-v1/.daml/dist/splice-api-token-transfer-instruction-v1-current.dar - ../../token-standard/splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar -- ../../token-standard/splice-api-token-allocation-v1/.daml/dist/splice-api-token-allocation-v1-current.dar +- ../../token-standard/splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar +- ../../token-standard/splice-api-token-utils-v2/.daml/dist/splice-api-token-utils-v2-current.dar - ../splice-amulet/.daml/dist/splice-amulet-current.dar - ../splice-util/.daml/dist/splice-util-current.dar - ../splice-wallet-payments/.daml/dist/splice-wallet-payments-current.dar diff --git a/daml/splice-wallet/daml/Splice/Wallet/Install.daml b/daml/splice-wallet/daml/Splice/Wallet/Install.daml index 8c4fe19b84..5a4b66d56a 100644 --- a/daml/splice-wallet/daml/Splice/Wallet/Install.daml +++ b/daml/splice-wallet/daml/Splice/Wallet/Install.daml @@ -11,10 +11,12 @@ import DA.Time import DA.Foldable (forA_) import DA.Optional (isSome) -import qualified Splice.Api.Token.AllocationV1 +import qualified Splice.Api.Token.AllocationV2 import qualified Splice.Api.Token.AllocationInstructionV1 import qualified Splice.Api.Token.TransferInstructionV1 +import Splice.Api.Token.UtilsV2 import Splice.Amulet +import Splice.AmuletAllocation (allocationSender) import Splice.Amulet.TokenApiUtils import Splice.Types import Splice.AmuletRules @@ -592,7 +594,7 @@ template WalletAppInstall controller validatorParty do let transfer = transferArg.transfer require ("sender " <> show transfer.sender <> " is endUserParty " <> show endUserParty) (transfer.sender == endUserParty) - require ("instrumentId " <> show transfer.instrumentId <> " is amuletInstrumentId " <> show (amuletInstrumentId dsoParty)) (transfer.instrumentId == amuletInstrumentId dsoParty) + require ("instrumentId " <> show transfer.instrumentId <> " is amuletInstrumentId " <> show (amuletInstrumentId dsoParty)) (instrumentId_v1_to_v2 transfer.instrumentId == amuletInstrumentId dsoParty) require ("expected admin " <> show transferArg.expectedAdmin <> " is dso " <> show dsoParty) (transferArg.expectedAdmin == dsoParty) exercise transferFactoryCid transferArg @@ -638,16 +640,16 @@ template WalletAppInstall let sender = allocateArg.allocation.transferLeg.sender require ("sender " <> show sender <> " is endUserParty " <> show endUserParty) (sender == endUserParty) let legInstrumentId = allocateArg.allocation.transferLeg.instrumentId - require ("instrumentId " <> show legInstrumentId <> " is amuletInstrumentId " <> show (amuletInstrumentId dsoParty)) (legInstrumentId == amuletInstrumentId dsoParty) + require ("instrumentId " <> show legInstrumentId <> " is amuletInstrumentId " <> show (amuletInstrumentId dsoParty)) (instrumentId_v1_to_v2 legInstrumentId == amuletInstrumentId dsoParty) exercise allocationFactory allocateArg - nonconsuming choice WalletAppInstall_Allocation_Withdraw : Splice.Api.Token.AllocationV1.Allocation_WithdrawResult + nonconsuming choice WalletAppInstall_Allocation_Withdraw : Splice.Api.Token.AllocationV2.Allocation_WithdrawResult with - allocationCid : ContractId Splice.Api.Token.AllocationV1.Allocation - withdrawArg : Splice.Api.Token.AllocationV1.Allocation_Withdraw + allocationCid : ContractId Splice.Api.Token.AllocationV2.Allocation + withdrawArg : Splice.Api.Token.AllocationV2.Allocation_Withdraw controller validatorParty do allocation <- fetchCheckedInterface (ForDso dsoParty) allocationCid - let sender = (view allocation).allocation.transferLeg.sender + let sender = allocationSender (view allocation).allocation require ("sender " <> show sender <> " must match endUserParty " <> show endUserParty) (sender == endUserParty) exercise allocationCid withdrawArg diff --git a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml index e89344eafd..e560d0591c 100644 --- a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml +++ b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml @@ -81,6 +81,8 @@ data AllocationSpecification = AllocationSpecification with deriving (Show, Eq) -- | View of a funded allocation of assets to a specific leg of a settlement. +-- To be standards compliant, an allocation must have a non-zero number of +-- transfer legs, all with an instrumentId with the same adminId. data AllocationView = AllocationView with allocation : AllocationSpecification -- ^ The settlement for whose execution the assets are being allocated. @@ -124,7 +126,7 @@ allocationSenders AllocationView{..} = map (._2.sender) (toList allocation.trans --- | A contract representing an allocation of some amount of aasset holdings to +-- | A contract representing an allocation of some amount of asset holdings to -- a specific leg of a settlement. interface Allocation where viewtype AllocationView diff --git a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml index d4cef4543d..c64a5c8e7c 100644 --- a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml +++ b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml @@ -5,6 +5,7 @@ -- implement the V1 interfaces from the V2 interfaces. module Splice.Api.Token.UtilsV2 where +import DA.Optional (fromSome) import DA.TextMap qualified as TextMap import Splice.Api.Token.MetadataV1 @@ -40,8 +41,8 @@ instrumentId_v2_to_v1 HoldingV2.InstrumentId{..} = HoldingV1.InstrumentId with . lock_v2_to_v1 : HoldingV2.Lock -> HoldingV1.Lock lock_v2_to_v1 HoldingV2.Lock{..} = HoldingV1.Lock with .. -holdingv2_to_v1 : HoldingV2.HoldingView -> HoldingV1.HoldingView -holdingv2_to_v1 v2 = v1 +holding_v2_to_v1 : HoldingV2.HoldingView -> HoldingV1.HoldingView +holding_v2_to_v1 v2 = v1 where v1 = HoldingV1.HoldingView with owner = v2.owner @@ -157,3 +158,55 @@ allocation_view_v2_to_v1 AllocationV2.AllocationView{..} = TextMap.insert "canton.network/transferExtraAuth" (show transferExtraAuth) $ meta.values +-- Choices + +allocation_execute_transfer_v1_to_v2 : AllocationV1.Allocation_ExecuteTransfer -> AllocationV2.Allocation_ExecuteTransfer +allocation_execute_transfer_v1_to_v2 AllocationV1.Allocation_ExecuteTransfer{..} = + AllocationV2.Allocation_ExecuteTransfer with + extraAuth = None + .. + +allocation_transfer_result_v2_to_v1 : AllocationV2.Allocation_ExecuteTransferResult -> AllocationV1.Allocation_ExecuteTransferResult +allocation_transfer_result_v2_to_v1 AllocationV2.Allocation_ExecuteTransferResult {..} = + AllocationV1.Allocation_ExecuteTransferResult with + senderHoldingCids = map coerceInterfaceContractId senderHoldingCids + receiverHoldingCids = map coerceInterfaceContractId receiverHoldingCids + meta + +allocation_v1_executeTransferImpl : AllocationV2.Allocation -> ContractId AllocationV1.Allocation -> AllocationV1.Allocation_ExecuteTransfer -> Update AllocationV1.Allocation_ExecuteTransferResult +allocation_v1_executeTransferImpl this self execv1 = do + resv2 <- AllocationV2.allocation_executeTransferImpl + this + (coerceInterfaceContractId @AllocationV2.Allocation self) + (allocation_execute_transfer_v1_to_v2 execv1) + return (allocation_transfer_result_v2_to_v1 resv2) + + +allocation_withdraw_result_v2_to_v1 : AllocationV2.Allocation_WithdrawResult -> AllocationV1.Allocation_WithdrawResult +allocation_withdraw_result_v2_to_v1 AllocationV2.Allocation_WithdrawResult {..} = + AllocationV1.Allocation_WithdrawResult with + senderHoldingCids = map coerceInterfaceContractId senderHoldingCids + meta + +allocation_v1_withdrawImpl : AllocationV2.Allocation -> ContractId AllocationV1.Allocation -> AllocationV1.Allocation_Withdraw -> Update AllocationV1.Allocation_WithdrawResult +allocation_v1_withdrawImpl this self AllocationV1.Allocation_Withdraw{..} = do + resv2 <- AllocationV2.allocation_withdrawImpl + this + (coerceInterfaceContractId @AllocationV2.Allocation self) + AllocationV2.Allocation_Withdraw {..} + return (allocation_withdraw_result_v2_to_v1 resv2) + + +allocation_cancel_result_v2_to_v1 : AllocationV2.Allocation_CancelResult -> AllocationV1.Allocation_CancelResult +allocation_cancel_result_v2_to_v1 AllocationV2.Allocation_CancelResult {..} = + AllocationV1.Allocation_CancelResult with + senderHoldingCids = map coerceInterfaceContractId senderHoldingCids + meta + +allocation_v1_cancelImpl : AllocationV2.Allocation -> ContractId AllocationV1.Allocation -> AllocationV1.Allocation_Cancel -> Update AllocationV1.Allocation_CancelResult +allocation_v1_cancelImpl this self AllocationV1.Allocation_Cancel{..} = do + resv2 <- AllocationV2.allocation_cancelImpl + this + (coerceInterfaceContractId @AllocationV2.Allocation self) + AllocationV2.Allocation_Cancel {..} + return (allocation_cancel_result_v2_to_v1 resv2) diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml index 883e77d7b9..a30a0da70c 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml @@ -13,14 +13,15 @@ import DA.TextMap as TextMap import DA.Traversable qualified as Traversable import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 -import Splice.Api.Token.AllocationV1 as Api.Token.AllocationV1 +import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import Splice.Api.Token.AllocationRequestV1 +import Splice.Api.Token.UtilsV2 template OTCTradeProposal with venue : Party tradeCid : Optional (ContractId OTCTradeProposal) -- Tracking-id for the trade being proposed. Set to None for new trades. - transferLegs : TextMap Api.Token.AllocationV1.TransferLeg + transferLegs : TextMap Api.Token.AllocationV2.TransferLeg approvers : [Party] -- ^ Parties that have approved the proposal where signatory approvers @@ -66,21 +67,20 @@ template OTCTradeProposal with settleBefore tradeAllocations - : SettlementInfo -> TextMap Api.Token.AllocationV1.TransferLeg + : SettlementInfo -> TextMap Api.Token.AllocationV2.TransferLeg -> TextMap AllocationSpecification tradeAllocations settlementInfo transferLegs = TextMap.fromList $ do (transferLegId, transferLeg) <- TextMap.toList transferLegs let spec = AllocationSpecification with settlement = settlementInfo - transferLegId - transferLeg + transferLegs = TextMap.fromList [(transferLegId, transferLeg)] pure (transferLegId, spec) template OTCTrade with venue : Party - transferLegs : TextMap Api.Token.AllocationV1.TransferLeg + transferLegs : TextMap Api.Token.AllocationV2.TransferLeg tradeCid : ContractId OTCTradeProposal createdAt : Time prepareUntil : Time @@ -104,6 +104,7 @@ template OTCTrade allocateBefore = prepareUntil settleBefore meta = emptyMetadata + controllerOverride = None let expectedAllocations = tradeAllocations settlementInfo transferLegs let mergedMaps = zipTextMaps allocationsWithContext expectedAllocations forTextMapWithKey mergedMaps \legId (optAllocWithContext, optExpectedAlloc) -> do @@ -113,7 +114,7 @@ template OTCTrade instr <- fetch @Allocation allocCid let instrView = view @Allocation instr require "Allocation matches expected allocation" (instrView.allocation == expectedAlloc) - exercise allocCid (Allocation_ExecuteTransfer extraArgs) + exercise allocCid (Allocation_ExecuteTransfer with extraArgs; extraAuth = None) -- NOTE: this choice is an approximation to what a real app would do. @@ -134,6 +135,7 @@ template OTCTrade allocateBefore = prepareUntil settleBefore meta = emptyMetadata + controllerOverride = None let expectedAllocations = tradeAllocations settlementInfo transferLegs let mergedMaps = zipTextMaps allocationsWithContext expectedAllocations -- fetch and validate the allocation instruction @@ -150,14 +152,15 @@ template OTCTrade interface instance AllocationRequest for OTCTrade where view = AllocationRequestView with - settlement = SettlementInfo with + settlement = settlement_info_v2_to_v1 $ SettlementInfo with executor = venue requestedAt = createdAt settlementRef = makeTradeRef tradeCid allocateBefore = prepareUntil settleBefore meta = emptyMetadata - transferLegs + controllerOverride = None + transferLegs = fmap transfer_leg_v2_to_v1 transferLegs meta = emptyMetadata allocationRequest_RejectImpl _self AllocationRequest_Reject{..} = do @@ -171,7 +174,7 @@ template OTCTrade pure ChoiceExecutionMetadata with meta = emptyMetadata -tradingParties : TextMap Api.Token.AllocationV1.TransferLeg -> Set.Set Party +tradingParties : TextMap Api.Token.AllocationV2.TransferLeg -> Set.Set Party tradingParties = F.foldl (\acc t -> Set.insert t.sender (Set.insert t.receiver acc)) Set.empty -- | Check whether a required condition is true. If it's not, abort the @@ -180,8 +183,8 @@ require : CanAssert m => Text -> Bool -> m () require msg invariant = assertMsg ("The requirement '" <> msg <> "' was not met.") invariant -makeTradeRef : ContractId OTCTradeProposal -> Api.Token.AllocationV1.Reference -makeTradeRef tradeCid = Api.Token.AllocationV1.Reference with +makeTradeRef : ContractId OTCTradeProposal -> Api.Token.AllocationV2.Reference +makeTradeRef tradeCid = Api.Token.AllocationV2.Reference with id = "OTCTradeProposal" -- set to the name of the template to simplify debugging cid = Some (coerceContractId tradeCid) diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml index cc5a597456..cd93e4aa8f 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml @@ -35,10 +35,11 @@ import DA.Time import DA.Text qualified as T import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 -import Splice.Api.Token.HoldingV1 as Api.Token.HoldingV1 -import Splice.Api.Token.AllocationV1 as Api.Token.AllocationV1 +import Splice.Api.Token.HoldingV2 as Api.Token.HoldingV2 +import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import Splice.Api.Token.AllocationInstructionV1 import Splice.Api.Token.TransferInstructionV1 +import Splice.Api.Token.UtilsV2 import Splice.Amulet import Splice.Amulet.TokenApiUtils diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml index d7b41e8d76..f1456e5087 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml @@ -9,7 +9,7 @@ module Splice.Testing.TokenStandard.RegistryApi ) where import Splice.Api.Token.MetadataV1 -import Splice.Api.Token.AllocationV1 as Api.Token.AllocationV1 +import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import Splice.Api.Token.AllocationInstructionV1 import Splice.Api.Token.TransferInstructionV1 diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml index b19733c374..b847345219 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml @@ -35,7 +35,6 @@ import DA.TextMap qualified as TextMap import Splice.Api.Token.AllocationV1 qualified as AllocationV1 import Splice.Api.Token.TransferInstructionV1 qualified as TransferInstructionV1 import Splice.Api.Token.AllocationRequestV1 qualified as AllocationRequestV1 -import Splice.Api.Token.HoldingV1 qualified as HoldingV1 import Splice.Api.Token.UtilsV2 import Splice.Api.Token.AllocationV2 qualified as AllocationV2 @@ -45,9 +44,9 @@ import Daml.Script -- | List the hodlings of a party of a specific instrument. -- We always read as V1 and upcast as needed. -listHoldings : Party -> HoldingV1.InstrumentId -> Script [(ContractId HoldingV1.Holding, HoldingV1.HoldingView)] +listHoldings : Party -> HoldingV2.InstrumentId -> Script [(ContractId HoldingV2.Holding, HoldingV2.HoldingView)] listHoldings p instrumentId = do - holdings <- queryInterface @HoldingV1.Holding p + holdings <- queryInterface @HoldingV2.Holding p let instrumendHoldings = do (cid, Some holding) <- holdings guard (holding.instrumentId == instrumentId) @@ -55,23 +54,23 @@ listHoldings p instrumentId = do pure (cid, holding) pure instrumendHoldings -listLockedHoldings : Party -> HoldingV1.InstrumentId -> Script [(ContractId HoldingV1.Holding, HoldingV1.HoldingView)] +listLockedHoldings : Party -> HoldingV2.InstrumentId -> Script [(ContractId HoldingV2.Holding, HoldingV2.HoldingView)] listLockedHoldings p instrumentId = filter (\(_, holding) -> isSome (holding.lock)) <$> listHoldings p instrumentId -- | List the cids of the hodlings of a party of a specific instrument. -listHoldingCids : Party -> HoldingV1.InstrumentId -> Script [ContractId HoldingV1.Holding] +listHoldingCids : Party -> HoldingV2.InstrumentId -> Script [ContractId HoldingV2.Holding] listHoldingCids p instrumentId = (map fst) <$> listHoldings p instrumentId -- | Check that a holding with a specific amount exists for the given owner. -checkHoldingWithAmountExists : Party -> HoldingV1.InstrumentId -> Decimal -> Script () +checkHoldingWithAmountExists : Party -> HoldingV2.InstrumentId -> Decimal -> Script () checkHoldingWithAmountExists p instrumentId amount = do holdings <- map snd <$> listHoldings p instrumentId unless (any (\holding -> holding.amount == amount) holdings) $ fail (show p <> " is missing holding of value " <> show amount <> " in " <> show holdings) -- | Check the bounds on a party's total balance of all holdings of the given instrument. -checkBalanceBounds : Party -> HoldingV1.InstrumentId -> (Decimal, Decimal) -> Script () +checkBalanceBounds : Party -> HoldingV2.InstrumentId -> (Decimal, Decimal) -> Script () checkBalanceBounds p instrumentId (lb, ub) = do holdings <- listHoldings p instrumentId let total = sum $ map (._2.amount) holdings @@ -80,11 +79,11 @@ checkBalanceBounds p instrumentId (lb, ub) = do " is not within the expected range [" <> show lb <> ", " <> show ub <> "]" -- | Check the exact value of on an individual holding's amount. -checkHolding : Party -> ContractId HoldingV1.Holding -> Decimal -> Script () +checkHolding : Party -> ContractId HoldingV2.Holding -> Decimal -> Script () checkHolding p holdingCid amount = checkHoldingBounds p holdingCid (amount, amount) -- | Check the bounds on an individual holding's amount. -checkHoldingBounds : Party -> ContractId HoldingV1.Holding -> (Decimal, Decimal) -> Script () +checkHoldingBounds : Party -> ContractId HoldingV2.Holding -> (Decimal, Decimal) -> Script () checkHoldingBounds p holdingCid (lb, ub) = do holdingO <- queryInterfaceContractId p holdingCid debug holdingO @@ -96,26 +95,26 @@ checkHoldingBounds p holdingCid (lb, ub) = do " is not within the expected range [" <> show lb <> ", " <> show ub <> "]" -- | Check the approximate value (+/- 1.0) a party's total balance of all holdings of the given instrument. -checkBalanceApprox : Party -> HoldingV1.InstrumentId -> Decimal -> Script () +checkBalanceApprox : Party -> HoldingV2.InstrumentId -> Decimal -> Script () checkBalanceApprox p instrumentId approximateBalance = checkBalanceBounds p instrumentId (approximateBalance - 1.0, approximateBalance + 1.0) -- | Check the approximate (+/- 1.0) amount of an individual holding. -checkHoldingApprox : Party -> ContractId HoldingV1.Holding -> Decimal -> Script () +checkHoldingApprox : Party -> ContractId HoldingV2.Holding -> Decimal -> Script () checkHoldingApprox p holdingCid approximateAmount = checkHoldingBounds p holdingCid (approximateAmount - 1.0, approximateAmount + 1.0) -- | Check the exact value a party's total balance of all holdings of the given instrument. -checkBalance : Party -> HoldingV1.InstrumentId -> Decimal -> Script () +checkBalance : Party -> HoldingV2.InstrumentId -> Decimal -> Script () checkBalance p instrumentId balance = checkBalanceBounds p instrumentId (balance, balance) -- | List pending transfer offers (as sender or receiver) -listTransferOffers : Party -> HoldingV1.InstrumentId -> Script [(ContractId TransferInstructionV1.TransferInstruction, TransferInstructionV1.TransferInstructionView)] +listTransferOffers : Party -> HoldingV2.InstrumentId -> Script [(ContractId TransferInstructionV1.TransferInstruction, TransferInstructionV1.TransferInstructionView)] listTransferOffers p instrumentId = do instrs <- queryInterface @TransferInstructionV1.TransferInstruction p let pendingOffers = do (cid, Some instr) <- instrs - guard (instr.transfer.instrumentId == instrumentId) + guard (instr.transfer.instrumentId == instrumentId_v2_to_v1 instrumentId) guard (instr.status == TransferInstructionV1.TransferPendingReceiverAcceptance) guard (p == instr.transfer.sender || p == instr.transfer.receiver) pure (cid, instr) @@ -124,14 +123,14 @@ listTransferOffers p instrumentId = do -- | List all allocations requested from the owner for a specific instrument. -- Currently targeting V1. -- TODO: Make this sensible. -listRequestedAllocations : Party -> HoldingV1.InstrumentId -> Script [AllocationV1.AllocationSpecification] +listRequestedAllocations : Party -> HoldingV2.InstrumentId -> Script [AllocationV1.AllocationSpecification] listRequestedAllocations p instrumentId = do reqs <- queryInterface @AllocationRequestV1.AllocationRequest p trace reqs $ pure () let amuletAllocs = do (_reqCid, Some req) <- reqs (tfId, tf) <- TextMap.toList req.transferLegs - guard (tf.instrumentId == instrumentId) + guard (tf.instrumentId == instrumentId_v2_to_v1 instrumentId) guard (p == tf.sender) pure AllocationV1.AllocationSpecification with settlement = req.settlement diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml index 281f6337de..0c5ec1fb0a 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml @@ -24,10 +24,11 @@ import DA.Time import DA.Traversable qualified as Traversable import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 -import Splice.Api.Token.HoldingV1 -import Splice.Api.Token.AllocationV1 as Api.Token.AllocationV1 +import Splice.Api.Token.HoldingV2 +import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import Splice.Api.Token.AllocationRequestV1 import Splice.Api.Token.AllocationInstructionV1 +import Splice.Api.Token.UtilsV2 import Splice.Amulet import Splice.Amulet.TokenApiUtils (burnedMetaKey) @@ -75,7 +76,7 @@ setupOtcTrade = do AmuletRegistry.tapLockedAndUnlockedFunds registry alice 1000.0 AmuletRegistry.tapLockedAndUnlockedFunds registry bob 1000.0 - let mkTransfer sender receiver amount = Api.Token.AllocationV1.TransferLeg with + let mkTransfer sender receiver amount = Api.Token.AllocationV2.TransferLeg with sender receiver amount @@ -123,7 +124,7 @@ setupOtcTrade = do enrichedChoice <- RegistryApi.getAllocationFactory registry AllocationFactory_Allocate with expectedAdmin = alice allocation = aliceAlloc - inputHoldingCids + inputHoldingCids = map coerceInterfaceContractId inputHoldingCids requestedAt = now extraArgs = emptyExtraArgs submitWithDisclosuresMustFail' alice enrichedChoice.disclosures $ @@ -135,7 +136,7 @@ setupOtcTrade = do enrichedChoice <- RegistryApi.getAllocationFactory registry AllocationFactory_Allocate with expectedAdmin = registry.dso allocation = aliceAlloc - inputHoldingCids + inputHoldingCids = map coerceInterfaceContractId inputHoldingCids requestedAt = now extraArgs = emptyExtraArgs result <- submitWithDisclosures' alice enrichedChoice.disclosures $ @@ -162,7 +163,7 @@ setupOtcTrade = do enrichedChoice <- RegistryApi.getAllocationFactory registry AllocationFactory_Allocate with expectedAdmin = registry.dso allocation = bobAlloc - inputHoldingCids + inputHoldingCids = map coerceInterfaceContractId inputHoldingCids requestedAt = now extraArgs = emptyExtraArgs submitWithDisclosures' bob enrichedChoice.disclosures $ @@ -195,7 +196,7 @@ testDvP = script do passTime (hours 1) -- provider runs automation that completes the settlement - let otcTradeRef = (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef + let otcTradeRef = reference_v1_to_v2 (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef allocations <- appBackendListAllocations provider otcTradeRef TextMap.size allocations === 2 @@ -252,7 +253,7 @@ testDvP = script do testDvPCancel = script do AllocatedOTCTrade{..} <- setupOtcTrade - let otcTradeRef = (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef + let otcTradeRef = reference_v1_to_v2 (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef allocations <- appBackendListAllocations provider otcTradeRef [(_, aliceLockedHolding)] <- WalletClient.listLockedHoldings alice registry.instrumentId @@ -318,7 +319,7 @@ appBackendListAllocations p ref = do let matchingAllocs = do (cid, Some fundedAllocation) <- allocs guard (fundedAllocation.allocation.settlement.settlementRef == ref) - pure (fundedAllocation.allocation.transferLegId, (cid, fundedAllocation)) + map (\(transferLegId, _) -> (transferLegId, (cid, fundedAllocation))) (TextMap.toList fundedAllocation.allocation.transferLegs) pure $ TextMap.fromList matchingAllocs expectBurn : Metadata -> Script () diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml index 1960891749..a9d8a52a6f 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml @@ -6,8 +6,9 @@ module Splice.Tests.TestAmuletTokenTransfer where import Splice.Api.Token.MetadataV1 -import Splice.Api.Token.HoldingV1 +import Splice.Api.Token.HoldingV2 import Splice.Api.Token.TransferInstructionV1 as Api.Token.TransferInstructionV1 +import Splice.Api.Token.UtilsV2 import Daml.Script @@ -107,10 +108,10 @@ setupTest = do sender = bob receiver = alice amount = 10.0 - instrumentId = registry.instrumentId + instrumentId = instrumentId_v2_to_v1 registry.instrumentId requestedAt = now executeBefore = now `addRelTime` days 1 - inputHoldingCids = bobHoldingCids + inputHoldingCids = map coerceInterfaceContractId bobHoldingCids meta = Metadata with values = TextMap.fromList [("token-metadata-v1.splice.lfdecentralizedtrust.org/correlation-id", "")] @@ -132,7 +133,7 @@ setupTwoStepTransfer = do let transfer = defaultTransfer with sender = alice receiver = bob -- turn this around so that the transfer is a two-step one - inputHoldingCids = map fst aliceHoldingCids + inputHoldingCids = map (coerceInterfaceContractId . fst) aliceHoldingCids enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with expectedAdmin = registry.dso @@ -148,7 +149,7 @@ setupTwoStepTransfer = do TransferInstructionResult_Pending aliceInstrCid <- pure result.output -- check that the change is returned as expected - [senderChangeCid] <- pure result.senderChangeCids + [senderChangeCid] <- pure (map coerceInterfaceContractId result.senderChangeCids) Some senderChange <- queryInterfaceContractId @Holding alice senderChangeCid senderChange.lock === None WalletClient.checkHoldingApprox alice senderChangeCid (1000.0 - transfer.amount) @@ -194,8 +195,8 @@ test_happy_path_self = script do -- check holdings and rewards TransferInstructionResult_Completed [splitHoldingCid] <- pure result.output - WalletClient.checkHolding bob splitHoldingCid 10.0 - [changeHoldingCid] <- pure result.senderChangeCids + WalletClient.checkHolding bob (coerceInterfaceContractId splitHoldingCid) 10.0 + [changeHoldingCid] <- pure (map coerceInterfaceContractId result.senderChangeCids) WalletClient.checkHoldingApprox bob changeHoldingCid 40.0 expectBurn result.meta @@ -223,10 +224,10 @@ test_happy_path_direct = script do result <- submitWithDisclosures' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg TransferInstructionResult_Completed receiverHoldingCids <- pure result.output case result.senderChangeCids of - [holdingCid] -> WalletClient.checkHoldingApprox bob holdingCid 40.0 + [holdingCid] -> WalletClient.checkHoldingApprox bob (coerceInterfaceContractId holdingCid) 40.0 cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids) case receiverHoldingCids of - [holdingCid] -> WalletClient.checkHoldingApprox alice holdingCid 10.0 + [holdingCid] -> WalletClient.checkHoldingApprox alice (coerceInterfaceContractId holdingCid) 10.0 cids -> abort ("Unexpected number of receiverHoldingCids: " <> show cids) expectBurn result.meta @@ -262,7 +263,7 @@ test_two_step_success = do -- bob queries the pending transfer through their wallet aliceHoldings <- WalletClient.listHoldings alice registry.instrumentId [(bobInstrCid, bobInstrView)] <- WalletClient.listTransferOffers bob registry.instrumentId - bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ] + map coerceInterfaceContractId bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ] bobInstrCid === aliceInstrCid -- bob accepts the transfer @@ -274,10 +275,10 @@ test_two_step_success = do TransferInstructionResult_Completed receiverHoldingCids <- pure result.output case result.senderChangeCids of - [holdingCid] -> WalletClient.checkHoldingApprox alice holdingCid 1.0 + [holdingCid] -> WalletClient.checkHoldingApprox alice (coerceInterfaceContractId holdingCid) 1.0 cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids) case receiverHoldingCids of - [holdingCid] -> WalletClient.checkHoldingApprox bob holdingCid 10.0 + [holdingCid] -> WalletClient.checkHoldingApprox bob (coerceInterfaceContractId holdingCid) 10.0 cids -> abort ("Unexpected number of receiverHoldingCids: " <> show cids) expectBurn result.meta @@ -294,7 +295,7 @@ test_two_step_withdraw = do -- alice queries the pending transfer through their wallet [ lockedHolding ] <- WalletClient.listLockedHoldings alice registry.instrumentId [(aliceInstrCid, aliceInstrView)] <- WalletClient.listTransferOffers alice registry.instrumentId - aliceInstrView.transfer.inputHoldingCids === [ lockedHolding._1 ] + map coerceInterfaceContractId aliceInstrView.transfer.inputHoldingCids === [ lockedHolding._1 ] aliceInstrCid0 === aliceInstrCid -- alice rejects the transfer @@ -306,7 +307,7 @@ test_two_step_withdraw = do case result.senderChangeCids of - [holdingCid] -> WalletClient.checkHoldingApprox alice holdingCid 10.0 + [holdingCid] -> WalletClient.checkHoldingApprox alice (coerceInterfaceContractId holdingCid) 10.0 cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids) TransferInstructionResult_Failed === result.output @@ -323,11 +324,11 @@ test_two_step_withdraw_locked_amulet_gone = do -- alice queries the pending transfer through their wallet [ lockedHolding ] <- WalletClient.listLockedHoldings alice registry.instrumentId [(aliceInstrCid, aliceInstrView)] <- WalletClient.listTransferOffers alice registry.instrumentId - aliceInstrView.transfer.inputHoldingCids === [ lockedHolding._1 ] + map coerceInterfaceContractId aliceInstrView.transfer.inputHoldingCids === [ lockedHolding._1 ] aliceInstrCid0 === aliceInstrCid -- pass time and unlock the amulet as the alice - let [lockedCid] = aliceInstrView.transfer.inputHoldingCids + let [lockedCid] = map coerceInterfaceContractId aliceInstrView.transfer.inputHoldingCids setTime (aliceInstrView.transfer.executeBefore `addRelTime` days 1) AmuletRegistry.expireLockAsOwner registry lockedCid @@ -371,7 +372,7 @@ test_two_step_reject = do -- bob queries the pending transfer through their wallet aliceHoldings <- WalletClient.listHoldings alice registry.instrumentId [(bobInstrCid, bobInstrView)] <- WalletClient.listTransferOffers bob registry.instrumentId - bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ] + map coerceInterfaceContractId bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ] bobInstrCid === aliceInstrCid -- bob rejects the transfer @@ -382,7 +383,7 @@ test_two_step_reject = do meta = emptyMetadata case result.senderChangeCids of - [holdingCid] -> WalletClient.checkHoldingApprox alice holdingCid 10.0 + [holdingCid] -> WalletClient.checkHoldingApprox alice (coerceInterfaceContractId holdingCid) 10.0 cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids) result.output === TransferInstructionResult_Failed @@ -399,11 +400,11 @@ test_two_step_reject_locked_amulet_gone = do -- bob queries the pending transfer through their wallet aliceHoldings <- WalletClient.listHoldings alice registry.instrumentId [(bobInstrCid, bobInstrView)] <- WalletClient.listTransferOffers bob registry.instrumentId - bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ] + map coerceInterfaceContractId bobInstrView.transfer.inputHoldingCids === [ cid | (cid, holdingView) <- aliceHoldings, isSome (holdingView.lock) ] bobInstrCid === aliceInstrCid -- pass time and unlock the amulet as the owner - let [lockedCid] = bobInstrView.transfer.inputHoldingCids + let [lockedCid] = map coerceInterfaceContractId bobInstrView.transfer.inputHoldingCids setTime (bobInstrView.transfer.executeBefore `addRelTime` days 1) AmuletRegistry.expireLockAsOwner registry lockedCid diff --git a/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry.daml b/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry.daml index 1e2c84a58f..8a1715f8be 100644 --- a/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry.daml +++ b/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry.daml @@ -58,6 +58,14 @@ import Splice.Testing.TokenStandard.RegistryApi import Daml.Script +-- Utils to keep V1 alive +------------------------- + +-- | Shared definition of the instrument-id used for amulets. +amuletInstrumentIdV1 : Party -> InstrumentId +amuletInstrumentIdV1 dso = + InstrumentId with admin = dso; id = "Amulet" + -- Registry representation -------------------------- @@ -118,7 +126,7 @@ initialize config = do dso <- allocateParty "dso-party" let registry = AmuletRegistry with dso - instrumentId = amuletInstrumentId dso + instrumentId = amuletInstrumentIdV1 dso let amuletConfig | config.noTransferFee = defaultAmuletConfig with From 62941400182e854a1d6a9b74255b4b0b8325c7fc Mon Sep 17 00:00:00 2001 From: bame-da Date: Tue, 30 Sep 2025 19:27:30 +0000 Subject: [PATCH 03/11] V2-ify all the token standard packages & test --- build.sbt | 80 ++++- daml/splice-amulet/daml.yaml | 2 + daml/splice-wallet-test/daml.yaml | 4 +- .../daml.yaml | 21 ++ .../Api/Token/AllocationInstructionV2.daml | 175 +++++++++++ .../openapi/allocation-instruction-v1.yaml | 167 ++++++++++ .../openapi/docker-compose.yml | 18 ++ .../README.md | 8 + .../daml.yaml | 20 ++ .../Splice/Api/Token/AllocationRequestV2.daml | 65 ++++ .../splice-api-token-allocation-v2/daml.yaml | 2 +- .../daml/Splice/Api/Token/AllocationV2.daml | 18 +- .../splice-api-token-holding-v2/daml.yaml | 2 +- .../daml.yaml | 20 ++ .../Api/Token/TransferInstructionV2.daml | 224 ++++++++++++++ .../openapi/docker-compose.yml | 16 + .../openapi/transfer-instruction-v2yaml | 285 ++++++++++++++++++ .../splice-token-standard-test-v2/daml.yaml | 12 +- .../daml/Splice/Testing/Apps/TradingApp.daml | 6 +- .../Testing/Registries/AmuletRegistry.daml | 4 +- .../Testing/TokenStandard/RegistryApi.daml | 4 +- .../Testing/TokenStandard/WalletClient.daml | 25 +- .../daml/Splice/Tests/TestAmuletTokenDvP.daml | 4 +- .../Splice/Tests/TestAmuletTokenTransfer.daml | 8 +- 24 files changed, 1141 insertions(+), 49 deletions(-) create mode 100644 token-standard/splice-api-token-allocation-instruction-v2/daml.yaml create mode 100644 token-standard/splice-api-token-allocation-instruction-v2/daml/Splice/Api/Token/AllocationInstructionV2.daml create mode 100644 token-standard/splice-api-token-allocation-instruction-v2/openapi/allocation-instruction-v1.yaml create mode 100644 token-standard/splice-api-token-allocation-instruction-v2/openapi/docker-compose.yml create mode 100644 token-standard/splice-api-token-allocation-request-v2/README.md create mode 100644 token-standard/splice-api-token-allocation-request-v2/daml.yaml create mode 100644 token-standard/splice-api-token-allocation-request-v2/daml/Splice/Api/Token/AllocationRequestV2.daml create mode 100644 token-standard/splice-api-token-transfer-instruction-v2/daml.yaml create mode 100644 token-standard/splice-api-token-transfer-instruction-v2/daml/Splice/Api/Token/TransferInstructionV2.daml create mode 100644 token-standard/splice-api-token-transfer-instruction-v2/openapi/docker-compose.yml create mode 100644 token-standard/splice-api-token-transfer-instruction-v2/openapi/transfer-instruction-v2yaml diff --git a/build.sbt b/build.sbt index 97ece575c5..2e857520f8 100644 --- a/build.sbt +++ b/build.sbt @@ -113,10 +113,13 @@ lazy val root: Project = (project in file(".")) `splice-api-token-holding-v1-daml`, `splice-api-token-holding-v2-daml`, `splice-api-token-transfer-instruction-v1-daml`, + `splice-api-token-transfer-instruction-v2-daml`, `splice-api-token-allocation-v1-daml`, `splice-api-token-allocation-v2-daml`, `splice-api-token-allocation-request-v1-daml`, + `splice-api-token-allocation-request-v2-daml`, `splice-api-token-allocation-instruction-v1-daml`, + `splice-api-token-allocation-instruction-v2-daml`, `splice-api-token-burn-mint-v1-daml`, `splice-api-token-utils-v2-daml`, `splice-token-standard-test-daml`, @@ -236,10 +239,13 @@ lazy val docs = project (`splice-api-token-holding-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-transfer-instruction-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-request-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-instruction-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-burn-mint-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-utils-v2-daml` / Compile / damlBuild).value cacheDamlDocs( @@ -395,6 +401,37 @@ lazy val `splice-api-token-transfer-instruction-v1-daml` = ) .dependsOn(`canton-bindings-java`) +lazy val `splice-api-token-transfer-instruction-v2-daml` = + project + .in(file("token-standard/splice-api-token-transfer-instruction-v2")) + .enablePlugins(DamlPlugin) + .settings( + BuildCommon.damlSettings, + Compile / damlDependencies := + (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value, + templateDirectory := (`openapi-typescript-template` / patchTemplate).value, + Compile / sourceGenerators += + Def.taskDyn { + val transferInstructionOpenApiFile = + baseDirectory.value / "openapi/transfer-instruction-v2.yaml" + + val npmName = "transfer-instruction-openapi" + + BuildCommon.TS.generateOpenApiClient( + npmName = npmName, + npmModuleName = npmName, + npmProjectName = npmName, + openApiSpec = "transfer-instruction-v2.yaml", + cacheFileDependencies = Set(transferInstructionOpenApiFile), + directory = "openapi-ts-client", + subPath = "openapi", + ) + }, + cleanFiles += { baseDirectory.value / "openapi-ts-client" }, + ) + .dependsOn(`canton-bindings-java`) + lazy val `splice-api-token-allocation-v1-daml` = project .in(file("token-standard/splice-api-token-allocation-v1")) @@ -432,6 +469,19 @@ lazy val `splice-api-token-allocation-request-v1-daml` = ) .dependsOn(`canton-bindings-java`) +lazy val `splice-api-token-allocation-request-v2-daml` = + project + .in(file("token-standard/splice-api-token-allocation-request-v2")) + .enablePlugins(DamlPlugin) + .settings( + BuildCommon.damlSettings, + Compile / damlDependencies := + (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-transfer-instruction-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value, + ) + .dependsOn(`canton-bindings-java`) + lazy val `splice-api-token-allocation-instruction-v1-daml` = project .in(file("token-standard/splice-api-token-allocation-instruction-v1")) @@ -445,6 +495,19 @@ lazy val `splice-api-token-allocation-instruction-v1-daml` = ) .dependsOn(`canton-bindings-java`) +lazy val `splice-api-token-allocation-instruction-v2-daml` = + project + .in(file("token-standard/splice-api-token-allocation-instruction-v2")) + .enablePlugins(DamlPlugin) + .settings( + BuildCommon.damlSettings, + Compile / damlDependencies := + (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value, + ) + .dependsOn(`canton-bindings-java`) + lazy val `splice-api-token-burn-mint-v1-daml` = project .in(file("daml/splice-api-token-burn-mint-v1")) @@ -522,13 +585,11 @@ lazy val `splice-token-standard-test-v2-daml` = BuildCommon.damlSettings, Compile / damlDependencies := (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-holding-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value ++ - (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-transfer-instruction-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ - (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-request-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-instruction-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-utils-v2-daml` / Compile / damlBuild).value ++ (`splice-util-daml` / Compile / damlBuild).value ++ (`splice-amulet-daml` / Compile / damlBuild).value, @@ -750,10 +811,15 @@ lazy val `splice-amulet-daml` = (`splice-util-daml` / Compile / damlBuild).value ++ (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-holding-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-transfer-instruction-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-request-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-instruction-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-utils-v2-daml` / Compile / damlBuild).value ++ (`splice-featured-app-api-v1-daml` / Compile / damlBuild).value, ) @@ -851,8 +917,8 @@ lazy val `splice-wallet-daml` = (`splice-amulet-name-service-daml` / Compile / damlBuild).value ++ (`splice-util-daml` / Compile / damlBuild).value ++ (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value, + (`splice-api-token-transfer-instruction-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-request-v2-daml` / Compile / damlBuild).value, ) .dependsOn(`canton-bindings-java`) diff --git a/daml/splice-amulet/daml.yaml b/daml/splice-amulet/daml.yaml index 49a0a19e7e..c9f277d57f 100644 --- a/daml/splice-amulet/daml.yaml +++ b/daml/splice-amulet/daml.yaml @@ -15,9 +15,11 @@ data-dependencies: - ../../token-standard/splice-api-token-holding-v1/.daml/dist/splice-api-token-holding-v1-current.dar - ../../token-standard/splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar - ../../token-standard/splice-api-token-transfer-instruction-v1/.daml/dist/splice-api-token-transfer-instruction-v1-current.dar + - ../../token-standard/splice-api-token-transfer-instruction-v2/.daml/dist/splice-api-token-transfer-instruction-v2-current.dar - ../../token-standard/splice-api-token-allocation-v1/.daml/dist/splice-api-token-allocation-v1-current.dar - ../../token-standard/splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar - ../../token-standard/splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar + - ../../token-standard/splice-api-token-allocation-instruction-v2/.daml/dist/splice-api-token-allocation-instruction-v2-current.dar - ../splice-util/.daml/dist/splice-util-current.dar - ../splice-api-featured-app-v1/.daml/dist/splice-api-featured-app-v1-current.dar - ../../token-standard/splice-api-token-utils-v2/.daml/dist/splice-api-token-utils-v2-current.dar diff --git a/daml/splice-wallet-test/daml.yaml b/daml/splice-wallet-test/daml.yaml index 65ec55090b..ae5df6bd7b 100644 --- a/daml/splice-wallet-test/daml.yaml +++ b/daml/splice-wallet-test/daml.yaml @@ -15,9 +15,9 @@ data-dependencies: - ../../token-standard/examples/splice-token-test-trading-app/.daml/dist/splice-token-test-trading-app-current.dar - ../../token-standard/splice-token-standard-test/.daml/dist/splice-token-standard-test-current.dar - ../../token-standard/splice-token-standard-test-v2/.daml/dist/splice-token-standard-test-v2-current.dar -- ../../token-standard/splice-api-token-transfer-instruction-v1/.daml/dist/splice-api-token-transfer-instruction-v1-current.dar +- ../../token-standard/splice-api-token-transfer-instruction-v2/.daml/dist/splice-api-token-transfer-instruction-v2-current.dar - ../../token-standard/splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar -- ../../token-standard/splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar +- ../../token-standard/splice-api-token-allocation-instruction-v2/.daml/dist/splice-api-token-allocation-instruction-v2-current.dar - ../../token-standard/splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar - ../../token-standard/splice-api-token-utils-v2/.daml/dist/splice-api-token-utils-v2-current.dar diff --git a/token-standard/splice-api-token-allocation-instruction-v2/daml.yaml b/token-standard/splice-api-token-allocation-instruction-v2/daml.yaml new file mode 100644 index 0000000000..d8467dc67a --- /dev/null +++ b/token-standard/splice-api-token-allocation-instruction-v2/daml.yaml @@ -0,0 +1,21 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +sdk-version: 3.3.0-snapshot.20250502.13767.0.v2fc6c7e2 +name: splice-api-token-allocation-instruction-v2 +version: 2.0.0 +source: daml +dependencies: +- daml-prim +- daml-stdlib +data-dependencies: +- ../splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar +- ../splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar +- ../splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar +build-options: + - --target=2.1 +codegen: + java: + package-prefix: org.lfdecentralizedtrust.splice.codegen.java + decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceApiTokenAllocationInstructionV2 + output-directory: target/scala-2.13/src_managed/main/daml-codegen-java diff --git a/token-standard/splice-api-token-allocation-instruction-v2/daml/Splice/Api/Token/AllocationInstructionV2.daml b/token-standard/splice-api-token-allocation-instruction-v2/daml/Splice/Api/Token/AllocationInstructionV2.daml new file mode 100644 index 0000000000..e5ebc55acd --- /dev/null +++ b/token-standard/splice-api-token-allocation-instruction-v2/daml/Splice/Api/Token/AllocationInstructionV2.daml @@ -0,0 +1,175 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Interfaces to enable wallets to instruct the registry to create allocations. +module Splice.Api.Token.AllocationInstructionV2 where + +import DA.Map qualified as Map + +import Splice.Api.Token.MetadataV1 +import Splice.Api.Token.HoldingV2 +import Splice.Api.Token.AllocationV2 + + +-- AllocationInstruction +------------------------ + +-- | View for `AllocationInstruction`. +data AllocationInstructionView = AllocationInstructionView with + originalInstructionCid : Optional (ContractId AllocationInstruction) + -- ^ The contract id of the original allocation instruction contract. + -- Used by the wallet to track the lineage of allocation instructions through multiple steps. + -- + -- Only set if the registry evolves the allocation instruction in multiple steps. + allocation : AllocationSpecification + -- ^ The allocation that this instruction should create. + pendingActions : Map.Map Party Text + -- ^ The pending actions to be taken by different actors to create the allocation. + -- + -- ^ This field can by used to report on the progress of registry specific + -- workflows that are required to prepare the allocation. + requestedAt : Time + -- ^ The time at which the allocation was requested. + inputHoldingCids : [ContractId Holding] + -- ^ The holdings to be used to fund the allocation. + -- + -- MAY be empty for registries that do not represent their holdings on-ledger. + meta : Metadata + -- ^ Additional metadata specific to the allocation instruction, used for + -- extensibility; e.g., more detailed status information. + deriving (Show, Eq) + +-- | An interface for tracking the status of an allocation instruction, +-- i.e., a request to a registry app to create an allocation. +-- +-- Registries MAY evolve the allocation instruction in multiple steps. They SHOULD +-- do so using only the choices on this interface, so that wallets can reliably +-- parse the transaction history and determine whether the creation of the allocation ultimately +-- succeeded or failed. +interface AllocationInstruction where + viewtype AllocationInstructionView + + allocationInstruction_withdrawImpl : ContractId AllocationInstruction -> AllocationInstruction_Withdraw -> Update AllocationInstructionResult + allocationInstruction_updateImpl : ContractId AllocationInstruction -> AllocationInstruction_Update -> Update AllocationInstructionResult + + choice AllocationInstruction_Withdraw : AllocationInstructionResult + -- ^ Withdraw the allocation instruction as the sender. + with + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller allocationSenders (view this).allocation + do allocationInstruction_withdrawImpl this self arg + + choice AllocationInstruction_Update : AllocationInstructionResult + -- ^ Update the state of the allocation instruction. Used by the registry to + -- execute registry internal workflow steps that advance the state of the + -- allocation instruction. A reason may be communicated via the metadata. + with + extraActors : [Party] + -- ^ Extra actors authorizing the update. Implementations MUST check that + -- this field contains the expected actors for the specific update. + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller allocationAdmin (view this).allocation, extraActors + do allocationInstruction_updateImpl this self arg + + +-- AllocationFactory +-------------------- + +-- | View for `AllocationFactory`. +data AllocationFactoryView = AllocationFactoryView with + admin : Party + -- ^ The party representing the registry app that administers the instruments + -- for which this allocation factory can be used. + meta : Metadata + -- ^ Additional metadata specific to the allocation factory, used for extensibility. + deriving (Show, Eq) + +-- | Contracts implementing `AllocationFactory` are retrieved from the registry app and are +-- used by the wallet to create allocation instructions (or allocations directly). +interface AllocationFactory where + viewtype AllocationFactoryView + + allocationFactory_allocateImpl : ContractId AllocationFactory -> AllocationFactory_Allocate -> Update AllocationInstructionResult + allocationFactory_publicFetchImpl : ContractId AllocationFactory -> AllocationFactory_PublicFetch -> Update AllocationFactoryView + + nonconsuming choice AllocationFactory_Allocate : AllocationInstructionResult + -- ^ Generic choice for the sender's wallet to request the allocation of + -- assets to a specific leg of a settlement. It depends on the registry + -- whether this results in the allocation being created directly + -- or in an allocation instruction being created instead. + with + expectedAdmin : Party + -- ^ The expected admin party issuing the factory. Implementations MUST validate that this matches + -- the admin of the factory. + -- Callers should ensure they get `expectedAdmin` from a trusted source, e.g., a read against + -- their own participant. That way they can ensure that it is safe to exercise a choice + -- on a factory contract acquired from an untrusted source *provided* + -- all vetted Daml packages only contain interface implementations + -- that check the expected admin party. + allocation : AllocationSpecification + -- ^ The allocation which should be created. + requestedAt : Time + -- ^ The time at which the allocation was requested. + inputHoldingCids : [ContractId Holding] + -- ^ The holdings that SHOULD be used to fund the allocation. + -- + -- MAY be empty for registries that do not represent their holdings on-ledger; or + -- for registries that support automatic selection of holdings for allocations. + -- + -- If specified, then the successful allocation MUST archive all of these holdings, so + -- that the execution of the allocation conflicts with any other allocations + -- using these holdings. Thereby allowing that the sender can use + -- deliberate contention on holdings to prevent duplicate allocations. + extraArgs : ExtraArgs + -- ^ Additional choice arguments. + controller allocationSenders allocation + do allocationFactory_allocateImpl this self arg + + nonconsuming choice AllocationFactory_PublicFetch : AllocationFactoryView + with + expectedAdmin : Party + -- ^ The expected admin party issuing the factory. Implementations MUST validate that this matches + -- the admin of the factory. + -- Callers should ensure they get `expectedAdmin` from a trusted source, e.g., a read against + -- their own participant. That way they can ensure that it is safe to exercise a choice + -- on a factory contract acquired from an untrusted source *provided* + -- all vetted Daml packages only contain interface implementations + -- that check the expected admin party. + actor : Party + controller actor + do allocationFactory_publicFetchImpl this self arg + + +-- Result type +-------------- + +-- | The result of instructing an allocation or advancing the state of an allocation instruction. +data AllocationInstructionResult = AllocationInstructionResult with + output : AllocationInstructionResult_Output + -- ^ The output of the step. + senderChangeCids : [ContractId Holding] + -- ^ New holdings owned by the sender created to return "change". Can be used + -- by callers to batch creating or updating multiple allocation instructions + -- in a single Daml transaction. + meta : Metadata + -- ^ Additional metadata specific to the allocation instruction, used for extensibility; e.g., fees charged. + deriving (Show, Eq) + +-- | The output of instructing an allocation or advancing the state of an allocation instruction. +data AllocationInstructionResult_Output + = AllocationInstructionResult_Pending + -- ^ Use this result to communicate that the creation of the allocation is pending further steps. + with + allocationInstructionCid : ContractId AllocationInstruction + -- ^ Contract id of the allocation instruction representing the pending state. + | AllocationInstructionResult_Completed + -- ^ Use this result to communicate that the allocation was created. + with + allocationCid : ContractId Allocation + -- ^ The newly created allocation. + | AllocationInstructionResult_Failed + -- ^ Use this result to communicate that the creation of the allocation did not succeed and + -- all holdings reserved for funding the allocation have been released. + deriving (Show, Eq) diff --git a/token-standard/splice-api-token-allocation-instruction-v2/openapi/allocation-instruction-v1.yaml b/token-standard/splice-api-token-allocation-instruction-v2/openapi/allocation-instruction-v1.yaml new file mode 100644 index 0000000000..7d450eda71 --- /dev/null +++ b/token-standard/splice-api-token-allocation-instruction-v2/openapi/allocation-instruction-v1.yaml @@ -0,0 +1,167 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +openapi: 3.0.0 +info: + title: allocation instruction off-ledger API + description: | + Implemented by token registries for using and managing + allocation instructions by wallets. + version: 1.0.0 +paths: + + /registry/allocation-instruction/v1/allocation-factory: + post: + operationId: "getAllocationFactory" + description: | + Get the factory and choice context for creating allocations using the `AllocationFactory_Allocate` choice. + requestBody: + required: true + content: + application/json: + schema: + $ref: "#/components/schemas/GetFactoryRequest" + responses: + "200": + description: ok + content: + application/json: + schema: + $ref: "#/components/schemas/FactoryWithChoiceContext" + "400": + $ref: "#/components/responses/400" + "404": + $ref: "#/components/responses/404" + +components: + responses: + "400": + description: "bad request" + content: + application/json: + schema: + $ref: "#/components/schemas/ErrorResponse" + "404": + description: "not found" + content: + application/json: + schema: + $ref: "#/components/schemas/ErrorResponse" + + schemas: + # Note: intentionally not shared with the other APIs to keep the self-contained, and because not all OpenAPI codegens support such shared definitions. + GetFactoryRequest: + type: object + properties: + choiceArguments: + type: object + description: | + The arguments that are intended to be passed to the choice provided by the factory. + To avoid repeating the Daml type definitions, they are specified as JSON objects. + However the concrete format is given by how the choice arguments are encoded using the Daml JSON API + (with the `extraArgs.context` and `extraArgs.meta` fields set to the empty object). + + The choice arguments are provided so that the registry can also provide choice-argument + specific contracts, e.g., the configuration for a specific instrument-id. + excludeDebugFields: + description: "If set to true, the response will not include debug fields." + default: false + type: boolean + required: + [ + "choiceArguments", + ] + + FactoryWithChoiceContext: + description: | + A factory contract together with the choice context required to exercise the choice + provided by the factory. Typically used to implement the generic initiation of on-ledger workflows + via a Daml interface. + + Clients SHOULD avoid reusing the same `FactoryWithChoiceContext` for exercising multiple choices, + as the choice context MAY be specific to the choice being exercised. + type: object + properties: + factoryId: + description: "The contract ID of the contract implementing the factory interface." + type: string + choiceContext: + $ref: "#/components/schemas/ChoiceContext" + required: + [ + "factoryId", + "choiceContext", + ] + + ChoiceContext: + description: | + The context required to exercise a choice on a contract via an interface. + Used to retrieve additional reference date that is passed in via disclosed contracts, + which are in turn referred to via their contract ID in the `choiceContextData`. + type: object + properties: + choiceContextData: + description: "The additional data to use when exercising the choice." + type: object + disclosedContracts: + description: | + The contracts that are required to be disclosed to the participant node for exercising + the choice. + type: array + items: + $ref: "#/components/schemas/DisclosedContract" + required: + [ + "choiceContextData", + "disclosedContracts", + ] + + # Note: intentionally not shared with the other APIs to keep the self-contained, and because not all OpenAPI codegens support such shared definitions. + DisclosedContract: + type: object + properties: + templateId: + type: string + contractId: + type: string + createdEventBlob: + type: string + synchronizerId: + description: | + The synchronizer to which the contract is currently assigned. + If the contract is in the process of being reassigned, then a "409" response is returned. + type: string + debugPackageName: + description: | + The name of the Daml package that was used to create the contract. + Use this data only if you trust the provider, as it might not match the data in the + `createdEventBlob`. + type: string + debugPayload: + description: | + The contract arguments that were used to create the contract. + Use this data only if you trust the provider, as it might not match the data in the + `createdEventBlob`. + type: object + debugCreatedAt: + description: | + The ledger effective time at which the contract was created. + Use this data only if you trust the provider, as it might not match the data in the + `createdEventBlob`. + type: string + format: date-time + required: + [ + "templateId", + "contractId", + "createdEventBlob", + "synchronizerId" + ] + + ErrorResponse: + type: object + required: + - error + properties: + error: + type: string diff --git a/token-standard/splice-api-token-allocation-instruction-v2/openapi/docker-compose.yml b/token-standard/splice-api-token-allocation-instruction-v2/openapi/docker-compose.yml new file mode 100644 index 0000000000..a13f30d934 --- /dev/null +++ b/token-standard/splice-api-token-allocation-instruction-v2/openapi/docker-compose.yml @@ -0,0 +1,18 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +# Description: Docker compose file for running Swagger UI with the allocation-instruction OpenAPI specification. +# Usage: docker-compose up +version: '3.7' + +services: + swagger-ui: + image: swaggerapi/swagger-ui + ports: + - "8080:8080" + environment: + # TODO(DACH-NY/canton-network-node#86): split the standards into separate directories + # SWAGGER_JSON: /spec/allocation.yaml + SWAGGER_JSON: /spec/allocation-instruction.yaml + volumes: + - ./allocation-instruction.yaml:/spec/allocation-instruction.yaml diff --git a/token-standard/splice-api-token-allocation-request-v2/README.md b/token-standard/splice-api-token-allocation-request-v2/README.md new file mode 100644 index 0000000000..4e1d12b521 --- /dev/null +++ b/token-standard/splice-api-token-allocation-request-v2/README.md @@ -0,0 +1,8 @@ +# Allocation Request API v1 + +TODO(DACH-NY/canton-network-node#17944): flesh out this README + +Notes: +We need to consider whether want the choices on `AllocationRequest` to be called +with an empty choice-context to avoid app's to always have to provide an +off-ledger API to use the `AllocationRequest` API. diff --git a/token-standard/splice-api-token-allocation-request-v2/daml.yaml b/token-standard/splice-api-token-allocation-request-v2/daml.yaml new file mode 100644 index 0000000000..d9e6bd8829 --- /dev/null +++ b/token-standard/splice-api-token-allocation-request-v2/daml.yaml @@ -0,0 +1,20 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +sdk-version: 3.3.0-snapshot.20250502.13767.0.v2fc6c7e2 +name: splice-api-token-allocation-request-v2 +version: 2.0.0 +source: daml +dependencies: +- daml-prim +- daml-stdlib +data-dependencies: +- ../splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar +- ../splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar +build-options: + - --target=2.1 +codegen: + java: + package-prefix: org.lfdecentralizedtrust.splice.codegen.java + decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceApiTokenAllocationRequestV2 + output-directory: target/scala-2.13/src_managed/main/daml-codegen-java diff --git a/token-standard/splice-api-token-allocation-request-v2/daml/Splice/Api/Token/AllocationRequestV2.daml b/token-standard/splice-api-token-allocation-request-v2/daml/Splice/Api/Token/AllocationRequestV2.daml new file mode 100644 index 0000000000..daa374aeae --- /dev/null +++ b/token-standard/splice-api-token-allocation-request-v2/daml/Splice/Api/Token/AllocationRequestV2.daml @@ -0,0 +1,65 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | This module defines the interface for an `AllocationRequest`, which is an interface that can +-- be implemented by an app to request specific allocations from their users +-- for the purpose of settling a DvP or a payment as part of an app's workflow. +module Splice.Api.Token.AllocationRequestV2 where + +import DA.TextMap (TextMap) + +import Splice.Api.Token.MetadataV1 +import Splice.Api.Token.AllocationV2 + +-- | A request by an app for allocations to be created to enable the execution of a settlement. +-- +-- Apps are free to use a single request spanning all senders or one request per sender. +interface AllocationRequest where + viewtype AllocationRequestView + + allocationRequest_RejectImpl + : ContractId AllocationRequest -> AllocationRequest_Reject -> Update ChoiceExecutionMetadata + allocationRequest_WithdrawImpl + : ContractId AllocationRequest -> AllocationRequest_Withdraw -> Update ChoiceExecutionMetadata + + choice AllocationRequest_Reject : ChoiceExecutionMetadata + -- ^ Reject an allocation request. + -- + -- Implementations SHOULD allow any sender of a transfer leg to reject the allocation request, + -- and thereby signal that they are definitely not going to create a matching allocation for the settlement. + with + actor : Party -- ^ The party rejecting the allocation request. + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller actor + do allocationRequest_RejectImpl this self arg + + choice AllocationRequest_Withdraw : ChoiceExecutionMetadata + -- ^ Withdraw an allocation request as the executor. + -- + -- Used by executors to withdraw the allocation request if they are unable to execute it; + -- e.g., because a trade has been cancelled. + with + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller (view this).settlement.executor + do allocationRequest_WithdrawImpl this self arg + + +-- | View of `AllocationRequest`. +-- +-- Implementations SHOULD make sure that at least all senders of the transfer legs +-- are observers of the implementing contract, so that their wallet can show +-- the request to them. +data AllocationRequestView = AllocationRequestView with + settlement : SettlementInfo + -- ^ Settlement for which the assets are requested to be allocated. + transferLegs : TextMap TransferLeg + -- ^ Transfer legs that are requested to be allocated for the execution of the settlement + -- keyed by their identifier. + -- + -- This may or may not be a complete list of transfer legs that are part of the settlement, + -- depending on the confidentiality requirements of the app. + meta : Metadata + -- ^ Additional metadata specific to the allocation request, used for extensibility. + deriving (Show, Eq) diff --git a/token-standard/splice-api-token-allocation-v2/daml.yaml b/token-standard/splice-api-token-allocation-v2/daml.yaml index 93839bc85d..0315cd7978 100644 --- a/token-standard/splice-api-token-allocation-v2/daml.yaml +++ b/token-standard/splice-api-token-allocation-v2/daml.yaml @@ -16,5 +16,5 @@ build-options: codegen: java: package-prefix: org.lfdecentralizedtrust.splice.codegen.java - decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceApiTokenAllocationV1 + decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceApiTokenAllocationV2 output-directory: target/scala-2.13/src_managed/main/daml-codegen-java diff --git a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml index e560d0591c..6dc0ef6b1e 100644 --- a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml +++ b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml @@ -8,6 +8,7 @@ -- by an app. module Splice.Api.Token.AllocationV2 where +import DA.List (dedupSort) import DA.TextMap import Splice.Api.Token.MetadataV1 @@ -120,11 +121,18 @@ allocationControllers AllocationView{..} = (\override -> allocation.settlement.executor :: override) allocation.settlement.controllerOverride --- | Convenience function all senders -allocationSenders : AllocationView -> [Party] -allocationSenders AllocationView{..} = map (._2.sender) (toList allocation.transferLegs) - +-- | Convenience function to get all senders +allocationSenders : AllocationSpecification -> [Party] +allocationSenders AllocationSpecification{..} = map (._2.sender) (toList transferLegs) +-- | Convenience to get the allocation admin +allocationAdmin : AllocationSpecification -> Party +allocationAdmin AllocationSpecification{..} = admin + where + admins = dedupSort $ map (._2.instrumentId.admin) (toList transferLegs) + admin = case admins of + [a] -> a + _ -> error "Allocations must involve instruments from exactly one admin" -- | A contract representing an allocation of some amount of asset holdings to -- a specific leg of a settlement. @@ -178,7 +186,7 @@ interface Allocation where with extraArgs : ExtraArgs -- ^ Additional context required in order to exercise the choice. - controller allocationSenders (view this) + controller allocationSenders (view this).allocation do allocation_withdrawImpl this self arg -- AllocationTransferAuthorization diff --git a/token-standard/splice-api-token-holding-v2/daml.yaml b/token-standard/splice-api-token-holding-v2/daml.yaml index 8ac58f151c..b328a7806f 100644 --- a/token-standard/splice-api-token-holding-v2/daml.yaml +++ b/token-standard/splice-api-token-holding-v2/daml.yaml @@ -15,5 +15,5 @@ build-options: codegen: java: package-prefix: org.lfdecentralizedtrust.splice.codegen.java - decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceApiTokenHoldingV1 + decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceApiTokenHoldingV2 output-directory: target/scala-2.13/src_managed/main/daml-codegen-java diff --git a/token-standard/splice-api-token-transfer-instruction-v2/daml.yaml b/token-standard/splice-api-token-transfer-instruction-v2/daml.yaml new file mode 100644 index 0000000000..e24d490f38 --- /dev/null +++ b/token-standard/splice-api-token-transfer-instruction-v2/daml.yaml @@ -0,0 +1,20 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +sdk-version: 3.3.0-snapshot.20250502.13767.0.v2fc6c7e2 +name: splice-api-token-transfer-instruction-v2 +version: 2.0.0 +source: daml +dependencies: +- daml-prim +- daml-stdlib +data-dependencies: +- ../splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar +- ../splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar +build-options: + - --target=2.1 +codegen: + java: + package-prefix: org.lfdecentralizedtrust.splice.codegen.java + decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceApiTokenTransferInstructionV2 + output-directory: target/scala-2.13/src_managed/main/daml-codegen-java diff --git a/token-standard/splice-api-token-transfer-instruction-v2/daml/Splice/Api/Token/TransferInstructionV2.daml b/token-standard/splice-api-token-transfer-instruction-v2/daml/Splice/Api/Token/TransferInstructionV2.daml new file mode 100644 index 0000000000..5c1fd781a7 --- /dev/null +++ b/token-standard/splice-api-token-transfer-instruction-v2/daml/Splice/Api/Token/TransferInstructionV2.daml @@ -0,0 +1,224 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +-- | Instruct transfers of holdings between parties. +module Splice.Api.Token.TransferInstructionV2 where + +import qualified DA.Map as Map + +import Splice.Api.Token.MetadataV1 +import Splice.Api.Token.HoldingV2 + +-- | A specification of a transfer of holdings between parties parties. +data Transfer = Transfer with + sender : Party + -- ^ The sender of the transfer. + receiver : Party + -- ^ The receiver of the transfer. + amount : Decimal + -- ^ The amount to transfer. + instrumentId : InstrumentId + -- ^ The instrument identifier. + requestedAt : Time + -- ^ Wallet provided timestamp when the transfer was requested. + -- MUST be in the past when instructing the transfer. + executeBefore : Time + -- ^ Until when (exclusive) the transfer may be executed. MUST be in the + -- future when instructing the transfer. + -- + -- Registries SHOULD NOT execute the transfer instruction after this time, + -- so that senders can retry creating a new transfer instruction after this time. + inputHoldingCids : [ContractId Holding] + -- ^ The holding contracts that should be used to fund the transfer. + -- + -- MAY be empty if the registry supports automatic selection of holdings for transfers + -- or does not represent holdings on-ledger. + -- + -- If specified, then the transfer MUST archive all of these holdings, so + -- that the execution of the transfer conflicts with any other transfers + -- using these holdings. Thereby allowing that the sender can use + -- deliberate contention on holdings to prevent duplicate transfers. + meta : Metadata + -- ^ Metadata. + deriving (Show, Eq) + +-- | The result of instructing a transfer or advancing the state of a transfer instruction. +data TransferInstructionResult = TransferInstructionResult with + output : TransferInstructionResult_Output + -- ^ The output of the step. + senderChangeCids : [ContractId Holding] + -- ^ New holdings owned by the sender created to return "change". Can be used + -- by callers to batch creating or updating multiple transfer instructions + -- in a single Daml transaction. + meta : Metadata + -- ^ Additional metadata specific to the transfer instruction, used for extensibility; e.g., fees charged. + deriving (Show, Eq) + +-- | The output of instructing a transfer or advancing the state of a transfer instruction. +data TransferInstructionResult_Output + = TransferInstructionResult_Pending + -- ^ Use this result to communicate that the transfer is pending further steps. + with + transferInstructionCid : ContractId TransferInstruction + -- ^ Contract id of the transfer instruction representing the pending state. + | TransferInstructionResult_Completed + -- ^ Use this result to communicate that the transfer succeeded and the receiver + -- has received their holdings. + with + receiverHoldingCids : [ContractId Holding] + -- ^ The newly created holdings owned by the receiver as part of successfully + -- completing the transfer. + | TransferInstructionResult_Failed + -- ^ Use this result to communicate that the transfer did not succeed and all holdings (minus fees) + -- have been returned to the sender. + deriving (Show, Eq) + + +-- TransferInstruction +------------------------ + +-- | Status of a transfer instruction. +data TransferInstructionStatus + = TransferPendingReceiverAcceptance + -- ^ The transfer is pending acceptance by the receiver. + | TransferPendingInternalWorkflow + -- ^ The transfer is pending actions to be taken as part of registry internal workflows. + with + pendingActions : Map.Map Party Text + -- ^ The actions that a party could take to advance the transfer. + -- + -- This field can by used to inform wallet users whether they need to take an action or not. + deriving (Show, Eq) + +-- | View for `TransferInstruction`. +data TransferInstructionView = TransferInstructionView with + originalInstructionCid : Optional (ContractId TransferInstruction) + -- ^ The contract id of the original transfer instruction contract. + -- Used by the wallet to track the lineage of transfer instructions through multiple steps. + -- + -- Only set if the registry evolves the transfer instruction in multiple steps. + transfer : Transfer + -- ^ The transfer specified by the transfer instruction. + status : TransferInstructionStatus + -- ^ The status of the transfer instruction. + meta : Metadata + -- ^ Additional metadata specific to the transfer instruction, used for extensibility; e.g., more detailed status information. + deriving (Show, Eq) + +-- | An interface for tracking the status of a transfer instruction, +-- i.e., a request to a registry app to execute a transfer. +-- +-- Registries MAY evolve the transfer instruction in multiple steps. They SHOULD +-- do so using only the choices on this interface, so that wallets can reliably +-- parse the transaction history and determine whether the instruction ultimately +-- succeeded or failed. +interface TransferInstruction where + viewtype TransferInstructionView + + transferInstruction_acceptImpl : ContractId TransferInstruction -> TransferInstruction_Accept -> Update TransferInstructionResult + transferInstruction_rejectImpl : ContractId TransferInstruction -> TransferInstruction_Reject -> Update TransferInstructionResult + transferInstruction_withdrawImpl : ContractId TransferInstruction -> TransferInstruction_Withdraw -> Update TransferInstructionResult + transferInstruction_updateImpl : ContractId TransferInstruction -> TransferInstruction_Update -> Update TransferInstructionResult + + choice TransferInstruction_Accept : TransferInstructionResult + -- ^ Accept the transfer as the receiver. + -- + -- This choice is only available if the instruction is in + -- `TransferPendingReceiverAcceptance` state. + -- + -- Note that while implementations will typically return `TransferInstructionResult_Completed`, + -- this is not guaranteed. The result of the choice is implementation-specific and MAY + -- be any of the three possible results. + with + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller (view this).transfer.receiver + do transferInstruction_acceptImpl this self arg + + choice TransferInstruction_Reject : TransferInstructionResult + -- ^ Reject the transfer as the receiver. + -- + -- This choice is only available if the instruction is in + -- `TransferPendingReceiverAcceptance` state. + with + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller (view this).transfer.receiver + do transferInstruction_rejectImpl this self arg + + choice TransferInstruction_Withdraw : TransferInstructionResult + -- ^ Withdraw the transfer instruction as the sender. + with + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller (view this).transfer.sender + do transferInstruction_withdrawImpl this self arg + + choice TransferInstruction_Update : TransferInstructionResult + -- ^ Update the state of the transfer instruction. Used by the registry to + -- execute registry internal workflow steps that advance the state of the + -- transfer instruction. A reason may be communicated via the metadata. + with + extraActors : [Party] + -- ^ Extra actors authorizing the update. Implementations MUST check that + -- this field contains the expected actors for the specific update. + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + controller (view this).transfer.instrumentId.admin, extraActors + do transferInstruction_updateImpl this self arg + + +-- Transfer Factory +------------------- + +-- | A factory contract to instruct transfers of holdings between parties. +interface TransferFactory where + viewtype TransferFactoryView + + transferFactory_transferImpl : ContractId TransferFactory -> TransferFactory_Transfer -> Update TransferInstructionResult + transferFactory_publicFetchImpl : ContractId TransferFactory -> TransferFactory_PublicFetch -> Update TransferFactoryView + + nonconsuming choice TransferFactory_Transfer : TransferInstructionResult + -- ^ Instruct the registry to execute a transfer. + -- Implementations MUST ensure that this choice fails if `transfer.executeBefore` is in the past. + with + expectedAdmin : Party + -- ^ The expected admin party issuing the factory. Implementations MUST validate that this matches + -- the admin of the factory. + -- Callers SHOULD ensure they get `expectedAdmin` from a trusted source, e.g., a read against + -- their own participant. That way they can ensure that it is safe to exercise a choice + -- on a factory contract acquired from an untrusted source *provided* + -- all vetted Daml packages only contain interface implementations + -- that check the expected admin party. + transfer : Transfer + -- ^ The transfer to execute. + extraArgs : ExtraArgs + -- ^ The extra arguments to pass to the transfer implementation. + controller transfer.sender + do transferFactory_transferImpl this self arg + + nonconsuming choice TransferFactory_PublicFetch : TransferFactoryView + -- ^ Fetch the view of the factory contract. + with + expectedAdmin : Party + -- ^ The expected admin party issuing the factory. Implementations MUST validate that this matches + -- the admin of the factory. + -- Callers SHOULD ensure they get `expectedAdmin` from a trusted source, e.g., a read against + -- their own participant. That way they can ensure that it is safe to exercise a choice + -- on a factory contract acquired from an untrusted source *provided* + -- all vetted Daml packages only contain interface implementations + -- that check the expected admin party. + actor : Party + -- ^ The party fetching the contract. + controller actor + do transferFactory_publicFetchImpl this self arg + +-- | View for `TransferFactory`. +data TransferFactoryView = TransferFactoryView + with + admin : Party + -- ^ The party representing the registry app that administers the instruments for + -- which this transfer factory can be used. + meta : Metadata + -- ^ Additional metadata specific to the transfer factory, used for extensibility. + deriving (Show, Eq) diff --git a/token-standard/splice-api-token-transfer-instruction-v2/openapi/docker-compose.yml b/token-standard/splice-api-token-transfer-instruction-v2/openapi/docker-compose.yml new file mode 100644 index 0000000000..f95ce9e0ae --- /dev/null +++ b/token-standard/splice-api-token-transfer-instruction-v2/openapi/docker-compose.yml @@ -0,0 +1,16 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +# Description: Docker compose file for running Swagger UI with the transfer-instruction OpenAPI specification. +# Usage: docker-compose up +version: '3.7' + +services: + swagger-ui: + image: swaggerapi/swagger-ui + ports: + - "8080:8080" + environment: + SWAGGER_JSON: /spec/transfer-instruction.yaml + volumes: + - ./transfer-instruction.yaml:/spec/transfer-instruction.yaml diff --git a/token-standard/splice-api-token-transfer-instruction-v2/openapi/transfer-instruction-v2yaml b/token-standard/splice-api-token-transfer-instruction-v2/openapi/transfer-instruction-v2yaml new file mode 100644 index 0000000000..48104f96fe --- /dev/null +++ b/token-standard/splice-api-token-transfer-instruction-v2/openapi/transfer-instruction-v2yaml @@ -0,0 +1,285 @@ +# Copyright (c) 2025 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +openapi: 3.0.0 +info: + title: transfer instruction off-ledger API + description: | + Implemented by token registries for the purpose of supporting the initiation + of asset transfers; e.g. to settle off-ledger obligations. + version: 1.0.0 +paths: + + /registry/transfer-instruction/v1/transfer-factory: + post: + operationId: "getTransferFactory" + description: | + Get the factory and choice context for executing a direct transfer. + requestBody: + required: true + content: + application/json: + schema: + $ref: "#/components/schemas/GetFactoryRequest" + responses: + "200": + description: ok + content: + application/json: + schema: + $ref: "#/components/schemas/TransferFactoryWithChoiceContext" + "400": + $ref: "#/components/responses/400" + "404": + $ref: "#/components/responses/404" + + + /registry/transfer-instruction/v1/{transferInstructionId}/choice-contexts/accept: + post: + operationId: "getTransferInstructionAcceptContext" + description: | + Get the choice context to accept a transfer instruction. + parameters: + - name: transferInstructionId + description: "The contract ID of the transfer instruction to accept." + in: path + required: true + schema: + type: string + requestBody: + required: true + content: + application/json: + schema: + $ref: "#/components/schemas/GetChoiceContextRequest" + responses: + "200": + description: ok + content: + application/json: + schema: + $ref: "#/components/schemas/ChoiceContext" + "400": + $ref: "#/components/responses/400" + "404": + $ref: "#/components/responses/404" + + /registry/transfer-instruction/v1/{transferInstructionId}/choice-contexts/reject: + post: + operationId: "getTransferInstructionRejectContext" + description: | + Get the choice context to reject a transfer instruction. + parameters: + - name: transferInstructionId + description: "The contract ID of the transfer instruction to reject." + in: path + required: true + schema: + type: string + requestBody: + required: true + content: + application/json: + schema: + $ref: "#/components/schemas/GetChoiceContextRequest" + responses: + "200": + description: ok + content: + application/json: + schema: + $ref: "#/components/schemas/ChoiceContext" + "400": + $ref: "#/components/responses/400" + "404": + $ref: "#/components/responses/404" + + /registry/transfer-instruction/v1/{transferInstructionId}/choice-contexts/withdraw: + post: + operationId: "getTransferInstructionWithdrawContext" + description: | + Get the choice context to withdraw a transfer instruction. + parameters: + - name: transferInstructionId + description: "The contract ID of the transfer instruction to withdraw." + in: path + required: true + schema: + type: string + requestBody: + required: true + content: + application/json: + schema: + $ref: "#/components/schemas/GetChoiceContextRequest" + responses: + "200": + description: ok + content: + application/json: + schema: + $ref: "#/components/schemas/ChoiceContext" + "400": + $ref: "#/components/responses/400" + "404": + $ref: "#/components/responses/404" + +components: + responses: + "400": + description: "bad request" + content: + application/json: + schema: + $ref: "#/components/schemas/ErrorResponse" + "404": + description: "not found" + content: + application/json: + schema: + $ref: "#/components/schemas/ErrorResponse" + + schemas: + # Note: intentionally not shared with the other APIs to keep the self-contained, and because not all OpenAPI codegens support such shared definitions. + GetFactoryRequest: + type: object + properties: + choiceArguments: + type: object + description: | + The arguments that are intended to be passed to the choice provided by the factory. + To avoid repeating the Daml type definitions, they are specified as JSON objects. + However the concrete format is given by how the choice arguments are encoded using the Daml JSON API + (with the `extraArgs.context` and `extraArgs.meta` fields set to the empty object). + + The choice arguments are provided so that the registry can also provide choice-argument + specific contracts, e.g., the configuration for a specific instrument-id. + excludeDebugFields: + description: "If set to true, the response will not include debug fields." + default: false + type: boolean + required: + [ + "choiceArguments", + ] + + GetChoiceContextRequest: + description: | + A request to get the context for executing a choice on a contract. + type: object + properties: + meta: + description: | + Metadata that will be passed to the choice, and should be incorporated + into the choice context. Provided for extensibility. + type: object + additionalProperties: + type: string + + TransferFactoryWithChoiceContext: + description: | + The transfer factory contract together with the choice context required to exercise the choice + provided by the factory. Typically used to implement the generic initiation of on-ledger workflows + via a Daml interface. + + Clients SHOULD avoid reusing the same `FactoryWithChoiceContext` for exercising multiple choices, + as the choice context MAY be specific to the choice being exercised. + type: object + properties: + factoryId: + description: "The contract ID of the contract implementing the factory interface." + type: string + transferKind: + description: | + The kind of transfer workflow that will be used: + * `offer`: offer a transfer to the receiver and only transfer if they accept + * `direct`: transfer directly to the receiver without asking them for approval. + Only chosen if the receiver has pre-approved direct transfers. + * `self`: a self-transfer where the sender and receiver are the same party. + No approval is required, and the transfer is typically immediate. + type: string + enum: + - "self" + - "direct" + - "offer" + choiceContext: + $ref: "#/components/schemas/ChoiceContext" + required: + [ + "factoryId", + "choiceContext", + "transferKind", + ] + + ChoiceContext: + description: | + The context required to exercise a choice on a contract via an interface. + Used to retrieve additional reference data that is passed in via disclosed contracts, + which are in turn referred to via their contract ID in the `choiceContextData`. + type: object + properties: + choiceContextData: + description: "The additional data to use when exercising the choice." + type: object + disclosedContracts: + description: | + The contracts that are required to be disclosed to the participant node for exercising + the choice. + type: array + items: + $ref: "#/components/schemas/DisclosedContract" + required: + [ + "choiceContextData", + "disclosedContracts", + ] + + # Note: intentionally not shared with the other APIs to keep the self-contained, and because not all OpenAPI codegens support such shared definitions. + DisclosedContract: + type: object + properties: + templateId: + type: string + contractId: + type: string + createdEventBlob: + type: string + synchronizerId: + description: | + The synchronizer to which the contract is currently assigned. + If the contract is in the process of being reassigned, then a "409" response is returned. + type: string + debugPackageName: + description: | + The name of the Daml package that was used to create the contract. + Use this data only if you trust the provider, as it might not match the data in the + `createdEventBlob`. + type: string + debugPayload: + description: | + The contract arguments that were used to create the contract. + Use this data only if you trust the provider, as it might not match the data in the + `createdEventBlob`. + type: object + debugCreatedAt: + description: | + The ledger effective time at which the contract was created. + Use this data only if you trust the provider, as it might not match the data in the + `createdEventBlob`. + type: string + format: date-time + required: + [ + "templateId", + "contractId", + "createdEventBlob", + "synchronizerId" + ] + + ErrorResponse: + type: object + required: + - error + properties: + error: + type: string diff --git a/token-standard/splice-token-standard-test-v2/daml.yaml b/token-standard/splice-token-standard-test-v2/daml.yaml index 7fdc21249a..dd8ac4166b 100644 --- a/token-standard/splice-token-standard-test-v2/daml.yaml +++ b/token-standard/splice-token-standard-test-v2/daml.yaml @@ -23,11 +23,11 @@ dependencies: - daml-script data-dependencies: - ../splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar - - ../splice-api-token-holding-v1/.daml/dist/splice-api-token-holding-v1-current.dar - - ../splice-api-token-transfer-instruction-v1/.daml/dist/splice-api-token-transfer-instruction-v1-current.dar - - ../splice-api-token-allocation-v1/.daml/dist/splice-api-token-allocation-v1-current.dar - - ../splice-api-token-allocation-request-v1/.daml/dist/splice-api-token-allocation-request-v1-current.dar - - ../splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar + - ../splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar + - ../splice-api-token-transfer-instruction-v2/.daml/dist/splice-api-token-transfer-instruction-v2-current.dar + - ../splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar + - ../splice-api-token-allocation-request-v2/.daml/dist/splice-api-token-allocation-request-v2-current.dar + - ../splice-api-token-allocation-instruction-v2/.daml/dist/splice-api-token-allocation-instruction-v2-current.dar - ../../daml/splice-util/.daml/dist/splice-util-current.dar - ../../daml/splice-amulet/.daml/dist/splice-amulet-current.dar - ../splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar @@ -42,5 +42,5 @@ build-options: codegen: java: package-prefix: org.lfdecentralizedtrust.splice.codegen.java - decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceTokenTransferTest + decoderClass: org.lfdecentralizedtrust.splice.codegen.java.DecoderSpliceTokenTransferTestV2 output-directory: target/scala-2.13/src_managed/main/daml-codegen-java diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml index a30a0da70c..5fdce8f4e1 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml @@ -14,7 +14,7 @@ import DA.Traversable qualified as Traversable import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 -import Splice.Api.Token.AllocationRequestV1 +import Splice.Api.Token.AllocationRequestV2 import Splice.Api.Token.UtilsV2 @@ -152,7 +152,7 @@ template OTCTrade interface instance AllocationRequest for OTCTrade where view = AllocationRequestView with - settlement = settlement_info_v2_to_v1 $ SettlementInfo with + settlement = SettlementInfo with executor = venue requestedAt = createdAt settlementRef = makeTradeRef tradeCid @@ -160,7 +160,7 @@ template OTCTrade settleBefore meta = emptyMetadata controllerOverride = None - transferLegs = fmap transfer_leg_v2_to_v1 transferLegs + transferLegs meta = emptyMetadata allocationRequest_RejectImpl _self AllocationRequest_Reject{..} = do diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml index cd93e4aa8f..2b0fe681d2 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml @@ -37,8 +37,8 @@ import DA.Text qualified as T import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 import Splice.Api.Token.HoldingV2 as Api.Token.HoldingV2 import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 -import Splice.Api.Token.AllocationInstructionV1 -import Splice.Api.Token.TransferInstructionV1 +import Splice.Api.Token.AllocationInstructionV2 +import Splice.Api.Token.TransferInstructionV2 import Splice.Api.Token.UtilsV2 import Splice.Amulet diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml index f1456e5087..a2c88ce7d8 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml @@ -10,8 +10,8 @@ module Splice.Testing.TokenStandard.RegistryApi import Splice.Api.Token.MetadataV1 import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 -import Splice.Api.Token.AllocationInstructionV1 -import Splice.Api.Token.TransferInstructionV1 +import Splice.Api.Token.AllocationInstructionV2 +import Splice.Api.Token.TransferInstructionV2 import Splice.Testing.Utils diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml index b847345219..c86b905ede 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml @@ -32,9 +32,8 @@ import DA.Action (unless) import DA.Optional (isSome) import DA.TextMap qualified as TextMap -import Splice.Api.Token.AllocationV1 qualified as AllocationV1 -import Splice.Api.Token.TransferInstructionV1 qualified as TransferInstructionV1 -import Splice.Api.Token.AllocationRequestV1 qualified as AllocationRequestV1 +import Splice.Api.Token.TransferInstructionV2 qualified as TransferInstructionV2 +import Splice.Api.Token.AllocationRequestV2 qualified as AllocationRequestV2 import Splice.Api.Token.UtilsV2 import Splice.Api.Token.AllocationV2 qualified as AllocationV2 @@ -43,7 +42,6 @@ import Splice.Api.Token.HoldingV2 qualified as HoldingV2 import Daml.Script -- | List the hodlings of a party of a specific instrument. --- We always read as V1 and upcast as needed. listHoldings : Party -> HoldingV2.InstrumentId -> Script [(ContractId HoldingV2.Holding, HoldingV2.HoldingView)] listHoldings p instrumentId = do holdings <- queryInterface @HoldingV2.Holding p @@ -109,13 +107,13 @@ checkBalance p instrumentId balance = checkBalanceBounds p instrumentId (balance, balance) -- | List pending transfer offers (as sender or receiver) -listTransferOffers : Party -> HoldingV2.InstrumentId -> Script [(ContractId TransferInstructionV1.TransferInstruction, TransferInstructionV1.TransferInstructionView)] +listTransferOffers : Party -> HoldingV2.InstrumentId -> Script [(ContractId TransferInstructionV2.TransferInstruction, TransferInstructionV2.TransferInstructionView)] listTransferOffers p instrumentId = do - instrs <- queryInterface @TransferInstructionV1.TransferInstruction p + instrs <- queryInterface @TransferInstructionV2.TransferInstruction p let pendingOffers = do (cid, Some instr) <- instrs - guard (instr.transfer.instrumentId == instrumentId_v2_to_v1 instrumentId) - guard (instr.status == TransferInstructionV1.TransferPendingReceiverAcceptance) + guard (instr.transfer.instrumentId == instrumentId) + guard (instr.status == TransferInstructionV2.TransferPendingReceiverAcceptance) guard (p == instr.transfer.sender || p == instr.transfer.receiver) pure (cid, instr) pure pendingOffers @@ -123,17 +121,16 @@ listTransferOffers p instrumentId = do -- | List all allocations requested from the owner for a specific instrument. -- Currently targeting V1. -- TODO: Make this sensible. -listRequestedAllocations : Party -> HoldingV2.InstrumentId -> Script [AllocationV1.AllocationSpecification] +listRequestedAllocations : Party -> HoldingV2.InstrumentId -> Script [AllocationV2.AllocationSpecification] listRequestedAllocations p instrumentId = do - reqs <- queryInterface @AllocationRequestV1.AllocationRequest p + reqs <- queryInterface @AllocationRequestV2.AllocationRequest p trace reqs $ pure () let amuletAllocs = do (_reqCid, Some req) <- reqs (tfId, tf) <- TextMap.toList req.transferLegs - guard (tf.instrumentId == instrumentId_v2_to_v1 instrumentId) + guard (tf.instrumentId == instrumentId) guard (p == tf.sender) - pure AllocationV1.AllocationSpecification with + pure AllocationV2.AllocationSpecification with settlement = req.settlement - transferLegId = tfId - transferLeg = tf + transferLegs = TextMap.fromList [(tfId, tf)] pure amuletAllocs diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml index 0c5ec1fb0a..3de2276e4d 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml @@ -26,8 +26,8 @@ import DA.Traversable qualified as Traversable import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 import Splice.Api.Token.HoldingV2 import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 -import Splice.Api.Token.AllocationRequestV1 -import Splice.Api.Token.AllocationInstructionV1 +import Splice.Api.Token.AllocationRequestV2 +import Splice.Api.Token.AllocationInstructionV2 import Splice.Api.Token.UtilsV2 import Splice.Amulet diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml index a9d8a52a6f..8ab3c89d81 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml @@ -7,7 +7,7 @@ module Splice.Tests.TestAmuletTokenTransfer where import Splice.Api.Token.MetadataV1 import Splice.Api.Token.HoldingV2 -import Splice.Api.Token.TransferInstructionV1 as Api.Token.TransferInstructionV1 +import Splice.Api.Token.TransferInstructionV2 as Api.Token.TransferInstructionV2 import Splice.Api.Token.UtilsV2 import Daml.Script @@ -39,7 +39,7 @@ data TestSetup = TestSetup with aliceValidator : Party bob : Party now : Time - defaultTransfer : Api.Token.TransferInstructionV1.Transfer + defaultTransfer : Api.Token.TransferInstructionV2.Transfer setupTest : Script TestSetup setupTest = do @@ -104,7 +104,7 @@ setupTest = do -- Define default transfer from Bob to Alice let - defaultTransfer = Api.Token.TransferInstructionV1.Transfer with + defaultTransfer = Api.Token.TransferInstructionV2.Transfer with sender = bob receiver = alice amount = 10.0 @@ -496,4 +496,4 @@ test_factory_PublicFetch = do with expectedAdmin = registry.dso actor = alice - view === Api.Token.TransferInstructionV1.TransferFactoryView registry.dso emptyMetadata + view === Api.Token.TransferInstructionV2.TransferFactoryView registry.dso emptyMetadata From 7451a9c0915ff560cd72f2883293960ca3e5659a Mon Sep 17 00:00:00 2001 From: bame-da Date: Tue, 30 Sep 2025 20:15:14 +0000 Subject: [PATCH 04/11] Converters for allocation instruction/factory --- build.sbt | 3 +- .../splice-api-token-utils-v2/daml.yaml | 2 + .../daml/Splice/Api/Token/UtilsV2.daml | 111 ++++++++++++++++++ 3 files changed, 114 insertions(+), 2 deletions(-) diff --git a/build.sbt b/build.sbt index 2e857520f8..db0a61862c 100644 --- a/build.sbt +++ b/build.sbt @@ -553,8 +553,7 @@ lazy val `splice-api-token-utils-v2-daml` = (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ - (`splice-util-daml` / Compile / damlBuild).value ++ - (`splice-amulet-daml` / Compile / damlBuild).value, + (`splice-api-token-allocation-instruction-v2-daml` / Compile / damlBuild).value , ) .dependsOn(`canton-bindings-java`) diff --git a/token-standard/splice-api-token-utils-v2/daml.yaml b/token-standard/splice-api-token-utils-v2/daml.yaml index d1dda92bec..a87d3eaff5 100644 --- a/token-standard/splice-api-token-utils-v2/daml.yaml +++ b/token-standard/splice-api-token-utils-v2/daml.yaml @@ -14,6 +14,8 @@ data-dependencies: - ../splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar - ../splice-api-token-allocation-v1/.daml/dist/splice-api-token-allocation-v1-current.dar - ../splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar +- ../splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar +- ../splice-api-token-allocation-instruction-v2/.daml/dist/splice-api-token-allocation-instruction-v2-current.dar build-options: - --target=2.1 codegen: diff --git a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml index c64a5c8e7c..3e12c3abe6 100644 --- a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml +++ b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml @@ -13,6 +13,8 @@ import Splice.Api.Token.HoldingV1 qualified as HoldingV1 import Splice.Api.Token.HoldingV2 qualified as HoldingV2 import Splice.Api.Token.AllocationV1 qualified as AllocationV1 import Splice.Api.Token.AllocationV2 qualified as AllocationV2 +import Splice.Api.Token.AllocationInstructionV1 qualified as AllocationInstructionV1 +import Splice.Api.Token.AllocationInstructionV2 qualified as AllocationInstructionV2 -- Holding ---------- @@ -210,3 +212,112 @@ allocation_v1_cancelImpl this self AllocationV1.Allocation_Cancel{..} = do (coerceInterfaceContractId @AllocationV2.Allocation self) AllocationV2.Allocation_Cancel {..} return (allocation_cancel_result_v2_to_v1 resv2) + + +-- AllocationInstruction +------------------------ + +-- Upcast +allocation_instruction_view_v1_to_v2 : AllocationInstructionV1.AllocationInstructionView -> AllocationInstructionV2.AllocationInstructionView +allocation_instruction_view_v1_to_v2 AllocationInstructionV1.AllocationInstructionView{..} = + AllocationInstructionV2.AllocationInstructionView with + originalInstructionCid = fmap coerceInterfaceContractId originalInstructionCid + allocation = allocation_specification_v1_to_v2 allocation + pendingActions + requestedAt + inputHoldingCids = map coerceInterfaceContractId inputHoldingCids + meta + +-- Downcast +allocation_instruction_view_v2_to_v1 : AllocationInstructionV2.AllocationInstructionView -> AllocationInstructionV1.AllocationInstructionView +allocation_instruction_view_v2_to_v1 AllocationInstructionV2.AllocationInstructionView{..} = + AllocationInstructionV1.AllocationInstructionView with + originalInstructionCid = fmap coerceInterfaceContractId originalInstructionCid + allocation = allocation_specification_v2_to_v1 allocation + pendingActions + requestedAt + inputHoldingCids = map coerceInterfaceContractId inputHoldingCids + meta + +-- Choices + +allocation_instruction_result_output_v2_to_v1 : AllocationInstructionV2.AllocationInstructionResult_Output -> AllocationInstructionV1.AllocationInstructionResult_Output +allocation_instruction_result_output_v2_to_v1 iro = + case iro of + AllocationInstructionV2.AllocationInstructionResult_Pending cid -> + AllocationInstructionV1.AllocationInstructionResult_Pending (coerceInterfaceContractId cid) + AllocationInstructionV2.AllocationInstructionResult_Completed cid -> + AllocationInstructionV1.AllocationInstructionResult_Completed (coerceInterfaceContractId cid) + AllocationInstructionV2.AllocationInstructionResult_Failed -> + AllocationInstructionV1.AllocationInstructionResult_Failed + +allocation_instruction_result_v2_to_v1 : AllocationInstructionV2.AllocationInstructionResult -> AllocationInstructionV1.AllocationInstructionResult +allocation_instruction_result_v2_to_v1 AllocationInstructionV2.AllocationInstructionResult{..} = + AllocationInstructionV1.AllocationInstructionResult with + output = allocation_instruction_result_output_v2_to_v1 output + senderChangeCids = map coerceInterfaceContractId senderChangeCids + meta + +allocationInstruction_v1_withdrawImpl : AllocationInstructionV2.AllocationInstruction -> ContractId AllocationInstructionV1.AllocationInstruction -> AllocationInstructionV1.AllocationInstruction_Withdraw -> Update AllocationInstructionV1.AllocationInstructionResult +allocationInstruction_v1_withdrawImpl this self AllocationInstructionV1.AllocationInstruction_Withdraw{..} = do + resv2 <- AllocationInstructionV2.allocationInstruction_withdrawImpl + this + (coerceInterfaceContractId @AllocationInstructionV2.AllocationInstruction self) + AllocationInstructionV2.AllocationInstruction_Withdraw {..} + return (allocation_instruction_result_v2_to_v1 resv2) + + +allocationInstruction_v1_updateImpl : AllocationInstructionV2.AllocationInstruction -> ContractId AllocationInstructionV1.AllocationInstruction -> AllocationInstructionV1.AllocationInstruction_Update -> Update AllocationInstructionV1.AllocationInstructionResult +allocationInstruction_v1_updateImpl this self AllocationInstructionV1.AllocationInstruction_Update{..} = do + resv2 <- AllocationInstructionV2.allocationInstruction_updateImpl + this + (coerceInterfaceContractId @AllocationInstructionV2.AllocationInstruction self) + AllocationInstructionV2.AllocationInstruction_Update {..} + return (allocation_instruction_result_v2_to_v1 resv2) + + +-- AllocationFactory +--------------------- + +-- Upcast +allocation_factory_view_v1_to_v2 : AllocationInstructionV1.AllocationFactoryView -> AllocationInstructionV2.AllocationFactoryView +allocation_factory_view_v1_to_v2 AllocationInstructionV1.AllocationFactoryView{..} = + AllocationInstructionV2.AllocationFactoryView with + admin + meta + +-- Downcast +allocation_factory_view_v2_to_v1 : AllocationInstructionV2.AllocationFactoryView -> AllocationInstructionV1.AllocationFactoryView +allocation_factory_view_v2_to_v1 AllocationInstructionV2.AllocationFactoryView{..} = + AllocationInstructionV1.AllocationFactoryView with + admin + meta + +-- Choices + +allocation_factory_allocate_v1_to_v2 : AllocationInstructionV1.AllocationFactory_Allocate -> AllocationInstructionV2.AllocationFactory_Allocate +allocation_factory_allocate_v1_to_v2 AllocationInstructionV1.AllocationFactory_Allocate{..} = + AllocationInstructionV2.AllocationFactory_Allocate with + expectedAdmin + allocation = allocation_specification_v1_to_v2 allocation + requestedAt + inputHoldingCids = map coerceInterfaceContractId inputHoldingCids + extraArgs + +allocationFactory_v1_allocateImpl : AllocationInstructionV2.AllocationFactory -> ContractId AllocationInstructionV1.AllocationFactory -> AllocationInstructionV1.AllocationFactory_Allocate -> Update AllocationInstructionV1.AllocationInstructionResult +allocationFactory_v1_allocateImpl this self alloc = do + resv2 <- AllocationInstructionV2.allocationFactory_allocateImpl + this + (coerceInterfaceContractId @AllocationInstructionV2.AllocationFactory self) + (allocation_factory_allocate_v1_to_v2 alloc) + return (allocation_instruction_result_v2_to_v1 resv2) + + +allocationFactory_v1_publicFetchImpl : AllocationInstructionV2.AllocationFactory -> ContractId AllocationInstructionV1.AllocationFactory -> AllocationInstructionV1.AllocationFactory_PublicFetch -> Update AllocationInstructionV1.AllocationFactoryView +allocationFactory_v1_publicFetchImpl this self AllocationInstructionV1.AllocationFactory_PublicFetch{..} = do + resv2 <- AllocationInstructionV2.allocationFactory_publicFetchImpl + this + (coerceInterfaceContractId @AllocationInstructionV2.AllocationFactory self) + AllocationInstructionV2.AllocationFactory_PublicFetch {..} + return (allocation_factory_view_v2_to_v1 resv2) + From c3ec30ab58a2bc3b5e20f35e565e9211bee03636 Mon Sep 17 00:00:00 2001 From: bame-da Date: Tue, 30 Sep 2025 20:23:02 +0000 Subject: [PATCH 05/11] Implement V2 AllocationFactory on Amulet --- .../daml/Splice/ExternalPartyAmuletRules.daml | 36 ++++++++++++------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml index a727f4590e..6125a7c41b 100644 --- a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml @@ -11,7 +11,8 @@ import qualified DA.TextMap as TextMap import Splice.Api.Token.MetadataV1 import Splice.Api.Token.TransferInstructionV1 qualified as Api.Token.TransferInstructionV1 -import Splice.Api.Token.AllocationInstructionV1 as Api.Token.AllocationInstructionV1 +import Splice.Api.Token.AllocationInstructionV1 qualified as AllocationInstructionV1 +import Splice.Api.Token.AllocationInstructionV2 as AllocationInstructionV2 import Splice.Api.Token.UtilsV2 @@ -83,7 +84,14 @@ template ExternalPartyAmuletRules allocationFactory_allocateImpl self arg = amulet_allocationFactory_allocateImpl this self arg allocationFactory_publicFetchImpl _self arg = do requireExpectedAdminMatch arg.expectedAdmin dso - pure (view $ toInterface @Api.Token.AllocationInstructionV1.AllocationFactory this) + pure (view $ toInterface @AllocationFactory this) + + interface instance AllocationInstructionV1.AllocationFactory for ExternalPartyAmuletRules where + view = allocation_factory_view_v2_to_v1 (view (toInterface @AllocationFactory this)) + + AllocationInstructionV1.allocationFactory_allocateImpl = allocationFactory_v1_allocateImpl (toInterface @AllocationFactory this) + AllocationInstructionV1.allocationFactory_publicFetchImpl = allocationFactory_v1_publicFetchImpl (toInterface @AllocationFactory this) + data ExternalPartyAmuletRules_CreateTransferCommandResult = ExternalPartyAmuletRules_CreateTransferCommandResult with @@ -367,7 +375,7 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do -- == validate each field of the requested allocation let settlement = allocation.settlement - let transferLeg = allocation.transferLeg + let transferLegs = allocation.transferLegs -- settlement.executor: no check -- settlement.settlementRef: no check @@ -378,15 +386,17 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do -- settlement.settleBefore: require "Allocation.settlement.allocateBefore <= Allocation.settlement.settleBefore" (settlement.allocateBefore <= settlement.settleBefore) - -- transferLegId: no check + forA_ transferLegs (\transferLeg -> do + -- transferLegId: no check - -- transferLeg.sender: no check - -- transferLeg.receiver: nothing to check - -- transferLeg.amount - require "Transfer amount must be positive" (transferLeg.amount > 0.0) - -- transferLeg.instrumentId - require "Instrument-id must match the factory" (instrumentId_v1_to_v2 transferLeg.instrumentId == amuletInstrumentId dso) - -- transferLeg.meta: no check + -- transferLeg.sender: no check + -- transferLeg.receiver: nothing to check + -- transferLeg.amount + require "Transfer amount must be positive" (transferLeg.amount > 0.0) + -- transferLeg.instrumentId + require "Instrument-id must match the factory" (transferLeg.instrumentId == amuletInstrumentId dso) + -- transferLeg.meta: no check + ) -- requestedAt (of the allocation instruction itself): assertDeadlineExceeded "requestedAt" requestedAt @@ -395,12 +405,12 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do require "At least one input holding must be provided" (not $ null inputHoldingCids) -- lock the funds - let twoStepTransfer = allocationToTwoStepTransfer (allocation_specification_v1_to_v2 arg.allocation) + let twoStepTransfer = allocationToTwoStepTransfer arg.allocation (lockedAmulet, senderChangeCids, meta) <- prepareTwoStepTransfer twoStepTransfer arg.requestedAt (map coerceInterfaceContractId inputHoldingCids) paymentContext -- create the amulet allocation allocationCid <- toInterfaceContractId <$> create AmuletAllocation with - allocation = allocation_specification_v1_to_v2 arg.allocation + allocation = arg.allocation lockedAmulet -- finaly done: return the result From cae8c1d91dcdfc01ef4a990d835f69e17e086594 Mon Sep 17 00:00:00 2001 From: bame-da Date: Wed, 1 Oct 2025 09:01:54 +0000 Subject: [PATCH 06/11] Thread v2 factories/instructions through Amulet --- build.sbt | 15 +- .../Splice/AmuletTransferInstruction.daml | 19 ++- .../daml/Splice/ExternalPartyAmuletRules.daml | 57 ++++--- daml/splice-amulet/daml/Splice/Types.daml | 2 +- daml/splice-wallet-test/daml.yaml | 5 +- .../daml/Splice/Scripts/TestWallet.daml | 49 +++--- daml/splice-wallet/daml.yaml | 4 +- .../daml/Splice/Wallet/Install.daml | 45 +++-- .../splice-api-token-utils-v2/daml.yaml | 3 + .../daml/Splice/Api/Token/UtilsV2.daml | 154 +++++++++++++++++- .../splice-token-standard-test-v2/daml.yaml | 1 - .../{TradingApp.daml => TradingAppV2.daml} | 3 +- ...letRegistry.daml => AmuletRegistryV2.daml} | 9 +- .../Parameters.daml | 2 +- .../{RegistryApi.daml => RegistryApiV2.daml} | 4 +- ...{WalletClient.daml => WalletClientV2.daml} | 3 +- .../Testing/{Utils.daml => UtilsV2.daml} | 2 +- .../daml/Splice/Tests/TestAmuletTokenDvP.daml | 23 +-- .../Splice/Tests/TestAmuletTokenTransfer.daml | 11 +- 19 files changed, 296 insertions(+), 115 deletions(-) rename token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/{TradingApp.daml => TradingAppV2.daml} (99%) rename token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/{AmuletRegistry.daml => AmuletRegistryV2.daml} (98%) rename token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/{AmuletRegistry => AmuletRegistryV2}/Parameters.daml (98%) rename token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/{RegistryApi.daml => RegistryApiV2.daml} (95%) rename token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/{WalletClient.daml => WalletClientV2.daml} (98%) rename token-standard/splice-token-standard-test-v2/daml/Splice/Testing/{Utils.daml => UtilsV2.daml} (99%) diff --git a/build.sbt b/build.sbt index db0a61862c..0f16717006 100644 --- a/build.sbt +++ b/build.sbt @@ -553,7 +553,9 @@ lazy val `splice-api-token-utils-v2-daml` = (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-allocation-instruction-v2-daml` / Compile / damlBuild).value , + (`splice-api-token-allocation-instruction-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-transfer-instruction-v2-daml` / Compile / damlBuild).value , ) .dependsOn(`canton-bindings-java`) @@ -589,7 +591,6 @@ lazy val `splice-token-standard-test-v2-daml` = (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-request-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v2-daml` / Compile / damlBuild).value ++ - (`splice-api-token-utils-v2-daml` / Compile / damlBuild).value ++ (`splice-util-daml` / Compile / damlBuild).value ++ (`splice-amulet-daml` / Compile / damlBuild).value, ) @@ -917,6 +918,7 @@ lazy val `splice-wallet-daml` = (`splice-util-daml` / Compile / damlBuild).value ++ (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-transfer-instruction-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-instruction-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-request-v2-daml` / Compile / damlBuild).value, ) .dependsOn(`canton-bindings-java`) @@ -954,7 +956,14 @@ lazy val `splice-wallet-test-daml` = .enablePlugins(DamlPlugin) .settings( BuildCommon.damlSettings, - Compile / damlDependencies := (`splice-amulet-test-daml` / Compile / damlBuild).value ++ (`splice-wallet-daml` / Compile / damlBuild).value, + Compile / damlDependencies := + (`splice-amulet-test-daml` / Compile / damlBuild).value ++ + (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value ++ + (`splice-token-standard-test-daml` / Compile / damlBuild).value ++ + (`splice-token-standard-test-v2-daml` / Compile / damlBuild).value ++ + (`splice-wallet-daml` / Compile / damlBuild).value, Compile / damlEnableJavaCodegen := false, ) .dependsOn(`canton-bindings-java`) diff --git a/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml b/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml index 711322ad16..f2b3db3fe4 100644 --- a/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml +++ b/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml @@ -7,7 +7,9 @@ module Splice.AmuletTransferInstruction ( ) where import Splice.Api.Token.MetadataV1 -import Splice.Api.Token.TransferInstructionV1 +import Splice.Api.Token.TransferInstructionV1 qualified as TransferInstructionV1 +import Splice.Api.Token.TransferInstructionV2 +import Splice.Api.Token.UtilsV2 import Splice.Amulet import Splice.Amulet.TwoStepTransfer @@ -17,7 +19,7 @@ import Splice.Amulet.TwoStepTransfer template AmuletTransferInstruction with lockedAmulet : ContractId LockedAmulet -- ^ Locked amulet that holds the funds for executing the transfer upon acceptance - transfer : Splice.Api.Token.TransferInstructionV1.Transfer + transfer : Splice.Api.Token.TransferInstructionV2.Transfer where signatory transfer.instrumentId.admin, transfer.sender observer transfer.receiver @@ -41,11 +43,22 @@ template AmuletTransferInstruction transferInstruction_withdrawImpl _self arg = do abortAmuletTransferInstruction this arg.extraArgs + interface instance TransferInstructionV1.TransferInstruction for AmuletTransferInstruction where + view = transfer_instruction_view_v2_to_v1 (view (toInterface @TransferInstruction this)) + + TransferInstructionV1.transferInstruction_acceptImpl = transferInstruction_v1_acceptImpl (toInterface @TransferInstruction this) + TransferInstructionV1.transferInstruction_rejectImpl = transferInstruction_v1_rejectImpl (toInterface @TransferInstruction this) + TransferInstructionV1.transferInstruction_updateImpl = transferInstruction_v1_updateImpl (toInterface @TransferInstruction this) + TransferInstructionV1.transferInstruction_withdrawImpl = transferInstruction_v1_withdrawImpl (toInterface @TransferInstruction this) + + + + -- Transfer instruction evolution --------------------------------- -standardTransferToTwoStepTransfer : Splice.Api.Token.TransferInstructionV1.Transfer-> TwoStepTransfer +standardTransferToTwoStepTransfer : Splice.Api.Token.TransferInstructionV2.Transfer-> TwoStepTransfer standardTransferToTwoStepTransfer transfer = TwoStepTransfer with dso = transfer.instrumentId.admin diff --git a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml index 6125a7c41b..12e147ad6f 100644 --- a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml @@ -10,7 +10,8 @@ import DA.Optional import qualified DA.TextMap as TextMap import Splice.Api.Token.MetadataV1 -import Splice.Api.Token.TransferInstructionV1 qualified as Api.Token.TransferInstructionV1 +import Splice.Api.Token.TransferInstructionV1 qualified as TransferInstructionV1 +import Splice.Api.Token.TransferInstructionV2 qualified as TransferInstructionV2 import Splice.Api.Token.AllocationInstructionV1 qualified as AllocationInstructionV1 import Splice.Api.Token.AllocationInstructionV2 as AllocationInstructionV2 import Splice.Api.Token.UtilsV2 @@ -66,15 +67,21 @@ template ExternalPartyAmuletRules description pure (ExternalPartyAmuletRules_CreateTransferCommandResult cmd) - interface instance Api.Token.TransferInstructionV1.TransferFactory for ExternalPartyAmuletRules where - view = Api.Token.TransferInstructionV1.TransferFactoryView with + interface instance TransferInstructionV2.TransferFactory for ExternalPartyAmuletRules where + view = TransferInstructionV2.TransferFactoryView with admin = dso meta = emptyMetadata transferFactory_transferImpl self arg = amulet_transferFactory_transferImpl this self arg transferFactory_publicFetchImpl _self arg = do requireExpectedAdminMatch arg.expectedAdmin dso - pure (view $ toInterface @Api.Token.TransferInstructionV1.TransferFactory this) + pure (view $ toInterface @TransferInstructionV2.TransferFactory this) + + interface instance TransferInstructionV1.TransferFactory for ExternalPartyAmuletRules where + view = transfer_factory_view_v2_to_v1 (view (toInterface @TransferInstructionV2.TransferFactory this)) + + transferFactory_transferImpl = transferFactory_v1_transferImpl (toInterface @TransferInstructionV2.TransferFactory this) + transferFactory_publicFetchImpl = transferFactory_v1_publicFetchImpl (toInterface @TransferInstructionV2.TransferFactory this) interface instance AllocationFactory for ExternalPartyAmuletRules where view = AllocationFactoryView with @@ -89,8 +96,8 @@ template ExternalPartyAmuletRules interface instance AllocationInstructionV1.AllocationFactory for ExternalPartyAmuletRules where view = allocation_factory_view_v2_to_v1 (view (toInterface @AllocationFactory this)) - AllocationInstructionV1.allocationFactory_allocateImpl = allocationFactory_v1_allocateImpl (toInterface @AllocationFactory this) - AllocationInstructionV1.allocationFactory_publicFetchImpl = allocationFactory_v1_publicFetchImpl (toInterface @AllocationFactory this) + allocationFactory_allocateImpl = allocationFactory_v1_allocateImpl (toInterface @AllocationFactory this) + allocationFactory_publicFetchImpl = allocationFactory_v1_publicFetchImpl (toInterface @AllocationFactory this) data ExternalPartyAmuletRules_CreateTransferCommandResult = ExternalPartyAmuletRules_CreateTransferCommandResult @@ -257,11 +264,11 @@ data TransferCommand_ExpireResult = TransferCommand_ExpireResult amulet_transferFactory_transferImpl : ExternalPartyAmuletRules - -> ContractId Api.Token.TransferInstructionV1.TransferFactory - -> Api.Token.TransferInstructionV1.TransferFactory_Transfer - -> Update Api.Token.TransferInstructionV1.TransferInstructionResult + -> ContractId TransferInstructionV2.TransferFactory + -> TransferInstructionV2.TransferFactory_Transfer + -> Update TransferInstructionV2.TransferInstructionResult amulet_transferFactory_transferImpl this _self arg = do - let Api.Token.TransferInstructionV1.TransferFactory_Transfer {transfer, extraArgs} = arg + let TransferInstructionV2.TransferFactory_Transfer {transfer, extraArgs} = arg let dso = this.dso -- validate call to factory and retrieve context requireExpectedAdminMatch arg.expectedAdmin dso @@ -276,7 +283,7 @@ amulet_transferFactory_transferImpl this _self arg = do let expectedInstrumentId = amuletInstrumentId this.dso require ("Expected instrumentId " <> show expectedInstrumentId <> " matches actual instrumentId " <> show transfer.instrumentId) - (expectedInstrumentId == instrumentId_v1_to_v2 transfer.instrumentId) -- TODO - remove + (expectedInstrumentId == transfer.instrumentId) -- TODO - remove -- amount: require "Amount must be positive" (transfer.amount > 0.0) -- requestedAt: @@ -294,7 +301,7 @@ amulet_transferFactory_transferImpl this _self arg = do | transfer.receiver == transfer.sender -> do -- execute a self-transfer paymentContext <- unfeaturedPaymentContextFromChoiceContext dso extraArgs.context - inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext (map coerceInterfaceContractId transfer.inputHoldingCids) + inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext transfer.inputHoldingCids result <- exercisePaymentTransfer paymentContext Transfer with sender = transfer.sender provider = transfer.sender @@ -305,10 +312,10 @@ amulet_transferFactory_transferImpl this _self arg = do receiverFeeRatio = 0.0 lock = None ] beneficiaries = None - pure Api.Token.TransferInstructionV1.TransferInstructionResult with + pure TransferInstructionV2.TransferInstructionResult with senderChangeCids = toInterfaceContractId <$> optionalToList result.senderChangeAmulet - output = Api.Token.TransferInstructionV1.TransferInstructionResult_Completed with - receiverHoldingCids = map coerceInterfaceContractId $ createdAmuletToHolding <$> result.createdAmulets + output = TransferInstructionV2.TransferInstructionResult_Completed with + receiverHoldingCids = createdAmuletToHolding <$> result.createdAmulets meta = copyOnlyBurnMeta result.meta | otherwise -> do @@ -316,16 +323,16 @@ amulet_transferFactory_transferImpl this _self arg = do let twoStepTransfer = standardTransferToTwoStepTransfer arg.transfer let requestedAt = arg.transfer.requestedAt paymentContext <- unfeaturedPaymentContextFromChoiceContext dso extraArgs.context - (lockedAmulet, senderChangeCids, meta) <- prepareTwoStepTransfer twoStepTransfer requestedAt (map coerceInterfaceContractId arg.transfer.inputHoldingCids) paymentContext + (lockedAmulet, senderChangeCids, meta) <- prepareTwoStepTransfer twoStepTransfer requestedAt arg.transfer.inputHoldingCids paymentContext -- create the transfer instruction tracking this locked amulet transferInstructionCid <- toInterfaceContractId <$> create AmuletTransferInstruction with transfer = arg.transfer with inputHoldingCids = [toInterfaceContractId lockedAmulet] -- report the locked holding backing the transfer lockedAmulet -- return result - pure Api.Token.TransferInstructionV1.TransferInstructionResult with - senderChangeCids = map coerceInterfaceContractId senderChangeCids - output = Api.Token.TransferInstructionV1.TransferInstructionResult_Pending + pure TransferInstructionV2.TransferInstructionResult with + senderChangeCids = senderChangeCids + output = TransferInstructionV2.TransferInstructionResult_Pending with transferInstructionCid meta @@ -334,7 +341,7 @@ amulet_transferFactory_transferImpl this _self arg = do -- use a payment context with featuring so the preapproval provider can be featured paymentContext <- paymentFromChoiceContext dso extraArgs.context -- execute a direct transfer - inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext (map coerceInterfaceContractId transfer.inputHoldingCids) + inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext transfer.inputHoldingCids result <- exercise preapprovalCid TransferPreapproval_Send with sender = transfer.sender @@ -344,10 +351,10 @@ amulet_transferFactory_transferImpl this _self arg = do description = reason -- return result - pure Api.Token.TransferInstructionV1.TransferInstructionResult with + pure TransferInstructionV2.TransferInstructionResult with senderChangeCids = toInterfaceContractId <$> optionalToList result.result.senderChangeAmulet - output = Api.Token.TransferInstructionV1.TransferInstructionResult_Completed with - receiverHoldingCids = map coerceInterfaceContractId $ createdAmuletToHolding <$> result.result.createdAmulets + output = TransferInstructionV2.TransferInstructionResult_Completed with + receiverHoldingCids = createdAmuletToHolding <$> result.result.createdAmulets meta = copyOnlyBurnMeta result.meta @@ -407,7 +414,7 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do -- lock the funds let twoStepTransfer = allocationToTwoStepTransfer arg.allocation (lockedAmulet, senderChangeCids, meta) <- - prepareTwoStepTransfer twoStepTransfer arg.requestedAt (map coerceInterfaceContractId inputHoldingCids) paymentContext + prepareTwoStepTransfer twoStepTransfer arg.requestedAt inputHoldingCids paymentContext -- create the amulet allocation allocationCid <- toInterfaceContractId <$> create AmuletAllocation with allocation = arg.allocation @@ -415,7 +422,7 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do -- finaly done: return the result pure AllocationInstructionResult with - senderChangeCids = map coerceInterfaceContractId senderChangeCids + senderChangeCids output = AllocationInstructionResult_Completed with allocationCid meta diff --git a/daml/splice-amulet/daml/Splice/Types.daml b/daml/splice-amulet/daml/Splice/Types.daml index fcbdebb7c8..54ea0c6c41 100644 --- a/daml/splice-amulet/daml/Splice/Types.daml +++ b/daml/splice-amulet/daml/Splice/Types.daml @@ -6,7 +6,7 @@ module Splice.Types where import Splice.Api.Token.AllocationV2 import Splice.Api.Token.HoldingV2 -import Splice.Api.Token.TransferInstructionV1 +import Splice.Api.Token.TransferInstructionV2 import Splice.Util (HasCheckedFetch(..)) import DA.TextMap qualified as TextMap diff --git a/daml/splice-wallet-test/daml.yaml b/daml/splice-wallet-test/daml.yaml index ae5df6bd7b..5cc9b97536 100644 --- a/daml/splice-wallet-test/daml.yaml +++ b/daml/splice-wallet-test/daml.yaml @@ -15,11 +15,14 @@ data-dependencies: - ../../token-standard/examples/splice-token-test-trading-app/.daml/dist/splice-token-test-trading-app-current.dar - ../../token-standard/splice-token-standard-test/.daml/dist/splice-token-standard-test-current.dar - ../../token-standard/splice-token-standard-test-v2/.daml/dist/splice-token-standard-test-v2-current.dar +- ../../token-standard/splice-token-standard-test/.daml/dist/splice-token-standard-test-current.dar +- ../../token-standard/splice-api-token-transfer-instruction-v1/.daml/dist/splice-api-token-transfer-instruction-v1-current.dar - ../../token-standard/splice-api-token-transfer-instruction-v2/.daml/dist/splice-api-token-transfer-instruction-v2-current.dar - ../../token-standard/splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar +- ../../token-standard/splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar - ../../token-standard/splice-api-token-allocation-instruction-v2/.daml/dist/splice-api-token-allocation-instruction-v2-current.dar +- ../../token-standard/splice-api-token-allocation-v1/.daml/dist/splice-api-token-allocation-v1-current.dar - ../../token-standard/splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar -- ../../token-standard/splice-api-token-utils-v2/.daml/dist/splice-api-token-utils-v2-current.dar build-options: - --ghc-option=-Wunused-binds diff --git a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml index e58b81537a..0773109739 100644 --- a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml +++ b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml @@ -26,18 +26,17 @@ import Splice.Wallet.TransferPreapproval import Splice.Scripts.Wallet.TestSubscriptions import Splice.Fees import Splice.Scripts.Util -import Splice.Testing.Utils -import Splice.Testing.Registries.AmuletRegistry.Parameters -import Splice.Testing.Registries.AmuletRegistry qualified as AmuletRegistry -import Splice.Testing.TokenStandard.RegistryApi qualified as RegistryApi +import Splice.Testing.UtilsV2 +import Splice.Testing.Registries.AmuletRegistryV2.Parameters +import Splice.Testing.Registries.AmuletRegistryV2 qualified as AmuletRegistry +import Splice.Testing.TokenStandard.RegistryApiV2 qualified as RegistryApi import qualified Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 -import qualified Splice.Api.Token.AllocationInstructionV1 as Api.Token.AllocationInstructionV1 -import Splice.Api.Token.TransferInstructionV1 (TransferFactory_Transfer(..)) -import qualified Splice.Api.Token.TransferInstructionV1 as Api.Token.TransferInstructionV1 +import qualified Splice.Api.Token.AllocationInstructionV2 as Api.Token.AllocationInstructionV2 +import Splice.Api.Token.TransferInstructionV2 (TransferFactory_Transfer(..)) +import qualified Splice.Api.Token.TransferInstructionV2 as Api.Token.TransferInstructionV2 import Splice.Api.Token.MetadataV1 -import Splice.Api.Token.UtilsV2 -import Splice.Testing.Apps.TradingApp -import Splice.Testing.TokenStandard.WalletClient qualified as WalletClient +import Splice.Testing.Apps.TradingAppV2 +import Splice.Testing.TokenStandard.WalletClientV2 qualified as WalletClient createPaymentRequest : AmuletApp -> Party -> Party -> [(Party, PaymentAmount)] -> Script (ContractId AppPaymentRequest) createPaymentRequest app provider sender receiverAmounts = do @@ -1004,11 +1003,11 @@ testTokenStandardTransfer = script do now <- getTime let - defaultTransfer = Api.Token.TransferInstructionV1.Transfer with + defaultTransfer = Api.Token.TransferInstructionV2.Transfer with sender = alice receiver = bob amount = 10.0 - instrumentId = instrumentId_v2_to_v1 registry.instrumentId + instrumentId = registry.instrumentId requestedAt = now executeBefore = now `addRelTime` days 1 inputHoldingCids = [] @@ -1027,60 +1026,60 @@ testTokenStandardTransfer = script do result <- submitMulti [aliceValidator] [alice, registry.dso] $ exerciseCmd aliceInstall WalletAppInstall_TransferFactory_Transfer with transferFactoryCid = enrichedChoice.factoryCid transferArg = enrichedChoice.arg - Api.Token.TransferInstructionV1.TransferInstructionResult_Pending aliceInstrCid <- pure result.output + Api.Token.TransferInstructionV2.TransferInstructionResult_Pending aliceInstrCid <- pure result.output let change1 = result.senderChangeCids context <- RegistryApi.getTransferInstruction_WithdrawContext registry aliceInstrCid emptyMetadata result <- submitMulti [aliceValidator] [alice, registry.dso] $ exerciseCmd aliceInstall WalletAppInstall_TransferInstruction_Withdraw with transferInstructionCid = aliceInstrCid - withdrawArg = Api.Token.TransferInstructionV1.TransferInstruction_Withdraw with + withdrawArg = Api.Token.TransferInstructionV2.TransferInstruction_Withdraw with extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata - Api.Token.TransferInstructionV1.TransferInstructionResult_Failed === result.output + Api.Token.TransferInstructionV2.TransferInstructionResult_Failed === result.output let change2 = result.senderChangeCids result <- submitMulti [aliceValidator] [alice, registry.dso] $ exerciseCmd aliceInstall WalletAppInstall_TransferFactory_Transfer with transferFactoryCid = enrichedChoice.factoryCid - transferArg = Api.Token.TransferInstructionV1.TransferFactory_Transfer with + transferArg = Api.Token.TransferInstructionV2.TransferFactory_Transfer with expectedAdmin = registry.dso transfer = enrichedChoice.arg.transfer with inputHoldingCids = change1 ++ change2 extraArgs = enrichedChoice.arg.extraArgs - Api.Token.TransferInstructionV1.TransferInstructionResult_Pending aliceInstrCid <- pure result.output + Api.Token.TransferInstructionV2.TransferInstructionResult_Pending aliceInstrCid <- pure result.output let change3 = result.senderChangeCids result <- submitMulti [bobValidator] [bob, registry.dso] $ exerciseCmd bobInstall WalletAppInstall_TransferInstruction_Reject with transferInstructionCid = aliceInstrCid - rejectArg = Api.Token.TransferInstructionV1.TransferInstruction_Reject with + rejectArg = Api.Token.TransferInstructionV2.TransferInstruction_Reject with extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata - Api.Token.TransferInstructionV1.TransferInstructionResult_Failed === result.output + Api.Token.TransferInstructionV2.TransferInstructionResult_Failed === result.output let change4 = result.senderChangeCids result <- submitMulti [aliceValidator] [alice, registry.dso] $ exerciseCmd aliceInstall WalletAppInstall_TransferFactory_Transfer with transferFactoryCid = enrichedChoice.factoryCid - transferArg = Api.Token.TransferInstructionV1.TransferFactory_Transfer with + transferArg = Api.Token.TransferInstructionV2.TransferFactory_Transfer with expectedAdmin = registry.dso transfer = enrichedChoice.arg.transfer with inputHoldingCids = change3 ++ change4 extraArgs = enrichedChoice.arg.extraArgs - Api.Token.TransferInstructionV1.TransferInstructionResult_Pending aliceInstrCid <- pure result.output + Api.Token.TransferInstructionV2.TransferInstructionResult_Pending aliceInstrCid <- pure result.output context <- RegistryApi.getTransferInstruction_AcceptContext registry aliceInstrCid emptyMetadata result <- submitMulti [bobValidator] [bob, registry.dso] $ exerciseCmd bobInstall WalletAppInstall_TransferInstruction_Accept with transferInstructionCid = aliceInstrCid - acceptArg = Api.Token.TransferInstructionV1.TransferInstruction_Accept with + acceptArg = Api.Token.TransferInstructionV2.TransferInstruction_Accept with extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata - Api.Token.TransferInstructionV1.TransferInstructionResult_Completed _ <- pure result.output + Api.Token.TransferInstructionV2.TransferInstructionResult_Completed _ <- pure result.output pure () @@ -1127,7 +1126,7 @@ testTokenStandardAllocate = script do holdingCid <- AmuletRegistry.tapFaucet registry alice 200.0 - enrichedChoice <- RegistryApi.getAllocationFactory registry Api.Token.AllocationInstructionV1.AllocationFactory_Allocate with + enrichedChoice <- RegistryApi.getAllocationFactory registry Api.Token.AllocationInstructionV2.AllocationFactory_Allocate with expectedAdmin = registry.dso allocation = aliceAlloc inputHoldingCids = [coerceInterfaceContractId holdingCid] @@ -1138,7 +1137,7 @@ testTokenStandardAllocate = script do allocationFactory = enrichedChoice.factoryCid allocateArg = enrichedChoice.arg - Api.Token.AllocationInstructionV1.AllocationInstructionResult_Completed allocationCid <- pure result.output + Api.Token.AllocationInstructionV2.AllocationInstructionResult_Completed allocationCid <- pure result.output context <- RegistryApi.getAllocation_WithdrawContext registry (coerceInterfaceContractId allocationCid) emptyMetadata diff --git a/daml/splice-wallet/daml.yaml b/daml/splice-wallet/daml.yaml index 67b2ce6379..a646810655 100644 --- a/daml/splice-wallet/daml.yaml +++ b/daml/splice-wallet/daml.yaml @@ -8,8 +8,8 @@ dependencies: data-dependencies: - ../../token-standard/splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar - ../../token-standard/splice-api-token-metadata-v1/.daml/dist/splice-api-token-metadata-v1-current.dar -- ../../token-standard/splice-api-token-transfer-instruction-v1/.daml/dist/splice-api-token-transfer-instruction-v1-current.dar -- ../../token-standard/splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar +- ../../token-standard/splice-api-token-transfer-instruction-v2/.daml/dist/splice-api-token-transfer-instruction-v2-current.dar +- ../../token-standard/splice-api-token-allocation-instruction-v2/.daml/dist/splice-api-token-allocation-instruction-v2-current.dar - ../../token-standard/splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar - ../../token-standard/splice-api-token-utils-v2/.daml/dist/splice-api-token-utils-v2-current.dar - ../splice-amulet/.daml/dist/splice-amulet-current.dar diff --git a/daml/splice-wallet/daml/Splice/Wallet/Install.daml b/daml/splice-wallet/daml/Splice/Wallet/Install.daml index 5a4b66d56a..fd5decc747 100644 --- a/daml/splice-wallet/daml/Splice/Wallet/Install.daml +++ b/daml/splice-wallet/daml/Splice/Wallet/Install.daml @@ -12,9 +12,8 @@ import DA.Foldable (forA_) import DA.Optional (isSome) import qualified Splice.Api.Token.AllocationV2 -import qualified Splice.Api.Token.AllocationInstructionV1 -import qualified Splice.Api.Token.TransferInstructionV1 -import Splice.Api.Token.UtilsV2 +import qualified Splice.Api.Token.AllocationInstructionV2 +import qualified Splice.Api.Token.TransferInstructionV2 import Splice.Amulet import Splice.AmuletAllocation (allocationSender) import Splice.Amulet.TokenApiUtils @@ -587,41 +586,41 @@ template WalletAppInstall -- This is a dedicated choice rather than going through AmuletOperation as it behaves a bit differently than all the other operations: -- 1. We cannot use rewards as inputs. -- 2. We can use expired locked amulets as inputs. - nonconsuming choice WalletAppInstall_TransferFactory_Transfer : Splice.Api.Token.TransferInstructionV1.TransferInstructionResult + nonconsuming choice WalletAppInstall_TransferFactory_Transfer : Splice.Api.Token.TransferInstructionV2.TransferInstructionResult with - transferFactoryCid : ContractId Splice.Api.Token.TransferInstructionV1.TransferFactory - transferArg : Splice.Api.Token.TransferInstructionV1.TransferFactory_Transfer + transferFactoryCid : ContractId Splice.Api.Token.TransferInstructionV2.TransferFactory + transferArg : Splice.Api.Token.TransferInstructionV2.TransferFactory_Transfer controller validatorParty do let transfer = transferArg.transfer require ("sender " <> show transfer.sender <> " is endUserParty " <> show endUserParty) (transfer.sender == endUserParty) - require ("instrumentId " <> show transfer.instrumentId <> " is amuletInstrumentId " <> show (amuletInstrumentId dsoParty)) (instrumentId_v1_to_v2 transfer.instrumentId == amuletInstrumentId dsoParty) + require ("instrumentId " <> show transfer.instrumentId <> " is amuletInstrumentId " <> show (amuletInstrumentId dsoParty)) (transfer.instrumentId == amuletInstrumentId dsoParty) require ("expected admin " <> show transferArg.expectedAdmin <> " is dso " <> show dsoParty) (transferArg.expectedAdmin == dsoParty) exercise transferFactoryCid transferArg - nonconsuming choice WalletAppInstall_TransferInstruction_Accept : Splice.Api.Token.TransferInstructionV1.TransferInstructionResult + nonconsuming choice WalletAppInstall_TransferInstruction_Accept : Splice.Api.Token.TransferInstructionV2.TransferInstructionResult with - transferInstructionCid : ContractId Splice.Api.Token.TransferInstructionV1.TransferInstruction - acceptArg : Splice.Api.Token.TransferInstructionV1.TransferInstruction_Accept + transferInstructionCid : ContractId Splice.Api.Token.TransferInstructionV2.TransferInstruction + acceptArg : Splice.Api.Token.TransferInstructionV2.TransferInstruction_Accept controller validatorParty do instruction <- fetchCheckedInterface (ForDso dsoParty) transferInstructionCid let receiver = (view instruction).transfer.receiver require ("receiver " <> show receiver <> " must match endUserParty " <> show endUserParty) (receiver == endUserParty) exercise transferInstructionCid acceptArg - nonconsuming choice WalletAppInstall_TransferInstruction_Reject : Splice.Api.Token.TransferInstructionV1.TransferInstructionResult + nonconsuming choice WalletAppInstall_TransferInstruction_Reject : Splice.Api.Token.TransferInstructionV2.TransferInstructionResult with - transferInstructionCid : ContractId Splice.Api.Token.TransferInstructionV1.TransferInstruction - rejectArg : Splice.Api.Token.TransferInstructionV1.TransferInstruction_Reject + transferInstructionCid : ContractId Splice.Api.Token.TransferInstructionV2.TransferInstruction + rejectArg : Splice.Api.Token.TransferInstructionV2.TransferInstruction_Reject controller validatorParty do instruction <- fetchCheckedInterface (ForDso dsoParty) transferInstructionCid let receiver = (view instruction).transfer.receiver require ("receiver " <> show receiver <> " must match endUserParty " <> show endUserParty) (receiver == endUserParty) exercise transferInstructionCid rejectArg - nonconsuming choice WalletAppInstall_TransferInstruction_Withdraw : Splice.Api.Token.TransferInstructionV1.TransferInstructionResult + nonconsuming choice WalletAppInstall_TransferInstruction_Withdraw : Splice.Api.Token.TransferInstructionV2.TransferInstructionResult with - transferInstructionCid : ContractId Splice.Api.Token.TransferInstructionV1.TransferInstruction - withdrawArg : Splice.Api.Token.TransferInstructionV1.TransferInstruction_Withdraw + transferInstructionCid : ContractId Splice.Api.Token.TransferInstructionV2.TransferInstruction + withdrawArg : Splice.Api.Token.TransferInstructionV2.TransferInstruction_Withdraw controller validatorParty do instruction <- fetchCheckedInterface (ForDso dsoParty) transferInstructionCid let sender = (view instruction).transfer.sender @@ -631,16 +630,16 @@ template WalletAppInstall -- This is a dedicated choice rather than going through AmuletOperation as it behaves a bit differently than all the other operations: -- 1. We cannot use rewards as inputs. -- 2. We can use expired locked amulets as inputs. - nonconsuming choice WalletAppInstall_AllocationFactory_Allocate : Splice.Api.Token.AllocationInstructionV1.AllocationInstructionResult + nonconsuming choice WalletAppInstall_AllocationFactory_Allocate : Splice.Api.Token.AllocationInstructionV2.AllocationInstructionResult with - allocationFactory : ContractId Splice.Api.Token.AllocationInstructionV1.AllocationFactory - allocateArg : Splice.Api.Token.AllocationInstructionV1.AllocationFactory_Allocate + allocationFactory : ContractId Splice.Api.Token.AllocationInstructionV2.AllocationFactory + allocateArg : Splice.Api.Token.AllocationInstructionV2.AllocationFactory_Allocate controller validatorParty do require ("expected admin " <> show allocateArg.expectedAdmin <> " is dso " <> show dsoParty) (allocateArg.expectedAdmin == dsoParty) - let sender = allocateArg.allocation.transferLeg.sender - require ("sender " <> show sender <> " is endUserParty " <> show endUserParty) (sender == endUserParty) - let legInstrumentId = allocateArg.allocation.transferLeg.instrumentId - require ("instrumentId " <> show legInstrumentId <> " is amuletInstrumentId " <> show (amuletInstrumentId dsoParty)) (instrumentId_v1_to_v2 legInstrumentId == amuletInstrumentId dsoParty) + forA_ allocateArg.allocation.transferLegs (\Splice.Api.Token.AllocationV2.TransferLeg{sender; instrumentId} -> do + require ("sender " <> show sender <> " is endUserParty " <> show endUserParty) (sender == endUserParty) + require ("instrumentId " <> show instrumentId <> " is amuletInstrumentId " <> show (amuletInstrumentId dsoParty)) (instrumentId == amuletInstrumentId dsoParty) + ) exercise allocationFactory allocateArg nonconsuming choice WalletAppInstall_Allocation_Withdraw : Splice.Api.Token.AllocationV2.Allocation_WithdrawResult diff --git a/token-standard/splice-api-token-utils-v2/daml.yaml b/token-standard/splice-api-token-utils-v2/daml.yaml index a87d3eaff5..a4471426aa 100644 --- a/token-standard/splice-api-token-utils-v2/daml.yaml +++ b/token-standard/splice-api-token-utils-v2/daml.yaml @@ -16,6 +16,9 @@ data-dependencies: - ../splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar - ../splice-api-token-allocation-instruction-v1/.daml/dist/splice-api-token-allocation-instruction-v1-current.dar - ../splice-api-token-allocation-instruction-v2/.daml/dist/splice-api-token-allocation-instruction-v2-current.dar +- ../splice-api-token-transfer-instruction-v1/.daml/dist/splice-api-token-transfer-instruction-v1-current.dar +- ../splice-api-token-transfer-instruction-v2/.daml/dist/splice-api-token-transfer-instruction-v2-current.dar + build-options: - --target=2.1 codegen: diff --git a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml index 3e12c3abe6..068a004a6a 100644 --- a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml +++ b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml @@ -15,6 +15,8 @@ import Splice.Api.Token.AllocationV1 qualified as AllocationV1 import Splice.Api.Token.AllocationV2 qualified as AllocationV2 import Splice.Api.Token.AllocationInstructionV1 qualified as AllocationInstructionV1 import Splice.Api.Token.AllocationInstructionV2 qualified as AllocationInstructionV2 +import Splice.Api.Token.TransferInstructionV1 qualified as TransferInstructionV1 +import Splice.Api.Token.TransferInstructionV2 qualified as TransferInstructionV2 -- Holding ---------- @@ -277,7 +279,7 @@ allocationInstruction_v1_updateImpl this self AllocationInstructionV1.Allocation -- AllocationFactory ---------------------- +-------------------- -- Upcast allocation_factory_view_v1_to_v2 : AllocationInstructionV1.AllocationFactoryView -> AllocationInstructionV2.AllocationFactoryView @@ -321,3 +323,153 @@ allocationFactory_v1_publicFetchImpl this self AllocationInstructionV1.Allocatio AllocationInstructionV2.AllocationFactory_PublicFetch {..} return (allocation_factory_view_v2_to_v1 resv2) + +-- TransferInstruction +---------------------- + +-- Upcast +transfer_v1_to_v2 : TransferInstructionV1.Transfer -> TransferInstructionV2.Transfer +transfer_v1_to_v2 TransferInstructionV1.Transfer{..} = + TransferInstructionV2.Transfer with + sender + receiver + amount + instrumentId = instrumentId_v1_to_v2 instrumentId + requestedAt + executeBefore + inputHoldingCids = map coerceInterfaceContractId inputHoldingCids + meta + +transfer_instruction_status_v1_to_v2 : TransferInstructionV1.TransferInstructionStatus -> TransferInstructionV2.TransferInstructionStatus +transfer_instruction_status_v1_to_v2 tis = case tis of + TransferInstructionV1.TransferPendingReceiverAcceptance -> + TransferInstructionV2.TransferPendingReceiverAcceptance + TransferInstructionV1.TransferPendingInternalWorkflow pendingActions -> + TransferInstructionV2.TransferPendingInternalWorkflow pendingActions + +transfer_instruction_view_v1_to_v2 : TransferInstructionV1.TransferInstructionView -> TransferInstructionV2.TransferInstructionView +transfer_instruction_view_v1_to_v2 TransferInstructionV1.TransferInstructionView{..} = + TransferInstructionV2.TransferInstructionView with + originalInstructionCid = fmap coerceInterfaceContractId originalInstructionCid + transfer = transfer_v1_to_v2 transfer + status = transfer_instruction_status_v1_to_v2 status + meta + + +-- Downcast +transfer_v2_to_v1 : TransferInstructionV2.Transfer -> TransferInstructionV1.Transfer +transfer_v2_to_v1 TransferInstructionV2.Transfer{..} = + TransferInstructionV1.Transfer with + sender + receiver + amount + instrumentId = instrumentId_v2_to_v1 instrumentId + requestedAt + executeBefore + inputHoldingCids = map coerceInterfaceContractId inputHoldingCids + meta + +transfer_instruction_status_v2_to_v1 : TransferInstructionV2.TransferInstructionStatus -> TransferInstructionV1.TransferInstructionStatus +transfer_instruction_status_v2_to_v1 tis = case tis of + TransferInstructionV2.TransferPendingReceiverAcceptance -> + TransferInstructionV1.TransferPendingReceiverAcceptance + TransferInstructionV2.TransferPendingInternalWorkflow pendingActions -> + TransferInstructionV1.TransferPendingInternalWorkflow pendingActions + +transfer_instruction_view_v2_to_v1 : TransferInstructionV2.TransferInstructionView -> TransferInstructionV1.TransferInstructionView +transfer_instruction_view_v2_to_v1 TransferInstructionV2.TransferInstructionView{..} = + TransferInstructionV1.TransferInstructionView with + originalInstructionCid = fmap coerceInterfaceContractId originalInstructionCid + transfer = transfer_v2_to_v1 transfer + status = transfer_instruction_status_v2_to_v1 status + meta + +-- Choices + +transfer_instruction_result_output_v2_to_v1 : TransferInstructionV2.TransferInstructionResult_Output -> TransferInstructionV1.TransferInstructionResult_Output +transfer_instruction_result_output_v2_to_v1 tiro = case tiro of + TransferInstructionV2.TransferInstructionResult_Pending with transferInstructionCid -> + TransferInstructionV1.TransferInstructionResult_Pending with + transferInstructionCid = (coerceInterfaceContractId transferInstructionCid) + TransferInstructionV2.TransferInstructionResult_Completed with receiverHoldingCids -> + TransferInstructionV1.TransferInstructionResult_Completed with + receiverHoldingCids = (map coerceInterfaceContractId receiverHoldingCids) + TransferInstructionV2.TransferInstructionResult_Failed -> + TransferInstructionV1.TransferInstructionResult_Failed + +transfer_instruction_result_v2_to_v1 : TransferInstructionV2.TransferInstructionResult -> TransferInstructionV1.TransferInstructionResult +transfer_instruction_result_v2_to_v1 TransferInstructionV2.TransferInstructionResult{..} = + TransferInstructionV1.TransferInstructionResult with + output = transfer_instruction_result_output_v2_to_v1 output + senderChangeCids = map coerceInterfaceContractId senderChangeCids + meta + +transferInstruction_v1_acceptImpl : TransferInstructionV2.TransferInstruction -> ContractId TransferInstructionV1.TransferInstruction -> TransferInstructionV1.TransferInstruction_Accept -> Update TransferInstructionV1.TransferInstructionResult +transferInstruction_v1_acceptImpl this self TransferInstructionV1.TransferInstruction_Accept{..} = do + resv2 <- TransferInstructionV2.transferInstruction_acceptImpl + this + (coerceInterfaceContractId @TransferInstructionV2.TransferInstruction self) + (TransferInstructionV2.TransferInstruction_Accept{..}) + return (transfer_instruction_result_v2_to_v1 resv2) + +transferInstruction_v1_rejectImpl : TransferInstructionV2.TransferInstruction -> ContractId TransferInstructionV1.TransferInstruction -> TransferInstructionV1.TransferInstruction_Reject -> Update TransferInstructionV1.TransferInstructionResult +transferInstruction_v1_rejectImpl this self TransferInstructionV1.TransferInstruction_Reject{..} = do + resv2 <- TransferInstructionV2.transferInstruction_rejectImpl + this + (coerceInterfaceContractId @TransferInstructionV2.TransferInstruction self) + (TransferInstructionV2.TransferInstruction_Reject{..}) + return (transfer_instruction_result_v2_to_v1 resv2) + +transferInstruction_v1_withdrawImpl : TransferInstructionV2.TransferInstruction -> ContractId TransferInstructionV1.TransferInstruction -> TransferInstructionV1.TransferInstruction_Withdraw -> Update TransferInstructionV1.TransferInstructionResult +transferInstruction_v1_withdrawImpl this self TransferInstructionV1.TransferInstruction_Withdraw{..} = do + resv2 <- TransferInstructionV2.transferInstruction_withdrawImpl + this + (coerceInterfaceContractId @TransferInstructionV2.TransferInstruction self) + (TransferInstructionV2.TransferInstruction_Withdraw{..}) + return (transfer_instruction_result_v2_to_v1 resv2) + +transferInstruction_v1_updateImpl : TransferInstructionV2.TransferInstruction -> ContractId TransferInstructionV1.TransferInstruction -> TransferInstructionV1.TransferInstruction_Update -> Update TransferInstructionV1.TransferInstructionResult +transferInstruction_v1_updateImpl this self TransferInstructionV1.TransferInstruction_Update{..} = do + resv2 <- TransferInstructionV2.transferInstruction_updateImpl + this + (coerceInterfaceContractId @TransferInstructionV2.TransferInstruction self) + (TransferInstructionV2.TransferInstruction_Update{..}) + return (transfer_instruction_result_v2_to_v1 resv2) + +-- TransferFactory +------------------ + +-- Updast +transfer_factory_view_v1_to_v2 : TransferInstructionV1.TransferFactoryView -> TransferInstructionV2.TransferFactoryView +transfer_factory_view_v1_to_v2 TransferInstructionV1.TransferFactoryView{..} = + TransferInstructionV2.TransferFactoryView with .. + +-- Downcast +transfer_factory_view_v2_to_v1 : TransferInstructionV2.TransferFactoryView -> TransferInstructionV1.TransferFactoryView +transfer_factory_view_v2_to_v1 TransferInstructionV2.TransferFactoryView{..} = + TransferInstructionV1.TransferFactoryView with .. + +-- Choices + +transfer_factory_transfer_v1_to_v2 : TransferInstructionV1.TransferFactory_Transfer -> TransferInstructionV2.TransferFactory_Transfer +transfer_factory_transfer_v1_to_v2 TransferInstructionV1.TransferFactory_Transfer{..} = + TransferInstructionV2.TransferFactory_Transfer with + expectedAdmin + transfer = transfer_v1_to_v2 transfer + extraArgs + +transferFactory_v1_transferImpl : TransferInstructionV2.TransferFactory -> ContractId TransferInstructionV1.TransferFactory -> TransferInstructionV1.TransferFactory_Transfer -> Update TransferInstructionV1.TransferInstructionResult +transferFactory_v1_transferImpl this self args = do + resv2 <- TransferInstructionV2.transferFactory_transferImpl + this + (coerceInterfaceContractId @TransferInstructionV2.TransferFactory self) + (transfer_factory_transfer_v1_to_v2 args) + return (transfer_instruction_result_v2_to_v1 resv2) + +transferFactory_v1_publicFetchImpl : TransferInstructionV2.TransferFactory -> ContractId TransferInstructionV1.TransferFactory -> TransferInstructionV1.TransferFactory_PublicFetch -> Update TransferInstructionV1.TransferFactoryView +transferFactory_v1_publicFetchImpl this self TransferInstructionV1.TransferFactory_PublicFetch{..} = do + resv2 <- TransferInstructionV2.transferFactory_publicFetchImpl + this + (coerceInterfaceContractId @TransferInstructionV2.TransferFactory self) + TransferInstructionV2.TransferFactory_PublicFetch with .. + return (transfer_factory_view_v2_to_v1 resv2) diff --git a/token-standard/splice-token-standard-test-v2/daml.yaml b/token-standard/splice-token-standard-test-v2/daml.yaml index dd8ac4166b..03514402c6 100644 --- a/token-standard/splice-token-standard-test-v2/daml.yaml +++ b/token-standard/splice-token-standard-test-v2/daml.yaml @@ -32,7 +32,6 @@ data-dependencies: - ../../daml/splice-amulet/.daml/dist/splice-amulet-current.dar - ../splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar - ../splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar - - ../splice-api-token-utils-v2/.daml/dist/splice-api-token-utils-v2-current.dar build-options: - --target=2.1 diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml similarity index 99% rename from token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml rename to token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml index 5fdce8f4e1..530298de6b 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingApp.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml @@ -4,7 +4,7 @@ -- | An example of how to build an OTC trading app for multi-leg standard token trades. -- -- Used as part of the testing infrastructure to test the DvP workflows based on the token standard. -module Splice.Testing.Apps.TradingApp where +module Splice.Testing.Apps.TradingAppV2 where import DA.Foldable qualified as F import DA.Optional (fromOptional, fromSomeNote) @@ -15,7 +15,6 @@ import DA.Traversable qualified as Traversable import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import Splice.Api.Token.AllocationRequestV2 -import Splice.Api.Token.UtilsV2 template OTCTradeProposal with diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml similarity index 98% rename from token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml rename to token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml index 2b0fe681d2..aa501f1f62 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml @@ -3,7 +3,7 @@ -- | Daml script functions for initializing and using an amulet registry via the -- token standard and the amulet specific functions. -module Splice.Testing.Registries.AmuletRegistry +module Splice.Testing.Registries.AmuletRegistryV2 ( -- * Setup AmuletRegistryConfig(..) @@ -39,7 +39,6 @@ import Splice.Api.Token.HoldingV2 as Api.Token.HoldingV2 import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import Splice.Api.Token.AllocationInstructionV2 import Splice.Api.Token.TransferInstructionV2 -import Splice.Api.Token.UtilsV2 import Splice.Amulet import Splice.Amulet.TokenApiUtils @@ -51,9 +50,9 @@ import Splice.ExternalPartyAmuletRules import Splice.Fees import Splice.Round -import Splice.Testing.Utils -import Splice.Testing.Registries.AmuletRegistry.Parameters -import Splice.Testing.TokenStandard.RegistryApi +import Splice.Testing.UtilsV2 +import Splice.Testing.Registries.AmuletRegistryV2.Parameters +import Splice.Testing.TokenStandard.RegistryApiV2 import Daml.Script diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2/Parameters.daml similarity index 98% rename from token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml rename to token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2/Parameters.daml index a806f1c567..081fc61dc7 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2/Parameters.daml @@ -2,7 +2,7 @@ -- SPDX-License-Identifier: Apache-2.0 -- | Default configuration paramaters for the amulet registry used for testing. -module Splice.Testing.Registries.AmuletRegistry.Parameters where +module Splice.Testing.Registries.AmuletRegistryV2.Parameters where import qualified DA.Set as Set import DA.Time diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApiV2.daml similarity index 95% rename from token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml rename to token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApiV2.daml index a2c88ce7d8..4bef05f48b 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApi.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApiV2.daml @@ -4,7 +4,7 @@ -- | Support for using a token compliant registry API in tests. -- -- These simulate the OpenAPI endpoints that would be served by the backend of the registry implementation. -module Splice.Testing.TokenStandard.RegistryApi +module Splice.Testing.TokenStandard.RegistryApiV2 ( RegistryApi(..) ) where @@ -13,7 +13,7 @@ import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import Splice.Api.Token.AllocationInstructionV2 import Splice.Api.Token.TransferInstructionV2 -import Splice.Testing.Utils +import Splice.Testing.UtilsV2 import Daml.Script diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml similarity index 98% rename from token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml rename to token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml index c86b905ede..546646567e 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClient.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml @@ -5,7 +5,7 @@ -- based on the token standard. -- -- NOTE: there are likely more functions that could/should be added to this module. PRs welcome. -module Splice.Testing.TokenStandard.WalletClient +module Splice.Testing.TokenStandard.WalletClientV2 ( -- * Reading/checking holdings listHoldings, @@ -35,7 +35,6 @@ import DA.TextMap qualified as TextMap import Splice.Api.Token.TransferInstructionV2 qualified as TransferInstructionV2 import Splice.Api.Token.AllocationRequestV2 qualified as AllocationRequestV2 -import Splice.Api.Token.UtilsV2 import Splice.Api.Token.AllocationV2 qualified as AllocationV2 import Splice.Api.Token.HoldingV2 qualified as HoldingV2 diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Utils.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/UtilsV2.daml similarity index 99% rename from token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Utils.daml rename to token-standard/splice-token-standard-test-v2/daml/Splice/Testing/UtilsV2.daml index adb809d21c..e1f3090475 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Utils.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/UtilsV2.daml @@ -2,7 +2,7 @@ -- SPDX-License-Identifier: Apache-2.0 -- | Testing utilities to simplify testing token standard usage and implementation. -module Splice.Testing.Utils +module Splice.Testing.UtilsV2 ( -- * Utilities for disclosures Disclosures'(..), diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml index 3de2276e4d..9c8d5a63d9 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml @@ -28,16 +28,15 @@ import Splice.Api.Token.HoldingV2 import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import Splice.Api.Token.AllocationRequestV2 import Splice.Api.Token.AllocationInstructionV2 -import Splice.Api.Token.UtilsV2 import Splice.Amulet import Splice.Amulet.TokenApiUtils (burnedMetaKey) -import Splice.Testing.Apps.TradingApp hiding (require) -import Splice.Testing.Utils -import Splice.Testing.Registries.AmuletRegistry qualified as AmuletRegistry -import Splice.Testing.TokenStandard.RegistryApi qualified as RegistryApi -import Splice.Testing.TokenStandard.WalletClient qualified as WalletClient +import Splice.Testing.Apps.TradingAppV2 hiding (require) +import Splice.Testing.UtilsV2 +import Splice.Testing.Registries.AmuletRegistryV2 qualified as AmuletRegistry +import Splice.Testing.TokenStandard.RegistryApiV2 qualified as RegistryApi +import Splice.Testing.TokenStandard.WalletClientV2 qualified as WalletClient data AllocatedOTCTrade = AllocatedOTCTrade with @@ -111,7 +110,8 @@ setupOtcTrade = do -- Alice sees the allocation request in her wallet [aliceAlloc] <- WalletClient.listRequestedAllocations alice amuletId - aliceAlloc.transferLeg.amount === 100.0 + let [(_, tl)] = TextMap.toList aliceAlloc.transferLegs + tl.amount === 100.0 -- alice accepts allocation request directly via her wallet inputHoldingCids <- WalletClient.listHoldingCids alice amuletId @@ -156,7 +156,8 @@ setupOtcTrade = do -- Bob sees the allocation request in his wallet as well [bobAlloc] <- WalletClient.listRequestedAllocations bob amuletId - bobAlloc.transferLeg.amount === 20.0 + let [(_, tl)] = TextMap.toList bobAlloc.transferLegs + tl.amount === 20.0 -- bob accepts allocation request directly via her wallet inputHoldingCids <- WalletClient.listHoldingCids bob amuletId @@ -173,7 +174,7 @@ setupOtcTrade = do with expectedAdmin = registry.dso actor = alice - factoryView === Splice.Api.Token.AllocationInstructionV1.AllocationFactoryView registry.dso emptyMetadata + factoryView === AllocationFactoryView registry.dso emptyMetadata pure AllocatedOTCTrade with alice bob @@ -196,7 +197,7 @@ testDvP = script do passTime (hours 1) -- provider runs automation that completes the settlement - let otcTradeRef = reference_v1_to_v2 (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef + let otcTradeRef = (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef allocations <- appBackendListAllocations provider otcTradeRef TextMap.size allocations === 2 @@ -253,7 +254,7 @@ testDvP = script do testDvPCancel = script do AllocatedOTCTrade{..} <- setupOtcTrade - let otcTradeRef = reference_v1_to_v2 (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef + let otcTradeRef = (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef allocations <- appBackendListAllocations provider otcTradeRef [(_, aliceLockedHolding)] <- WalletClient.listLockedHoldings alice registry.instrumentId diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml index 8ab3c89d81..74a8d655e8 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml @@ -8,7 +8,6 @@ module Splice.Tests.TestAmuletTokenTransfer where import Splice.Api.Token.MetadataV1 import Splice.Api.Token.HoldingV2 import Splice.Api.Token.TransferInstructionV2 as Api.Token.TransferInstructionV2 -import Splice.Api.Token.UtilsV2 import Daml.Script @@ -24,10 +23,10 @@ import DA.Time import Splice.Amulet (AppRewardCoupon(..)) import Splice.Amulet.TokenApiUtils (createdInRoundMetaKey, ratePerRoundMetaKey, burnedMetaKey) -import Splice.Testing.Utils -import Splice.Testing.Registries.AmuletRegistry qualified as AmuletRegistry -import Splice.Testing.TokenStandard.RegistryApi qualified as RegistryApi -import Splice.Testing.TokenStandard.WalletClient qualified as WalletClient +import Splice.Testing.UtilsV2 +import Splice.Testing.Registries.AmuletRegistryV2 qualified as AmuletRegistry +import Splice.Testing.TokenStandard.RegistryApiV2 qualified as RegistryApi +import Splice.Testing.TokenStandard.WalletClientV2 qualified as WalletClient -- Shared test setup @@ -108,7 +107,7 @@ setupTest = do sender = bob receiver = alice amount = 10.0 - instrumentId = instrumentId_v2_to_v1 registry.instrumentId + instrumentId = registry.instrumentId requestedAt = now executeBefore = now `addRelTime` days 1 inputHoldingCids = map coerceInterfaceContractId bobHoldingCids From 6cf01903a585c736b3c4f7ee362b99efbb6a7b60 Mon Sep 17 00:00:00 2001 From: bame-da Date: Thu, 2 Oct 2025 09:10:45 +0000 Subject: [PATCH 07/11] Make the tests pass --- .../daml/Splice/Testing/Apps/TradingApp.daml | 47 +++++++++++++- .../Splice/Testing/Apps/TradingAppV2.daml | 63 ++++++++++++++++++- 2 files changed, 106 insertions(+), 4 deletions(-) diff --git a/token-standard/examples/splice-token-test-trading-app/daml/Splice/Testing/Apps/TradingApp.daml b/token-standard/examples/splice-token-test-trading-app/daml/Splice/Testing/Apps/TradingApp.daml index 883e77d7b9..12fab660a7 100644 --- a/token-standard/examples/splice-token-test-trading-app/daml/Splice/Testing/Apps/TradingApp.daml +++ b/token-standard/examples/splice-token-test-trading-app/daml/Splice/Testing/Apps/TradingApp.daml @@ -6,6 +6,7 @@ -- Used as part of the testing infrastructure to test the DvP workflows based on the token standard. module Splice.Testing.Apps.TradingApp where +import DA.Assert ((===)) import DA.Foldable qualified as F import DA.Optional (fromOptional, fromSomeNote) import DA.Set as Set @@ -112,7 +113,10 @@ template OTCTrade -- fetch and validate the allocation instruction instr <- fetch @Allocation allocCid let instrView = view @Allocation instr - require "Allocation matches expected allocation" (instrView.allocation == expectedAlloc) + case matchAllocationWithMeta expectedAlloc instrView.allocation of + Right () -> return () + Left mismatch -> abort + ("Submitted allocation does not match expected allocation." <> "\nMismatch: " <> mismatch) exercise allocCid (Allocation_ExecuteTransfer extraArgs) @@ -144,7 +148,10 @@ template OTCTrade let expectedAlloc = fromSomeNote ("Allocation with context provided for unexpected leg " <> legId) optExpectedAlloc instr <- fetch @Allocation allocCid let instrView = view @Allocation instr - require "Allocation matches expected allocation" (instrView.allocation == expectedAlloc) + case matchAllocationWithMeta expectedAlloc instrView.allocation of + Right () -> return () + Left mismatch -> abort + ("Submitted allocation does not match expected allocation." <> "\nMismatch: " <> mismatch) exercise allocCid (Allocation_Cancel extraArgs) @@ -203,3 +210,39 @@ forTextMapWithKey m f = TextMap.fromList <$> mapA f' (TextMap.toList m) where f' (k, v) = (k,) <$> f k v + +-- Utility for matching with metadata +------------------------------------- + +-- If an app has an expected allocation and receives a allocation, it needs +-- to check whether they match. The received may have extra metadata so a simple +-- equality check is insufficient. This function checks that the received +-- has only _additional_ metadata. + +matchMeta : Metadata -> Metadata -> Either Text () +matchMeta expected received = do + F.forA_ (TextMap.toList expected.values) (\(k, v) -> do + case TextMap.lookup k received.values of + None -> abort ("Entry missing in received metadata: " <> k) + Some w + | w == v -> return () + | otherwise -> abort ("Matadata entry " <> k <> "doesn't match.\nExpected: " <> v <> "\nReceived: " <> w) + ) + +matchAllocationWithMeta : AllocationSpecification -> AllocationSpecification -> Either Text () +matchAllocationWithMeta expected received = do + let + baseExpected = expected with + transferLeg = expected.transferLeg with + meta = emptyMetadata + settlement = expected.settlement with + meta = emptyMetadata + baseReceived = received with + transferLeg = received.transferLeg with + meta = emptyMetadata + settlement = received.settlement with + meta = emptyMetadata + baseExpected === baseReceived + matchMeta expected.settlement.meta received.settlement.meta + matchMeta expected.transferLeg.meta received.transferLeg.meta + diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml index 530298de6b..4bd9810603 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml @@ -6,6 +6,8 @@ -- Used as part of the testing infrastructure to test the DvP workflows based on the token standard. module Splice.Testing.Apps.TradingAppV2 where +import DA.Assert ((===)) +import DA.Either (fromLeft) import DA.Foldable qualified as F import DA.Optional (fromOptional, fromSomeNote) import DA.Set as Set @@ -112,7 +114,10 @@ template OTCTrade -- fetch and validate the allocation instruction instr <- fetch @Allocation allocCid let instrView = view @Allocation instr - require "Allocation matches expected allocation" (instrView.allocation == expectedAlloc) + case matchAllocationWithMeta expectedAlloc instrView.allocation of + Right () -> return () + Left mismatch -> abort + ("Submitted allocation does not match expected allocation." <> "\nMismatch: " <> mismatch) exercise allocCid (Allocation_ExecuteTransfer with extraArgs; extraAuth = None) @@ -145,7 +150,10 @@ template OTCTrade let expectedAlloc = fromSomeNote ("Allocation with context provided for unexpected leg " <> legId) optExpectedAlloc instr <- fetch @Allocation allocCid let instrView = view @Allocation instr - require "Allocation matches expected allocation" (instrView.allocation == expectedAlloc) + case matchAllocationWithMeta expectedAlloc instrView.allocation of + Right () -> return () + Left mismatch -> abort + ("Submitted allocation does not match expected allocation." <> "\nMismatch: " <> mismatch) exercise allocCid (Allocation_Cancel extraArgs) @@ -205,3 +213,54 @@ forTextMapWithKey m f = TextMap.fromList <$> mapA f' (TextMap.toList m) where f' (k, v) = (k,) <$> f k v + + +-- Utility for matching with metadata +------------------------------------- + +-- If an app has an expected allocation and receives a allocation, it needs +-- to check whether they match. The received may have extra metadata so a simple +-- equality check is insufficient. This function checks that the received +-- has only _additional_ metadata. + +matchMeta : Metadata -> Metadata -> Either Text () +matchMeta expected received = do + F.forA_ (TextMap.toList expected.values) (\(k, v) -> do + case TextMap.lookup k received.values of + None -> abort ("Entry missing in received metadata: " <> k) + Some w + | w == v -> return () + | otherwise -> abort ("Matadata entry " <> k <> "doesn't match.\nExpected: " <> v <> "\nReceived: " <> w) + ) + +matchLegs : TextMap TransferLeg -> TextMap TransferLeg -> Either Text () +matchLegs expected received = do + assertMsg + ("Expected " <> show (TextMap.size expected) <> " transfer legs. Received " <> show (TextMap.size received)) + (TextMap.size expected == TextMap.size received) + F.forA_ (TextMap.toList expected) (\(tlId, tl_e) -> do + tl_r <- case TextMap.lookup tlId received of + None -> abort ("Did not receive expected transfer leg with Id " <> tlId) + Some tl -> Right tl + let + baseExpected = tl_e with meta = emptyMetadata + baseReceived = tl_r with meta = emptyMetadata + baseExpected === baseReceived + matchMeta tl_e.meta tl_r.meta + ) + +matchAllocationWithMeta : AllocationSpecification -> AllocationSpecification -> Either Text () +matchAllocationWithMeta expected received = do + let + baseExpected = expected with + transferLegs = TextMap.empty + settlement = expected.settlement with + meta = emptyMetadata + baseReceived = received with + transferLegs = TextMap.empty + settlement = received.settlement with + meta = emptyMetadata + baseExpected === baseReceived + matchMeta expected.settlement.meta received.settlement.meta + matchLegs expected.transferLegs received.transferLegs + From 572fed3712b952eb35a5878f3590bd8777a26992 Mon Sep 17 00:00:00 2001 From: bame-da Date: Sun, 12 Oct 2025 13:37:51 +0000 Subject: [PATCH 08/11] Implement and test Amulet settlment with auth via Allocation --- .../daml/Splice/Amulet/TwoStepTransfer.daml | 39 ++- .../daml/Splice/AmuletAllocation.daml | 121 +++++-- .../Splice/AmuletTransferInstruction.daml | 3 +- .../daml/Splice/ExternalPartyAmuletRules.daml | 7 +- .../daml/Splice/Scripts/TestWallet.daml | 21 +- .../daml/Splice/Wallet/Install.daml | 4 +- .../Api/Token/AllocationInstructionV2.daml | 8 +- .../daml/Splice/Api/Token/AllocationV2.daml | 105 ++++-- .../daml/Splice/Api/Token/UtilsV2.daml | 22 +- .../Splice/Testing/Apps/TradingAppV2.daml | 323 ++++++++---------- .../Testing/TokenStandard/WalletClientV2.daml | 17 +- .../daml/Splice/Tests/TestAmuletTokenDvP.daml | 85 +++-- .../daml/Splice/Tests/TestAmuletTokenDvP.daml | 2 +- 13 files changed, 434 insertions(+), 323 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml b/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml index a956e45a5f..49b01b57c3 100644 --- a/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml +++ b/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml @@ -33,8 +33,7 @@ import Splice.Util data TwoStepTransfer = TwoStepTransfer with dso : Party sender : Party - receiver : Party - amount : Decimal + outputs : [(Party, Decimal)] lockContext : Text -- ^ Context description of the lock. This is used to display the reason for -- the lock in wallets. @@ -72,23 +71,29 @@ prepareTwoStepTransfer prepareTwoStepTransfer TwoStepTransfer{..} requestedAt inputHoldingCids paymentContext = do require "requestedAt < transferBefore" (requestedAt < transferBefore) -- over-approximate fees that will be due on the actual transfer - let receiverOutputForActualTransfer = TransferOutput with - receiver - amount - receiverFeeRatio = 0.0 -- all fees are paid by the sender - lock = None - [expectedTransferFees] <- exerciseComputeFees dso paymentContext sender [receiverOutputForActualTransfer] - let feesReserveAmount = expectedTransferFees * feeReserveMultiplier + let receiverOutputsForActualTransfer = map (\(receiver, amount) -> TransferOutput with + receiver + amount + receiverFeeRatio = 0.0 -- all fees are paid by the sender + lock = None + ) + outputs + expectedTransferFees <- sum <$> exerciseComputeFees dso paymentContext sender receiverOutputsForActualTransfer + openRound <- fetchChecked (ForDso with dso) paymentContext.context.openMiningRound + let lockDuration = transferBefore `subTime` requestedAt + let approximateHoldingFees = holdingFeesForDuration lockDuration openRound + let feesReserveAmount = (expectedTransferFees + approximateHoldingFees) * feeReserveMultiplier -- lock the amulet transferInputs <- holdingToTransferInputs (ForOwner with dso; owner = sender) paymentContext inputHoldingCids + let totalAmount = sum $ (map snd outputs) let transfer = Splice.AmuletRules.Transfer with sender provider = sender -- the sender is serving as its own "app provider" outputs = [ TransferOutput with receiver = sender - amount = amount + feesReserveAmount + amount = totalAmount + feesReserveAmount receiverFeeRatio = 0.0 -- locking fees are paid by the sender lock = Some TimeLock with expiresAt = transferBefore @@ -126,16 +131,18 @@ executeTwoStepTransfer TwoStepTransfer{..} lockedAmuletCid extraArgs = do unlockResult <- exercise lockedAmuletCid LockedAmulet_Unlock with openRoundCid let amuletCid = unlockResult.amuletSum.amulet -- execute transfer - let receiverOutput = TransferOutput with - receiver = receiver - amount = amount - receiverFeeRatio = 0.0 -- all fees are paid by the sender - lock = None + let receiverOutputs = map (\(receiver, amount) -> TransferOutput with + receiver + amount + receiverFeeRatio = 0.0 -- all fees are paid by the sender + lock = None + ) + outputs let amuletRulesTransfer = Splice.AmuletRules.Transfer with sender provider inputs = [InputAmulet amuletCid] - outputs = [receiverOutput] + outputs = receiverOutputs beneficiaries result <- exercisePaymentTransfer dso paymentContext amuletRulesTransfer pure diff --git a/daml/splice-amulet/daml/Splice/AmuletAllocation.daml b/daml/splice-amulet/daml/Splice/AmuletAllocation.daml index c6a1f37d7f..4f6d80ad69 100644 --- a/daml/splice-amulet/daml/Splice/AmuletAllocation.daml +++ b/daml/splice-amulet/daml/Splice/AmuletAllocation.daml @@ -4,12 +4,13 @@ module Splice.AmuletAllocation ( AmuletAllocation(..), allocationToTwoStepTransfer, - allocationSender, ) where +import DA.Assert((===), (=/=)) import DA.Text as Text import DA.TextMap qualified as TextMap -import DA.List (dedupSort) +import DA.List ((\\), dedupSort) +import DA.Optional(fromSome) import Splice.Api.Token.MetadataV1 import Splice.Api.Token.HoldingV2 @@ -26,21 +27,32 @@ template AmuletAllocation with lockedAmulet : ContractId LockedAmulet -- ^ Locked amulet that holds the funds for the allocation allocation : AllocationSpecification + sender : Party + admin : Party where - signatory allocationInstrumentAdmin allocation, allocationSender allocation + signatory admin, sender observer allocation.settlement.executor - -- Only allow a single sender. - ensure all (\(_,tl) -> tl.sender == allocationSender allocation) (TextMap.toList allocation.transferLegs) + ensure + all + (\(_,tl) -> ( + -- Sender needs to appear as sender or receiver of each leg. + sender `elem` [tl.sender, tl.receiver]) + -- Only one admin Id allowed. + && tl.instrumentId.admin == admin) + (TextMap.toList allocation.transferLegs) interface instance Allocation for AmuletAllocation where view = AllocationView with allocation holdingCids = [toInterfaceContractId lockedAmulet] meta = emptyMetadata - transferExtraAuth = [allocationSender allocation] + senders = [sender] + requiredReceiverAuth = (defaultAllocationControllers allocation) \\ (sender::allocationControllers allocation) - allocation_executeTransferImpl _self Allocation_ExecuteTransfer{..} = transferAmuletAllocation this extraArgs + allocation_executeTransferImpl self Allocation_ExecuteTransfer{..} = case extraAuth of + [] -> transferAmuletAllocation this extraArgs + ea -> collectAuthAndSettle (fromInterfaceContractId self) extraArgs ea [] allocation_withdrawImpl _self Allocation_Withdraw{..} = do senderHoldingCids <- unlockAmuletAllocation this extraArgs @@ -56,7 +68,12 @@ template AmuletAllocation senderHoldingCids meta = emptyMetadata - allocation_executeAuthorizeIncomingImpl = error "unimplemented" + allocation_executeAuthorizeIncomingImpl _self Allocation_AuthorizeIncoming{..} = do + cid <- create AmuletAllocationTransferAuthorization with + allocation + receiver = sender + admin + return $ toInterfaceContractId cid interface instance AllocationV1.Allocation for AmuletAllocation where view = allocation_view_v2_to_v1 (view (toInterface @Allocation this)) @@ -65,46 +82,53 @@ template AmuletAllocation AllocationV1.allocation_withdrawImpl = allocation_v1_withdrawImpl (toInterface @Allocation this) AllocationV1.allocation_cancelImpl = allocation_v1_cancelImpl (toInterface @Allocation this) -allocationInstrumentAdmin : AllocationSpecification -> Party -allocationInstrumentAdmin AllocationSpecification{..} = - let tl::_ = (TextMap.toList transferLegs) - in tl._2.instrumentId.admin + choice AmuletAllocation_InternalSettleWithExtraAuth : Allocation_ExecuteTransferResult + with + extraArgs : ExtraArgs + extraControllers : [Party] + controller extraControllers ++ allocationControllers allocation + do transferAmuletAllocation this extraArgs --- Amulet only supports a single sender! -allocationSender : AllocationSpecification -> Party -allocationSender AllocationSpecification{..} = - let tl::_ = (TextMap.toList transferLegs) - in tl._2.sender -allocationInstrumentReceivers : AllocationSpecification -> [Party] -allocationInstrumentReceivers AllocationSpecification{..} = + +allocationReceivers : AllocationSpecification -> [Party] +allocationReceivers AllocationSpecification{..} = dedupSort $ map ((.receiver) . snd) (TextMap.toList transferLegs) -- Allocation usage ------------------- -allocationToTwoStepTransfer : AllocationSpecification -> TwoStepTransfer -allocationToTwoStepTransfer allocation = +allocationToTwoStepTransfer : Party -> Party -> AllocationSpecification -> TwoStepTransfer +allocationToTwoStepTransfer sender admin allocation = TwoStepTransfer with - dso = transferLeg.instrumentId.admin - sender = transferLeg.sender - receiver = transferLeg.receiver - amount = transferLeg.amount + dso = admin + sender = sender + outputs provider = allocation.settlement.executor transferBefore = allocation.settlement.settleBefore transferBeforeDeadline = "allocation.settlement.settleBefore" allowFeaturing = True lockContext = Text.implode -- We don't show more context to avoid bloating the response here. - ["allocation for transfer leg ", show transferLegId, " to ", show transferLeg.receiver] + ["allocation for settlement ", allocation.settlement.settlementRef.id] where - (transferLegId, transferLeg) = case TextMap.toList allocation.transferLegs of - [tl] -> tl - _ -> error "Only one leg supported" -- TODO. + senderLegs = filter (\tl -> tl.sender == sender) $ map snd (TextMap.toList allocation.transferLegs) + outputs = map (\tl -> (tl.receiver, tl.amount)) senderLegs + +collectAuthAndSettle : ContractId AmuletAllocation -> ExtraArgs -> [ContractId AllocationTransferAuthorization] -> [Party] -> Update Allocation_ExecuteTransferResult +collectAuthAndSettle allocationCid extraArgs extraAuth extraControllers = do + case extraAuth of + eaCid::eas -> exercise (fromInterfaceContractId @AmuletAllocationTransferAuthorization eaCid) AmuletAllocationTransferAuthorization_AuthorizeTransfer with + extraAuth = eas + extraControllers + .. + [] -> exercise allocationCid AmuletAllocation_InternalSettleWithExtraAuth with + extraArgs + extraControllers transferAmuletAllocation : AmuletAllocation -> ExtraArgs -> Update Allocation_ExecuteTransferResult transferAmuletAllocation amuletAllocation extraArgs = do - let twoStepTransfer = allocationToTwoStepTransfer amuletAllocation.allocation + let twoStepTransfer = allocationToTwoStepTransfer amuletAllocation.sender amuletAllocation.admin amuletAllocation.allocation (senderHoldingCids, receiverHoldingCids, meta) <- executeTwoStepTransfer twoStepTransfer amuletAllocation.lockedAmulet extraArgs pure Allocation_ExecuteTransferResult @@ -115,5 +139,40 @@ transferAmuletAllocation amuletAllocation extraArgs = do unlockAmuletAllocation : AmuletAllocation -> ExtraArgs -> Update [ContractId Holding] unlockAmuletAllocation amuletAllocation extraArgs = do - let twoStepTransfer = allocationToTwoStepTransfer amuletAllocation.allocation + let twoStepTransfer = allocationToTwoStepTransfer amuletAllocation.sender amuletAllocation.admin amuletAllocation.allocation abortTwoStepTransfer twoStepTransfer amuletAllocation.lockedAmulet extraArgs + +template AmuletAllocationTransferAuthorization + with + allocation : AllocationSpecification + receiver : Party + admin : Party + where + signatory admin, receiver, allocation.settlement.executor + + interface instance AllocationTransferAuthorization for AmuletAllocationTransferAuthorization where + view = AllocationTransferAuthorizationView with + allocation + receiver + admin + + choice AmuletAllocationTransferAuthorization_AuthorizeTransfer : Allocation_ExecuteTransferResult + with + allocationCid : ContractId AmuletAllocation + extraArgs : ExtraArgs + extraAuth : [ContractId AllocationTransferAuthorization] + extraControllers : [Party] + controller extraControllers ++ allocation.settlement.executor :: fromSome (allocation.settlement.controllerOverride) -- should never be None if this is called. + do + -- Validate that the receiver is only a receiver on a matching settlement + amuletAllocation <- fetch allocationCid + let allocation' = amuletAllocation.allocation + allocation === allocation' + admin === amuletAllocation.admin + receiver =/= amuletAllocation.sender + let receivers = allocationReceivers allocation + assertMsg ("Receiver " <> show receiver <> " not found in receivers " <> show receivers) + (receiver `elem` receivers) + -- Transfer with added authority. + collectAuthAndSettle allocationCid extraArgs extraAuth (receiver::extraControllers) + diff --git a/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml b/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml index f2b3db3fe4..1e29f0ab20 100644 --- a/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml +++ b/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml @@ -64,8 +64,7 @@ standardTransferToTwoStepTransfer transfer = dso = transfer.instrumentId.admin sender = transfer.sender provider = transfer.sender - receiver = transfer.receiver - amount = transfer.amount + outputs = [(transfer.receiver, transfer.amount)] transferBefore = transfer.executeBefore transferBeforeDeadline = "Transfer.executeBefore" allowFeaturing = False -- unfeatured as the sender is serving as its own "app provider" diff --git a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml index 12e147ad6f..b887b93f3a 100644 --- a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml @@ -368,7 +368,7 @@ amulet_allocationFactory_allocateImpl -> Update AllocationInstructionResult amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do let dso = externalAmuletRules.dso - let AllocationFactory_Allocate {allocation, requestedAt, inputHoldingCids, extraArgs} = arg + let AllocationFactory_Allocate {allocation, requestedAt, inputHoldingCids, extraArgs, creator} = arg -- validate call to factory and retrieve context requireExpectedAdminMatch arg.expectedAdmin dso @@ -412,13 +412,16 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do require "At least one input holding must be provided" (not $ null inputHoldingCids) -- lock the funds - let twoStepTransfer = allocationToTwoStepTransfer arg.allocation + let sender = creator + let twoStepTransfer = allocationToTwoStepTransfer sender dso arg.allocation (lockedAmulet, senderChangeCids, meta) <- prepareTwoStepTransfer twoStepTransfer arg.requestedAt inputHoldingCids paymentContext -- create the amulet allocation allocationCid <- toInterfaceContractId <$> create AmuletAllocation with allocation = arg.allocation lockedAmulet + admin = dso + sender -- finaly done: return the result pure AllocationInstructionResult with diff --git a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml index 0773109739..6a296ace06 100644 --- a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml +++ b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml @@ -1107,22 +1107,22 @@ testTokenStandardAllocate = script do meta = emptyMetadata let aliceLeg = mkTransfer alice alice 100.0 - -- alice proposes trade with herself - proposalCid <- submit alice $ createCmd OTCTradeProposal with + -- provider proposes a trade for alice with herself + now <- getTime + let settleBefore = now `addRelTime` hours 2 + proposalCid <- submit provider $ createCmd OTCTrade with venue = provider - tradeCid = None transferLegs = TextMap.fromList [("leg0", aliceLeg)] - approvers = [alice] + prepareUntil = now `addRelTime` hours 1 + settleBefore + createdAt = now + -- provider initiates settlement - now <- getTime - let settleBefore = now `addRelTime` hours 2 _ <- submit provider $ - exerciseCmd proposalCid OTCTradeProposal_InitiateSettlement with - prepareUntil = now `addRelTime` hours 1 - settleBefore + exerciseCmd proposalCid OTCTrade_RequestAllocations with - [aliceAlloc] <- WalletClient.listRequestedAllocations alice amuletId + [aliceAlloc] <- WalletClient.listRequestedAllocationsForAdmin alice amuletId.admin holdingCid <- AmuletRegistry.tapFaucet registry alice 200.0 @@ -1132,6 +1132,7 @@ testTokenStandardAllocate = script do inputHoldingCids = [coerceInterfaceContractId holdingCid] requestedAt = now extraArgs = emptyExtraArgs + creator = alice result <- submitMulti [aliceValidator] [alice, registry.dso] $ exerciseCmd aliceInstall WalletAppInstall_AllocationFactory_Allocate with allocationFactory = enrichedChoice.factoryCid diff --git a/daml/splice-wallet/daml/Splice/Wallet/Install.daml b/daml/splice-wallet/daml/Splice/Wallet/Install.daml index fd5decc747..a17092d015 100644 --- a/daml/splice-wallet/daml/Splice/Wallet/Install.daml +++ b/daml/splice-wallet/daml/Splice/Wallet/Install.daml @@ -15,7 +15,6 @@ import qualified Splice.Api.Token.AllocationV2 import qualified Splice.Api.Token.AllocationInstructionV2 import qualified Splice.Api.Token.TransferInstructionV2 import Splice.Amulet -import Splice.AmuletAllocation (allocationSender) import Splice.Amulet.TokenApiUtils import Splice.Types import Splice.AmuletRules @@ -648,7 +647,8 @@ template WalletAppInstall withdrawArg : Splice.Api.Token.AllocationV2.Allocation_Withdraw controller validatorParty do allocation <- fetchCheckedInterface (ForDso dsoParty) allocationCid - let sender = allocationSender (view allocation).allocation + -- Amulet only supports a single sender per allocation + let [sender] = (view allocation).senders require ("sender " <> show sender <> " must match endUserParty " <> show endUserParty) (sender == endUserParty) exercise allocationCid withdrawArg diff --git a/token-standard/splice-api-token-allocation-instruction-v2/daml/Splice/Api/Token/AllocationInstructionV2.daml b/token-standard/splice-api-token-allocation-instruction-v2/daml/Splice/Api/Token/AllocationInstructionV2.daml index e5ebc55acd..800b25f2f2 100644 --- a/token-standard/splice-api-token-allocation-instruction-v2/daml/Splice/Api/Token/AllocationInstructionV2.daml +++ b/token-standard/splice-api-token-allocation-instruction-v2/daml/Splice/Api/Token/AllocationInstructionV2.daml @@ -34,6 +34,9 @@ data AllocationInstructionView = AllocationInstructionView with -- ^ The holdings to be used to fund the allocation. -- -- MAY be empty for registries that do not represent their holdings on-ledger. + senders : [Party] + -- ^ The senders of the allocation - who typically instructed the allocation instruction + -- and later appear on the Allocation as senders. meta : Metadata -- ^ Additional metadata specific to the allocation instruction, used for -- extensibility; e.g., more detailed status information. @@ -57,7 +60,7 @@ interface AllocationInstruction where with extraArgs : ExtraArgs -- ^ Additional context required in order to exercise the choice. - controller allocationSenders (view this).allocation + controller (view this).senders do allocationInstruction_withdrawImpl this self arg choice AllocationInstruction_Update : AllocationInstructionResult @@ -124,7 +127,8 @@ interface AllocationFactory where -- deliberate contention on holdings to prevent duplicate allocations. extraArgs : ExtraArgs -- ^ Additional choice arguments. - controller allocationSenders allocation + creator : Party + controller creator do allocationFactory_allocateImpl this self arg nonconsuming choice AllocationFactory_PublicFetch : AllocationFactoryView diff --git a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml index 6dc0ef6b1e..610e128b4c 100644 --- a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml +++ b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml @@ -8,11 +8,13 @@ -- by an app. module Splice.Api.Token.AllocationV2 where -import DA.List (dedupSort) -import DA.TextMap +import DA.List (dedup, dedupSort) +import DA.TextMap as TextMap import Splice.Api.Token.MetadataV1 import Splice.Api.Token.HoldingV2 (Holding, InstrumentId) +import qualified DA.Foldable as F +import DA.Assert ((===)) -- | A generic type to refer to data defined within an app. @@ -96,16 +98,22 @@ data AllocationView = AllocationView with -- MAY be empty for registries that do not represent their holdings on-ledger. meta : Metadata -- ^ Additional metadata specific to the allocation, used for extensibility. - transferExtraAuth : [Party] - -- ^ Any additional parties whose authorization that needs to be provided to - -- Allocation_ExecuteTransfer via AllocationTransferAuthorizations + senders : [Party] + -- ^ The senders of this allocation, who could also authorize incoming transfers + -- through Allocation_AuthorizeIncoming + requiredReceiverAuth : [Party] + -- ^ The extra authority this allocation needs for settlement on top of + -- the controllers specified via allocation.settlement.controllerOverride deriving (Show, Eq) -- | View of a delegated authority from the signer to the execurot to settle given transfer legs. -- authorizers are always the signatories so not made available in the viewtype. data AllocationTransferAuthorizationView = AllocationTransferAuthorizationView with allocation : AllocationSpecification - -- ^ the allocation to which this authorization applies. + receiver : Party + admin : Party + -- ^ the settlement to which this authorization applies. + -- Allocation @@ -114,16 +122,17 @@ data AllocationTransferAuthorizationView = AllocationTransferAuthorizationView w -- | Convenience function to refer to the union of sender, receiver, and -- executor of the settlement, which jointly control the execution of the -- allocation. -allocationControllers : AllocationView -> [Party] -allocationControllers AllocationView{..} = - optional - (allocation.settlement.executor :: concat (map (\leg -> [leg._2.sender, leg._2.receiver]) (toList allocation.transferLegs))) - (\override -> allocation.settlement.executor :: override) - allocation.settlement.controllerOverride +defaultAllocationControllers : AllocationSpecification -> [Party] +defaultAllocationControllers AllocationSpecification{..} = + dedup $ settlement.executor :: concatMap (\leg -> [leg._2.sender, leg._2.receiver]) (toList transferLegs) --- | Convenience function to get all senders -allocationSenders : AllocationSpecification -> [Party] -allocationSenders AllocationSpecification{..} = map (._2.sender) (toList transferLegs) +-- | Convenience function read out the overridden allocation controllers. +allocationControllers : AllocationSpecification -> [Party] +allocationControllers alloc@AllocationSpecification{..} = + optional + (defaultAllocationControllers alloc) + (\override -> dedup $ settlement.executor :: override) + settlement.controllerOverride -- | Convenience to get the allocation admin allocationAdmin : AllocationSpecification -> Party @@ -144,25 +153,26 @@ interface Allocation where allocation_withdrawImpl : ContractId Allocation -> Allocation_Withdraw -> Update Allocation_WithdrawResult allocation_executeAuthorizeIncomingImpl : ContractId Allocation -> Allocation_AuthorizeIncoming -> Update (ContractId AllocationTransferAuthorization) - choice Allocation_AuthorizeIncoming : ContractId AllocationTransferAuthorization + nonconsuming choice Allocation_AuthorizeIncoming : ContractId AllocationTransferAuthorization -- ^ Transfer the authority from this Allocation to a AllocationTransferAuthorization which -- can then be used in another allocation's Allocation_ExecuteTransfer to authorize incoming -- transfers. with extraArgs : ExtraArgs -- ^ Additional context required in order to exercise the choice. - controller allocationControllers (view this) + controller allocationControllers (view this).allocation do allocation_executeAuthorizeIncomingImpl this self arg - choice Allocation_ExecuteTransfer : Allocation_ExecuteTransferResult + -- NOTE: This used to be consuming. Implementations now must archive self. + nonconsuming choice Allocation_ExecuteTransfer : Allocation_ExecuteTransferResult -- ^ Execute the transfer of the allocated assets. Intended to be used to execute the settlement. -- This choice SHOULD succeed provided the `settlement.settleBefore` deadline has not yet passed. with - extraAuth : Optional [ContractId AllocationTransferAuthorization] - -- ^ Contract encapsulating extra authority needed to exercise the choice extraArgs : ExtraArgs -- ^ Additional context required in order to exercise the choice. - controller allocationControllers (view this) + extraAuth : [ContractId AllocationTransferAuthorization] + -- ^ Contract encapsulating extra authority needed to exercise the choice + controller allocationControllers (view this).allocation do allocation_executeTransferImpl this self arg choice Allocation_Cancel : Allocation_CancelResult @@ -176,7 +186,7 @@ interface Allocation where with extraArgs : ExtraArgs -- ^ Additional context required in order to exercise the choice. - controller allocationControllers (view this) + controller allocationControllers (view this).allocation do allocation_cancelImpl this self arg choice Allocation_Withdraw : Allocation_WithdrawResult @@ -186,7 +196,7 @@ interface Allocation where with extraArgs : ExtraArgs -- ^ Additional context required in order to exercise the choice. - controller allocationSenders (view this).allocation + controller (view this).senders do allocation_withdrawImpl this self arg -- AllocationTransferAuthorization @@ -231,3 +241,52 @@ data Allocation_WithdrawResult = Allocation_WithdrawResult deriving (Show, Eq) +-- Utility for matching with metadata +------------------------------------- + +-- If an app has an expected allocation and receives a allocation, it needs +-- to check whether they match. The received may have extra metadata so a simple +-- equality check is insufficient. This function checks that the received +-- has only _additional_ metadata. + +matchMeta : Metadata -> Metadata -> Either Text () +matchMeta expected received = do + F.forA_ (TextMap.toList expected.values) (\(k, v) -> do + case TextMap.lookup k received.values of + None -> abort ("Entry missing in received metadata: " <> k) + Some w + | w == v -> return () + | otherwise -> abort ("Matadata entry " <> k <> "doesn't match.\nExpected: " <> v <> "\nReceived: " <> w) + ) + +matchLegs : TextMap TransferLeg -> TextMap TransferLeg -> Either Text () +matchLegs expected received = do + assertMsg + ("Expected " <> show (TextMap.size expected) <> " transfer legs. Received " <> show (TextMap.size received)) + (TextMap.size expected == TextMap.size received) + F.forA_ (TextMap.toList expected) (\(tlId, tl_e) -> do + tl_r <- case TextMap.lookup tlId received of + None -> abort ("Did not receive expected transfer leg with Id " <> tlId) + Some tl -> Right tl + let + baseExpected = tl_e with meta = emptyMetadata + baseReceived = tl_r with meta = emptyMetadata + baseExpected === baseReceived + matchMeta tl_e.meta tl_r.meta + ) + +matchAllocationWithMeta : AllocationSpecification -> AllocationSpecification -> Either Text () +matchAllocationWithMeta expected received = do + let + baseExpected = expected with + transferLegs = TextMap.empty + settlement = expected.settlement with + meta = emptyMetadata + baseReceived = received with + transferLegs = TextMap.empty + settlement = received.settlement with + meta = emptyMetadata + baseExpected === baseReceived + matchMeta expected.settlement.meta received.settlement.meta + matchLegs expected.transferLegs received.transferLegs + diff --git a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml index 068a004a6a..5e89b47a38 100644 --- a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml +++ b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml @@ -5,7 +5,6 @@ -- implement the V1 interfaces from the V2 interfaces. module Splice.Api.Token.UtilsV2 where -import DA.Optional (fromSome) import DA.TextMap qualified as TextMap import Splice.Api.Token.MetadataV1 @@ -99,9 +98,13 @@ allocation_view_v1_to_v2 AllocationV1.AllocationView{..} = allocation = allocation_specification_v1_to_v2 allocation holdingCids = map coerceInterfaceContractId holdingCids meta - transferExtraAuth + senders + requiredReceiverAuth where - transferExtraAuth = case TextMap.lookup "canton.network/transferExtraAuth" meta.values of + senders = case TextMap.lookup "canton.network/senders" meta.values of + None -> [allocation.transferLeg.sender] + Some ol -> [allocation.transferLeg.sender] -- TODO: Parse extra auth list. + requiredReceiverAuth = case TextMap.lookup "canton.network/requiredReceiverAuth" meta.values of None -> [] Some ol -> [] -- TODO: Parse extra auth list. @@ -159,7 +162,8 @@ allocation_view_v2_to_v1 AllocationV2.AllocationView{..} = meta' = Metadata with values = TextMap.insert "canton.network/version" "v2" $ - TextMap.insert "canton.network/transferExtraAuth" (show transferExtraAuth) $ + TextMap.insert "canton.network/senders" (show senders) $ + TextMap.insert "canton.network/requiredReceiverAuth" (show requiredReceiverAuth) $ meta.values -- Choices @@ -167,7 +171,7 @@ allocation_view_v2_to_v1 AllocationV2.AllocationView{..} = allocation_execute_transfer_v1_to_v2 : AllocationV1.Allocation_ExecuteTransfer -> AllocationV2.Allocation_ExecuteTransfer allocation_execute_transfer_v1_to_v2 AllocationV1.Allocation_ExecuteTransfer{..} = AllocationV2.Allocation_ExecuteTransfer with - extraAuth = None + extraAuth = [] .. allocation_transfer_result_v2_to_v1 : AllocationV2.Allocation_ExecuteTransferResult -> AllocationV1.Allocation_ExecuteTransferResult @@ -228,7 +232,12 @@ allocation_instruction_view_v1_to_v2 AllocationInstructionV1.AllocationInstructi pendingActions requestedAt inputHoldingCids = map coerceInterfaceContractId inputHoldingCids + senders meta + where + senders = case TextMap.lookup "canton.network/senders" meta.values of + None -> [allocation.transferLeg.sender] + Some ol -> [allocation.transferLeg.sender] -- TODO: Parse extra auth list. -- Downcast allocation_instruction_view_v2_to_v1 : AllocationInstructionV2.AllocationInstructionView -> AllocationInstructionV1.AllocationInstructionView @@ -305,6 +314,7 @@ allocation_factory_allocate_v1_to_v2 AllocationInstructionV1.AllocationFactory_A requestedAt inputHoldingCids = map coerceInterfaceContractId inputHoldingCids extraArgs + creator = allocation.transferLeg.sender allocationFactory_v1_allocateImpl : AllocationInstructionV2.AllocationFactory -> ContractId AllocationInstructionV1.AllocationFactory -> AllocationInstructionV1.AllocationFactory_Allocate -> Update AllocationInstructionV1.AllocationInstructionResult allocationFactory_v1_allocateImpl this self alloc = do @@ -473,3 +483,5 @@ transferFactory_v1_publicFetchImpl this self TransferInstructionV1.TransferFacto (coerceInterfaceContractId @TransferInstructionV2.TransferFactory self) TransferInstructionV2.TransferFactory_PublicFetch with .. return (transfer_factory_view_v2_to_v1 resv2) + + diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml index 4bd9810603..cd81965cc9 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml @@ -6,94 +6,84 @@ -- Used as part of the testing infrastructure to test the DvP workflows based on the token standard. module Splice.Testing.Apps.TradingAppV2 where -import DA.Assert ((===)) -import DA.Either (fromLeft) import DA.Foldable qualified as F -import DA.Optional (fromOptional, fromSomeNote) -import DA.Set as Set +import DA.Optional (fromSomeNote) +import DA.Set qualified as Set import DA.TextMap as TextMap -import DA.Traversable qualified as Traversable +import DA.Map as Map import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import Splice.Api.Token.AllocationRequestV2 +import DA.List (groupOn) +import DA.Foldable (mapA_) +import DA.List.Total (dedup) +import DA.Assert ((===)) +import qualified DA.Traversable as Traversable - -template OTCTradeProposal with - venue : Party - tradeCid : Optional (ContractId OTCTradeProposal) -- Tracking-id for the trade being proposed. Set to None for new trades. - transferLegs : TextMap Api.Token.AllocationV2.TransferLeg - approvers : [Party] -- ^ Parties that have approved the proposal +template OTCTradeAllocationRequest with + otcTrade : OTCTrade + otcTradeCid : ContractId OTCTrade where - signatory approvers - observer venue, tradingParties transferLegs + signatory otcTrade.venue + observer otcTrade.venue, tradingParties (otcTrade.transferLegs) - -- This is test code, so we don't care about the contention here. - -- Moreover, likely the number of trading parties is going to be low anyways. - choice OTCTradeProposal_Accept : ContractId OTCTradeProposal - with - approver : Party - controller approver - do - let newApprovers = approver :: approvers - let traders = tradingParties transferLegs - require "Approver is a trading party" (approver `Set.member` traders) - require "Approver is new" (approver `notElem` approvers) - create this with - approvers = newApprovers - tradeCid = Some (fromOptional self tradeCid) - - choice OTCTradeProposal_Reject : () - with - trader : Party - controller trader - do require "Trader is a trading party" (trader `Set.member` tradingParties transferLegs) + interface instance AllocationRequest for OTCTradeAllocationRequest where + view = AllocationRequestView with + settlement = SettlementInfo with + executor = otcTrade.venue + requestedAt = otcTrade.createdAt + settlementRef = makeTradeRef otcTradeCid + allocateBefore = otcTrade.prepareUntil + settleBefore = otcTrade.settleBefore + meta = emptyMetadata + controllerOverride = Some [] -- We will settle using only executor authority. + transferLegs = otcTrade.transferLegs + meta = emptyMetadata - choice OTCTradeProposal_InitiateSettlement : ContractId OTCTrade - with - prepareUntil : Time - settleBefore : Time - controller venue - do - require "All trading parties have approved" (Set.fromList approvers == tradingParties transferLegs) - now <- getTime - require "Preparation time has not passed" (now < prepareUntil) - require "Preparation time before settlement time" (prepareUntil < settleBefore) - create OTCTrade with - venue - transferLegs - tradeCid = fromOptional self tradeCid - createdAt = now - prepareUntil - settleBefore + allocationRequest_RejectImpl _self AllocationRequest_Reject{..} = do + -- Note: this corresponds to signalling early that assets won't be allocated / that the trade is being rejected. + require "Actor is a trader" (F.any (\leg -> actor == leg.sender || actor == leg.receiver) otcTrade.transferLegs) + pure ChoiceExecutionMetadata with meta = emptyMetadata -tradeAllocations - : SettlementInfo -> TextMap Api.Token.AllocationV2.TransferLeg - -> TextMap AllocationSpecification -tradeAllocations settlementInfo transferLegs = - TextMap.fromList $ do - (transferLegId, transferLeg) <- TextMap.toList transferLegs - let spec = AllocationSpecification with - settlement = settlementInfo - transferLegs = TextMap.fromList [(transferLegId, transferLeg)] - pure (transferLegId, spec) + allocationRequest_WithdrawImpl _self _extraArgs = + -- just archiving the trade is enough + pure ChoiceExecutionMetadata with meta = emptyMetadata -template OTCTrade - with +template OTCTrade with venue : Party transferLegs : TextMap Api.Token.AllocationV2.TransferLeg - tradeCid : ContractId OTCTradeProposal createdAt : Time prepareUntil : Time settleBefore : Time where - signatory venue, tradingParties transferLegs + signatory venue + observer venue, tradingParties transferLegs - choice OTCTrade_Settle : TextMap Allocation_ExecuteTransferResult + nonconsuming choice OTCTrade_RequestAllocations : [ContractId OTCTradeAllocationRequest] + with + controller venue + do + now <- getTime + require "Preparation time has not passed" (now < prepareUntil) + require "Preparation time before settlement time" (prepareUntil < settleBefore) + let + legsByAdmin = + map TextMap.fromList $ + groupOn (\(_, tl) -> tl.instrumentId.admin) $ + TextMap.toList transferLegs + mapA (\transferLegs -> create (OTCTradeAllocationRequest (this with transferLegs) self)) legsByAdmin + + choice OTCTrade_Settle : Map Party (Map Party Allocation_ExecuteTransferResult) with - allocationsWithContext : TextMap (ContractId Allocation, ExtraArgs) + allocationsWithContext : Map Party (Map Party (ContractId Allocation, ExtraArgs)) + -- ^ Allocations sorted by admin and sender. + allocationRequests : [ContractId OTCTradeAllocationRequest] controller venue do + -- Could be safer by validating the requests match the trade, but venue is the only authorizer + -- so we can assume the checks happened off-ledger. + mapA_ archive allocationRequests -- check timing constraints now <- getTime require "Settlement deadline has not passed" (now < settleBefore) @@ -101,84 +91,96 @@ template OTCTrade let settlementInfo = SettlementInfo with executor = venue requestedAt = createdAt - settlementRef = makeTradeRef tradeCid + settlementRef = makeTradeRef self allocateBefore = prepareUntil settleBefore meta = emptyMetadata - controllerOverride = None - let expectedAllocations = tradeAllocations settlementInfo transferLegs - let mergedMaps = zipTextMaps allocationsWithContext expectedAllocations - forTextMapWithKey mergedMaps \legId (optAllocWithContext, optExpectedAlloc) -> do - let (allocCid, extraArgs) = fromSomeNote ("Allocation cid and extra arg is missing for leg " <> legId) optAllocWithContext - let expectedAlloc = fromSomeNote ("Allocation with context provided for unexpected leg " <> legId) optExpectedAlloc - -- fetch and validate the allocation instruction - instr <- fetch @Allocation allocCid - let instrView = view @Allocation instr - case matchAllocationWithMeta expectedAlloc instrView.allocation of - Right () -> return () - Left mismatch -> abort - ("Submitted allocation does not match expected allocation." <> "\nMismatch: " <> mismatch) - exercise allocCid (Allocation_ExecuteTransfer with extraArgs; extraAuth = None) + controllerOverride = Some [] + let expectedAllocations = expectedTradeAllocations settlementInfo transferLegs + let outerMergedMaps = zipMaps allocationsWithContext expectedAllocations + exercises <- forMapWithKey outerMergedMaps \admin (optAdminAllocsWithContext, optExpectedAdminAllocs) -> do + let adminAllocsWithContext = fromSomeNote ("Allocations are missing for admin " <> show admin) optAdminAllocsWithContext + let expectedAdminAllocs = fromSomeNote ("Allocation with context provided for unexpected admin " <> show admin) optExpectedAdminAllocs + let innerMergedMaps = zipMaps adminAllocsWithContext expectedAdminAllocs + forMapWithKey innerMergedMaps \trader (optAllocWithContext, optExpectedAlloc) -> do + let (allocCid, extraArgs) = fromSomeNote ("Allocation is missing for admin " <> show admin <> " and trader " <> show trader) optAllocWithContext + let expectedAlloc = fromSomeNote ("Allocation with context provided for unexpected admin " <> show admin) optExpectedAlloc + -- fetch and validate the allocation instruction + instr <- fetch @Allocation allocCid + let instrView = view @Allocation instr + case matchAllocationWithMeta expectedAlloc instrView.allocation of + Right () -> return () + Left mismatch -> abort + ("Submitted allocation does not match expected allocation." <> "\nMismatch: " <> mismatch) + -- Fetch extra auths + let requiredReceiverAuth = (view instr).requiredReceiverAuth + extraAuth <- forA requiredReceiverAuth + (\receiver -> do + debug ("authorizing incoming for " <> show admin <> ", " <> show trader <> ", " <> show receiver) + (recAllocCid, recExtraArgs) <- case Map.lookup receiver innerMergedMaps of + Some (optReceiverAllocWithContext, _) -> + return $ fromSomeNote ("Allocation is missing for admin " <> show admin <> " and trader " <> show receiver) optReceiverAllocWithContext + None -> abort ("Extra auth needed for receiver that is not present in any transfer legs: " <> show receiver) + exercise recAllocCid Allocation_AuthorizeIncoming with extraArgs = recExtraArgs + ) + -- on first pass don't settle yet as we may still need the extra auth. + return $ (allocCid, Allocation_ExecuteTransfer with extraArgs; extraAuth) + -- Exercise on second pass + Traversable.mapA (Traversable.mapA (uncurry exercise)) exercises -- NOTE: this choice is an approximation to what a real app would do. -- As it stands, the venue can't cancel allocations that come right after -- the first cancellation. A better approach would be to leave a marker -- contract in place until the `settleBefore` time, so that the venue -- retains the ability to cancel the allocations that are created. - choice OTCTrade_Cancel : TextMap (Optional Allocation_CancelResult) + choice OTCTrade_Cancel : [Allocation_CancelResult] with - allocationsWithContext : TextMap (ContractId Allocation, ExtraArgs) + allocationsWithContext : [(ContractId Allocation, ExtraArgs)] + allocationRequests : [ContractId OTCTradeAllocationRequest] controller venue do - -- validate and cancel transferLegs - let settlementInfo = SettlementInfo with - executor = venue - requestedAt = createdAt - settlementRef = makeTradeRef tradeCid - allocateBefore = prepareUntil - settleBefore - meta = emptyMetadata - controllerOverride = None - let expectedAllocations = tradeAllocations settlementInfo transferLegs - let mergedMaps = zipTextMaps allocationsWithContext expectedAllocations - -- fetch and validate the allocation instruction - forTextMapWithKey mergedMaps \legId (optAllocWithContext, optExpectedAlloc) -> - -- skip the leg if there is no matching allocation to cancel - Traversable.forA optAllocWithContext $ \(allocCid, extraArgs) -> do - -- fetch and validate the allocation instruction - let expectedAlloc = fromSomeNote ("Allocation with context provided for unexpected leg " <> legId) optExpectedAlloc - instr <- fetch @Allocation allocCid - let instrView = view @Allocation instr - case matchAllocationWithMeta expectedAlloc instrView.allocation of - Right () -> return () - Left mismatch -> abort - ("Submitted allocation does not match expected allocation." <> "\nMismatch: " <> mismatch) + mapA_ (\arCid -> do + ar <- fetch arCid + -- validate the allocation request matches this trade + ar.otcTradeCid === self + signatory ar === [venue] + archive arCid + ) + allocationRequests + mapA (\(allocCid, extraArgs) -> do + alloc <- fetch allocCid + -- validate the allocation request matches this trade + (view alloc).allocation.settlement.settlementRef === makeTradeRef self + (view alloc).allocation.settlement.executor === venue exercise allocCid (Allocation_Cancel extraArgs) + ) + allocationsWithContext - - interface instance AllocationRequest for OTCTrade where - view = AllocationRequestView with - settlement = SettlementInfo with - executor = venue - requestedAt = createdAt - settlementRef = makeTradeRef tradeCid - allocateBefore = prepareUntil - settleBefore - meta = emptyMetadata - controllerOverride = None - transferLegs - meta = emptyMetadata - - allocationRequest_RejectImpl _self AllocationRequest_Reject{..} = do - -- Note: this corresponds to signalling early that one is going to fail to deliver one's assets. - -- A real trading app will likely demand punitive charges for this. - require "Actor is a sender" (F.any (\leg -> actor == leg.sender) transferLegs) - pure ChoiceExecutionMetadata with meta = emptyMetadata - - allocationRequest_WithdrawImpl _self _extraArgs = - -- just archiving the trade is enough - pure ChoiceExecutionMetadata with meta = emptyMetadata +expectedTradeAllocations + : SettlementInfo -> TextMap Api.Token.AllocationV2.TransferLeg + -> Map Party (Map Party AllocationSpecification) +expectedTradeAllocations settlementInfo transferLegs = Map.fromList allocsByAdminAndTrader + where + legsByAdmin = + map (\tls@((_, tl)::_) -> (tl.instrumentId.admin, TextMap.fromList tls)) $ + groupOn (\(_, tl) -> tl.instrumentId.admin) $ + TextMap.toList transferLegs + tradersForLegs tls = dedup $ concatMap (\(_, tl) -> [tl.sender, tl.receiver]) (TextMap.toList tls) + legsForTrader tls trader = + TextMap.fromList $ + Prelude.filter (\(_, tl) -> tl.sender == trader || tl.receiver == trader) $ + TextMap.toList tls + allocForTraderAndLegs trader tls = AllocationSpecification with + settlement = settlementInfo + transferLegs = legsForTrader tls trader + allocsByTrader tls = map + (\trader -> (trader, allocForTraderAndLegs trader $ legsForTrader tls trader)) + (tradersForLegs tls) + allocsByAdminAndTrader = map + (\(admin, tls) -> (admin, Map.fromList (allocsByTrader tls))) + legsByAdmin + tradingParties : TextMap Api.Token.AllocationV2.TransferLeg -> Set.Set Party @@ -190,7 +192,7 @@ require : CanAssert m => Text -> Bool -> m () require msg invariant = assertMsg ("The requirement '" <> msg <> "' was not met.") invariant -makeTradeRef : ContractId OTCTradeProposal -> Api.Token.AllocationV2.Reference +makeTradeRef : ContractId OTCTrade -> Api.Token.AllocationV2.Reference makeTradeRef tradeCid = Api.Token.AllocationV2.Reference with id = "OTCTradeProposal" -- set to the name of the template to simplify debugging cid = Some (coerceContractId tradeCid) @@ -199,68 +201,19 @@ makeTradeRef tradeCid = Api.Token.AllocationV2.Reference with -- Additional text map utilities -------------------------------- -zipTextMaps : TextMap a -> TextMap b -> TextMap (Optional a, Optional b) -zipTextMaps m1 m2 = - TextMap.merge +zipMaps : (Ord k) => Map k a -> Map k b -> Map k (Optional a, Optional b) +zipMaps m1 m2 = + Map.merge (\_ v1 -> Some (Some v1, None)) (\_ v2 -> Some (None, Some v2)) (\_ v1 v2 -> Some (Some v1, Some v2)) m1 m2 -forTextMapWithKey : Applicative f => TextMap a -> (Text -> a -> f b) -> f (TextMap b) -forTextMapWithKey m f = - TextMap.fromList <$> mapA f' (TextMap.toList m) +forMapWithKey : (Ord k) => Applicative f => Map k a -> (k -> a -> f b) -> f (Map k b) +forMapWithKey m f = + Map.fromList <$> mapA f' (Map.toList m) where f' (k, v) = (k,) <$> f k v --- Utility for matching with metadata -------------------------------------- - --- If an app has an expected allocation and receives a allocation, it needs --- to check whether they match. The received may have extra metadata so a simple --- equality check is insufficient. This function checks that the received --- has only _additional_ metadata. - -matchMeta : Metadata -> Metadata -> Either Text () -matchMeta expected received = do - F.forA_ (TextMap.toList expected.values) (\(k, v) -> do - case TextMap.lookup k received.values of - None -> abort ("Entry missing in received metadata: " <> k) - Some w - | w == v -> return () - | otherwise -> abort ("Matadata entry " <> k <> "doesn't match.\nExpected: " <> v <> "\nReceived: " <> w) - ) - -matchLegs : TextMap TransferLeg -> TextMap TransferLeg -> Either Text () -matchLegs expected received = do - assertMsg - ("Expected " <> show (TextMap.size expected) <> " transfer legs. Received " <> show (TextMap.size received)) - (TextMap.size expected == TextMap.size received) - F.forA_ (TextMap.toList expected) (\(tlId, tl_e) -> do - tl_r <- case TextMap.lookup tlId received of - None -> abort ("Did not receive expected transfer leg with Id " <> tlId) - Some tl -> Right tl - let - baseExpected = tl_e with meta = emptyMetadata - baseReceived = tl_r with meta = emptyMetadata - baseExpected === baseReceived - matchMeta tl_e.meta tl_r.meta - ) - -matchAllocationWithMeta : AllocationSpecification -> AllocationSpecification -> Either Text () -matchAllocationWithMeta expected received = do - let - baseExpected = expected with - transferLegs = TextMap.empty - settlement = expected.settlement with - meta = emptyMetadata - baseReceived = received with - transferLegs = TextMap.empty - settlement = received.settlement with - meta = emptyMetadata - baseExpected === baseReceived - matchMeta expected.settlement.meta received.settlement.meta - matchLegs expected.transferLegs received.transferLegs - diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml index 546646567e..85909d88e6 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml @@ -24,7 +24,7 @@ module Splice.Testing.TokenStandard.WalletClientV2 listTransferOffers, -- * Reading allocations - listRequestedAllocations, + listRequestedAllocationsForAdmin, ) where @@ -119,17 +119,18 @@ listTransferOffers p instrumentId = do -- | List all allocations requested from the owner for a specific instrument. -- Currently targeting V1. --- TODO: Make this sensible. -listRequestedAllocations : Party -> HoldingV2.InstrumentId -> Script [AllocationV2.AllocationSpecification] -listRequestedAllocations p instrumentId = do +listRequestedAllocationsForAdmin : Party -> Party -> Script [AllocationV2.AllocationSpecification] +listRequestedAllocationsForAdmin p admin = do reqs <- queryInterface @AllocationRequestV2.AllocationRequest p trace reqs $ pure () let amuletAllocs = do (_reqCid, Some req) <- reqs - (tfId, tf) <- TextMap.toList req.transferLegs - guard (tf.instrumentId == instrumentId) - guard (p == tf.sender) + let transferLegs = do + (tfId, tf) <- TextMap.toList req.transferLegs + guard (tf.instrumentId.admin == admin) + guard (p == tf.sender || p == tf.receiver) + return (tfId, tf) pure AllocationV2.AllocationSpecification with settlement = req.settlement - transferLegs = TextMap.fromList [(tfId, tf)] + transferLegs = TextMap.fromList transferLegs pure amuletAllocs diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml index 9c8d5a63d9..71a0069780 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml @@ -20,6 +20,7 @@ import DA.Assert import DA.Foldable (forA_, foldMap) import DA.Optional (isSome) import DA.TextMap as TextMap hiding (filter) +import DA.Map as Map hiding (filter) import DA.Time import DA.Traversable qualified as Traversable @@ -49,6 +50,7 @@ data AllocatedOTCTrade = AllocatedOTCTrade registry : AmuletRegistry.AmuletRegistry otcTradeCid : ContractId OTCTrade otcTrade : OTCTrade + requestCid : ContractId OTCTradeAllocationRequest amuletId : InstrumentId deriving (Show, Eq) @@ -61,7 +63,7 @@ setupOtcTrade = do bob <- allocatePartyExact "bob" -- featured app provider - provider <- allocatePartyExact "trading-app-provider-party" + provider <- allocatePartyExact "trading-app-provider-party" providerBeneficiary1 <- allocatePartyExact "trading-app-investor1" providerBeneficiary2 <- allocatePartyExact "trading-app-investor2" let providerBeneficiaries = @@ -87,30 +89,26 @@ setupOtcTrade = do let aliceLeg = mkTransfer alice bob 100.0 let bobLeg = mkTransfer bob alice 20.0 - -- alice proposes trade with bob - proposalCid <- submit alice $ createCmd OTCTradeProposal with + -- venue creates a trade + now <- getTime + let settleBefore = now `addRelTime` hours 2 + otcTradeCid <- submit provider $ createCmd OTCTrade with venue = provider - tradeCid = None transferLegs = TextMap.fromList [("leg0", aliceLeg), ("leg1", bobLeg)] - approvers = [alice] - - -- bob accepts - proposalCid <- submit bob $ exerciseCmd proposalCid OTCTradeProposal_Accept with - approver = bob + prepareUntil = now `addRelTime` hours 1 + settleBefore + createdAt = now - -- provider initiates settlement - now <- getTime - let settleBefore = now `addRelTime` hours 2 - otcTradeCid <- submit provider $ - exerciseCmd proposalCid OTCTradeProposal_InitiateSettlement with - prepareUntil = now `addRelTime` hours 1 - settleBefore + -- venue requests settlement + [requestCid] <- submit provider $ + exerciseCmd otcTradeCid OTCTrade_RequestAllocations with Some otcTrade <- queryContractId provider otcTradeCid -- Alice sees the allocation request in her wallet - [aliceAlloc] <- WalletClient.listRequestedAllocations alice amuletId - let [(_, tl)] = TextMap.toList aliceAlloc.transferLegs + [aliceAlloc] <- WalletClient.listRequestedAllocationsForAdmin alice amuletId.admin + let + [(_, tl)] = filter (\(_, tl) -> tl.sender == alice) (TextMap.toList aliceAlloc.transferLegs) tl.amount === 100.0 -- alice accepts allocation request directly via her wallet @@ -127,6 +125,7 @@ setupOtcTrade = do inputHoldingCids = map coerceInterfaceContractId inputHoldingCids requestedAt = now extraArgs = emptyExtraArgs + creator = alice submitWithDisclosuresMustFail' alice enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg @@ -139,6 +138,7 @@ setupOtcTrade = do inputHoldingCids = map coerceInterfaceContractId inputHoldingCids requestedAt = now extraArgs = emptyExtraArgs + creator = alice result <- submitWithDisclosures' alice enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg @@ -151,12 +151,13 @@ setupOtcTrade = do expiresAt = Some settleBefore expiresAfter = None holders = [registry.dso] - context = Some "allocation for transfer leg \"leg0\" to 'bob'" + context = Some "allocation for settlement OTCTradeProposal" lockedHolding.lock === expectedLock -- Bob sees the allocation request in his wallet as well - [bobAlloc] <- WalletClient.listRequestedAllocations bob amuletId - let [(_, tl)] = TextMap.toList bobAlloc.transferLegs + [bobAlloc] <- WalletClient.listRequestedAllocationsForAdmin bob amuletId.admin + let + [(_, tl)] = filter (\(_, tl) -> tl.sender == bob) (TextMap.toList aliceAlloc.transferLegs) tl.amount === 20.0 -- bob accepts allocation request directly via her wallet @@ -167,6 +168,7 @@ setupOtcTrade = do inputHoldingCids = map coerceInterfaceContractId inputHoldingCids requestedAt = now extraArgs = emptyExtraArgs + creator = bob submitWithDisclosures' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg @@ -185,6 +187,7 @@ setupOtcTrade = do providerBeneficiaries otcTradeCid otcTrade + requestCid amuletId @@ -197,12 +200,13 @@ testDvP = script do passTime (hours 1) -- provider runs automation that completes the settlement - let otcTradeRef = (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef - allocations <- appBackendListAllocations provider otcTradeRef - TextMap.size allocations === 2 + let otcTradeRef = makeTradeRef otcTradeCid + allocationsMap <- appBackendListAllocations provider otcTradeRef + let [(_, amuletAllocations)] = Map.toList allocationsMap + Map.size amuletAllocations === 2 let beneficiaryMetadata = AmuletRegistry.beneficiariesToMetadata providerBeneficiaries - richAllocationsWithContext <- Traversable.forA allocations $ \(allocCid, _) -> do + richAllocationsWithContext <- Traversable.forA amuletAllocations $ \(allocCid, _) -> do context <- RegistryApi.getAllocation_TransferContext registry allocCid beneficiaryMetadata let extraArgs = ExtraArgs with context = context.choiceContext @@ -211,10 +215,11 @@ testDvP = script do let disclosures = foldMap fst richAllocationsWithContext results <- submitWithDisclosures' provider disclosures $ exerciseCmd otcTradeCid OTCTrade_Settle with - allocationsWithContext = fmap snd richAllocationsWithContext + allocationsWithContext = Map.fromList [(amuletId.admin, fmap snd richAllocationsWithContext)] + allocationRequests = [requestCid] -- check metadata - forA_ results $ \result -> expectBurn result.meta + forA_ results $ \result -> forA_ result $ \innerResult -> expectBurn innerResult.meta -- check that the expected transfers happened WalletClient.checkHoldingWithAmountExists alice amuletId 20.0 @@ -242,7 +247,7 @@ testDvP = script do unless (numCoupons == expectedNumCoupons ) $ fail $ "Expected " <> show expectedNumCoupons <> " coupons for " <> show b <> ", but got " <> show numCoupons - + debug aliceAmount checkCouponExists aliceAmount checkCouponExists bobAmount @@ -252,10 +257,13 @@ testDvP = script do -- TODO (DACH-NY/canton-network-node#17541):early abortion of settlement, unwinding of expired settlements, etc. pure () +testDvPCancel : Script () testDvPCancel = script do AllocatedOTCTrade{..} <- setupOtcTrade - let otcTradeRef = (view $ toInterface @AllocationRequest otcTrade).settlement.settlementRef - allocations <- appBackendListAllocations provider otcTradeRef + let otcTradeRef = makeTradeRef otcTradeCid + allocationsMap <- appBackendListAllocations provider otcTradeRef + let [(_, amuletAllocations)] = Map.toList allocationsMap + Map.size amuletAllocations === 2 [(_, aliceLockedHolding)] <- WalletClient.listLockedHoldings alice registry.instrumentId [(bobLockedHoldingCid, _)] <- WalletClient.listLockedHoldings bob registry.instrumentId @@ -265,7 +273,7 @@ testDvPCancel = script do -- expire the amulet for bob to test both cases where the amulet still exists for alice and where it doesn't for bob AmuletRegistry.expireLockAsOwner registry bobLockedHoldingCid - richAllocationsWithContext <- Traversable.forA allocations $ \(allocCid, _) -> do + richAllocationsWithContext <- Traversable.forA amuletAllocations $ \(allocCid, _) -> do context <- RegistryApi.getAllocation_CancelContext registry allocCid emptyMetadata let extraArgs = ExtraArgs with context = context.choiceContext @@ -274,7 +282,8 @@ testDvPCancel = script do let disclosures = foldMap fst richAllocationsWithContext _ <- submitWithDisclosures' provider disclosures $ exerciseCmd otcTradeCid OTCTrade_Cancel with - allocationsWithContext = fmap snd richAllocationsWithContext + allocationsWithContext = Map.values $ fmap snd richAllocationsWithContext + allocationRequests = [requestCid] [] <- WalletClient.listLockedHoldings alice registry.instrumentId WalletClient.checkHoldingWithAmountExists alice amuletId aliceLockedHolding.amount @@ -284,6 +293,7 @@ testDvPCancel = script do pure () +testDvPWithdraw : Script () testDvPWithdraw = script do AllocatedOTCTrade{..} <- setupOtcTrade [(aliceAllocationCid, _)] <- queryInterface @Allocation alice @@ -312,16 +322,19 @@ testDvPWithdraw = script do -- utilities ------------ --- | List all allocations matching a particular settlement reference, sorted by their tradeLeg id. +-- | List all allocations matching a particular settlement reference, sorted by their admin and trader. -- This function would be run on the trading app provider's backend as part of an automation loop. -appBackendListAllocations : Party -> Reference -> Script (TextMap (ContractId Allocation, AllocationView)) +appBackendListAllocations : Party -> Reference -> Script (Map Party (Map Party (ContractId Allocation, AllocationView))) appBackendListAllocations p ref = do allocs <- queryInterface @Allocation p let matchingAllocs = do (cid, Some fundedAllocation) <- allocs guard (fundedAllocation.allocation.settlement.settlementRef == ref) - map (\(transferLegId, _) -> (transferLegId, (cid, fundedAllocation))) (TextMap.toList fundedAllocation.allocation.transferLegs) - pure $ TextMap.fromList matchingAllocs + let (_, tl)::_ = TextMap.toList fundedAllocation.allocation.transferLegs + admin = tl.instrumentId.admin + [sender] = fundedAllocation.senders + return (admin, Map.fromList [(sender, (cid, fundedAllocation))]) + pure $ Map.fromListWithR Map.union matchingAllocs expectBurn : Metadata -> Script () expectBurn meta = diff --git a/token-standard/splice-token-standard-test/daml/Splice/Tests/TestAmuletTokenDvP.daml b/token-standard/splice-token-standard-test/daml/Splice/Tests/TestAmuletTokenDvP.daml index 7c542e90f5..9b915ddcbe 100644 --- a/token-standard/splice-token-standard-test/daml/Splice/Tests/TestAmuletTokenDvP.daml +++ b/token-standard/splice-token-standard-test/daml/Splice/Tests/TestAmuletTokenDvP.daml @@ -150,7 +150,7 @@ setupOtcTrade = do expiresAt = Some settleBefore expiresAfter = None holders = [registry.dso] - context = Some "allocation for transfer leg \"leg0\" to 'bob'" + context = Some "allocation for settlement OTCTradeProposal" lockedHolding.lock === expectedLock -- Bob sees the allocation request in his wallet as well From 3a49ce1db4f211474e2b91a21d78b6c530788538 Mon Sep 17 00:00:00 2001 From: bame-da Date: Sun, 2 Nov 2025 08:53:58 +0000 Subject: [PATCH 09/11] Resolve any rebase issues --- .vscode/settings.json | 3 ++- build.sbt | 13 +++------ .../daml/Splice/Amulet/TwoStepTransfer.daml | 5 +--- .../daml/Splice/ExternalPartyAmuletRules.daml | 2 +- .../Testing/Registries/AmuletRegistryV2.daml | 27 +++++++++++++++++++ 5 files changed, 35 insertions(+), 15 deletions(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index a94c5892b5..709986bc34 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -34,5 +34,6 @@ }, "metals.inlayHints.implicitArguments.enable": true, "metals.inlayHints.implicitConversions.enable": true, - "makefile.configureOnOpen": false + "makefile.configureOnOpen": false, + "daml.useDPMWhenAvailable": false } diff --git a/build.sbt b/build.sbt index 0f16717006..cd95eb44fa 100644 --- a/build.sbt +++ b/build.sbt @@ -416,12 +416,8 @@ lazy val `splice-api-token-transfer-instruction-v2-daml` = val transferInstructionOpenApiFile = baseDirectory.value / "openapi/transfer-instruction-v2.yaml" - val npmName = "transfer-instruction-openapi" - BuildCommon.TS.generateOpenApiClient( - npmName = npmName, - npmModuleName = npmName, - npmProjectName = npmName, + unscopedNpmName = "transfer-instruction-openapi", openApiSpec = "transfer-instruction-v2.yaml", cacheFileDependencies = Set(transferInstructionOpenApiFile), directory = "openapi-ts-client", @@ -530,7 +526,7 @@ lazy val `splice-token-test-trading-app-daml` = (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-holding-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value, + (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ (`splice-util-daml` / Compile / damlBuild).value ++ @@ -547,15 +543,14 @@ lazy val `splice-api-token-utils-v2-daml` = Compile / damlDependencies := (`splice-api-token-metadata-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-holding-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value, + (`splice-api-token-allocation-request-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-holding-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v1-daml` / Compile / damlBuild).value ++ (`splice-api-token-allocation-instruction-v2-daml` / Compile / damlBuild).value ++ (`splice-api-token-transfer-instruction-v1-daml` / Compile / damlBuild).value ++ - (`splice-api-token-transfer-instruction-v2-daml` / Compile / damlBuild).value , + (`splice-api-token-transfer-instruction-v2-daml` / Compile / damlBuild).value, ) .dependsOn(`canton-bindings-java`) diff --git a/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml b/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml index 49b01b57c3..61b40c289f 100644 --- a/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml +++ b/daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml @@ -79,10 +79,7 @@ prepareTwoStepTransfer TwoStepTransfer{..} requestedAt inputHoldingCids paymentC ) outputs expectedTransferFees <- sum <$> exerciseComputeFees dso paymentContext sender receiverOutputsForActualTransfer - openRound <- fetchChecked (ForDso with dso) paymentContext.context.openMiningRound - let lockDuration = transferBefore `subTime` requestedAt - let approximateHoldingFees = holdingFeesForDuration lockDuration openRound - let feesReserveAmount = (expectedTransferFees + approximateHoldingFees) * feeReserveMultiplier + let feesReserveAmount = expectedTransferFees * feeReserveMultiplier -- lock the amulet transferInputs <- holdingToTransferInputs (ForOwner with dso; owner = sender) paymentContext inputHoldingCids diff --git a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml index b887b93f3a..1353e8491e 100644 --- a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml @@ -302,7 +302,7 @@ amulet_transferFactory_transferImpl this _self arg = do -- execute a self-transfer paymentContext <- unfeaturedPaymentContextFromChoiceContext dso extraArgs.context inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext transfer.inputHoldingCids - result <- exercisePaymentTransfer paymentContext Transfer with + result <- exercisePaymentTransfer dso paymentContext Transfer with sender = transfer.sender provider = transfer.sender inputs diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml index aa501f1f62..66262bbf3c 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml @@ -41,6 +41,7 @@ import Splice.Api.Token.AllocationInstructionV2 import Splice.Api.Token.TransferInstructionV2 import Splice.Amulet +import Splice.AmuletConfig hiding (Amulet) import Splice.Amulet.TokenApiUtils import Splice.AmuletAllocation import Splice.AmuletTransferInstruction @@ -48,6 +49,7 @@ import Splice.AmuletRules import Splice.Expiry import Splice.ExternalPartyAmuletRules import Splice.Fees +import Splice.Schedule import Splice.Round import Splice.Testing.UtilsV2 @@ -84,6 +86,7 @@ data AmuletRegistryConfig = AmuletRegistryConfig with initialAmuletPrice : Decimal demoTime : Time + noTransferFee : Bool -- ^ If true then the transfer fee is set to zero to test their removal deriving (Eq, Show) -- | Recommended default configuration for setting up the mock amulet registry. @@ -91,6 +94,20 @@ defaultAmuletRegistryConfig : AmuletRegistryConfig defaultAmuletRegistryConfig = AmuletRegistryConfig with initialAmuletPrice = 0.5 -- a non-zero price that still makes it easy to reason about fees and amounts demoTime = time (DA.Date.date 2022 Jan 1) 0 0 0 + noTransferFee = False -- charge fees by default as dealing with them is important as long as they are being charged + +noTransferFeeConfig : TransferConfig USD +noTransferFeeConfig = TransferConfig with + createFee = FixedFee 0.0 + holdingFee = RatePerRound 0.00002 + lockHolderFee = FixedFee 0.0 + transferFee = SteppedRate with + initialRate = 0.0 + steps = [] + extraFeaturedAppRewardAmount = 1.0 + maxNumInputs = 100 + maxNumOutputs = 100 + maxNumLockHolders = 10 -- | Initialize the mock amulet registry. initialize : AmuletRegistryConfig -> Script AmuletRegistry @@ -103,6 +120,14 @@ initialize config = do dso instrumentId = amuletInstrumentId dso + let amuletConfig + | config.noTransferFee = defaultAmuletConfig with + transferConfig = noTransferFeeConfig + | otherwise = defaultAmuletConfig + let defaultAmuletConfigSchedule = Schedule with + initialValue = amuletConfig + futureValues = [] + _ <- submit dso $ createCmd AmuletRules with configSchedule = defaultAmuletConfigSchedule isDevNet = True @@ -114,10 +139,12 @@ initialize config = do submit registry.dso $ exerciseCmd amuletRulesCid AmuletRules_Bootstrap_Rounds with amuletPrice = config.initialAmuletPrice round0Duration = minutes 10 -- no special setup for normal tests + initialRound = None -- return the off-ledger reference to the registry for later script steps return registry + -- | Tap the faucet on DevNet to get a specified amount of Amulet. tapFaucet : AmuletRegistry -> Party -> Decimal -> Script (ContractId Holding) tapFaucet registry user amount = do From 214c464ca658d296c7971b4fc07474d165c19138 Mon Sep 17 00:00:00 2001 From: bame-da Date: Sat, 15 Nov 2025 10:19:39 +0000 Subject: [PATCH 10/11] Incorporate timings changes --- .../daml/Splice/AmuletAllocation.daml | 22 +++++++--- .../daml/Splice/AmuletRules.daml | 2 +- daml/splice-amulet/daml/Splice/Expiry.daml | 31 +++++++++++--- .../daml/Splice/ExternalPartyAmuletRules.daml | 23 +++++++--- .../daml/Splice/Scripts/TestWallet.daml | 6 +-- .../daml/Splice/Api/Token/AllocationV2.daml | 19 ++++----- .../daml/Splice/Api/Token/UtilsV2.daml | 42 ++++++++++++++++--- .../Splice/Testing/Apps/TradingAppV2.daml | 23 +++++----- .../Testing/Registries/AmuletRegistryV2.daml | 2 +- .../daml/Splice/Tests/TestAmuletTokenDvP.daml | 21 +++++----- .../Testing/Registries/AmuletRegistry.daml | 2 +- 11 files changed, 132 insertions(+), 61 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/AmuletAllocation.daml b/daml/splice-amulet/daml/Splice/AmuletAllocation.daml index 4f6d80ad69..6857b43bfc 100644 --- a/daml/splice-amulet/daml/Splice/AmuletAllocation.daml +++ b/daml/splice-amulet/daml/Splice/AmuletAllocation.daml @@ -3,6 +3,7 @@ module Splice.AmuletAllocation ( AmuletAllocation(..), + allocationAmount, allocationToTwoStepTransfer, ) where @@ -29,6 +30,7 @@ template AmuletAllocation allocation : AllocationSpecification sender : Party admin : Party + expiresAt : Time where signatory admin, sender observer allocation.settlement.executor @@ -49,6 +51,7 @@ template AmuletAllocation meta = emptyMetadata senders = [sender] requiredReceiverAuth = (defaultAllocationControllers allocation) \\ (sender::allocationControllers allocation) + expiresAt = Some expiresAt allocation_executeTransferImpl self Allocation_ExecuteTransfer{..} = case extraAuth of [] -> transferAmuletAllocation this extraArgs @@ -98,15 +101,21 @@ allocationReceivers AllocationSpecification{..} = -- Allocation usage ------------------- -allocationToTwoStepTransfer : Party -> Party -> AllocationSpecification -> TwoStepTransfer -allocationToTwoStepTransfer sender admin allocation = +allocationAmount : Party -> AllocationSpecification -> Decimal +allocationAmount sender allocation = sum (map (._2) outputs) + where + senderLegs = filter (\tl -> tl.sender == sender) $ map snd (TextMap.toList allocation.transferLegs) + outputs = map (\tl -> (tl.receiver, tl.amount)) senderLegs + +allocationToTwoStepTransfer : Party -> Party -> Time -> AllocationSpecification -> TwoStepTransfer +allocationToTwoStepTransfer sender admin expiresAt allocation = TwoStepTransfer with dso = admin sender = sender outputs provider = allocation.settlement.executor - transferBefore = allocation.settlement.settleBefore - transferBeforeDeadline = "allocation.settlement.settleBefore" + transferBefore = expiresAt + transferBeforeDeadline = "allocation.expiresAt" allowFeaturing = True lockContext = Text.implode -- We don't show more context to avoid bloating the response here. @@ -115,6 +124,7 @@ allocationToTwoStepTransfer sender admin allocation = senderLegs = filter (\tl -> tl.sender == sender) $ map snd (TextMap.toList allocation.transferLegs) outputs = map (\tl -> (tl.receiver, tl.amount)) senderLegs + collectAuthAndSettle : ContractId AmuletAllocation -> ExtraArgs -> [ContractId AllocationTransferAuthorization] -> [Party] -> Update Allocation_ExecuteTransferResult collectAuthAndSettle allocationCid extraArgs extraAuth extraControllers = do case extraAuth of @@ -128,7 +138,7 @@ collectAuthAndSettle allocationCid extraArgs extraAuth extraControllers = do transferAmuletAllocation : AmuletAllocation -> ExtraArgs -> Update Allocation_ExecuteTransferResult transferAmuletAllocation amuletAllocation extraArgs = do - let twoStepTransfer = allocationToTwoStepTransfer amuletAllocation.sender amuletAllocation.admin amuletAllocation.allocation + let twoStepTransfer = allocationToTwoStepTransfer amuletAllocation.sender amuletAllocation.admin amuletAllocation.expiresAt amuletAllocation.allocation (senderHoldingCids, receiverHoldingCids, meta) <- executeTwoStepTransfer twoStepTransfer amuletAllocation.lockedAmulet extraArgs pure Allocation_ExecuteTransferResult @@ -139,7 +149,7 @@ transferAmuletAllocation amuletAllocation extraArgs = do unlockAmuletAllocation : AmuletAllocation -> ExtraArgs -> Update [ContractId Holding] unlockAmuletAllocation amuletAllocation extraArgs = do - let twoStepTransfer = allocationToTwoStepTransfer amuletAllocation.sender amuletAllocation.admin amuletAllocation.allocation + let twoStepTransfer = allocationToTwoStepTransfer amuletAllocation.sender amuletAllocation.admin amuletAllocation.expiresAt amuletAllocation.allocation abortTwoStepTransfer twoStepTransfer amuletAllocation.lockedAmulet extraArgs template AmuletAllocationTransferAuthorization diff --git a/daml/splice-amulet/daml/Splice/AmuletRules.daml b/daml/splice-amulet/daml/Splice/AmuletRules.daml index 758ed8bbb3..b704745b8d 100644 --- a/daml/splice-amulet/daml/Splice/AmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/AmuletRules.daml @@ -1117,7 +1117,7 @@ createTransferOutputs currentOpenRound transferConfigAmulet dso sender summary p Some lock -> do -- We require the lock to expire before the amulet to allow app authors to -- assume that a locked amulet is never archived by standard DSO while the lock is held. - require "lock expires before amulet" + require ("lock expiry " <> show lock.expiresAt <> " is before amulet expires") (doesLockExpireBeforeAmulet currentOpenRound lock amulet.amount currentOpenRound.tickDuration) TransferResultLockedAmulet <$> create LockedAmulet with amulet; lock diff --git a/daml/splice-amulet/daml/Splice/Expiry.daml b/daml/splice-amulet/daml/Splice/Expiry.daml index ca76604b8a..9c9a125da8 100644 --- a/daml/splice-amulet/daml/Splice/Expiry.daml +++ b/daml/splice-amulet/daml/Splice/Expiry.daml @@ -6,6 +6,7 @@ module Splice.Expiry ( BoundedSet(..) , TimeLock(..) , doesLockExpireBeforeAmulet + , maxExpiry , isAmuletExpired -- for testing , amountExpiresAt @@ -134,11 +135,11 @@ addBoundedRelTime d (Singleton rt) | otherwise = Singleton (addRelTime d rt) addBoundedRelTime _ AfterMaxBound = AfterMaxBound --- | Check if a time is less than a bounded set. +-- | Check if a time is less or equal than a bounded set. -- If the bounded set is a `AfterMaxBound`, it will already return true. -boundedLessTime : Time -> BoundedSet Time -> Bool -boundedLessTime t1 (Singleton t2) = t1 < t2 -boundedLessTime _ AfterMaxBound = True +boundedLessEqTime : Time -> BoundedSet Time -> Bool +boundedLessEqTime t1 (Singleton t2) = t1 < t2 +boundedLessEqTime _ AfterMaxBound = True -- Amount expiry @@ -193,7 +194,27 @@ doesLockExpireBeforeAmulet currentOpenRound lock e tickDuration = optAmuletExpiresAt = estimateOpenRoundCreatedAt tickDuration currentOpenRound expiringRound in case optAmuletExpiresAt of None -> False -- as the amulet is already expired - Some amuletExpiresAt -> lock.expiresAt `boundedLessTime` amuletExpiresAt + Some amuletExpiresAt -> lock.expiresAt `boundedLessEqTime` amuletExpiresAt + +-- | `maxExpiry` computes the maximum expiry time for a `TimeLock` for a given `ExpiringAmount`. +maxExpiry : OpenMiningRound -> Decimal -> Time +maxExpiry currentOpenRound initialAmount = + let + ratePerRound = scaleRatePerRound (1.0 / currentOpenRound.amuletPrice) currentOpenRound.transferConfigUsd.holdingFee + e = ExpiringAmount with + initialAmount + createdAt = currentOpenRound.round + ratePerRound + r = amountExpiresAt e + -- Note: we exploit that there are exactly three open rounds active at any + -- point in time;(Singleton and we ensure that a amulet can be expired as soon as it can + -- definitely not be used as an input to transfer anymore. + expiringRound = addToBoundedRound r (RelRound 2) + optAmuletExpiresAt = estimateOpenRoundCreatedAt currentOpenRound.tickDuration currentOpenRound expiringRound + in case optAmuletExpiresAt of + None -> currentOpenRound.opensAt -- as the amulet is already expired + Some (Singleton t) -> t + Some (AfterMaxBound) -> maxTime -- | `isAmuletExpired openRound amuletAmount` computes whether the expiring `amuletAmount` -- is definitely expired in case the `openRound` is open. diff --git a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml index 1353e8491e..a6727de146 100644 --- a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml @@ -22,6 +22,7 @@ import Splice.Amulet.TwoStepTransfer import Splice.AmuletAllocation import Splice.AmuletTransferInstruction import Splice.AmuletRules +import Splice.Expiry (maxExpiry) import Splice.Types import Splice.Util @@ -388,10 +389,19 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do -- settlement.settlementRef: no check -- settlement.requestedAt: assertDeadlineExceeded "Allocation.settlement.requestedAt" settlement.requestedAt - -- settlement.allocateBefore: - assertWithinDeadline "Allocation.settlement.allocateBefore" settlement.allocateBefore - -- settlement.settleBefore: - require "Allocation.settlement.allocateBefore <= Allocation.settlement.settleBefore" (settlement.allocateBefore <= settlement.settleBefore) + -- settlement.settlementDeadline: + whenSome settlement.settlementDeadline \d -> do + assertWithinDeadline "Allocation.settlement.settlementDeadline" d + + openMiningRound <- fetch paymentContext.context.openMiningRound + + let sender = creator + let amount = allocationAmount sender arg.allocation + let expiresAt = min + (maxExpiry openMiningRound amount) + (fromOptional maxTime allocation.settlement.settlementDeadline) + require "Allocation.settlement.settleAt <= Allocation.expiresAt" + (settlement.settleAt <= expiresAt) forA_ transferLegs (\transferLeg -> do -- transferLegId: no check @@ -412,8 +422,8 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do require "At least one input holding must be provided" (not $ null inputHoldingCids) -- lock the funds - let sender = creator - let twoStepTransfer = allocationToTwoStepTransfer sender dso arg.allocation + let twoStepTransfer = allocationToTwoStepTransfer sender dso expiresAt arg.allocation + (lockedAmulet, senderChangeCids, meta) <- prepareTwoStepTransfer twoStepTransfer arg.requestedAt inputHoldingCids paymentContext -- create the amulet allocation @@ -422,6 +432,7 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do lockedAmulet admin = dso sender + expiresAt -- finaly done: return the result pure AllocationInstructionResult with diff --git a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml index 6a296ace06..1f6024cebc 100644 --- a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml +++ b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml @@ -1109,13 +1109,13 @@ testTokenStandardAllocate = script do -- provider proposes a trade for alice with herself now <- getTime - let settleBefore = now `addRelTime` hours 2 + let settleAt = now `addRelTime` hours 1 proposalCid <- submit provider $ createCmd OTCTrade with venue = provider transferLegs = TextMap.fromList [("leg0", aliceLeg)] - prepareUntil = now `addRelTime` hours 1 - settleBefore + settleAt createdAt = now + settlementDeadline = None -- provider initiates settlement diff --git a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml index 610e128b4c..92c5ed28f5 100644 --- a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml +++ b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml @@ -39,22 +39,18 @@ data SettlementInfo = SettlementInfo requestedAt : Time -- ^ When the settlement was requested. Provided for display and debugging purposes, -- but SHOULD be in the past. - allocateBefore : Time - -- ^ Until when (exclusive) the senders are given time to allocate their assets. - -- This field has a particular relevance with respect to instrument versioning / corporate - -- actions, in that the settlement pertains to the instrument version resulting from the - -- processing of all corporate actions falling strictly before the `allocateBefore` time. - settleBefore : Time - -- ^ Until when (exclusive) the executor is given time to execute the settlement. - -- - -- SHOULD be strictly after `allocateBefore`. + settleAt : Time + -- ^ The earliest settlement time. Allocations should be made before this time. Settlement + -- happens at any point after this time. meta : Metadata -- ^ Additional metadata about the settlement, used for extensibility. controllerOverride : Optional [Party] -- ^ Additional party signatures in addition to executor that need to authorize -- choices on the Allocation. Defaults to senders and receivers across all -- transferLegs. - + settlementDeadline : Optional Time + -- ^ The latest point at which settlement will occur. This allows registries + -- to set appropriate locks and expiries. deriving (Show, Eq) -- | A specification of a transfer of holdings between two parties for the @@ -104,6 +100,9 @@ data AllocationView = AllocationView with requiredReceiverAuth : [Party] -- ^ The extra authority this allocation needs for settlement on top of -- the controllers specified via allocation.settlement.controllerOverride + expiresAt : Optional Time + -- ^ A time at which this allocation expires. SHOULD be as close as the + -- registry can make it to the settlementInfo's settlementDeadline. deriving (Show, Eq) -- | View of a delegated authority from the signer to the execurot to settle given transfer legs. diff --git a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml index 5e89b47a38..b5abc75139 100644 --- a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml +++ b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml @@ -16,6 +16,26 @@ import Splice.Api.Token.AllocationInstructionV1 qualified as AllocationInstructi import Splice.Api.Token.AllocationInstructionV2 qualified as AllocationInstructionV2 import Splice.Api.Token.TransferInstructionV1 qualified as TransferInstructionV1 import Splice.Api.Token.TransferInstructionV2 qualified as TransferInstructionV2 +import DA.Time +import DA.Date +import DA.Text (parseInt) +import DA.Optional (fromOptional) + +-- Utils +-------- +epoch : Time +epoch = time (date 1970 Jan 1) 0 0 0 + +maxTime : Time +maxTime = time (date 9999 Dec 31) 23 59 59 + +encodeTime : Time -> Text +encodeTime t = show (convertRelTimeToMicroseconds(t `subTime` epoch)) + +decodeTime : Text -> Time +decodeTime t = case parseInt t of + Some i -> epoch `addRelTime` (convertMicrosecondsToRelTime i) + None -> error ("Cannot parse time " <> t) -- Holding ---------- @@ -71,10 +91,10 @@ settlement_info_v1_to_v2 AllocationV1.SettlementInfo{..} = v2 executor settlementRef = reference_v1_to_v2 settlementRef requestedAt - allocateBefore - settleBefore + settleAt = allocateBefore meta - controllerOverride = None + controllerOverride + settlementDeadline = if settleBefore == maxTime then None else Some settleBefore transfer_leg_v1_to_v2 : AllocationV1.TransferLeg -> AllocationV2.TransferLeg transfer_leg_v1_to_v2 AllocationV1.TransferLeg{..} = @@ -100,6 +120,7 @@ allocation_view_v1_to_v2 AllocationV1.AllocationView{..} = meta senders requiredReceiverAuth + expiresAt where senders = case TextMap.lookup "canton.network/senders" meta.values of None -> [allocation.transferLeg.sender] @@ -107,6 +128,10 @@ allocation_view_v1_to_v2 AllocationV1.AllocationView{..} = requiredReceiverAuth = case TextMap.lookup "canton.network/requiredReceiverAuth" meta.values of None -> [] Some ol -> [] -- TODO: Parse extra auth list. + expiresAt = Some $ optional + (allocation.settlement.settleBefore) + decodeTime + (TextMap.lookup "canton.network/expiresAt" meta.values) -- Downcast @@ -121,12 +146,13 @@ settlement_info_v2_to_v1 AllocationV2.SettlementInfo{..} = v1 TextMap.insert "canton.network/version" "v2" $ TextMap.insert "canton.network/controllerOverride" (show controllerOverride) $ meta.values + v1 = AllocationV1.SettlementInfo with executor settlementRef = reference_v2_to_v1 settlementRef requestedAt - allocateBefore - settleBefore + allocateBefore = settleAt + settleBefore = fromOptional maxTime settlementDeadline meta = meta' transfer_leg_v2_to_v1 : AllocationV2.TransferLeg -> AllocationV1.TransferLeg @@ -159,11 +185,15 @@ allocation_view_v2_to_v1 AllocationV2.AllocationView{..} = holdingCids = map coerceInterfaceContractId holdingCids meta = meta' where + insertOptional k ov m = case ov of + None -> m + Some v -> TextMap.insert k v m meta' = Metadata with values = TextMap.insert "canton.network/version" "v2" $ - TextMap.insert "canton.network/senders" (show senders) $ + TextMap.insert "canton.network/senders" (show senders) $ TextMap.insert "canton.network/requiredReceiverAuth" (show requiredReceiverAuth) $ + insertOptional "canton.network/expiresAt" (fmap encodeTime expiresAt) $ meta.values -- Choices diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml index cd81965cc9..6bac736011 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml @@ -20,6 +20,11 @@ import DA.Foldable (mapA_) import DA.List.Total (dedup) import DA.Assert ((===)) import qualified DA.Traversable as Traversable +import DA.Time +import DA.Date + +maxTime : Time +maxTime = time (date 9999 Dec 31) 23 59 59 template OTCTradeAllocationRequest with otcTrade : OTCTrade @@ -34,10 +39,10 @@ template OTCTradeAllocationRequest with executor = otcTrade.venue requestedAt = otcTrade.createdAt settlementRef = makeTradeRef otcTradeCid - allocateBefore = otcTrade.prepareUntil - settleBefore = otcTrade.settleBefore + settleAt = otcTrade.settleAt meta = emptyMetadata controllerOverride = Some [] -- We will settle using only executor authority. + settlementDeadline = otcTrade.settlementDeadline transferLegs = otcTrade.transferLegs meta = emptyMetadata @@ -54,8 +59,8 @@ template OTCTrade with venue : Party transferLegs : TextMap Api.Token.AllocationV2.TransferLeg createdAt : Time - prepareUntil : Time - settleBefore : Time + settleAt : Time + settlementDeadline : Optional Time where signatory venue observer venue, tradingParties transferLegs @@ -64,9 +69,6 @@ template OTCTrade with with controller venue do - now <- getTime - require "Preparation time has not passed" (now < prepareUntil) - require "Preparation time before settlement time" (prepareUntil < settleBefore) let legsByAdmin = map TextMap.fromList $ @@ -84,18 +86,15 @@ template OTCTrade with -- Could be safer by validating the requests match the trade, but venue is the only authorizer -- so we can assume the checks happened off-ledger. mapA_ archive allocationRequests - -- check timing constraints - now <- getTime - require "Settlement deadline has not passed" (now < settleBefore) -- validate and execute transferLegs let settlementInfo = SettlementInfo with executor = venue requestedAt = createdAt settlementRef = makeTradeRef self - allocateBefore = prepareUntil - settleBefore + settleAt meta = emptyMetadata controllerOverride = Some [] + settlementDeadline let expectedAllocations = expectedTradeAllocations settlementInfo transferLegs let outerMergedMaps = zipMaps allocationsWithContext expectedAllocations exercises <- forMapWithKey outerMergedMaps \admin (optAdminAllocsWithContext, optExpectedAdminAllocs) -> do diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml index 66262bbf3c..8b2eb94807 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml @@ -296,7 +296,7 @@ registryApi_getAllocation_abortTwoStepTransferContext registry instrCid = do let lockedAmuletActive = isSome optLockedAmulet -- this can only happen if the locked amulet already expired now <- getTime - unless (lockedAmuletActive || amuletAlloc.allocation.settlement.settleBefore <= now) $ + unless (lockedAmuletActive || amuletAlloc.expiresAt <= now) $ fail "Invariant violation: the locked amulet is archived, but the settlement is not yet expired" -- this context communicates whether to unlock the amulet let expireLockC = OpenApiChoiceContext with diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml index 71a0069780..39ddee9824 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml @@ -18,7 +18,7 @@ import Daml.Script import DA.Action (unless) import DA.Assert import DA.Foldable (forA_, foldMap) -import DA.Optional (isSome) +import DA.Optional (fromSome, isSome) import DA.TextMap as TextMap hiding (filter) import DA.Map as Map hiding (filter) import DA.Time @@ -91,13 +91,14 @@ setupOtcTrade = do -- venue creates a trade now <- getTime - let settleBefore = now `addRelTime` hours 2 + let settleAt = now `addRelTime` hours 1 + deadline = now `addRelTime` hours 2 otcTradeCid <- submit provider $ createCmd OTCTrade with venue = provider transferLegs = TextMap.fromList [("leg0", aliceLeg), ("leg1", bobLeg)] - prepareUntil = now `addRelTime` hours 1 - settleBefore + settleAt createdAt = now + settlementDeadline = Some deadline -- venue requests settlement [requestCid] <- submit provider $ @@ -146,13 +147,15 @@ setupOtcTrade = do expectBurn result.meta -- check lock context - [(_, lockedHolding)] <- WalletClient.listLockedHoldings alice registry.instrumentId - let expectedLock = Some $ Lock with - expiresAt = Some settleBefore + [(_, lockedHolding)] <- WalletClient.listLockedHoldings alice registry.instrumentId + let expectedLock = Lock with + expiresAt = None expiresAfter = None holders = [registry.dso] context = Some "allocation for settlement OTCTradeProposal" - lockedHolding.lock === expectedLock + ((fromSome lockedHolding.lock) with expiresAt = None) === expectedLock + assertMsg "locks expire should be in the future" + (fromSome (fromSome lockedHolding.lock).expiresAt > now) -- Bob sees the allocation request in his wallet as well [bobAlloc] <- WalletClient.listRequestedAllocationsForAdmin bob amuletId.admin @@ -280,11 +283,9 @@ testDvPCancel = script do meta = emptyMetadata pure (context.disclosures, (allocCid, extraArgs)) let disclosures = foldMap fst richAllocationsWithContext - _ <- submitWithDisclosures' provider disclosures $ exerciseCmd otcTradeCid OTCTrade_Cancel with allocationsWithContext = Map.values $ fmap snd richAllocationsWithContext allocationRequests = [requestCid] - [] <- WalletClient.listLockedHoldings alice registry.instrumentId WalletClient.checkHoldingWithAmountExists alice amuletId aliceLockedHolding.amount diff --git a/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry.daml b/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry.daml index 8a1715f8be..096eb5bc02 100644 --- a/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry.daml +++ b/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry.daml @@ -303,7 +303,7 @@ registryApi_getAllocation_abortTwoStepTransferContext registry instrCid = do let lockedAmuletActive = isSome optLockedAmulet -- this can only happen if the locked amulet already expired now <- getTime - unless (lockedAmuletActive || amuletAlloc.allocation.settlement.settleBefore <= now) $ + unless (lockedAmuletActive || amuletAlloc.expiresAt <= now) $ fail "Invariant violation: the locked amulet is archived, but the settlement is not yet expired" -- this context communicates whether to unlock the amulet let expireLockC = OpenApiChoiceContext with From 74cd702c28002790412fb62a7033b9acf937e4e1 Mon Sep 17 00:00:00 2001 From: bame-da Date: Sat, 15 Nov 2025 13:28:07 +0000 Subject: [PATCH 11/11] Accountable holdings initial implementation --- daml/splice-amulet/daml/Splice/Amulet.daml | 10 +- .../daml/Splice/AmuletAllocation.daml | 21 +-- .../Splice/AmuletTransferInstruction.daml | 12 +- .../daml/Splice/ExternalPartyAmuletRules.daml | 26 +++- daml/splice-amulet/daml/Splice/Types.daml | 2 +- daml/splice-wallet-test/daml.yaml | 1 + .../daml/Splice/Scripts/TestWallet.daml | 18 ++- .../daml/Splice/Wallet/Install.daml | 13 +- .../daml/Splice/Api/Token/AllocationV2.daml | 19 +-- .../daml/Splice/Api/Token/HoldingV2.daml | 20 ++- .../Api/Token/TransferInstructionV2.daml | 23 +++- .../daml/Splice/Api/Token/UtilsV2.daml | 124 ++++++++++++++---- .../Splice/Testing/Apps/TradingAppV2.daml | 36 +++-- .../Testing/Registries/AmuletRegistryV2.daml | 2 +- .../Testing/TokenStandard/WalletClientV2.daml | 6 +- .../daml/Splice/Tests/TestAmuletTokenDvP.daml | 10 +- .../Splice/Tests/TestAmuletTokenTransfer.daml | 38 ++++-- 17 files changed, 272 insertions(+), 109 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/Amulet.daml b/daml/splice-amulet/daml/Splice/Amulet.daml index bf5aa065e9..82787df1b3 100644 --- a/daml/splice-amulet/daml/Splice/Amulet.daml +++ b/daml/splice-amulet/daml/Splice/Amulet.daml @@ -115,7 +115,10 @@ template Amulet interface instance Api.Token.HoldingV2.Holding for Amulet where view = Api.Token.HoldingV2.HoldingView with - owner + account = Api.Token.HoldingV2.Account with + owner + provider = None + id = None instrumentId = amuletInstrumentId dso amount = amount.initialAmount lock = None @@ -141,7 +144,10 @@ template LockedAmulet interface instance Api.Token.HoldingV2.Holding for LockedAmulet where view = Api.Token.HoldingV2.HoldingView with - owner = amulet.owner + account = Api.Token.HoldingV2.Account with + owner = amulet.owner + provider = None + id = None instrumentId = amuletInstrumentId amulet.dso amount = amulet.amount.initialAmount lock = Some Api.Token.HoldingV2.Lock with diff --git a/daml/splice-amulet/daml/Splice/AmuletAllocation.daml b/daml/splice-amulet/daml/Splice/AmuletAllocation.daml index 6857b43bfc..552cd04498 100644 --- a/daml/splice-amulet/daml/Splice/AmuletAllocation.daml +++ b/daml/splice-amulet/daml/Splice/AmuletAllocation.daml @@ -10,7 +10,7 @@ module Splice.AmuletAllocation ( import DA.Assert((===), (=/=)) import DA.Text as Text import DA.TextMap qualified as TextMap -import DA.List ((\\), dedupSort) +import DA.List (dedupSort) import DA.Optional(fromSome) import Splice.Api.Token.MetadataV1 @@ -39,7 +39,7 @@ template AmuletAllocation all (\(_,tl) -> ( -- Sender needs to appear as sender or receiver of each leg. - sender `elem` [tl.sender, tl.receiver]) + sender `elem` [tl.sender.owner, tl.receiver.owner]) -- Only one admin Id allowed. && tl.instrumentId.admin == admin) (TextMap.toList allocation.transferLegs) @@ -49,8 +49,8 @@ template AmuletAllocation allocation holdingCids = [toInterfaceContractId lockedAmulet] meta = emptyMetadata - senders = [sender] - requiredReceiverAuth = (defaultAllocationControllers allocation) \\ (sender::allocationControllers allocation) + senders = [basicAccount sender] + requiredReceiverAuth = filter (\a -> a.owner /= sender) (map (\(_, tl) -> tl.receiver) (TextMap.toList allocation.transferLegs)) expiresAt = Some expiresAt allocation_executeTransferImpl self Allocation_ExecuteTransfer{..} = case extraAuth of @@ -96,7 +96,7 @@ template AmuletAllocation allocationReceivers : AllocationSpecification -> [Party] allocationReceivers AllocationSpecification{..} = - dedupSort $ map ((.receiver) . snd) (TextMap.toList transferLegs) + dedupSort $ map ((.receiver.owner) . snd) (TextMap.toList transferLegs) -- Allocation usage ------------------- @@ -104,7 +104,7 @@ allocationReceivers AllocationSpecification{..} = allocationAmount : Party -> AllocationSpecification -> Decimal allocationAmount sender allocation = sum (map (._2) outputs) where - senderLegs = filter (\tl -> tl.sender == sender) $ map snd (TextMap.toList allocation.transferLegs) + senderLegs = filter (\tl -> tl.sender.owner == sender) $ map snd (TextMap.toList allocation.transferLegs) outputs = map (\tl -> (tl.receiver, tl.amount)) senderLegs allocationToTwoStepTransfer : Party -> Party -> Time -> AllocationSpecification -> TwoStepTransfer @@ -121,8 +121,8 @@ allocationToTwoStepTransfer sender admin expiresAt allocation = -- We don't show more context to avoid bloating the response here. ["allocation for settlement ", allocation.settlement.settlementRef.id] where - senderLegs = filter (\tl -> tl.sender == sender) $ map snd (TextMap.toList allocation.transferLegs) - outputs = map (\tl -> (tl.receiver, tl.amount)) senderLegs + senderLegs = filter (\tl -> tl.sender.owner == sender) $ map snd (TextMap.toList allocation.transferLegs) + outputs = map (\tl -> (tl.receiver.owner, tl.amount)) senderLegs collectAuthAndSettle : ContractId AmuletAllocation -> ExtraArgs -> [ContractId AllocationTransferAuthorization] -> [Party] -> Update Allocation_ExecuteTransferResult @@ -163,7 +163,10 @@ template AmuletAllocationTransferAuthorization interface instance AllocationTransferAuthorization for AmuletAllocationTransferAuthorization where view = AllocationTransferAuthorizationView with allocation - receiver + receiver = Account with + owner = receiver + provider = None + id = None admin choice AmuletAllocationTransferAuthorization_AuthorizeTransfer : Allocation_ExecuteTransferResult diff --git a/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml b/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml index 1e29f0ab20..de996cdfb4 100644 --- a/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml +++ b/daml/splice-amulet/daml/Splice/AmuletTransferInstruction.daml @@ -21,8 +21,8 @@ template AmuletTransferInstruction lockedAmulet : ContractId LockedAmulet -- ^ Locked amulet that holds the funds for executing the transfer upon acceptance transfer : Splice.Api.Token.TransferInstructionV2.Transfer where - signatory transfer.instrumentId.admin, transfer.sender - observer transfer.receiver + signatory transfer.instrumentId.admin, transfer.sender.owner + observer transfer.receiver.owner interface instance TransferInstruction for AmuletTransferInstruction where view = TransferInstructionView with @@ -62,13 +62,13 @@ standardTransferToTwoStepTransfer : Splice.Api.Token.TransferInstructionV2.Trans standardTransferToTwoStepTransfer transfer = TwoStepTransfer with dso = transfer.instrumentId.admin - sender = transfer.sender - provider = transfer.sender - outputs = [(transfer.receiver, transfer.amount)] + sender = transfer.sender.owner + provider = transfer.sender.owner + outputs = [(transfer.receiver.owner, transfer.amount)] transferBefore = transfer.executeBefore transferBeforeDeadline = "Transfer.executeBefore" allowFeaturing = False -- unfeatured as the sender is serving as its own "app provider" - lockContext = "transfer to " <> show transfer.receiver + lockContext = "transfer to " <> show transfer.receiver.owner executeTransferInstr : AmuletTransferInstruction -> ExtraArgs -> Update TransferInstructionResult executeTransferInstr instr extraArgs = do diff --git a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml index a6727de146..57a2abd784 100644 --- a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml @@ -279,7 +279,7 @@ amulet_transferFactory_transferImpl this _self arg = do -- receiver: validate preapproval if given optPreapprovalCid <- lookupFromContextU @(ContractId TransferPreapproval) extraArgs.context transferPreapprovalContextKey forA_ optPreapprovalCid \preapprovalCid -> - fetchChecked (ForOwner with dso; owner = transfer.receiver) preapprovalCid + fetchChecked (ForOwner with dso; owner = transfer.receiver.owner) preapprovalCid -- instrumentId: let expectedInstrumentId = amuletInstrumentId this.dso require @@ -294,6 +294,12 @@ amulet_transferFactory_transferImpl this _self arg = do -- inputHoldingCids: note that their detailed validation is done in the transfer itself require "At least one holding must be provided" (not $ null transfer.inputHoldingCids) + -- accounts : + require "sender account provider must be None" (isNone transfer.sender.provider) + require "sender account id must be None" (isNone transfer.sender.id) + require "receiver account provider must be None" (isNone transfer.receiver.provider) + require "receiver account id must be None" (isNone transfer.receiver.id) + let reason = TextMap.lookup reasonMetaKey transfer.meta.values -- execute the right kind of transfer @@ -302,13 +308,13 @@ amulet_transferFactory_transferImpl this _self arg = do | transfer.receiver == transfer.sender -> do -- execute a self-transfer paymentContext <- unfeaturedPaymentContextFromChoiceContext dso extraArgs.context - inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext transfer.inputHoldingCids + inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender.owner) paymentContext transfer.inputHoldingCids result <- exercisePaymentTransfer dso paymentContext Transfer with - sender = transfer.sender - provider = transfer.sender + sender = transfer.sender.owner + provider = transfer.sender.owner inputs outputs = [ TransferOutput with - receiver = transfer.sender + receiver = transfer.sender.owner amount = transfer.amount receiverFeeRatio = 0.0 lock = None ] @@ -342,10 +348,10 @@ amulet_transferFactory_transferImpl this _self arg = do -- use a payment context with featuring so the preapproval provider can be featured paymentContext <- paymentFromChoiceContext dso extraArgs.context -- execute a direct transfer - inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender) paymentContext transfer.inputHoldingCids + inputs <- holdingToTransferInputs (ForOwner with dso; owner = transfer.sender.owner) paymentContext transfer.inputHoldingCids result <- exercise preapprovalCid TransferPreapproval_Send with - sender = transfer.sender + sender = transfer.sender.owner context = paymentContext inputs amount = transfer.amount @@ -413,6 +419,12 @@ amulet_allocationFactory_allocateImpl externalAmuletRules _self arg = do -- transferLeg.instrumentId require "Instrument-id must match the factory" (transferLeg.instrumentId == amuletInstrumentId dso) -- transferLeg.meta: no check + + -- accounts : + require "sender account provider must be None" (isNone transferLeg.sender.provider) + require "sender account id must be None" (isNone transferLeg.sender.id) + require "receiver account provider must be None" (isNone transferLeg.receiver.provider) + require "receiver account id must be None" (isNone transferLeg.receiver.id) ) -- requestedAt (of the allocation instruction itself): diff --git a/daml/splice-amulet/daml/Splice/Types.daml b/daml/splice-amulet/daml/Splice/Types.daml index 54ea0c6c41..f7c318aead 100644 --- a/daml/splice-amulet/daml/Splice/Types.daml +++ b/daml/splice-amulet/daml/Splice/Types.daml @@ -47,7 +47,7 @@ data ForOwner = ForOwner with instance HasCheckedFetch HoldingView ForOwner where contractGroupId HoldingView {..} = ForOwner with dso = instrumentId.admin - owner = owner + owner = account.owner instance HasCheckedFetch TransferInstructionView ForDso where contractGroupId TransferInstructionView {..} = ForDso with diff --git a/daml/splice-wallet-test/daml.yaml b/daml/splice-wallet-test/daml.yaml index 5cc9b97536..327082800a 100644 --- a/daml/splice-wallet-test/daml.yaml +++ b/daml/splice-wallet-test/daml.yaml @@ -23,6 +23,7 @@ data-dependencies: - ../../token-standard/splice-api-token-allocation-instruction-v2/.daml/dist/splice-api-token-allocation-instruction-v2-current.dar - ../../token-standard/splice-api-token-allocation-v1/.daml/dist/splice-api-token-allocation-v1-current.dar - ../../token-standard/splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-v2-current.dar +- ../../token-standard/splice-api-token-holding-v2/.daml/dist/splice-api-token-holding-v2-current.dar build-options: - --ghc-option=-Wunused-binds diff --git a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml index 1f6024cebc..4ca549f3ce 100644 --- a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml +++ b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml @@ -30,6 +30,7 @@ import Splice.Testing.UtilsV2 import Splice.Testing.Registries.AmuletRegistryV2.Parameters import Splice.Testing.Registries.AmuletRegistryV2 qualified as AmuletRegistry import Splice.Testing.TokenStandard.RegistryApiV2 qualified as RegistryApi +import qualified Splice.Api.Token.HoldingV2 as HoldingV2 import qualified Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import qualified Splice.Api.Token.AllocationInstructionV2 as Api.Token.AllocationInstructionV2 import Splice.Api.Token.TransferInstructionV2 (TransferFactory_Transfer(..)) @@ -1004,8 +1005,8 @@ testTokenStandardTransfer = script do let defaultTransfer = Api.Token.TransferInstructionV2.Transfer with - sender = alice - receiver = bob + sender = HoldingV2.basicAccount alice + receiver = HoldingV2.basicAccount bob amount = 10.0 instrumentId = registry.instrumentId requestedAt = now @@ -1014,14 +1015,15 @@ testTokenStandardTransfer = script do meta = emptyMetadata let transfer = defaultTransfer with - sender = alice - receiver = bob + sender = HoldingV2.basicAccount alice + receiver = HoldingV2.basicAccount bob inputHoldingCids = [coerceInterfaceContractId holdingCid] enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with expectedAdmin = registry.dso transfer extraArgs = emptyExtraArgs + actor = None result <- submitMulti [aliceValidator] [alice, registry.dso] $ exerciseCmd aliceInstall WalletAppInstall_TransferFactory_Transfer with transferFactoryCid = enrichedChoice.factoryCid @@ -1036,6 +1038,7 @@ testTokenStandardTransfer = script do extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata + actor = None Api.Token.TransferInstructionV2.TransferInstructionResult_Failed === result.output let change2 = result.senderChangeCids @@ -1047,6 +1050,7 @@ testTokenStandardTransfer = script do transfer = enrichedChoice.arg.transfer with inputHoldingCids = change1 ++ change2 extraArgs = enrichedChoice.arg.extraArgs + actor = None Api.Token.TransferInstructionV2.TransferInstructionResult_Pending aliceInstrCid <- pure result.output let change3 = result.senderChangeCids @@ -1057,6 +1061,7 @@ testTokenStandardTransfer = script do extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata + actor = None Api.Token.TransferInstructionV2.TransferInstructionResult_Failed === result.output let change4 = result.senderChangeCids @@ -1068,6 +1073,7 @@ testTokenStandardTransfer = script do transfer = enrichedChoice.arg.transfer with inputHoldingCids = change3 ++ change4 extraArgs = enrichedChoice.arg.extraArgs + actor = None Api.Token.TransferInstructionV2.TransferInstructionResult_Pending aliceInstrCid <- pure result.output context <- RegistryApi.getTransferInstruction_AcceptContext registry aliceInstrCid emptyMetadata @@ -1078,6 +1084,7 @@ testTokenStandardTransfer = script do extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata + actor = None Api.Token.TransferInstructionV2.TransferInstructionResult_Completed _ <- pure result.output @@ -1099,13 +1106,14 @@ testTokenStandardAllocate = script do validatorParty = aliceValidator let amuletId = registry.instrumentId + let aliceAccount = HoldingV2.basicAccount alice let mkTransfer sender receiver amount = Api.Token.AllocationV2.TransferLeg with sender receiver amount instrumentId = amuletId meta = emptyMetadata - let aliceLeg = mkTransfer alice alice 100.0 + let aliceLeg = mkTransfer aliceAccount aliceAccount 100.0 -- provider proposes a trade for alice with herself now <- getTime diff --git a/daml/splice-wallet/daml/Splice/Wallet/Install.daml b/daml/splice-wallet/daml/Splice/Wallet/Install.daml index a17092d015..b278866211 100644 --- a/daml/splice-wallet/daml/Splice/Wallet/Install.daml +++ b/daml/splice-wallet/daml/Splice/Wallet/Install.daml @@ -28,6 +28,7 @@ import Splice.Wallet.TopUpState import Splice.Wallet.TransferPreapproval import Prelude hiding (forA) import Splice.Util +import Splice.Api.Token.HoldingV2 qualified as HoldingV2 (owner, Account(Account)) -- Evaluates an update, catches any exceptions it throws and converts them into an Either @@ -591,7 +592,7 @@ template WalletAppInstall transferArg : Splice.Api.Token.TransferInstructionV2.TransferFactory_Transfer controller validatorParty do let transfer = transferArg.transfer - require ("sender " <> show transfer.sender <> " is endUserParty " <> show endUserParty) (transfer.sender == endUserParty) + require ("sender " <> show transfer.sender <> " is endUserParty " <> show endUserParty) (transfer.sender.owner == endUserParty) require ("instrumentId " <> show transfer.instrumentId <> " is amuletInstrumentId " <> show (amuletInstrumentId dsoParty)) (transfer.instrumentId == amuletInstrumentId dsoParty) require ("expected admin " <> show transferArg.expectedAdmin <> " is dso " <> show dsoParty) (transferArg.expectedAdmin == dsoParty) exercise transferFactoryCid transferArg @@ -602,7 +603,7 @@ template WalletAppInstall acceptArg : Splice.Api.Token.TransferInstructionV2.TransferInstruction_Accept controller validatorParty do instruction <- fetchCheckedInterface (ForDso dsoParty) transferInstructionCid - let receiver = (view instruction).transfer.receiver + let receiver = (view instruction).transfer.receiver.owner require ("receiver " <> show receiver <> " must match endUserParty " <> show endUserParty) (receiver == endUserParty) exercise transferInstructionCid acceptArg @@ -612,7 +613,7 @@ template WalletAppInstall rejectArg : Splice.Api.Token.TransferInstructionV2.TransferInstruction_Reject controller validatorParty do instruction <- fetchCheckedInterface (ForDso dsoParty) transferInstructionCid - let receiver = (view instruction).transfer.receiver + let receiver = (view instruction).transfer.receiver.owner require ("receiver " <> show receiver <> " must match endUserParty " <> show endUserParty) (receiver == endUserParty) exercise transferInstructionCid rejectArg @@ -622,7 +623,7 @@ template WalletAppInstall withdrawArg : Splice.Api.Token.TransferInstructionV2.TransferInstruction_Withdraw controller validatorParty do instruction <- fetchCheckedInterface (ForDso dsoParty) transferInstructionCid - let sender = (view instruction).transfer.sender + let sender = (view instruction).transfer.sender.owner require ("sender " <> show sender <> " must match endUserParty " <> show endUserParty) (sender == endUserParty) exercise transferInstructionCid withdrawArg @@ -636,7 +637,7 @@ template WalletAppInstall controller validatorParty do require ("expected admin " <> show allocateArg.expectedAdmin <> " is dso " <> show dsoParty) (allocateArg.expectedAdmin == dsoParty) forA_ allocateArg.allocation.transferLegs (\Splice.Api.Token.AllocationV2.TransferLeg{sender; instrumentId} -> do - require ("sender " <> show sender <> " is endUserParty " <> show endUserParty) (sender == endUserParty) + require ("sender " <> show sender <> " is endUserParty " <> show endUserParty) (sender.owner == endUserParty) require ("instrumentId " <> show instrumentId <> " is amuletInstrumentId " <> show (amuletInstrumentId dsoParty)) (instrumentId == amuletInstrumentId dsoParty) ) exercise allocationFactory allocateArg @@ -648,7 +649,7 @@ template WalletAppInstall controller validatorParty do allocation <- fetchCheckedInterface (ForDso dsoParty) allocationCid -- Amulet only supports a single sender per allocation - let [sender] = (view allocation).senders + let [HoldingV2.Account{HoldingV2.owner = sender}] = (view allocation).senders require ("sender " <> show sender <> " must match endUserParty " <> show endUserParty) (sender == endUserParty) exercise allocationCid withdrawArg diff --git a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml index 92c5ed28f5..db6e449a0a 100644 --- a/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml +++ b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml @@ -12,9 +12,10 @@ import DA.List (dedup, dedupSort) import DA.TextMap as TextMap import Splice.Api.Token.MetadataV1 -import Splice.Api.Token.HoldingV2 (Holding, InstrumentId) +import Splice.Api.Token.HoldingV2 (Holding, InstrumentId, Account) import qualified DA.Foldable as F import DA.Assert ((===)) +import DA.Optional (optionalToList) -- | A generic type to refer to data defined within an app. @@ -56,9 +57,9 @@ data SettlementInfo = SettlementInfo -- | A specification of a transfer of holdings between two parties for the -- purpose of a settlement, which often requires the atomic execution of multiple legs. data TransferLeg = TransferLeg with - sender : Party + sender : Account -- ^ The sender of the transfer. - receiver : Party + receiver : Account -- ^ The receiver of the transfer. amount : Decimal -- ^ The amount to transfer. @@ -94,11 +95,11 @@ data AllocationView = AllocationView with -- MAY be empty for registries that do not represent their holdings on-ledger. meta : Metadata -- ^ Additional metadata specific to the allocation, used for extensibility. - senders : [Party] + senders : [Account] -- ^ The senders of this allocation, who could also authorize incoming transfers -- through Allocation_AuthorizeIncoming - requiredReceiverAuth : [Party] - -- ^ The extra authority this allocation needs for settlement on top of + requiredReceiverAuth : [Account] + -- ^ The extra account authorization this allocation needs for settlement on top of -- the controllers specified via allocation.settlement.controllerOverride expiresAt : Optional Time -- ^ A time at which this allocation expires. SHOULD be as close as the @@ -109,7 +110,7 @@ data AllocationView = AllocationView with -- authorizers are always the signatories so not made available in the viewtype. data AllocationTransferAuthorizationView = AllocationTransferAuthorizationView with allocation : AllocationSpecification - receiver : Party + receiver : Account admin : Party -- ^ the settlement to which this authorization applies. @@ -123,7 +124,7 @@ data AllocationTransferAuthorizationView = AllocationTransferAuthorizationView w -- allocation. defaultAllocationControllers : AllocationSpecification -> [Party] defaultAllocationControllers AllocationSpecification{..} = - dedup $ settlement.executor :: concatMap (\leg -> [leg._2.sender, leg._2.receiver]) (toList transferLegs) + dedup $ settlement.executor :: concatMap (\leg -> [leg._2.sender.owner, leg._2.receiver.owner]) (toList transferLegs) -- | Convenience function read out the overridden allocation controllers. allocationControllers : AllocationSpecification -> [Party] @@ -195,7 +196,7 @@ interface Allocation where with extraArgs : ExtraArgs -- ^ Additional context required in order to exercise the choice. - controller (view this).senders + controller concatMap (\acc -> acc.owner :: optionalToList acc.provider) (view this).senders do allocation_withdrawImpl this self arg -- AllocationTransferAuthorization diff --git a/token-standard/splice-api-token-holding-v2/daml/Splice/Api/Token/HoldingV2.daml b/token-standard/splice-api-token-holding-v2/daml/Splice/Api/Token/HoldingV2.daml index f38480fa4a..8b53d5faf1 100644 --- a/token-standard/splice-api-token-holding-v2/daml/Splice/Api/Token/HoldingV2.daml +++ b/token-standard/splice-api-token-holding-v2/daml/Splice/Api/Token/HoldingV2.daml @@ -19,6 +19,22 @@ data InstrumentId = InstrumentId -- This identifier MUST be unique and unambiguous per instrument admin. deriving (Eq, Ord, Show) +-- | A data type to represent an on-chain managed account, +-- for example in a traditional accounting structure, or simply a delegation +-- to a provider to perform some services. +data Account = Account + with + provider : Optional Party + -- ^ The provider of the account. + id : Optional Text + -- ^ Account number or similar. Should be unique per provider. + owner: Party + -- ^ The party that owns the account. + deriving (Eq, Show, Ord) + +basicAccount : Party -> Account +basicAccount p = Account None None p + -- | Details of a lock. data Lock = Lock with @@ -48,8 +64,8 @@ interface Holding where viewtype HoldingView -- | View for `Holding`. data HoldingView = HoldingView with - owner : Party - -- ^ Owner of the holding. + account : Account + -- ^ Account in which the holding is held. instrumentId : InstrumentId -- ^ Instrument being held. amount : Decimal diff --git a/token-standard/splice-api-token-transfer-instruction-v2/daml/Splice/Api/Token/TransferInstructionV2.daml b/token-standard/splice-api-token-transfer-instruction-v2/daml/Splice/Api/Token/TransferInstructionV2.daml index 5c1fd781a7..575bc0bb32 100644 --- a/token-standard/splice-api-token-transfer-instruction-v2/daml/Splice/Api/Token/TransferInstructionV2.daml +++ b/token-standard/splice-api-token-transfer-instruction-v2/daml/Splice/Api/Token/TransferInstructionV2.daml @@ -8,12 +8,13 @@ import qualified DA.Map as Map import Splice.Api.Token.MetadataV1 import Splice.Api.Token.HoldingV2 +import DA.Optional (fromOptional) -- | A specification of a transfer of holdings between parties parties. data Transfer = Transfer with - sender : Party + sender : Account -- ^ The sender of the transfer. - receiver : Party + receiver : Account -- ^ The receiver of the transfer. amount : Decimal -- ^ The amount to transfer. @@ -48,7 +49,7 @@ data TransferInstructionResult = TransferInstructionResult with -- ^ The output of the step. senderChangeCids : [ContractId Holding] -- ^ New holdings owned by the sender created to return "change". Can be used - -- by callers to batch creating or updating multiple transfer instructions + -- by actors to batch creating or updating multiple transfer instructions -- in a single Daml transaction. meta : Metadata -- ^ Additional metadata specific to the transfer instruction, used for extensibility; e.g., fees charged. @@ -130,9 +131,11 @@ interface TransferInstruction where -- this is not guaranteed. The result of the choice is implementation-specific and MAY -- be any of the three possible results. with + actor : Optional Party + -- ^ The party calling Accept, if different from the owner or the recipient account extraArgs : ExtraArgs -- ^ Additional context required in order to exercise the choice. - controller (view this).transfer.receiver + controller fromOptional (view this).transfer.receiver.owner actor do transferInstruction_acceptImpl this self arg choice TransferInstruction_Reject : TransferInstructionResult @@ -141,17 +144,21 @@ interface TransferInstruction where -- This choice is only available if the instruction is in -- `TransferPendingReceiverAcceptance` state. with + actor : Optional Party + -- ^ The party calling Reject, if different from the owner or the recipient account extraArgs : ExtraArgs -- ^ Additional context required in order to exercise the choice. - controller (view this).transfer.receiver + controller fromOptional (view this).transfer.receiver.owner actor do transferInstruction_rejectImpl this self arg choice TransferInstruction_Withdraw : TransferInstructionResult -- ^ Withdraw the transfer instruction as the sender. with + actor : Optional Party + -- ^ The party calling Withdraw, if different from the owner or the source account extraArgs : ExtraArgs -- ^ Additional context required in order to exercise the choice. - controller (view this).transfer.sender + controller fromOptional (view this).transfer.sender.owner actor do transferInstruction_withdrawImpl this self arg choice TransferInstruction_Update : TransferInstructionResult @@ -192,9 +199,11 @@ interface TransferFactory where -- that check the expected admin party. transfer : Transfer -- ^ The transfer to execute. + actor : Optional Party + -- ^ The party instructing the transfer, if different from the owner or the source account extraArgs : ExtraArgs -- ^ The extra arguments to pass to the transfer implementation. - controller transfer.sender + controller fromOptional transfer.sender.owner actor do transferFactory_transferImpl this self arg nonconsuming choice TransferFactory_PublicFetch : TransferFactoryView diff --git a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml index b5abc75139..81ce21d1fb 100644 --- a/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml +++ b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml @@ -19,7 +19,7 @@ import Splice.Api.Token.TransferInstructionV2 qualified as TransferInstructionV2 import DA.Time import DA.Date import DA.Text (parseInt) -import DA.Optional (fromOptional) +import DA.Optional (fromSome, fromOptional) -- Utils -------- @@ -37,6 +37,10 @@ decodeTime t = case parseInt t of Some i -> epoch `addRelTime` (convertMicrosecondsToRelTime i) None -> error ("Cannot parse time " <> t) +insertOptional : Text -> Optional a -> TextMap.TextMap a -> TextMap.TextMap a +insertOptional k ov m = case ov of + None -> m + Some v -> TextMap.insert k v m -- Holding ---------- @@ -51,7 +55,10 @@ holdingv1_to_v2 : HoldingV1.HoldingView -> HoldingV2.HoldingView holdingv1_to_v2 v1 = v2 where v2 = HoldingV2.HoldingView with - owner = v1.owner + account = HoldingV2.Account with + provider = (TextMap.lookup "canton.network/account.provider" v1.meta.values) >>= partyFromText + id = TextMap.lookup "canton.network/account.id" v1.meta.values + owner = v1.owner instrumentId = instrumentId_v1_to_v2 v1.instrumentId amount = v1.amount lock = fmap lock_v1_to_v2 v1.lock @@ -67,12 +74,17 @@ lock_v2_to_v1 HoldingV2.Lock{..} = HoldingV1.Lock with .. holding_v2_to_v1 : HoldingV2.HoldingView -> HoldingV1.HoldingView holding_v2_to_v1 v2 = v1 where + meta' = Metadata with + values = + insertOptional "canton.network/account.provider" (partyToText <$> v2.account.provider) $ + insertOptional "canton.network/account.id" (v2.account.id) $ + v2.meta.values v1 = HoldingV1.HoldingView with - owner = v2.owner + owner = v2.account.owner instrumentId = instrumentId_v2_to_v1 v2.instrumentId amount = v2.amount lock = fmap lock_v2_to_v1 v2.lock - meta = v2.meta + meta = meta' -- Allocation ------------- @@ -100,7 +112,21 @@ transfer_leg_v1_to_v2 : AllocationV1.TransferLeg -> AllocationV2.TransferLeg transfer_leg_v1_to_v2 AllocationV1.TransferLeg{..} = AllocationV2.TransferLeg with instrumentId = instrumentId_v1_to_v2 instrumentId + sender = senderAccount + receiver = receiverAccount .. + where + senderAccount = HoldingV2.Account + with + provider = (TextMap.lookup "canton.network/sender.provider" meta.values) >>= partyFromText + id = TextMap.lookup "canton.network/sender.id" meta.values + owner = sender + receiverAccount = HoldingV2.Account + with + provider = (TextMap.lookup "canton.network/receiver.provider" meta.values) >>= partyFromText + id = TextMap.lookup "canton.network/receiver.id" meta.values + owner = receiver + allocation_specification_v1_to_v2 : AllocationV1.AllocationSpecification -> AllocationV2.AllocationSpecification allocation_specification_v1_to_v2 AllocationV1.AllocationSpecification{..} = @@ -122,9 +148,20 @@ allocation_view_v1_to_v2 AllocationV1.AllocationView{..} = requiredReceiverAuth expiresAt where - senders = case TextMap.lookup "canton.network/senders" meta.values of - None -> [allocation.transferLeg.sender] - Some ol -> [allocation.transferLeg.sender] -- TODO: Parse extra auth list. + numExtraSenders = TextMap.lookup "canton.network/numExtraSenders" meta.values >>= parseInt + sender = HoldingV2.Account with + owner = allocation.transferLeg.sender + provider = TextMap.lookup "canton.network/sender.provider" meta.values >>= partyFromText + id = TextMap.lookup "canton.network/sender.id" meta.values + extraSenders = case numExtraSenders of + None -> [] + Some num -> map + (\n -> HoldingV2.Account with + owner = fromSome $ TextMap.lookup ("canton.network/sender[" <> show n <> "].owner") meta.values >>= partyFromText + provider = TextMap.lookup ("canton.network/sender[" <> show n <> "].provider") meta.values >>= partyFromText + id = TextMap.lookup ("canton.network/sender[" <> show n <> "].id") meta.values) + [1..num] + senders = sender::extraSenders requiredReceiverAuth = case TextMap.lookup "canton.network/requiredReceiverAuth" meta.values of None -> [] Some ol -> [] -- TODO: Parse extra auth list. @@ -159,7 +196,18 @@ transfer_leg_v2_to_v1 : AllocationV2.TransferLeg -> AllocationV1.TransferLeg transfer_leg_v2_to_v1 AllocationV2.TransferLeg{..} = AllocationV1.TransferLeg with instrumentId = instrumentId_v2_to_v1 instrumentId + sender = sender.owner + receiver = receiver.owner + meta = meta' .. + where + meta' = Metadata with + values = + insertOptional "canton.network/sender.provider" (partyToText <$> sender.provider) $ + insertOptional "canton.network/sender.id" (sender.id) $ + insertOptional "canton.network/receiver.provider" (partyToText <$> receiver.provider) $ + insertOptional "canton.network/receiver.id" (receiver.id) $ + meta.values allocation_specification_v2_to_v1 : AllocationV2.AllocationSpecification -> AllocationV1.AllocationSpecification allocation_specification_v2_to_v1 AllocationV2.AllocationSpecification{..} = @@ -184,17 +232,27 @@ allocation_view_v2_to_v1 AllocationV2.AllocationView{..} = allocation = allocation_specification_v2_to_v1 allocation holdingCids = map coerceInterfaceContractId holdingCids meta = meta' - where - insertOptional k ov m = case ov of - None -> m - Some v -> TextMap.insert k v m - meta' = Metadata with + where + sender::extraSenders = senders + meta0 = Metadata with values = TextMap.insert "canton.network/version" "v2" $ - TextMap.insert "canton.network/senders" (show senders) $ + insertOptional "canton.network/sender.provider" (partyToText <$> sender.provider) $ + insertOptional "canton.network/sender.id" (sender.id) $ TextMap.insert "canton.network/requiredReceiverAuth" (show requiredReceiverAuth) $ insertOptional "canton.network/expiresAt" (fmap encodeTime expiresAt) $ meta.values + meta' = Metadata with + values = foldl + (\acc (s, n) -> + TextMap.insert ("canton.network/sender[" <> show n <> "].owner") (partyToText s.owner) $ + insertOptional ("canton.network/sender[" <> show n <> "].provider") (partyToText <$> s.provider) $ + insertOptional ("canton.network/sender[" <> show n <> "].id") (s.id) $ + acc + ) + meta0.values + (zip extraSenders [1..(length extraSenders)]) + -- Choices @@ -371,15 +429,26 @@ allocationFactory_v1_publicFetchImpl this self AllocationInstructionV1.Allocatio transfer_v1_to_v2 : TransferInstructionV1.Transfer -> TransferInstructionV2.Transfer transfer_v1_to_v2 TransferInstructionV1.Transfer{..} = TransferInstructionV2.Transfer with - sender - receiver + sender = senderAccount + receiver = receiverAccount amount instrumentId = instrumentId_v1_to_v2 instrumentId requestedAt executeBefore inputHoldingCids = map coerceInterfaceContractId inputHoldingCids meta - + where + senderAccount = HoldingV2.Account + with + provider = (TextMap.lookup "canton.network/sender.provider" meta.values) >>= partyFromText + id = TextMap.lookup "canton.network/sender.id" meta.values + owner = sender + receiverAccount = HoldingV2.Account + with + provider = (TextMap.lookup "canton.network/receiver.provider" meta.values) >>= partyFromText + id = TextMap.lookup "canton.network/receiver.id" meta.values + owner = receiver + transfer_instruction_status_v1_to_v2 : TransferInstructionV1.TransferInstructionStatus -> TransferInstructionV2.TransferInstructionStatus transfer_instruction_status_v1_to_v2 tis = case tis of TransferInstructionV1.TransferPendingReceiverAcceptance -> @@ -400,14 +469,23 @@ transfer_instruction_view_v1_to_v2 TransferInstructionV1.TransferInstructionView transfer_v2_to_v1 : TransferInstructionV2.Transfer -> TransferInstructionV1.Transfer transfer_v2_to_v1 TransferInstructionV2.Transfer{..} = TransferInstructionV1.Transfer with - sender - receiver + sender = sender.owner + receiver = receiver.owner amount instrumentId = instrumentId_v2_to_v1 instrumentId requestedAt executeBefore inputHoldingCids = map coerceInterfaceContractId inputHoldingCids - meta + meta = meta' + .. + where + meta' = Metadata with + values = + insertOptional "canton.network/sender.provider" (partyToText <$> sender.provider) $ + insertOptional "canton.network/sender.id" (sender.id) $ + insertOptional "canton.network/receiver.provider" (partyToText <$> receiver.provider) $ + insertOptional "canton.network/receiver.id" (receiver.id) $ + meta.values transfer_instruction_status_v2_to_v1 : TransferInstructionV2.TransferInstructionStatus -> TransferInstructionV1.TransferInstructionStatus transfer_instruction_status_v2_to_v1 tis = case tis of @@ -449,15 +527,16 @@ transferInstruction_v1_acceptImpl this self TransferInstructionV1.TransferInstru resv2 <- TransferInstructionV2.transferInstruction_acceptImpl this (coerceInterfaceContractId @TransferInstructionV2.TransferInstruction self) - (TransferInstructionV2.TransferInstruction_Accept{..}) + (TransferInstructionV2.TransferInstruction_Accept{actor = None; ..}) return (transfer_instruction_result_v2_to_v1 resv2) + transferInstruction_v1_rejectImpl : TransferInstructionV2.TransferInstruction -> ContractId TransferInstructionV1.TransferInstruction -> TransferInstructionV1.TransferInstruction_Reject -> Update TransferInstructionV1.TransferInstructionResult transferInstruction_v1_rejectImpl this self TransferInstructionV1.TransferInstruction_Reject{..} = do resv2 <- TransferInstructionV2.transferInstruction_rejectImpl this (coerceInterfaceContractId @TransferInstructionV2.TransferInstruction self) - (TransferInstructionV2.TransferInstruction_Reject{..}) + (TransferInstructionV2.TransferInstruction_Reject{actor = None; ..}) return (transfer_instruction_result_v2_to_v1 resv2) transferInstruction_v1_withdrawImpl : TransferInstructionV2.TransferInstruction -> ContractId TransferInstructionV1.TransferInstruction -> TransferInstructionV1.TransferInstruction_Withdraw -> Update TransferInstructionV1.TransferInstructionResult @@ -465,7 +544,7 @@ transferInstruction_v1_withdrawImpl this self TransferInstructionV1.TransferInst resv2 <- TransferInstructionV2.transferInstruction_withdrawImpl this (coerceInterfaceContractId @TransferInstructionV2.TransferInstruction self) - (TransferInstructionV2.TransferInstruction_Withdraw{..}) + (TransferInstructionV2.TransferInstruction_Withdraw{actor = None; ..}) return (transfer_instruction_result_v2_to_v1 resv2) transferInstruction_v1_updateImpl : TransferInstructionV2.TransferInstruction -> ContractId TransferInstructionV1.TransferInstruction -> TransferInstructionV1.TransferInstruction_Update -> Update TransferInstructionV1.TransferInstructionResult @@ -496,6 +575,7 @@ transfer_factory_transfer_v1_to_v2 TransferInstructionV1.TransferFactory_Transfe TransferInstructionV2.TransferFactory_Transfer with expectedAdmin transfer = transfer_v1_to_v2 transfer + actor = None extraArgs transferFactory_v1_transferImpl : TransferInstructionV2.TransferFactory -> ContractId TransferInstructionV1.TransferFactory -> TransferInstructionV1.TransferFactory_Transfer -> Update TransferInstructionV1.TransferInstructionResult diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml index 6bac736011..a22b3a6a3d 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml @@ -15,6 +15,7 @@ import DA.Map as Map import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 import Splice.Api.Token.AllocationRequestV2 +import Splice.Api.Token.HoldingV2 (Account) import DA.List (groupOn) import DA.Foldable (mapA_) import DA.List.Total (dedup) @@ -48,7 +49,14 @@ template OTCTradeAllocationRequest with allocationRequest_RejectImpl _self AllocationRequest_Reject{..} = do -- Note: this corresponds to signalling early that assets won't be allocated / that the trade is being rejected. - require "Actor is a trader" (F.any (\leg -> actor == leg.sender || actor == leg.receiver) otcTrade.transferLegs) + require "Actor is a trader or their account providers" + (F.any + (\leg -> + actor == leg.sender.owner || + actor == leg.receiver.owner || + Some actor == leg.receiver.provider || + Some actor == leg.receiver.provider) + otcTrade.transferLegs) pure ChoiceExecutionMetadata with meta = emptyMetadata allocationRequest_WithdrawImpl _self _extraArgs = @@ -76,9 +84,9 @@ template OTCTrade with TextMap.toList transferLegs mapA (\transferLegs -> create (OTCTradeAllocationRequest (this with transferLegs) self)) legsByAdmin - choice OTCTrade_Settle : Map Party (Map Party Allocation_ExecuteTransferResult) + choice OTCTrade_Settle : Map Party (Map Account Allocation_ExecuteTransferResult) with - allocationsWithContext : Map Party (Map Party (ContractId Allocation, ExtraArgs)) + allocationsWithContext : Map Party (Map Account (ContractId Allocation, ExtraArgs)) -- ^ Allocations sorted by admin and sender. allocationRequests : [ContractId OTCTradeAllocationRequest] controller venue @@ -158,32 +166,32 @@ template OTCTrade with expectedTradeAllocations : SettlementInfo -> TextMap Api.Token.AllocationV2.TransferLeg - -> Map Party (Map Party AllocationSpecification) + -> Map Party (Map Account AllocationSpecification) expectedTradeAllocations settlementInfo transferLegs = Map.fromList allocsByAdminAndTrader where legsByAdmin = map (\tls@((_, tl)::_) -> (tl.instrumentId.admin, TextMap.fromList tls)) $ groupOn (\(_, tl) -> tl.instrumentId.admin) $ TextMap.toList transferLegs - tradersForLegs tls = dedup $ concatMap (\(_, tl) -> [tl.sender, tl.receiver]) (TextMap.toList tls) - legsForTrader tls trader = + accountsForLegs tls = dedup $ concatMap (\(_, tl) -> [tl.sender, tl.receiver]) (TextMap.toList tls) + legsForAccount tls account = TextMap.fromList $ - Prelude.filter (\(_, tl) -> tl.sender == trader || tl.receiver == trader) $ + Prelude.filter (\(_, tl) -> tl.sender == account || tl.receiver == account) $ TextMap.toList tls - allocForTraderAndLegs trader tls = AllocationSpecification with + allocForAccountAndLegs account tls = AllocationSpecification with settlement = settlementInfo - transferLegs = legsForTrader tls trader - allocsByTrader tls = map - (\trader -> (trader, allocForTraderAndLegs trader $ legsForTrader tls trader)) - (tradersForLegs tls) + transferLegs = legsForAccount tls account + allocsByAccount tls = map + (\trader -> (trader, allocForAccountAndLegs trader $ legsForAccount tls trader)) + (accountsForLegs tls) allocsByAdminAndTrader = map - (\(admin, tls) -> (admin, Map.fromList (allocsByTrader tls))) + (\(admin, tls) -> (admin, Map.fromList (allocsByAccount tls))) legsByAdmin tradingParties : TextMap Api.Token.AllocationV2.TransferLeg -> Set.Set Party -tradingParties = F.foldl (\acc t -> Set.insert t.sender (Set.insert t.receiver acc)) Set.empty +tradingParties = F.foldl (\acc t -> Set.insert t.sender.owner (Set.insert t.receiver.owner acc)) Set.empty -- | Check whether a required condition is true. If it's not, abort the -- transaction with a message saying that the requirement was not met. diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml index 8b2eb94807..757e10f5d4 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml @@ -219,7 +219,7 @@ registryApi_getTransferFactory registryApi_getTransferFactory registry arg = do (extAmuletRulesCid, extAmuletRulesD) <- getExtAmuletRulesWithDisclosures registry transferC <- getAmuletRulesTransferContext registry - (optPreapproval, preapprovalC) <- lookupPreapprovalWithContext registry arg.transfer.receiver + (optPreapproval, preapprovalC) <- lookupPreapprovalWithContext registry arg.transfer.receiver.owner featuredAppRightC <- case optPreapproval of None -> pure emptyOpenApiChoiceContext Some preapproval -> getFeaturedAppRightContext registry preapproval.provider diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml index 85909d88e6..336d6b9a73 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml @@ -47,7 +47,7 @@ listHoldings p instrumentId = do let instrumendHoldings = do (cid, Some holding) <- holdings guard (holding.instrumentId == instrumentId) - guard (holding.owner == p) + guard (holding.account.owner == p) pure (cid, holding) pure instrumendHoldings @@ -113,7 +113,7 @@ listTransferOffers p instrumentId = do (cid, Some instr) <- instrs guard (instr.transfer.instrumentId == instrumentId) guard (instr.status == TransferInstructionV2.TransferPendingReceiverAcceptance) - guard (p == instr.transfer.sender || p == instr.transfer.receiver) + guard (p == instr.transfer.sender.owner || p == instr.transfer.receiver.owner) pure (cid, instr) pure pendingOffers @@ -128,7 +128,7 @@ listRequestedAllocationsForAdmin p admin = do let transferLegs = do (tfId, tf) <- TextMap.toList req.transferLegs guard (tf.instrumentId.admin == admin) - guard (p == tf.sender || p == tf.receiver) + guard (p == tf.sender.owner || p == tf.receiver.owner) return (tfId, tf) pure AllocationV2.AllocationSpecification with settlement = req.settlement diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml index 39ddee9824..52169d8bfc 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml @@ -78,8 +78,8 @@ setupOtcTrade = do AmuletRegistry.tapLockedAndUnlockedFunds registry bob 1000.0 let mkTransfer sender receiver amount = Api.Token.AllocationV2.TransferLeg with - sender - receiver + sender = basicAccount sender + receiver = basicAccount receiver amount instrumentId = amuletId meta = emptyMetadata @@ -109,7 +109,7 @@ setupOtcTrade = do -- Alice sees the allocation request in her wallet [aliceAlloc] <- WalletClient.listRequestedAllocationsForAdmin alice amuletId.admin let - [(_, tl)] = filter (\(_, tl) -> tl.sender == alice) (TextMap.toList aliceAlloc.transferLegs) + [(_, tl)] = filter (\(_, tl) -> tl.sender == basicAccount alice) (TextMap.toList aliceAlloc.transferLegs) tl.amount === 100.0 -- alice accepts allocation request directly via her wallet @@ -160,7 +160,7 @@ setupOtcTrade = do -- Bob sees the allocation request in his wallet as well [bobAlloc] <- WalletClient.listRequestedAllocationsForAdmin bob amuletId.admin let - [(_, tl)] = filter (\(_, tl) -> tl.sender == bob) (TextMap.toList aliceAlloc.transferLegs) + [(_, tl)] = filter (\(_, tl) -> tl.sender == basicAccount bob) (TextMap.toList aliceAlloc.transferLegs) tl.amount === 20.0 -- bob accepts allocation request directly via her wallet @@ -325,7 +325,7 @@ testDvPWithdraw = script do -- | List all allocations matching a particular settlement reference, sorted by their admin and trader. -- This function would be run on the trading app provider's backend as part of an automation loop. -appBackendListAllocations : Party -> Reference -> Script (Map Party (Map Party (ContractId Allocation, AllocationView))) +appBackendListAllocations : Party -> Reference -> Script (Map Party (Map Account (ContractId Allocation, AllocationView))) appBackendListAllocations p ref = do allocs <- queryInterface @Allocation p let matchingAllocs = do diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml index 74a8d655e8..a618bd5890 100644 --- a/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenTransfer.daml @@ -39,6 +39,8 @@ data TestSetup = TestSetup with bob : Party now : Time defaultTransfer : Api.Token.TransferInstructionV2.Transfer + aliceAccount : Account + bobAccount : Account setupTest : Script TestSetup setupTest = do @@ -64,12 +66,15 @@ setupTest = do -- Bob taps coin to send to Alice. AmuletRegistry.tapLockedAndUnlockedFunds registry bob 50.0 + let bobAccount = basicAccount bob + let aliceAccount = basicAccount alice + bobHoldings <- WalletClient.listHoldings bob registry.instrumentId let bobHoldingCids = map fst bobHoldings let actualBobHoldingViews = sortOn (.lock) $ map snd bobHoldings let expectedBobHoldingViews = sortOn (.lock) $ [ HoldingView with - owner = bob + account = bobAccount instrumentId = InstrumentId with id = "Amulet", admin = registry.dso amount = 25.0 lock = None @@ -80,7 +85,7 @@ setupTest = do , (ratePerRoundMetaKey, "0.00004") ] , HoldingView with - owner = bob + account = bobAccount instrumentId = InstrumentId with id = "Amulet", admin = registry.dso amount = 25.0 lock = Some $ Lock with @@ -104,8 +109,8 @@ setupTest = do -- Define default transfer from Bob to Alice let defaultTransfer = Api.Token.TransferInstructionV2.Transfer with - sender = bob - receiver = alice + sender = bobAccount + receiver = aliceAccount amount = 10.0 instrumentId = registry.instrumentId requestedAt = now @@ -127,17 +132,18 @@ setupTwoStepTransfer = do WalletClient.checkBalance alice registry.instrumentId 1000.0 WalletClient.checkBalanceApprox bob registry.instrumentId 50.0 - + -- check that the default transfer can be executed let transfer = defaultTransfer with - sender = alice - receiver = bob -- turn this around so that the transfer is a two-step one + sender = aliceAccount + receiver = bobAccount -- turn this around so that the transfer is a two-step one inputHoldingCids = map (coerceInterfaceContractId . fst) aliceHoldingCids enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with expectedAdmin = registry.dso transfer extraArgs = emptyExtraArgs + actor = None TextMap.size enrichedChoice.arg.extraArgs.context.values === 2 Map.size enrichedChoice.disclosures.disclosures === 3 @@ -176,13 +182,14 @@ test_happy_path_self = script do -- check that the default transfer can be executed let transfer = defaultTransfer with - sender = bob - receiver = bob + sender = bobAccount + receiver = bobAccount enrichedChoice <- RegistryApi.getTransferFactory registry TransferFactory_Transfer with expectedAdmin = registry.dso transfer extraArgs = emptyExtraArgs + actor = None TextMap.size enrichedChoice.arg.extraArgs.context.values === 2 Map.size enrichedChoice.disclosures.disclosures === 3 @@ -213,6 +220,7 @@ test_happy_path_direct = script do expectedAdmin = registry.dso transfer extraArgs = emptyExtraArgs + actor = None TextMap.size enrichedChoice.arg.extraArgs.context.values === 4 Map.size enrichedChoice.disclosures.disclosures === 5 @@ -271,6 +279,7 @@ test_two_step_success = do extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata + actor = None TransferInstructionResult_Completed receiverHoldingCids <- pure result.output case result.senderChangeCids of @@ -303,6 +312,7 @@ test_two_step_withdraw = do extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata + actor = None case result.senderChangeCids of @@ -342,6 +352,7 @@ test_two_step_withdraw_locked_amulet_gone = do extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata + actor = None -- move time back to the future (TM) so withdrawal can complete setTime (aliceInstrView.transfer.executeBefore `addRelTime` days 1) @@ -352,6 +363,7 @@ test_two_step_withdraw_locked_amulet_gone = do extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata + actor = None result.senderChangeCids === [] result.output === TransferInstructionResult_Failed @@ -380,6 +392,7 @@ test_two_step_reject = do extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata + actor = None case result.senderChangeCids of [holdingCid] -> WalletClient.checkHoldingApprox alice (coerceInterfaceContractId holdingCid) 10.0 @@ -413,6 +426,7 @@ test_two_step_reject_locked_amulet_gone = do extraArgs = ExtraArgs with context = context.choiceContext meta = emptyMetadata + actor = None result.senderChangeCids === [] result.output === TransferInstructionResult_Failed @@ -439,6 +453,7 @@ test_no_holdings = script do expectedAdmin = registry.dso transfer extraArgs = emptyExtraArgs + actor = None -- Show that the actual transfer choice fails submitWithDisclosuresMustFail' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg @@ -457,7 +472,8 @@ test_expired = script do expectedAdmin = registry.dso transfer extraArgs = emptyExtraArgs - + actor = None + -- Show that the actual transfer choice fails submitWithDisclosuresMustFail' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg @@ -476,6 +492,7 @@ test_wrong_admin = script do expectedAdmin = alice -- set the wrong admin transfer extraArgs = emptyExtraArgs + actor = None -- Show that the actual transfer choice fails submitWithDisclosuresMustFail' bob enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid enrichedChoice.arg @@ -491,6 +508,7 @@ test_factory_PublicFetch = do expectedAdmin = registry.dso transfer = defaultTransfer extraArgs = emptyExtraArgs + actor = None view <- submitWithDisclosures' alice enrichedChoice.disclosures $ exerciseCmd enrichedChoice.factoryCid TransferFactory_PublicFetch with expectedAdmin = registry.dso