Support transfers with 24h validity period

Signed-off-by: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>

Author: cocreature

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
+  externalPartyConfigStateTickDuration = config.externalPartyConfigStateTickDuration
 
 test : Script ()
 test = script do

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

@@ -76,11 +76,14 @@ genericSetupApp dsoPrefix = do
 
   _ <- submit dso $ createCmd ExternalPartyAmuletRules with dso
 
-  submitExerciseAmuletRulesByKey app [dso] [] AmuletRules_Bootstrap_Rounds with
+  result <- submitExerciseAmuletRulesByKey app [dso] [] AmuletRules_Bootstrap_Rounds with
       amuletPrice = 1.0
       round0Duration = hours 24 -- extra time for all initial svs to join
       initialRound = None
 
+  _ <- submitExerciseAmuletRulesByKey app [dso] [] AmuletRules_BootstrapExternalPartyConfigState with
+      openRoundCid = result.openMiningRoundCid
+
   -- return the off-ledger reference to the app for later script steps
   return app
 

daml/splice-amulet/daml/Splice/Amulet.daml

@@ -16,6 +16,7 @@ import Splice.Api.Token.HoldingV1 qualified as Api.Token.HoldingV1
 
 import Splice.Amulet.TokenApiUtils
 import Splice.Expiry
+import Splice.ExternalPartyConfigState
 import Splice.Fees
 import qualified Splice.Api.FeaturedAppRightV1
 import Splice.Round
@@ -81,7 +82,7 @@ data SvRewardCoupon_ArchiveAsBeneficiaryResult = SvRewardCoupon_ArchiveAsBenefic
 
 data UnclaimedActivityRecord_ArchiveAsBeneficiaryResult = UnclaimedActivityRecord_ArchiveAsBeneficiaryResult
 
-data UnclaimedActivityRecord_DsoExpireResult = UnclaimedActivityRecord_DsoExpireResult with 
+data UnclaimedActivityRecord_DsoExpireResult = UnclaimedActivityRecord_DsoExpireResult with
   unclaimedRewardCid : ContractId UnclaimedReward
 
 -- | A amulet, which can be locked and whose amount expires over time.
@@ -159,6 +160,19 @@ template LockedAmulet
          return LockedAmulet_UnlockResult with
            meta = Some (simpleHoldingTxMeta TxKind_Unlock (Some "holders released lock") None), ..
 
+    choice LockedAmulet_ExternalPartyUnlock : LockedAmulet_UnlockResult
+      with
+        externalPartyConfigStateCid : ContractId ExternalPartyConfigState
+      controller amulet.owner :: lock.holders
+      do externalPartyConfigState <- fetchReferenceData (ForDso with dso = amulet.dso) externalPartyConfigStateCid
+         amuletCid <- create amulet
+         let amuletSum = AmuletCreateSummary with
+               amulet = amuletCid
+               amuletPrice = externalPartyConfigState.amuletPrice
+               round = externalPartyConfigState.openRoundNumber
+         return LockedAmulet_UnlockResult with
+           meta = Some (simpleHoldingTxMeta TxKind_Unlock (Some "holders released lock") None), ..
+
     choice LockedAmulet_OwnerExpireLock : LockedAmulet_OwnerExpireLockResult
       with
         openRoundCid : ContractId OpenMiningRound
@@ -173,6 +187,20 @@ template LockedAmulet
          return LockedAmulet_OwnerExpireLockResult with
           meta = Some (simpleHoldingTxMeta TxKind_Unlock (Some "lock expired") None), ..
 
+    choice LockedAmulet_ExternalPartyOwnerExpireLock : LockedAmulet_OwnerExpireLockResult
+      with
+        externalPartyConfigStateCid : ContractId ExternalPartyConfigState
+      controller amulet.owner
+      do externalPartyConfigState <- fetchReferenceData (ForDso with dso = amulet.dso) externalPartyConfigStateCid
+         assertDeadlineExceeded "Lock.expiresAt" lock.expiresAt
+         amuletCid <- create amulet
+         let amuletSum = AmuletCreateSummary with
+               amulet = amuletCid
+               amuletPrice = externalPartyConfigState.amuletPrice
+               round = externalPartyConfigState.openRoundNumber
+         return LockedAmulet_OwnerExpireLockResult with
+          meta = Some (simpleHoldingTxMeta TxKind_Unlock (Some "lock expired") None), ..
+
     choice LockedAmulet_ExpireAmulet : LockedAmulet_ExpireAmuletResult
       with
         roundCid : ContractId OpenMiningRound
@@ -392,29 +420,29 @@ template UnclaimedReward with
 
     signatory dso
 
--- | A record of activity that can be minted by the beneficiary. 
--- Note that these do not come out of the per-round issuance but are instead created by burning 
--- UnclaimedRewardCoupon as defined through a vote by the SVs. That's also why expiry is a separate 
+-- | A record of activity that can be minted by the beneficiary.
+-- Note that these do not come out of the per-round issuance but are instead created by burning
+-- UnclaimedRewardCoupon as defined through a vote by the SVs. That's also why expiry is a separate
 -- time-based expiry instead of being tied to a round like the other activity records.
 template UnclaimedActivityRecord
   with
     dso : Party
     beneficiary : Party -- ^ The owner of the `Amulet` to be minted.
     amount : Decimal -- ^ The amount of `Amulet` to be minted.
-    reason : Text -- ^ A reason to mint the `Amulet`. 
-    expiresAt : Time -- ^ Selected timestamp defining the lifetime of the contract. 
-  where 
+    reason : Text -- ^ A reason to mint the `Amulet`.
+    expiresAt : Time -- ^ Selected timestamp defining the lifetime of the contract.
+  where
     signatory dso
     observer beneficiary
     ensure amount > 0.0
 
     choice UnclaimedActivityRecord_DsoExpire : UnclaimedActivityRecord_DsoExpireResult
       controller dso
-      do 
+      do
         assertDeadlineExceeded "UnclaimedActivityRecord.expiresAt" expiresAt
         unclaimedRewardCid <- create UnclaimedReward with dso; amount
         pure UnclaimedActivityRecord_DsoExpireResult with unclaimedRewardCid
-  
+
 
 requireAmuletExpiredForAllOpenRounds : ContractId OpenMiningRound -> Amulet -> Update ()
 requireAmuletExpiredForAllOpenRounds roundCid amulet = do
@@ -456,4 +484,4 @@ instance HasCheckedFetch FeaturedAppActivityMarker ForDso where
   contractGroupId FeaturedAppActivityMarker {..} = ForDso with dso
 
 instance HasCheckedFetch UnclaimedActivityRecord ForOwner where
-  contractGroupId UnclaimedActivityRecord{..} = ForOwner with dso; owner = beneficiary
+  contractGroupId UnclaimedActivityRecord{..} = ForOwner with dso; owner = beneficiary

daml/splice-amulet/daml/Splice/Amulet/TokenApiUtils.daml

@@ -43,7 +43,7 @@ nonZeroMetadata k n m
 
 -- | Add an metadata entry for an optional value if it is non-zero number.
 optionalNonZeroMetadata : (Eq a, Additive a, Show a) => Text -> Optional a -> TextMap Text -> TextMap Text
-optionalNonZeroMetadata k optN m = 
+optionalNonZeroMetadata k optN m =
   case optN of
     None -> m
     Some n -> nonZeroMetadata k n m
@@ -146,6 +146,9 @@ amuletRulesContextKey = "amulet-rules"
 openRoundContextKey : Text
 openRoundContextKey = "open-round"
 
+externalPartyConfigStateContextKey : Text
+externalPartyConfigStateContextKey = "external-party-config-state"
+
 featuredAppRightContextKey : Text
 featuredAppRightContextKey = "featured-app-right"
 

daml/splice-amulet/daml/Splice/Amulet/TwoStepTransfer.daml

@@ -45,41 +45,33 @@ data TwoStepTransfer = TwoStepTransfer with
     allowFeaturing : Bool
       -- ^ Whether the second step can be featured.
 
--- | The extra amount locked to guard against the transfer fees changing between
--- the time of locking the amulet and the time of executing the actual transfer.
-feeReserveMultiplier : Decimal
-feeReserveMultiplier = 4.0
-
 -- | Converting a set of holding inputs to inputs for an amulet transfer,
 -- unlocking any expired LockedAmulet holdings on the fly.
-holdingToTransferInputs : ForOwner -> PaymentTransferContext -> [ContractId Holding] -> Update [TransferInput]
-holdingToTransferInputs forOwner paymentContext inputHoldingCids =
+holdingToTransferInputs : ForOwner -> Either PaymentTransferContext ExternalPartyPaymentTransferContext -> [ContractId Holding] -> Update [TransferInput]
+holdingToTransferInputs forOwner paymentContextE inputHoldingCids =
   forA inputHoldingCids $ \holdingCid -> do
     holding <- fetchCheckedInterface @Holding forOwner holdingCid
     case fromInterface holding of
       Some (LockedAmulet {}) -> do
         let lockedAmuletCid : ContractId LockedAmulet = fromInterfaceContractId holdingCid
         -- We assume the lock is expired, and if not then we rely `LockedAmulet_OwnerExpireLock` to fail
-        result <- exercise lockedAmuletCid LockedAmulet_OwnerExpireLock with
-          openRoundCid = paymentContext.context.openMiningRound
-        pure $ InputAmulet result.amuletSum.amulet
+        case paymentContextE of
+          Left paymentContext -> do
+            result <- exercise lockedAmuletCid LockedAmulet_OwnerExpireLock with
+              openRoundCid = paymentContext.context.openMiningRound
+            pure $ InputAmulet result.amuletSum.amulet
+          Right externalPartyPaymentContext -> do
+            result <- exercise lockedAmuletCid LockedAmulet_ExternalPartyOwnerExpireLock with
+              externalPartyConfigStateCid = externalPartyPaymentContext.context.externalPartyConfigState
+            pure $ InputAmulet result.amuletSum.amulet
       None -> pure $ InputAmulet $ coerceContractId holdingCid
 
 -- | Prepare a two-step transfer of amulet by locking the funds.
 prepareTwoStepTransfer
-  : TwoStepTransfer -> Time -> [ContractId Holding] -> PaymentTransferContext
+  : TwoStepTransfer -> Time -> [ContractId Holding] -> Either PaymentTransferContext ExternalPartyPaymentTransferContext
   -> Update (ContractId LockedAmulet, [ContractId Holding], Metadata)
 prepareTwoStepTransfer TwoStepTransfer{..} requestedAt inputHoldingCids paymentContext = do
   require "requestedAt < transferBefore" (requestedAt < transferBefore)
-  -- over-approximate fees that will be due on the actual transfer
-  let receiverOutputForActualTransfer = TransferOutput with
-        receiver
-        amount
-        receiverFeeRatio = 0.0  -- all fees are paid by the sender
-        lock = None
-  [expectedTransferFees] <- exerciseComputeFees dso paymentContext sender [receiverOutputForActualTransfer]
-  let feesReserveAmount = expectedTransferFees * feeReserveMultiplier
-
   -- lock the amulet
   transferInputs <- holdingToTransferInputs (ForOwner with dso; owner = sender) paymentContext inputHoldingCids
   let transfer = Splice.AmuletRules.Transfer with
@@ -88,8 +80,8 @@ prepareTwoStepTransfer TwoStepTransfer{..} requestedAt inputHoldingCids paymentC
         outputs =
           [ TransferOutput with
               receiver = sender
-              amount = amount + feesReserveAmount
-              receiverFeeRatio = 0.0 -- locking fees are paid by the sender
+              amount = amount
+              receiverFeeRatio = 0.0 -- irrelevant as fees are always zero
               lock = Some TimeLock with
                 expiresAt = transferBefore
                 holders = [dso]
@@ -98,7 +90,7 @@ prepareTwoStepTransfer TwoStepTransfer{..} requestedAt inputHoldingCids paymentC
         inputs = transferInputs
         beneficiaries = None
 
-  result <- exercisePaymentTransfer dso paymentContext transfer
+  result <- exerciseExternalPartyPaymentTransferWithFallback dso paymentContext transfer
   let [TransferResultLockedAmulet lockedAmulet] = result.createdAmulets
   pure
     ( lockedAmulet
@@ -121,9 +113,8 @@ executeTwoStepTransfer TwoStepTransfer{..} lockedAmuletCid extraArgs = do
         -- ignore beneficiaries in case we are not allowing featuring
         context <- unfeaturedPaymentContextFromChoiceContext dso extraArgs.context
         pure (context, None)
-  let openRoundCid = paymentContext.context.openMiningRound
   -- unlock amulet
-  unlockResult <- exercise lockedAmuletCid LockedAmulet_Unlock with openRoundCid
+  unlockResult <- unlockAmulet paymentContext lockedAmuletCid
   let amuletCid = unlockResult.amuletSum.amulet
   -- execute transfer
   let receiverOutput = TransferOutput with
@@ -137,7 +128,7 @@ executeTwoStepTransfer TwoStepTransfer{..} lockedAmuletCid extraArgs = do
         inputs = [InputAmulet amuletCid]
         outputs = [receiverOutput]
         beneficiaries
-  result <- exercisePaymentTransfer dso paymentContext amuletRulesTransfer
+  result <- exerciseExternalPartyPaymentTransferWithFallback dso paymentContext amuletRulesTransfer
   pure
     ( optionalToList (toInterfaceContractId <$> result.senderChangeAmulet)
     , createdAmuletToHolding <$> result.createdAmulets
@@ -149,6 +140,7 @@ abortTwoStepTransfer TwoStepTransfer{..} lockedAmuletCid extraArgs = do
   expireLockedAmulet <- getFromContextU @Bool extraArgs.context expireLockKey
   if expireLockedAmulet
     then do
+      -- FIXME: switch this to ExternalPartyConfigState
       openRoundCid <- getFromContextU @(ContractId OpenMiningRound) extraArgs.context openRoundContextKey
       -- prudent engineering: check the DSO party
       _ <- fetchChecked (ForDso with dso) openRoundCid
@@ -159,3 +151,10 @@ abortTwoStepTransfer TwoStepTransfer{..} lockedAmuletCid extraArgs = do
       assertDeadlineExceeded transferBeforeDeadline transferBefore
       pure []
 
+unlockAmulet : Either PaymentTransferContext ExternalPartyPaymentTransferContext -> ContractId LockedAmulet -> Update LockedAmulet_UnlockResult
+unlockAmulet transferContextE lockedAmuletCid = do
+  case transferContextE of
+    Left paymentContext -> do
+      exercise lockedAmuletCid LockedAmulet_Unlock with openRoundCid = paymentContext.context.openMiningRound
+    Right externalPartyPaymentContext -> do
+      exercise lockedAmuletCid LockedAmulet_ExternalPartyUnlock with externalPartyConfigStateCid = externalPartyPaymentContext.context.externalPartyConfigState

daml/splice-amulet/daml/Splice/AmuletConfig.daml

@@ -3,6 +3,7 @@
 
 module Splice.AmuletConfig where
 
+import DA.Optional
 import DA.Time
 
 import Splice.Fees
@@ -45,8 +46,12 @@ 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
+    externalPartyConfigStateTickDuration : Optional RelTime
   deriving (Eq, Show)
 
+getExternalPartyConfigStateTickDuration : AmuletConfig a -> RelTime
+getExternalPartyConfigStateTickDuration config = fromOptional (hours 24) config.externalPartyConfigStateTickDuration
+
 -- $1/year specified as a daily rate
 defaultTransferPreapprovalFee : Decimal
 defaultTransferPreapprovalFee = 0.00274
@@ -69,7 +74,8 @@ validAmuletConfig AmuletConfig
     tickDuration > days 0 &&
     validPackageConfig packageConfig &&
     optional True (>= 0.0) transferPreapprovalFee &&
-    optional True (>= 0.0) featuredAppActivityMarkerAmount
+    optional True (>= 0.0) featuredAppActivityMarkerAmount &&
+    featuredAppActivityMarkerAmount == Some transferConfig.extraFeaturedAppRewardAmount
 
 validTransferConfig : TransferConfig unit -> Bool
 validTransferConfig TransferConfig
@@ -83,10 +89,11 @@ validTransferConfig TransferConfig
     , maxNumLockHolders
     }
   =
-    positiveFixedFee createFee &&
+    createFee == FixedFee 0.0 &&
     positiveRatePerRound holdingFee &&
-    validSteppedRate transferFee &&
-    positiveFixedFee lockHolderFee &&
+    transferFee.initialRate == 0.0 &&
+    all (\(_, r) -> r == 0.0) transferFee.steps &&
+    lockHolderFee == FixedFee 0.0 &&
     extraFeaturedAppRewardAmount >= 0.0 &&
     maxNumInputs >= 1 &&
     maxNumOutputs >= 1 &&
@@ -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
+    externalPartyConfigStateTickDuration = patch new.externalPartyConfigStateTickDuration base.externalPartyConfigStateTickDuration current.externalPartyConfigStateTickDuration
 
 instance Patchable (TransferConfig USD) where
   patch new base current = TransferConfig with