diff --git a/daml/splice-amulet/daml/Splice/Amulet.daml b/daml/splice-amulet/daml/Splice/Amulet.daml index a6f2c96e61..807b96b8b5 100644 --- a/daml/splice-amulet/daml/Splice/Amulet.daml +++ b/daml/splice-amulet/daml/Splice/Amulet.daml @@ -110,6 +110,10 @@ data FeaturedAppRight_UpdateResult = FeaturedAppRight_UpdateResult with data FeaturedAppRight_CancelResult = FeaturedAppRight_CancelResult deriving (Serializable) +data FeaturedAppRight_UpdateUnderlockResult = FeaturedAppRight_UpdateUnderlockResult with + featuredAppRightCid : ContractId FeaturedAppRight + deriving (Serializable) + data AppRewardCoupon_DsoExpireResult = AppRewardCoupon_DsoExpireResult with featured : Bool amount : Decimal @@ -307,10 +311,18 @@ template FeaturedAppRight with -- ^ Weight of the this provider's app activity in the computation of traffic-based app rewards. -- -- If not set, the default weight of 1.0 is used. + requiredLockAmount : Optional Decimal + -- ^ Override of the network-wide minimum lock threshold. + -- None means that the default in DsoRulesConfig applies. + firstUnderlockObservedAt : Optional Time + -- ^ Ledger time at which the DSO first observed this provider underlocked. + -- Some t means suspended since time t, and archivable from t + grace period. + -- None means compliant. Never set before enforcement is activated. where signatory dso observer provider ensure 0.0 <= fromOptional defaultAppActivityWeight activityWeight + && 0.0 <= fromOptional 0.0 requiredLockAmount choice FeaturedAppRight_Update : FeaturedAppRight_UpdateResult with @@ -334,6 +346,21 @@ template FeaturedAppRight with controller provider do return FeaturedAppRight_CancelResult + choice FeaturedAppRight_UpdateUnderlock : FeaturedAppRight_UpdateUnderlockResult + with + underlocked : Bool + controller dso + do + now <- getTime + let newObservedAt = + if underlocked + then Some (fromOptional now firstUnderlockObservedAt) + else None + featuredAppRightCid <- create this with + firstUnderlockObservedAt = newObservedAt + return FeaturedAppRight_UpdateUnderlockResult with + featuredAppRightCid + interface instance Splice.Api.FeaturedAppRightV1.FeaturedAppRight for FeaturedAppRight where view = Splice.Api.FeaturedAppRightV1.FeaturedAppRightView with dso, provider diff --git a/daml/splice-amulet/daml/Splice/AmuletRules.daml b/daml/splice-amulet/daml/Splice/AmuletRules.daml index 522c9cb564..ae3ef87889 100644 --- a/daml/splice-amulet/daml/Splice/AmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/AmuletRules.daml @@ -420,7 +420,9 @@ template AmuletRules controller provider do require "isDevNet flag is true" isDevNet - featuredAppRightCid <- create FeaturedAppRight with dso; provider; activityWeight + let requiredLockAmount = None + firstUnderlockObservedAt = None + featuredAppRightCid <- create FeaturedAppRight with dso; provider; activityWeight; requiredLockAmount; firstUnderlockObservedAt return AmuletRules_DevNet_FeatureAppResult with .. -- Bootstrap the open mining rounds by creating diff --git a/daml/splice-dso-governance/daml/Splice/DsoRules.daml b/daml/splice-dso-governance/daml/Splice/DsoRules.daml index fbf97ff083..34ab2a9a59 100644 --- a/daml/splice-dso-governance/daml/Splice/DsoRules.daml +++ b/daml/splice-dso-governance/daml/Splice/DsoRules.daml @@ -121,6 +121,7 @@ data DsoRules_ActionRequiringConfirmation -- ^ Create BootstrapExternalPartyConfigStateInstruction | SRARC_UpdateFeaturedAppRight DsoRules_UpdateFeaturedAppRight -- ^ Update a specific featured app right. + | SRARC_UpdateFeaturedAppUnderlock DsoRules_UpdateFeaturedAppUnderlock deriving (Eq, Show, Serializable) data AnsEntryContext_ActionRequiringConfirmation @@ -235,6 +236,9 @@ data DsoRules_UpdateFeaturedAppRightResult = DsoRules_UpdateFeaturedAppRightResu result : FeaturedAppRight_UpdateResult deriving (Serializable) +data DsoRules_UpdateFeaturedAppUnderlockResult = DsoRules_UpdateFeaturedAppUnderlockResult + deriving (Serializable) + data DsoRules_OnboardValidatorResult = DsoRules_OnboardValidatorResult with validatorLicense : ContractId ValidatorLicense deriving (Serializable) @@ -543,12 +547,26 @@ data DsoRulesConfig = DsoRulesConfig with nextScheduledSynchronizerUpgrade: Optional SynchronizerUpgradeSchedule voteCooldownTime : Optional RelTime -- ^ The minimum time between two votes by the same SV. nextScheduledLogicalSynchronizerUpgrade: Optional LogicalSynchronizerUpgradeSchedule + faDefaultRequiredLockAmount : Optional Decimal -- ^ The amount of amulet required to be locked by an FA to maintain their FeaturedAppRight if its requiredLockAmount is None. + faUnderlockGracePeriod : Optional RelTime -- ^ The amount of time after which automatic enforcement will withdraw a FeaturedAppRight if its provider remains underlocked. + faUnderlockEnforcementEnabled : Optional Bool -- ^ Whether automatic FA underlock enforcement may now occur, used to support a transitionary period. deriving (Eq, Show, Serializable) -- | Read the `voteCooldownTime` from the `DsoRulesConfig` with a default value of 1 minute. getVoteCooldownTime : DsoRulesConfig -> RelTime getVoteCooldownTime config = fromOptional (minutes 1) config.voteCooldownTime +-- | Read the `faDefaultRequiredLockAmount` from the `DsoRulesConfig` with a default value of 5_000_000.0 +getFaDefaultRequiredLockAmount : DsoRulesConfig -> Decimal +getFaDefaultRequiredLockAmount config = fromOptional 5_000_000.0 config.faDefaultRequiredLockAmount + +-- | Read the `faUnderlockGracePeriod` from the `DsoRulesConfig` with a default value of 7 days. +getFaUnderlockGracePeriod : DsoRulesConfig -> RelTime +getFaUnderlockGracePeriod config = fromOptional (days 7) config.faUnderlockGracePeriod + +-- | Read the `faUnderlockEnforcementEnabled` from the `DsoRulesConfig` with a default value of False. +getFaUnderlockEnforcementEnabled : DsoRulesConfig -> Bool +getFaUnderlockEnforcementEnabled config = fromOptional False config.faUnderlockEnforcementEnabled data SynchronizerUpgradeSchedule = SynchronizerUpgradeSchedule with time : Time @@ -575,6 +593,13 @@ data TrafficState = TrafficState with consumedTraffic: Int -- ^ Bytes of extra traffic consumed before the decentralized synchronizer was bootstrapped. deriving (Eq, Show, Serializable) +-- | This is an enumeration of the transitions in underlocking state that can be caused by DsoRules_UpdateFeaturedAppUnderlock +data FaUnderlockTransition = + FaUnderlockTransition_Open -- ^ Transition to underlocked state + | FaUnderlockTransition_Close -- ^ Transition to compliant state + | FaUnderlockTransition_Enforce -- ^ Withdraw rights + deriving (Eq, Show, Serializable) + template DsoRules with dso : Party epoch : Int @@ -1072,12 +1097,15 @@ template DsoRules with with provider : Party activityWeight : Optional Decimal + requiredLockAmount : Optional Decimal controller dso do featuredAppRight <- create FeaturedAppRight with dso provider activityWeight + requiredLockAmount + firstUnderlockObservedAt = None return DsoRules_GrantFeaturedAppRightResult with .. nonconsuming choice DsoRules_RevokeFeaturedAppRight : DsoRules_RevokeFeaturedAppRightResult @@ -1100,6 +1128,28 @@ template DsoRules with result <- exercise rightCid update return DsoRules_UpdateFeaturedAppRightResult with result + nonconsuming choice DsoRules_UpdateFeaturedAppUnderlock : DsoRules_UpdateFeaturedAppUnderlockResult + with + rightCid : ContractId FeaturedAppRight + transition : FaUnderlockTransition + controller dso + do + right <- fetchChecked (ForDso with dso) rightCid + now <- getTime + require "FA underlock enforcement is active" + (getFaUnderlockEnforcementEnabled this.config) + case transition of + FaUnderlockTransition_Open -> void $ exercise rightCid FeaturedAppRight_UpdateUnderlock with underlocked = True + FaUnderlockTransition_Close -> void $ exercise rightCid FeaturedAppRight_UpdateUnderlock with underlocked = False + FaUnderlockTransition_Enforce -> do + case right.firstUnderlockObservedAt of + None -> fail "FA right is not underlocked" + Some observedAt -> do + require "grace period elapsed" + (observedAt `addRelTime` getFaUnderlockGracePeriod this.config <= now) + void $ exercise rightCid FeaturedAppRight_Withdraw with + reason = "CIP-XXX underlock enforcement" + return DsoRules_UpdateFeaturedAppUnderlockResult -- Validator onboarding ----------------------- @@ -1868,6 +1918,7 @@ executeActionRequiringConfirmation dso dsoRulesCid amuletRulesCid act = case act SRARC_GrantFeaturedAppRight choiceArg -> void $ exercise dsoRulesCid choiceArg SRARC_RevokeFeaturedAppRight choiceArg -> void $ exercise dsoRulesCid choiceArg SRARC_UpdateFeaturedAppRight choiceArg -> void $ exercise dsoRulesCid choiceArg + SRARC_UpdateFeaturedAppUnderlock choiceArg -> void $ exercise dsoRulesCid choiceArg SRARC_SetConfig choiceArg -> void $ exercise dsoRulesCid choiceArg SRARC_UpdateSvRewardWeight choiceArg -> void $ exercise dsoRulesCid choiceArg SRARC_CreateExternalPartyAmuletRules choiceArg -> void $ exercise dsoRulesCid choiceArg @@ -2109,6 +2160,9 @@ instance Patchable DsoRulesConfig where nextScheduledSynchronizerUpgrade = patch new.nextScheduledSynchronizerUpgrade base.nextScheduledSynchronizerUpgrade current.nextScheduledSynchronizerUpgrade nextScheduledLogicalSynchronizerUpgrade = patch new.nextScheduledLogicalSynchronizerUpgrade base.nextScheduledLogicalSynchronizerUpgrade current.nextScheduledLogicalSynchronizerUpgrade voteCooldownTime = patch new.voteCooldownTime base.voteCooldownTime current.voteCooldownTime + faDefaultRequiredLockAmount = patch new.faDefaultRequiredLockAmount base.faDefaultRequiredLockAmount current.faDefaultRequiredLockAmount + faUnderlockGracePeriod = patch new.faUnderlockGracePeriod base.faUnderlockGracePeriod current.faUnderlockGracePeriod + faUnderlockEnforcementEnabled = patch new.faUnderlockEnforcementEnabled base.faUnderlockEnforcementEnabled current.faUnderlockEnforcementEnabled instance Patchable SynchronizerUpgradeSchedule where patch new base current = SynchronizerUpgradeSchedule with diff --git a/daml/splice-util/daml/Splice/Util.daml b/daml/splice-util/daml/Splice/Util.daml index aa9a17a0cd..7952d1050d 100644 --- a/daml/splice-util/daml/Splice/Util.daml +++ b/daml/splice-util/daml/Splice/Util.daml @@ -209,6 +209,9 @@ instance Patchable Time where instance Patchable Party where patch = patchScalar +instance Patchable Bool where + patch = patchScalar + mapDifference : Ord k => Map k a -> Map k a -> Map k k mapDifference = Map.merge (\_ _ -> None) (\k _ -> Some k) (\_ _ _ -> None)