diff --git a/.gitignore b/.gitignore index 2c56be64b4..fae017aaa8 100644 --- a/.gitignore +++ b/.gitignore @@ -22,6 +22,8 @@ _build/ **/metals.sbt **/.scala-build/* +daml/daml-ide-mono/daml/ +daml/daml-ide-mono/.vscode/ .vscode/* !.vscode/settings.json # Make sure test files are checkedin diff --git a/apps/sv/src/main/scala/org/lfdecentralizedtrust/splice/sv/onboarding/sv1/SV1Initializer.scala b/apps/sv/src/main/scala/org/lfdecentralizedtrust/splice/sv/onboarding/sv1/SV1Initializer.scala index 77b46c1545..e5fe32571e 100644 --- a/apps/sv/src/main/scala/org/lfdecentralizedtrust/splice/sv/onboarding/sv1/SV1Initializer.scala +++ b/apps/sv/src/main/scala/org/lfdecentralizedtrust/splice/sv/onboarding/sv1/SV1Initializer.scala @@ -733,6 +733,9 @@ class SV1Initializer( .asJava, sv1Config.isDevNet, java.util.Optional.of(initialRound), + // FIXME: Make configurablze + java.util.Optional.empty(), + java.util.Optional.empty(), ).createAnd.exerciseDsoBootstrap_Bootstrap, ) .withDedup( diff --git a/daml/daml-ide-mono/README.md b/daml/daml-ide-mono/README.md new file mode 100644 index 0000000000..4a24340200 --- /dev/null +++ b/daml/daml-ide-mono/README.md @@ -0,0 +1,15 @@ +# What is this? + +This directory, along with its fake `daml.yaml` can be populated with symlinks by +`./scripts/setup-mono-package.sh` to serve as a fake single-dar package containing all the daml in +Splice such that cross-package changes can be worked on with a tighter feedback loop using the +Daml Language Server (LSP) in VS Code or other editors, e.g. by running `dpm studio` in this directory +after having run the script. + +You'll also have to remember to re-run the script if you add new `.daml` files to any package. + +You should still verify that everything builds/tests for real once you're done of course, but this mode +of interaction can be very useful to eliminate 12-20 second build cycles and instead get immediate +feedback from the VS Code extension when working on tests and making changes that would otherwise be in +their upstream DAR dependencies, for example. + diff --git a/daml/daml-ide-mono/daml.yaml b/daml/daml-ide-mono/daml.yaml new file mode 100644 index 0000000000..e998fdd9a9 --- /dev/null +++ b/daml/daml-ide-mono/daml.yaml @@ -0,0 +1,17 @@ +sdk-version: 3.5.2 +name: splice-mono-ide +source: daml +version: 0.0.1 +dependencies: + - daml-prim + - daml-stdlib + - daml-script +build-options: + - --ghc-option=-Wunused-binds + - --ghc-option=-Wunused-matches + - --target=2.1 + - -Wno-upgrade-exceptions + - -Wno-deprecated-exceptions + - -Wno-template-interface-depends-on-daml-script + - -Wno-upgrade-interfaces + - --force-utility-package=no diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml new file mode 100644 index 0000000000..43fc641f00 --- /dev/null +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -0,0 +1,289 @@ +{-# LANGUAGE ApplicativeDo #-} +module Splice.Scripts.TestAggregateLocks where + +import DA.Assert +import DA.Optional +import DA.Time +import qualified DA.Map as M +import qualified DA.TextMap as TM + +import Daml.Script + +import Splice.AggregateLock +import Splice.Api.Token.AllocationInstructionV2 +import Splice.Api.Token.AllocationV2 +import Splice.Api.Token.AllocationV2 qualified as V2 +import Splice.Api.Token.HoldingV2 qualified as V2 +import Splice.Api.Token.MetadataV1 +import Splice.Scripts.TokenStandard.TestAmuletTokenStandardTestEnv +import Splice.Testing.Registries.AmuletRegistryV2 +import Splice.Testing.Registries.AmuletRegistryV2 qualified as AmuletRegistryV2 +import Splice.Testing.TokenStandard.MultiRegistry qualified as MultiRegistry +import Splice.Testing.TokenStandard.RegistryApiV2 +import Splice.Testing.TokenStandard.WalletClientV2 qualified as WalletClientV2 +import Splice.Testing.Utils +import Splice.TokenStandard.Utils qualified as TSU +import Splice.TokenStandard.Utils.Internal.Conversions (encodeTime) + + +lockForGovernance : TestEnv -> TM.TextMap Decimal -> Metadata -> Party -> Script AllocationInstructionResult +lockForGovernance (TestEnv {..}) amounts meta party = do + WalletClientV2.allocateV2 registries party lockSettlementInfo lockAllocation + where + lockSettlementInfo = V2.SettlementInfo with + executors = [ instrId.admin ] + id = "AggregateLock" + cid = None + meta = emptyMetadata + lockAllocation = V2.AllocationSpecification with + admin = instrId.admin + authorizer = TSU.basicAccount party + transferLegSides = [] + committed = True + nextIterationFunding = Some amounts + settlementDeadline = Some maxComparableTime + meta + +lockForAggregate : TestEnv -> Decimal -> Text -> Party -> Script AllocationInstructionResult +lockForAggregate te amount lockName = lockForGovernance te (TM.fromList [(te.instrId.id, amount)]) $ Metadata $ TM.fromList + [ ("cip-105/type", "aggregateLock") + , ("cip-105/for-benefit-of", lockName) + , ("cip-105/vestingSchedule", "SV") + ] + +-- | Directly create a vesting lock allocation funded with @initialAmount@, +-- bypassing the aggregate-lock unlock path. Used to exercise the vesting +-- withdrawal flow in isolation. +lockForVesting : Decimal -> Time -> TestEnv -> Party -> Script AllocationInstructionResult +lockForVesting initialAmount now te = + lockForGovernance te (TM.fromList [(te.instrId.id, initialAmount)]) $ Metadata $ TM.fromList + [ ("cip-105/type", "vestingLock") + , ("cip-105/vestingLock.startDate", encodeTime now) + , ("cip-105/vestingLock.endDate", encodeTime $ addRelTime now $ days 365 + hours 6) + , ("cip-105/vestingLock.initialAmount", show initialAmount) + ] + +-- | Enrich the wallet-side withdraw context with the external party config +-- state disclosure, which AmuletAllocationV2's settle path reads when the +-- governance-lock withdraw fans out through the settlement factory. +withAggregateWithdrawContext : TestEnv -> MultiRegistry.MultiRegistry -> MultiRegistry.MultiRegistry +withAggregateWithdrawContext env registries = + flip fmap registries $ \reg -> + reg { v2Api = fmap updateApi reg.v2Api } + where + addContext a = do + baseCtxt <- a + extraContext <- getExternalPartyConfigStateContext env.registriesEnv.amuletV2 + pure $ baseCtxt <> extraContext + updateApi api = + api { ggetAllocation_WithdrawContext = \a -> addContext . api.ggetAllocation_WithdrawContext a } + +-- | Verify that locking funds for a "for-benefit-of" name aggregates over +-- separate lock allocations sharing the same name. +testAggregateLockTotals : Script () +testAggregateLockTotals = do + env@TestEnv{..} <- setupTest + let dso = env.instrId.admin + + AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 alice 1200.0 + AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 + + _ <- lockForAggregate env 300.0 "alice-supervalidator" alice + _ <- lockForAggregate env 400.0 "alice-supervalidator" bob + _ <- lockForAggregate env 600.0 "alice-supervalidator" bob + _ <- lockForAggregate env 300.0 "charlie-supervalidator" bob + + allocs <- queryInterface @V2.Allocation dso + let aggregateLocks = + filter (isValidAggregateLockedAllocation dso) $ fromSome . snd <$> allocs + benefitOfAmount alloc = + ( "cip-105/for-benefit-of" `TM.lookup` alloc.allocation.meta.values + , fromOptional 0.0 $ alloc.allocation.nextIterationFunding >>= TM.lookup env.instrId.id + ) + totals = M.fromListWithR (+) $ benefitOfAmount <$> aggregateLocks + + assertEq (Some 1300.0) (Some "alice-supervalidator" `M.lookup` totals) + assertEq (Some 300.0) (Some "charlie-supervalidator" `M.lookup` totals) + +-- | Withdrawing an aggregate-lock allocation moves the locked funds into a +-- fresh vesting-lock destination for the same owner. +testAggregateLockUnlockCreatesVestingLock : Script () +testAggregateLockUnlockCreatesVestingLock = do + env@TestEnv{..} <- setupTest + let dso = env.instrId.admin + newRegistries = withAggregateWithdrawContext env registries + + AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 + + AllocationInstructionResult { output = AllocationInstructionResult_Completed locked } <- + lockForAggregate env 1000.0 "alice-supervalidator" bob + Some lockedView <- queryInterfaceContractId bob locked + + _ <- WalletClientV2.withdrawAllocationV2 newRegistries bob (locked, lockedView) + + liveAllocs <- fmap (fromSome . snd) . filter (isSome . snd) <$> + queryInterface @V2.Allocation bob + length liveAllocs === 1 + + let aggregates = filter (isValidAggregateLockedAllocation dso) liveAllocs + vestings = filter (isValidVestingLockedDestination dso) liveAllocs + + length aggregates === 0 + length vestings === 1 + + let [vesting] = vestings + fromOptional 0.0 (vesting.allocation.nextIterationFunding >>= TM.lookup instrId.id) === 1000.0 + + -- The vesting destination records its start/end dates. + assertMsg "vesting destination must record startDate" $ + TM.member "cip-105/vestingLock.startDate" vesting.allocation.meta.values + assertMsg "vesting destination must record endDate" $ + TM.member "cip-105/vestingLock.endDate" vesting.allocation.meta.values + +-- | Partially withdrawing an aggregate-lock allocation moves only that amount +-- of the locked funds into a fresh vesting-lock destination for the same owner. +testAggregateLockPartialWithdraw : Script () +testAggregateLockPartialWithdraw = do + env@TestEnv{..} <- setupTest + let dso = env.instrId.admin + newRegistries = withAggregateWithdrawContext env registries + + AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 + + AllocationInstructionResult { output = AllocationInstructionResult_Completed locked } <- + lockForAggregate env 1000.0 "alice-supervalidator" bob + Some lockedView <- queryInterfaceContractId bob locked + + _ <- WalletClientV2.withdrawAllocationV2Meta newRegistries bob (locked, lockedView) $ Metadata $ TM.singleton "cip-105/withdraw-amount" "500.0" + + liveAllocs <- fmap (fromSome . snd) . filter (isSome . snd) <$> + queryInterface @V2.Allocation bob + length liveAllocs === 2 + + let aggregates = filter (isValidAggregateLockedAllocation dso) liveAllocs + vestings = filter (isValidVestingLockedDestination dso) liveAllocs + + length aggregates === 1 + length vestings === 1 + + let [aggregate] = aggregates + [vesting] = vestings + fromOptional 0.0 (aggregate.allocation.nextIterationFunding >>= TM.lookup instrId.id) === 500.0 + fromOptional 0.0 (vesting.allocation.nextIterationFunding >>= TM.lookup instrId.id) === 500.0 + + -- Metadata carried over correctly: same owner and DSO on both sides. + aggregate.allocation.authorizer === vesting.allocation.authorizer + aggregate.allocation.admin === vesting.allocation.admin + + -- The vesting destination records its start/end dates. + assertMsg "vesting destination must record startDate" $ + TM.member "cip-105/vestingLock.startDate" vesting.allocation.meta.values + assertMsg "vesting destination must record endDate" $ + TM.member "cip-105/vestingLock.endDate" vesting.allocation.meta.values + +-- | Withdrawing from a vesting-lock allocation vests funds linearly over the +-- lock's start/end period. This exercises the flow against a vesting lock +-- created directly by 'lockForVesting'; the round-trip through +-- 'aggregateLockUnlock' + 'vestingLockWithdraw' isn't tested here because +-- 'aggregateLockUnlock' doesn't (yet) populate the destination's +-- @cip-105/vestingLock.initialAmount@ metadata. +testVestingLockWithdraw : Script () +testVestingLockWithdraw = do + env@TestEnv{..} <- setupTest + let newRegistries = withAggregateWithdrawContext env registries + initialAmount = 365.25 -- one unit per day of the 365 day + 6 hour vesting period + + AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 + + vestStart <- getTime + AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingLockCid } <- + lockForVesting initialAmount vestStart env bob + Some vestingLockView <- queryInterfaceContractId bob vestingLockCid + + -- Withdrawing immediately fails: nothing has vested yet. + vestingLockView.allocation.admin `submitMustFailWithdraw` (vestingLockCid, vestingLockView) $ newRegistries + + -- After some time passes a proportional amount can be withdrawn. + passTime (days 10) + vestingResult1 <- WalletClientV2.extractAllocationResult <$> + WalletClientV2.withdrawAllocationV2 newRegistries bob (vestingLockCid, vestingLockView) + + let holdingCids1 = fromSome $ TM.lookup instrId.id vestingResult1.authorizerHoldingCids + amount1 <- unlockedAmountOf bob holdingCids1 + amount1 === 10.0000000105 + + -- The vesting-lock is settled iteratively, so a new allocation contract + -- carries the remaining vesting balance. + case vestingResult1.output of + AllocationResult_Settled { nextIterationAllocationCid = Some nextCid } -> do + -- After the full period has elapsed the remainder becomes withdrawable. + passTime (days 365) + Some nextView <- queryInterfaceContractId bob nextCid + vestingResult2 <- WalletClientV2.extractAllocationResult <$> + WalletClientV2.withdrawAllocationV2 newRegistries bob (nextCid, nextView) + + let holdingCids2 = fromSome $ TM.lookup instrId.id vestingResult2.authorizerHoldingCids + amount2 <- unlockedAmountOf bob holdingCids2 + amount1 + amount2 === initialAmount + other -> + fail $ "expected AllocationResult_Settled with a next-iteration allocation, got: " <> show other + +testVestingLockTotalWithdraw : Script () +testVestingLockTotalWithdraw = do + env@TestEnv{..} <- setupTest + let newRegistries = withAggregateWithdrawContext env registries + initialAmount = 365.25 -- one unit per day of the 365 day + 6 hour vesting period + + AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 + + vestStart <- getTime + AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingLockCid } <- + lockForVesting initialAmount vestStart env bob + Some vestingLockView <- queryInterfaceContractId bob vestingLockCid + + -- Withdrawing immediately fails: nothing has vested yet. + vestingLockView.allocation.admin `submitMustFailWithdraw` (vestingLockCid, vestingLockView) $ newRegistries + + -- After some time passes a proportional amount can be withdrawn. + passTime (days 366) + vestingResult1 <- WalletClientV2.extractAllocationResult <$> + WalletClientV2.withdrawAllocationV2 newRegistries bob (vestingLockCid, vestingLockView) + + let holdingCids1 = fromSome $ TM.lookup instrId.id vestingResult1.authorizerHoldingCids + amount1 <- unlockedAmountOf bob holdingCids1 + amount1 === 365.25 + + liveAllocs <- fmap (fromSome . snd) . filter (isSome . snd) <$> + queryInterface @V2.Allocation bob + length liveAllocs === 0 + +-- | Attempt an @Allocation_Withdraw@ that should fail; asserts the submit +-- fails and does not leak the underlying error. +submitMustFailWithdraw + : Party -- ^ admin party (needed to read the enriched choice context) + -> (ContractId V2.Allocation, V2.AllocationView) + -> MultiRegistry.MultiRegistry + -> Script () +submitMustFailWithdraw admin (allocCid, _allocView) registries = do + registry <- MultiRegistry.getRegistryApiV2 registries admin + context <- getAllocation_WithdrawContext registry allocCid emptyMetadata + Some owner <- pure =<< + fmap ((.allocation.authorizer.owner) . fromSome) (queryInterfaceContractId admin allocCid) + submitMustFail (actAs owner <> discloseMany' context.disclosures) $ + exerciseCmd allocCid V2.Allocation_Withdraw with + actors = [owner] + extraArgs = ExtraArgs with + context = context.choiceContext + meta = emptyMetadata + +-- | Sum the amounts of the given (unlocked) holding contracts owned by @p@. +unlockedAmountOf : Party -> [ContractId V2.Holding] -> Script Decimal +unlockedAmountOf p wantedCids = do + holdings <- queryInterface @V2.Holding p + let matching = + [ h + | (cid, Some h) <- holdings + , cid `elem` wantedCids + , isNone h.lock + ] + pure $ sum (fmap (.amount) matching) diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml new file mode 100644 index 0000000000..b6bf85fd49 --- /dev/null +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -0,0 +1,290 @@ +module Splice.AggregateLock where + +import Splice.Amulet.TokenApiUtils +import Splice.Api.Token.AllocationV2 as V2 +import qualified Splice.Api.Token.AllocationInstructionV2 as V2 +import Splice.Api.Token.MetadataV1 +import Splice.Types (ForDso(..)) +import Splice.TokenStandard.Utils (fromAnyContractId, maxTime) +import Splice.TokenStandard.Utils.Internal.Allocations (settlementFactoryV2_settleBatchDefaultImplNoSelf) +import Splice.TokenStandard.Utils.Internal.Conversions (decodeTime, encodeTime) +import Splice.Util + +import DA.Either +import DA.Optional +import DA.Text +import DA.List +import qualified DA.TextMap as TM +import DA.Time + +maxComparableTime : Time +maxComparableTime = addRelTime maxTime $ microseconds (-1) + +isValidAggregateLockedAllocation : Party -> V2.AllocationView -> Bool +isValidAggregateLockedAllocation dso alloc = + and [ alloc.allocation.admin == dso + , alloc.settlement.executors == [dso] + , alloc.allocation.committed + , null alloc.allocation.transferLegSides + , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "aggregateLock" + , alloc.expiresAt == Some maxComparableTime + ] + +isValidVestingLockedDestination : Party -> V2.AllocationView -> Bool +isValidVestingLockedDestination dso alloc = + and [ alloc.allocation.admin == dso + , alloc.settlement.executors == [dso] + , alloc.allocation.committed + , null alloc.allocation.transferLegSides + , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "vestingLock" + , alloc.expiresAt == Some maxComparableTime + , TM.member "cip-105/vestingLock.startDate" metaValues + , TM.member "cip-105/vestingLock.endDate" metaValues + ] + where metaValues = alloc.allocation.meta.values + +type ControllerSets = [[Party]] + +partiesFromText : Text -> Optional [Party] +partiesFromText = eitherToOptional . parseCommaSeparated "Parties" partyFromText + +controllerSetFromMeta : Text -> Optional ControllerSets +controllerSetFromMeta = mapA partiesFromText . splitOn ";" + +data GovernanceLockedControllers = GovernanceLockedControllers with + unlockControllerSets : ControllerSets + substituteControllerSets : ControllerSets + withdrawControllerSets : ControllerSets + +governanceLockedControllersFromMeta : Metadata -> Party -> GovernanceLockedControllers +governanceLockedControllersFromMeta meta acctParty = GovernanceLockedControllers with + unlockControllerSets = controllerSetFromMetaMap "cip-105/unlockControllerSets" + substituteControllerSets = controllerSetFromMetaMap "cip-105/substituteControllerSets" + withdrawControllerSets = controllerSetFromMetaMap "cip-105/withdrawControllerSets" + where + controllerSetFromMetaMap key = fromOptional [[acctParty]] $ controllerSetFromMeta =<< key `TM.lookup` meta.values + +checkControllerSet : [Party] -> ControllerSets -> Update () +checkControllerSet parties set = + require "Controllers must be one of the listed options" $ any (\conj -> all (`elem` parties) conj && all (`elem` conj) parties) set + +governanceLockedWithdrawImpl + : HasToInterface a V2.Allocation + => (a -> Time -> Metadata -> Update (ContractId V2.Allocation)) + -> a + -> ContractId a + -> V2.Allocation_Withdraw + -> Update V2.AllocationResult +governanceLockedWithdrawImpl newEmptyAllocation a acid arg@(V2.Allocation_Withdraw{..}) = + case TM.lookup "cip-105/type" allocView.allocation.meta.values of + Some "aggregateLock" -> do + aggregateLockUnlock newEmptyAllocation a acid arg + Some "vestingLock" -> + vestingLockWithdraw a acid arg + _ -> assertFail "Invalid cip-105/type field." + where + allocView = view $ toInterface @V2.Allocation a + +data VestingSchedule + = VestingSchedule_SV + | VestingSchedule_Immediate + deriving (Show, Eq, Ord) + +validateVestingSchedule : VestingSchedule -> Time -> Metadata -> Bool +validateVestingSchedule VestingSchedule_SV now meta = + let + start = decodeTime $ fromSomeNote "start must exist" (TM.lookup "cip-105/vestingLock.startDate" meta.values) + end = decodeTime $ fromSomeNote "end must exist" (TM.lookup "cip-105/vestingLock.endDate" meta.values) + in + -- CIP-0105 states the SV vesting period be 365.25 days + now <= start && end `subTime` start == days 365 + hours 6 +validateVestingSchedule VestingSchedule_Immediate _ _ = True + +-- TODO: Potentially make return type, it's own data type? +calculateAvailableWithdrawAmount : Time -> V2.AllocationView -> Decimal -> (Decimal, Decimal) +calculateAvailableWithdrawAmount currentDateTime alloc nextIterationFundAmount = max (0.0, 0.0) availAmount + where + availAmount = if currentDateTime >= endDate + then (nextIterationFundAmount, 0.0) + else (availableWithdrawAmount, remainingVestingAmount) + availableWithdrawAmount = (initialAmount * totalVestedRatioElapsed) - withdrawnAmount + remainingVestingAmount = nextIterationFundAmount - availableWithdrawAmount + meta = alloc.allocation.meta.values + -- The initial amount represents the total that was locked initially when thrown into vesting state + initialAmount : Decimal = fromSome . parseDecimal . fromSome $ TM.lookup "cip-105/vestingLock.initialAmount" meta + startDate : Time = decodeTime . fromSome $ TM.lookup "cip-105/vestingLock.startDate" meta + endDate : Time = decodeTime . fromSome $ TM.lookup "cip-105/vestingLock.endDate" meta + totalUnlockPeriod : Decimal = intToDecimal . convertRelTimeToMicroseconds $ subTime endDate startDate + unlockPeriodElapsed : Decimal = intToDecimal . convertRelTimeToMicroseconds $ subTime currentDateTime startDate + totalVestedRatioElapsed : Decimal = unlockPeriodElapsed / totalUnlockPeriod + withdrawnAmount = initialAmount - nextIterationFundAmount + + +aggregateLockUnlock : (HasToInterface a V2.Allocation) => (a -> Time -> Metadata -> Update (ContractId V2.Allocation)) -> a -> ContractId a -> Allocation_Withdraw -> Update V2.AllocationResult +aggregateLockUnlock newEmptyAllocation a aCid arg = do + let alloc = view $ toInterface @V2.Allocation a + allocCid = toInterfaceContractId @V2.Allocation aCid + + (instrumentId, currentLockedAmount) <- case TM.toList <$> alloc.allocation.nextIterationFunding of + Some [a] -> pure a + _ -> assertFail "The requirement 'Must reserve a single amount of a single token' was not met" + + vestingSchedule <- decodeVestingSchedule arg.extraArgs.meta alloc.allocation.meta + + let dso = alloc.allocation.admin + + ownerParty <- whenNone alloc.allocation.authorizer.owner $ -- Mostly to safely get ownerParty + assertFail "The requirement 'governance locked allocations must be owned by basic accounts' was not met" + + let GovernanceLockedControllers{..} = governanceLockedControllersFromMeta alloc.meta ownerParty + checkControllerSet arg.actors unlockControllerSets + + require "Must be a valid governance-locked allocation" $ isValidAggregateLockedAllocation dso alloc + + now <- getTime + let endTime = getEndTimeFromVestingSchedule vestingSchedule now + transferLegId = "unlock" + + let alternateAmount = TM.lookup "cip-105/withdraw-amount" arg.extraArgs.meta.values >>= parseDecimal + amount = fromOptional currentLockedAmount alternateAmount + newLockedAmount = currentLockedAmount - amount + newLockedNextIterationFunding + | newLockedAmount == 0.0 = None + | otherwise = Some $ TM.singleton instrumentId newLockedAmount + + -- Not easy to call directly into amulet_allocationFactoryV2_allocateImpl or the like here as that would make a circular dependency. + withdrawTo <- newEmptyAllocation a now $ Metadata $ TM.fromList + [ ("cip-105/type", "vestingLock") + , ("cip-105/vestingLock.startDate", encodeTime $ now) + , ("cip-105/vestingLock.endDate", encodeTime $ endTime) + ] + + settleBatchResult <- settlementFactoryV2_settleBatchDefaultImplNoSelf (\_ _ -> pure arg.extraArgs) dso $ SettlementFactory_SettleBatch with + settlement = alloc.settlement + actors = [ dso ] + extraArgs = arg.extraArgs + transferLegs = + [ TransferLeg with + transferLegId + sender = alloc.allocation.authorizer + receiver = alloc.allocation.authorizer + amount + instrumentId + meta = emptyMetadata + ] + allocations = + [ FinalizedAllocation with + allocationCid = allocCid + extraTransferLegSides = + [ TransferLegSide with + transferLegId + side = SenderSide + otherside = alloc.allocation.authorizer + amount + instrumentId + meta = emptyMetadata + ] + nextIterationFunding = newLockedNextIterationFunding + , FinalizedAllocation with + allocationCid = withdrawTo + extraTransferLegSides = + [ TransferLegSide with + transferLegId + side = ReceiverSide + otherside = alloc.allocation.authorizer + amount + instrumentId + meta = emptyMetadata + ] + nextIterationFunding = Some $ TM.singleton instrumentId amount + ] + pure $ head settleBatchResult.allocationSettleResults + where + getEndTimeFromVestingSchedule VestingSchedule_SV now = addRelTime now $ days 365 + hours 6 + getEndTimeFromVestingSchedule VestingSchedule_Immediate now = now + +vestingLockWithdraw : (HasToInterface a V2.Allocation) => a -> ContractId a -> Allocation_Withdraw -> Update V2.AllocationResult +vestingLockWithdraw a aCid arg = do + let vestingLock = view $ toInterface @V2.Allocation a + vestingLockCid = toInterfaceContractId @V2.Allocation aCid + now <- getTime + + require "Must be a valid vesting unlock allocation" $ isValidVestingLockedDestination vestingLock.allocation.admin vestingLock + require "There must be an initialAmount set for the vestingLock" + $ TM.member "cip-105/vestingLock.initialAmount" vestingLock.allocation.meta.values + + ownerParty <- whenNone vestingLock.allocation.authorizer.owner $ -- Mostly to safely get ownerParty + assertFail "The requirement 'governance locked allocations must be owned by basic accounts' was not met" + let GovernanceLockedControllers{..} = governanceLockedControllersFromMeta vestingLock.meta ownerParty + + checkControllerSet arg.actors withdrawControllerSets + + (instrumentId, nextIterationFunding) <- case TM.toList <$> vestingLock.allocation.nextIterationFunding of + Some [a] -> pure a + _ -> assertFail "The requirement 'Must reserve a single amount of a single token' was not met" + require "There must be an initialAmount set for the vestingLock" + $ TM.member "cip-105/vestingLock.initialAmount" vestingLock.allocation.meta.values + + let (availableWithdrawAmount, remainingVestingAmount) : (Decimal, Decimal) = + calculateAvailableWithdrawAmount now vestingLock nextIterationFunding + + require ("Current eligible withdraw amount for vesting lock is not greater than 0.0. " + <> "currentEligibleWithdrawableAmount came back = '" + <> show availableWithdrawAmount + <> "'." + ) + $ availableWithdrawAmount > 0.0 + + let + transferLegId = "withdraw" + nextIterationFunding + | remainingVestingAmount <= 0.0 = None + | otherwise = Some $ TM.singleton instrumentId remainingVestingAmount + + settleResult <- settlementFactoryV2_settleBatchDefaultImplNoSelf (\_ _ -> pure arg.extraArgs) vestingLock.allocation.admin $ SettlementFactory_SettleBatch with + settlement = vestingLock.settlement + actors = [ vestingLock.allocation.admin ] + extraArgs = ExtraArgs emptyChoiceContext emptyMetadata + transferLegs = + [ TransferLeg with + transferLegId + sender = vestingLock.allocation.authorizer + receiver = vestingLock.allocation.authorizer + amount = availableWithdrawAmount + instrumentId + meta = emptyMetadata + ] + allocations = + [ FinalizedAllocation with + allocationCid = vestingLockCid + extraTransferLegSides = + [ TransferLegSide with + transferLegId + side = SenderSide + otherside = vestingLock.allocation.authorizer + amount = availableWithdrawAmount + instrumentId + meta = emptyMetadata + , TransferLegSide with + transferLegId + side = ReceiverSide + otherside = vestingLock.allocation.authorizer + amount = availableWithdrawAmount + instrumentId + meta = emptyMetadata + ] + nextIterationFunding + ] + + -- We should have one result from settleBatch + case settleResult.allocationSettleResults of + [allocationResult] -> pure allocationResult + _ -> abort "VestingUnlock_Withdraw should result in one allocation result. " + +-- Takes the choice metadata as well to enable override to allow quick unlock +decodeVestingSchedule : Metadata -> Metadata -> Update VestingSchedule +decodeVestingSchedule _withdrawMeta lockMeta = do + case TM.lookup "cip-105/vestingSchedule" lockMeta.values of + Some "SV" -> pure VestingSchedule_SV + _ -> assertFail "Must have a valid vesting schedule" + diff --git a/daml/splice-amulet/daml/Splice/Amulet.daml b/daml/splice-amulet/daml/Splice/Amulet.daml index 2473529d5b..f8f086ee40 100644 --- a/daml/splice-amulet/daml/Splice/Amulet.daml +++ b/daml/splice-amulet/daml/Splice/Amulet.daml @@ -618,6 +618,15 @@ template UnclaimedActivityRecord pure UnclaimedActivityRecord_DsoExpireResult with unclaimedRewardCid +template SvRewardMintReceipt with + dso : Party + amount : Decimal + beneficiary : Party + where + signatory dso + + + -- Support code --------------- diff --git a/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml b/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml index 469ede68f2..aefff68139 100644 --- a/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml +++ b/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml @@ -23,6 +23,7 @@ import Splice.Api.Token.HoldingV2 qualified as V2 import Splice.Api.Token.AllocationV2 qualified as V2 import Splice.TokenStandard.Utils hiding (require) +import Splice.AggregateLock import Splice.Amulet import Splice.AmuletConfig (TransferConfigV2, getTokenStandardMaxTTL) import Splice.AmuletRules @@ -76,6 +77,8 @@ template AmuletAllocationV2 allocation_cancelExtraObservers _arg = observer this allocation_withdrawExtraObservers _arg = observer this + allocation_withdrawImpl self arg | isGovernanceLocked this = + governanceLockedWithdrawImpl emptyCloneWithMeta this (fromInterfaceContractId self) arg allocation_withdrawImpl self arg@(V2.Allocation_Withdraw{..}) = do archiveAndCheckActors self arg.actors [[accountPrincipal allocation.admin allocation.authorizer]] ensureWithdrawIsAllowed allocation @@ -230,12 +233,23 @@ computeAllocationExpiryInternal transferConfig oldExpiresAt settlementDeadline = | maxTime `subTime` oldExpiresAt <= maxTTL = maxTime | otherwise = oldExpiresAt `addRelTime` maxTTL +-- FIXME: the exception to allow Some maxTime is for infinite-duration governance locks, and should probably be limited more explicitly to only those cases. computeAllocationExpiry : TransferConfigV2 Amulet -> Time -> Optional Time -> Update Time -computeAllocationExpiry transferConfig oldExpiresAt settlementDeadline = do - let expiresAt = computeAllocationExpiryInternal transferConfig oldExpiresAt settlementDeadline - assertWithinDeadline "allocation.expiresAt" expiresAt - pure expiresAt +computeAllocationExpiry transferConfig oldExpiresAt settlementDeadline + | settlementDeadline == Some maxComparableTime = pure maxComparableTime + | otherwise = do + let expiresAt = computeAllocationExpiryInternal transferConfig oldExpiresAt settlementDeadline + assertWithinDeadline "allocation.expiresAt" expiresAt + pure expiresAt +isGovernanceLocked alloc = TextMap.member "cip-105/type" alloc.allocation.meta.values + +emptyCloneWithMeta : AmuletAllocationV2 -> Time -> Metadata -> Update (ContractId V2.Allocation) +emptyCloneWithMeta src now meta = toInterfaceContractId <$> create src with + lockedAmulet = None + createdAt = now + allocation = src.allocation with + meta -- instances ------------ diff --git a/daml/splice-amulet/daml/Splice/AmuletRules.daml b/daml/splice-amulet/daml/Splice/AmuletRules.daml index f1292fa96f..9d24baf3be 100644 --- a/daml/splice-amulet/daml/Splice/AmuletRules.daml +++ b/daml/splice-amulet/daml/Splice/AmuletRules.daml @@ -1138,6 +1138,15 @@ executeTransfer' config csum dso t = do isum <- summarizeAndConsumeInputs csum dso t.sender t.inputs osum <- preprocessOutputs csum.config t.outputs summary <- summarizeTransfer t.sender csum.openRoundNumber csum.amuletPrice csum.config isum osum + + case isum.mintedRewardMap of + None -> pure () + Some m -> forA_ (Map.toList m) $ \(beneficiary, amount) -> + create SvRewardMintReceipt with + dso + amount + beneficiary + -- check that overall transfer constraints are satisfied case checkTransferConstraints t summary csum.config of Left failureStatus -> failWithStatus failureStatus @@ -1245,6 +1254,9 @@ data TransferInputsSummary = TransferInputsSummary with totalDevelopmentFundAmount : Optional Decimal -- ^ Note: Same rationale as above — made optional to ensure compatibility with -- the upgrade checker on package upload because `TransferInputsSummary` is serializable. + mintedRewardMap : Optional (Map Party Decimal) + -- ^ Note: This is a map from the beneficiaries of unclaimed activity records, and reward coupons to + -- the amounts minted for them, used to produce receipts. deriving (Eq, Show) type TransferOutputsSummary = [PreprocessedTransferOutput] @@ -1351,6 +1363,11 @@ summarizeAndConsumeInputs csum dso sender inps = do changeToHoldingFeesRate = 0.0 totalUnclaimedActivityRecordAmount = Some 0.0 totalDevelopmentFundAmount = Some 0.0 + mintedRewardMap = Some Map.empty + + addMintedReward : Party -> Decimal -> Optional (Map Party Decimal) -> Optional (Map Party Decimal) + addMintedReward beneficiary amount None = Some $ Map.singleton beneficiary amount + addMintedReward beneficiary amount (Some m) = Some $ Map.insertWith (+) beneficiary amount m summarizeAndConsumeInput _round s (InputAmulet amuletCid) = do amulet <- fetchAndArchive forOwner amuletCid @@ -1368,6 +1385,7 @@ summarizeAndConsumeInputs csum dso sender inps = do amountArchivedAsOfRoundZero = s.amountArchivedAsOfRoundZero + getValueAsOfRound0 amulet.amount changeToHoldingFeesRate = s.changeToHoldingFeesRate - amulet.amount.ratePerRound.rate totalDevelopmentFundAmount = s.totalDevelopmentFundAmount + mintedRewardMap = s.mintedRewardMap summarizeAndConsumeInput _round s (InputAppRewardCoupon couponCid) = do coupon <- fetchAndArchive forOwner couponCid @@ -1387,6 +1405,7 @@ summarizeAndConsumeInputs csum dso sender inps = do amountArchivedAsOfRoundZero = s.amountArchivedAsOfRoundZero changeToHoldingFeesRate = s.changeToHoldingFeesRate totalDevelopmentFundAmount = s.totalDevelopmentFundAmount + mintedRewardMap = s.mintedRewardMap summarizeAndConsumeInput _round s (InputValidatorRewardCoupon couponCid) = do -- we must and do use the validator right to archive the coupon of the user @@ -1409,6 +1428,7 @@ summarizeAndConsumeInputs csum dso sender inps = do amountArchivedAsOfRoundZero = s.amountArchivedAsOfRoundZero changeToHoldingFeesRate = s.changeToHoldingFeesRate totalDevelopmentFundAmount = s.totalDevelopmentFundAmount + mintedRewardMap = s.mintedRewardMap summarizeAndConsumeInput _round s (InputSvRewardCoupon couponCid) = do -- we use the SvRewardCoupon_ArchiveAsBeneficiary choice to signal the archival of the coupon @@ -1417,17 +1437,20 @@ summarizeAndConsumeInputs csum dso sender inps = do exercise couponCid SvRewardCoupon_ArchiveAsBeneficiary -- compute balance change miningRound <- getIssuingMiningRound csum coupon.round + let currentSvRewardCouponAmount = intToDecimal coupon.weight * miningRound.issuancePerSvRewardCoupon + return TransferInputsSummary with totalAmuletAmount = s.totalAmuletAmount totalAppRewardAmount = s.totalAppRewardAmount totalValidatorRewardAmount = s.totalValidatorRewardAmount totalUnclaimedActivityRecordAmount = s.totalUnclaimedActivityRecordAmount totalValidatorFaucetAmount = s.totalValidatorFaucetAmount - totalSvRewardAmount = s.totalSvRewardAmount + intToDecimal coupon.weight * miningRound.issuancePerSvRewardCoupon + totalSvRewardAmount = s.totalSvRewardAmount + currentSvRewardCouponAmount totalHoldingFees = s.totalHoldingFees amountArchivedAsOfRoundZero = s.amountArchivedAsOfRoundZero changeToHoldingFeesRate = s.changeToHoldingFeesRate totalDevelopmentFundAmount = s.totalDevelopmentFundAmount + mintedRewardMap = addMintedReward coupon.beneficiary currentSvRewardCouponAmount s.mintedRewardMap summarizeAndConsumeInput _round s (InputValidatorLivenessActivityRecord recordCid) = do record <- fetchAndArchive forOwner recordCid @@ -1445,6 +1468,7 @@ summarizeAndConsumeInputs csum dso sender inps = do amountArchivedAsOfRoundZero = s.amountArchivedAsOfRoundZero changeToHoldingFeesRate = s.changeToHoldingFeesRate totalDevelopmentFundAmount = s.totalDevelopmentFundAmount + mintedRewardMap = s.mintedRewardMap summarizeAndConsumeInput _round s (ExtTransferInput _dummyUnitField optInputValidatorFaucetCoupon) = do optional (pure s) (summarizeAndConsumeValidatorFaucetInput s) optInputValidatorFaucetCoupon @@ -1464,6 +1488,7 @@ summarizeAndConsumeInputs csum dso sender inps = do amountArchivedAsOfRoundZero = s.amountArchivedAsOfRoundZero changeToHoldingFeesRate = s.changeToHoldingFeesRate totalDevelopmentFundAmount = s.totalDevelopmentFundAmount + mintedRewardMap = addMintedReward unclaimedActivityRecord.beneficiary unclaimedActivityRecord.amount s.mintedRewardMap summarizeAndConsumeInput _round s (InputDevelopmentFundCoupon couponCid) = do coupon <- fetchAndArchive forOwner couponCid @@ -1479,6 +1504,7 @@ summarizeAndConsumeInputs csum dso sender inps = do amountArchivedAsOfRoundZero = s.amountArchivedAsOfRoundZero changeToHoldingFeesRate = s.changeToHoldingFeesRate totalDevelopmentFundAmount = (+ coupon.amount) <$> s.totalDevelopmentFundAmount + mintedRewardMap = s.mintedRewardMap summarizeAndConsumeInput _round s (InputRewardCouponV2 couponCid) = do coupon <- fetchAndArchive forOwner couponCid @@ -1496,6 +1522,7 @@ summarizeAndConsumeInputs csum dso sender inps = do amountArchivedAsOfRoundZero = s.amountArchivedAsOfRoundZero changeToHoldingFeesRate = s.changeToHoldingFeesRate totalDevelopmentFundAmount = s.totalDevelopmentFundAmount + mintedRewardMap = s.mintedRewardMap summarizeAndConsumeValidatorFaucetInput s couponCid = do coupon <- fetchAndArchive forOwner couponCid @@ -1513,6 +1540,7 @@ summarizeAndConsumeInputs csum dso sender inps = do amountArchivedAsOfRoundZero = s.amountArchivedAsOfRoundZero changeToHoldingFeesRate = s.changeToHoldingFeesRate totalDevelopmentFundAmount = s.totalDevelopmentFundAmount + mintedRewardMap = s.mintedRewardMap -- | Deduplicate lock-holders to store them and charge for them at most once dedupOutputLockHolders : TransferOutput -> TransferOutput diff --git a/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestRewardAccountingV2.daml b/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestRewardAccountingV2.daml index 6a384648da..82b7f0dc5c 100644 --- a/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestRewardAccountingV2.daml +++ b/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestRewardAccountingV2.daml @@ -212,4 +212,3 @@ test_ArchiveDryRunRewardAccountingV2 = do -- check that no coupons were created [] <- query @RewardCouponV2 app.dso pure () - diff --git a/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestUtils.daml b/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestUtils.daml index fefc74eef1..2f4a88d639 100644 --- a/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestUtils.daml +++ b/daml/splice-dso-governance-test/daml/Splice/Scripts/DsoTestUtils.daml @@ -12,6 +12,7 @@ import qualified DA.Map as Map import DA.Optional (fromOptional) import qualified DA.Set as Set import qualified DA.Text as T +import qualified DA.TextMap as TextMap import Daml.Script import DA.Time @@ -33,34 +34,38 @@ import Splice.DsoBootstrap import Splice.DSO.AmuletPrice import Splice.DSO.DecentralizedSynchronizer import Splice.DSO.SvState +import Splice.DSO.SvRightOwner import Splice.Scripts.AnsRulesParameters -import Splice.Util -- | Multiplier for the SV weights, which are recorded in basis-points, i.e., 1/10000ths bpsMultiplier : Int bpsMultiplier = 10000 initMainNet : Script (AmuletApp, Party, (Party, Party, Party, Party)) -initMainNet = initDecentralizedSynchronizer False None +initMainNet = initDecentralizedSynchronizer False None True + + +initMainNetNoOnLedgerSvRightOwners : Script (AmuletApp, Party, (Party, Party, Party, Party)) +initMainNetNoOnLedgerSvRightOwners = initDecentralizedSynchronizer False None False initMainNetWithAmuletPrice : Decimal -> Script (AmuletApp, Party, (Party, Party, Party, Party)) -initMainNetWithAmuletPrice amuletPrice = initDecentralizedSynchronizerWithAmuletPrice False 0 amuletPrice None +initMainNetWithAmuletPrice amuletPrice = initDecentralizedSynchronizerWithAmuletPrice False 0 amuletPrice None True initDevNet : Script (AmuletApp, Party, (Party, Party, Party, Party)) -initDevNet = initDecentralizedSynchronizer True None +initDevNet = initDecentralizedSynchronizer True None True initDevNetWithAmuletConfig : AmuletConfig USD -> Script (AmuletApp, Party, (Party, Party, Party, Party)) -initDevNetWithAmuletConfig amuletConfig = initDecentralizedSynchronizer True (Some amuletConfig) +initDevNetWithAmuletConfig amuletConfig = initDecentralizedSynchronizer True (Some amuletConfig) True -initDecentralizedSynchronizer : Bool -> Optional (AmuletConfig USD) -> Script (AmuletApp, Party, (Party, Party, Party, Party)) -initDecentralizedSynchronizer isDevNet optAmuletConfig = initDecentralizedSynchronizerWithAmuletPrice isDevNet 0 1.0 optAmuletConfig +initDecentralizedSynchronizer : Bool -> Optional (AmuletConfig USD) -> Bool -> Script (AmuletApp, Party, (Party, Party, Party, Party)) +initDecentralizedSynchronizer isDevNet optAmuletConfig onLedgerSvRightOwners = initDecentralizedSynchronizerWithAmuletPrice isDevNet 0 1.0 optAmuletConfig onLedgerSvRightOwners -initDecentralizedSynchronizerWithNonZeroRound : Bool -> Int -> Script (AmuletApp, Party, (Party, Party, Party, Party)) -initDecentralizedSynchronizerWithNonZeroRound isDevNet initialRound = initDecentralizedSynchronizerWithAmuletPrice isDevNet initialRound 1.0 None +initDecentralizedSynchronizerWithNonZeroRound : Bool -> Int -> Bool -> Script (AmuletApp, Party, (Party, Party, Party, Party)) +initDecentralizedSynchronizerWithNonZeroRound isDevNet initialRound onLedgerSvRightOwners = initDecentralizedSynchronizerWithAmuletPrice isDevNet initialRound 1.0 None onLedgerSvRightOwners -initDecentralizedSynchronizerWithAmuletPrice : Bool -> Int -> Decimal -> Optional (AmuletConfig USD) -> Script (AmuletApp, Party, (Party, Party, Party, Party)) -initDecentralizedSynchronizerWithAmuletPrice isDevNet initialRound amuletPrice optAmuletConfig = do +initDecentralizedSynchronizerWithAmuletPrice : Bool -> Int -> Decimal -> Optional (AmuletConfig USD) -> Bool -> Script (AmuletApp, Party, (Party, Party, Party, Party)) +initDecentralizedSynchronizerWithAmuletPrice isDevNet initialRound amuletPrice optAmuletConfig onLedgerSvRightOwners = do [sv1, sv2, sv3, sv4] <- forA ["sv1", "sv2", "sv3", "sv4"] allocateParty dso <- allocateParty "dso-party" @@ -129,6 +134,8 @@ initDecentralizedSynchronizerWithAmuletPrice isDevNet initialRound amuletPrice o initialTrafficState = Map.empty isDevNet initialRound = Some initialRound + sv1RightOwnerName = if onLedgerSvRightOwners then Some "sv1" else None + sv1VoteWeight = if onLedgerSvRightOwners then Some 1 else None DsoBootstrap_Bootstrap dsoUserId <- validateUserId "dso-user" @@ -136,32 +143,43 @@ initDecentralizedSynchronizerWithAmuletPrice isDevNet initialRound amuletPrice o -- add more sv nodes forA_ (zip [sv2, sv3, sv4] ["sv2", "sv3", "sv4"]) $ \(svParty, svName) -> do + let rewardWeight = 3 * bpsMultiplier -- Simulate the new nodes being Tier 2 SV nodes [(dsoRulesCid, _)] <- query @DsoRules dso submit (actAs sv1 <> readAs dso) $ exerciseCmd dsoRulesCid $ DsoRules_OnboardValidator with sponsor = sv1 validator = svParty version = Some "0.1.0" contactPoint = Some (svName <> "@example.com") - (_, earliestOpenRound) <- head <$> getOpenRoundsSorted app - submit dso $ exerciseCmd dsoRulesCid $ DsoRules_AddSv with + (earliestOpenRoundCid, earliestOpenRound) <- head <$> getOpenRoundsSorted app + result <- submit dso $ exerciseCmd dsoRulesCid $ DsoRules_AddSv with newSvParty = svParty newSvName = svName - newSvRewardWeight = 3 * bpsMultiplier -- Simulate the new nodes being Tier 2 SV nodes + newSvRewardWeight = if onLedgerSvRightOwners then 0 else rewardWeight newSvParticipantId = svName <> "-participant-id" joinedAsOfRound = earliestOpenRound.round - + when onLedgerSvRightOwners $ do + instructionCid <- submit dso $ exerciseCmd result.newDsoRules $ DsoRules_AddSvRightOwner with + rightOwnerName = svName + info = SvRightOwnerInfo with + rightOwnerParty = svParty + voteWeight = 1 + rewardWeight = rewardWeight + rewardNodeOperatorName = svName + beneficiaries = [] + void $ submit (actAs sv1 <> readAs dso) $ exerciseCmd result.newDsoRules DsoRules_ExecuteAddSvRightOwnerInstruction with + instructionCid + openMiningRoundCid = earliestOpenRoundCid + svOperator = sv1 -- check that the SvStatusReports are present checkSvContractInvariants app pure (app, dso, (sv1, sv2, sv3, sv4)) -getSvInfoByParty : AmuletApp -> Party -> Script SvInfo +getSvInfoByParty : AmuletApp -> Party -> Script (Text, SvInfo) getSvInfoByParty app sv = do [(_, rules)] <- query @DsoRules app.dso - case Map.lookup sv rules.svs of - None -> fail $ "Not a sv: " <> show sv - Some info -> pure info + getSvInfoByOperatorParty sv rules generateUnclaimedReward : AmuletApp -> AmuletUser -> Script () generateUnclaimedReward app provider1 = do @@ -181,13 +199,13 @@ generateUnclaimedReward app provider1 = do dsoDelegateSubmits : AmuletApp -> (ContractId DsoRules -> Commands a) -> Script a dsoDelegateSubmits app mkCommands = do [(dsoRulesCid, dsoRules)] <- query @DsoRules app.dso - let sv = head (Map.keys dsoRules.svs) + let sv = head (operatorParties dsoRules) submit (actAs sv <> readAs app.dso) $ mkCommands dsoRulesCid dsoDelegateSubmitsMustFail : AmuletApp -> (ContractId DsoRules -> Commands a) -> Script () dsoDelegateSubmitsMustFail app mkCommands = do [(dsoRulesCid, dsoRules)] <- query @DsoRules app.dso - let sv = head (Map.keys dsoRules.svs) + let sv = head (operatorParties dsoRules) submitMustFail (actAs sv <> readAs app.dso) $ mkCommands dsoRulesCid svSubmits : AmuletApp -> Party -> (ContractId DsoRules -> Commands a) -> Script a @@ -228,7 +246,7 @@ runNextIssuanceD app amuletPrice appActivityRoundTotal = do svRewardCouponCids = map fst svRewards optValidatorFaucetCouponCids = Some (map fst validatorFaucetCoupons) optValidatorLivenessActivityRecordCids = Some (map fst validatorLivenessActivityRecords) - sv = Some (head (Map.keys dsoRules.svs)) + sv = Some (head (operatorParties dsoRules)) -- the closed round confirmAWC_MiningRound_Archive app @@ -255,7 +273,7 @@ runNextIssuanceD app amuletPrice appActivityRoundTotal = do middleRoundCid = r2Cid latestRoundCid = r3Cid amuletPriceVoteCids - sv = Some (head (Map.keys dsoRules.svs)) + sv = Some (head (operatorParties dsoRules)) let summarizingRoundCid = advanceResult.summarizingRound Some summarizingRound <- queryContractId app.dso summarizingRoundCid @@ -322,7 +340,7 @@ confirmAWC_MiningRound_Archive app = do confirmAndExecutionAction : AmuletApp -> ActionRequiringConfirmation -> Script () confirmAndExecutionAction app action = do [(dsoRulesCid, rules)] <- query @DsoRules app.dso - forA_ (Map.keys rules.svs) $ \sv -> do + forA_ (operatorParties rules) $ \sv -> do -- mallory does not act unless ("mallory" `T.isPrefixOf` partyToText sv) $ do submit (actAs sv <> readAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_ConfirmAction with @@ -335,51 +353,72 @@ executeAllConfirmedActions : AmuletApp -> Script () executeAllConfirmedActions app = do [(amuletRulesCid, _)] <- query @AmuletRules app.dso [(dsoRulesCid, rules)] <- query @DsoRules app.dso - let s = summarizeDso rules -- query all confirmations visible to DSO party confirmations0 <- query @Confirmation app.dso -- execute the actions for which there are enough confirmations let executableConfirmations = filter (const True) -- (\cs -> s.requiredNumConfirmations <= length cs) $ groupEqualOn (\c -> c._2.action) confirmations0 + submitter = head (operatorParties rules) forA_ executableConfirmations $ \cs -> do - submit (actAs s.dsoDelegate <> readAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_ExecuteConfirmedAction with + submit (actAs submitter <> readAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_ExecuteConfirmedAction with action = (head cs)._2.action amuletRulesCid = Some amuletRulesCid confirmationCids = map fst cs - sv = Some s.dsoDelegate + sv = Some submitter executeAllDefinitiveVotes : AmuletApp -> Script () executeAllDefinitiveVotes app = do [(amuletRulesCid, _)] <- query @AmuletRules app.dso [(dsoRulesCid, rules)] <- query @DsoRules app.dso - let s = summarizeDso rules + let submitter = head (operatorParties rules) -- query all voting requests visible to DSO party now <- getTime requests <- query @VoteRequest app.dso forA_ requests $ \(requestCid, request) -> do - let activeSvs = Set.fromList $ map (.name) $ Map.values rules.svs + let activeSvs = if onLedgerSvRightOwners rules then Set.fromList (getSvRightOwners rules) else Set.fromList (map (.name) (Map.values rules.svs)) let execute = request.voteBefore <= now || (activeSvs == Set.fromList (Map.keys request.votes)) + rightOwnerCids <- querySvRightOwners app when execute $ do - void $ submit (actAs s.dsoDelegate <> readAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_CloseVoteRequest with + Some request <- queryContractId app.dso requestCid + void $ submit (actAs submitter <> readAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_CloseVoteRequest with requestCid amuletRulesCid = Some amuletRulesCid - sv = Some s.dsoDelegate + sv = Some submitter + rightOwnerCids = if voteType request.action == RightOwnerVote then rightOwnerCids else None + +lookupRightOwner : AmuletApp -> Party -> Script (Optional (ContractId SvRightOwner)) +lookupRightOwner app rightOwnerParty = do + rightOwners <- queryFilter @SvRightOwner app.dso (\ro -> ro.info.rightOwnerParty == rightOwnerParty) + case rightOwners of + [] -> pure None + [(roCid, _)] -> pure (Some roCid) + _ -> abort "lookupRightOwner: multiple SvRightOwner contracts found for the same party" + +querySvRightOwners : AmuletApp -> Script (Optional (TextMap.TextMap (ContractId SvRightOwner))) +querySvRightOwners app = do + rightOwners <- query @SvRightOwner app.dso + pure $ if null rightOwners + then None + else Some (TextMap.fromList [(ro.rightOwnerName, roCid) | (roCid, ro) <- rightOwners]) initiateAndCastVote : AmuletApp -> [Party] -> Optional Time -> ActionRequiringConfirmation -> Script (ContractId VoteRequest) initiateAndCastVote _ [] _ _ = error "initiateVote: require at least one party" initiateAndCastVote app (initiator::others) targetEffectiveAt action = do [(dsoRulesCid, _)] <- query @DsoRules app.dso + rightOwnerCid <- lookupRightOwner app initiator requestCid <- submit (actAs initiator <> readAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_RequestVote with requester = initiator action reason = Reason with url = ""; body = "let's get it done" targetEffectiveAt voteRequestTimeout = None + rightOwnerCid = if voteType action == RightOwnerVote then rightOwnerCid else None foldlA (castVote dsoRulesCid) requestCid.voteRequest others where castVote dsoRulesCid requestCid sv = do + rightOwnerCid <- lookupRightOwner app sv result <- submit (actAs sv <> readAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_CastVote with requestCid vote = Vote with @@ -387,22 +426,26 @@ initiateAndCastVote app (initiator::others) targetEffectiveAt action = do accept = True reason = Reason with url = ""; body = "✓" optCastAt = None + rightOwnerCid = if voteType action == RightOwnerVote then rightOwnerCid else None return result.voteRequest initiateAndAcceptVote : AmuletApp -> [Party] -> ActionRequiringConfirmation -> Script () initiateAndAcceptVote _ [] _ = error "initiateAndAcceptVote: require at least one party" initiateAndAcceptVote app (initiator::others) action = do [(dsoRulesCid, _)] <- query @DsoRules app.dso + rightOwnerCid <- lookupRightOwner app initiator requestCid <- submit (actAs initiator <> readAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_RequestVote with requester = initiator action reason = Reason with url = ""; body = "let's get it done" targetEffectiveAt = None voteRequestTimeout = None + rightOwnerCid = if voteType action == RightOwnerVote then rightOwnerCid else None foldlA (castVote dsoRulesCid) requestCid.voteRequest others executeAllDefinitiveVotes app where castVote dsoRulesCid requestCid sv = do + rightOwnerCid <- lookupRightOwner app sv result <- submit (actAs sv <> readAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_CastVote with requestCid vote = Vote with @@ -410,13 +453,16 @@ initiateAndAcceptVote app (initiator::others) action = do accept = True reason = Reason with url = ""; body = "✓" optCastAt = None + rightOwnerCid = if voteType action == RightOwnerVote then rightOwnerCid else None return result.voteRequest -- cast a vote on a request castVote : AmuletApp -> Party -> ContractId VoteRequest -> Bool -> Script (ContractId VoteRequest) castVote app sv requestCid vote = do [(dsoRulesCid, _)] <- query @DsoRules app.dso - result <- submit (actAs sv <> actAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_CastVote with + rightOwnerCid <- lookupRightOwner app sv + Some request <- queryContractId app.dso requestCid + result <- submit (actAs sv <> readAs app.dso) $ exerciseCmd dsoRulesCid DsoRules_CastVote with requestCid = requestCid vote = Vote with sv = sv @@ -425,6 +471,7 @@ castVote app sv requestCid vote = do url = "" body = "" optCastAt = None + rightOwnerCid = if voteType request.action == RightOwnerVote then rightOwnerCid else None return result.voteRequest -- | Update all currently desired prices to the target price @@ -447,27 +494,23 @@ checkSvRewardStates : AmuletApp -> Script () checkSvRewardStates app = do rewardStates <- query @SvRewardState app.dso [(_, dsoRules)] <- query @DsoRules app.dso - forA_ (Map.values dsoRules.svs) $ \info -> - require "Each onboarded andSV name has one SvRewardState contract" $ - any (\(_, rewardState) -> rewardState.svName == info.name) rewardStates - forA_ (Map.values dsoRules.offboardedSvs) $ \info -> - require "Each offboarded and SV name has one SvRewardState contract" $ - any (\(_, rewardState) -> rewardState.svName == info.name) rewardStates - let offAndOnboardedSvs = Set.fromList (map (\info -> info.name) (Map.values dsoRules.svs) <> map (\info -> info.name) (Map.values dsoRules.offboardedSvs)) - Set.fromList [state.svName | (_, state) <- rewardStates] === offAndOnboardedSvs - require "No duplicate SvRewardstate contracts" $ - length rewardStates == Set.size offAndOnboardedSvs + if onLedgerSvRightOwners dsoRules then + Set.fromList [state.svName | (_, state) <- rewardStates] === Set.fromList (getSvRightOwners dsoRules) + else + Set.fromList [state.svName | (_, state) <- rewardStates] === Set.fromList (map (.name) (Map.values dsoRules.svs)) + -- | Check that there's exactly one status report per SV both off-boarded and onboarded. checkSvStatusReports : AmuletApp -> Script () checkSvStatusReports app = do [(_, dsoRules)] <- query @DsoRules app.dso - let svParties = Map.keys dsoRules.svs + let svParties = operatorParties dsoRules let offboardedParties = Map.keys dsoRules.offboardedSvs let expectedSvParties = Set.fromList $ svParties ++ offboardedParties reports <- query @SvStatusReport app.dso let reportingParties = Set.fromList $ [ report.sv | (_, report) <- reports ] reportingParties === expectedSvParties + pure () getSvNodeState : AmuletApp -> Party -> Script (ContractId SvNodeState, SvNodeState) getSvNodeState app sv = do diff --git a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestDecentralizedAutomation.daml b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestDecentralizedAutomation.daml index cd33691534..0faec58037 100644 --- a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestDecentralizedAutomation.daml +++ b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestDecentralizedAutomation.daml @@ -176,7 +176,7 @@ testRequiredNumOfConfirmation = do [(amuletRulesCid, _)] <- query @AmuletRules dso [(dsoRulesCid, dsoRules)] <- query @DsoRules dso - Map.size dsoRules.svs === 4 + length (Map.toList dsoRules.svs) === 4 svX <- allocateParty "svX" @@ -185,7 +185,7 @@ testRequiredNumOfConfirmation = do dsoAction = SRARC_AddSv $ DsoRules_AddSv with newSvParty = svX newSvName = "svX" - newSvRewardWeight = 1 + newSvRewardWeight = 0 newSvParticipantId = "svX-participant-id" joinedAsOfRound = (Round 3) @@ -218,7 +218,7 @@ testRequiredNumOfConfirmation = do -- check that the `action` was executed [(_, dsoRules)] <- query @DsoRules dso - require "svX is a sv" (svX `Map.member` dsoRules.svs) + require "svX is a sv" (svX `elem` operatorParties dsoRules) pure () diff --git a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestGovernance.daml b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestGovernance.daml index ca17a103b9..3e453d5f7b 100644 --- a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestGovernance.daml +++ b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestGovernance.daml @@ -55,16 +55,18 @@ testVoteRequestAcceptanceWithoutEffectivity = do reason = Reason with url = ""; body = "they are great!" targetEffectiveAt = None voteRequestTimeout = Some (days 7) -- give everybody 7 days to vote + rightOwnerCid = None let requestCid1 = result.voteRequest - + -- sv2 rejects initially requestCid <- castVote app sv2 requestCid1 False - + -- there are two votes, which is not enough to consider the vote definitive and grant the app right submitMustFail (actAs sv1 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_CloseVoteRequest with requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None -- a day passes and sv2 updates their vote passTime (days 1) @@ -79,6 +81,7 @@ testVoteRequestAcceptanceWithoutEffectivity = do requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None -- sv3 accepts too requestCid <- castVote app sv3 requestCid True @@ -88,6 +91,7 @@ testVoteRequestAcceptanceWithoutEffectivity = do requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None [(rightCid, right)] <- query @FeaturedAppRight provider right === FeaturedAppRight with dso; provider; activityWeight = Some 11.0 @@ -130,6 +134,7 @@ testVoteRequestAcceptanceWithEffectivity = do reason = Reason with url = ""; body = "they are great!" targetEffectiveAt = Some (effectiveTime) -- the right will be granted in 8 days voteRequestTimeout = Some (days 7) -- give everybody 7 days to vote with the possibility to change their vote + rightOwnerCid = None let requestCid1 = result.voteRequest -- sv2 accepts @@ -140,6 +145,7 @@ testVoteRequestAcceptanceWithEffectivity = do requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None -- the voteRequest trackingCid is set to the initial requestCid Some voteRequest <- queryContractId dso requestCid @@ -154,6 +160,7 @@ testVoteRequestAcceptanceWithEffectivity = do requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None -- sv4 rejects requestCid <- castVote app sv4 requestCid False @@ -166,6 +173,7 @@ testVoteRequestAcceptanceWithEffectivity = do requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None -- sv4 can change its vote past the expiration date requestCid <- castVote app sv4 requestCid True @@ -178,6 +186,7 @@ testVoteRequestAcceptanceWithEffectivity = do requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None now <- getTime result.completedAt === now @@ -227,7 +236,7 @@ testVoteRequestAcceptanceWithEffectivity = do testVoteRequestRejectionWithoutEffectivity : Script () testVoteRequestRejectionWithoutEffectivity = do - (_app, dso, (sv1, sv2, _sv3, sv4)) <- initMainNet + (app, dso, (sv1, sv2, _sv3, sv4)) <- initMainNet [(dsoRulesCid, _)] <- query @DsoRules dso @@ -245,14 +254,15 @@ testVoteRequestRejectionWithoutEffectivity = do reason = Reason with url = ""; body = "they are great!" targetEffectiveAt = None voteRequestTimeout = Some (days 7) -- give everybody 7 days to vote + rightOwnerCid = None let requestCid = result.voteRequest -- majority rejects the request - requestCid <- castVote _app sv2 requestCid False - requestCid <- castVote _app sv4 requestCid False + requestCid <- castVote app sv2 requestCid False + requestCid <- castVote app sv4 requestCid False -- sv1 changes their opinion and votes again after the cooldown of 1 minute passTime (minutes 1) - requestCid <- castVote _app sv1 requestCid False + requestCid <- castVote app sv1 requestCid False -- the request is directly rejected now <- getTime @@ -260,6 +270,7 @@ testVoteRequestRejectionWithoutEffectivity = do requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None result.completedAt === now result.offboardedVoters === [] @@ -291,6 +302,7 @@ testVoteRequestRejectionWithEffectivityBeforeExpiration = do reason = Reason with url = ""; body = "they are great!" targetEffectiveAt = Some (effectiveTime) voteRequestTimeout = Some (days 3) -- give everybody 3 days to vote + rightOwnerCid = None let requestCid = result.voteRequest -- majority rejects the request @@ -306,6 +318,7 @@ testVoteRequestRejectionWithEffectivityBeforeExpiration = do requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None result.completedAt === now result.offboardedVoters === [] @@ -337,6 +350,7 @@ testVoteRequestRejectionWithEffectivityAfterExpiration = do reason = Reason with url = ""; body = "they are great!" targetEffectiveAt = Some (addRelTime now (days 1)) voteRequestTimeout = Some (days 2) + rightOwnerCid = None -- sv1 initiates the granting of the featured app right for the provider result <- submit (actAs sv1 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_RequestVote with @@ -348,6 +362,7 @@ testVoteRequestRejectionWithEffectivityAfterExpiration = do reason = Reason with url = ""; body = "they are great!" targetEffectiveAt = Some (effectiveTime) voteRequestTimeout = Some (days 3) -- give everybody 3 days to vote + rightOwnerCid = None let requestCid = result.voteRequest -- a majority accepts the request before the expiration data @@ -359,6 +374,7 @@ testVoteRequestRejectionWithEffectivityAfterExpiration = do requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None -- the expiration date has passed passTime (days 3) @@ -373,6 +389,7 @@ testVoteRequestRejectionWithEffectivityAfterExpiration = do requestCid amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None now <- getTime @@ -387,7 +404,7 @@ testVoteRequestRejectionWithEffectivityAfterExpiration = do testRacingSvRemoval : Script () testRacingSvRemoval = do (app, dso, (sv1, sv2, sv3, sv4)) <- initMainNet - + [(dsoRulesCid, _)] <- query @DsoRules dso -- sv1 is not happy with sv2, and issues two removal requests at the same time! @@ -399,6 +416,7 @@ testRacingSvRemoval = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = None voteRequestTimeout = Some (days 7) -- give everybody 7 days to vote + rightOwnerCid = None result2 <- submit (actAs sv1 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_RequestVote with requester = sv1 @@ -408,6 +426,7 @@ testRacingSvRemoval = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = None voteRequestTimeout = Some (days 7) -- give everybody 7 days to vote + rightOwnerCid = None -- sv2 counters and wants to remove sv1 result3 <- submit (actAs sv2 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_RequestVote with @@ -418,6 +437,7 @@ testRacingSvRemoval = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = None voteRequestTimeout = Some (days 7) -- give everybody 7 days to vote + rightOwnerCid = None -- sv1 is not really happy with sv2, and issues a third removal request with an effective date set in 8 days. now <- getTime @@ -431,6 +451,7 @@ testRacingSvRemoval = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = Some (effectiveTime) voteRequestTimeout = Some (days 2) -- give everybody 2 days to vote + rightOwnerCid = None let (req1, req2, req3, req4) = (result1.voteRequest, result2.voteRequest, result3.voteRequest, result4.voteRequest) @@ -447,6 +468,7 @@ testRacingSvRemoval = do accept = True reason = Reason with url = ""; body = "OK, let them go" optCastAt = None + rightOwnerCid = None result2 <- submit (actAs sv2 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_CastVote with requestCid = result1.voteRequest vote = Vote with @@ -454,6 +476,7 @@ testRacingSvRemoval = do accept = True reason = Reason with url = ""; body = "OK, let them go" optCastAt = None + rightOwnerCid = None result3 <- submit (actAs sv3 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_CastVote with requestCid = result2.voteRequest vote = Vote with @@ -461,6 +484,7 @@ testRacingSvRemoval = do accept = True reason = Reason with url = ""; body = "OK, let them go" optCastAt = None + rightOwnerCid = None result4 <- submit (actAs sv4 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_CastVote with requestCid = result3.voteRequest vote = Vote with @@ -468,6 +492,7 @@ testRacingSvRemoval = do accept = True reason = Reason with url = ""; body = "OK, let them go" optCastAt = None + rightOwnerCid = None pure result4.voteRequest -- sv1 attempts to immediatly accept the request to remove sv2 @@ -476,6 +501,7 @@ testRacingSvRemoval = do requestCid = req1 amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None result.completedAt === now result.offboardedVoters === [] @@ -489,6 +515,7 @@ testRacingSvRemoval = do requestCid = req2 amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None -- sv3 refuses and sv4 accepts request 4 with effectivity 8 days before the expiration. req4 <- castVote app sv3 req4 False @@ -504,6 +531,7 @@ testRacingSvRemoval = do requestCid = req4 amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None now <- getTime result.completedAt === now @@ -517,6 +545,7 @@ testRacingSvRemoval = do requestCid = req3 amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None result.completedAt === now result.offboardedVoters === ["sv2"] @@ -525,9 +554,8 @@ testRacingSvRemoval = do -- There are only two svs left, and sv3 is the new DSO delegate [(_, dsoRules)] <- query @DsoRules dso - Map.keys dsoRules.svs === [sv3, sv4] - dsoRules.dsoDelegate === sv3 - + operatorParties dsoRules === [sv3, sv4] + -- The story continues: sv3 tries to remove sv4 [(dsoRulesCid, _)] <- query @DsoRules dso result4 <- submit (actAs sv3 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_RequestVote with @@ -538,6 +566,7 @@ testRacingSvRemoval = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = None voteRequestTimeout = Some (seconds 1) -- attempt to not give sv4 enough time to vote + rightOwnerCid = None let req4 = result4.voteRequest -- early closing is not possible, as the outcome of the vote is not determined, and we thus leave @@ -546,6 +575,7 @@ testRacingSvRemoval = do requestCid = req4 amuletRulesCid = None sv = Some sv3 + rightOwnerCids = None -- after enough time has passed the closing works passTime (seconds 1) @@ -553,6 +583,7 @@ testRacingSvRemoval = do requestCid = req4 amuletRulesCid = None sv = Some sv3 + rightOwnerCids = None -- however sv4 is still here, as at least `numSvs / 2 + 1` svs need to accept the offboarding result.outcome === VRO_Expired @@ -566,6 +597,7 @@ testRacingSvRemoval = do reason = Reason with url = ""; body = "they want to leave!" targetEffectiveAt = None voteRequestTimeout = Some (days 1) + rightOwnerCid = None castResult <- submit (actAs sv4 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_CastVote with requestCid = result5.voteRequest @@ -574,6 +606,7 @@ testRacingSvRemoval = do accept = True reason = Reason with url = ""; body = "yes, let me go please!" optCastAt = None + rightOwnerCid = None let req5 = castResult.voteRequest -- and actually early closing is possible, as everybody has voted and the outcome is definite @@ -582,12 +615,13 @@ testRacingSvRemoval = do requestCid = req5 amuletRulesCid = None sv = Some sv3 + rightOwnerCids = None result.outcome === VRO_Accepted with effectiveAt = now -- check the SV's are gone [(_, dsoRules)] <- query @DsoRules dso - Map.keys dsoRules.svs === [sv3] + operatorParties dsoRules === [sv3] pure () @@ -650,6 +684,7 @@ testDsoRulesConfigChange = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = None voteRequestTimeout = Some (days 2) + rightOwnerCid = None result2 <- submit (actAs sv1 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_RequestVote with requester = sv1 @@ -660,6 +695,7 @@ testDsoRulesConfigChange = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = None voteRequestTimeout = Some (days 2) + rightOwnerCid = None let (req1, req2) = (result1.voteRequest, result2.voteRequest) @@ -671,6 +707,7 @@ testDsoRulesConfigChange = do requestCid = req1 amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None result.completedAt === now result.offboardedVoters === [] @@ -688,6 +725,7 @@ testDsoRulesConfigChange = do requestCid = req2 amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None result.completedAt === now result.offboardedVoters === [] @@ -704,7 +742,6 @@ testDsoRulesConfigChange = do testAmuletRulesTickDurationChange : Script () testAmuletRulesTickDurationChange = do (app, dso, (sv1, sv2, sv3, _)) <- initMainNet - [(dsoRulesCid, _)] <- query @DsoRules dso [(_, amuletRules)] <- query @AmuletRules dso @@ -723,6 +760,7 @@ testAmuletRulesTickDurationChange = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = None voteRequestTimeout = Some (days 2) + rightOwnerCid = None now <- getTime -- vote on change @@ -734,6 +772,7 @@ testAmuletRulesTickDurationChange = do requestCid = request amuletRulesCid = Some amuletRulesCid sv = Some sv1 + rightOwnerCids = None result.completedAt === now result.offboardedVoters === [] @@ -827,6 +866,7 @@ testAmuletRulesConfigChange = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = None voteRequestTimeout = Some (days 2) + rightOwnerCid = None result2 <- submit (actAs sv1 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_RequestVote with requester = sv1 @@ -837,6 +877,7 @@ testAmuletRulesConfigChange = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = None voteRequestTimeout = Some (days 2) + rightOwnerCid = None let (req1, req2) = (result1.voteRequest, result2.voteRequest) @@ -847,7 +888,7 @@ testAmuletRulesConfigChange = do requestCid = req1 amuletRulesCid = Some amuletRulesCid sv = Some sv1 - + rightOwnerCids = None result.completedAt === now result.offboardedVoters === [] result.abstainingSvs === ["sv4"] @@ -864,6 +905,7 @@ testAmuletRulesConfigChange = do requestCid = req2 amuletRulesCid = Some amuletRulesCid sv = Some sv1 + rightOwnerCids = None result.completedAt === now result.offboardedVoters === [] @@ -892,7 +934,7 @@ testOffboardSvAndAmuletPriceVotes = do -- the voting process is only definitive after the timeout, so right now sv1 is still present [(_, dsoRules)] <- query @DsoRules dso - Map.keys (dsoRules.svs) === [sv1, sv2, sv3, sv4] + operatorParties dsoRules === [sv1, sv2, sv3, sv4] -- pass the default voting timeout passTime (dsoRules.config.voteRequestTimeout) @@ -900,9 +942,8 @@ testOffboardSvAndAmuletPriceVotes = do -- check that the sv was removed and the DSO delegate changed to sv2 [(dsoRulesCid, dsoRules)] <- query @DsoRules dso - Map.keys (dsoRules.svs) === [sv2, sv3, sv4] + operatorParties dsoRules === [sv2, sv3, sv4] Map.keys (dsoRules.offboardedSvs) === [sv1] - dsoRules.dsoDelegate === sv2 -- duplicate the AmuletPriceVote for sv2 to test duplicate removal amuletPriceVotes <- query @AmuletPriceVote dso @@ -934,7 +975,7 @@ testOffboardSvAndAmuletPriceVotes = do -- | vote request contract is archived if it has expired testVoteRequestExpireWithoutEffectivity : Script () testVoteRequestExpireWithoutEffectivity = do - (_, dso, (sv1, _, _, _)) <- initMainNet + (_app, dso, (sv1, _, _, _)) <- initMainNet provider <- allocateParty "provider" [(dsoRulesCid, _)] <- query @DsoRules dso @@ -947,12 +988,14 @@ testVoteRequestExpireWithoutEffectivity = do reason = Reason with url = ""; body = "they are great!" targetEffectiveAt = None voteRequestTimeout = None + rightOwnerCid = None -- attempt to close the vote request before its voting period submitMustFail (actAs sv1 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_CloseVoteRequest with requestCid = requestResult.voteRequest amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None passTime(days 7) now <- getTime @@ -962,6 +1005,7 @@ testVoteRequestExpireWithoutEffectivity = do requestCid = requestResult.voteRequest amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None -- only sv1 voted to accept as they created the request result.completedAt === now @@ -974,7 +1018,7 @@ testVoteRequestExpireWithoutEffectivity = do testVoteRequestExpireWithEffectivity : Script () testVoteRequestExpireWithEffectivity = do - (_, dso, (sv1, _, _, _)) <- initMainNet + (_app, dso, (sv1, _, _, _)) <- initMainNet provider <- allocateParty "provider" now <- getTime @@ -990,12 +1034,14 @@ testVoteRequestExpireWithEffectivity = do reason = Reason with url = ""; body = "they are great!" targetEffectiveAt = Some (effectiveTime) voteRequestTimeout = None + rightOwnerCid = None -- attempt to close the vote request before its voting period submitMustFail (actAs sv1 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_CloseVoteRequest with requestCid = requestResult.voteRequest amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None passTime(days 7) now <- getTime @@ -1005,6 +1051,7 @@ testVoteRequestExpireWithEffectivity = do requestCid = requestResult.voteRequest amuletRulesCid = None sv = Some sv1 + rightOwnerCids = None -- only sv1 voted to accept as they created the request result.completedAt === now @@ -1085,7 +1132,7 @@ testAmuletPriceVoting = do testVoteCastingCooldown : Script () testVoteCastingCooldown = do - (_, dso, (sv1, sv2, _sv3, _sv4)) <- initMainNet + (_app, dso, (sv1, sv2, _sv3, _sv4)) <- initMainNet [(dsoRulesCid, _)] <- query @DsoRules dso @@ -1098,6 +1145,7 @@ testVoteCastingCooldown = do reason = Reason with url = ""; body = "they are not good for us!" targetEffectiveAt = None voteRequestTimeout = Some (days 7) -- give everybody 7 days to vote + rightOwnerCid = None let requestCid = result.voteRequest -- SV2 can immediately cast a vote @@ -1108,6 +1156,7 @@ testVoteCastingCooldown = do accept = False reason = Reason with url = ""; body = "noooo, let me stay on please!" optCastAt = None + rightOwnerCid = None let requestCid = result.voteRequest -- The second vote SV2 fails though @@ -1118,6 +1167,7 @@ testVoteCastingCooldown = do accept = False reason = Reason with url = ""; body = "a better rebuttal" optCastAt = None + rightOwnerCid = None -- And that same holds for SV1, as it voted as part of creating the request. _ <- submitMustFail (actAs sv1 <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_CastVote with @@ -1127,7 +1177,7 @@ testVoteCastingCooldown = do accept = True reason = Reason with url = ""; body = "a better reason" optCastAt = None - + rightOwnerCid = None -- let the vote cooldown pass, so they can update their votes passTime (minutes 1) @@ -1139,6 +1189,7 @@ testVoteCastingCooldown = do accept = False reason = Reason with url = ""; body = "a better rebuttal" optCastAt = None + rightOwnerCid = None let requestCid = result.voteRequest -- And that same holds for SV1, as it voted as part of creating the request. @@ -1149,5 +1200,6 @@ testVoteCastingCooldown = do accept = True reason = Reason with url = ""; body = "a better reason" optCastAt = None + rightOwnerCid = None pure () diff --git a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestGovernanceRefactor.daml b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestGovernanceRefactor.daml new file mode 100644 index 0000000000..6fab3bd264 --- /dev/null +++ b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestGovernanceRefactor.daml @@ -0,0 +1,126 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Splice.Scripts.TestGovernanceRefactor where + +import DA.Action +import DA.Assert +import DA.Foldable hiding (length) +import DA.List (sort) +import Daml.Script +import qualified DA.Map as Map +import qualified DA.TextMap as TextMap + +import Splice.DSO.SvRightOwner +import Splice.Issuance() + + +import Splice.DsoRules +import Splice.Scripts.DsoTestUtils +import Splice.Scripts.Util + + +testGovernanceRefactor : Script () +testGovernanceRefactor = do + (app, _, (sv1, sv2, sv3, sv4)) <- initMainNet + let nonOperatorName1 = "non-operator1" + let nonOperatorName2 = "non-operator2" + rightOwnerParty1 <- allocateParty "non-operator-governance1" + rightOwnerParty2 <- allocateParty "non-operator-governance2" + initiateAndAcceptVote app [sv1, sv2, sv3, sv4] $ ARC_DsoRules $ SRARC_DsoRules_AddSvRightOwner $ DsoRules_AddSvRightOwner nonOperatorName1 SvRightOwnerInfo with + rightOwnerParty = rightOwnerParty1 + voteWeight = 4 + rewardWeight = 1000 + rewardNodeOperatorName = "sv1" + beneficiaries = [] + executeAddSvRightOwnerInstructions sv1 app + [(_, dsoRules)] <- query @DsoRules app.dso + length (getSvRightOwners dsoRules) === 5 + voteRequest <- initiateAndCastVote app [sv1, sv2, sv3, sv4] None $ ARC_DsoRules $ SRARC_DsoRules_AddSvRightOwner $ DsoRules_AddSvRightOwner nonOperatorName2 SvRightOwnerInfo with + rightOwnerParty = rightOwnerParty2 + voteWeight = 1 + rewardWeight = 1000 + rewardNodeOperatorName = "sv1" + beneficiaries = [] + + executeAllDefinitiveVotes app + + -- we have not yet reached the vote weight + Some _ <- queryContractId app.dso voteRequest + + castVote app rightOwnerParty1 voteRequest True + + executeAllDefinitiveVotes app + executeAddSvRightOwnerInstructions sv1 app + -- now we have reached the vote weight + None <- queryContractId app.dso voteRequest + [(_, dsoRules)] <- query @DsoRules app.dso + length (getSvRightOwners dsoRules) === 6 + pure () + +testGovernanceRefactorMigration : Script () +testGovernanceRefactorMigration = do + (app, _, (sv1, sv2, sv3, sv4)) <- initMainNetNoOnLedgerSvRightOwners + [(_, dsoRules)] <- query @DsoRules app.dso + dsoRules.svRightOwners === None + initiateAndAcceptVote app [sv1, sv2, sv3, sv4] $ ARC_DsoRules $ SRARC_DsoRules_MigrateToOnLedgerSvRightOwners DsoRules_MigrateToOnLedgerSvRightOwners with + rightOwners = TextMap.fromList [ + ( "sv1", + SvRightOwnerInfo with + rightOwnerParty = sv1 + voteWeight = 1 + rewardWeight = 100000 + rewardNodeOperatorName = "sv1" + beneficiaries = [] + ), + ( "sv2", + SvRightOwnerInfo with + rightOwnerParty = sv2 + voteWeight = 1 + rewardWeight = 30000 + rewardNodeOperatorName = "sv2" + beneficiaries = [] + ), + ( "sv3", + SvRightOwnerInfo with + rightOwnerParty = sv3 + voteWeight = 1 + rewardWeight = 30000 + rewardNodeOperatorName = "sv3" + beneficiaries = [] + ), + ( "sv4", + SvRightOwnerInfo with + rightOwnerParty = sv4 + voteWeight = 1 + rewardWeight = 10000 + rewardNodeOperatorName = "sv4" + beneficiaries = [] + ), + -- before the migration sv4 had weight 30_000 with 20_000 of this going to a beneficiary. The beneficiary is now represented as a dedicated right owner. + ( "rightOwnerFormerlyOnSv4", + SvRightOwnerInfo with + rightOwnerParty = sv4 + voteWeight = 1 + rewardWeight = 20000 + rewardNodeOperatorName = "sv4" + beneficiaries = [] + ) + ] + executeAllDefinitiveVotes app + [(_, dsoRules)] <- query @DsoRules app.dso + sort (getSvRightOwners dsoRules) === sort ("rightOwnerFormerlyOnSv4" :: map (.name) (Map.values dsoRules.svs)) + length (getSvRightOwners dsoRules) === 5 + pure () + + +executeAddSvRightOwnerInstructions : Party -> AmuletApp -> Script () +executeAddSvRightOwnerInstructions sv1 app = do + instructions <- query @AddSvRightOwnerInstruction app.dso + forA_ instructions $ \(instructionCid, _) -> do + [(dsoRulesCid, _)] <- query @DsoRules app.dso + (earliestOpenRoundCid, _) :: _ <- getOpenRoundsSorted app + void $ submit (actAs sv1 <> readAs app.dso) $ exerciseCmd dsoRulesCid $ DsoRules_ExecuteAddSvRightOwnerInstruction with + instructionCid = instructionCid + openMiningRoundCid = earliestOpenRoundCid + svOperator = sv1 \ No newline at end of file diff --git a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestOnboarding.daml b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestOnboarding.daml index 9f95c56446..b44944889c 100644 --- a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestOnboarding.daml +++ b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestOnboarding.daml @@ -5,7 +5,6 @@ module Splice.Scripts.TestOnboarding where import DA.Assert import DA.Foldable (forA_) -import DA.Optional (fromSome) import qualified DA.Map as Map import Daml.Script import DA.Time @@ -144,7 +143,7 @@ testSvOnboarding = do newSvName = "svX" newParticipantId = "svX-participant-id" reason = "because" - newSvRewardWeight = 19 -- we use 19 as a dummy reward weight for testing + newSvRewardWeight = 0 -- weight is not used for on-ledger sv right owners executeAllConfirmedActions app -- svX is now a confirmed SV @@ -154,7 +153,7 @@ testSvOnboarding = do svName = "svX" svParticipantId = "svX-participant-id" reason = "because" - svRewardWeight = 19 + svRewardWeight = 0 -- weight is not used for on-ledger sv right owners dso expiresAt = svOnboardingConfirmed.expiresAt @@ -323,7 +322,7 @@ testSvOnboardingRequestArchiveWhenSvIsAlreadyAddedAsSV = do submit dso $ exerciseCmd dsoRulesCid $ DsoRules_AddSv with newSvParty = svX newSvName = "svX" - newSvRewardWeight = 19 + newSvRewardWeight = 0 -- weight is not used for on-ledger sv right owners newSvParticipantId = "svX-participant-id" joinedAsOfRound = (Round 3) @@ -352,7 +351,7 @@ testSvOnboardingConfirmedExpiry = do newSvParty = svX newSvName = "svX" newParticipantId = "svX-participant-id" - newSvRewardWeight = 19 + newSvRewardWeight = 0 -- sv weight is not used for on-ledger sv right owners reason = "because" executeAllConfirmedActions app @@ -375,6 +374,10 @@ testSvOnboardingConfirmedExpiry = do [(_, dsoRules)] <- query @DsoRules dso Map.keys (dsoRules.offboardedSvs) === [svX] +lookupSvOperatorParty : Text -> DsoRules -> Optional Party +lookupSvOperatorParty name dsoRules = + fmap fst (find (\(_, info) -> info.name == name) $ Map.toList dsoRules.svs) + testSvNameUniquenessNotInDevNet : Script () testSvNameUniquenessNotInDevNet = do @@ -383,7 +386,7 @@ testSvNameUniquenessNotInDevNet = do [(dsoRulesCid, dsoRules)] <- query @DsoRules dso - (fromSome (Map.lookup sv2 dsoRules.svs)).name === "sv2" + lookupSvOperatorParty "sv2" dsoRules === Some sv2 svX <- allocateParty "svX" submitMustFail dso $ exerciseCmd dsoRulesCid $ DsoRules_AddSv svX "sv2" 19 "sv2-participant-id" (Round 3) @@ -395,12 +398,12 @@ testSvOverwriteInDevNet = do [(dsoRulesCid, dsoRules)] <- query @DsoRules dso - (fromSome (Map.lookup sv1 dsoRules.svs)).name === "sv1" - (fromSome (Map.lookup sv2 dsoRules.svs)).name === "sv2" + lookupSvOperatorParty "sv1" dsoRules === Some sv1 + lookupSvOperatorParty "sv2" dsoRules === Some sv2 svX <- allocateParty "svX" -- overwriting existing sv successfully (using a new participant node) - submit dso $ exerciseCmd dsoRulesCid $ DsoRules_AddSv svX "sv2" 19 "svX-participant-id" (Round 3) + submit dso $ exerciseCmd dsoRulesCid $ DsoRules_AddSv svX "sv2" 0 "svX-participant-id" (Round 3) [(_, dsoRules)] <- query @DsoRules app.dso dsoRules.offboardedSvs === Map.fromList [(sv2, OffboardedSvInfo "sv2" "sv2-participant-id")] @@ -410,7 +413,7 @@ testSvOverwriteInDevNet = do [(dsoRulesCid, _)] <- query @DsoRules app.dso -- overwriting existing sv again - submit dso $ exerciseCmd dsoRulesCid $ DsoRules_AddSv svX2 "sv2" 19 "svX2-participant-id" (Round 3) + submit dso $ exerciseCmd dsoRulesCid $ DsoRules_AddSv svX2 "sv2" 0 "svX2-participant-id" (Round 3) [(_, dsoRules)] <- query @DsoRules app.dso dsoRules.offboardedSvs === Map.fromList @@ -429,7 +432,7 @@ testSvReonboarding = do [(_, dsoRules)] <- query @DsoRules dso - Map.keys dsoRules.svs === [sv1, sv2, sv3, sv4] + operatorParties dsoRules === [sv1, sv2, sv3, sv4] initiateAndAcceptVote app [sv1, sv2, sv3] $ ARC_DsoRules with @@ -439,14 +442,13 @@ testSvReonboarding = do executeAllDefinitiveVotes app [(_, dsoRules)] <- query @DsoRules dso - Map.keys dsoRules.svs === [sv1, sv2, sv3] + operatorParties dsoRules === [sv1, sv2, sv3] Map.keys dsoRules.offboardedSvs === [sv4] checkSvContractInvariants app -- reonboard sv4 let token = "mock-token" sv4New <- allocateParty "sv4New" - svSubmits app sv1 $ \cid -> exerciseCmd cid $ DsoRules_StartSvOnboarding "sv4" sv4New "sv4New-participant-id" token sv1 forA_ [sv1,sv2,sv3] $ \sv -> @@ -458,7 +460,8 @@ testSvReonboarding = do newSvName = "sv4" newParticipantId = "sv4New-participant-id" reason = "because the sv4 owner still has the right to operate a node" - newSvRewardWeight = 19 -- we use 19 as a dummy reward weight for testing + newSvRewardWeight = 0 -- sv weight is not used for on-ledger sv right owners + executeAllConfirmedActions app [(svOnboardingConfirmedCid, _)] <- query @SvOnboardingConfirmed dso @@ -466,7 +469,6 @@ testSvReonboarding = do [(amuletRulesCid, _)] <- query @AmuletRules dso [(dsoRulesCid, _)] <- query @DsoRules dso - submit (actAs sv4New <> readAs dso) $ exerciseCmd dsoRulesCid DsoRules_AddConfirmedSv with sv = sv4New svOnboardingConfirmedCid @@ -477,7 +479,7 @@ testSvReonboarding = do [(_, dsoRules)] <- query @DsoRules dso - Map.keys dsoRules.svs === [sv1, sv2, sv3, sv4New] + operatorParties dsoRules === [sv1, sv2, sv3, sv4New] -- sv4 remaines offboarded Map.keys dsoRules.offboardedSvs === [sv4] @@ -548,7 +550,7 @@ test_MergeValidatorLicense = do testBootstrapDevNetWithNonZeroRound : Script () testBootstrapDevNetWithNonZeroRound = do - (app, _, _) <- initDecentralizedSynchronizerWithNonZeroRound True 34 + (app, _, _) <- initDecentralizedSynchronizerWithNonZeroRound True 34 True [(_, earliestRound), (_, middleRound), (_, latestRound)] <- getActiveOpenRoundsSorted app.dso earliestRound.round === Round 34 middleRound.round === Round 35 @@ -557,7 +559,7 @@ testBootstrapDevNetWithNonZeroRound = do testBootstrapMainNetWithNonZeroRound : Script () testBootstrapMainNetWithNonZeroRound = do - (app, _, _) <- initDecentralizedSynchronizerWithNonZeroRound False 34 + (app, _, _) <- initDecentralizedSynchronizerWithNonZeroRound False 34 True [(_, earliestRound), (_, middleRound), (_, latestRound)] <- getActiveOpenRoundsSorted app.dso earliestRound.round === Round 34 middleRound.round === Round 35 diff --git a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestSvRewards.daml b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestSvRewards.daml index 602fbb0eee..ec53ea9a1e 100644 --- a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestSvRewards.daml +++ b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestSvRewards.daml @@ -26,8 +26,8 @@ test_SvRewards_With_InitialRound_In_FirstIssuanceCurve = do let initialRound = 0 let expectedIssuancePerSvRewardCoupon = 4.6832923545 - - (app, dso, (sv1, sv2, sv3, sv4)) <- initDecentralizedSynchronizerWithNonZeroRound False initialRound + + (app, dso, (sv1, sv2, sv3, sv4)) <- initDecentralizedSynchronizerWithNonZeroRound False initialRound False -- extra party to represent beneficiary extraBeneficiary <- allocateParty "beneficiary" @@ -47,8 +47,8 @@ test_SvRewards_With_InitialRound_In_FirstIssuanceCurve = do require (show sv <> " balance: expected " <> show amount <> " == " <> show amulet.amount.initialAmount) (amulet.amount.initialAmount == amount) let getSvRewardWeightAndState sv = do - info <- getSvInfoByParty app sv - [(rewardStateCid, _)] <- queryFilter @SvRewardState dso (\s -> s.svName == info.name) + (name, info) <- getSvInfoByParty app sv + [(rewardStateCid, _)] <- queryFilter @SvRewardState dso (\s -> s.svName == name) pure (info.svRewardWeight, rewardStateCid) let receiveSvRewardCouponFails sv round rulesCid = do @@ -172,7 +172,7 @@ test_SvRewards_With_InitialRound_In_SecondIssuanceCurve = do let initialRound = 50000 let expectedIssuancePerSvRewardCoupon = 1.4049877064 - (app, dso, (sv1, sv2, sv3, sv4)) <- initDecentralizedSynchronizerWithNonZeroRound False initialRound + (app, dso, (sv1, sv2, sv3, sv4)) <- initDecentralizedSynchronizerWithNonZeroRound False initialRound False -- extra party to represent beneficiary extraBeneficiary <- allocateParty "beneficiary" @@ -192,8 +192,8 @@ test_SvRewards_With_InitialRound_In_SecondIssuanceCurve = do require (show sv <> " balance: expected " <> show amount <> " == " <> show amulet.amount.initialAmount) (amulet.amount.initialAmount == amount) let getSvRewardWeightAndState sv = do - info <- getSvInfoByParty app sv - [(rewardStateCid, _)] <- queryFilter @SvRewardState dso (\s -> s.svName == info.name) + (name, info) <- getSvInfoByParty app sv + [(rewardStateCid, _)] <- queryFilter @SvRewardState dso (\s -> s.svName == name) pure (info.svRewardWeight, rewardStateCid) let receiveSvRewardCouponFails sv round rulesCid = do @@ -329,11 +329,13 @@ test_SvRewardStateMerge = do submitMustFail (actAs sv1 <> readAs dso) $ exerciseCmd rulesCid (DsoRules_MergeSvRewardState "sv1" [sv1RewardStateCid3, sv2RewardStateCid1] (Some sv1)) pure () +-- FIXME: reenable +{- test_SvRewardUpdatedWeight : Script () test_SvRewardUpdatedWeight = do (app, dso, (sv1, sv2, sv3, sv4)) <- initMainNet - unchangedBefore <- getSvInfoByParty app sv1 - before <- getSvInfoByParty app sv2 + (_, unchangedBefore) <- getSvInfoByParty app sv1 + (beforeName, before) <- getSvInfoByParty app sv2 initiateAndAcceptVote app [sv1, sv2, sv3, sv4] $ ARC_DsoRules with @@ -341,16 +343,16 @@ test_SvRewardUpdatedWeight = do svParty = sv2 newRewardWeight = before.svRewardWeight + 1 - after <- getSvInfoByParty app sv2 + (_, after) <- getSvInfoByParty app sv2 after.svRewardWeight === before.svRewardWeight + 1 - unchangedAfter <- getSvInfoByParty app sv1 + (_, unchangedAfter) <- getSvInfoByParty app sv1 unchangedAfter.svRewardWeight === unchangedBefore.svRewardWeight -- check that coupons are claimed with the new weight [(rulesCid, _)] <- query @DsoRules app.dso [(roundCid, round), _, _] <- getActiveOpenRoundsSorted app.dso - [(rewardStateCid, _)] <- queryFilter @SvRewardState dso (\s -> s.svName == before.name) + [(rewardStateCid, _)] <- queryFilter @SvRewardState dso (\s -> s.svName == beforeName) -- collect reward coupon void $ submit (actAs sv2 <> readAs dso) $ exerciseCmd rulesCid DsoRules_ReceiveSvRewardCoupon with openRoundCid = roundCid @@ -360,3 +362,4 @@ test_SvRewardUpdatedWeight = do -- check that the coupon exists and has the right weight [(_, coupon)] <- queryFilter @SvRewardCoupon sv2 (\co -> co.round == round.round) coupon.weight === before.svRewardWeight + 1 +-} \ No newline at end of file diff --git a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestSynchronizerMigration.daml b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestSynchronizerMigration.daml index 1e0d9a86ad..335960c2d4 100644 --- a/daml/splice-dso-governance-test/daml/Splice/Scripts/TestSynchronizerMigration.daml +++ b/daml/splice-dso-governance-test/daml/Splice/Scripts/TestSynchronizerMigration.daml @@ -111,7 +111,7 @@ executeDsoRulesConfigChange : AmuletApp -> (DsoRulesConfig -> DsoRulesConfig) -> executeDsoRulesConfigChange app updateConfig = do [(_, dsoRules)] <- query @DsoRules app.dso let newConfig = updateConfig dsoRules.config - initiateAndAcceptVote app (Map.keys dsoRules.svs) $ + initiateAndAcceptVote app (operatorParties dsoRules) $ ARC_DsoRules with dsoAction = SRARC_SetConfig DsoRules_SetConfig with newConfig = newConfig @@ -125,7 +125,7 @@ initiateAndCastAmuletRulesConfigChange app targetEffectiveAt updateConfig = do let baseConfig = amuletRules.configSchedule.initialValue newConfig = updateConfig baseConfig - initiateAndCastVote app (Map.keys dsoRules.svs) (Some targetEffectiveAt) $ + initiateAndCastVote app (operatorParties dsoRules) (Some targetEffectiveAt) $ ARC_AmuletRules with amuletRulesAction = CRARC_SetConfig AmuletRules_SetConfig with newConfig diff --git a/daml/splice-dso-governance/daml/Splice/DSO/SvRightOwner.daml b/daml/splice-dso-governance/daml/Splice/DSO/SvRightOwner.daml new file mode 100644 index 0000000000..6d1b0f89ea --- /dev/null +++ b/daml/splice-dso-governance/daml/Splice/DSO/SvRightOwner.daml @@ -0,0 +1,62 @@ +module Splice.DSO.SvRightOwner where + +import DA.List (unique) +import Splice.DSO.SvState +import Splice.Util +import Splice.Types + +-- | Information about a super validator right owner. +data SvRightOwnerInfo = SvRightOwnerInfo + with + rightOwnerParty : Party -- ^ The party representing the SV rights owner + voteWeight : Int + -- ^ the weight of an SV for voting, can be zero + rewardWeight : Int + -- ^ the weight of an SV for reward minting, can be zero + rewardNodeOperatorName : Text + -- ^ Name of the SV node operator through which rewards are minted. + -- For rewards to be minted both the node operator. + beneficiaries : [(Party, Decimal)] + -- ^ List of beneficiaries and their percentages for reward distribution. Must not include rightOwnerParty. Remainder goes to rightOwnerParty. + deriving (Eq, Show) + +instance Patchable SvRightOwnerInfo where + patch new base current = SvRightOwnerInfo + with + rightOwnerParty = patch new.rightOwnerParty base.rightOwnerParty current.rightOwnerParty + voteWeight = patch new.voteWeight base.voteWeight current.voteWeight + rewardWeight = patch new.rewardWeight base.rewardWeight current.rewardWeight + rewardNodeOperatorName = patch new.rewardNodeOperatorName base.rewardNodeOperatorName current.rewardNodeOperatorName + beneficiaries = patchScalar new.beneficiaries base.beneficiaries current.beneficiaries + +template SvRightOwner + with + dso : Party + rightOwnerName : Text + info : SvRightOwnerInfo + where + signatory dso + ensure validSvRightOwnerInfo info + +instance HasCheckedFetch SvRightOwner ForSv where + contractGroupId SvRightOwner{..} = + ForSv + with + dso + svName = rightOwnerName + +instance HasCheckedFetch SvRightOwner ForDso where + contractGroupId SvRightOwner{..} = + ForDso + with + dso + +validSvRightOwnerInfo : SvRightOwnerInfo -> Bool +validSvRightOwnerInfo SvRightOwnerInfo{..} = + voteWeight >= 0 && + rewardWeight >= 0 && + sum (map snd beneficiaries) <= 1.0 && + all (\(_, beneficiaryWeight) -> beneficiaryWeight > 0.0) beneficiaries && + all (\(beneficiary,_) -> beneficiary /= rightOwnerParty) beneficiaries && + unique (map fst beneficiaries) && + length beneficiaries <= 20 \ No newline at end of file diff --git a/daml/splice-dso-governance/daml/Splice/DSO/SvState.daml b/daml/splice-dso-governance/daml/Splice/DSO/SvState.daml index 72239fd1f3..eb1d1ab2fb 100644 --- a/daml/splice-dso-governance/daml/Splice/DSO/SvState.daml +++ b/daml/splice-dso-governance/daml/Splice/DSO/SvState.daml @@ -43,7 +43,7 @@ data RewardState = RewardState with -- | State of reward collection for a sv identified by their sv name. template SvRewardState with dso : Party - svName : Text + svName : Text -- ^ sv right owner name state : RewardState where signatory dso diff --git a/daml/splice-dso-governance/daml/Splice/DsoBootstrap.daml b/daml/splice-dso-governance/daml/Splice/DsoBootstrap.daml index c3dedfbc78..f15672579d 100644 --- a/daml/splice-dso-governance/daml/Splice/DsoBootstrap.daml +++ b/daml/splice-dso-governance/daml/Splice/DsoBootstrap.daml @@ -3,9 +3,10 @@ module Splice.DsoBootstrap where +import DA.Functor import qualified DA.Map as Map import DA.Time -import DA.Optional (fromOptional) +import DA.Optional import Splice.AmuletConfig import Splice.AmuletRules @@ -15,6 +16,7 @@ import Splice.Types import Splice.Ans import Splice.DSO.DecentralizedSynchronizer +import Splice.DSO.SvRightOwner import Splice.DsoRules data DsoBootstrap_BootstrapResult = DsoBootstrap_BootstrapResult @@ -35,6 +37,8 @@ template DsoBootstrap with initialTrafficState: Map.Map Text TrafficState isDevNet : Bool initialRound : Optional Int + sv1RightOwnerName : Optional Text + sv1VoteWeight : Optional Int where signatory dso observer sv1Party @@ -60,28 +64,29 @@ template DsoBootstrap with amuletPrice initialRound -- create the DSO rules with the SV1 as the sole sv - let sv1SvInfo = SvInfo with - name = sv1Name - joinedAsOfRound = fromOptional (Round 0) result.initialRound - svRewardWeight = sv1RewardWeight - participantId = sv1ParticipantId - let dsoRules = DsoRules with + let joinedAsOfRound = fromOptional (Round 0) result.initialRound + dsoRules = DsoRules with dso epoch = 0 - svs = Map.fromList [(sv1Party, sv1SvInfo)] + svs = Map.singleton sv1Party SvInfo with + name = sv1Name + svRewardWeight = if isSome sv1RightOwnerName then 0 else sv1RewardWeight + participantId = sv1ParticipantId + joinedAsOfRound offboardedSvs = Map.empty dsoDelegate = sv1Party config initialTrafficState isDevNet + svRightOwners = sv1RightOwnerName <&> \name -> [name] + let info = sv1RightOwnerName <&> \rightOwnerName -> SvRightOwnerInfo with + rightOwnerParty = sv1Party + voteWeight = fromOptional 0 sv1VoteWeight + rewardWeight = sv1RewardWeight + rewardNodeOperatorName = rightOwnerName + beneficiaries = [] create dsoRules - -- create initial per-sv and per-operator contracts for sv1 - let addSvChoiceArgs = DsoRules_AddSv with - newSvParty = sv1Party - newSvName = sv1Name - newSvParticipantId = sv1ParticipantId - joinedAsOfRound = fromOptional (Round 0) result.initialRound - newSvRewardWeight = sv1RewardWeight - createPerSvContracts dsoRules addSvChoiceArgs - createPerSvPartyContracts dso sv1Party sv1Name sv1SynchronizerNodes (Some amuletPrice) (getVoteCooldownTime config) + let joinedAsOfRound = fromOptional (Round 0) result.initialRound + createSvRightOwnerContracts dsoRules sv1Name info joinedAsOfRound + createSvOperatorContracts dso sv1Party sv1Name sv1SynchronizerNodes (Some amuletPrice) (getVoteCooldownTime config) return DsoBootstrap_BootstrapResult diff --git a/daml/splice-dso-governance/daml/Splice/DsoRules.daml b/daml/splice-dso-governance/daml/Splice/DsoRules.daml index ff4829a8cd..779f87303e 100644 --- a/daml/splice-dso-governance/daml/Splice/DsoRules.daml +++ b/daml/splice-dso-governance/daml/Splice/DsoRules.daml @@ -10,10 +10,11 @@ import DA.Assert import DA.Either (partitionEithers) import DA.Foldable (forA_, all) import DA.List as List hiding (all) -import DA.Optional (isNone, fromSome, fromOptional, isSome) +import DA.Optional (isNone, fromOptional, isSome) import qualified DA.Map as Map import qualified DA.Set as Set import qualified DA.Text as T +import qualified DA.TextMap as TextMap import DA.Time import Splice.Amulet @@ -34,6 +35,7 @@ import Splice.Ans import Splice.SvOnboarding import Splice.DSO.AmuletPrice import Splice.DSO.DecentralizedSynchronizer +import Splice.DSO.SvRightOwner import Splice.DSO.SvState import Splice.Schedule import Splice.Util @@ -121,6 +123,10 @@ data DsoRules_ActionRequiringConfirmation -- ^ Create BootstrapExternalPartyConfigStateInstruction | SRARC_UpdateFeaturedAppRight DsoRules_UpdateFeaturedAppRight -- ^ Update a specific featured app right. + | SRARC_DsoRules_UpdateSvRightOwnerInfo DsoRules_UpdateSvRightOwnerInfo + | SRARC_DsoRules_AddSvRightOwner DsoRules_AddSvRightOwner + | SRARC_DsoRules_RemoveSvRightOwner DsoRules_RemoveSvRightOwner + | SRARC_DsoRules_MigrateToOnLedgerSvRightOwners DsoRules_MigrateToOnLedgerSvRightOwners deriving (Eq, Show) data AnsEntryContext_ActionRequiringConfirmation @@ -132,7 +138,7 @@ data AnsEntryContext_ActionRequiringConfirmation -- | Information about SVs relevant to DSO governance. data SvInfo = SvInfo with - name : Text -- ^ Human-readable name; must be unique. + name : Text -- ^ Human-readable sv operator name; must be unique. joinedAsOfRound : Round -- ^ Round in which the SV joined svRewardWeight : Int -- ^ Weight of the SV in the SV reward distribution. participantId : Text -- ^ Participant ID of the SV, stored here as PartyToParticipant mappings are tracked via state on the DsoRules + SvOnboardingConfirmed contracts. @@ -152,6 +158,13 @@ data DsoSummary = DsoSummary with -- ^ The number of votes required for considering a confirmation, or a request for a vote deriving (Eq, Show) +data DsoSummaryV2 = DsoSummaryV2 + with + totalVoteWeight : Int + requiredVoteWeight : Int + votersWithWeight : TextMap.TextMap Int -- ^ Map from voter name (right owner or operator name depending on the vote type) to its vote weight + deriving (Eq, Show) + -- | Choice return types ------------------------- -- In order to support upgrades of the Daml models, all choices should return records, which can @@ -432,6 +445,18 @@ template VoteRequest ensure all (voteBefore <=) targetEffectiveAt signatory dso +-- FIXME: Placeholder, current implementation is arbitrary and just serves to be able to exercise both vote types in tests. +voteType : ActionRequiringConfirmation -> VoteType +voteType (ARC_DsoRules act) = case act of + SRARC_DsoRules_UpdateSvRightOwnerInfo{} -> RightOwnerVote + SRARC_DsoRules_AddSvRightOwner{} -> RightOwnerVote + SRARC_DsoRules_RemoveSvRightOwner{} -> RightOwnerVote + _ -> OperatorVote +voteType (ARC_AmuletRules _) = OperatorVote +voteType (ARC_AnsEntryContext _ _) = OperatorVote +voteType (ExtActionRequiringConformation _) = OperatorVote + + data DsoRules_CloseVoteRequestResult = DsoRules_CloseVoteRequestResult with request : VoteRequest -- ^ The original vote request. completedAt : Time -- ^ When the vote request was completed. @@ -456,7 +481,7 @@ data VoteRequestOutcome -- -- | A vote cast by an SV. data Vote = Vote with - sv : Party -- ^ The SV party used to submit the vote. + sv : Party -- ^ The SV party used to submit the vote. Can be a right owner party or an operator party depending on the vote type. accept : Bool -- ^ Whether the responder accepted the request to execute the action or not. reason : Reason @@ -518,19 +543,43 @@ data TrafficState = TrafficState with consumedTraffic: Int -- ^ Bytes of extra traffic consumed before the decentralized synchronizer was bootstrapped. deriving (Eq, Show) +getSvRightOwners : DsoRules -> [Text] +getSvRightOwners DsoRules{..} = fromOptional [] svRightOwners + +onLedgerSvRightOwners : DsoRules -> Bool +onLedgerSvRightOwners DsoRules{..} = isSome svRightOwners + +requireOnLedgerSvRightOwners : DsoRules -> Update () +requireOnLedgerSvRightOwners this = + require "svRightOwners are tracked on-ledger" (onLedgerSvRightOwners this) + +requireNoOnLedgerSvRightOwners : DsoRules -> Update () +requireNoOnLedgerSvRightOwners this = + require "svRightOwners are not tracked on-ledger" (not $ onLedgerSvRightOwners this) + template DsoRules with dso : Party epoch : Int svs : Map.Map Party SvInfo + -- ^ SV Node Operators offboardedSvs : Map.Map Party OffboardedSvInfo + -- ^ Only set for sv node owners to handle DSO party offboarding dsoDelegate : Party -- ^ __Deprecated__ in favor of delegateless automation. config : DsoRulesConfig initialTrafficState: Map.Map Text TrafficState -- ^ Map from participant/mediator ID to its traffic state at the time of synchronizer bootstrapping. Used for testing, empty in prod. isDevNet : Bool + svRightOwners : Optional [Text] + -- ^ Set of sv right owner names. we maintain the invariant that for each right owner here there is exactly one SvRightOwner contract + -- and the list of SvRightOwner contracts and the list of sv right owners here are kept in sync atomically. + where ensure - config.numUnclaimedRewardsThreshold > 0 + config.numUnclaimedRewardsThreshold > 0 && + -- when using on-ledger right owners they must be non-empty + optional True (\rightOwners -> length rightOwners >= 1 && unique rightOwners) svRightOwners && + -- when using on-ledger right owners the weight in the operator info must be 0 + (not (onLedgerSvRightOwners this) || all (\info -> info.svRewardWeight == 0) (Map.values svs)) -- NOTE: the svs are not direct signatories as that would not give us the right fault-tolerance wrt -- validating choices on this contract. Instead, the svs are indirect signatories by being @@ -554,20 +603,21 @@ template DsoRules with choice DsoRules_OffboardSv : DsoRules_OffboardSvResult with - sv : Party + sv : Party -- ^ sv operator party controller dso do + let svOperator = sv require "There is more than one sv" (Map.size svs > 1) - case Map.lookup sv svs of + case Map.lookup svOperator svs of None -> fail "Not a sv" Some info -> do -- NOTE: this immediate deletion will lead to the SV apps of the remaining svs -- revoking that sv's rights in the CometBFT network and the topology state. - let newSvs = Map.delete sv svs + let newSvs = Map.delete svOperator svs -- We optimize for prompt removal of a sv if the vote said so. -- and instead just choose the sv with the lexicographically smallest name. let (newDsoDelegate, newEpoch) - | sv == dsoDelegate = (head (Map.keys newSvs), epoch + 1) + | svOperator == dsoDelegate = (head (Map.keys newSvs), epoch + 1) | otherwise = (dsoDelegate, epoch) let offboardedSvInfo = OffboardedSvInfo with name = info.name @@ -578,7 +628,8 @@ template DsoRules with epoch = newEpoch dsoDelegate = newDsoDelegate svs = newSvs - offboardedSvs = Map.insert sv offboardedSvInfo offboardedSvs + svRightOwners + offboardedSvs = Map.insert svOperator offboardedSvInfo offboardedSvs config initialTrafficState isDevNet @@ -588,21 +639,20 @@ template DsoRules with -- Update an SV's Status report nonconsuming choice DsoRules_SubmitStatusReport : DsoRules_SubmitStatusReportResult with - sv : Party + sv : Party -- ^ sv operator party previousReportCid : ContractId SvStatusReport status : SvStatus controller sv do - newReport <- case Map.lookup sv svs of - None -> fail "SV is not an SV" - Some info -> do - previousReport <- fetchAndArchive (ForSvNode with dso; sv; svName = info.name) previousReportCid - create SvStatusReport with - dso - sv - svName = info.name - number = previousReport.number + 1 - status = Some status + let svOperator = sv + name <- getAndValidateSvNodeOperatorParty this (Some svOperator) + previousReport <- fetchAndArchive (ForSvNode with dso; sv = svOperator; svName = name) previousReportCid + newReport <- create SvStatusReport with + dso + sv = svOperator + svName = name + number = previousReport.number + 1 + status = Some status return DsoRules_SubmitStatusReportResult with .. -- Called by SV candidates to add themselves to the DsoRules once they are confirmed and ready. @@ -610,7 +660,7 @@ template DsoRules with -- the first round in which the new SV will receive rewards. nonconsuming choice DsoRules_AddConfirmedSv : DsoRules_AddConfirmedSvResult with - sv : Party + sv : Party -- ^ sv operator party svOnboardingConfirmedCid : ContractId SvOnboardingConfirmed earliestRoundCid : ContractId OpenMiningRound middleRoundCid : ContractId OpenMiningRound @@ -620,8 +670,8 @@ template DsoRules with -- (This was used when the current round number was tracked in the AmuletRules contract.) controller sv do - - svOnboardingConfirmed <- fetchAndArchive (ForOwner with dso; owner = sv) svOnboardingConfirmedCid + let svOperator = sv + svOnboardingConfirmed <- fetchAndArchive (ForOwner with dso; owner = svOperator) svOnboardingConfirmedCid assertWithinDeadline "svOnboardingConfirmed.expiresAt" svOnboardingConfirmed.expiresAt let forDso = ForDso with dso @@ -632,7 +682,7 @@ template DsoRules with require "latestRound is one after middleRound" (latestRound.round.number == middleRound.round.number + 1) addSvResult <- exercise self DsoRules_AddSv with - newSvParty = sv + newSvParty = svOperator newSvName = svOnboardingConfirmed.svName newSvRewardWeight = svOnboardingConfirmed.svRewardWeight newSvParticipantId = svOnboardingConfirmed.svParticipantId @@ -648,12 +698,14 @@ template DsoRules with -- Every SV can change their own synchronizer node's config within the configured limits. nonconsuming choice DsoRules_SetSynchronizerNodeConfig : DsoRules_SetSynchronizerNodeConfigResult with - sv : Party + sv : Party -- ^ sv operator party synchronizerId : Text newNodeConfig : SynchronizerNodeConfig nodeStateCid : ContractId SvNodeState controller sv do + let svOperator = sv + getAndValidateSvNodeOperatorParty this (Some svOperator) -- check that the synchronizer is known require "Synchronizer with this id is configured" (synchronizerId `Map.member` config.decentralizedSynchronizer.synchronizers) -- check validity of config and constraint on voting power @@ -661,9 +713,8 @@ template DsoRules with unless isDevNet $ require "CometBft voting power <= 1" (CometBft.totalVotingPower newNodeConfig.cometBft <= 1) -- update the SV operator node's state - info <- getSvInfo sv this - let svName = info.name - nodeState <- fetchAndArchive (ForSvNode with dso; sv; svName) nodeStateCid + (svName, _) <- getSvInfoByOperatorParty svOperator this + nodeState <- fetchAndArchive (ForSvNode with dso; sv = svOperator; svName) nodeStateCid let state = nodeState.state svNodeState <- create nodeState with state = state with @@ -714,7 +765,7 @@ template DsoRules with action : ActionRequiringConfirmation controller confirmer do - require "Confirmer is an SV" (confirmer `Map.member` svs) + getAndValidateSvNodeOperatorParty this (Some confirmer) now <- getTime let expiresAt = now `addRelTime` config.actionConfirmationTimeout confirmation <- create Confirmation with @@ -732,13 +783,14 @@ template DsoRules with sv : Optional Party controller sv do - _ <- getAndValidateSvParty this sv - let s = summarizeDso this + _ <- getAndValidateSvNodeOperatorParty this sv + s <- summarizeDso OperatorVote TextMap.empty this let forDso = ForDso with dso - require "Enough confirmations" (length confirmationCids >= s.requiredNumVotes) + -- there are no operator vote weights so just number of confirmations is sufficient. + require "Enough confirmations" (length confirmationCids >= s.requiredVoteWeight) confirmers <- forA confirmationCids $ \confirmationCid -> do confirmation <- fetchAndArchive forDso confirmationCid - require "Confirmer is an SV" (confirmation.confirmer `Map.member` svs) + getAndValidateSvNodeOperatorParty this (Some confirmation.confirmer) require "Confirmed action matches" (confirmation.action == action) assertWithinDeadline "confirmation.expiresAt" confirmation.expiresAt pure confirmation.confirmer @@ -758,11 +810,10 @@ template DsoRules with reason : Reason voteRequestTimeout : Optional RelTime targetEffectiveAt : Optional Time + rightOwnerCid : Optional (ContractId SvRightOwner) controller requester do - requesterName <- case requester `Map.lookup` svs of - None -> fail "Requester is not an SV" - Some info -> pure (info.name) + requesterName <- getAndValidateVotingParty rightOwnerCid this requester action requireWellformedReason config reason now <- getTime let voteBefore = case voteRequestTimeout of @@ -793,15 +844,14 @@ template DsoRules with with requestCid : ContractId VoteRequest vote : Vote + rightOwnerCid : Optional (ContractId SvRightOwner) controller vote.sv do -- validate vote parameters requireWellformedVote config vote - voterName <- case Map.lookup vote.sv svs of - None -> fail "Voter is not an SV" - Some info -> pure info.name -- validate and archive request request <- fetchAndArchive (ForDso with dso) requestCid + voterName <- getAndValidateVotingParty rightOwnerCid this vote.sv request.action -- rate limit casting of votes by the same SV to avoid them blocking others from making progress -- Note: we currently ignore the optional self-declared vote casting time -- `vote.optCastAt`. We'll use that in the future when adding support for larger @@ -843,36 +893,36 @@ template DsoRules with requestCid : ContractId VoteRequest amuletRulesCid : Optional (ContractId AmuletRules) sv : Optional Party + rightOwnerCids : Optional (TextMap.TextMap (ContractId SvRightOwner)) controller sv do - _ <- getAndValidateSvParty this sv + _ <- getAndValidateSvNodeOperatorParty this sv now <- getTime - let s = summarizeDso this request <- fetchAndArchive (ForDso with dso) requestCid + s <- summarizeDso (voteType request.action) (fromOptional TextMap.empty rightOwnerCids) this - let activeSvs = map (.name) $ Map.values svs - - let activeSvSet = Set.fromList activeSvs let (validVotes, offboardedVoters) = partitionEithers - [ if voterName `Set.member` activeSvSet then Left vote else Right voterName + [ case TextMap.lookup voterName s.votersWithWeight of + None -> Right voterName + Some weight -> Left (voterName, vote, weight) | (voterName, vote) <- Map.toList request.votes ] - let abstainingSvs = [ name | name <- activeSvs, not (name `Map.member` request.votes) ] - let (yays, nays) = partition (.accept) validVotes - let numYays = length yays - let numNays = length nays - let numVotes = numYays + numNays + let abstainingSvs = [ name | (name, _) <- TextMap.toList s.votersWithWeight, not (name `Map.member` request.votes) ] + let (yays, nays) = partition (\(_, v, _) -> v.accept) validVotes + let yayWeight = sum $ map (\(_, _, weight) -> weight) yays + let nayWeight = sum $ map (\(_, _, weight) -> weight) nays + let totalWeight = yayWeight + nayWeight outcome <- case request.targetEffectiveAt of - Some _ | numNays >= s.requiredNumVotes -> + Some _ | nayWeight >= s.requiredVoteWeight -> pure $ VRO_Rejected - Some _ | now >= request.voteBefore && numVotes < s.requiredNumVotes -> + Some _ | now >= request.voteBefore && totalWeight < s.requiredVoteWeight -> pure $ VRO_Expired - Some effectiveTime | now >= effectiveTime && numYays >= s.requiredNumVotes -> + Some effectiveTime | now >= effectiveTime && yayWeight >= s.requiredVoteWeight -> do executeActionRequiringConfirmation dso self amuletRulesCid request.action pure $ VRO_Accepted with @@ -884,10 +934,10 @@ template DsoRules with Some _ -> fail "no definitive outcome for voting request with effectivity" - None | numNays >= s.requiredNumVotes -> + None | nayWeight >= s.requiredVoteWeight -> pure $ VRO_Rejected - None | numYays >= s.requiredNumVotes -> + None | yayWeight >= s.requiredVoteWeight -> do executeActionRequiringConfirmation dso self amuletRulesCid request.action -- TODO(#16139): Remove Config Schedule from AmuletConfig @@ -915,19 +965,20 @@ template DsoRules with nonconsuming choice DsoRules_UpdateAmuletPriceVote : DsoRules_UpdateAmuletPriceVoteResult with - sv : Party + sv : Party -- ^ sv operator party voteCid : ContractId AmuletPriceVote amuletPrice : Decimal controller sv do - pastVote <- fetchAndArchive (ForOwner with dso; owner = sv) voteCid + let svOperator = sv -- ^ for now we still tie amulet price votes to operators, it may make sense to change it to right owners eventually + pastVote <- fetchAndArchive (ForOwner with dso; owner = svOperator) voteCid -- rate limit, so that an SV cannot block round advancement by changing their price vote too often - enforceCooldown ("voteCooldownTime for " <> partyToText sv) (getVoteCooldownTime config) (Some pastVote.lastUpdatedAt) + enforceCooldown ("voteCooldownTime for " <> partyToText svOperator) (getVoteCooldownTime config) (Some pastVote.lastUpdatedAt) now <- getTime -- create new vote amuletPriceVote <- create AmuletPriceVote with dso - sv + sv = svOperator amuletPrice = Some amuletPrice lastUpdatedAt = now return DsoRules_UpdateAmuletPriceVoteResult with .. @@ -944,10 +995,11 @@ template DsoRules with with nonSvVoteCids : [ContractId AmuletPriceVote] duplicateVoteCids : [[ContractId AmuletPriceVote]] - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator let forDso = ForDso with dso -- validate and archive non-sv votes forA_ nonSvVoteCids $ \voteCid -> do @@ -966,7 +1018,7 @@ template DsoRules with [_] -> fail "singleton list of duplicate votes" ((_, vote)::duplicates) -> do require "matching DSO party" (vote.dso == dso) - require "SV is a sv" (vote.sv `Map.member` svs) + getAndValidateSvNodeOperatorParty this (Some vote.sv) forA_ duplicates $ \(duplicateCid, duplicate) -> do -- safe, as we fetched it before and check the constraints below potentiallyUnsafeArchive duplicateCid @@ -993,10 +1045,11 @@ template DsoRules with choice DsoRules_UpdateSvRewardWeight : DsoRules_UpdateSvRewardWeightResult with - svParty : Party + svParty : Party -- ^ sv operator party but will be replaced by DsoRules_UpdateSvRightOwnerInfo newRewardWeight : Int controller dso do + requireNoOnLedgerSvRightOwners this require "New reward weight is positive" (newRewardWeight >= 0) case Map.lookup svParty svs of None -> fail "SV party is not registered" @@ -1049,13 +1102,13 @@ template DsoRules with nonconsuming choice DsoRules_OnboardValidator : DsoRules_OnboardValidatorResult with - sponsor : Party + sponsor : Party -- ^ sv operator for now, will be replaced as part of public sequencer work validator : Party version : Optional Text contactPoint : Optional Text controller sponsor do - require "Sponsor is an SV" (sponsor `Map.member` svs) + getAndValidateSvNodeOperatorParty this (Some sponsor) now <- getTime validatorLicense <- create ValidatorLicense with dso @@ -1072,9 +1125,10 @@ template DsoRules with -- There should never be duplicates going forward. with validatorLicenseCids : [ContractId ValidatorLicense] - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv - do _ <- getAndValidateSvParty this sv + do let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator require "Number of validatorLicense contracts to merge is >= 2" (length validatorLicenseCids >= 2) validatorLicenses <- forA validatorLicenseCids $ fetchAndArchive (ForDso this.dso) require "All validatorLicenses map to the same validator" ( length (dedup (map (.validator) validatorLicenses)) == 1) @@ -1097,10 +1151,11 @@ template DsoRules with candidateParty : Party candidateParticipantId: Text token : Text - sponsor : Party + sponsor : Party -- ^ sv operator controller sponsor do - require "Sponsor is an SV" (sponsor `Map.member` svs) + -- node onboarding is controlled by existing nodes + getAndValidateSvNodeOperatorParty this (Some sponsor) now <- getTime let expiresAt = now `addRelTime` config.svOnboardingRequestTimeout onboardingRequest <- create SvOnboardingRequest with .. @@ -1109,25 +1164,26 @@ template DsoRules with nonconsuming choice DsoRules_ExpireSvOnboardingRequest : DsoRules_ExpireSvOnboardingRequestResult with cid: ContractId SvOnboardingRequest - sv : Optional Party + sv : Optional Party -- ^ sv operator controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator exercise cid SvOnboardingRequest_Expire return DsoRules_ExpireSvOnboardingRequestResult nonconsuming choice DsoRules_ArchiveSvOnboardingRequest : DsoRules_ArchiveSvOnboardingRequestResult with svOnboardingRequestCid: ContractId SvOnboardingRequest - sv : Optional Party + sv : Optional Party -- ^ sv operator controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator -- TODO(#3756) Enable archiving also before the sv is added, after a matching `SvOnboardingConfirmed` contract is created. svOnboardingRequest <- fetchAndArchive (ForDso with dso) svOnboardingRequestCid - let maybeSv = Map.lookup svOnboardingRequest.candidateParty svs - require "SV party is an SV" (isSome maybeSv) - require "SV name matches" ((fromSome maybeSv).name == svOnboardingRequest.candidateName) + name <- getAndValidateSvNodeOperatorParty this (Some svOnboardingRequest.candidateParty) + require "SV name matches" (name == svOnboardingRequest.candidateName) return DsoRules_ArchiveSvOnboardingRequestResult nonconsuming choice DsoRules_ConfirmSvOnboarding : DsoRules_ConfirmSvOnboardingResult @@ -1142,7 +1198,7 @@ template DsoRules with ensureNeverOperatedNode newSvParty this if (not isDevNet) then - require "SV name is expected to be new unless in devnet" (newSvName `notElem` (map (.name) (Map.values svs))) + require "SV name is expected to be new unless in devnet" (isNone $ lookupSvOperatorInfoByName newSvName this) else pure () now <- getTime let expiresAt = now `addRelTime` config.svOnboardingConfirmedTimeout @@ -1159,10 +1215,11 @@ template DsoRules with choice DsoRules_ExpireSvOnboardingConfirmed : DsoRules_ExpireSvOnboardingConfirmedResult with cid: ContractId SvOnboardingConfirmed - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator svOnboardingConfirmed <- fetchButArchiveLater (ForDso with dso) cid exercise cid SvOnboardingConfirmed_Expire -- register the sv as offboarded so it's PartyToParticipant mapping for the DSO party gets removed @@ -1182,10 +1239,11 @@ template DsoRules with with extAmuletRulesCid : ContractId ExternalPartyAmuletRules expireAllocations : ExternalPartyAmuletRules_ExpireAmuletAllocations - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) TSU.requireMatchExpected ("expireAllocations.expectedDso", expireAllocations.expectedDso) dso res <- exercise extAmuletRulesCid (expireAllocations with expectedDso = dso) @@ -1195,10 +1253,11 @@ template DsoRules with with extAmuletRulesCid : ContractId ExternalPartyAmuletRules choiceArg : ExternalPartyAmuletRules_ExpireAmuletAllocationsV2 - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) _ <- fetchChecked (ForDso with dso) extAmuletRulesCid result <- exercise extAmuletRulesCid choiceArg pure DsoRules_ExpireAmuletAllocationsV2Result with result @@ -1207,10 +1266,11 @@ template DsoRules with with amuletRulesCid : ContractId AmuletRules transferInsts : AmuletRules_Amulet_ExpireTransferInstructions - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) require ("expectedDso " <> show transferInsts.expectedDso <> " matches the actualDso " <> show dso) (transferInsts.expectedDso == dso) res <- exercise amuletRulesCid (transferInsts with expectedDso = dso) pure DsoRules_Amulet_ExpireTransferInstructionsResult with result = res @@ -1227,10 +1287,11 @@ template DsoRules with with cid : ContractId Amulet choiceArg : Amulet_ExpireV2 - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator result <- exercise cid choiceArg return DsoRules_Amulet_ExpireV2Result with expireSum = result.expireSum @@ -1239,10 +1300,11 @@ template DsoRules with with cid : ContractId LockedAmulet choiceArg : LockedAmulet_ExpireAmulet - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator result <- exercise cid choiceArg return DsoRules_LockedAmulet_ExpireAmuletResult with expireSum = result.expireSum @@ -1251,10 +1313,11 @@ template DsoRules with with cid : ContractId LockedAmulet choiceArg : LockedAmulet_ExpireAmuletV2 - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator result <- exercise cid choiceArg return DsoRules_LockedAmulet_ExpireAmuletV2Result with expireSum = result.expireSum @@ -1270,11 +1333,12 @@ template DsoRules with middleRoundCid : ContractId OpenMiningRound latestRoundCid : ContractId OpenMiningRound amuletPriceVoteCids : [ContractId AmuletPriceVote] - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv - amuletPrice <- fetchMedianAmuletPrice dso (Map.keys svs) amuletPriceVoteCids + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator + amuletPrice <- fetchMedianAmuletPrice dso (operatorParties this) amuletPriceVoteCids result <- exercise amuletRulesCid AmuletRules_AdvanceOpenMiningRounds with .. return DsoRules_AdvanceOpenMiningRoundsResult with summarizingRound = result.summarizingRoundCid @@ -1286,10 +1350,11 @@ template DsoRules with externalPartyConfigStateCid0 : ContractId ExternalPartyConfigState externalPartyConfigStateCid1 : ContractId ExternalPartyConfigState openMiningRoundTriple : OpenMiningRoundTriple - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) result <- exercise amuletRulesCid AmuletRules_UpdateExternalPartyConfigStates with .. return DsoRules_UpdateExternalPartyConfigStatesResult with newExternalPartyConfigStateCid = result.newExternalPartyConfigStateCid @@ -1302,10 +1367,11 @@ template DsoRules with with ansEntryContextCid : ContractId AnsEntryContext choiceArg : AnsEntryContext_CollectEntryRenewalPayment - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator summary <- exercise ansEntryContextCid choiceArg return DsoRules_CollectEntryRenewalPaymentResult with ansEntry = summary.entryCid @@ -1315,10 +1381,11 @@ template DsoRules with with ansEntryCid : ContractId AnsEntry choiceArg : AnsEntry_Expire - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator exercise ansEntryCid choiceArg pure DsoRules_ExpireAnsEntryResult @@ -1327,10 +1394,11 @@ template DsoRules with ansEntryContextCid : ContractId AnsEntryContext subscriptionIdleStateCid: ContractId SubscriptionIdleState choiceArg : SubscriptionIdleState_ExpireSubscription - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator result <- exercise subscriptionIdleStateCid choiceArg exercise ansEntryContextCid (AnsEntryContext_Terminate dso result.terminatedSubscription) pure DsoRules_ExpireSubscriptionResult @@ -1339,27 +1407,29 @@ template DsoRules with with ansEntryContextCid : ContractId AnsEntryContext terminatedSubscriptionCid : ContractId TerminatedSubscription - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator exercise ansEntryContextCid (AnsEntryContext_Terminate dso terminatedSubscriptionCid) pure DsoRules_TerminateSubscriptionResult -- Reward management driven directly by the DSO delegates --------------------------------------------------------- - nonconsuming choice DsoRules_ReceiveSvRewardCoupon : DsoRules_ReceiveSvRewardCouponResult with - sv : Party + sv : Party -- ^ sv operator party openRoundCid : ContractId OpenMiningRound rewardStateCid : ContractId SvRewardState beneficiaries : [(Party, Int)] controller sv do - case Map.lookup sv svs of - None -> fail "SV is not an SV" + requireNoOnLedgerSvRightOwners this + let svOperator = sv + case Map.lookup svOperator svs of + None -> fail "SV is not an SV operator" Some info -> do -- check round now <- getTime @@ -1398,6 +1468,64 @@ template DsoRules with svRewardState = newRewardStateCid svRewardCoupons = couponCids + nonconsuming choice DsoRules_ReceiveSvRewardCouponV2 : () + with + sv : Party -- ^ sv operator party + openRoundCid : ContractId OpenMiningRound + svRewardStates : TextMap.TextMap (ContractId SvRightOwner, ContractId SvRewardState) + controller sv + do + requireOnLedgerSvRightOwners this + let svOperator = sv + operatorName <- getAndValidateSvNodeOperatorParty this (Some svOperator) + now <- getTime + openRound <- fetchReferenceData (ForDso with dso) openRoundCid + require "OpenRound is open" (openRound.opensAt <= now) + + forA_ (TextMap.toList svRewardStates) $ \(svName, (rightOwnerCid, rewardStateCid)) -> do + rewardState <- fetchAndArchive (ForSv with dso, svName) rewardStateCid + svRightOwner <- fetchChecked (ForSv with dso, svName) rightOwnerCid + require "Operator matches" (svRightOwner.info.rewardNodeOperatorName == operatorName) + let svInfo = svRightOwner.info + let state = rewardState.state + beneficiaries = svInfo.beneficiaries + let (configuredBeneficiaryCouponWeights, remainingWeight) = + foldl + (\(acc, remainingWeight) (beneficiary, weight) -> + let beneficiaryWeight = floor (weight * intToDecimal svInfo.rewardWeight) + in ((beneficiary, beneficiaryWeight) :: acc, remainingWeight - beneficiaryWeight)) + ([], svInfo.rewardWeight) + beneficiaries + beneficiaryCouponWeights = + if remainingWeight > 0 then (svInfo.rightOwnerParty, remainingWeight) :: configuredBeneficiaryCouponWeights + else configuredBeneficiaryCouponWeights + require + ("Round " <> show openRound.round <> " is greater than the last round a reward has been received for " <> show state.lastRoundCollected) + (state.lastRoundCollected < openRound.round) + + newRewardStateCid <- create rewardState with + state = RewardState with + lastRoundCollected = openRound.round + numRoundsCollected = state.numRoundsCollected + 1 + numRoundsMissed = + state.numRoundsMissed + (openRound.round.number - state.lastRoundCollected.number - 1) + numCouponsIssued = state.numCouponsIssued + length beneficiaryCouponWeights + + -- check weights and issue rewards + require "Sum of beneficiary weights matches" (svInfo.rewardWeight == sum (map snd beneficiaryCouponWeights)) + + couponCids <- forA beneficiaryCouponWeights $ \(beneficiary, weight) -> + create SvRewardCoupon with + dso + sv = svInfo.rightOwnerParty + beneficiary + weight + round = openRound.round + + return (svName, (newRewardStateCid, couponCids)) + + pure () + -- Batch expiry of unclaimed rewards for a specific claimed round ----------------------------------------------------------------- @@ -1405,10 +1533,11 @@ template DsoRules with with amuletRulesCid : ContractId AmuletRules choiceArg : AmuletRules_ClaimExpiredRewards - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator -- TODO(#2025) Deprecate AmuletRules_ClaimExpiredRewards. We did not do that in the same change -- as inlining the definition here so don't need to bump splice-amulet which also requires validators to upgrade. @@ -1467,10 +1596,11 @@ template DsoRules with with amuletRulesCid : ContractId AmuletRules choiceArg : AmuletRules_ClaimExpiredRewardsV2 - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) result <- exercise amuletRulesCid choiceArg return DsoRules_ClaimExpiredRewardsV2Result with result @@ -1479,10 +1609,11 @@ template DsoRules with with processRewardsCid : ContractId RewardAccountingV2.ProcessRewardsV2 choiceArg : RewardAccountingV2.ProcessRewardsV2_ProcessBatch - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) result <- exercise processRewardsCid choiceArg return DsoRules_ProcessRewardsV2_ProcessBatchResult with result @@ -1491,10 +1622,11 @@ template DsoRules with with amuletRulesCid : ContractId AmuletRules choiceArg : AmuletRules_UnhideRewardCouponsV2 - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) result <- exercise amuletRulesCid choiceArg return DsoRules_UnhideRewardCouponsV2Result with result @@ -1504,10 +1636,11 @@ template DsoRules with with amuletRulesCid : ContractId AmuletRules choiceArg : AmuletRules_ArchiveDryRunRewardAccountingV2 - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) result <- exercise amuletRulesCid choiceArg return DsoRules_ArchiveDryRunRewardAccountingV2Result with result @@ -1518,10 +1651,11 @@ template DsoRules with with amuletRulesCid : ContractId AmuletRules unclaimedRewardCids : [ContractId UnclaimedReward] - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator require "Number of unclaimed rewards is above the configured threshold" $ length unclaimedRewardCids > config.numUnclaimedRewardsThreshold result <- exercise amuletRulesCid AmuletRules_MergeUnclaimedRewards with .. return DsoRules_MergeUnclaimedRewardsResult with @@ -1532,10 +1666,11 @@ template DsoRules with with amuletRulesCid : ContractId AmuletRules choiceArg : AmuletRules_MergeUnclaimedDevelopmentFundCoupons - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) result <- exercise amuletRulesCid choiceArg return DsoRules_MergeUnclaimedDevelopmentFundCouponsResult with result @@ -1543,10 +1678,11 @@ template DsoRules with -- ^ Expires a DevelopmentFundCoupon and produces an UnclaimedDevelopmentFundCoupon with the same amount. with developmentFundCouponCid : ContractId DevelopmentFundCoupon - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) result <- exercise developmentFundCouponCid DevelopmentFundCoupon_DsoExpire pure $ DsoRules_ExpireDevelopmentFundCouponResult with result @@ -1554,10 +1690,11 @@ template DsoRules with with amuletRulesCid : ContractId AmuletRules issuingRoundCid : ContractId IssuingMiningRound - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator result <- exercise amuletRulesCid AmuletRules_MiningRound_Close with .. return DsoRules_MiningRound_CloseResult with closedRound = result.closedRoundCid @@ -1570,10 +1707,11 @@ template DsoRules with nonconsuming choice DsoRules_ExpireStaleConfirmation : DsoRules_ExpireStaleConfirmationResult with staleConfirmationCid : ContractId Confirmation - sv : Optional Party + sv : Optional Party -- ^ sv operator controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator fetchChecked (ForDso with dso) staleConfirmationCid exercise staleConfirmationCid Confirmation_Expire return DsoRules_ExpireStaleConfirmationResult @@ -1584,10 +1722,11 @@ template DsoRules with with amuletRulesCid : ContractId AmuletRules trafficCids : [ContractId MemberTraffic] - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator require "Number of member traffic contracts is above the configured threshold" $ length trafficCids > config.numMemberTrafficContractsThreshold result <- exercise amuletRulesCid AmuletRules_MergeMemberTrafficContracts with .. return DsoRules_MergeMemberTrafficContractsResult with @@ -1599,9 +1738,10 @@ template DsoRules with with svName : Text rewardStateCids : [ContractId SvRewardState] - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv - do _ <- getAndValidateSvParty this sv + do let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator require "Number of SvRewardState contracts to merge is >= 2" (length rewardStateCids >= 2) rewardStates <- forA rewardStateCids $ fetchAndArchive (ForSv this.dso svName) -- We don't attempt to merge the fields in the reward state since there is no good @@ -1616,7 +1756,7 @@ template DsoRules with amuletRulesCid : ContractId AmuletRules sv : Optional Party controller sv - do _ <- getAndValidateSvParty this sv + do _ <- getAndValidateSvNodeOperatorParty this sv deprecatedChoice "splice-dso-governance" "0.1.16" "DsoRules_PruneAmuletConfigSchedule" -- external party @@ -1639,10 +1779,11 @@ template DsoRules with nonconsuming choice DsoRules_ExpireTransferPreapproval : DsoRules_ExpireTransferPreapprovalResult with transferPreapprovalCid : ContractId TransferPreapproval - sv : Optional Party + sv : Optional Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator exercise transferPreapprovalCid TransferPreapproval_Expire pure DsoRules_ExpireTransferPreapprovalResult @@ -1650,10 +1791,11 @@ template DsoRules with with amuletRulesCid : ContractId AmuletRules argument : AmuletRules_ConvertFeaturedAppActivityMarkers - sv : Optional Party + sv : Optional Party -- ^ sv operator controller sv do - _ <- getAndValidateSvParty this sv + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this svOperator result <- exercise amuletRulesCid argument pure DsoRules_AmuletRules_ConvertFeaturedAppActivityMarkersResult with result @@ -1687,10 +1829,11 @@ template DsoRules with unclaimedRewardsToBurnCids : [ContractId UnclaimedReward] -- ^ A sufficient list of `UnclaimedReward` to be archived. -- It must cover at least the requested amount. - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) UnallocatedUnclaimedActivityRecord{..} <- fetchAndArchive (ForDso with dso) unallocatedUnclaimedActivityRecordCid assertWithinDeadline "UnallocatedUnclaimedActivityRecord.expiresAt" expiresAt @@ -1715,10 +1858,11 @@ template DsoRules with nonconsuming choice DsoRules_ExpireUnallocatedUnclaimedActivityRecord : DsoRules_ExpireUnallocatedUnclaimedActivityRecordResult with unallocatedUnclaimedActivityRecordCid : ContractId UnallocatedUnclaimedActivityRecord - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) unallocatedUnclaimedActivityRecord <- fetchAndArchive (ForDso with dso) unallocatedUnclaimedActivityRecordCid assertDeadlineExceeded "UnallocatedUnclaimedActivityRecord.expiresAt" unallocatedUnclaimedActivityRecord.expiresAt pure $ DsoRules_ExpireUnallocatedUnclaimedActivityRecordResult @@ -1726,10 +1870,11 @@ template DsoRules with nonconsuming choice DsoRules_ExpireUnclaimedActivityRecord : DsoRules_ExpireUnclaimedActivityRecordResult with unclaimedActivityRecordCid : ContractId UnclaimedActivityRecord - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) UnclaimedActivityRecord_DsoExpireResult unclaimedRewardCid <- exercise unclaimedActivityRecordCid UnclaimedActivityRecord_DsoExpire pure DsoRules_ExpireUnclaimedActivityRecordResult with unclaimedRewardCid @@ -1745,16 +1890,193 @@ template DsoRules with amuletRulesCid : ContractId AmuletRules instructionCid : ContractId BootstrapExternalPartyConfigStateInstruction openMiningRoundTriple : OpenMiningRoundTriple - sv : Party + sv : Party -- ^ sv operator party controller sv do - _ <- getAndValidateSvParty this (Some sv) + let svOperator = sv + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) _ <- fetchAndArchive (ForDso dso) instructionCid _ <- exercise amuletRulesCid AmuletRules_BootstrapExternalPartyConfigState with openMiningRoundTriple expectedDso = dso pure DsoRules_BootstrapExternalPartyConfigStateResult + choice DsoRules_MigrateToOnLedgerSvRightOwners : ContractId DsoRules + with + rightOwners : TextMap.TextMap SvRightOwnerInfo + controller dso + do + require "svRightOwners is not already on-ledger" (isNone this.svRightOwners) + require "Sum of SV weights does not change" + (sum (map (.svRewardWeight) (Map.values this.svs)) == sum [info.rewardWeight | (_, info) <- TextMap.toList rightOwners]) + forA_ (TextMap.toList rightOwners) $ \(rightOwnerName, info) -> do + create SvRightOwner with + dso + info + rightOwnerName + create this with + svs = Map.fromList ([(sv, info with svRewardWeight = 0) | (sv, info) <- Map.toList this.svs]) + svRightOwners = Some (map fst $ TextMap.toList rightOwners) + + nonconsuming choice DsoRules_UpdateRightOwnerParty : ContractId SvRightOwner + with + name : Text + svRightOwnerCid : ContractId SvRightOwner + oldRightOwnerParty : Party + newRightOwnerParty : Party + controller oldRightOwnerParty + do + requireOnLedgerSvRightOwners this + svRightOwner <- fetchAndArchive (ForSv with dso; svName = name) svRightOwnerCid + require "right owner parties match" (svRightOwner.info.rightOwnerParty == oldRightOwnerParty) + create svRightOwner with + info.rightOwnerParty = newRightOwnerParty + + choice DsoRules_UpdateBeneficiaries : ContractId SvRightOwner + with + name : Text + svRightOwnerCid : ContractId SvRightOwner + rightOwnerParty : Party + beneficiaries : [(Party, Decimal)] + controller rightOwnerParty + do + requireOnLedgerSvRightOwners this + svRightOwner <- fetchAndArchive (ForSv with dso; svName = name) svRightOwnerCid + require "right owner parties match" (svRightOwner.info.rightOwnerParty == rightOwnerParty) + create svRightOwner with + info.beneficiaries = beneficiaries + + nonconsuming choice DsoRules_UpdateSvRightOwnerInfo : ContractId SvRightOwner + with + name : Text + rightOwnercid : ContractId SvRightOwner + baseInfo : SvRightOwnerInfo -- ^ The info the vote was created against + newInfo : SvRightOwnerInfo -- ^ The target info, only fields that are different from baseInfo will be updated + controller dso + do + requireOnLedgerSvRightOwners this + rightOwner <- fetchAndArchive (ForSv with dso; svName = name) rightOwnercid + create rightOwner with + info = patch newInfo baseInfo rightOwner.info + + nonconsuming choice DsoRules_AddSvRightOwner : ContractId AddSvRightOwnerInstruction + with + rightOwnerName : Text + info : SvRightOwnerInfo + controller dso + do + requireOnLedgerSvRightOwners this + now <- getTime + if rightOwnerName `elem` getSvRightOwners this + then abort ("SV with name " <> rightOwnerName <> " already exists") + else + create AddSvRightOwnerInstruction with + dso + rightOwnerName + info + expiresAt = now `addRelTime` hours 1 + + choice DsoRules_ExecuteAddSvRightOwnerInstruction : ContractId DsoRules + with + instructionCid : ContractId AddSvRightOwnerInstruction + openMiningRoundCid : ContractId OpenMiningRound + svOperator : Party + controller svOperator + do + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) + requireOnLedgerSvRightOwners this + instruction <- fetchAndArchive (ForDso dso) instructionCid + openMiningRound <- fetchReferenceData (ForDso dso) openMiningRoundCid + if instruction.rightOwnerName `elem` getSvRightOwners this + then abort ("SV with name " <> instruction.rightOwnerName <> " already exists") + else do + createSvRightOwnerContracts this instruction.rightOwnerName (Some instruction.info) openMiningRound.round + create this with + svRightOwners = Some (instruction.rightOwnerName :: getSvRightOwners this) + + nonconsuming choice DsoRules_RemoveSvRightOwner : ContractId RemoveSvRightOwnerInstruction + with + rightOwnerName : Text + controller dso + do + requireOnLedgerSvRightOwners this + if rightOwnerName `elem` getSvRightOwners this + then do + now <- getTime + create RemoveSvRightOwnerInstruction with + dso + rightOwnerName + expiresAt = now `addRelTime` hours 1 + else abort ("No SV with name " <> show rightOwnerName) + + choice DsoRules_ExecuteRemoveSvRightOwnerInstruction : ContractId DsoRules + with + instructionCid : ContractId RemoveSvRightOwnerInstruction + rewardStateCid : ContractId SvRewardState + svRightOwnerCid : ContractId SvRightOwner + svOperator : Party + controller svOperator + do + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) + requireOnLedgerSvRightOwners this + instruction <- fetchAndArchive (ForDso dso) instructionCid + if instruction.rightOwnerName `elem` getSvRightOwners this + then do + -- We archive the reward state as part of offboarding to avoid having to track offboardedSvs for non-operators. + -- In theory reonboarding an SV immediately could let it mint rewards twice for the same round. + -- In practice, reonboarding that quickly seems unrealistic in practice. + _ <- fetchAndArchive (ForSv with dso; svName = instruction.rightOwnerName) rewardStateCid + _ <- fetchAndArchive (ForSv with dso; svName = instruction.rightOwnerName) svRightOwnerCid + create this with svRightOwners = Some (filter (/= instruction.rightOwnerName) (getSvRightOwners this)) + else abort ("No SV with name " <> show instruction.rightOwnerName) + + nonconsuming choice DsoRules_ExpireRemoveSvRightOwnerInstruction : () + with + instructionCid : ContractId RemoveSvRightOwnerInstruction + svOperator : Party + controller svOperator + do + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) + requireOnLedgerSvRightOwners this + instruction <- fetchAndArchive (ForDso dso) instructionCid + assertDeadlineExceeded "RemoveSvRightOwnerInstruction.expiresAt" instruction.expiresAt + pure () + + nonconsuming choice DsoRules_ExpireAddSvRightOwnerInstruction : () + with + instructionCid : ContractId AddSvRightOwnerInstruction + svOperator : Party + controller svOperator + do + _ <- getAndValidateSvNodeOperatorParty this (Some svOperator) + requireOnLedgerSvRightOwners this + instruction <- fetchAndArchive (ForDso dso) instructionCid + assertDeadlineExceeded "AddSvRightOwnerInstruction.expiresAt" instruction.expiresAt + pure () + + +template AddSvRightOwnerInstruction + with + dso : Party + rightOwnerName : Text + info : SvRightOwnerInfo + expiresAt : Time + where + signatory dso + +template RemoveSvRightOwnerInstruction + with + dso : Party + rightOwnerName : Text + expiresAt : Time + where + signatory dso + +instance HasCheckedFetch RemoveSvRightOwnerInstruction ForDso where + contractGroupId RemoveSvRightOwnerInstruction{..} = ForDso dso + +instance HasCheckedFetch AddSvRightOwnerInstruction ForDso where + contractGroupId AddSvRightOwnerInstruction{..} = ForDso dso pruneAtLeastOne : Ord t => t -> Schedule t a -> Optional (Schedule t a) pruneAtLeastOne now schedule = @@ -1764,25 +2086,26 @@ pruneAtLeastOne now schedule = where (past, future) = span (\(t, _) -> t <= now) schedule.futureValues -summarizeDso : DsoRules -> DsoSummary -summarizeDso dsoRules = DsoSummary with - dsoDelegate = dsoRules.dsoDelegate - numSvs - requiredNumVotes = - -- NOTE: - -- For a vote with n svs and f = floor((n - 1) /3) byzantine svs, we want to have the following properties: - -- *availability*: f operators abstaining, won’t stop the vote - -- ⇒ numRequiredVotes <= n - f - -- *tolerate DSO delegate selecting the votes*: the threshold must be independent of the number of votes cast - -- *integrity*: f operators cannot boost their voting power for future votes by collaborating - -- ⇒ implies f < threshold-for-accepting-an-action - -- *result acceptance*: outcome is accepted by SV operators - -- ⇒ we can pick between requiring numYays >= n / 2 + 1 (simple majority) and requiring numYays >= numRequiredVotes (super-majority) - -- We favor the following threshold that agrees with our preference of having both integrity and availability. - ceiling ((intToDecimal (numSvs + f + 1)) / 2.0) - where - numSvs = Map.size dsoRules.svs - f = floor ((intToDecimal (numSvs - 1)) / 3.0) +data VoteType = OperatorVote | RightOwnerVote deriving (Show, Eq) + +summarizeDso : VoteType -> TextMap.TextMap (ContractId SvRightOwner) -> DsoRules -> Update DsoSummaryV2 +summarizeDso voteType svRightOwnerCids dsoRules = do + votersWithWeight <- case voteType of + RightOwnerVote -> do + require "set of right owner cids matches the list of right owners" (sort (map fst (TextMap.toList svRightOwnerCids)) == sort (getSvRightOwners dsoRules)) + rightOwners <- forA (TextMap.toList svRightOwnerCids) $ \(name, rightOwnerCid) -> do + fetchChecked (ForSv with dso = dsoRules.dso; svName = name) rightOwnerCid + pure [(rightOwner.rightOwnerName, rightOwner.info.voteWeight) | rightOwner <- rightOwners, rightOwner.info.voteWeight > 0] + OperatorVote -> do + require "operator votes should not specify any right owner cids" (TextMap.null svRightOwnerCids) + pure [(info.name, 1) | (_, info) <- Map.toList dsoRules.svs] -- operators have weight 1 + let totalVoteWeight = sum (map snd votersWithWeight) + let f = floor ((intToDecimal (totalVoteWeight - 1)) / 3.0) + pure DsoSummaryV2 with + totalVoteWeight + requiredVoteWeight = + ceiling ((intToDecimal (totalVoteWeight + f + 1)) / 2.0) + votersWithWeight = TextMap.fromList votersWithWeight -- | Execute an action which requires certain number of confirmations from SVs. -- Each confirmed action can at most be executed once. @@ -1817,6 +2140,10 @@ executeActionRequiringConfirmation dso dsoRulesCid amuletRulesCid act = case act SRARC_CreateTransferCommandCounter choiceArg -> void $ exercise dsoRulesCid choiceArg SRARC_CreateUnallocatedUnclaimedActivityRecord choiceArg -> void $ exercise dsoRulesCid choiceArg SRARC_CreateBootstrapExternalPartyConfigStateInstruction choiceArg -> void $ exercise dsoRulesCid choiceArg + SRARC_DsoRules_UpdateSvRightOwnerInfo choiceArg -> void $ exercise dsoRulesCid choiceArg + SRARC_DsoRules_AddSvRightOwner choiceArg -> void $ exercise dsoRulesCid choiceArg + SRARC_DsoRules_RemoveSvRightOwner choiceArg -> void $ exercise dsoRulesCid choiceArg + SRARC_DsoRules_MigrateToOnLedgerSvRightOwners choiceArg -> void $ exercise dsoRulesCid choiceArg ARC_AnsEntryContext with .. -> do void $ fetchChecked (ForDso with dso) ansEntryContextCid case ansEntryContextAction of @@ -1880,53 +2207,58 @@ actionRequiringConfirmationEffectiveAt action = -- On- and offboarding ---------------------- -getSvInfo : Party -> DsoRules -> Update SvInfo -getSvInfo operator this = - optional (fail "Not a sv") pure $ Map.lookup operator this.svs +getSvInfoByOperatorParty : ActionFail m => Party -> DsoRules -> m (Text, SvInfo) +getSvInfoByOperatorParty operator this = + case Map.lookup operator this.svs of + None -> fail ("Not a sv operator: " <> show operator) + Some svInfo -> pure (svInfo.name, svInfo) -lookupSvInfoByName : Text -> DsoRules -> Optional (Party, SvInfo) -lookupSvInfoByName svName DsoRules{..} = +lookupSvOperatorInfoByName : Text -> DsoRules -> Optional (Party, SvInfo) +lookupSvOperatorInfoByName svName DsoRules{..} = find (\info -> info._2.name == svName) $ Map.toList svs -- | Returns True if an SV with that name is either currently onboarded -- or an SV with that name has been onboarded before and is now in offboardedSvs. svHasBeenOnboardedBefore : Text -> DsoRules -> Bool svHasBeenOnboardedBefore svName this = - isSome (lookupSvInfoByName svName this) || any (\info -> info.name == svName) (Map.values this.offboardedSvs) + isSome (lookupSvOperatorInfoByName svName this) || any (\info -> info.name == svName) (Map.values this.offboardedSvs) ensureNeverOperatedNode : Party -> DsoRules -> Update () ensureNeverOperatedNode newSvParty this = do require "SV party has not yet operated a node" $ not (newSvParty `Map.member` this.svs || newSvParty `Map.member` this.offboardedSvs) --- factored out from the choice to avoid mistakes from having the fields of DsoRules{..} in scope -dsoRules_addSv : DsoRules -> DsoRules_AddSv -> Update (ContractId DsoRules) -dsoRules_addSv this0 arg@DsoRules_AddSv{..} = do - ensureNeverOperatedNode newSvParty this0 +checkSvNotAlreadyOnboarded : DsoRules -> Text -> Update DsoRules +checkSvNotAlreadyOnboarded this svOperatorName = -- in DevNet we allow changing the operator of an existing sv, which we implement as a removal and re-addition - this@DsoRules{..} <- - if this0.isDevNet + if this.isDevNet then - let DsoRules{..} = this0 in -- bring all DsoRules fields into scope - case lookupSvInfoByName newSvName this0 of - None -> pure this0 - Some (sv, info) -> do + case lookupSvOperatorInfoByName svOperatorName this of + Some (sv, SvInfo{participantId}) -> do let offboardingInfo = OffboardedSvInfo with - name = info.name - participantId = info.participantId - pure $ this0 with - svs = Map.delete sv svs - offboardedSvs = Map.insert sv offboardingInfo offboardedSvs + name = svOperatorName + participantId + pure $ this with + offboardedSvs = Map.insert sv offboardingInfo this.offboardedSvs + svs = Map.delete sv this.svs + _ -> pure this else do - require "SV is not currently onboarded" (isNone $ lookupSvInfoByName newSvName this0) - pure this0 + require "SV is not currently onboarded" (isNone $ lookupSvOperatorInfoByName svOperatorName this) + pure this - -- create per-sv contracts if they have never been onboarded - unless (svHasBeenOnboardedBefore newSvName this) $ - createPerSvContracts this arg +-- factored out from the choice to avoid mistakes from having the fields of DsoRules{..} in scope +dsoRules_addSv : DsoRules -> DsoRules_AddSv -> Update (ContractId DsoRules) +dsoRules_addSv this0 DsoRules_AddSv{..} = do + ensureNeverOperatedNode newSvParty this0 + this@DsoRules{..} <- checkSvNotAlreadyOnboarded this0 newSvName + if onLedgerSvRightOwners this + then require "rewardWeight must be 0 when onboarding a new SV operator with on-ledger right owners" (newSvRewardWeight == 0) + else + unless (svHasBeenOnboardedBefore newSvName this) $ + createSvRightOwnerContracts this newSvName None joinedAsOfRound -- create per SV party contracts let initialAmuletPriceVote = None - createPerSvPartyContracts dso newSvParty newSvName noSynchronizerNodes initialAmuletPriceVote (getVoteCooldownTime config) + createSvOperatorContracts dso newSvParty newSvName noSynchronizerNodes initialAmuletPriceVote (getVoteCooldownTime config) -- register the new operator in the DsoRules let svInfo = SvInfo with name = newSvName @@ -1936,8 +2268,8 @@ dsoRules_addSv this0 arg@DsoRules_AddSv{..} = do create this with svs = Map.insert newSvParty svInfo svs -createPerSvContracts : DsoRules -> DsoRules_AddSv -> Update () -createPerSvContracts DsoRules{..} DsoRules_AddSv{..} = do +createSvRightOwnerContracts : DsoRules -> Text -> Optional SvRightOwnerInfo -> Round -> Update () +createSvRightOwnerContracts rules@DsoRules{..} newSvName rightOwnerInfo joinedAsOfRound = do void $ create SvRewardState with dso svName = newSvName @@ -1946,9 +2278,17 @@ createPerSvContracts DsoRules{..} DsoRules_AddSv{..} = do numRoundsMissed = 0 numRoundsCollected = 0 numCouponsIssued = 0 - -createPerSvPartyContracts : Party -> Party -> Text -> SynchronizerNodeConfigMap -> Optional Decimal -> RelTime -> Update () -createPerSvPartyContracts dso newSvParty newSvName synchronizerNodes amuletPrice voteCooldownTime = do + case rightOwnerInfo of + None -> requireNoOnLedgerSvRightOwners rules + Some info -> do + requireOnLedgerSvRightOwners rules + void $ create SvRightOwner with + dso + rightOwnerName = newSvName + info + +createSvOperatorContracts : Party -> Party -> Text -> SynchronizerNodeConfigMap -> Optional Decimal -> RelTime -> Update () +createSvOperatorContracts dso newSvParty newSvName synchronizerNodes amuletPrice voteCooldownTime = do -- Note: we currently track the amulet-price vote on a per operator basis. -- This implies it will be reset when an operator is offboarded and re-onboarded. now <- getTime @@ -1972,12 +2312,37 @@ createPerSvPartyContracts dso newSvParty newSvName synchronizerNodes amuletPrice state = NodeState with synchronizerNodes -getAndValidateSvParty : DsoRules -> Optional Party -> Update Party -getAndValidateSvParty _ None = fail "no SV party provided" -getAndValidateSvParty rules (Some sv) = do - require "SV party is an actual SV" (sv `Map.member` rules.svs) - pure sv - +getAndValidateSvNodeOperatorParty : DsoRules -> Optional Party -> Update Text +getAndValidateSvNodeOperatorParty _ None = fail "no SV operator party provided" +getAndValidateSvNodeOperatorParty rules (Some sv) = do + case Map.lookup sv rules.svs of + None -> fail ("SV party " <> show sv <> " is not a registered SV node operator") + Some svInfo -> pure svInfo.name + +getAndValidateSvRightOwnerParty : Optional (ContractId SvRightOwner) -> DsoRules -> Optional Party -> Update Text +getAndValidateSvRightOwnerParty _ _ None = fail "no SV right owner party provided" +getAndValidateSvRightOwnerParty rightOwnerCid rules (Some sv) = do + if onLedgerSvRightOwners rules + then + case rightOwnerCid of + None -> fail "no SV right owner contract id provided" + Some cid -> do + rightOwner <- fetchChecked (ForDso with dso = rules.dso) cid + require "SV right owner parties match" (rightOwner.info.rightOwnerParty == sv) + pure rightOwner.rightOwnerName + else do + require "Right owner cid is not specified when not using on-ledger right owners" (isNone rightOwnerCid) + case Map.lookup sv rules.svs of + None -> fail ("SV party " <> show sv <> " is not a right owner party") + Some info -> pure info.name + +getAndValidateVotingParty : Optional (ContractId SvRightOwner) -> DsoRules -> Party -> ActionRequiringConfirmation -> Update Text +getAndValidateVotingParty rightOwnerCid dsoRules party action = + case voteType action of + RightOwnerVote -> getAndValidateSvRightOwnerParty rightOwnerCid dsoRules (Some party) + OperatorVote -> do + require "Right owner cid is not specified for operator vote" (isNone rightOwnerCid) + getAndValidateSvNodeOperatorParty dsoRules (Some party) -- Rate limiting ---------------- @@ -2067,3 +2432,6 @@ instance Patchable LogicalSynchronizerUpgradeSchedule where upgradeTime = patch new.upgradeTime base.upgradeTime current.upgradeTime newPhysicalSynchronizerSerial = patch new.newPhysicalSynchronizerSerial base.newPhysicalSynchronizerSerial current.newPhysicalSynchronizerSerial newPhysicalSynchronizerProtocolVersion = patch new.newPhysicalSynchronizerProtocolVersion base.newPhysicalSynchronizerProtocolVersion current.newPhysicalSynchronizerProtocolVersion + +operatorParties : DsoRules -> [Party] +operatorParties DsoRules{svs} = Map.keys svs diff --git a/docs/gen-daml-docs.sh b/docs/gen-daml-docs.sh index ac5e208f7f..1fd1c1818e 100755 --- a/docs/gen-daml-docs.sh +++ b/docs/gen-daml-docs.sh @@ -47,6 +47,7 @@ DAML_PROJECT_FILES="\ -not -ipath '*splitwell*' \ -not -ipath '*app-manager*' \ -not -ipath '*dummy-holding*' \ + -not -ipath '*daml-ide-mono*' \ -print)" DAML_PROJECT_FILES=$(printf "%s\n" "$DAML_PROJECT_FILES" | grep -vf <(printf "%s\n" "${NON_COMPILED_DAML_PROJECTS[@]}" | xargs -n1 basename)) diff --git a/scripts/rename.sh b/scripts/rename.sh index 92ff142232..8fc9397d5e 100755 --- a/scripts/rename.sh +++ b/scripts/rename.sh @@ -1216,7 +1216,7 @@ function subcmd_no_illegal_daml_references() { ) for pattern in "${illegal_patterns[@]}"; do echo "Checking for occurences of '$pattern' (case sensitive, in code other than splitwell)" - if rg -P "$pattern" daml/ token-standard/ -g '!*/splitwell/*' -g '!*/splitwell-test/*' -g '!daml/dars.lock' -g '!token-standard/README.md' -g '!token-standard/V2_VALIDATION.md' -g '!token-standard/TOKEN_STANDARD_V2_DEVNET.md' -g '!*.json' -g '!token-standard/dependencies/*' -g '!**/target/'; then + if rg -P "$pattern" daml/ token-standard/ -g '!*/splitwell/*' -g '!*/splitwell-test/*' -g '!daml/dars.lock' -g '!token-standard/README.md' -g '!token-standard/V2_VALIDATION.md' -g '!token-standard/TOKEN_STANDARD_V2_DEVNET.md' -g'!daml/daml-ide-mono/README.md' -g '!*.json' -g '!token-standard/dependencies/*' -g '!**/target/'; then echo "$pattern occurs in Daml code (other than splitwell), remove all references" exit 1 fi diff --git a/scripts/setup-mono-package.sh b/scripts/setup-mono-package.sh new file mode 100755 index 0000000000..d7e8cc34f8 --- /dev/null +++ b/scripts/setup-mono-package.sh @@ -0,0 +1,34 @@ +#!/usr/bin/env bash + +# Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +# SPDX-License-Identifier: Apache-2.0 + +# Populate daml/daml-ide-mono/daml/ with per-file symlinks into every +# workspace Daml package's source tree. daml/daml-ide-mono/daml.yaml is +# checked in and static - this script only regenerates the source tree +# so that VS Code can work on the union as a single package. +# +# Re-run this any time a .daml file is added or removed anywhere in the +# workspace. + +set -euo pipefail + +repo=$(cd "$(dirname "$0")/.." && pwd) +dest="$repo/daml/daml-ide-mono/daml" + +rm -rf "$dest" +mkdir -p "$dest" + +for pkg in "$repo"/daml/*/daml.yaml \ + "$repo"/token-standard/*/daml.yaml \ + "$repo"/token-standard/examples/*/daml.yaml; do + src=$(dirname "$pkg")/daml + [ -d "$src" ] || continue + ( cd "$src" && find . -name '*.daml' -printf '%P\n' ) | + while IFS= read -r rel; do + link="$dest/$rel" + mkdir -p "$(dirname "$link")" + target=$(realpath --relative-to="$(dirname "$link")" "$src/$rel") + ln -sfn "$target" "$link" + done +done diff --git a/token-standard/splice-token-standard-utils/daml/Splice/TokenStandard/Utils/Internal/Allocations.daml b/token-standard/splice-token-standard-utils/daml/Splice/TokenStandard/Utils/Internal/Allocations.daml index 9ce6ef72f6..2085a3ae4e 100644 --- a/token-standard/splice-token-standard-utils/daml/Splice/TokenStandard/Utils/Internal/Allocations.daml +++ b/token-standard/splice-token-standard-utils/daml/Splice/TokenStandard/Utils/Internal/Allocations.daml @@ -53,6 +53,7 @@ module Splice.TokenStandard.Utils.Internal.Allocations ( -- ** SettlementFactory template implementations settlementFactoryV2_settleBatchDefaultImpl, + settlementFactoryV2_settleBatchDefaultImplNoSelf, fetchAndValidateAllocations, validateNextIterationArgs, @@ -374,7 +375,18 @@ settlementFactoryV2_settleBatchDefaultImpl -> ContractId AllocationV2.SettlementFactory -> AllocationV2.SettlementFactory_SettleBatch -> Update AllocationV2.SettlementFactory_SettleBatchResult -settlementFactoryV2_settleBatchDefaultImpl getFilteredExtraArgs admin self arg = do +settlementFactoryV2_settleBatchDefaultImpl getFilteredExtraArgs admin self arg = + settlementFactoryV2_settleBatchDefaultImplNoSelf getFilteredExtraArgs admin arg + +settlementFactoryV2_settleBatchDefaultImplNoSelf + : (AllocationV2.AllocationView -> AllocationV2.Allocation_Settle -> Update ExtraArgs) + -- ^ Function to compute the actual extra argument to use for settling an allocation. + -- Use this for example to redact unrelated choice-context data from the extra arguments. + -> Party + -- ^ Admin of the allocations and the settlement factory + -> AllocationV2.SettlementFactory_SettleBatch + -> Update AllocationV2.SettlementFactory_SettleBatchResult +settlementFactoryV2_settleBatchDefaultImplNoSelf getFilteredExtraArgs admin arg = do let AllocationV2.SettlementFactory_SettleBatch {..} = arg checkActors actors [settlement.executors] diff --git a/token-standard/splice-token-standard-utils/daml/Splice/TokenStandard/Utils/Internal/Conversions.daml b/token-standard/splice-token-standard-utils/daml/Splice/TokenStandard/Utils/Internal/Conversions.daml index 5fbcdd253a..60c19fb477 100644 --- a/token-standard/splice-token-standard-utils/daml/Splice/TokenStandard/Utils/Internal/Conversions.daml +++ b/token-standard/splice-token-standard-utils/daml/Splice/TokenStandard/Utils/Internal/Conversions.daml @@ -27,6 +27,8 @@ module Splice.TokenStandard.Utils.Internal.Conversions ( partiesToMeta, dropMeta, validateNoMeta, + encodeTime, + decodeTime, -- * Transfer utils reasonMetaKey, diff --git a/token-standard/splice-token-standard-v2-test/daml/Splice/Testing/Registries/AmuletRegistryV2.daml b/token-standard/splice-token-standard-v2-test/daml/Splice/Testing/Registries/AmuletRegistryV2.daml index 04a7817fff..92492103db 100644 --- a/token-standard/splice-token-standard-v2-test/daml/Splice/Testing/Registries/AmuletRegistryV2.daml +++ b/token-standard/splice-token-standard-v2-test/daml/Splice/Testing/Registries/AmuletRegistryV2.daml @@ -30,6 +30,10 @@ module Splice.Testing.Registries.AmuletRegistryV2 , getActiveOpenRoundsSorted , advanceToNextRoundChange , convertAllFeaturedAppActivityMarkers + + -- + , getExtAmuletRulesWithDisclosures + , getExternalPartyConfigStateContext ) where import DA.Action (unless, when) diff --git a/token-standard/splice-token-standard-v2-test/daml/Splice/Testing/TokenStandard/WalletClientV2.daml b/token-standard/splice-token-standard-v2-test/daml/Splice/Testing/TokenStandard/WalletClientV2.daml index 1327fc43e7..d15c0d0010 100644 --- a/token-standard/splice-token-standard-v2-test/daml/Splice/Testing/TokenStandard/WalletClientV2.daml +++ b/token-standard/splice-token-standard-v2-test/daml/Splice/Testing/TokenStandard/WalletClientV2.daml @@ -55,6 +55,7 @@ module Splice.Testing.TokenStandard.WalletClientV2 acceptAllocationInstructionV2, withdrawAllocationInstructionV2, withdrawAllocationV2, + withdrawAllocationV2Meta, allocateV1, withdrawAllocationInstructionV1, @@ -73,6 +74,7 @@ module Splice.Testing.TokenStandard.WalletClientV2 -- ** Allocations extractNextIterationAllocationCid, + extractAllocationResult, mkAllocationFactory_AllocateV2, mkAllocationInstruction_AcceptV2, @@ -469,6 +471,20 @@ withdrawAllocationV2 registries actor alloc = do batch <- mkAllocation_WithdrawV2 registries actor alloc executeSingletonTSABatch registries actor batch +-- | Simulate a V2 wallet withdrawing an allocation from a V2 app, with extra metadata +withdrawAllocationV2Meta + : MultiRegistry.MultiRegistry -> Party -> (ContractId V2.Allocation, V2.AllocationView) -> Metadata + -> Script BatchingUtilityV2.TokenStandardActionResult +withdrawAllocationV2Meta registries actor alloc meta = do + batch <- mkAllocation_WithdrawV2Meta registries actor alloc meta + executeSingletonTSABatch registries actor batch + +-- | Extract the underlying @AllocationResult@ from a wallet-client batch result. +extractAllocationResult : BatchingUtilityV2.TokenStandardActionResult -> V2.AllocationResult +extractAllocationResult (BatchingUtilityV2.TSAR_AllocationResultV2 r) = r +extractAllocationResult other = + error $ "expected TSAR_AllocationResultV2, got: " <> show other + -- | Simulate a V2 wallet withdrawing an allocation from a V1 app. withdrawAllocationV1 : MultiRegistry.MultiRegistry -> Party -> (ContractId V1.Allocation, V1.AllocationView) @@ -812,7 +828,10 @@ mkAllocationFactory_AllocateV2 registryV2 actor settlement allocation = do disclosures = enrichedChoice.disclosures mkAllocation_WithdrawV2 : MultiRegistry.MultiRegistry -> Party -> (ContractId V2.Allocation, V2.AllocationView) -> Script TSABatch -mkAllocation_WithdrawV2 registries actor (allocCid, allocView) = do +mkAllocation_WithdrawV2 registries actor (allocCid, allocView) = mkAllocation_WithdrawV2Meta registries actor (allocCid, allocView) emptyMetadata + +mkAllocation_WithdrawV2Meta : MultiRegistry.MultiRegistry -> Party -> (ContractId V2.Allocation, V2.AllocationView) -> Metadata -> Script TSABatch +mkAllocation_WithdrawV2Meta registries actor (allocCid, allocView) meta = do registry <- MultiRegistry.getRegistryApiV2 registries allocView.allocation.admin context <- V2.getAllocation_WithdrawContext registry allocCid emptyMetadata let withdrawRequest = BatchingUtilityV2.TSA_Allocation_WithdrawV2 BatchingUtilityV2.ChoiceCall with @@ -820,7 +839,7 @@ mkAllocation_WithdrawV2 registries actor (allocCid, allocView) = do arg = V2.Allocation_Withdraw with extraArgs = ExtraArgs with context = context.choiceContext - meta = emptyMetadata + meta actors = [actor] pure TSABatch with actions = [withdrawRequest]