From 6c8b68a3e72d48e28e61b6cb6efe3167e3c86220 Mon Sep 17 00:00:00 2001 From: "Jonathan D.K. Gibbons" Date: Tue, 14 Jul 2026 11:15:01 -0400 Subject: [PATCH 01/23] WIP of user-of-allocations code --- .../daml/Splice/AggregateLock.daml | 187 ++++++++++++++++++ 1 file changed, 187 insertions(+) create mode 100644 daml/splice-amulet/daml/Splice/AggregateLock.daml diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml new file mode 100644 index 0000000000..5ed0ef4eb7 --- /dev/null +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -0,0 +1,187 @@ +module Splice.AggregateLock where + +import Splice.Api.Token.AllocationV2 as V2 +import Splice.Api.Token.HoldingV2 (Account) +import Splice.Api.Token.MetadataV1 +import DA.TextMap as TM +import DA.Map as M + + +isValidAggregateLockedAllocation : Party -> V2.Allocation -> Bool +isValidAggregateLockedAllocation dso alloc = + True +-- alloc.allocation.admin = dso +-- && alloc.allocation. + +baseLockedMetadata = emptyMetadata +baseVestingMetadata = emptyMetadata + +type ControllerSets = [[Party]] + +controllerSetFromMeta : Text -> ControllerSets +controllerSetFromMeta = map partiesFromText . splitOn ";" + +data AggregateLocked = AggregateLocked with + unlockControllerSets : ControllerSets + substituteControllerSets : ControllerSets + +aggLockedAmuletFromMeta : Metadata -> Account -> AggregateLocked +aggLockedAmuletFromMeta meta acctParty = AggregateLocked with + unlockControllerSets = controllerSetFromMetaMap "cip-105/unlockControllerSets" + substituteControllerSets = controllerSetFromMetaMap "cip-105/substituteControllerSets" + where + controllerSetFromMetaMap key = controllerSetFromMeta $ fromOptional acctParty $ meta.values `TM.lookup` key + + +template AggregateLock + with + dso: Party + instrumentId : Text + allowImmediateUnlock : Bool + where + signatory dso + nonconsuming choice AggregateLock_Unlock : SettlementFactory_SettleBatchResult + with + factoryCid : ContractId SettlementFactory + lockedCid : ContractId Allocation + withdrawToCid : ContractId Allocation + authorizers : [ Party ] + amount : Decimal + where + controller authorizers + do + locked <- fetch lockedCid + withdrawTo <- fetch withdrawToCid + let ownerParty = fromSomeNote "Account must be basic" $ locked.allocation.authorizer.owner + let aggLockedAmulet = aggLockedAmuletFromMeta locked.meta ownerParty + require "Unlock controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) unlockControllerSets + require "Not allowed to unlock to a different party than locked the funds" $ locked.allocation.authorizer == withdrawTo.allocation.authorizer + if not allowImmediateUnlocks then require "Unlock without vesting is only allowed when specifically enabled" else pure () + require "Must be a valid goverance-locked allocation" $ isValidGovernanceLocked locked + require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination withdrawToCid + let + info = SettlementInfo with + executors = [ dso ] + id = "AggregateLock" + sid = self + transferLegId = "unlock" + + exercise factoryCid $ SettlementFactory_SettleBatch with + info + transferLegs = + [ TransferLeg with + transferLegId + sender = locked.authorizer + receiver = withdrawTo.authorizer + amount + instrumentId + meta = emptyMetadata + ] + allocations = + [ FinalizedAllocation with + allocationCid = locked + extraTransferLegSides = + [ TransferLegSide with + transferLegId + side = SenderSide + otherside = authorizer + amount + instrumentId + meta = baseLockedMetadata + ] + nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount + , FinalizedAllocation with + allocationCid = locked + extraTransferLegSides = + [ TransferLegSide with + transferLegId + side = SenderSide + otherside = authorizer + amount + instrumentId + meta = baseLockedMetadata + ] + nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount + ] + + nonconsuming choice AggregateLock_substitute : SettlementFactory_SettleBatchResult -- AggregateLock_SubstituteResult + with + factoryCid : ContractId SettlementFactory + unlockingCid : ContractId Allocation + fundsToLock : ContractId Allocation + lockingCid : ContractId Allocation + authorizers : [ Party ] + amount : Decimal + where + controller authorizers + do + unlocking <- fetch lockedCid + locking <- fetch withdrawToCid + let ownerParty = fromSomeNote "Account must be basic" $ locked.allocation.authorizer.owner + let aggLockedAmulet = aggLockedAmuletFromMeta locked.meta ownerParty + require "Substitute controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) substituteControllerSets + require "Not allowed to unlock to a different party than locked the funds" $ locked.allocation.authorizer == withdrawTo.allocation.authorizer + if not allowImmediateUnlocks then require "Unlock without vesting is only allowed when specifically enabled" else pure () + require "Must be a valid goverance-locked allocation" $ isValidGovernanceLocked locked + require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination withdrawToCid + let + info = SettlementInfo with + executors = [ dso ] + id = "AggregateLock" + sid = self + transferLegId = "unlock" + + exercise factoryCid AllocationFactory_SettleBatch with + info + transferLegs = + [ TransferLeg with + transferLegId + sender = locked.authorizer + receiver = locked.authorizer + amount + instrumentId + meta = emptyMetadata + , TransferLeg with + transferLegId + sender = locked.authorizer + receiver = locked.authorizer + amount + instrumentId + meta = emptyMetadata + ] + allocations = + [ FinalizedAllocation with + allocationCid = locked + extraTransferLegSides = + [ TransferLegSide with + transferLegId + side = SenderSide + otherside = authorizer + amount + instrumentId + meta = baseLockedMetadata + ] + nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount + , FinalizedAllocation with + allocationCid = locked + extraTransferLegSides = + [ TransferLegSide with + transferLegId + side = SenderSide + otherside = authorizer + amount + instrumentId + meta = baseLockedMetadata + ] + nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount + ] + + {- data AggregateLock_UnlockResult + = AggregateLock_UnlockResult_Vesting with + vesting : ContractId VestedAmulet + locked : ContractId AggregateLockedAmulet + | AggregateLock_UnlockResult_Immediate with + unlocked : ContractId Amulet + locked : ContractId AggregateLockedAmulet + deriving (Show) +-} From 63a9f458bba0ad3e522e3c27756ba1bda61466b7 Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Tue, 14 Jul 2026 19:25:44 +0000 Subject: [PATCH 02/23] WIP: Potentially fix some errors/imports --- .../daml/Splice/AggregateLock.daml | 62 ++++++++++++------- 1 file changed, 39 insertions(+), 23 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 5ed0ef4eb7..2abc8c2e84 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -3,8 +3,12 @@ module Splice.AggregateLock where import Splice.Api.Token.AllocationV2 as V2 import Splice.Api.Token.HoldingV2 (Account) import Splice.Api.Token.MetadataV1 -import DA.TextMap as TM +import Splice.Util + import DA.Map as M +import DA.Optional +import DA.Text +import DA.TextMap as TM isValidAggregateLockedAllocation : Party -> V2.Allocation -> Bool @@ -19,7 +23,7 @@ baseVestingMetadata = emptyMetadata type ControllerSets = [[Party]] controllerSetFromMeta : Text -> ControllerSets -controllerSetFromMeta = map partiesFromText . splitOn ";" +controllerSetFromMeta = map partyFromText . splitOn ";" data AggregateLocked = AggregateLocked with unlockControllerSets : ControllerSets @@ -56,18 +60,22 @@ template AggregateLock let aggLockedAmulet = aggLockedAmuletFromMeta locked.meta ownerParty require "Unlock controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) unlockControllerSets require "Not allowed to unlock to a different party than locked the funds" $ locked.allocation.authorizer == withdrawTo.allocation.authorizer - if not allowImmediateUnlocks then require "Unlock without vesting is only allowed when specifically enabled" else pure () + if not allowImmediateUnlock then require "Unlock without vesting is only allowed when specifically enabled" else pure () + -- TODO: What is isValidGovernanceLocked? require "Must be a valid goverance-locked allocation" $ isValidGovernanceLocked locked require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination withdrawToCid let info = SettlementInfo with executors = [ dso ] - id = "AggregateLock" - sid = self + id = "AggregateLock_Unlock" + cid = Some self + meta = emptyMetadata transferLegId = "unlock" exercise factoryCid $ SettlementFactory_SettleBatch with - info + settlement = info + actors = [ dso ] + extraArgs = ExtraArgs emptyChoiceContext emptyMetadata transferLegs = [ TransferLeg with transferLegId @@ -89,6 +97,7 @@ template AggregateLock instrumentId meta = baseLockedMetadata ] + -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount , FinalizedAllocation with allocationCid = locked @@ -101,10 +110,11 @@ template AggregateLock instrumentId meta = baseLockedMetadata ] + -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount ] - nonconsuming choice AggregateLock_substitute : SettlementFactory_SettleBatchResult -- AggregateLock_SubstituteResult + nonconsuming choice AggregateLock_Substitute : SettlementFactory_SettleBatchResult -- AggregateLock_SubstituteResult with factoryCid : ContractId SettlementFactory unlockingCid : ContractId Allocation @@ -117,41 +127,45 @@ template AggregateLock do unlocking <- fetch lockedCid locking <- fetch withdrawToCid - let ownerParty = fromSomeNote "Account must be basic" $ locked.allocation.authorizer.owner - let aggLockedAmulet = aggLockedAmuletFromMeta locked.meta ownerParty + let ownerParty = fromSomeNote "Account must be basic" $ unlocking.allocation.authorizer.owner + let aggLockedAmulet = aggLockedAmuletFromMeta unlocking.meta ownerParty require "Substitute controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) substituteControllerSets - require "Not allowed to unlock to a different party than locked the funds" $ locked.allocation.authorizer == withdrawTo.allocation.authorizer - if not allowImmediateUnlocks then require "Unlock without vesting is only allowed when specifically enabled" else pure () - require "Must be a valid goverance-locked allocation" $ isValidGovernanceLocked locked + require "Not allowed to unlock to a different party than locked the funds" $ unlocking.allocation.authorizer == withdrawTo.allocation.authorizer + if not allowImmediateUnlock then require "Unlock without vesting is only allowed when specifically enabled" else pure () + -- TODO: What is isValidGovernanceLocked? + require "Must be a valid goverance-locked allocation" $ isValidGovernanceLocked unlocking require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination withdrawToCid let info = SettlementInfo with executors = [ dso ] - id = "AggregateLock" - sid = self - transferLegId = "unlock" + id = "AggregateLock_substitute" + cid = Some self + meta = emptyMetadata + transferLegId = "substitute" - exercise factoryCid AllocationFactory_SettleBatch with - info + exercise factoryCid SettlementFactory_SettleBatch with + settlement = info + actors = [dso] + extraArgs = ExtraArgs emptyChoiceContext emptyMetadata transferLegs = [ TransferLeg with transferLegId - sender = locked.authorizer - receiver = locked.authorizer + sender = unlocking.authorizer + receiver = unlocking.authorizer amount instrumentId meta = emptyMetadata , TransferLeg with transferLegId - sender = locked.authorizer - receiver = locked.authorizer + sender = unlocking.authorizer + receiver = unlocking.authorizer amount instrumentId meta = emptyMetadata ] allocations = [ FinalizedAllocation with - allocationCid = locked + allocationCid = unlocking extraTransferLegSides = [ TransferLegSide with transferLegId @@ -161,9 +175,10 @@ template AggregateLock instrumentId meta = baseLockedMetadata ] + -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount , FinalizedAllocation with - allocationCid = locked + allocationCid = unlocking extraTransferLegSides = [ TransferLegSide with transferLegId @@ -173,6 +188,7 @@ template AggregateLock instrumentId meta = baseLockedMetadata ] + -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount ] From 082ca6f525b99310f3bc88768fad659ef2b42c41 Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Tue, 14 Jul 2026 20:53:37 +0000 Subject: [PATCH 03/23] WIP correct some more fields and functions --- .../daml/Splice/AggregateLock.daml | 37 +++++++++++-------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 2abc8c2e84..85fa67daa4 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -5,20 +5,29 @@ import Splice.Api.Token.HoldingV2 (Account) import Splice.Api.Token.MetadataV1 import Splice.Util -import DA.Map as M +import qualified DA.Map as M import DA.Optional import DA.Text -import DA.TextMap as TM +import qualified DA.TextMap as TM isValidAggregateLockedAllocation : Party -> V2.Allocation -> Bool isValidAggregateLockedAllocation dso alloc = - True --- alloc.allocation.admin = dso --- && alloc.allocation. + and [ alloc.allocation.admin == dso + , alloc.allocation.committed + , null alloc.allocation.transferLegSides + , TM.lookup alloc.allocation.meta.values "cip-105/type" == Some "aggregateLock" + , alloc.allocation.expiresAt == Some maxBound + ] -baseLockedMetadata = emptyMetadata -baseVestingMetadata = emptyMetadata +isValidVestingLockedDestination : Party -> V2.Allocation -> Bool +isValidVestingLockedDestination dso alloc = + and [ alloc.allocation.admin == dso + , alloc.allocation.committed + , null alloc.allocation.transferLegSides + , TM.lookup alloc.allocation.meta.values "cip-105/type" == Some "aggregateLock" + , alloc.allocation.expiresAt == Some maxBound + ] type ControllerSets = [[Party]] @@ -61,8 +70,7 @@ template AggregateLock require "Unlock controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) unlockControllerSets require "Not allowed to unlock to a different party than locked the funds" $ locked.allocation.authorizer == withdrawTo.allocation.authorizer if not allowImmediateUnlock then require "Unlock without vesting is only allowed when specifically enabled" else pure () - -- TODO: What is isValidGovernanceLocked? - require "Must be a valid goverance-locked allocation" $ isValidGovernanceLocked locked + require "Must be a valid governance-locked allocation" $ isValidAggregateLockedAllocation locked require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination withdrawToCid let info = SettlementInfo with @@ -95,7 +103,7 @@ template AggregateLock otherside = authorizer amount instrumentId - meta = baseLockedMetadata + meta = emptyMetadata ] -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount @@ -108,7 +116,7 @@ template AggregateLock otherside = authorizer amount instrumentId - meta = baseLockedMetadata + meta = emptyMetadata ] -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount @@ -132,8 +140,7 @@ template AggregateLock require "Substitute controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) substituteControllerSets require "Not allowed to unlock to a different party than locked the funds" $ unlocking.allocation.authorizer == withdrawTo.allocation.authorizer if not allowImmediateUnlock then require "Unlock without vesting is only allowed when specifically enabled" else pure () - -- TODO: What is isValidGovernanceLocked? - require "Must be a valid goverance-locked allocation" $ isValidGovernanceLocked unlocking + require "Must be a valid goverance-locked allocation" $ isValidAggregateLockedAllocation unlocking require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination withdrawToCid let info = SettlementInfo with @@ -173,7 +180,7 @@ template AggregateLock otherside = authorizer amount instrumentId - meta = baseLockedMetadata + meta = emptyMetadata ] -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount @@ -186,7 +193,7 @@ template AggregateLock otherside = authorizer amount instrumentId - meta = baseLockedMetadata + meta = emptyMetadata ] -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount From dcd3af3e4706ed8f1b8fd3083dbab8f36eef198b Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Tue, 14 Jul 2026 21:26:12 +0000 Subject: [PATCH 04/23] WIP fixing type errors in AggregageLock.daml --- .../daml/Splice/AggregateLock.daml | 32 +++++++++++-------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 85fa67daa4..8305d5c371 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -16,7 +16,7 @@ isValidAggregateLockedAllocation dso alloc = and [ alloc.allocation.admin == dso , alloc.allocation.committed , null alloc.allocation.transferLegSides - , TM.lookup alloc.allocation.meta.values "cip-105/type" == Some "aggregateLock" + , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "aggregateLock" , alloc.allocation.expiresAt == Some maxBound ] @@ -25,14 +25,17 @@ isValidVestingLockedDestination dso alloc = and [ alloc.allocation.admin == dso , alloc.allocation.committed , null alloc.allocation.transferLegSides - , TM.lookup alloc.allocation.meta.values "cip-105/type" == Some "aggregateLock" + , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "aggregateLock" , alloc.allocation.expiresAt == Some maxBound ] type ControllerSets = [[Party]] -controllerSetFromMeta : Text -> ControllerSets -controllerSetFromMeta = map partyFromText . splitOn ";" +partiesFromText : Text -> Optional [Party] +partiesFromText = mapA partyFromText . splitOn "," + +controllerSetFromMeta : Text -> Optional ControllerSets +controllerSetFromMeta = mapA partiesFromText . splitOn ";" data AggregateLocked = AggregateLocked with unlockControllerSets : ControllerSets @@ -72,6 +75,7 @@ template AggregateLock if not allowImmediateUnlock then require "Unlock without vesting is only allowed when specifically enabled" else pure () require "Must be a valid governance-locked allocation" $ isValidAggregateLockedAllocation locked require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination withdrawToCid + require "Must have amounts reserved within the next settlement iteration" $ isSome locked.allocation.nextIterationFunding let info = SettlementInfo with executors = [ dso ] @@ -80,6 +84,10 @@ template AggregateLock meta = emptyMetadata transferLegId = "unlock" + newLockedAmount <- case locked.allocation.nextIterationFunding of + Some a -> pure $ a - amount + None -> require "Must have amounts reserved within the next settlement iteration" False + exercise factoryCid $ SettlementFactory_SettleBatch with settlement = info actors = [ dso ] @@ -95,7 +103,7 @@ template AggregateLock ] allocations = [ FinalizedAllocation with - allocationCid = locked + allocationCid = lockedCid extraTransferLegSides = [ TransferLegSide with transferLegId @@ -105,10 +113,9 @@ template AggregateLock instrumentId meta = emptyMetadata ] - -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount , FinalizedAllocation with - allocationCid = locked + allocationCid = withdrawToCid extraTransferLegSides = [ TransferLegSide with transferLegId @@ -118,10 +125,9 @@ template AggregateLock instrumentId meta = emptyMetadata ] - -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount ] - +{- nonconsuming choice AggregateLock_Substitute : SettlementFactory_SettleBatchResult -- AggregateLock_SubstituteResult with factoryCid : ContractId SettlementFactory @@ -134,7 +140,7 @@ template AggregateLock controller authorizers do unlocking <- fetch lockedCid - locking <- fetch withdrawToCid + withdrawTo <- fetch withdrawToCid let ownerParty = fromSomeNote "Account must be basic" $ unlocking.allocation.authorizer.owner let aggLockedAmulet = aggLockedAmuletFromMeta unlocking.meta ownerParty require "Substitute controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) substituteControllerSets @@ -172,7 +178,7 @@ template AggregateLock ] allocations = [ FinalizedAllocation with - allocationCid = unlocking + allocationCid = unlockingCid extraTransferLegSides = [ TransferLegSide with transferLegId @@ -185,7 +191,7 @@ template AggregateLock -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount , FinalizedAllocation with - allocationCid = unlocking + allocationCid = unlockingCid extraTransferLegSides = [ TransferLegSide with transferLegId @@ -198,7 +204,7 @@ template AggregateLock -- TODO: what's newLockedAmount nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount ] - +-} {- data AggregateLock_UnlockResult = AggregateLock_UnlockResult_Vesting with vesting : ContractId VestedAmulet From 5b426568154613f69e09b16984b7352b49eac1a6 Mon Sep 17 00:00:00 2001 From: "Jonathan D.K. Gibbons" Date: Wed, 15 Jul 2026 00:38:28 +0000 Subject: [PATCH 05/23] WIP: externally-defined governance lock implementation using V2 allocations. --- .../daml/Splice/AggregateLock.daml | 147 ++++-------------- 1 file changed, 33 insertions(+), 114 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 8305d5c371..292f85372a 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -1,32 +1,30 @@ module Splice.AggregateLock where import Splice.Api.Token.AllocationV2 as V2 -import Splice.Api.Token.HoldingV2 (Account) import Splice.Api.Token.MetadataV1 import Splice.Util -import qualified DA.Map as M import DA.Optional import DA.Text import qualified DA.TextMap as TM -isValidAggregateLockedAllocation : Party -> V2.Allocation -> Bool +isValidAggregateLockedAllocation : Party -> V2.AllocationView -> Bool isValidAggregateLockedAllocation dso alloc = and [ alloc.allocation.admin == dso , alloc.allocation.committed , null alloc.allocation.transferLegSides , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "aggregateLock" - , alloc.allocation.expiresAt == Some maxBound + , alloc.expiresAt == Some maxBound ] -isValidVestingLockedDestination : Party -> V2.Allocation -> Bool +isValidVestingLockedDestination : Party -> V2.AllocationView -> Bool isValidVestingLockedDestination dso alloc = and [ alloc.allocation.admin == dso , alloc.allocation.committed , null alloc.allocation.transferLegSides , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "aggregateLock" - , alloc.allocation.expiresAt == Some maxBound + , alloc.expiresAt == Some maxBound ] type ControllerSets = [[Party]] @@ -37,18 +35,25 @@ partiesFromText = mapA partyFromText . splitOn "," controllerSetFromMeta : Text -> Optional ControllerSets controllerSetFromMeta = mapA partiesFromText . splitOn ";" -data AggregateLocked = AggregateLocked with +data GovernanceLockedControllers = GovernanceLockedControllers with unlockControllerSets : ControllerSets substituteControllerSets : ControllerSets -aggLockedAmuletFromMeta : Metadata -> Account -> AggregateLocked -aggLockedAmuletFromMeta meta acctParty = AggregateLocked with +governanceLockedControllersFromMeta : Metadata -> Party -> GovernanceLockedControllers +governanceLockedControllersFromMeta meta acctParty = GovernanceLockedControllers with unlockControllerSets = controllerSetFromMetaMap "cip-105/unlockControllerSets" substituteControllerSets = controllerSetFromMetaMap "cip-105/substituteControllerSets" where - controllerSetFromMetaMap key = controllerSetFromMeta $ fromOptional acctParty $ meta.values `TM.lookup` key + controllerSetFromMetaMap key = fromOptional [[acctParty]] $ controllerSetFromMeta =<< key `TM.lookup` meta.values +-- | The intention is to treat the overall aggregate lock for a SV as if it is +-- "the settlement" for the allocations locked to it, and use iterated +-- settlement to execute updates on the committed allocations as needed. +-- This approach would permit most of the specific governance locking and +-- vesting to be in a separate dar from amulet only needed for SVs and +-- interested observers. + template AggregateLock with dso: Party @@ -66,27 +71,28 @@ template AggregateLock where controller authorizers do - locked <- fetch lockedCid - withdrawTo <- fetch withdrawToCid - let ownerParty = fromSomeNote "Account must be basic" $ locked.allocation.authorizer.owner - let aggLockedAmulet = aggLockedAmuletFromMeta locked.meta ownerParty + locked <- view <$> fetch lockedCid + withdrawTo <- view <$> fetch withdrawToCid + ownerParty <- whenNone locked.allocation.authorizer.owner $ + assertFail "The requirement 'governance locked allocations must be owned by basic accounts' was not met" + let GovernanceLockedControllers{..} = governanceLockedControllersFromMeta locked.meta ownerParty require "Unlock controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) unlockControllerSets require "Not allowed to unlock to a different party than locked the funds" $ locked.allocation.authorizer == withdrawTo.allocation.authorizer - if not allowImmediateUnlock then require "Unlock without vesting is only allowed when specifically enabled" else pure () - require "Must be a valid governance-locked allocation" $ isValidAggregateLockedAllocation locked - require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination withdrawToCid + if not allowImmediateUnlock then require "Unlock without vesting is only allowed when specifically enabled" False else pure () + require "Must be a valid governance-locked allocation" $ isValidAggregateLockedAllocation dso locked + require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination dso withdrawTo require "Must have amounts reserved within the next settlement iteration" $ isSome locked.allocation.nextIterationFunding let info = SettlementInfo with executors = [ dso ] id = "AggregateLock_Unlock" - cid = Some self + cid = Some $ coerceContractId self meta = emptyMetadata transferLegId = "unlock" - newLockedAmount <- case locked.allocation.nextIterationFunding of - Some a -> pure $ a - amount - None -> require "Must have amounts reserved within the next settlement iteration" False + currentLockedAmount <- whenNone (locked.allocation.nextIterationFunding >>= TM.lookup instrumentId) $ + assertFail "The requirement 'Must have amounts reserved within the next settlement iteration' was not met" + let newLockedAmount = currentLockedAmount - amount exercise factoryCid $ SettlementFactory_SettleBatch with settlement = info @@ -95,8 +101,8 @@ template AggregateLock transferLegs = [ TransferLeg with transferLegId - sender = locked.authorizer - receiver = withdrawTo.authorizer + sender = locked.allocation.authorizer + receiver = withdrawTo.allocation.authorizer amount instrumentId meta = emptyMetadata @@ -108,109 +114,22 @@ template AggregateLock [ TransferLegSide with transferLegId side = SenderSide - otherside = authorizer + otherside = withdrawTo.allocation.authorizer amount instrumentId meta = emptyMetadata ] - nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount + nextIterationFunding = Some $ TM.singleton instrumentId newLockedAmount , FinalizedAllocation with allocationCid = withdrawToCid extraTransferLegSides = [ TransferLegSide with transferLegId side = SenderSide - otherside = authorizer - amount - instrumentId - meta = emptyMetadata - ] - nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount - ] -{- - nonconsuming choice AggregateLock_Substitute : SettlementFactory_SettleBatchResult -- AggregateLock_SubstituteResult - with - factoryCid : ContractId SettlementFactory - unlockingCid : ContractId Allocation - fundsToLock : ContractId Allocation - lockingCid : ContractId Allocation - authorizers : [ Party ] - amount : Decimal - where - controller authorizers - do - unlocking <- fetch lockedCid - withdrawTo <- fetch withdrawToCid - let ownerParty = fromSomeNote "Account must be basic" $ unlocking.allocation.authorizer.owner - let aggLockedAmulet = aggLockedAmuletFromMeta unlocking.meta ownerParty - require "Substitute controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) substituteControllerSets - require "Not allowed to unlock to a different party than locked the funds" $ unlocking.allocation.authorizer == withdrawTo.allocation.authorizer - if not allowImmediateUnlock then require "Unlock without vesting is only allowed when specifically enabled" else pure () - require "Must be a valid goverance-locked allocation" $ isValidAggregateLockedAllocation unlocking - require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination withdrawToCid - let - info = SettlementInfo with - executors = [ dso ] - id = "AggregateLock_substitute" - cid = Some self - meta = emptyMetadata - transferLegId = "substitute" - - exercise factoryCid SettlementFactory_SettleBatch with - settlement = info - actors = [dso] - extraArgs = ExtraArgs emptyChoiceContext emptyMetadata - transferLegs = - [ TransferLeg with - transferLegId - sender = unlocking.authorizer - receiver = unlocking.authorizer - amount - instrumentId - meta = emptyMetadata - , TransferLeg with - transferLegId - sender = unlocking.authorizer - receiver = unlocking.authorizer - amount - instrumentId - meta = emptyMetadata - ] - allocations = - [ FinalizedAllocation with - allocationCid = unlockingCid - extraTransferLegSides = - [ TransferLegSide with - transferLegId - side = SenderSide - otherside = authorizer - amount - instrumentId - meta = emptyMetadata - ] - -- TODO: what's newLockedAmount - nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount - , FinalizedAllocation with - allocationCid = unlockingCid - extraTransferLegSides = - [ TransferLegSide with - transferLegId - side = SenderSide - otherside = authorizer + otherside = locked.allocation.authorizer amount instrumentId meta = emptyMetadata ] - -- TODO: what's newLockedAmount - nextIterationFunding = Some $ M.singleton instrumentId newLockedAmount + nextIterationFunding = Some $ TM.singleton instrumentId newLockedAmount ] --} - {- data AggregateLock_UnlockResult - = AggregateLock_UnlockResult_Vesting with - vesting : ContractId VestedAmulet - locked : ContractId AggregateLockedAmulet - | AggregateLock_UnlockResult_Immediate with - unlocked : ContractId Amulet - locked : ContractId AggregateLockedAmulet - deriving (Show) --} From 101c58b5011aa1f07c5da581cc206f2b823e2059 Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Wed, 15 Jul 2026 21:47:15 +0000 Subject: [PATCH 06/23] WIP: Converting Vesting state to use the V2 Allocations --- .../daml/Splice/AggregateLock.daml | 48 +++++++++++++++++-- .../TestTokenV2/TestAllocationHappyV2.daml | 27 +++++++++++ .../Utils/Internal/Conversions.daml | 3 ++ 3 files changed, 75 insertions(+), 3 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 292f85372a..967ba2014e 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -2,12 +2,13 @@ module Splice.AggregateLock where import Splice.Api.Token.AllocationV2 as V2 import Splice.Api.Token.MetadataV1 +import Splice.TokenStandard.Utils.Internal.Conversions (decodeTime) import Splice.Util import DA.Optional import DA.Text import qualified DA.TextMap as TM - +import DA.Time isValidAggregateLockedAllocation : Party -> V2.AllocationView -> Bool isValidAggregateLockedAllocation dso alloc = @@ -23,9 +24,13 @@ isValidVestingLockedDestination dso alloc = and [ alloc.allocation.admin == dso , alloc.allocation.committed , null alloc.allocation.transferLegSides - , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "aggregateLock" + , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "vestingLock" , alloc.expiresAt == Some maxBound + , TM.member "cip-105/vestingLock.startDate" metaValues + , TM.member "cip-105/vestingLock.endDate" metaValues + -- TODO: Check the period is valid, check startDate < endDate ] + where metaValues = alloc.allocation.meta.values type ControllerSets = [[Party]] @@ -46,6 +51,26 @@ governanceLockedControllersFromMeta meta acctParty = GovernanceLockedControllers where controllerSetFromMetaMap key = fromOptional [[acctParty]] $ controllerSetFromMeta =<< key `TM.lookup` meta.values +calculateAvailableWithdrawAmount : Time -> V2.AllocationView -> Decimal -> Decimal +calculateAvailableWithdrawAmount currentDateTime alloc nextIterationFundAmount = max 0.0 availAmount + where + availAmount = if currentDateTime >= endDate + then nextIterationFundAmount + else 0.0 + -- (initialAmount * totalVestedPercentageElapsed) - withdrawnAmount + meta = alloc.allocation.meta.values + -- The initial amount represents the total that was locked initially when thrown into vesting state + initialAmount = fromSome $ TM.lookup "cip-105/vestingLock.initialAmount" meta + startDate = decodeTime . fromSome $ TM.lookup "cip-105/vestingLock.startDate" meta + endDate = decodeTime . fromSome $ TM.lookup "cip-105/vestingLock.endDate" meta + --totalUnlockPeriod = intToDecimal . convertRelTimeToMicroseconds $ subTime endDate startDate + --unlockPeriodElapsed = intToDecimal . convertRelTimeToMicroseconds $ subTime currentDateTime startDate + --totalVestedPercentageElapsed : Decimal = unlockPeriodElapsed / totalUnlockPeriod + --withdrawnAmount = initialAmount - nextIterationFundAmount + + + + -- | The intention is to treat the overall aggregate lock for a SV as if it is -- "the settlement" for the allocations locked to it, and use iterated @@ -131,5 +156,22 @@ template AggregateLock instrumentId meta = emptyMetadata ] - nextIterationFunding = Some $ TM.singleton instrumentId newLockedAmount + nextIterationFunding = Some $ TM.singleton instrumentId amount ] + -- Choice temporarily lives here and it will be moved, testing/draft purposes atm + nonconsuming choice VestingLock_Withdraw : () -- AllocationResult + with + authorizers : [Party] + vestingLockCid : ContractId Allocation + where + controller authorizers + do + -- remainingLocked stays in nextIterationFunding + vestingLock <- view <$> fetch vestingLockCid + + require "There are no remaining funds to withdraw" + $ isSome vestingLock.allocation.nextIterationFunding + require "There must be an initialAmount set for the vestingLock" + $ TM.member "cip-105/vestingLock.initialAmount" vestingLock.allocation.meta.values + + pure () diff --git a/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml b/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml index 43cb979150..9fc600beaa 100644 --- a/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml +++ b/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml @@ -10,6 +10,7 @@ import DA.Assert import DA.List (sort) import DA.Map qualified as Map import DA.TextMap qualified as TextMap +import DA.Time (addRelTime, days, hours) import Daml.Script @@ -24,6 +25,7 @@ import Splice.Testing.Tokens.TestTokenV2 qualified as TestTokenV2 import Splice.Testing.Utils import Splice.Testing.Registries.TestTokenV2_RegistryV2 qualified as TestTokenRegistryV2 +import Splice.TokenStandard.Utils.Internal.Conversions (encodeTime) import Splice.Testing.TokenStandard.RegistryApiV2 qualified as V2 import Splice.Testing.TokenStandard.WalletClientV2 qualified as WalletClientV2 import Splice.Testing.TokenStandard.MultiRegistry qualified as MultiRegistry @@ -45,6 +47,31 @@ test_allocation_WithdrawV2 = test_allocation_withdrawCancel_generic $ \TestEnv { meta = emptyMetadata pure () +-- This is a temporary test script +test_vesting_lock_WithdrawV2 : Script () +test_vesting_lock_WithdrawV2 = do + TestEnv {..} <- setupTest + now <- getTime + let endDate : Time = addRelTime now $ (days 365) + (hours 6) + vestingInitialAmount : Decimal = 3652.5 + + let allocationV2 = V2.AllocationSpecification with + admin = instrId.admin + authorizer = TSU.basicAccount alice + transferLegSides = [] + committed = False + nextIterationFunding = Some $ TextMap.fromList [(instrId.id, vestingInitialAmount)] + settlementDeadline = None + meta = Metadata with + values = TextMap.fromList + [ ("cip-105/type", "vestingLock") + , ("cip-105/vestingLock.initialAmount", show vestingInitialAmount) + , ("cip-105/vestingLock.startDate", encodeTime now) + , ("cip-105/vestingLock.endDate", encodeTime endDate) + ] + + pure () + -- TODO(tech-debt): add support for dealing with stale references to locked tokens -- -- Handle them analogous to how Amulet handles them and copy the relevant tests from Amulet. 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..1e70ba6c5c 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,9 @@ module Splice.TokenStandard.Utils.Internal.Conversions ( partiesToMeta, dropMeta, validateNoMeta, + -- TODO: Is exporting the below cool? + encodeTime, + decodeTime, -- * Transfer utils reasonMetaKey, From cbf22de75aae8769bebacb94b06351e92ee35df7 Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Thu, 16 Jul 2026 20:05:06 +0000 Subject: [PATCH 07/23] WIP Fixing withdrawing from VestingLock choice --- .../daml/Splice/AggregateLock.daml | 87 +++++++++++++++---- 1 file changed, 71 insertions(+), 16 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 967ba2014e..3d6d014f68 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -51,25 +51,24 @@ governanceLockedControllersFromMeta meta acctParty = GovernanceLockedControllers where controllerSetFromMetaMap key = fromOptional [[acctParty]] $ controllerSetFromMeta =<< key `TM.lookup` meta.values -calculateAvailableWithdrawAmount : Time -> V2.AllocationView -> Decimal -> Decimal -calculateAvailableWithdrawAmount currentDateTime alloc nextIterationFundAmount = max 0.0 availAmount +-- 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 - else 0.0 - -- (initialAmount * totalVestedPercentageElapsed) - withdrawnAmount + 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 = fromSome $ TM.lookup "cip-105/vestingLock.initialAmount" meta - startDate = decodeTime . fromSome $ TM.lookup "cip-105/vestingLock.startDate" meta - endDate = decodeTime . fromSome $ TM.lookup "cip-105/vestingLock.endDate" meta - --totalUnlockPeriod = intToDecimal . convertRelTimeToMicroseconds $ subTime endDate startDate - --unlockPeriodElapsed = intToDecimal . convertRelTimeToMicroseconds $ subTime currentDateTime startDate - --totalVestedPercentageElapsed : Decimal = unlockPeriodElapsed / totalUnlockPeriod - --withdrawnAmount = initialAmount - nextIterationFundAmount - - - + 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 -- | The intention is to treat the overall aggregate lock for a SV as if it is @@ -159,8 +158,10 @@ template AggregateLock nextIterationFunding = Some $ TM.singleton instrumentId amount ] -- Choice temporarily lives here and it will be moved, testing/draft purposes atm - nonconsuming choice VestingLock_Withdraw : () -- AllocationResult + -- Note: this whole choice is WIP + nonconsuming choice VestingLock_Withdraw : () -- TODO: Return type possibly AllocationResult with + factoryCid : ContractId SettlementFactory authorizers : [Party] vestingLockCid : ContractId Allocation where @@ -168,10 +169,64 @@ template AggregateLock do -- remainingLocked stays in nextIterationFunding vestingLock <- view <$> fetch vestingLockCid + now <- getTime + -- TODO: Probably add valid unlockController set check? + -- TODO: Potentially do case statement with nextIterationFunding optionals require "There are no remaining funds to withdraw" $ isSome vestingLock.allocation.nextIterationFunding + + let mNextIterationFunding = TM.lookup instrumentId $ fromSome vestingLock.allocation.nextIterationFunding + require ("The instrumentId " <> show instrumentId <> ", does not exist under the nextIterationFunding") + $ isSome mNextIterationFunding 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 + $ fromSome mNextIterationFunding + + require ("Current eligible withdraw amount for vesting lock is not greater than 0.0. " + <> "currentEligibleWithdrawableAmount came back = '" + <> show availableWithdrawAmount + <> "'." + ) + $ availableWithdrawAmount > 0.0 + + let + info = SettlementInfo with + executors = [ dso ] + id = "VestingLock_Withdraw" + cid = Some $ coerceContractId vestingLockCid + meta = emptyMetadata + transferLegId = "withdraw" + + exercise factoryCid $ SettlementFactory_SettleBatch with + settlement = info + actors = [ dso ] + 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 = remainingVestingAmount + instrumentId + meta = emptyMetadata + ] + nextIterationFunding = Some $ TM.singleton instrumentId remainingVestingAmount + ] + + pure () From fd4c8a75a6e17e8794fae8d6bfeaf854eaa974a9 Mon Sep 17 00:00:00 2001 From: "Jonathan D.K. Gibbons" Date: Mon, 20 Jul 2026 14:34:19 +0000 Subject: [PATCH 08/23] WIP: Test for lock-to-aggregate and unlock, and bug fixes. --- .../Splice/Scripts/TestAggregateLocks.daml | 109 ++++++++++++++++++ .../daml/Splice/AggregateLock.daml | 24 ++-- .../daml/Splice/AmuletAllocationV2.daml | 2 + 3 files changed, 128 insertions(+), 7 deletions(-) create mode 100644 daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml 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..090f340218 --- /dev/null +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -0,0 +1,109 @@ +{-# LANGUAGE ApplicativeDo #-} +module Splice.Scripts.TestAggregateLocks where + +import DA.Time +import Daml.Script +import Splice.Amulet +import Splice.AggregateLock +import Splice.AmuletRules +import Splice.Expiry +import Splice.Scripts.Util +import Splice.TokenStandard.Utils qualified as TSU +import Splice.Api.Token.AllocationV2 qualified as V2 +import Splice.Testing.TokenStandard.RegistryApiV2 +import Splice.Testing.TokenStandard.WalletClientV2 qualified as WalletClientV2 +import Splice.Testing.Registries.AmuletRegistryV2 +import Splice.Api.Token.MetadataV1 +import Splice.Api.Token.AllocationV2 +import Splice.Api.Token.AllocationInstructionV2 +import Splice.AmuletAllocationV2 +import Splice.Testing.Utils + +import Splice.ExternalPartyAmuletRules + +import DA.Assert +import DA.Optional +import DA.Functor +import DA.Foldable (mapA_, sequence_) +import qualified DA.TextMap as TM + +import Splice.Scripts.TokenStandard.TestAmuletTokenStandardTestEnv +import Splice.Testing.Registries.AmuletRegistryV2 qualified as AmuletRegistryV2 + + +lockForGovernance : TestEnv -> TM.TextMap Decimal -> Metadata -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult +lockForGovernance (TestEnv {..}) amounts meta party aggCid = do + WalletClientV2.allocateV2 registries bob lockSettlementInfo lockAllocation + where + lockSettlementInfo = V2.SettlementInfo with + executors = [ instrId.admin ] + id = "AggregateLock" + cid = Some $ coerceContractId aggCid + meta = emptyMetadata + lockAllocation = V2.AllocationSpecification with + admin = instrId.admin + authorizer = TSU.basicAccount bob + transferLegSides = [] + committed = True + nextIterationFunding = Some $ amounts -- TM.fromList [(instrId.id, amount)] + settlementDeadline = Some maxBound + meta + +lockForAggregate : TestEnv -> Decimal -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult +lockForAggregate te amount = lockForGovernance te (TM.fromList [(te.instrId.id, amount)]) $ Metadata $ TM.fromList + [ ("cip-105/type", "aggregateLock") ] + +lockForVesting : TestEnv -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult +lockForVesting te = lockForGovernance te TM.empty $ Metadata $ TM.fromList + [ ("cip-105/type", "vestingLock") + , ("cip-105/vestingPeriod", "365") ] + +testAggregateLockHappyPath : Script () +testAggregateLockHappyPath = do + env@TestEnv{..} <- setupTest + now <- getTime + let dso = env.instrId.admin + + AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 + + aggLock <- submit (actAs [alice, dso]) $ createCmd AggregateLock with + dso + instrumentId = env.instrId.id + vestingSchedule = VestingSchedule_SV + Some aggLockDisclosure <- queryDisclosure dso aggLock + + -- Lock some funds for the aggregate + AllocationInstructionResult { output = AllocationInstructionResult_Completed locked } <- lockForAggregate env 1000.0 bob aggLock + + -- Check total for the aggregate; needs to be implemented. + + AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingInput } <- lockForVesting env bob aggLock + + -- use getSettlementFactory to get the extraArgs and disclosures to call AggregateLock_Unlock + enriched <- getSettlementFactory registriesEnv.amuletV2 $ SettlementFactory_SettleBatch with + settlement = SettlementInfo with + executors = [ dso ] + id = "AggregateLock" + cid = None + meta = emptyMetadata + actors = [ dso ] + extraArgs = emptyExtraArgs + transferLegs = [] + allocations = [] + + submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ AggregateLock_Unlock with + factoryCid = enriched.factoryCid + lockedCid = locked + withdrawToCid = vestingInput + authorizers = [ bob ] + amount = 100.0 + extraArgs = enriched.arg.extraArgs + + allocations <- query @AmuletAllocationV2 bob + + debug allocations + + assert $ length allocations == 2 + + -- Need to check other than via inspection that the two allocations actually exist with correct values. + diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 292f85372a..a3dec7a4f2 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -23,7 +23,7 @@ isValidVestingLockedDestination dso alloc = and [ alloc.allocation.admin == dso , alloc.allocation.committed , null alloc.allocation.transferLegSides - , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "aggregateLock" + , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "vestingLock" , alloc.expiresAt == Some maxBound ] @@ -46,6 +46,15 @@ governanceLockedControllersFromMeta meta acctParty = GovernanceLockedControllers where controllerSetFromMetaMap key = fromOptional [[acctParty]] $ controllerSetFromMeta =<< key `TM.lookup` meta.values +data VestingSchedule + = VestingSchedule_SV + | VestingSchedule_Immediate + deriving (Show, Eq, Ord) + +validateVestingSchedule : VestingSchedule -> Metadata -> Bool +validateVestingSchedule VestingSchedule_SV meta = + TM.lookup "cip-105/vestingPeriod" meta.values == Some "365" -- Placeholder check, depends on vesting impl. +validateVestingSchedule VestingSchedule_Immediate _ = True -- | The intention is to treat the overall aggregate lock for a SV as if it is -- "the settlement" for the allocations locked to it, and use iterated @@ -58,7 +67,7 @@ template AggregateLock with dso: Party instrumentId : Text - allowImmediateUnlock : Bool + vestingSchedule : VestingSchedule where signatory dso nonconsuming choice AggregateLock_Unlock : SettlementFactory_SettleBatchResult @@ -68,6 +77,7 @@ template AggregateLock withdrawToCid : ContractId Allocation authorizers : [ Party ] amount : Decimal + extraArgs : ExtraArgs where controller authorizers do @@ -78,14 +88,14 @@ template AggregateLock let GovernanceLockedControllers{..} = governanceLockedControllersFromMeta locked.meta ownerParty require "Unlock controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) unlockControllerSets require "Not allowed to unlock to a different party than locked the funds" $ locked.allocation.authorizer == withdrawTo.allocation.authorizer - if not allowImmediateUnlock then require "Unlock without vesting is only allowed when specifically enabled" False else pure () require "Must be a valid governance-locked allocation" $ isValidAggregateLockedAllocation dso locked require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination dso withdrawTo require "Must have amounts reserved within the next settlement iteration" $ isSome locked.allocation.nextIterationFunding + require "Vesting allocation must have a correct schedule configuration" $ validateVestingSchedule vestingSchedule withdrawTo.allocation.meta let info = SettlementInfo with executors = [ dso ] - id = "AggregateLock_Unlock" + id = "AggregateLock" cid = Some $ coerceContractId self meta = emptyMetadata transferLegId = "unlock" @@ -97,7 +107,7 @@ template AggregateLock exercise factoryCid $ SettlementFactory_SettleBatch with settlement = info actors = [ dso ] - extraArgs = ExtraArgs emptyChoiceContext emptyMetadata + extraArgs transferLegs = [ TransferLeg with transferLegId @@ -125,11 +135,11 @@ template AggregateLock extraTransferLegSides = [ TransferLegSide with transferLegId - side = SenderSide + side = ReceiverSide otherside = locked.allocation.authorizer amount instrumentId meta = emptyMetadata ] - nextIterationFunding = Some $ TM.singleton instrumentId newLockedAmount + nextIterationFunding = Some $ TM.singleton instrumentId amount ] diff --git a/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml b/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml index 469ede68f2..088455e03f 100644 --- a/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml +++ b/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml @@ -230,7 +230,9 @@ computeAllocationExpiryInternal transferConfig oldExpiresAt settlementDeadline = | maxTime `subTime` oldExpiresAt <= maxTTL = maxTime | otherwise = oldExpiresAt `addRelTime` maxTTL +-- FIXME: the exception to allow Some maxBound 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 | settlementDeadline == Some maxBound = pure maxBound computeAllocationExpiry transferConfig oldExpiresAt settlementDeadline = do let expiresAt = computeAllocationExpiryInternal transferConfig oldExpiresAt settlementDeadline assertWithinDeadline "allocation.expiresAt" expiresAt From 29e569e5d0a6ff707e64073502e7feef43c38800 Mon Sep 17 00:00:00 2001 From: "Jonathan D.K. Gibbons" Date: Mon, 20 Jul 2026 17:47:37 +0000 Subject: [PATCH 09/23] fix tests --- .../daml/Splice/Scripts/TestAggregateLocks.daml | 12 +++++++----- daml/splice-amulet/daml/Splice/AggregateLock.daml | 15 ++++++++++----- 2 files changed, 17 insertions(+), 10 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index 090f340218..8a7968e8c2 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -29,6 +29,7 @@ import qualified DA.TextMap as TM import Splice.Scripts.TokenStandard.TestAmuletTokenStandardTestEnv import Splice.Testing.Registries.AmuletRegistryV2 qualified as AmuletRegistryV2 +import Splice.TokenStandard.Utils.Internal.Conversions (encodeTime) lockForGovernance : TestEnv -> TM.TextMap Decimal -> Metadata -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult @@ -53,15 +54,15 @@ lockForAggregate : TestEnv -> Decimal -> Party -> ContractId AggregateLock -> Sc lockForAggregate te amount = lockForGovernance te (TM.fromList [(te.instrId.id, amount)]) $ Metadata $ TM.fromList [ ("cip-105/type", "aggregateLock") ] -lockForVesting : TestEnv -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult -lockForVesting te = lockForGovernance te TM.empty $ Metadata $ TM.fromList +lockForVesting : Time -> TestEnv -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult +lockForVesting now te = lockForGovernance te TM.empty $ Metadata $ TM.fromList [ ("cip-105/type", "vestingLock") - , ("cip-105/vestingPeriod", "365") ] + , ("cip-105/vestingLock.startDate", encodeTime now) + , ("cip-105/vestingLock.endDate", encodeTime $ addRelTime now $ days 365 + hours 6) ] testAggregateLockHappyPath : Script () testAggregateLockHappyPath = do env@TestEnv{..} <- setupTest - now <- getTime let dso = env.instrId.admin AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 @@ -77,7 +78,8 @@ testAggregateLockHappyPath = do -- Check total for the aggregate; needs to be implemented. - AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingInput } <- lockForVesting env bob aggLock + now <- getTime + AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingInput } <- lockForVesting (addRelTime now $ minutes 5) env bob aggLock -- use getSettlementFactory to get the extraArgs and disclosures to call AggregateLock_Unlock enriched <- getSettlementFactory registriesEnv.amuletV2 $ SettlementFactory_SettleBatch with diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 201b3934b1..fc703823fe 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -56,10 +56,14 @@ data VestingSchedule | VestingSchedule_Immediate deriving (Show, Eq, Ord) -validateVestingSchedule : VestingSchedule -> Metadata -> Bool -validateVestingSchedule VestingSchedule_SV meta = - TM.lookup "cip-105/vestingPeriod" meta.values == Some "365" -- Placeholder check, depends on vesting impl. -validateVestingSchedule VestingSchedule_Immediate _ = True +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 + 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) @@ -115,7 +119,8 @@ template AggregateLock require "Must be a valid governance-locked allocation" $ isValidAggregateLockedAllocation dso locked require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination dso withdrawTo require "Must have amounts reserved within the next settlement iteration" $ isSome locked.allocation.nextIterationFunding - require "Vesting allocation must have a correct schedule configuration" $ validateVestingSchedule vestingSchedule withdrawTo.allocation.meta + now <- getTime + require "Vesting allocation must have a correct schedule configuration" $ validateVestingSchedule vestingSchedule now withdrawTo.allocation.meta let info = SettlementInfo with executors = [ dso ] From 7e1be84170775c3606e496b9d97a7b10f0a27c2d Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Mon, 20 Jul 2026 21:21:09 +0000 Subject: [PATCH 10/23] WIP Start adding VestingLock Testing --- .../Splice/Scripts/TestAggregateLocks.daml | 34 ++++++++++++++++--- .../daml/Splice/AggregateLock.daml | 19 ++++++++--- .../TestTokenV2/TestAllocationHappyV2.daml | 26 -------------- 3 files changed, 43 insertions(+), 36 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index 8a7968e8c2..46ab6785ca 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -25,6 +25,7 @@ import DA.Assert import DA.Optional import DA.Functor import DA.Foldable (mapA_, sequence_) +import DA.List (last) import qualified DA.TextMap as TM import Splice.Scripts.TokenStandard.TestAmuletTokenStandardTestEnv @@ -54,11 +55,13 @@ lockForAggregate : TestEnv -> Decimal -> Party -> ContractId AggregateLock -> Sc lockForAggregate te amount = lockForGovernance te (TM.fromList [(te.instrId.id, amount)]) $ Metadata $ TM.fromList [ ("cip-105/type", "aggregateLock") ] -lockForVesting : Time -> TestEnv -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult -lockForVesting now te = lockForGovernance te TM.empty $ Metadata $ TM.fromList +lockForVesting : Decimal -> Time -> TestEnv -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult +lockForVesting initialAmount now te = lockForGovernance te TM.empty $ 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.endDate", encodeTime $ addRelTime now $ days 365 + hours 6) + , ("cip-105/vestingLock.initialAmount", show initialAmount) + ] testAggregateLockHappyPath : Script () testAggregateLockHappyPath = do @@ -79,7 +82,8 @@ testAggregateLockHappyPath = do -- Check total for the aggregate; needs to be implemented. now <- getTime - AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingInput } <- lockForVesting (addRelTime now $ minutes 5) env bob aggLock + let initialAmountToUnlock = 100.0 + AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingInput } <- lockForVesting initialAmountToUnlock (addRelTime now $ minutes 5) env bob aggLock -- use getSettlementFactory to get the extraArgs and disclosures to call AggregateLock_Unlock enriched <- getSettlementFactory registriesEnv.amuletV2 $ SettlementFactory_SettleBatch with @@ -98,7 +102,7 @@ testAggregateLockHappyPath = do lockedCid = locked withdrawToCid = vestingInput authorizers = [ bob ] - amount = 100.0 + amount = initialAmountToUnlock extraArgs = enriched.arg.extraArgs allocations <- query @AmuletAllocationV2 bob @@ -109,3 +113,23 @@ testAggregateLockHappyPath = do -- Need to check other than via inspection that the two allocations actually exist with correct values. + -- TODO: Temporary, bad to do this + let (vestingLockAllocationCid, _) = last allocations + + -- Immediate withdraw attempt causes transaction to fail due to the current + -- eligible withdraw amount being zero (no time has passed since locking yet) + submitMustFail (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with + factoryCid = enriched.factoryCid + authorizers = [ bob ] + vestingLockCid = toInterfaceContractId vestingLockAllocationCid + + -- Time needs to pass to be able to withdraw fron the VestedAmulet + passTime (days 10) + + submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with + factoryCid = enriched.factoryCid + authorizers = [ bob ] + vestingLockCid = toInterfaceContractId vestingLockAllocationCid + +-- assertEq False True + pure () diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index fc703823fe..a4fe168c12 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -174,7 +174,7 @@ template AggregateLock ] -- Choice temporarily lives here and it will be moved, testing/draft purposes atm -- Note: this whole choice is WIP - nonconsuming choice VestingLock_Withdraw : () -- TODO: Return type possibly AllocationResult + nonconsuming choice VestingLock_Withdraw : AllocationResult with factoryCid : ContractId SettlementFactory authorizers : [Party] @@ -210,12 +210,12 @@ template AggregateLock let info = SettlementInfo with executors = [ dso ] - id = "VestingLock_Withdraw" - cid = Some $ coerceContractId vestingLockCid + id = "AggregateLock" + cid = Some $ coerceContractId self meta = emptyMetadata transferLegId = "withdraw" - exercise factoryCid $ SettlementFactory_SettleBatch with + batchResults <- exercise factoryCid $ SettlementFactory_SettleBatch with settlement = info actors = [ dso ] extraArgs = ExtraArgs emptyChoiceContext emptyMetadata @@ -239,9 +239,18 @@ template AggregateLock amount = remainingVestingAmount instrumentId meta = emptyMetadata + , TransferLegSide with + transferLegId + side = ReceiverSide + otherside = vestingLock.allocation.authorizer + amount = remainingVestingAmount + instrumentId + meta = emptyMetadata ] nextIterationFunding = Some $ TM.singleton instrumentId remainingVestingAmount ] + -- TODO: Fix hacky way potentially + let (allocationResult::_) = batchResults.allocationSettleResults - pure () + pure allocationResult diff --git a/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml b/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml index 9fc600beaa..c106baad90 100644 --- a/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml +++ b/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml @@ -25,7 +25,6 @@ import Splice.Testing.Tokens.TestTokenV2 qualified as TestTokenV2 import Splice.Testing.Utils import Splice.Testing.Registries.TestTokenV2_RegistryV2 qualified as TestTokenRegistryV2 -import Splice.TokenStandard.Utils.Internal.Conversions (encodeTime) import Splice.Testing.TokenStandard.RegistryApiV2 qualified as V2 import Splice.Testing.TokenStandard.WalletClientV2 qualified as WalletClientV2 import Splice.Testing.TokenStandard.MultiRegistry qualified as MultiRegistry @@ -47,31 +46,6 @@ test_allocation_WithdrawV2 = test_allocation_withdrawCancel_generic $ \TestEnv { meta = emptyMetadata pure () --- This is a temporary test script -test_vesting_lock_WithdrawV2 : Script () -test_vesting_lock_WithdrawV2 = do - TestEnv {..} <- setupTest - now <- getTime - let endDate : Time = addRelTime now $ (days 365) + (hours 6) - vestingInitialAmount : Decimal = 3652.5 - - let allocationV2 = V2.AllocationSpecification with - admin = instrId.admin - authorizer = TSU.basicAccount alice - transferLegSides = [] - committed = False - nextIterationFunding = Some $ TextMap.fromList [(instrId.id, vestingInitialAmount)] - settlementDeadline = None - meta = Metadata with - values = TextMap.fromList - [ ("cip-105/type", "vestingLock") - , ("cip-105/vestingLock.initialAmount", show vestingInitialAmount) - , ("cip-105/vestingLock.startDate", encodeTime now) - , ("cip-105/vestingLock.endDate", encodeTime endDate) - ] - - pure () - -- TODO(tech-debt): add support for dealing with stale references to locked tokens -- -- Handle them analogous to how Amulet handles them and copy the relevant tests from Amulet. From 661fbe57841dadb0bc431b5b7da3e607698ba522 Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Tue, 21 Jul 2026 18:25:21 +0000 Subject: [PATCH 11/23] WIP Flush out vestingUnlock tests more --- .../Splice/Scripts/TestAggregateLocks.daml | 32 ++++++++++++++++--- .../daml/Splice/AggregateLock.daml | 10 +++--- 2 files changed, 34 insertions(+), 8 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index 46ab6785ca..6d0faab17e 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -16,6 +16,7 @@ import Splice.Testing.Registries.AmuletRegistryV2 import Splice.Api.Token.MetadataV1 import Splice.Api.Token.AllocationV2 import Splice.Api.Token.AllocationInstructionV2 +import Splice.Api.Token.HoldingV2 import Splice.AmuletAllocationV2 import Splice.Testing.Utils @@ -25,7 +26,7 @@ import DA.Assert import DA.Optional import DA.Functor import DA.Foldable (mapA_, sequence_) -import DA.List (last) +import DA.List (head) import qualified DA.TextMap as TM import Splice.Scripts.TokenStandard.TestAmuletTokenStandardTestEnv @@ -82,7 +83,7 @@ testAggregateLockHappyPath = do -- Check total for the aggregate; needs to be implemented. now <- getTime - let initialAmountToUnlock = 100.0 + let initialAmountToUnlock = 365.25 AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingInput } <- lockForVesting initialAmountToUnlock (addRelTime now $ minutes 5) env bob aggLock -- use getSettlementFactory to get the extraArgs and disclosures to call AggregateLock_Unlock @@ -114,7 +115,7 @@ testAggregateLockHappyPath = do -- Need to check other than via inspection that the two allocations actually exist with correct values. -- TODO: Temporary, bad to do this - let (vestingLockAllocationCid, _) = last allocations + let vestingLockAllocationCid = head [cid | (cid, a) <- allocations, TM.member "cip-105/vestingLock.initialAmount" a.allocation.meta.values] -- Immediate withdraw attempt causes transaction to fail due to the current -- eligible withdraw amount being zero (no time has passed since locking yet) @@ -122,14 +123,37 @@ testAggregateLockHappyPath = do factoryCid = enriched.factoryCid authorizers = [ bob ] vestingLockCid = toInterfaceContractId vestingLockAllocationCid + extraArgs = enriched.arg.extraArgs -- Time needs to pass to be able to withdraw fron the VestedAmulet passTime (days 10) - submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with + (AllocationResult vestingAllocResult tmHoldingCids _) <- submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with factoryCid = enriched.factoryCid authorizers = [ bob ] vestingLockCid = toInterfaceContractId vestingLockAllocationCid + extraArgs = enriched.arg.extraArgs + + -- Time needs to pass to be able to withdraw fron the VestedAmulet + passTime (days 365) + + let holdingCids = fromSome $ TM.lookup env.instrId.id tmHoldingCids + debug holdingCids + + holdings <- queryInterface @Holding bob + debug holdings + let [(_, (Some unlockedHolding))] = filter (\(hcid, (Some h)) -> isNone h.lock && hcid `elem` holdingCids) holdings + debug unlockedHolding + + let tolerance = 0.01 + assert $ (abs $ unlockedHolding.amount - 10.0) < tolerance + +-- submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with +-- factoryCid = enriched.factoryCid +-- authorizers = [ bob ] +-- vestingLockCid = toInterfaceContractId vestingLockAllocationCid +-- extraArgs = enriched.arg.extraArgs +-- -- assertEq False True pure () diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index a4fe168c12..c8e7104b22 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -179,6 +179,7 @@ template AggregateLock factoryCid : ContractId SettlementFactory authorizers : [Party] vestingLockCid : ContractId Allocation + extraArgs : ExtraArgs where controller authorizers do @@ -194,6 +195,7 @@ template AggregateLock let mNextIterationFunding = TM.lookup instrumentId $ fromSome vestingLock.allocation.nextIterationFunding require ("The instrumentId " <> show instrumentId <> ", does not exist under the nextIterationFunding") $ isSome mNextIterationFunding + -- TODO: DOUBLE we get the right type in meta values require "There must be an initialAmount set for the vestingLock" $ TM.member "cip-105/vestingLock.initialAmount" vestingLock.allocation.meta.values @@ -218,7 +220,7 @@ template AggregateLock batchResults <- exercise factoryCid $ SettlementFactory_SettleBatch with settlement = info actors = [ dso ] - extraArgs = ExtraArgs emptyChoiceContext emptyMetadata + extraArgs transferLegs = [ TransferLeg with transferLegId @@ -236,14 +238,14 @@ template AggregateLock transferLegId side = SenderSide otherside = vestingLock.allocation.authorizer - amount = remainingVestingAmount + amount = availableWithdrawAmount instrumentId meta = emptyMetadata , TransferLegSide with transferLegId side = ReceiverSide otherside = vestingLock.allocation.authorizer - amount = remainingVestingAmount + amount = availableWithdrawAmount instrumentId meta = emptyMetadata ] @@ -251,6 +253,6 @@ template AggregateLock ] -- TODO: Fix hacky way potentially - let (allocationResult::_) = batchResults.allocationSettleResults + let [allocationResult] = batchResults.allocationSettleResults pure allocationResult From f722c80e62b6fed02d7d22785faf1665aff4f571 Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Tue, 21 Jul 2026 20:56:05 +0000 Subject: [PATCH 12/23] Finish basic happy test for vestingUnlock --- .../Splice/Scripts/TestAggregateLocks.daml | 29 ++++++++++++------- .../daml/Splice/AggregateLock.daml | 5 +++- 2 files changed, 22 insertions(+), 12 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index 6d0faab17e..83ac4e4849 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -133,27 +133,34 @@ testAggregateLockHappyPath = do authorizers = [ bob ] vestingLockCid = toInterfaceContractId vestingLockAllocationCid extraArgs = enriched.arg.extraArgs + debug vestingAllocResult -- Time needs to pass to be able to withdraw fron the VestedAmulet passTime (days 365) let holdingCids = fromSome $ TM.lookup env.instrId.id tmHoldingCids - debug holdingCids - holdings <- queryInterface @Holding bob - debug holdings + -- The holdings would include both locked/unlocked, so we filter let [(_, (Some unlockedHolding))] = filter (\(hcid, (Some h)) -> isNone h.lock && hcid `elem` holdingCids) holdings debug unlockedHolding let tolerance = 0.01 assert $ (abs $ unlockedHolding.amount - 10.0) < tolerance --- submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with --- factoryCid = enriched.factoryCid --- authorizers = [ bob ] --- vestingLockCid = toInterfaceContractId vestingLockAllocationCid --- extraArgs = enriched.arg.extraArgs + (AllocationResult vestingAllocResult' tmHoldingCids' _) <- submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with + factoryCid = enriched.factoryCid + authorizers = [ bob ] + vestingLockCid = fromSome $ vestingAllocResult.nextIterationAllocationCid + extraArgs = enriched.arg.extraArgs + + debug vestingAllocResult' + -- We should have no more remaining amount vesting, once the full period has passed + assertEq None $ vestingAllocResult'.nextIterationAllocationCid + + let holdingCids' = fromSome $ TM.lookup env.instrId.id tmHoldingCids' + holdings' <- queryInterface @Holding bob + -- The holdings would include both locked/unlocked, so we filter + let [(_, (Some unlockedHolding'))] = filter (\(hcid, (Some h)) -> isNone h.lock && hcid `elem` holdingCids') holdings' + debug unlockedHolding' --- --- assertEq False True - pure () + assertEq initialAmountToUnlock $ unlockedHolding.amount + unlockedHolding'.amount diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index c8e7104b22..b1198a2bfc 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -216,6 +216,9 @@ template AggregateLock cid = Some $ coerceContractId self meta = emptyMetadata transferLegId = "withdraw" + nextIterationFunding + | remainingVestingAmount <= 0.0 = None + | otherwise = Some $ TM.singleton instrumentId remainingVestingAmount batchResults <- exercise factoryCid $ SettlementFactory_SettleBatch with settlement = info @@ -249,7 +252,7 @@ template AggregateLock instrumentId meta = emptyMetadata ] - nextIterationFunding = Some $ TM.singleton instrumentId remainingVestingAmount + nextIterationFunding = nextIterationFunding ] -- TODO: Fix hacky way potentially From 457febe936b23b8a302fbd8b88a053f5c576ebc9 Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Tue, 21 Jul 2026 22:01:14 +0000 Subject: [PATCH 13/23] Move passTime within vesting happy path test --- .../daml/Splice/Scripts/TestAggregateLocks.daml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index 83ac4e4849..c1ebd483d7 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -135,9 +135,6 @@ testAggregateLockHappyPath = do extraArgs = enriched.arg.extraArgs debug vestingAllocResult - -- Time needs to pass to be able to withdraw fron the VestedAmulet - passTime (days 365) - let holdingCids = fromSome $ TM.lookup env.instrId.id tmHoldingCids holdings <- queryInterface @Holding bob -- The holdings would include both locked/unlocked, so we filter @@ -147,6 +144,9 @@ testAggregateLockHappyPath = do let tolerance = 0.01 assert $ (abs $ unlockedHolding.amount - 10.0) < tolerance + -- Let's try to withdraw the rest (now we should be past endDate) + passTime (days 365) + (AllocationResult vestingAllocResult' tmHoldingCids' _) <- submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with factoryCid = enriched.factoryCid authorizers = [ bob ] From 15dfa701bdbf30093e66fc2c205883b0990ecdf7 Mon Sep 17 00:00:00 2001 From: Cale Gibbard Date: Wed, 22 Jul 2026 16:28:28 -0400 Subject: [PATCH 14/23] Add a script which constructs a fake single package for speeding up development cycles by allowing the LSP to work cross-package when working on code. --- .gitignore | 2 ++ daml-ide-mono/README.md | 15 +++++++++++++++ daml-ide-mono/daml.yaml | 17 +++++++++++++++++ scripts/setup-mono-package.sh | 29 +++++++++++++++++++++++++++++ 4 files changed, 63 insertions(+) create mode 100644 daml-ide-mono/README.md create mode 100644 daml-ide-mono/daml.yaml create mode 100755 scripts/setup-mono-package.sh diff --git a/.gitignore b/.gitignore index 2c56be64b4..230671f341 100644 --- a/.gitignore +++ b/.gitignore @@ -22,6 +22,8 @@ _build/ **/metals.sbt **/.scala-build/* +daml-ide-mono/daml/ +daml-ide-mono/.vscode/ .vscode/* !.vscode/settings.json # Make sure test files are checkedin diff --git a/daml-ide-mono/README.md b/daml-ide-mono/README.md new file mode 100644 index 0000000000..4a24340200 --- /dev/null +++ b/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-ide-mono/daml.yaml b/daml-ide-mono/daml.yaml new file mode 100644 index 0000000000..e998fdd9a9 --- /dev/null +++ b/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/scripts/setup-mono-package.sh b/scripts/setup-mono-package.sh new file mode 100755 index 0000000000..d12b164336 --- /dev/null +++ b/scripts/setup-mono-package.sh @@ -0,0 +1,29 @@ +#!/usr/bin/env bash +# Populate daml-ide-mono/daml/ with per-file symlinks into every workspace +# Daml package's source tree. The synthesised 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 you add a new .daml file to the workspace or add +# a new workspace package. Symlinks are relative, so `mv`-ing the repo +# leaves them working. +set -euo pipefail + +repo=$(cd "$(dirname "$0")/.." && pwd) +dest="$repo/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")" + ln -sfn "$src/$rel" "$link" + done +done From e4e35f7fbee57de82fb1c53bd5a95356f1100215 Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Wed, 22 Jul 2026 20:47:35 +0000 Subject: [PATCH 15/23] Fix some issues related to PR comments for VestingLock --- .../Splice/Scripts/TestAggregateLocks.daml | 4 +- .../daml/Splice/AggregateLock.daml | 42 +++++++++++-------- .../TestTokenV2/TestAllocationHappyV2.daml | 1 - 3 files changed, 26 insertions(+), 21 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index c1ebd483d7..acd13f9c5c 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -71,7 +71,7 @@ testAggregateLockHappyPath = do AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 - aggLock <- submit (actAs [alice, dso]) $ createCmd AggregateLock with + aggLock <- submit (actAs dso) $ createCmd AggregateLock with dso instrumentId = env.instrId.id vestingSchedule = VestingSchedule_SV @@ -125,7 +125,7 @@ testAggregateLockHappyPath = do vestingLockCid = toInterfaceContractId vestingLockAllocationCid extraArgs = enriched.arg.extraArgs - -- Time needs to pass to be able to withdraw fron the VestedAmulet + -- Time needs to pass to be able to withdraw from the VestingLock passTime (days 10) (AllocationResult vestingAllocResult tmHoldingCids _) <- submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index b1198a2bfc..f817d1b041 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -3,10 +3,12 @@ module Splice.AggregateLock where import Splice.Api.Token.AllocationV2 as V2 import Splice.Api.Token.MetadataV1 import Splice.TokenStandard.Utils.Internal.Conversions (decodeTime) +import Splice.Types (ForDso(..)) import Splice.Util import DA.Optional import DA.Text +import qualified DA.List as L import qualified DA.TextMap as TM import DA.Time @@ -28,7 +30,6 @@ isValidVestingLockedDestination dso alloc = , alloc.expiresAt == Some maxBound , TM.member "cip-105/vestingLock.startDate" metaValues , TM.member "cip-105/vestingLock.endDate" metaValues - -- TODO: Check the period is valid, check startDate < endDate ] where metaValues = alloc.allocation.meta.values @@ -109,8 +110,8 @@ template AggregateLock where controller authorizers do - locked <- view <$> fetch lockedCid - withdrawTo <- view <$> fetch withdrawToCid + locked <- view <$> fetchCheckedInterface (ForDso with dso) lockedCid + withdrawTo <- view <$> fetchCheckedInterface (ForDso with dso) withdrawToCid ownerParty <- whenNone locked.allocation.authorizer.owner $ assertFail "The requirement 'governance locked allocations must be owned by basic accounts' was not met" let GovernanceLockedControllers{..} = governanceLockedControllersFromMeta locked.meta ownerParty @@ -183,26 +184,29 @@ template AggregateLock where controller authorizers do - -- remainingLocked stays in nextIterationFunding - vestingLock <- view <$> fetch vestingLockCid + vestingLock <- view <$> fetchCheckedInterface (ForDso with dso) vestingLockCid now <- getTime + ownerParty <- whenNone vestingLock.allocation.authorizer.owner $ + assertFail "The requirement 'governance locked allocations must be owned by basic accounts' was not met" - -- TODO: Probably add valid unlockController set check? - -- TODO: Potentially do case statement with nextIterationFunding optionals - require "There are no remaining funds to withdraw" - $ isSome vestingLock.allocation.nextIterationFunding - - let mNextIterationFunding = TM.lookup instrumentId $ fromSome vestingLock.allocation.nextIterationFunding - require ("The instrumentId " <> show instrumentId <> ", does not exist under the nextIterationFunding") - $ isSome mNextIterationFunding - -- TODO: DOUBLE we get the right type in meta values + require "Must be a valid vesting unlock allocation" $ isValidVestingLockedDestination dso vestingLock require "There must be an initialAmount set for the vestingLock" $ TM.member "cip-105/vestingLock.initialAmount" vestingLock.allocation.meta.values + let GovernanceLockedControllers{..} = governanceLockedControllersFromMeta vestingLock.meta ownerParty + require "Unlock controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) unlockControllerSets + + let mNextIterationFunding = case vestingLock.allocation.nextIterationFunding of + None -> None + Some nextIterationFundingTM -> + TM.lookup instrumentId nextIterationFundingTM + require ("VestingLock's nextIterationFunding should have remaining funds to withdraw for instrumentId " <> show instrumentId) + $ isSome mNextIterationFunding + let nextIterationFundingAmount = fromSome mNextIterationFunding - let (availableWithdrawAmount, remainingVestingAmount) : (Decimal, Decimal) = calculateAvailableWithdrawAmount now vestingLock - $ fromSome mNextIterationFunding + let (availableWithdrawAmount, remainingVestingAmount) : (Decimal, Decimal) = + calculateAvailableWithdrawAmount now vestingLock nextIterationFundingAmount - require ("Current eligible withdraw amount for vesting lock is not greater than 0.0. " + require ("Current eligible withdraw amount for vesting lock should be greater than 0.0. " <> "currentEligibleWithdrawableAmount came back = '" <> show availableWithdrawAmount <> "'." @@ -255,7 +259,9 @@ template AggregateLock nextIterationFunding = nextIterationFunding ] - -- TODO: Fix hacky way potentially + -- We should have one result from settleBatch + require "VestingUnlock_Withdraw should result in one allocation result. " $ + L.length batchResults.allocationSettleResults == 1 let [allocationResult] = batchResults.allocationSettleResults pure allocationResult diff --git a/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml b/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml index c106baad90..43cb979150 100644 --- a/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml +++ b/token-standard/examples/splice-test-token-v2-test/daml/Splice/Testing/Tokens/TestTokenV2/TestAllocationHappyV2.daml @@ -10,7 +10,6 @@ import DA.Assert import DA.List (sort) import DA.Map qualified as Map import DA.TextMap qualified as TextMap -import DA.Time (addRelTime, days, hours) import Daml.Script From 4b29e95040d709d432e3ac4a3c7936fa1c214833 Mon Sep 17 00:00:00 2001 From: Deepak Birdi Date: Fri, 24 Jul 2026 19:08:10 +0000 Subject: [PATCH 16/23] Address some CIP-0105 PR comments --- .../Splice/Scripts/TestAggregateLocks.daml | 10 ++---- .../daml/Splice/AggregateLock.daml | 34 +++++++++---------- .../Utils/Internal/Conversions.daml | 1 - 3 files changed, 19 insertions(+), 26 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index acd13f9c5c..c3c69b5919 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -84,7 +84,7 @@ testAggregateLockHappyPath = do now <- getTime let initialAmountToUnlock = 365.25 - AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingInput } <- lockForVesting initialAmountToUnlock (addRelTime now $ minutes 5) env bob aggLock + AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingInput } <- lockForVesting initialAmountToUnlock now env bob aggLock -- use getSettlementFactory to get the extraArgs and disclosures to call AggregateLock_Unlock enriched <- getSettlementFactory registriesEnv.amuletV2 $ SettlementFactory_SettleBatch with @@ -108,7 +108,6 @@ testAggregateLockHappyPath = do allocations <- query @AmuletAllocationV2 bob - debug allocations assert $ length allocations == 2 @@ -133,16 +132,13 @@ testAggregateLockHappyPath = do authorizers = [ bob ] vestingLockCid = toInterfaceContractId vestingLockAllocationCid extraArgs = enriched.arg.extraArgs - debug vestingAllocResult let holdingCids = fromSome $ TM.lookup env.instrId.id tmHoldingCids holdings <- queryInterface @Holding bob -- The holdings would include both locked/unlocked, so we filter let [(_, (Some unlockedHolding))] = filter (\(hcid, (Some h)) -> isNone h.lock && hcid `elem` holdingCids) holdings - debug unlockedHolding - let tolerance = 0.01 - assert $ (abs $ unlockedHolding.amount - 10.0) < tolerance + assertEq unlockedHolding.amount 10.0000000105 -- Let's try to withdraw the rest (now we should be past endDate) passTime (days 365) @@ -153,7 +149,6 @@ testAggregateLockHappyPath = do vestingLockCid = fromSome $ vestingAllocResult.nextIterationAllocationCid extraArgs = enriched.arg.extraArgs - debug vestingAllocResult' -- We should have no more remaining amount vesting, once the full period has passed assertEq None $ vestingAllocResult'.nextIterationAllocationCid @@ -161,6 +156,5 @@ testAggregateLockHappyPath = do holdings' <- queryInterface @Holding bob -- The holdings would include both locked/unlocked, so we filter let [(_, (Some unlockedHolding'))] = filter (\(hcid, (Some h)) -> isNone h.lock && hcid `elem` holdingCids') holdings' - debug unlockedHolding' assertEq initialAmountToUnlock $ unlockedHolding.amount + unlockedHolding'.amount diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index f817d1b041..76a08fc7f4 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -1,11 +1,13 @@ module Splice.AggregateLock where +import Splice.Amulet.TokenApiUtils import Splice.Api.Token.AllocationV2 as V2 import Splice.Api.Token.MetadataV1 import Splice.TokenStandard.Utils.Internal.Conversions (decodeTime) import Splice.Types (ForDso(..)) import Splice.Util +import DA.Either import DA.Optional import DA.Text import qualified DA.List as L @@ -36,7 +38,7 @@ isValidVestingLockedDestination dso alloc = type ControllerSets = [[Party]] partiesFromText : Text -> Optional [Party] -partiesFromText = mapA partyFromText . splitOn "," +partiesFromText = eitherToOptional . parseCommaSeparated "Parties" partyFromText controllerSetFromMeta : Text -> Optional ControllerSets controllerSetFromMeta = mapA partiesFromText . splitOn ";" @@ -63,7 +65,8 @@ validateVestingSchedule VestingSchedule_SV now meta = 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 - now < start && end `subTime` start == days 365 + hours 6 + -- 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? @@ -173,8 +176,7 @@ template AggregateLock ] nextIterationFunding = Some $ TM.singleton instrumentId amount ] - -- Choice temporarily lives here and it will be moved, testing/draft purposes atm - -- Note: this whole choice is WIP + -- Note: Choice temporarily lives here and it will be moved, testing/draft purposes atm nonconsuming choice VestingLock_Withdraw : AllocationResult with factoryCid : ContractId SettlementFactory @@ -195,13 +197,13 @@ template AggregateLock let GovernanceLockedControllers{..} = governanceLockedControllersFromMeta vestingLock.meta ownerParty require "Unlock controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) unlockControllerSets - let mNextIterationFunding = case vestingLock.allocation.nextIterationFunding of - None -> None - Some nextIterationFundingTM -> - TM.lookup instrumentId nextIterationFundingTM - require ("VestingLock's nextIterationFunding should have remaining funds to withdraw for instrumentId " <> show instrumentId) - $ isSome mNextIterationFunding - let nextIterationFundingAmount = fromSome mNextIterationFunding + let mNextIterationFunding = do + fundingMap <- vestingLock.allocation.nextIterationFunding + TM.lookup instrumentId fundingMap + + nextIterationFundingAmount <- case mNextIterationFunding of + None -> abort ("VestingLock's nextIterationFunding should have remaining funds to withdraw for instrumentId " <> show instrumentId) + Some amount -> pure amount let (availableWithdrawAmount, remainingVestingAmount) : (Decimal, Decimal) = calculateAvailableWithdrawAmount now vestingLock nextIterationFundingAmount @@ -259,9 +261,7 @@ template AggregateLock nextIterationFunding = nextIterationFunding ] - -- We should have one result from settleBatch - require "VestingUnlock_Withdraw should result in one allocation result. " $ - L.length batchResults.allocationSettleResults == 1 - let [allocationResult] = batchResults.allocationSettleResults - - pure allocationResult + -- We should have one result from settleBatch + case batchResults.allocationSettleResults of + [allocationResult] -> pure allocationResult + _ -> abort "VestingUnlock_Withdraw should result in one allocation result. " 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 1e70ba6c5c..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,7 +27,6 @@ module Splice.TokenStandard.Utils.Internal.Conversions ( partiesToMeta, dropMeta, validateNoMeta, - -- TODO: Is exporting the below cool? encodeTime, decodeTime, From c0da78d5e45aff7118a64bca9c3653c426b0dbe2 Mon Sep 17 00:00:00 2001 From: Cale Gibbard Date: Mon, 27 Jul 2026 17:14:21 +0000 Subject: [PATCH 17/23] Revert "Add a script which constructs a fake single package for speeding up development cycles by allowing the LSP to work cross-package when working on code." This reverts commit 15dfa701bdbf30093e66fc2c205883b0990ecdf7. --- .gitignore | 2 -- daml-ide-mono/README.md | 15 --------------- daml-ide-mono/daml.yaml | 17 ----------------- scripts/setup-mono-package.sh | 29 ----------------------------- 4 files changed, 63 deletions(-) delete mode 100644 daml-ide-mono/README.md delete mode 100644 daml-ide-mono/daml.yaml delete mode 100755 scripts/setup-mono-package.sh diff --git a/.gitignore b/.gitignore index 230671f341..2c56be64b4 100644 --- a/.gitignore +++ b/.gitignore @@ -22,8 +22,6 @@ _build/ **/metals.sbt **/.scala-build/* -daml-ide-mono/daml/ -daml-ide-mono/.vscode/ .vscode/* !.vscode/settings.json # Make sure test files are checkedin diff --git a/daml-ide-mono/README.md b/daml-ide-mono/README.md deleted file mode 100644 index 4a24340200..0000000000 --- a/daml-ide-mono/README.md +++ /dev/null @@ -1,15 +0,0 @@ -# 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-ide-mono/daml.yaml b/daml-ide-mono/daml.yaml deleted file mode 100644 index e998fdd9a9..0000000000 --- a/daml-ide-mono/daml.yaml +++ /dev/null @@ -1,17 +0,0 @@ -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/scripts/setup-mono-package.sh b/scripts/setup-mono-package.sh deleted file mode 100755 index d12b164336..0000000000 --- a/scripts/setup-mono-package.sh +++ /dev/null @@ -1,29 +0,0 @@ -#!/usr/bin/env bash -# Populate daml-ide-mono/daml/ with per-file symlinks into every workspace -# Daml package's source tree. The synthesised 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 you add a new .daml file to the workspace or add -# a new workspace package. Symlinks are relative, so `mv`-ing the repo -# leaves them working. -set -euo pipefail - -repo=$(cd "$(dirname "$0")/.." && pwd) -dest="$repo/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")" - ln -sfn "$src/$rel" "$link" - done -done From bde618e6a70ff89b17b07224a075bfcfa415b3e5 Mon Sep 17 00:00:00 2001 From: "Jonathan D.K. Gibbons" Date: Tue, 28 Jul 2026 12:19:28 +0000 Subject: [PATCH 18/23] WIP: hook the withdraw-like operations to withdraw. --- .../Splice/Scripts/TestAggregateLocks.daml | 82 +++- .../daml/Splice/AggregateLock.daml | 362 ++++++++++-------- .../daml/Splice/AmuletAllocationV2.daml | 15 +- .../Utils/Internal/Allocations.daml | 14 +- .../Testing/Registries/AmuletRegistryV2.daml | 4 + 5 files changed, 301 insertions(+), 176 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index c3c69b5919..717a9e6a02 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -1,4 +1,5 @@ {-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Splice.Scripts.TestAggregateLocks where import DA.Time @@ -10,6 +11,7 @@ import Splice.Expiry import Splice.Scripts.Util import Splice.TokenStandard.Utils qualified as TSU import Splice.Api.Token.AllocationV2 qualified as V2 +import Splice.Api.Token.HoldingV2 qualified as V2 import Splice.Testing.TokenStandard.RegistryApiV2 import Splice.Testing.TokenStandard.WalletClientV2 qualified as WalletClientV2 import Splice.Testing.Registries.AmuletRegistryV2 @@ -28,20 +30,34 @@ import DA.Functor import DA.Foldable (mapA_, sequence_) import DA.List (head) import qualified DA.TextMap as TM +import qualified DA.Map as M import Splice.Scripts.TokenStandard.TestAmuletTokenStandardTestEnv import Splice.Testing.Registries.AmuletRegistryV2 qualified as AmuletRegistryV2 import Splice.TokenStandard.Utils.Internal.Conversions (encodeTime) - -lockForGovernance : TestEnv -> TM.TextMap Decimal -> Metadata -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult -lockForGovernance (TestEnv {..}) amounts meta party aggCid = do - WalletClientV2.allocateV2 registries bob lockSettlementInfo lockAllocation +newtype AmuletRegistryExtraWithdrawContext = AmuletRegistryExtraWithdrawContext { unExtra : AmuletRegistry } + +instance RegistryApi AmuletRegistryExtraWithdrawContext where + getTransferFactory = getTransferFactory . unExtra + getAllocationFactory = getAllocationFactory . unExtra + getSettlementFactory = getSettlementFactory . unExtra + getAllocation_WithdrawContext = getAllocation_WithdrawContext . unExtra + getAllocation_CancelContext = getAllocation_CancelContext . unExtra + getAllocationInstruction_WithdrawContext = getAllocationInstruction_WithdrawContext . unExtra + getAllocationInstruction_AcceptContext = getAllocationInstruction_AcceptContext . unExtra + getTransferInstruction_AcceptContext = getTransferInstruction_AcceptContext . unExtra + getTransferInstruction_RejectContext = getTransferInstruction_RejectContext . unExtra + getTransferInstruction_WithdrawContext = getTransferInstruction_WithdrawContext . unExtra + +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 = Some $ coerceContractId aggCid + cid = None -- Some $ coerceContractId aggCid meta = emptyMetadata lockAllocation = V2.AllocationSpecification with admin = instrId.admin @@ -49,14 +65,17 @@ lockForGovernance (TestEnv {..}) amounts meta party aggCid = do transferLegSides = [] committed = True nextIterationFunding = Some $ amounts -- TM.fromList [(instrId.id, amount)] - settlementDeadline = Some maxBound + settlementDeadline = Some maxComparableTime meta -lockForAggregate : TestEnv -> Decimal -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult -lockForAggregate te amount = lockForGovernance te (TM.fromList [(te.instrId.id, amount)]) $ Metadata $ TM.fromList - [ ("cip-105/type", "aggregateLock") ] +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") + ] -lockForVesting : Decimal -> Time -> TestEnv -> Party -> ContractId AggregateLock -> Script AllocationInstructionResult +lockForVesting : Decimal -> Time -> TestEnv -> Party -> Script AllocationInstructionResult lockForVesting initialAmount now te = lockForGovernance te TM.empty $ Metadata $ TM.fromList [ ("cip-105/type", "vestingLock") , ("cip-105/vestingLock.startDate", encodeTime now) @@ -69,18 +88,52 @@ testAggregateLockHappyPath = do env@TestEnv{..} <- setupTest let dso = env.instrId.admin + let + addAggregateWithdrawContext : Script OpenApiChoiceContext -> Script OpenApiChoiceContext + addAggregateWithdrawContext a = do + baseCtxt <- a + extraContext <- getExternalPartyConfigStateContext registriesEnv.amuletV2 + pure $ baseCtxt <> extraContext + updateApi api = api { ggetAllocation_WithdrawContext = \a -> addAggregateWithdrawContext . api.ggetAllocation_WithdrawContext a } + newRegistries = flip fmap registries $ \reg -> + reg { v2Api = fmap updateApi reg.v2Api } + AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 - aggLock <- submit (actAs dso) $ createCmd AggregateLock with + {- + aggLock <- submit (actAs [alice, dso]) $ createCmd AggregateLock with dso instrumentId = env.instrId.id vestingSchedule = VestingSchedule_SV - Some aggLockDisclosure <- queryDisclosure dso aggLock + -- Some aggLockDisclosure <- queryDisclosure dso aggLock + -} -- Lock some funds for the aggregate - AllocationInstructionResult { output = AllocationInstructionResult_Completed locked } <- lockForAggregate env 1000.0 bob aggLock + AllocationInstructionResult { output = AllocationInstructionResult_Completed locked } <- lockForAggregate env 1000.0 "alice-supervalidator" bob + + Some lockedView <- queryInterfaceContractId bob locked + + allocs <- queryInterface @V2.Allocation dso + let filtered = filter (isValidAggregateLockedAllocation dso) $ fromSome . snd <$> allocs + toKeyAndAmount 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.fromListWith (+) $ toKeyAndAmount <$> filtered + + assertEq (Some 1000.0) (Some "alice-supervalidator" `M.lookup` totals) + + WalletClientV2.withdrawAllocationV2 newRegistries bob (locked, lockedView) + + let bobAcct = V2.Account with + owner = Some bob + provider = Some dso + id = "" + + allocs <- WalletClientV2.listAllocationsV2 bobAcct bob + + -- unlockResult <- WalletClientV2.withdrawAllocationV2 newRegistries bob $ head allocs + + pure () - -- Check total for the aggregate; needs to be implemented. + {- now <- getTime let initialAmountToUnlock = 365.25 @@ -112,6 +165,7 @@ testAggregateLockHappyPath = do assert $ length allocations == 2 -- Need to check other than via inspection that the two allocations actually exist with correct values. + -} -- TODO: Temporary, bad to do this let vestingLockAllocationCid = head [cid | (cid, a) <- allocations, TM.member "cip-105/vestingLock.initialAmount" a.allocation.meta.values] diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 76a08fc7f4..8943cac5af 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -2,25 +2,31 @@ 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.TokenStandard.Utils.Internal.Conversions (decodeTime) 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 qualified DA.List as L +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.allocation.committed , null alloc.allocation.transferLegSides , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "aggregateLock" - , alloc.expiresAt == Some maxBound + , alloc.expiresAt == Some maxComparableTime ] isValidVestingLockedDestination : Party -> V2.AllocationView -> Bool @@ -29,7 +35,7 @@ isValidVestingLockedDestination dso alloc = , alloc.allocation.committed , null alloc.allocation.transferLegSides , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "vestingLock" - , alloc.expiresAt == Some maxBound + , alloc.expiresAt == Some maxTime , TM.member "cip-105/vestingLock.startDate" metaValues , TM.member "cip-105/vestingLock.endDate" metaValues ] @@ -46,14 +52,37 @@ 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 @@ -95,173 +124,188 @@ calculateAvailableWithdrawAmount currentDateTime alloc nextIterationFundAmount = -- vesting to be in a separate dar from amulet only needed for SVs and -- interested observers. -template AggregateLock +{-template AggregateLock with dso: Party instrumentId : Text vestingSchedule : VestingSchedule where signatory dso - nonconsuming choice AggregateLock_Unlock : SettlementFactory_SettleBatchResult - with - factoryCid : ContractId SettlementFactory - lockedCid : ContractId Allocation - withdrawToCid : ContractId Allocation - authorizers : [ Party ] - amount : Decimal - extraArgs : ExtraArgs - where - controller authorizers - do - locked <- view <$> fetchCheckedInterface (ForDso with dso) lockedCid - withdrawTo <- view <$> fetchCheckedInterface (ForDso with dso) withdrawToCid - ownerParty <- whenNone locked.allocation.authorizer.owner $ - assertFail "The requirement 'governance locked allocations must be owned by basic accounts' was not met" - let GovernanceLockedControllers{..} = governanceLockedControllersFromMeta locked.meta ownerParty - require "Unlock controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) unlockControllerSets - require "Not allowed to unlock to a different party than locked the funds" $ locked.allocation.authorizer == withdrawTo.allocation.authorizer - require "Must be a valid governance-locked allocation" $ isValidAggregateLockedAllocation dso locked - require "Must be a valid empty vesting unlock allocation" $ isValidVestingLockedDestination dso withdrawTo - require "Must have amounts reserved within the next settlement iteration" $ isSome locked.allocation.nextIterationFunding - now <- getTime - require "Vesting allocation must have a correct schedule configuration" $ validateVestingSchedule vestingSchedule now withdrawTo.allocation.meta - let - info = SettlementInfo with - executors = [ dso ] - id = "AggregateLock" - cid = Some $ coerceContractId self - meta = emptyMetadata - transferLegId = "unlock" - - currentLockedAmount <- whenNone (locked.allocation.nextIterationFunding >>= TM.lookup instrumentId) $ - assertFail "The requirement 'Must have amounts reserved within the next settlement iteration' was not met" - let newLockedAmount = currentLockedAmount - amount - - exercise factoryCid $ SettlementFactory_SettleBatch with - settlement = info - actors = [ dso ] - extraArgs - transferLegs = - [ TransferLeg with +-} + +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 $ + 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 + + -- 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) + ] + + -- settlementFactoryV2_settleBatchDefaultImpl does not use it's third argument, so we pass undefined rather than require a contract ID for ExternalPartyAmuletRules. + 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 = Some $ TM.singleton instrumentId newLockedAmount + , 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 : V2.AllocationView -> ContractId V2.Allocation -> Allocation_Withdraw -> Update V2.AllocationResult +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 dso 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 $ + 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 + + -- TODO: Potentially do case statement with nextIterationFunding optionals + require "There are remaining funds to withdraw" + $ isSome vestingLock.allocation.nextIterationFunding + + (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 + info = SettlementInfo with + executors = [ vestingLock.allocation.admin ] + id = "VestingLock_Withdraw" + cid = Some $ coerceContractId vestingLockCid + meta = emptyMetadata + 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 = info + 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 - sender = locked.allocation.authorizer - receiver = withdrawTo.allocation.authorizer - amount + side = SenderSide + otherside = vestingLock.allocation.authorizer + amount = remainingVestingAmount instrumentId meta = emptyMetadata - ] - allocations = - [ FinalizedAllocation with - allocationCid = lockedCid - extraTransferLegSides = - [ TransferLegSide with - transferLegId - side = SenderSide - otherside = withdrawTo.allocation.authorizer - amount - instrumentId - meta = emptyMetadata - ] - nextIterationFunding = Some $ TM.singleton instrumentId newLockedAmount - , FinalizedAllocation with - allocationCid = withdrawToCid - extraTransferLegSides = - [ TransferLegSide with - transferLegId - side = ReceiverSide - otherside = locked.allocation.authorizer - amount - instrumentId - meta = emptyMetadata - ] - nextIterationFunding = Some $ TM.singleton instrumentId amount - ] - -- Note: Choice temporarily lives here and it will be moved, testing/draft purposes atm - nonconsuming choice VestingLock_Withdraw : AllocationResult - with - factoryCid : ContractId SettlementFactory - authorizers : [Party] - vestingLockCid : ContractId Allocation - extraArgs : ExtraArgs - where - controller authorizers - do - vestingLock <- view <$> fetchCheckedInterface (ForDso with dso) vestingLockCid - now <- getTime - ownerParty <- whenNone vestingLock.allocation.authorizer.owner $ - assertFail "The requirement 'governance locked allocations must be owned by basic accounts' was not met" - - require "Must be a valid vesting unlock allocation" $ isValidVestingLockedDestination dso vestingLock - require "There must be an initialAmount set for the vestingLock" - $ TM.member "cip-105/vestingLock.initialAmount" vestingLock.allocation.meta.values - let GovernanceLockedControllers{..} = governanceLockedControllersFromMeta vestingLock.meta ownerParty - require "Unlock controller must be one of the options" $ any (\conj -> all (`elem` authorizers) conj) unlockControllerSets - - let mNextIterationFunding = do - fundingMap <- vestingLock.allocation.nextIterationFunding - TM.lookup instrumentId fundingMap - - nextIterationFundingAmount <- case mNextIterationFunding of - None -> abort ("VestingLock's nextIterationFunding should have remaining funds to withdraw for instrumentId " <> show instrumentId) - Some amount -> pure amount - - let (availableWithdrawAmount, remainingVestingAmount) : (Decimal, Decimal) = - calculateAvailableWithdrawAmount now vestingLock nextIterationFundingAmount - - require ("Current eligible withdraw amount for vesting lock should be greater than 0.0. " - <> "currentEligibleWithdrawableAmount came back = '" - <> show availableWithdrawAmount - <> "'." - ) - $ availableWithdrawAmount > 0.0 - - let - info = SettlementInfo with - executors = [ dso ] - id = "AggregateLock" - cid = Some $ coerceContractId self - meta = emptyMetadata - transferLegId = "withdraw" - nextIterationFunding - | remainingVestingAmount <= 0.0 = None - | otherwise = Some $ TM.singleton instrumentId remainingVestingAmount - - batchResults <- exercise factoryCid $ SettlementFactory_SettleBatch with - settlement = info - actors = [ dso ] - extraArgs - transferLegs = - [ TransferLeg with + , TransferLegSide with transferLegId - sender = vestingLock.allocation.authorizer - receiver = vestingLock.allocation.authorizer + side = ReceiverSide + otherside = 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 = nextIterationFunding - ] + nextIterationFunding + ] + + -- We should have one result from settleBatch + case batchResults.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" - -- We should have one result from settleBatch - case batchResults.allocationSettleResults of - [allocationResult] -> pure allocationResult - _ -> abort "VestingUnlock_Withdraw should result in one allocation result. " diff --git a/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml b/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml index 088455e03f..806dbd054b 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,14 +233,22 @@ computeAllocationExpiryInternal transferConfig oldExpiresAt settlementDeadline = | maxTime `subTime` oldExpiresAt <= maxTTL = maxTime | otherwise = oldExpiresAt `addRelTime` maxTTL --- FIXME: the exception to allow Some maxBound is for infinite-duration governance locks, and should probably be limited more explicitly to only those cases. +-- 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 | settlementDeadline == Some maxBound = pure maxBound +computeAllocationExpiry transferConfig oldExpiresAt settlementDeadline | settlementDeadline == Some maxComparableTime = pure maxComparableTime computeAllocationExpiry transferConfig oldExpiresAt settlementDeadline = 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/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-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) From 0f752f121e56b459dfef327f0a2a9767004f3912 Mon Sep 17 00:00:00 2001 From: Cale Gibbard Date: Tue, 28 Jul 2026 16:18:06 +0000 Subject: [PATCH 19/23] Fixes to rebase and update tests --- .../Splice/Scripts/TestAggregateLocks.daml | 335 ++++++++++-------- .../daml/Splice/AggregateLock.daml | 20 +- .../daml/Splice/AmuletAllocationV2.daml | 11 +- 3 files changed, 194 insertions(+), 172 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index 717a9e6a02..e46429c7d5 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -1,54 +1,31 @@ {-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} 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.Amulet + import Splice.AggregateLock -import Splice.AmuletRules -import Splice.Expiry -import Splice.Scripts.Util -import Splice.TokenStandard.Utils qualified as TSU +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.Testing.TokenStandard.RegistryApiV2 -import Splice.Testing.TokenStandard.WalletClientV2 qualified as WalletClientV2 -import Splice.Testing.Registries.AmuletRegistryV2 import Splice.Api.Token.MetadataV1 -import Splice.Api.Token.AllocationV2 -import Splice.Api.Token.AllocationInstructionV2 -import Splice.Api.Token.HoldingV2 -import Splice.AmuletAllocationV2 -import Splice.Testing.Utils - -import Splice.ExternalPartyAmuletRules - -import DA.Assert -import DA.Optional -import DA.Functor -import DA.Foldable (mapA_, sequence_) -import DA.List (head) -import qualified DA.TextMap as TM -import qualified DA.Map as M - 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.Util.Token.Wallet.BatchingUtilityV2 qualified as BatchingUtilityV2 +import Splice.Testing.Utils +import Splice.TokenStandard.Utils qualified as TSU import Splice.TokenStandard.Utils.Internal.Conversions (encodeTime) -newtype AmuletRegistryExtraWithdrawContext = AmuletRegistryExtraWithdrawContext { unExtra : AmuletRegistry } - -instance RegistryApi AmuletRegistryExtraWithdrawContext where - getTransferFactory = getTransferFactory . unExtra - getAllocationFactory = getAllocationFactory . unExtra - getSettlementFactory = getSettlementFactory . unExtra - getAllocation_WithdrawContext = getAllocation_WithdrawContext . unExtra - getAllocation_CancelContext = getAllocation_CancelContext . unExtra - getAllocationInstruction_WithdrawContext = getAllocationInstruction_WithdrawContext . unExtra - getAllocationInstruction_AcceptContext = getAllocationInstruction_AcceptContext . unExtra - getTransferInstruction_AcceptContext = getTransferInstruction_AcceptContext . unExtra - getTransferInstruction_RejectContext = getTransferInstruction_RejectContext . unExtra - getTransferInstruction_WithdrawContext = getTransferInstruction_WithdrawContext . unExtra lockForGovernance : TestEnv -> TM.TextMap Decimal -> Metadata -> Party -> Script AllocationInstructionResult lockForGovernance (TestEnv {..}) amounts meta party = do @@ -57,14 +34,14 @@ lockForGovernance (TestEnv {..}) amounts meta party = do lockSettlementInfo = V2.SettlementInfo with executors = [ instrId.admin ] id = "AggregateLock" - cid = None -- Some $ coerceContractId aggCid + cid = None meta = emptyMetadata lockAllocation = V2.AllocationSpecification with admin = instrId.admin - authorizer = TSU.basicAccount bob + authorizer = TSU.basicAccount party transferLegSides = [] committed = True - nextIterationFunding = Some $ amounts -- TM.fromList [(instrId.id, amount)] + nextIterationFunding = Some amounts settlementDeadline = Some maxComparableTime meta @@ -75,140 +52,184 @@ lockForAggregate te amount lockName = lockForGovernance te (TM.fromList [(te.ins , ("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.empty $ 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) - ] +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 } -testAggregateLockHappyPath : Script () -testAggregateLockHappyPath = do +-- | 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 - let - addAggregateWithdrawContext : Script OpenApiChoiceContext -> Script OpenApiChoiceContext - addAggregateWithdrawContext a = do - baseCtxt <- a - extraContext <- getExternalPartyConfigStateContext registriesEnv.amuletV2 - pure $ baseCtxt <> extraContext - updateApi api = api { ggetAllocation_WithdrawContext = \a -> addAggregateWithdrawContext . api.ggetAllocation_WithdrawContext a } - newRegistries = flip fmap registries $ \reg -> - reg { v2Api = fmap updateApi reg.v2Api } - AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 - - {- - aggLock <- submit (actAs [alice, dso]) $ createCmd AggregateLock with - dso - instrumentId = env.instrId.id - vestingSchedule = VestingSchedule_SV - -- Some aggLockDisclosure <- queryDisclosure dso aggLock - -} - - -- Lock some funds for the aggregate - AllocationInstructionResult { output = AllocationInstructionResult_Completed locked } <- lockForAggregate env 1000.0 "alice-supervalidator" bob - Some lockedView <- queryInterfaceContractId bob locked + _ <- 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 filtered = filter (isValidAggregateLockedAllocation dso) $ fromSome . snd <$> allocs - toKeyAndAmount 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.fromListWith (+) $ toKeyAndAmount <$> filtered + 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 1000.0) (Some "alice-supervalidator" `M.lookup` totals) - - WalletClientV2.withdrawAllocationV2 newRegistries bob (locked, lockedView) - - let bobAcct = V2.Account with - owner = Some bob - provider = Some dso - id = "" - - allocs <- WalletClientV2.listAllocationsV2 bobAcct bob - - -- unlockResult <- WalletClientV2.withdrawAllocationV2 newRegistries bob $ head allocs - - pure () - - {- - - now <- getTime - let initialAmountToUnlock = 365.25 - AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingInput } <- lockForVesting initialAmountToUnlock now env bob aggLock - - -- use getSettlementFactory to get the extraArgs and disclosures to call AggregateLock_Unlock - enriched <- getSettlementFactory registriesEnv.amuletV2 $ SettlementFactory_SettleBatch with - settlement = SettlementInfo with - executors = [ dso ] - id = "AggregateLock" - cid = None - meta = emptyMetadata - actors = [ dso ] - extraArgs = emptyExtraArgs - transferLegs = [] - allocations = [] + assertEq (Some 300.0) (Some "charlie-supervalidator" `M.lookup` totals) - submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ AggregateLock_Unlock with - factoryCid = enriched.factoryCid - lockedCid = locked - withdrawToCid = vestingInput - authorizers = [ bob ] - amount = initialAmountToUnlock - extraArgs = enriched.arg.extraArgs +-- | 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 - allocations <- query @AmuletAllocationV2 bob + AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 + AllocationInstructionResult { output = AllocationInstructionResult_Completed locked } <- + lockForAggregate env 1000.0 "alice-supervalidator" bob + Some lockedView <- queryInterfaceContractId bob locked - assert $ length allocations == 2 + _ <- WalletClientV2.withdrawAllocationV2 newRegistries bob (locked, lockedView) + + 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) === 0.0 + fromOptional 0.0 (vesting.allocation.nextIterationFunding >>= TM.lookup instrId.id) === 1000.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 - -- Need to check other than via inspection that the two allocations actually exist with correct values. - -} + AmuletRegistryV2.tapFaucet registriesEnv.amuletV2 bob 1800.0 - -- TODO: Temporary, bad to do this - let vestingLockAllocationCid = head [cid | (cid, a) <- allocations, TM.member "cip-105/vestingLock.initialAmount" a.allocation.meta.values] + vestStart <- getTime + AllocationInstructionResult { output = AllocationInstructionResult_Completed vestingLockCid } <- + lockForVesting initialAmount vestStart env bob + Some vestingLockView <- queryInterfaceContractId bob vestingLockCid - -- Immediate withdraw attempt causes transaction to fail due to the current - -- eligible withdraw amount being zero (no time has passed since locking yet) - submitMustFail (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with - factoryCid = enriched.factoryCid - authorizers = [ bob ] - vestingLockCid = toInterfaceContractId vestingLockAllocationCid - extraArgs = enriched.arg.extraArgs + -- Withdrawing immediately fails: nothing has vested yet. + vestingLockView.allocation.admin `submitMustFailWithdraw` (vestingLockCid, vestingLockView) $ newRegistries - -- Time needs to pass to be able to withdraw from the VestingLock + -- After some time passes a proportional amount can be withdrawn. passTime (days 10) + vestingResult1 <- 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 <- 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 + +-- | 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 + +-- | 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 + +-- | 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) - (AllocationResult vestingAllocResult tmHoldingCids _) <- submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with - factoryCid = enriched.factoryCid - authorizers = [ bob ] - vestingLockCid = toInterfaceContractId vestingLockAllocationCid - extraArgs = enriched.arg.extraArgs - - let holdingCids = fromSome $ TM.lookup env.instrId.id tmHoldingCids - holdings <- queryInterface @Holding bob - -- The holdings would include both locked/unlocked, so we filter - let [(_, (Some unlockedHolding))] = filter (\(hcid, (Some h)) -> isNone h.lock && hcid `elem` holdingCids) holdings - - assertEq unlockedHolding.amount 10.0000000105 - - -- Let's try to withdraw the rest (now we should be past endDate) - passTime (days 365) - - (AllocationResult vestingAllocResult' tmHoldingCids' _) <- submit (actAs bob <> disclose aggLockDisclosure <> discloseMany' enriched.disclosures ) $ exerciseCmd aggLock $ VestingLock_Withdraw with - factoryCid = enriched.factoryCid - authorizers = [ bob ] - vestingLockCid = fromSome $ vestingAllocResult.nextIterationAllocationCid - extraArgs = enriched.arg.extraArgs - - -- We should have no more remaining amount vesting, once the full period has passed - assertEq None $ vestingAllocResult'.nextIterationAllocationCid - - let holdingCids' = fromSome $ TM.lookup env.instrId.id tmHoldingCids' - holdings' <- queryInterface @Holding bob - -- The holdings would include both locked/unlocked, so we filter - let [(_, (Some unlockedHolding'))] = filter (\(hcid, (Some h)) -> isNone h.lock && hcid `elem` holdingCids') holdings' - - assertEq initialAmountToUnlock $ unlockedHolding.amount + unlockedHolding'.amount +testAggregateLockHappyPath : Script () +testAggregateLockHappyPath = do + testAggregateLockTotals + testAggregateLockUnlockCreatesVestingLock + testVestingLockWithdraw diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 8943cac5af..e779c3fa08 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -35,7 +35,7 @@ isValidVestingLockedDestination dso alloc = , alloc.allocation.committed , null alloc.allocation.transferLegSides , TM.lookup "cip-105/type" alloc.allocation.meta.values == Some "vestingLock" - , alloc.expiresAt == Some maxTime + , alloc.expiresAt == Some maxComparableTime , TM.member "cip-105/vestingLock.startDate" metaValues , TM.member "cip-105/vestingLock.endDate" metaValues ] @@ -137,7 +137,7 @@ aggregateLockUnlock : (HasToInterface a V2.Allocation) => (a -> Time -> Metadata 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" @@ -151,24 +151,24 @@ aggregateLockUnlock newEmptyAllocation a aCid arg = do 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 - + -- 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) ] - + -- settlementFactoryV2_settleBatchDefaultImpl does not use it's third argument, so we pass undefined rather than require a contract ID for ExternalPartyAmuletRules. settleBatchResult <- settlementFactoryV2_settleBatchDefaultImplNoSelf (\_ _ -> pure arg.extraArgs) dso $ SettlementFactory_SettleBatch with settlement = alloc.settlement @@ -220,8 +220,8 @@ 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 dso vestingLock + + 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 @@ -297,8 +297,8 @@ vestingLockWithdraw a aCid arg = do nextIterationFunding ] - -- We should have one result from settleBatch - case batchResults.allocationSettleResults of + -- We should have one result from settleBatch + case settleResult.allocationSettleResults of [allocationResult] -> pure allocationResult _ -> abort "VestingUnlock_Withdraw should result in one allocation result. " diff --git a/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml b/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml index 806dbd054b..aefff68139 100644 --- a/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml +++ b/daml/splice-amulet/daml/Splice/AmuletAllocationV2.daml @@ -235,11 +235,12 @@ computeAllocationExpiryInternal transferConfig oldExpiresAt settlementDeadline = -- 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 | settlementDeadline == Some maxComparableTime = pure maxComparableTime -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 From f312c8a8d3a98796e6ac22ca5b49762847730750 Mon Sep 17 00:00:00 2001 From: "Jonathan D.K. Gibbons" Date: Tue, 28 Jul 2026 17:35:57 +0000 Subject: [PATCH 20/23] Fix tests and a couple bugs in vesting withdraw. --- .../daml/Splice/Scripts/TestAggregateLocks.daml | 17 ++--------------- .../daml/Splice/AggregateLock.daml | 9 ++------- .../Testing/TokenStandard/WalletClientV2.daml | 7 +++++++ 3 files changed, 11 insertions(+), 22 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index e46429c7d5..effb4c0831 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -21,7 +21,6 @@ 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.Util.Token.Wallet.BatchingUtilityV2 qualified as BatchingUtilityV2 import Splice.Testing.Utils import Splice.TokenStandard.Utils qualified as TSU import Splice.TokenStandard.Utils.Internal.Conversions (encodeTime) @@ -168,7 +167,7 @@ testVestingLockWithdraw = do -- After some time passes a proportional amount can be withdrawn. passTime (days 10) - vestingResult1 <- extractAllocationResult <$> + vestingResult1 <- WalletClientV2.extractAllocationResult <$> WalletClientV2.withdrawAllocationV2 newRegistries bob (vestingLockCid, vestingLockView) let holdingCids1 = fromSome $ TM.lookup instrId.id vestingResult1.authorizerHoldingCids @@ -182,7 +181,7 @@ testVestingLockWithdraw = do -- After the full period has elapsed the remainder becomes withdrawable. passTime (days 365) Some nextView <- queryInterfaceContractId bob nextCid - vestingResult2 <- extractAllocationResult <$> + vestingResult2 <- WalletClientV2.extractAllocationResult <$> WalletClientV2.withdrawAllocationV2 newRegistries bob (nextCid, nextView) let holdingCids2 = fromSome $ TM.lookup instrId.id vestingResult2.authorizerHoldingCids @@ -210,12 +209,6 @@ submitMustFailWithdraw admin (allocCid, _allocView) registries = do context = context.choiceContext meta = emptyMetadata --- | 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 - -- | Sum the amounts of the given (unlocked) holding contracts owned by @p@. unlockedAmountOf : Party -> [ContractId V2.Holding] -> Script Decimal unlockedAmountOf p wantedCids = do @@ -227,9 +220,3 @@ unlockedAmountOf p wantedCids = do , isNone h.lock ] pure $ sum (fmap (.amount) matching) - -testAggregateLockHappyPath : Script () -testAggregateLockHappyPath = do - testAggregateLockTotals - testAggregateLockUnlockCreatesVestingLock - testVestingLockWithdraw diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index e779c3fa08..43f2807b5f 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -252,18 +252,13 @@ vestingLockWithdraw a aCid arg = do $ availableWithdrawAmount > 0.0 let - info = SettlementInfo with - executors = [ vestingLock.allocation.admin ] - id = "VestingLock_Withdraw" - cid = Some $ coerceContractId vestingLockCid - meta = emptyMetadata 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 = info + settlement = vestingLock.settlement actors = [ vestingLock.allocation.admin ] extraArgs = ExtraArgs emptyChoiceContext emptyMetadata transferLegs = @@ -283,7 +278,7 @@ vestingLockWithdraw a aCid arg = do transferLegId side = SenderSide otherside = vestingLock.allocation.authorizer - amount = remainingVestingAmount + amount = availableWithdrawAmount instrumentId meta = emptyMetadata , TransferLegSide with 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..811786435e 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 @@ -73,6 +73,7 @@ module Splice.Testing.TokenStandard.WalletClientV2 -- ** Allocations extractNextIterationAllocationCid, + extractAllocationResult, mkAllocationFactory_AllocateV2, mkAllocationInstruction_AcceptV2, @@ -469,6 +470,12 @@ withdrawAllocationV2 registries actor alloc = do batch <- mkAllocation_WithdrawV2 registries actor alloc 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) From d601e0ebd6c25a4a52b6cdd922c4f363945074f0 Mon Sep 17 00:00:00 2001 From: "Jonathan D.K. Gibbons" Date: Tue, 28 Jul 2026 20:21:53 +0000 Subject: [PATCH 21/23] Fixes and test updates. --- .../Splice/Scripts/TestAggregateLocks.daml | 73 ++++++++++++++++++- .../daml/Splice/AggregateLock.daml | 15 ++-- .../Testing/TokenStandard/WalletClientV2.daml | 16 +++- 3 files changed, 90 insertions(+), 14 deletions(-) diff --git a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml index effb4c0831..43fc641f00 100644 --- a/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml +++ b/daml/splice-amulet-test/daml/Splice/Scripts/TestAggregateLocks.daml @@ -85,8 +85,10 @@ 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 @@ -100,7 +102,7 @@ testAggregateLockTotals = do ) totals = M.fromListWithR (+) $ benefitOfAmount <$> aggregateLocks - assertEq (Some 1000.0) (Some "alice-supervalidator" `M.lookup` totals) + 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 @@ -119,19 +121,55 @@ testAggregateLockUnlockCreatesVestingLock = do _ <- 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) === 0.0 - fromOptional 0.0 (vesting.allocation.nextIterationFunding >>= TM.lookup instrId.id) === 1000.0 + 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 @@ -190,6 +228,35 @@ testVestingLockWithdraw = do 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 diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index 43f2807b5f..c9e47ee31e 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -146,7 +146,7 @@ aggregateLockUnlock newEmptyAllocation a aCid arg = do let dso = alloc.allocation.admin - ownerParty <- whenNone alloc.allocation.authorizer.owner $ + 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 @@ -161,6 +161,9 @@ aggregateLockUnlock newEmptyAllocation a aCid arg = do 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 @@ -169,7 +172,6 @@ aggregateLockUnlock newEmptyAllocation a aCid arg = do , ("cip-105/vestingLock.endDate", encodeTime $ endTime) ] - -- settlementFactoryV2_settleBatchDefaultImpl does not use it's third argument, so we pass undefined rather than require a contract ID for ExternalPartyAmuletRules. settleBatchResult <- settlementFactoryV2_settleBatchDefaultImplNoSelf (\_ _ -> pure arg.extraArgs) dso $ SettlementFactory_SettleBatch with settlement = alloc.settlement actors = [ dso ] @@ -195,7 +197,7 @@ aggregateLockUnlock newEmptyAllocation a aCid arg = do instrumentId meta = emptyMetadata ] - nextIterationFunding = Some $ TM.singleton instrumentId newLockedAmount + nextIterationFunding = newLockedNextIterationFunding , FinalizedAllocation with allocationCid = withdrawTo extraTransferLegSides = @@ -214,7 +216,6 @@ aggregateLockUnlock newEmptyAllocation a aCid arg = do getEndTimeFromVestingSchedule VestingSchedule_SV now = addRelTime now $ days 365 + hours 6 getEndTimeFromVestingSchedule VestingSchedule_Immediate now = now --- vestingLockWithdraw : V2.AllocationView -> ContractId V2.Allocation -> Allocation_Withdraw -> Update V2.AllocationResult 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 @@ -225,16 +226,12 @@ vestingLockWithdraw a aCid arg = do 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 $ + 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 - -- TODO: Potentially do case statement with nextIterationFunding optionals - require "There are remaining funds to withdraw" - $ isSome vestingLock.allocation.nextIterationFunding - (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" 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 811786435e..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, @@ -470,6 +471,14 @@ 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 @@ -819,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 @@ -827,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] From 6dd81b319fc1dc2c71a89e0381e432bc5c94af71 Mon Sep 17 00:00:00 2001 From: "Jonathan D.K. Gibbons" Date: Wed, 29 Jul 2026 13:29:27 +0000 Subject: [PATCH 22/23] Check executors in isValid checks. --- daml/splice-amulet/daml/Splice/AggregateLock.daml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index c9e47ee31e..daae8931c4 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -23,6 +23,7 @@ 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" @@ -32,6 +33,7 @@ isValidAggregateLockedAllocation dso alloc = 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" From 7d5a0eaa1d8dbbce7d396e498ceb99cc8411a7b0 Mon Sep 17 00:00:00 2001 From: "Jonathan D.K. Gibbons" Date: Wed, 29 Jul 2026 13:34:15 +0000 Subject: [PATCH 23/23] Remove commented out AggregateLock template. --- daml/splice-amulet/daml/Splice/AggregateLock.daml | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/daml/splice-amulet/daml/Splice/AggregateLock.daml b/daml/splice-amulet/daml/Splice/AggregateLock.daml index daae8931c4..b6bf85fd49 100644 --- a/daml/splice-amulet/daml/Splice/AggregateLock.daml +++ b/daml/splice-amulet/daml/Splice/AggregateLock.daml @@ -119,21 +119,6 @@ calculateAvailableWithdrawAmount currentDateTime alloc nextIterationFundAmount = totalVestedRatioElapsed : Decimal = unlockPeriodElapsed / totalUnlockPeriod withdrawnAmount = initialAmount - nextIterationFundAmount --- | The intention is to treat the overall aggregate lock for a SV as if it is --- "the settlement" for the allocations locked to it, and use iterated --- settlement to execute updates on the committed allocations as needed. --- This approach would permit most of the specific governance locking and --- vesting to be in a separate dar from amulet only needed for SVs and --- interested observers. - -{-template AggregateLock - with - dso: Party - instrumentId : Text - vestingSchedule : VestingSchedule - where - signatory dso --} 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