Support transfers with 24h validity period

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

Author: cocreature

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

@@ -27,6 +27,7 @@ import Splice.AmuletConfig (AmuletConfig(..))
 import qualified Splice.AmuletConfig as Unit
 import Splice.Expiry
 import Splice.ExternalPartyAmuletRules
+import Splice.ExternalPartyConfigState
 import Splice.Issuance
 import Splice.Round
 import Splice.Fees
@@ -76,11 +77,44 @@ 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
 
+  Some openMiningRound <- queryContractId dso result.openMiningRoundCid
+
+  now <- getTime
+
+  -- FIXME: Consider moving the bootstrapping to AmuletRules so we can reuse AmuletRules_BootstrapExternalPartyConfigState
+  -- upside: no duplication here
+  -- downside: requires moving the tick parameter + the code into splice-amulet so changes are more disruptive and outside of testing it doesn't
+  -- seem to have a clear advantage
+
+  submit dso $ createCmd ExternalPartyConfigState with
+    dso
+    openRoundNumber = openMiningRound.round
+    amuletPrice = openMiningRound.amuletPrice
+    transferConfig = openMiningRound.transferConfigUsd
+    validFrom = now
+    validUntil = now `addRelTime` hours 24
+
+  submit dso $ createCmd ExternalPartyConfigState with
+    dso
+    openRoundNumber = openMiningRound.round
+    amuletPrice = openMiningRound.amuletPrice
+    transferConfig = openMiningRound.transferConfigUsd
+    validFrom = now
+    validUntil = now `addRelTime` hours 48
+
+  submit dso $ createCmd ExternalPartyConfigState with
+    dso
+    openRoundNumber = openMiningRound.round
+    amuletPrice = openMiningRound.amuletPrice
+    transferConfig = openMiningRound.transferConfigUsd
+    validFrom = now `addRelTime` hours 24
+    validUntil = now `addRelTime` hours 72
+
   -- 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

@@ -52,32 +52,40 @@ 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 receiverOutputForActualTransfer = TransferOutput with
+        -- receiver
+        -- amount
+        -- receiverFeeRatio = 0.0  -- all fees are paid by the sender
+        -- lock = None
+  -- FIXME: consider if we do need to preserve this in some form but don't see why
+  -- [expectedTransferFees] <- exerciseComputeFees dso paymentContext sender [receiverOutputForActualTransfer]
+  let expectedTransferFees = 0.0
   let feesReserveAmount = expectedTransferFees * feeReserveMultiplier
 
   -- lock the amulet
@@ -98,7 +106,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 +129,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 +144,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 +156,7 @@ abortTwoStepTransfer TwoStepTransfer{..} lockedAmuletCid extraArgs = do
   expireLockedAmulet <- getFromContextU @Bool extraArgs.context expireLockKey
   if expireLockedAmulet
     then do
+      -- FIXME
       openRoundCid <- getFromContextU @(ContractId OpenMiningRound) extraArgs.context openRoundContextKey
       -- prudent engineering: check the DSO party
       _ <- fetchChecked (ForDso with dso) openRoundCid
@@ -159,3 +167,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

@@ -69,7 +69,11 @@ validAmuletConfig AmuletConfig
     tickDuration > days 0 &&
     validPackageConfig packageConfig &&
     optional True (>= 0.0) transferPreapprovalFee &&
-    optional True (>= 0.0) featuredAppActivityMarkerAmount
+    optional True (>= 0.0) featuredAppActivityMarkerAmount &&
+    -- FIXME: If we don't want to do that we could instead
+    -- create app reward coupons instead of markers when they are not the same. That
+    -- seems kind of needless complexity given that we don't expect them to deviate.
+    featuredAppActivityMarkerAmount == Some transferConfig.extraFeaturedAppRewardAmount
 
 validTransferConfig : TransferConfig unit -> Bool
 validTransferConfig TransferConfig