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 e66f8da63b..cd95eb44fa 100644 --- a/build.sbt +++ b/build.sbt @@ -111,13 +111,20 @@ 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-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`, `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 +237,17 @@ 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-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-burn-mint-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( damlSources.toSet ).toSeq @@ -350,6 +363,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")) @@ -377,6 +401,33 @@ 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" + + BuildCommon.TS.generateOpenApiClient( + unscopedNpmName = "transfer-instruction-openapi", + 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")) @@ -385,7 +436,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`) @@ -402,6 +465,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")) @@ -415,6 +491,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")) @@ -437,7 +526,31 @@ 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 ++ + (`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-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, ) .dependsOn(`canton-bindings-java`) @@ -460,6 +573,24 @@ 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-v2-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-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-instruction-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")) @@ -675,10 +806,16 @@ 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, ) .dependsOn(`canton-bindings-java`) @@ -775,8 +912,9 @@ 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-instruction-v2-daml` / Compile / damlBuild).value ++ + (`splice-api-token-allocation-request-v2-daml` / Compile / damlBuild).value, ) .dependsOn(`canton-bindings-java`) @@ -813,7 +951,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.yaml b/daml/splice-amulet/daml.yaml index e646b82cf9..c9f277d57f 100644 --- a/daml/splice-amulet/daml.yaml +++ b/daml/splice-amulet/daml.yaml @@ -13,11 +13,16 @@ 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-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 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..61b40c289f 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 @@ -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,26 @@ 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 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 let feesReserveAmount = expectedTransferFees * 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 +128,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 92d1160f18..4f6d80ad69 100644 --- a/daml/splice-amulet/daml/Splice/AmuletAllocation.daml +++ b/daml/splice-amulet/daml/Splice/AmuletAllocation.daml @@ -6,11 +6,17 @@ module Splice.AmuletAllocation ( allocationToTwoStepTransfer, ) where +import DA.Assert((===), (=/=)) import DA.Text as Text +import DA.TextMap qualified as TextMap +import DA.List ((\\), dedupSort) +import DA.Optional(fromSome) 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 @@ -21,17 +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, allocation.transferLeg.sender + signatory admin, sender observer allocation.settlement.executor + 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 + 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 @@ -47,31 +68,67 @@ template AmuletAllocation senderHoldingCids meta = emptyMetadata -allocationInstrumentAdmin : AllocationSpecification -> Party -allocationInstrumentAdmin AllocationSpecification{..} = transferLeg.instrumentId.admin + 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)) + + 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) + + choice AmuletAllocation_InternalSettleWithExtraAuth : Allocation_ExecuteTransferResult + with + extraArgs : ExtraArgs + extraControllers : [Party] + controller extraControllers ++ allocationControllers allocation + do transferAmuletAllocation this extraArgs + +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 = allocationInstrumentAdmin allocation - sender = allocation.transferLeg.sender - receiver = allocation.transferLeg.receiver - amount = allocation.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 allocation.transferLegId, " to ", show allocation.transferLeg.receiver] + ["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 + +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 @@ -82,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/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..1e29f0ab20 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,18 +43,28 @@ 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 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" @@ -64,9 +76,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 +88,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..1353e8491e 100644 --- a/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/ExternalPartyAmuletRules.daml @@ -10,8 +10,12 @@ 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.AllocationInstructionV1 as Api.Token.AllocationInstructionV1 +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 + import Splice.Amulet.TokenApiUtils import Splice.Amulet.TwoStepTransfer @@ -63,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 @@ -81,7 +91,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)) + + allocationFactory_allocateImpl = allocationFactory_v1_allocateImpl (toInterface @AllocationFactory this) + allocationFactory_publicFetchImpl = allocationFactory_v1_publicFetchImpl (toInterface @AllocationFactory this) + data ExternalPartyAmuletRules_CreateTransferCommandResult = ExternalPartyAmuletRules_CreateTransferCommandResult with @@ -247,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 @@ -266,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 == transfer.instrumentId) + (expectedInstrumentId == transfer.instrumentId) -- TODO - remove -- amount: require "Amount must be positive" (transfer.amount > 0.0) -- requestedAt: @@ -295,9 +312,9 @@ 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 + output = TransferInstructionV2.TransferInstructionResult_Completed with receiverHoldingCids = createdAmuletToHolding <$> result.createdAmulets meta = copyOnlyBurnMeta result.meta @@ -313,9 +330,9 @@ amulet_transferFactory_transferImpl this _self arg = do inputHoldingCids = [toInterfaceContractId lockedAmulet] -- report the locked holding backing the transfer lockedAmulet -- return result - pure Api.Token.TransferInstructionV1.TransferInstructionResult with - senderChangeCids - output = Api.Token.TransferInstructionV1.TransferInstructionResult_Pending + pure TransferInstructionV2.TransferInstructionResult with + senderChangeCids = senderChangeCids + output = TransferInstructionV2.TransferInstructionResult_Pending with transferInstructionCid meta @@ -334,9 +351,9 @@ 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 + output = TransferInstructionV2.TransferInstructionResult_Completed with receiverHoldingCids = createdAmuletToHolding <$> result.result.createdAmulets meta = copyOnlyBurnMeta result.meta @@ -351,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 @@ -365,7 +382,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 @@ -376,15 +393,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" (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 @@ -393,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-amulet/daml/Splice/Types.daml b/daml/splice-amulet/daml/Splice/Types.daml index 9c976cebd3..54ea0c6c41 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.TransferInstructionV1 +import Splice.Api.Token.AllocationV2 +import Splice.Api.Token.HoldingV2 +import Splice.Api.Token.TransferInstructionV2 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..5cc9b97536 100644 --- a/daml/splice-wallet-test/daml.yaml +++ b/daml/splice-wallet-test/daml.yaml @@ -14,10 +14,16 @@ 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-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 + 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..6a296ace06 100644 --- a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml +++ b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml @@ -26,17 +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 qualified Splice.Api.Token.AllocationV1 as Api.Token.AllocationV1 -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.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.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.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 @@ -1003,7 +1003,7 @@ 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 @@ -1016,7 +1016,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 @@ -1026,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 () @@ -1099,7 +1099,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 @@ -1107,43 +1107,44 @@ 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 - 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 = [holdingCid] + inputHoldingCids = [coerceInterfaceContractId holdingCid] requestedAt = now extraArgs = emptyExtraArgs + creator = alice result <- submitMulti [aliceValidator] [alice, registry.dso] $ exerciseCmd aliceInstall WalletAppInstall_AllocationFactory_Allocate with 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 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..a646810655 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-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 - ../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..a17092d015 100644 --- a/daml/splice-wallet/daml/Splice/Wallet/Install.daml +++ b/daml/splice-wallet/daml/Splice/Wallet/Install.daml @@ -11,9 +11,9 @@ import DA.Time import DA.Foldable (forA_) import DA.Optional (isSome) -import qualified Splice.Api.Token.AllocationV1 -import qualified Splice.Api.Token.AllocationInstructionV1 -import qualified Splice.Api.Token.TransferInstructionV1 +import qualified Splice.Api.Token.AllocationV2 +import qualified Splice.Api.Token.AllocationInstructionV2 +import qualified Splice.Api.Token.TransferInstructionV2 import Splice.Amulet import Splice.Amulet.TokenApiUtils import Splice.Types @@ -585,10 +585,10 @@ 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) @@ -596,30 +596,30 @@ template WalletAppInstall 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 @@ -629,25 +629,26 @@ 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)) (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.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 + -- 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/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-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..800b25f2f2 --- /dev/null +++ b/token-standard/splice-api-token-allocation-instruction-v2/daml/Splice/Api/Token/AllocationInstructionV2.daml @@ -0,0 +1,179 @@ +-- 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. + 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. + 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 (view this).senders + 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. + creator : Party + controller creator + 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 new file mode 100644 index 0000000000..0315cd7978 --- /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.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 new file mode 100644 index 0000000000..610e128b4c --- /dev/null +++ b/token-standard/splice-api-token-allocation-v2/daml/Splice/Api/Token/AllocationV2.daml @@ -0,0 +1,292 @@ +-- 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.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. + +-- 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. +-- 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. + 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. + 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 + receiver : Party + admin : Party + -- ^ the settlement 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. +defaultAllocationControllers : AllocationSpecification -> [Party] +defaultAllocationControllers AllocationSpecification{..} = + dedup $ settlement.executor :: concatMap (\leg -> [leg._2.sender, leg._2.receiver]) (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 +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. +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) + + 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).allocation + do allocation_executeAuthorizeIncomingImpl this self arg + + -- 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 + extraArgs : ExtraArgs + -- ^ Additional context required in order to exercise the choice. + 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 + -- ^ 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).allocation + 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 (view this).senders + 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) + + +-- 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-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..b328a7806f --- /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.DecoderSpliceApiTokenHoldingV2 + 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-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-api-token-utils-v2/daml.yaml b/token-standard/splice-api-token-utils-v2/daml.yaml new file mode 100644 index 0000000000..a4471426aa --- /dev/null +++ b/token-standard/splice-api-token-utils-v2/daml.yaml @@ -0,0 +1,28 @@ +# 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 +- ../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: + 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..5e89b47a38 --- /dev/null +++ b/token-standard/splice-api-token-utils-v2/daml/Splice/Api/Token/UtilsV2.daml @@ -0,0 +1,487 @@ +-- 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 +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 +---------- + +-- 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 .. + +holding_v2_to_v1 : HoldingV2.HoldingView -> HoldingV1.HoldingView +holding_v2_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 + senders + requiredReceiverAuth + 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. + requiredReceiverAuth = case TextMap.lookup "canton.network/requiredReceiverAuth" 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/senders" (show senders) $ + TextMap.insert "canton.network/requiredReceiverAuth" (show requiredReceiverAuth) $ + 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 = [] + .. + +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) + + +-- 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 + 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 +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 + 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 + 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) + + +-- 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 new file mode 100644 index 0000000000..03514402c6 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml.yaml @@ -0,0 +1,45 @@ +# 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-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 + - ../splice-api-token-allocation-v2/.daml/dist/splice-api-token-allocation-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.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/TradingAppV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml new file mode 100644 index 0000000000..cd81965cc9 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Apps/TradingAppV2.daml @@ -0,0 +1,219 @@ +-- 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.TradingAppV2 where + +import DA.Foldable qualified as F +import DA.Optional (fromSomeNote) +import DA.Set qualified as Set +import DA.TextMap as TextMap +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 OTCTradeAllocationRequest with + otcTrade : OTCTrade + otcTradeCid : ContractId OTCTrade + where + signatory otcTrade.venue + observer otcTrade.venue, tradingParties (otcTrade.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 + + 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 + + allocationRequest_WithdrawImpl _self _extraArgs = + -- just archiving the trade is enough + pure ChoiceExecutionMetadata with meta = emptyMetadata + +template OTCTrade with + venue : Party + transferLegs : TextMap Api.Token.AllocationV2.TransferLeg + createdAt : Time + prepareUntil : Time + settleBefore : Time + where + signatory venue + observer venue, tradingParties transferLegs + + 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 : 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) + -- validate and execute transferLegs + let settlementInfo = SettlementInfo with + executor = venue + requestedAt = createdAt + settlementRef = makeTradeRef self + allocateBefore = prepareUntil + settleBefore + meta = emptyMetadata + 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 : [Allocation_CancelResult] + with + allocationsWithContext : [(ContractId Allocation, ExtraArgs)] + allocationRequests : [ContractId OTCTradeAllocationRequest] + controller venue + do + 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 + +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 +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 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) + + +-- Additional text map utilities +-------------------------------- + +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 + +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 + + 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 new file mode 100644 index 0000000000..66262bbf3c --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2.daml @@ -0,0 +1,429 @@ +-- 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.AmuletRegistryV2 + ( + -- * 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.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.Amulet +import Splice.AmuletConfig hiding (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.Schedule +import Splice.Round + +import Splice.Testing.UtilsV2 +import Splice.Testing.Registries.AmuletRegistryV2.Parameters +import Splice.Testing.TokenStandard.RegistryApiV2 + +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 + 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. +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 +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 + + 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 + .. + + _ <- 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 + 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 + (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/AmuletRegistryV2/Parameters.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2/Parameters.daml new file mode 100644 index 0000000000..081fc61dc7 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/Registries/AmuletRegistryV2/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.AmuletRegistryV2.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/RegistryApiV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApiV2.daml new file mode 100644 index 0000000000..4bef05f48b --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/RegistryApiV2.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.RegistryApiV2 + ( RegistryApi(..) + ) where + +import Splice.Api.Token.MetadataV1 +import Splice.Api.Token.AllocationV2 as Api.Token.AllocationV2 +import Splice.Api.Token.AllocationInstructionV2 +import Splice.Api.Token.TransferInstructionV2 + +import Splice.Testing.UtilsV2 + +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/WalletClientV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml new file mode 100644 index 0000000000..85909d88e6 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/TokenStandard/WalletClientV2.daml @@ -0,0 +1,136 @@ +-- 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.WalletClientV2 + ( + -- * Reading/checking holdings + listHoldings, + listHoldingCids, + listLockedHoldings, + + checkHoldingWithAmountExists, + checkBalanceBounds, + checkBalance, + checkBalanceApprox, + checkHolding, + checkHoldingBounds, + checkHoldingApprox, + + -- * Reading transfer instructions + listTransferOffers, + + -- * Reading allocations + listRequestedAllocationsForAdmin, + + ) where + +import DA.Action (unless) +import DA.Optional (isSome) +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.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. +listHoldings : Party -> HoldingV2.InstrumentId -> Script [(ContractId HoldingV2.Holding, HoldingV2.HoldingView)] +listHoldings p instrumentId = do + holdings <- queryInterface @HoldingV2.Holding p + let instrumendHoldings = do + (cid, Some holding) <- holdings + guard (holding.instrumentId == instrumentId) + guard (holding.owner == p) + pure (cid, holding) + pure instrumendHoldings + +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 -> 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 -> 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 -> HoldingV2.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 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 HoldingV2.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 -> 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 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 -> HoldingV2.InstrumentId -> Decimal -> Script () +checkBalance p instrumentId balance = + checkBalanceBounds p instrumentId (balance, balance) + +-- | List pending transfer offers (as sender or receiver) +listTransferOffers : Party -> HoldingV2.InstrumentId -> Script [(ContractId TransferInstructionV2.TransferInstruction, TransferInstructionV2.TransferInstructionView)] +listTransferOffers p instrumentId = do + instrs <- queryInterface @TransferInstructionV2.TransferInstruction p + let pendingOffers = do + (cid, Some instr) <- instrs + guard (instr.transfer.instrumentId == instrumentId) + guard (instr.status == TransferInstructionV2.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. +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 + 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 transferLegs + pure amuletAllocs diff --git a/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/UtilsV2.daml b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/UtilsV2.daml new file mode 100644 index 0000000000..e1f3090475 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Testing/UtilsV2.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.UtilsV2 + ( + -- * 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..71a0069780 --- /dev/null +++ b/token-standard/splice-token-standard-test-v2/daml/Splice/Tests/TestAmuletTokenDvP.daml @@ -0,0 +1,342 @@ +-- 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.Map as Map hiding (filter) +import DA.Time +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.AllocationRequestV2 +import Splice.Api.Token.AllocationInstructionV2 + +import Splice.Amulet +import Splice.Amulet.TokenApiUtils (burnedMetaKey) + +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 + alice : Party + bob : Party + provider : Party + providerBeneficiary1 : Party + providerBeneficiary2 : Party + providerBeneficiaries : [(Party, Decimal)] + registry : AmuletRegistry.AmuletRegistry + otcTradeCid : ContractId OTCTrade + otcTrade : OTCTrade + requestCid : ContractId OTCTradeAllocationRequest + 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.AllocationV2.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 + + -- venue creates a trade + now <- getTime + let settleBefore = 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 + createdAt = now + + -- 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.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 + 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 = map coerceInterfaceContractId inputHoldingCids + requestedAt = now + extraArgs = emptyExtraArgs + creator = alice + 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 = map coerceInterfaceContractId inputHoldingCids + requestedAt = now + extraArgs = emptyExtraArgs + creator = alice + 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 settlement OTCTradeProposal" + lockedHolding.lock === expectedLock + + -- 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.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 = map coerceInterfaceContractId inputHoldingCids + requestedAt = now + extraArgs = emptyExtraArgs + creator = bob + 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 === AllocationFactoryView registry.dso emptyMetadata + pure AllocatedOTCTrade with + alice + bob + provider + providerBeneficiary1 + providerBeneficiary2 + registry + providerBeneficiaries + otcTradeCid + otcTrade + requestCid + 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 = makeTradeRef otcTradeCid + allocationsMap <- appBackendListAllocations provider otcTradeRef + let [(_, amuletAllocations)] = Map.toList allocationsMap + Map.size amuletAllocations === 2 + + let beneficiaryMetadata = AmuletRegistry.beneficiariesToMetadata providerBeneficiaries + richAllocationsWithContext <- Traversable.forA amuletAllocations $ \(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 = Map.fromList [(amuletId.admin, fmap snd richAllocationsWithContext)] + allocationRequests = [requestCid] + + -- check metadata + forA_ results $ \result -> forA_ result $ \innerResult -> expectBurn innerResult.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 + + debug aliceAmount + 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 () +testDvPCancel = script do + AllocatedOTCTrade{..} <- setupOtcTrade + 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 + + 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 amuletAllocations $ \(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 = Map.values $ fmap snd richAllocationsWithContext + allocationRequests = [requestCid] + + [] <- WalletClient.listLockedHoldings alice registry.instrumentId + WalletClient.checkHoldingWithAmountExists alice amuletId aliceLockedHolding.amount + + [] <- queryInterface @Allocation alice + [] <- queryInterface @Allocation bob + + pure () + +testDvPWithdraw : Script () +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 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 p ref = do + allocs <- queryInterface @Allocation p + let matchingAllocs = do + (cid, Some fundedAllocation) <- allocs + guard (fundedAllocation.allocation.settlement.settlementRef == ref) + 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 = + 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..74a8d655e8 --- /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.HoldingV2 +import Splice.Api.Token.TransferInstructionV2 as Api.Token.TransferInstructionV2 + +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.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 +-------------------- + +data TestSetup = TestSetup with + registry : AmuletRegistry.AmuletRegistry + alice : Party + aliceValidator : Party + bob : Party + now : Time + defaultTransfer : Api.Token.TransferInstructionV2.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.TransferInstructionV2.Transfer with + sender = bob + receiver = alice + amount = 10.0 + instrumentId = registry.instrumentId + requestedAt = now + executeBefore = now `addRelTime` days 1 + inputHoldingCids = map coerceInterfaceContractId 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 (coerceInterfaceContractId . 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 (map coerceInterfaceContractId 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 (coerceInterfaceContractId splitHoldingCid) 10.0 + [changeHoldingCid] <- pure (map coerceInterfaceContractId 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 (coerceInterfaceContractId holdingCid) 40.0 + cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids) + case receiverHoldingCids of + [holdingCid] -> WalletClient.checkHoldingApprox alice (coerceInterfaceContractId 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 + map coerceInterfaceContractId 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 (coerceInterfaceContractId holdingCid) 1.0 + cids -> abort ("Unexpected number of senderHoldingCids: " <> show cids) + case receiverHoldingCids of + [holdingCid] -> WalletClient.checkHoldingApprox bob (coerceInterfaceContractId 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 + map coerceInterfaceContractId 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 (coerceInterfaceContractId 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 + map coerceInterfaceContractId aliceInstrView.transfer.inputHoldingCids === [ lockedHolding._1 ] + aliceInstrCid0 === aliceInstrCid + + -- pass time and unlock the amulet as the alice + let [lockedCid] = map coerceInterfaceContractId 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 + map coerceInterfaceContractId 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 (coerceInterfaceContractId 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 + 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] = map coerceInterfaceContractId 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.TransferInstructionV2.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 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 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