DRAFT: daml - adjust preapproval fee

daml/splice-amulet-test/daml/Splice/Scripts/TestExternalParty.daml

@@ -71,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
@@ -88,6 +88,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)

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

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 = now
+    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 ()

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

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,21 @@ 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
+-- | $1/year specified as a daily rate
 defaultTransferPreapprovalFee : Decimal
 defaultTransferPreapprovalFee = 0.00274
 
+defaultTransferPreapprovalBaseDuration : RelTime
+defaultTransferPreapprovalBaseDuration = days 90
+
+-- | Retrieve the base transfer pre-approval duration from the config.
+getTransferPreapprovalBaseDuration : AmuletConfig unit -> RelTime
+getTransferPreapprovalBaseDuration config =
+  fromOptional defaultTransferPreapprovalBaseDuration config.transferPreapprovalBaseDuration
+
 -- Check constraints on config params on which the implementation of the choices rely.
 validAmuletConfig : AmuletConfig unit -> Bool
 validAmuletConfig AmuletConfig
@@ -120,6 +130,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

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
@@ -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,13 @@ 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.
     expiresAt : Time -- ^ Provider selected timestamp defining the lifetime of the contract. Can be extended by renewing the contract.
   where
     signatory receiver, provider, dso
@@ -1478,32 +1487,31 @@ 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
         inputs : [TransferInput]
         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)
+        (amuletPaid, transferResult, meta) <-
+          payForTransferPreapproval dso provider context inputs expiresAt newExpiresAt
+        transferPreapprovalCid <- create this with
+          lastRenewedAt = expiresAt
+          expiresAt = newExpiresAt
+        return TransferPreapproval_RenewResult with meta = Some meta, ..
 
     -- 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
@@ -1597,6 +1605,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
 ---------------------------------

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,21 +584,28 @@ 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]
-      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
     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 +637,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 +1195,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