From b654e957f54c732d9a3546b518213ff08e4cd4f9 Mon Sep 17 00:00:00 2001 From: Simon Meier Date: Tue, 19 Aug 2025 08:17:34 +0000 Subject: [PATCH 1/6] partial changes for pre-approvals --- daml/splice-amulet/daml/Splice/Amulet.daml | 1 - .../daml/Splice/AmuletConfig.daml | 8 +++ .../daml/Splice/AmuletRules.daml | 59 ++++++++++++++----- 3 files changed, 52 insertions(+), 16 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/Amulet.daml b/daml/splice-amulet/daml/Splice/Amulet.daml index 57329940fe..e0d4ce4f29 100644 --- a/daml/splice-amulet/daml/Splice/Amulet.daml +++ b/daml/splice-amulet/daml/Splice/Amulet.daml @@ -334,7 +334,6 @@ template ValidatorRewardCoupon void $ fetchReferenceData (ForRound with dso; round) closedRoundCid return ValidatorRewardCoupon_DsoExpireResult with .. - choice ValidatorRewardCoupon_ArchiveAsValidator : ValidatorRewardCoupon_ArchiveAsValidatorResult -- ^ This choice was used by validators to archive the burn receipt upon claiming its corresponding issuance. with diff --git a/daml/splice-amulet/daml/Splice/AmuletConfig.daml b/daml/splice-amulet/daml/Splice/AmuletConfig.daml index abb4dc9af0..aee909b5d6 100644 --- a/daml/splice-amulet/daml/Splice/AmuletConfig.daml +++ b/daml/splice-amulet/daml/Splice/AmuletConfig.daml @@ -3,6 +3,7 @@ module Splice.AmuletConfig where +import DA.Optional (fromOptional) import DA.Time import Splice.Fees @@ -45,12 +46,18 @@ data AmuletConfig unit = AmuletConfig with -- that should be used for command submissions. transferPreapprovalFee : Optional Decimal -- ^ Fee for keeping a transfer pre-approval around. featuredAppActivityMarkerAmount : Optional Decimal -- ^ $-amount used for the conversion from FeaturedAppActivityMarker -> AppRewardCoupon + transferPreapprovalBaseDuration : Optional RelTime -- ^ Base duration of a transfer pre-approval granted for free on creation and renewal. deriving (Eq, Show) -- $1/year specified as a daily rate defaultTransferPreapprovalFee : Decimal defaultTransferPreapprovalFee = 0.00274 +-- | Retrieve the base transfer pre-approval duration from the config, defaulting to 90 days if not specified. +getTransferPreapprovalBaseDuration : AmuletConfig unit -> RelTime +getTransferPreapprovalBaseDuration config = + fromOptional (days 90) config.transferPreapprovalBaseDuration + -- Check constraints on config params on which the implementation of the choices rely. validAmuletConfig : AmuletConfig unit -> Bool validAmuletConfig AmuletConfig @@ -120,6 +127,7 @@ instance Patchable (AmuletConfig USD) where packageConfig = patch new.packageConfig base.packageConfig current.packageConfig transferPreapprovalFee = patch new.transferPreapprovalFee base.transferPreapprovalFee current.transferPreapprovalFee featuredAppActivityMarkerAmount = patch new.featuredAppActivityMarkerAmount base.featuredAppActivityMarkerAmount current.featuredAppActivityMarkerAmount + transferPreapprovalBaseDuration = patch new.transferPreapprovalBaseDuration base.transferPreapprovalBaseDuration current.transferPreapprovalBaseDuration instance Patchable (TransferConfig USD) where patch new base current = TransferConfig with diff --git a/daml/splice-amulet/daml/Splice/AmuletRules.daml b/daml/splice-amulet/daml/Splice/AmuletRules.daml index c0a94e8809..63e9bcdb2c 100644 --- a/daml/splice-amulet/daml/Splice/AmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/AmuletRules.daml @@ -25,7 +25,7 @@ import Splice.Api.Token.MetadataV1 as Api.Token.MetadataV1 import Splice.Api.Token.HoldingV1 qualified as Api.Token.HoldingV1 import Splice.Amulet import Splice.Amulet.TokenApiUtils -import Splice.AmuletConfig (AmuletConfig(..), TransferConfig(..), validAmuletConfig, defaultTransferPreapprovalFee) +import Splice.AmuletConfig (AmuletConfig(..), TransferConfig(..), validAmuletConfig, defaultTransferPreapprovalFee, getTransferPreapprovalBaseDuration) import qualified Splice.AmuletConfig as Unit import Splice.Schedule import Splice.Expiry @@ -1486,24 +1486,53 @@ template TransferPreapproval newExpiresAt : Time controller provider do - now <- getTime - require "Contract is not expired" (expiresAt > now) - require "newExpiresAt is after expiresAt" (newExpiresAt > expiresAt) - let extension = newExpiresAt `subTime` expiresAt - amuletRules <- fetchPublicReferenceData (ForDso dso) context.amuletRules (AmuletRules_Fetch dso) - let configUsd = getValueAsOf now amuletRules.configSchedule - (amuletPaid, _) <- computeTransferPreapprovalFee extension configUsd context.context dso - (transferResult, meta) <- splitAndBurn provider amuletPaid inputs context.context dso "renew TransferPreapproval" - transferPreapprovalCid <- create this with - lastRenewedAt = now - expiresAt = newExpiresAt - return TransferPreapproval_RenewResult with meta = Some meta, .. + assertWithinDeadline "TransferPreapproval.expiresAt" expiresAt + require "newExpiresAt is after expiresAt" (newExpiresAt > expiresAt) + amuletRules <- fetchChecked (ForDso dso) context.amuletRules + configUsd <- getValueAsOfLedgerTime amuletRules.configSchedule + let extension = newExpiresAt `subTime` expiresAt + let paidExtension = extension - getTransferPreapprovalBaseDuration configUsd + (amuletPaid, transferResult, meta) <- + if paidExtension <= aunit + then do + openMiningRound <- fetchChecked (ForDso dso) context.context.openMiningRound + pure + ( 0.0 + , TransferResult with + round = openMiningRound.round + summary = TransferSummary with + inputAmuletAmount = 0.0 + balanceChanges = Map.empty + inputAppRewardAmount = 0.0 + inputValidatorRewardAmount = 0.0 + inputUnclaimedActivityRecordAmount = None + inputValidatorFaucetAmount = None + inputSvRewardAmount = 0.0 + holdingFees = 0.0 + outputFees = [] + senderChangeFee = 0.0 + senderChangeAmount = 0.0 + amuletPrice = openMiningRound.amuletPrice + createdAmulets = [] + senderChangeAmulet = None + meta = None + , emptyMetadata) + else do + (amuletPaid, _) <- computeTransferPreapprovalFee paidExtension configUsd context.context dso + (transferResult, meta) <- splitAndBurn provider amuletPaid inputs context.context dso "renew TransferPreapproval" + pure (amuletPaid, transferResult, meta) + transferPreapprovalCid <- create this with + lastRenewedAt = expiresAt + expiresAt = newExpiresAt + return TransferPreapproval_RenewResult with meta = Some meta, .. + + -- FIXME(QUESTION): should we also provide a simple setup choice? -- Used by the DSO party to archive expired contracts choice TransferPreapproval_Expire : TransferPreapproval_ExpireResult controller dso - do now <- getTime - require "Contract has expired" (now >= expiresAt) + do + assertDeadlineExceeded "TransferPreapproval.expiresAt" expiresAt pure TransferPreapproval_ExpireResult -- Cancel the contract as the receiver or provider From 980935218171086c2c64bc09671264461dc863b7 Mon Sep 17 00:00:00 2001 From: Simon Meier Date: Tue, 19 Aug 2025 09:49:07 +0000 Subject: [PATCH 2/6] add free base duration for pre-approvals --- .../Splice/Scripts/TestExternalParty.daml | 4 +- .../Scripts/TestLockAndAmuletExpiry.daml | 1 + .../Scripts/TestTransferPreapproval.daml | 2 +- .../daml/Splice/AmuletConfig.daml | 11 +- .../daml/Splice/AmuletRules.daml | 126 ++++++++++-------- .../daml/Splice/Scripts/TestWallet.daml | 13 +- .../daml/Splice/Wallet/Install.daml | 1 + .../Splice/Wallet/TransferPreapproval.daml | 3 +- .../Registries/AmuletRegistry/Parameters.daml | 3 + 9 files changed, 100 insertions(+), 64 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml index 6c5235f50d..5f5a3e2dc5 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml @@ -80,7 +80,8 @@ createExternalPartySetupProposal app validator user = do context <- getPaymentTransferContext app validator amuletCid <- tap app validator 50.0 AmuletRules_CreateExternalPartySetupProposalResult{..} <- - checkTxMetadata app TxKind_Burn validator.primaryParty $ + -- FIXME: check both short and long durations + -- checkTxMetadata app TxKind_Burn validator.primaryParty $ submitMulti [validator.primaryParty] [app.dso] $ exerciseCmd amuletRulesCid AmuletRules_CreateExternalPartySetupProposal with context = context inputs = [InputAmulet amuletCid] @@ -88,6 +89,7 @@ createExternalPartySetupProposal app validator user = do validator = validator.primaryParty preapprovalExpiresAt expectedDso = Some app.dso + optCreatedAt = Some now Some proposal <- queryContractId app.dso proposalCid pure (proposalCid, proposal) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestLockAndAmuletExpiry.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestLockAndAmuletExpiry.daml index f39dae024a..26aa151ab3 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestLockAndAmuletExpiry.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestLockAndAmuletExpiry.daml @@ -33,6 +33,7 @@ scaleAmuletConfig amuletPrice config = AmuletConfig with packageConfig = config.packageConfig transferPreapprovalFee = fmap (/ amuletPrice) config.transferPreapprovalFee featuredAppActivityMarkerAmount = fmap (/ amuletPrice) config.featuredAppActivityMarkerAmount + transferPreapprovalBaseDuration = config.transferPreapprovalBaseDuration test : Script () test = script do diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestTransferPreapproval.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestTransferPreapproval.daml index 2b8229f027..1705155a2c 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestTransferPreapproval.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestTransferPreapproval.daml @@ -91,7 +91,7 @@ testTransferPreapprovalRenewal = script do newExpiresAt Some renewedPreapproval <- queryContractId app.dso result.transferPreapprovalCid renewedPreapproval === transferPreapproval with - lastRenewedAt = now + lastRenewedAt = expiresAt expiresAt = newExpiresAt -- Move forward in time to expire pre-approval diff --git a/daml/splice-amulet/daml/Splice/AmuletConfig.daml b/daml/splice-amulet/daml/Splice/AmuletConfig.daml index aee909b5d6..1131411b88 100644 --- a/daml/splice-amulet/daml/Splice/AmuletConfig.daml +++ b/daml/splice-amulet/daml/Splice/AmuletConfig.daml @@ -49,14 +49,19 @@ data AmuletConfig unit = AmuletConfig with transferPreapprovalBaseDuration : Optional RelTime -- ^ Base duration of a transfer pre-approval granted for free on creation and renewal. deriving (Eq, Show) --- $1/year specified as a daily rate +-- | $1/year specified as a daily rate defaultTransferPreapprovalFee : Decimal defaultTransferPreapprovalFee = 0.00274 --- | Retrieve the base transfer pre-approval duration from the config, defaulting to 90 days if not specified. +-- | 1/4 year as the setup and renewal transactions cost 1/4 year of traffic fees compared to a CC transfer. +-- FIXME: validate this number, it is likely higher as the full AmuletRules is used as an argument. +defaultTransferPreapprovalBaseDuration : RelTime +defaultTransferPreapprovalBaseDuration = days 90 + +-- | Retrieve the base transfer pre-approval duration from the config. getTransferPreapprovalBaseDuration : AmuletConfig unit -> RelTime getTransferPreapprovalBaseDuration config = - fromOptional (days 90) config.transferPreapprovalBaseDuration + fromOptional defaultTransferPreapprovalBaseDuration config.transferPreapprovalBaseDuration -- Check constraints on config params on which the implementation of the choices rely. validAmuletConfig : AmuletConfig unit -> Bool diff --git a/daml/splice-amulet/daml/Splice/AmuletRules.daml b/daml/splice-amulet/daml/Splice/AmuletRules.daml index 63e9bcdb2c..4e0d3b4410 100644 --- a/daml/splice-amulet/daml/Splice/AmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/AmuletRules.daml @@ -148,19 +148,25 @@ template AmuletRules -- Party that the sender expects to represent the DSO party of the AmuletRules contract they are calling. -- Must always be set to protect from malicious delegees swapping the AmuletRules contract out for -- one under their control. + optCreatedAt : Optional Time + -- ^ Optional createdAt time set by the caller. Must be in the past. + -- Set this to your wall-clock time to avoid a dependency on `getTime`, which is problematic for external parties. controller validator do checkExpectedDso dso expectedDso - now <- getTime - require "preapprovalExpiresAt is not in the past" (preapprovalExpiresAt > now) - let configUsd = getValueAsOf now configSchedule - (amuletPaid, _) <- computeTransferPreapprovalFee (preapprovalExpiresAt `subTime` now) configUsd context.context dso - (transferResult, meta) <- splitAndBurn validator amuletPaid inputs context.context dso "create ExternalPartySetupProposal" + createdAt <- case optCreatedAt of + None -> getTime + Some createdAt -> do + assertDeadlineExceeded "createdAt" createdAt + pure createdAt + assertWithinDeadline "preapprovalExpiresAt" preapprovalExpiresAt + (amuletPaid, transferResult, meta) <- + payForTransferPreapproval dso validator context inputs createdAt preapprovalExpiresAt proposalCid <- create ExternalPartySetupProposal with user validator dso - createdAt = now + createdAt preapprovalExpiresAt return AmuletRules_CreateExternalPartySetupProposalResult with meta = Some meta, .. @@ -176,20 +182,26 @@ template AmuletRules -- Party that the sender expects to represent the DSO party of the AmuletRules contract they are calling. -- Must always be set to protect from malicious delegees swapping the AmuletRules contract out for -- one under their control. + optCreatedAt : Optional Time + -- ^ Optional createdAt time set by the caller. Must be in the past. + -- Set this to your wall-clock time to avoid a dependency on `getTime`, which is problematic for external parties. controller provider, receiver do checkExpectedDso dso expectedDso - now <- getTime - require "expiresAt is not in the past" (expiresAt > now) - let configUsd = getValueAsOf now configSchedule - (amuletPaid, _) <- computeTransferPreapprovalFee (expiresAt `subTime` now) configUsd context.context dso - (transferResult, meta) <- splitAndBurn provider amuletPaid inputs context.context dso "create TransferPreapproval" + createdAt <- case optCreatedAt of + None -> getTime + Some createdAt -> do + assertDeadlineExceeded "createdAt" createdAt + pure createdAt + assertWithinDeadline "expiresAt" expiresAt + (amuletPaid, transferResult, meta) <- + payForTransferPreapproval dso provider context inputs createdAt expiresAt transferPreapprovalCid <- create TransferPreapproval with receiver provider dso - validFrom = now - lastRenewedAt = now + validFrom = createdAt + lastRenewedAt = createdAt expiresAt return AmuletRules_CreateTransferPreapprovalResult with meta = Some meta, .. @@ -342,9 +354,7 @@ template AmuletRules now <- getTime let configUsd = getValueAsOf now configSchedule let tickDuration = configUsd.tickDuration - let nr0 = case initialRound of - Some round -> round - None -> 0 + let nr0 = fromOptional 0 initialRound let nr1 = nr0 + 1 let nr2 = nr1 + 1 @@ -1427,14 +1437,14 @@ data ExternalPartySetupProposal_WithdrawResult = ExternalPartySetupProposal_With -- Receivers can either purchase and renew these pre-approvals by themselves, -- or have an app provider do so for them in exchange for the app rewards for -- the amulet transfers completed via the managed pre-approval. - template TransferPreapproval with dso : Party receiver : Party -- ^ The receiver party provider : Party -- ^ The app provider that manages the pre-approval for the receiver. Equal to the receiver for self-managed pre-approvals. validFrom : Time -- ^ This timestamp marks the start of the period for which fees were paid for the pre-approval. Preserved across renewals. - lastRenewedAt : Time -- ^ When the pre-approval was last renewed. Set equal to `validFrom` on creation and updated on each renewal. + lastRenewedAt : Time -- ^ The expiry of the pre-approval before its last extension, or the time when it was created. Used for tracking purposes only. + -- FIXME: consider passing in a `renewedAt` timestamp on renewal to avoid the slightly weird semantics here expiresAt : Time -- ^ Provider selected timestamp defining the lifetime of the contract. Can be extended by renewing the contract. where signatory receiver, provider, dso @@ -1478,7 +1488,10 @@ template TransferPreapproval let result = transferResult with meta = None pure (TransferPreapproval_SendResult result (Some (Metadata meta))) - -- Renew the contract as the provider + -- Renew the contract as the provider. + -- + -- Renewal durations shorter than `AmuletConfig.transferPreapprovalBaseDuration` do not require + -- any CC inputs, as they are implicitly paid for by the traffic fees spent for the renewal transaction. choice TransferPreapproval_Renew : TransferPreapproval_RenewResult with context : PaymentTransferContext @@ -1488,45 +1501,18 @@ template TransferPreapproval do assertWithinDeadline "TransferPreapproval.expiresAt" expiresAt require "newExpiresAt is after expiresAt" (newExpiresAt > expiresAt) - amuletRules <- fetchChecked (ForDso dso) context.amuletRules - configUsd <- getValueAsOfLedgerTime amuletRules.configSchedule - let extension = newExpiresAt `subTime` expiresAt - let paidExtension = extension - getTransferPreapprovalBaseDuration configUsd (amuletPaid, transferResult, meta) <- - if paidExtension <= aunit - then do - openMiningRound <- fetchChecked (ForDso dso) context.context.openMiningRound - pure - ( 0.0 - , TransferResult with - round = openMiningRound.round - summary = TransferSummary with - inputAmuletAmount = 0.0 - balanceChanges = Map.empty - inputAppRewardAmount = 0.0 - inputValidatorRewardAmount = 0.0 - inputUnclaimedActivityRecordAmount = None - inputValidatorFaucetAmount = None - inputSvRewardAmount = 0.0 - holdingFees = 0.0 - outputFees = [] - senderChangeFee = 0.0 - senderChangeAmount = 0.0 - amuletPrice = openMiningRound.amuletPrice - createdAmulets = [] - senderChangeAmulet = None - meta = None - , emptyMetadata) - else do - (amuletPaid, _) <- computeTransferPreapprovalFee paidExtension configUsd context.context dso - (transferResult, meta) <- splitAndBurn provider amuletPaid inputs context.context dso "renew TransferPreapproval" - pure (amuletPaid, transferResult, meta) + payForTransferPreapproval dso provider context inputs expiresAt newExpiresAt transferPreapprovalCid <- create this with + -- Last renewed at is only used for tracking purposes, so we assume that the + -- extension of the duration happens close enough to the current time so that + -- we can use the new expiration time as the last renewed time. + -- Thereby avoiding a dependency on `getTime`, which does not work well for external parties. lastRenewedAt = expiresAt expiresAt = newExpiresAt return TransferPreapproval_RenewResult with meta = Some meta, .. - -- FIXME(QUESTION): should we also provide a simple setup choice? + -- FIXME(QUESTION): should we also provide a simpler renewal choice that does not require a `PaymentTransferContext`? -- Used by the DSO party to archive expired contracts choice TransferPreapproval_Expire : TransferPreapproval_ExpireResult @@ -1626,6 +1612,42 @@ splitAndBurn sender amount inputs context dso usage = do totalBurnFromSummary : TransferSummary -> Decimal totalBurnFromSummary TransferSummary{..} = sum outputFees + holdingFees + senderChangeFee +payForTransferPreapproval + : Party -> Party -> PaymentTransferContext -> [TransferInput] -> Time -> Time + -> Update (Decimal, TransferResult, Metadata) +payForTransferPreapproval dso provider context inputs expiresAt newExpiresAt = do + amuletRules <- fetchChecked (ForDso dso) context.amuletRules + configUsd <- getValueAsOfLedgerTime amuletRules.configSchedule + let extension = newExpiresAt `subTime` expiresAt + let paidExtension = extension - getTransferPreapprovalBaseDuration configUsd + if paidExtension <= aunit + then do + openMiningRound <- fetchChecked (ForDso dso) context.context.openMiningRound + pure + ( 0.0 + , TransferResult with + round = openMiningRound.round + summary = TransferSummary with + inputAmuletAmount = 0.0 + balanceChanges = Map.empty + inputAppRewardAmount = 0.0 + inputValidatorRewardAmount = 0.0 + inputUnclaimedActivityRecordAmount = None + inputValidatorFaucetAmount = None + inputSvRewardAmount = 0.0 + holdingFees = 0.0 + outputFees = [] + senderChangeFee = 0.0 + senderChangeAmount = 0.0 + amuletPrice = openMiningRound.amuletPrice + createdAmulets = [] + senderChangeAmulet = None + meta = None + , emptyMetadata) + else do + (amuletPaid, _) <- computeTransferPreapprovalFee paidExtension configUsd context.context dso + (transferResult, meta) <- splitAndBurn provider amuletPaid inputs context.context dso "renew TransferPreapproval" + pure (amuletPaid, transferResult, meta) -- Token standard context parsing --------------------------------- diff --git a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml index 7555a7c1be..4d65bf19bf 100644 --- a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml +++ b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml @@ -13,7 +13,7 @@ import DA.TextMap as TextMap import Splice.Amulet import Splice.AmuletRules -import Splice.AmuletConfig (defaultTransferPreapprovalFee) +import Splice.AmuletConfig (defaultTransferPreapprovalFee, defaultTransferPreapprovalBaseDuration) import Splice.Types import Splice.Schedule import Splice.DecentralizedSynchronizer @@ -584,7 +584,7 @@ testTransferPreapproval = script do appRewardsBefore <- query @AppRewardCoupon aliceValidator.primaryParty validatorRewardsBefore <- query @ValidatorRewardCoupon aliceValidator.primaryParty - let duration = days 1 + let duration = days 100 WalletAppInstall_ExecuteBatchResult { outcomes } <- submitMulti [aliceValidator.primaryParty] [aliceValidator.primaryParty, app.dso] $ exerciseCmd install WalletAppInstall_ExecuteBatch with inputs = [InputAmulet amulet] @@ -593,12 +593,13 @@ testTransferPreapproval = script do let [COO_CreateExternalPartySetupProposal proposalCid] = outcomes Some proposal <- queryContractId aliceValidator.primaryParty proposalCid + let preapprovalExpiresAt = (now `addRelTime` duration) proposal === ExternalPartySetupProposal with user = alice.primaryParty validator = aliceValidator.primaryParty dso = app.dso createdAt = now - preapprovalExpiresAt = (now `addRelTime` duration) + preapprovalExpiresAt -- Check results of TransferPreapproval purchase (preapprovalFee, _) <- calculateTransferPreapprovalFee app duration @@ -630,7 +631,7 @@ testTransferPreapproval = script do preapprovalCid2 =/= preapprovalCid Some preapproval2 <- queryContractId aliceValidator.primaryParty preapprovalCid2 preapproval2 === preapproval with - lastRenewedAt = now + lastRenewedAt = preapprovalExpiresAt expiresAt = newExpiresAt checkAmuletPositions aliceValidator [1.0, initialAmount - 2.0*preapprovalFee - 4.0*createFee] @@ -1188,10 +1189,12 @@ calculateSynchronizerFees app trafficAmount = do pure (trafficCostCc, trafficCostUsd) calculateTransferPreapprovalFee : AmuletApp -> RelTime -> Script (Decimal, Decimal) -calculateTransferPreapprovalFee app duration = do +calculateTransferPreapprovalFee app duration0 = do [(_, amuletRules)] <- query @AmuletRules app.dso now <- getTime let configUsd = getValueAsOf now amuletRules.configSchedule + let duration = max (days 0) (duration0 - defaultTransferPreapprovalBaseDuration) + debug ("Duration", duration) let preapprovalFeeUsd = (relTimeToDays duration) * (fromOptional defaultTransferPreapprovalFee configUsd.transferPreapprovalFee) (_, openRound) <- getLatestOpenRound app let amuletPrice = openRound.amuletPrice diff --git a/daml/splice-wallet/daml/Splice/Wallet/Install.daml b/daml/splice-wallet/daml/Splice/Wallet/Install.daml index 8c4fe19b84..cd906efc7c 100644 --- a/daml/splice-wallet/daml/Splice/Wallet/Install.daml +++ b/daml/splice-wallet/daml/Splice/Wallet/Install.daml @@ -227,6 +227,7 @@ executeAmuletOperationRec executionContext inputs prevResults (operation::remain validator = executionContext.validator preapprovalExpiresAt expectedDso = Some executionContext.dso + optCreatedAt = None pure (proposalCid, transferResult.senderChangeAmulet) handleAcceptTransferPreapprovalProposal : ContractId TransferPreapprovalProposal -> Time -> Update (ContractId TransferPreapproval, Optional (ContractId Amulet)) diff --git a/daml/splice-wallet/daml/Splice/Wallet/TransferPreapproval.daml b/daml/splice-wallet/daml/Splice/Wallet/TransferPreapproval.daml index b900ab8063..3277cfdfd9 100644 --- a/daml/splice-wallet/daml/Splice/Wallet/TransferPreapproval.daml +++ b/daml/splice-wallet/daml/Splice/Wallet/TransferPreapproval.daml @@ -3,7 +3,6 @@ module Splice.Wallet.TransferPreapproval where -import Splice.Util import Splice.AmuletRules template TransferPreapprovalProposal @@ -25,7 +24,6 @@ template TransferPreapprovalProposal controller provider do now <- getTime - require "expiresAt is not in the past" (now < expiresAt) AmuletRules_CreateTransferPreapprovalResult{..} <- exercise context.amuletRules AmuletRules_CreateTransferPreapproval with context @@ -34,6 +32,7 @@ template TransferPreapprovalProposal provider expiresAt expectedDso + optCreatedAt = Some now return TransferPreapprovalProposal_AcceptResult with .. data TransferPreapprovalProposal_AcceptResult = TransferPreapprovalProposal_AcceptResult with diff --git a/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml b/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml index a806f1c567..b5b3e75386 100644 --- a/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml +++ b/token-standard/splice-token-standard-test/daml/Splice/Testing/Registries/AmuletRegistry/Parameters.daml @@ -88,6 +88,9 @@ defaultAmuletConfig = AmuletConfig with -- Amount of the AppRewardCoupon contract that a FeaturedAppActivityMarker is converted to. featuredAppActivityMarkerAmount = Some defaultFeaturedAppActivityMarkerAmount + -- Use the default that's set on read. + transferPreapprovalBaseDuration = None + -- | Default configuration schedule with single current amulet config defaultAmuletConfigSchedule : Schedule Time (AmuletConfig USD) defaultAmuletConfigSchedule = Schedule with From e1a0782db5de9e4a26652e2739a267d02c3c0b35 Mon Sep 17 00:00:00 2001 From: Simon Meier Date: Tue, 19 Aug 2025 14:53:37 +0000 Subject: [PATCH 3/6] adapt install contract to free base fee --- .../Splice/Scripts/TestExternalParty.daml | 1 - .../daml/Splice/Scripts/TestWallet.daml | 10 +++++-- .../daml/Splice/Wallet/Install.daml | 30 +++++++++++++------ 3 files changed, 29 insertions(+), 12 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml index 5f5a3e2dc5..d2b9095328 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml @@ -7,7 +7,6 @@ import Daml.Script import DA.Time import DA.Assert -import Splice.Amulet.TokenApiUtils import Splice.AmuletRules import Splice.Scripts.Util diff --git a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml index 4d65bf19bf..4bf1f00fec 100644 --- a/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml +++ b/daml/splice-wallet-test/daml/Splice/Scripts/TestWallet.daml @@ -588,10 +588,16 @@ testTransferPreapproval = script do WalletAppInstall_ExecuteBatchResult { outcomes } <- submitMulti [aliceValidator.primaryParty] [aliceValidator.primaryParty, app.dso] $ exerciseCmd install WalletAppInstall_ExecuteBatch with inputs = [InputAmulet amulet] - operations = [CO_CreateExternalPartySetupProposal alice.primaryParty (now `addRelTime` duration)] + operations = + -- create a short duration preapproval first to check batching logic handling unconsumed coin inputs + [ CO_CreateExternalPartySetupProposal alice.primaryParty (now `addRelTime` days 90) + , CO_CreateExternalPartySetupProposal alice.primaryParty (now `addRelTime` duration) + ] context - let [COO_CreateExternalPartySetupProposal proposalCid] = outcomes + debug ("outcomes", outcomes) + let [ COO_CreateExternalPartySetupProposal _shortLivedProposalCid, + COO_CreateExternalPartySetupProposal proposalCid ] = outcomes Some proposal <- queryContractId aliceValidator.primaryParty proposalCid let preapprovalExpiresAt = (now `addRelTime` duration) proposal === ExternalPartySetupProposal with diff --git a/daml/splice-wallet/daml/Splice/Wallet/Install.daml b/daml/splice-wallet/daml/Splice/Wallet/Install.daml index cd906efc7c..7dc111dbb7 100644 --- a/daml/splice-wallet/daml/Splice/Wallet/Install.daml +++ b/daml/splice-wallet/daml/Splice/Wallet/Install.daml @@ -80,14 +80,14 @@ executeAmuletOperationRec executionContext inputs prevResults (operation::remain CO_CreateExternalPartySetupProposal externalParty preapprovalExpiresAt -> do -- creates ExternalPartySetupProposal for externally hosted parties resultE <- catchAll $ handleCreateExternalPartySetupProposal executionContext externalParty preapprovalExpiresAt - handleResult COO_CreateExternalPartySetupProposal resultE + handleResultMultiChange COO_CreateExternalPartySetupProposal resultE CO_AcceptTransferPreapprovalProposal preapprovalProposalCid expiresAt -> do -- creates TransferPreapproval via the wallet resultE <- catchAll $ handleAcceptTransferPreapprovalProposal preapprovalProposalCid expiresAt - handleResult COO_AcceptTransferPreapprovalProposal resultE + handleResultMultiChange COO_AcceptTransferPreapprovalProposal resultE CO_RenewTransferPreapproval previousApprovalCid newExpiresAt -> do resultE <- catchAll $ handleRenewTransferPreapproval previousApprovalCid newExpiresAt - handleResult COO_RenewTransferPreapproval resultE + handleResultMultiChange COO_RenewTransferPreapproval resultE CO_TransferPreapprovalSend transferPreapprovalCid providerFeaturedAppRightCid amount description -> do -- The designated app provider for pre-approved transfers is the host of the receiver's party and -- not sender's wallet provider. So, the `featuredAppRight` in this context needs to be replaced @@ -112,6 +112,12 @@ executeAmuletOperationRec executionContext inputs prevResults (operation::remain let inputAmulets = optional [] (\amulet -> [InputAmulet amulet]) change executeAmuletOperationRec executionContext inputAmulets (resultConstructor result :: prevResults) remainingOperations + handleResultMultiChange : (r -> AmuletOperationOutcome) -> Either InvalidTransferReason (r, [TransferInput]) -> Update [AmuletOperationOutcome] + handleResultMultiChange resultConstructor = \case + Left errorMsg -> handleLeft errorMsg + Right (result, newInputs) -> do + executeAmuletOperationRec executionContext newInputs (resultConstructor result :: prevResults) remainingOperations + handleResultMergeInputs : Either InvalidTransferReason (TransferResult) -> Update [AmuletOperationOutcome] handleResultMergeInputs = \case Left errorMsg -> handleLeft errorMsg @@ -217,7 +223,7 @@ executeAmuletOperationRec executionContext inputs prevResults (operation::remain expectedDso = Some executionContext.dso pure (result.purchasedTraffic, result.senderChangeAmulet) - handleCreateExternalPartySetupProposal : ExecutionContext -> Party -> Time -> Update (ContractId ExternalPartySetupProposal, Optional (ContractId Amulet)) + handleCreateExternalPartySetupProposal : ExecutionContext -> Party -> Time -> Update (ContractId ExternalPartySetupProposal, [TransferInput]) handleCreateExternalPartySetupProposal executionContext externalParty preapprovalExpiresAt = do require "Only a validator can create a proposal to host an external party" (executionContext.endUser == executionContext.validator) AmuletRules_CreateExternalPartySetupProposalResult{..} <- exercise context.amuletRules AmuletRules_CreateExternalPartySetupProposal with @@ -228,24 +234,30 @@ executeAmuletOperationRec executionContext inputs prevResults (operation::remain preapprovalExpiresAt expectedDso = Some executionContext.dso optCreatedAt = None - pure (proposalCid, transferResult.senderChangeAmulet) + pure (proposalCid, inputsFromPreapprovalOperation amuletPaid transferResult) - handleAcceptTransferPreapprovalProposal : ContractId TransferPreapprovalProposal -> Time -> Update (ContractId TransferPreapproval, Optional (ContractId Amulet)) + handleAcceptTransferPreapprovalProposal : ContractId TransferPreapprovalProposal -> Time -> Update (ContractId TransferPreapproval, [TransferInput]) handleAcceptTransferPreapprovalProposal preapprovalProposalCid expiresAt = do require "Only a validator can accept a proposal to create a transfer preapproval" (executionContext.endUser == executionContext.validator) TransferPreapprovalProposal_AcceptResult{..} <- exercise preapprovalProposalCid TransferPreapprovalProposal_Accept with context = executionContext.paymentContext inputs expiresAt - pure (transferPreapprovalCid, transferResult.senderChangeAmulet) + pure (transferPreapprovalCid, inputsFromPreapprovalOperation amuletPaid transferResult) - handleRenewTransferPreapproval : ContractId TransferPreapproval -> Time -> Update (ContractId TransferPreapproval, Optional (ContractId Amulet)) + handleRenewTransferPreapproval : ContractId TransferPreapproval -> Time -> Update (ContractId TransferPreapproval, [TransferInput]) handleRenewTransferPreapproval previousApprovalCid newExpiresAt = do TransferPreapproval_RenewResult{..} <- exercise previousApprovalCid TransferPreapproval_Renew with context = executionContext.paymentContext inputs newExpiresAt - pure (transferPreapprovalCid, transferResult.senderChangeAmulet) + pure (transferPreapprovalCid, inputsFromPreapprovalOperation amuletPaid transferResult) + + inputsFromPreapprovalOperation : Decimal -> TransferResult -> [TransferInput] + inputsFromPreapprovalOperation amuletPaid transferResult = + if amuletPaid <= 0.0 + then inputs + else optional [] (\amulet -> [InputAmulet amulet]) transferResult.senderChangeAmulet executeAmuletOperationRec _executionContext _inputs prevResults [] = do return prevResults From e1dbcb9095935b71356dcf25d944c868d1ed3fac Mon Sep 17 00:00:00 2001 From: Simon Meier Date: Tue, 19 Aug 2025 15:05:59 +0000 Subject: [PATCH 4/6] Resolve FIXMEs --- daml/splice-amulet/daml/Splice/AmuletConfig.daml | 2 -- daml/splice-amulet/daml/Splice/AmuletRules.daml | 7 ------- 2 files changed, 9 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/AmuletConfig.daml b/daml/splice-amulet/daml/Splice/AmuletConfig.daml index 1131411b88..73dd841558 100644 --- a/daml/splice-amulet/daml/Splice/AmuletConfig.daml +++ b/daml/splice-amulet/daml/Splice/AmuletConfig.daml @@ -53,8 +53,6 @@ data AmuletConfig unit = AmuletConfig with defaultTransferPreapprovalFee : Decimal defaultTransferPreapprovalFee = 0.00274 --- | 1/4 year as the setup and renewal transactions cost 1/4 year of traffic fees compared to a CC transfer. --- FIXME: validate this number, it is likely higher as the full AmuletRules is used as an argument. defaultTransferPreapprovalBaseDuration : RelTime defaultTransferPreapprovalBaseDuration = days 90 diff --git a/daml/splice-amulet/daml/Splice/AmuletRules.daml b/daml/splice-amulet/daml/Splice/AmuletRules.daml index 4e0d3b4410..9763c5ffc7 100644 --- a/daml/splice-amulet/daml/Splice/AmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/AmuletRules.daml @@ -1444,7 +1444,6 @@ template TransferPreapproval provider : Party -- ^ The app provider that manages the pre-approval for the receiver. Equal to the receiver for self-managed pre-approvals. validFrom : Time -- ^ This timestamp marks the start of the period for which fees were paid for the pre-approval. Preserved across renewals. lastRenewedAt : Time -- ^ The expiry of the pre-approval before its last extension, or the time when it was created. Used for tracking purposes only. - -- FIXME: consider passing in a `renewedAt` timestamp on renewal to avoid the slightly weird semantics here expiresAt : Time -- ^ Provider selected timestamp defining the lifetime of the contract. Can be extended by renewing the contract. where signatory receiver, provider, dso @@ -1504,16 +1503,10 @@ template TransferPreapproval (amuletPaid, transferResult, meta) <- payForTransferPreapproval dso provider context inputs expiresAt newExpiresAt transferPreapprovalCid <- create this with - -- Last renewed at is only used for tracking purposes, so we assume that the - -- extension of the duration happens close enough to the current time so that - -- we can use the new expiration time as the last renewed time. - -- Thereby avoiding a dependency on `getTime`, which does not work well for external parties. lastRenewedAt = expiresAt expiresAt = newExpiresAt return TransferPreapproval_RenewResult with meta = Some meta, .. - -- FIXME(QUESTION): should we also provide a simpler renewal choice that does not require a `PaymentTransferContext`? - -- Used by the DSO party to archive expired contracts choice TransferPreapproval_Expire : TransferPreapproval_ExpireResult controller dso From b4c4146a6091464c7da4225078fbd51d37a2fc29 Mon Sep 17 00:00:00 2001 From: Simon Meier Date: Tue, 19 Aug 2025 15:12:33 +0000 Subject: [PATCH 5/6] add test for long and short duration extension --- .../Scripts/TestTransferPreapproval.daml | 25 +++++++++++++++---- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestTransferPreapproval.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestTransferPreapproval.daml index 1705155a2c..30d55180f7 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestTransferPreapproval.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestTransferPreapproval.daml @@ -82,28 +82,43 @@ testTransferPreapprovalRenewal = script do inputs = [InputAmulet providerAmuletCid] newExpiresAt = now - -- Provider can renew the pre-approval (before expiry) + -- Provider can renew the pre-approval without inputs for a short duration (before expiry) let newExpiresAt = now `addRelTime` (days 2) result <- submitMulti [aliceValidator.primaryParty] [app.dso] $ exerciseCmd transferPreapprovalCid TransferPreapproval_Renew with context = providerTransferContext - inputs = [InputAmulet providerAmuletCid] + inputs = [] newExpiresAt Some renewedPreapproval <- queryContractId app.dso result.transferPreapprovalCid renewedPreapproval === transferPreapproval with lastRenewedAt = expiresAt expiresAt = newExpiresAt + -- Provider can renew the pre-approval for a long duration with inputs (before expiry) + now <- getTime + let newExpiresAt2 = now `addRelTime` (days 1000) + result <- submitMulti [aliceValidator.primaryParty] [app.dso] $ + exerciseCmd result.transferPreapprovalCid TransferPreapproval_Renew with + context = providerTransferContext + inputs = [InputAmulet providerAmuletCid] + newExpiresAt = newExpiresAt2 + Some renewedPreapproval <- queryContractId app.dso result.transferPreapprovalCid + renewedPreapproval === transferPreapproval with + lastRenewedAt = newExpiresAt + expiresAt = newExpiresAt2 + -- Move forward in time to expire pre-approval - passTime (days 2) + passTime (days 1002) -- Renewal fails if the pre-approval has expired + now <- getTime providerAmuletCid2 <- tap app aliceValidator 10.0 + let newExpiresAt3 = now `addRelTime` (days 1000) submitMultiMustFail [aliceValidator.primaryParty] [app.dso] $ - exerciseCmd transferPreapprovalCid TransferPreapproval_Renew with + exerciseCmd result.transferPreapprovalCid TransferPreapproval_Renew with context = providerTransferContext inputs = [InputAmulet providerAmuletCid2] - newExpiresAt = now + newExpiresAt = newExpiresAt3 testTransferPreapprovalCancelExpire : Script () From fc16fc89cd0a7c605f7e29182c9c98639efdc71d Mon Sep 17 00:00:00 2001 From: Simon Meier Date: Tue, 19 Aug 2025 15:23:16 +0000 Subject: [PATCH 6/6] resolve another FIXME --- .../daml/Splice/Scripts/TestExternalParty.daml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml index d2b9095328..f0d7cbebe3 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml @@ -7,6 +7,7 @@ import Daml.Script import DA.Time import DA.Assert +import Splice.Amulet.TokenApiUtils import Splice.AmuletRules import Splice.Scripts.Util @@ -70,7 +71,7 @@ createExternalPartySetupProposal : AmuletApp -> AmuletUser -> Party -> Script (ContractId ExternalPartySetupProposal, ExternalPartySetupProposal) createExternalPartySetupProposal app validator user = do now <- getTime - let preapprovalExpiresAt = now `addRelTime` days 1 + let preapprovalExpiresAt = now `addRelTime` days 100 -- This would be submitted by the validator hosting the external party -- As part of the creation of the proposal, the validator also pays for the creation of the @@ -79,8 +80,7 @@ createExternalPartySetupProposal app validator user = do context <- getPaymentTransferContext app validator amuletCid <- tap app validator 50.0 AmuletRules_CreateExternalPartySetupProposalResult{..} <- - -- FIXME: check both short and long durations - -- checkTxMetadata app TxKind_Burn validator.primaryParty $ + checkTxMetadata app TxKind_Burn validator.primaryParty $ submitMulti [validator.primaryParty] [app.dso] $ exerciseCmd amuletRulesCid AmuletRules_CreateExternalPartySetupProposal with context = context inputs = [InputAmulet amuletCid]