Enforce vesting condition graph integrity

OpenCapTable-v34/daml.yaml

@@ -1,7 +1,7 @@
 sdk-version: 3.4.10
 name: OpenCapTable-v34
 source: daml
-version: 0.0.12
+version: 0.0.13
 build-options:
   - -Wno-crypto-text-is-alpha
   - --typecheck-upgrades=no

OpenCapTable-v34/daml/Fairmint/OpenCapTable/OCF/VestingTerms.daml

@@ -4,6 +4,9 @@ module Fairmint.OpenCapTable.OCF.VestingTerms where
 import Fairmint.OpenCapTable.Types.Core (Context)
 import Fairmint.OpenCapTable.Types.Validation (validateNonEmptyStringsArray)
 import Fairmint.Shared.TypeHelpers (validateOptionalText)
+import qualified DA.Map as Map
+import qualified DA.Optional as Optional
+import qualified DA.Set as Set
 
 
 template VestingTerms
@@ -51,7 +54,8 @@ validateOcfVestingTermsData d =
   d.name /= "" && d.description /= "" &&
   validateNonEmptyStringsArray d.comments &&
   (not (null d.vesting_conditions)) &&
-  all validateOcfVestingCondition d.vesting_conditions
+  all validateOcfVestingCondition d.vesting_conditions &&
+  validateOcfVestingConditionGraph d.vesting_conditions
 
 -- Enum - Allocation Type
 -- Enumeration of allocation types for vesting terms. Using an example of 18 shares split across 4 tranches, each allocation type results in a different schedule.
@@ -221,3 +225,157 @@ validateOcfVestingCondition c =
   optional True validateOcfVestingConditionPortion c.portion &&
   validateOcfVestingTrigger c.trigger &&
   validateNonEmptyStringsArray c.next_condition_ids
+
+vestingConditionIds : [OcfVestingCondition] -> [Text]
+vestingConditionIds conditions = map (\condition -> condition.id) conditions
+
+vestingGraphRootConditionId : [OcfVestingCondition] -> Optional Text
+vestingGraphRootConditionId conditions = case conditions of
+  root :: _ -> Some root.id
+  [] -> None
+
+hasAtMostOneVestingStartTrigger : [OcfVestingCondition] -> Bool
+hasAtMostOneVestingStartTrigger conditions =
+  foldl
+    (\count condition -> case condition.trigger of
+      OcfVestingStartTrigger -> count + 1
+      _ -> count)
+    0
+    conditions <= 1
+
+hasDuplicateTexts : [Text] -> Bool
+hasDuplicateTexts texts = hasDuplicateTextsSeen Set.empty texts
+
+hasDuplicateTextsSeen : Set.Set Text -> [Text] -> Bool
+hasDuplicateTextsSeen seen remaining = case remaining of
+  [] -> False
+  text :: rest ->
+    Set.member text seen || hasDuplicateTextsSeen (Set.insert text seen) rest
+
+conditionEdgeIds : Map.Map Text [Text] -> Text -> [Text]
+conditionEdgeIds edges conditionId =
+  Optional.fromOptional [] (Map.lookup conditionId edges)
+
+reachableConditionIds : Map.Map Text [Text] -> Set.Set Text -> [Text] -> Set.Set Text
+reachableConditionIds edges visited pending = case pending of
+  [] -> visited
+  currentId :: rest ->
+    if Set.member currentId visited
+      then reachableConditionIds edges visited rest
+      else reachableConditionIds edges (Set.insert currentId visited) (conditionEdgeIds edges currentId ++ rest)
+
+reachableConditionIdsAvoiding : Map.Map Text [Text] -> Text -> Set.Set Text -> [Text] -> Set.Set Text
+reachableConditionIdsAvoiding edges blockedId visited pending = case pending of
+  [] -> visited
+  currentId :: rest ->
+    if currentId == blockedId || Set.member currentId visited
+      then reachableConditionIdsAvoiding edges blockedId visited rest
+      else reachableConditionIdsAvoiding edges blockedId (Set.insert currentId visited) (conditionEdgeIds edges currentId ++ rest)
+
+conditionReachesTarget : Map.Map Text [Text] -> Text -> Text -> Bool
+conditionReachesTarget edges sourceId targetId =
+  Set.member targetId (reachableConditionIds edges Set.empty [sourceId])
+
+conditionReachesTargetAvoiding : Map.Map Text [Text] -> Text -> Text -> Text -> Bool
+conditionReachesTargetAvoiding edges blockedId sourceId targetId =
+  Set.member targetId (reachableConditionIdsAvoiding edges blockedId Set.empty [sourceId])
+
+allConditionsReachableFromStart : Map.Map Text [Text] -> Text -> [OcfVestingCondition] -> Bool
+allConditionsReachableFromStart nextEdges startConditionId conditions =
+  let reachableIds = reachableConditionIds nextEdges Set.empty [startConditionId]
+  in all (\condition -> Set.member condition.id reachableIds) conditions
+
+vestingTriggerReferencesKnownCondition : [Text] -> Map.Map Text [Text] -> OcfVestingCondition -> Bool
+vestingTriggerReferencesKnownCondition conditionIds nextEdges condition = case condition.trigger of
+  OcfVestingScheduleRelativeTrigger{relative_to_condition_id} ->
+    relative_to_condition_id /= condition.id &&
+    relative_to_condition_id `elem` conditionIds &&
+    conditionReachesTarget nextEdges relative_to_condition_id condition.id
+  _ -> True
+
+vestingConditionReferencesKnownConditions : [Text] -> Map.Map Text [Text] -> OcfVestingCondition -> Bool
+vestingConditionReferencesKnownConditions conditionIds nextEdges condition =
+  not (hasDuplicateTexts condition.next_condition_ids) &&
+  all (`elem` conditionIds) condition.next_condition_ids &&
+  vestingTriggerReferencesKnownCondition conditionIds nextEdges condition
+
+vestingTriggerAnchorDominatesCondition : Map.Map Text [Text] -> Text -> OcfVestingCondition -> Bool
+vestingTriggerAnchorDominatesCondition nextEdges startConditionId condition = case condition.trigger of
+  OcfVestingScheduleRelativeTrigger{relative_to_condition_id} ->
+    not (conditionReachesTargetAvoiding nextEdges relative_to_condition_id startConditionId condition.id)
+  _ -> True
+
+addDependentEdge : Text -> Text -> Map.Map Text [Text] -> Map.Map Text [Text]
+addDependentEdge fromConditionId toConditionId edges =
+  let conditionEdges = Optional.fromOptional [] (Map.lookup fromConditionId edges)
+      updatedEdges =
+        if toConditionId `elem` conditionEdges
+          then conditionEdges
+          else toConditionId :: conditionEdges
+  in Map.insert fromConditionId updatedEdges edges
+
+vestingConditionEdges : [OcfVestingCondition] -> Map.Map Text [Text]
+vestingConditionEdges conditions =
+  let baseEdges = Map.fromList (map (\condition -> (condition.id, condition.next_condition_ids)) conditions)
+  in foldl addRelativeEdge baseEdges conditions
+  where
+    addRelativeEdge : Map.Map Text [Text] -> OcfVestingCondition -> Map.Map Text [Text]
+    addRelativeEdge edges condition = case condition.trigger of
+      OcfVestingScheduleRelativeTrigger{relative_to_condition_id} ->
+        addDependentEdge relative_to_condition_id condition.id edges
+      _ -> edges
+
+data CycleCheckResult = CycleCheckResult with
+    has_cycle: Bool
+    checked: Set.Set Text
+  deriving (Eq, Show)
+
+vestingConditionCycleCheck :
+  Map.Map Text [Text] ->
+  Set.Set Text ->
+  Set.Set Text ->
+  Text ->
+  CycleCheckResult
+vestingConditionCycleCheck edges visiting checked conditionId
+  | Set.member conditionId visiting = CycleCheckResult with has_cycle = True; checked = checked
+  | Set.member conditionId checked = CycleCheckResult with has_cycle = False; checked = checked
+  | otherwise =
+      let result =
+            foldl
+              (\current nextId ->
+                if current.has_cycle
+                  then current
+                  else vestingConditionCycleCheck edges (Set.insert conditionId visiting) current.checked nextId)
+              (CycleCheckResult with has_cycle = False; checked = checked)
+              (conditionEdgeIds edges conditionId)
+      in
+        if result.has_cycle
+          then result
+          else result with checked = Set.insert conditionId result.checked
+
+vestingConditionGraphHasCycle : Map.Map Text [Text] -> [Text] -> Bool
+vestingConditionGraphHasCycle edges conditionIds =
+  let result =
+        foldl
+          (\current conditionId ->
+            if current.has_cycle
+              then current
+              else vestingConditionCycleCheck edges Set.empty current.checked conditionId)
+          (CycleCheckResult with has_cycle = False; checked = Set.empty)
+          conditionIds
+  in result.has_cycle
+
+validateOcfVestingConditionGraph : [OcfVestingCondition] -> Bool
+validateOcfVestingConditionGraph conditions =
+  let conditionIds = vestingConditionIds conditions
+      nextEdges = Map.fromList (map (\condition -> (condition.id, condition.next_condition_ids)) conditions)
+      edges = vestingConditionEdges conditions
+  in not (hasDuplicateTexts conditionIds) &&
+     hasAtMostOneVestingStartTrigger conditions &&
+     all (vestingConditionReferencesKnownConditions conditionIds nextEdges) conditions &&
+     (case vestingGraphRootConditionId conditions of
+       Some startConditionId ->
+         allConditionsReachableFromStart nextEdges startConditionId conditions &&
+         all (vestingTriggerAnchorDominatesCondition nextEdges startConditionId) conditions
+       None -> False) &&
+     not (vestingConditionGraphHasCycle edges conditionIds)

Test/daml.yaml

@@ -7,6 +7,6 @@ dependencies:
   - daml-stdlib
   - daml-script
 data-dependencies:
-  - ../OpenCapTable-v34/.daml/dist/OpenCapTable-v34-0.0.12.dar
+  - ../OpenCapTable-v34/.daml/dist/OpenCapTable-v34-0.0.13.dar
 build-options:
   - -Wno-template-interface-depends-on-daml-script

Test/daml/OpenCapTable/TestVestingTerms.daml

@@ -25,6 +25,40 @@ createVestingTerms issuer capTableCid =
       edits = []
       deletes = []
 
+vestingCondition : Text -> OcfVestingTrigger -> [Text] -> OcfVestingCondition
+vestingCondition conditionId trigger nextConditionIds =
+  OcfVestingCondition with
+    id = conditionId
+    description = Some conditionId
+    portion = None
+    quantity = Some 1.0
+    trigger = trigger
+    next_condition_ids = nextConditionIds
+
+vestingTermsData : Text -> [OcfVestingCondition] -> VestingTermsOcfData
+vestingTermsData vestingTermsId conditions =
+  VestingTermsOcfData with
+    id = vestingTermsId
+    name = vestingTermsId
+    description = vestingTermsId
+    allocation_type = OcfAllocationCumulativeRounding
+    vesting_conditions = conditions
+    comments = []
+
+createVestingTermsData issuer capTableCid data_ =
+  submit issuer do
+    exerciseCmd capTableCid CT.UpdateCapTable with
+      creates = [CT.OcfCreateVestingTerms data_]
+      edits = []
+      deletes = []
+
+createVestingTermsDataMustFail issuer capTableCid data_ =
+  submitMustFail issuer do
+    exerciseCmd capTableCid CT.UpdateCapTable with
+      creates = [CT.OcfCreateVestingTerms data_]
+      edits = []
+      deletes = []
+
 testCreateAndArchiveVestingTerms = script do
   TestOcp{system_operator, issuer, ctx, cap_table} <- setupTestOcp
   _ <- createVestingTerms issuer cap_table
@@ -113,3 +147,138 @@ testVestingTerms_ZeroDenominatorFails = script do
         comments = []]
       edits = []
       deletes = []
+
+testVestingTerms_DuplicateConditionIdsFail = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let duplicateA = vestingCondition "dup" OcfVestingStartTrigger []
+  let duplicateB = vestingCondition "dup" (OcfVestingEventTrigger) []
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_DUP_COND" [duplicateA, duplicateB])
+  pure ()
+
+testVestingTerms_DuplicateNextConditionIdsFail = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let start = vestingCondition "start" OcfVestingStartTrigger ["next", "next"]
+  let next = vestingCondition "next" OcfVestingEventTrigger []
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_DUP_NEXT" [start, next])
+  pure ()
+
+testVestingTerms_MissingNextConditionIdFails = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let start = vestingCondition "start" OcfVestingStartTrigger ["missing"]
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_MISSING_NEXT" [start])
+  pure ()
+
+testVestingTerms_MissingRelativeConditionIdFails = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let start = vestingCondition "start" OcfVestingStartTrigger ["relative"]
+  let relative = vestingCondition
+        "relative"
+        (OcfVestingScheduleRelativeTrigger with
+          period = OcfVestingPeriodDays with length_ = 30, occurrences = 1, cliff_installment = None
+          relative_to_condition_id = "missing")
+        []
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_MISSING_RELATIVE" [start, relative])
+  pure ()
+
+testVestingTerms_RelativeConditionCannotReferenceSelf = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let selfRelative = vestingCondition
+        "self"
+        (OcfVestingScheduleRelativeTrigger with
+          period = OcfVestingPeriodDays with length_ = 30, occurrences = 1, cliff_installment = None
+          relative_to_condition_id = "self")
+        []
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_SELF_RELATIVE" [selfRelative])
+  pure ()
+
+testVestingTerms_RelativeConditionMustBePredecessorFails = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let start = vestingCondition "start" OcfVestingStartTrigger ["other", "relative"]
+  let other = vestingCondition "other" OcfVestingEventTrigger []
+  let relative = vestingCondition
+        "relative"
+        (OcfVestingScheduleRelativeTrigger with
+          period = OcfVestingPeriodDays with length_ = 30, occurrences = 1, cliff_installment = None
+          relative_to_condition_id = "other")
+        []
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_RELATIVE_PREDECESSOR" [start, other, relative])
+  pure ()
+
+testVestingTerms_RelativeAnchorMustDominateAllPathsFails = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let start = vestingCondition "start" OcfVestingStartTrigger ["anchor", "bypass"]
+  let anchor = vestingCondition "anchor" OcfVestingEventTrigger ["relative"]
+  let bypass = vestingCondition "bypass" OcfVestingEventTrigger ["relative"]
+  let relative = vestingCondition
+        "relative"
+        (OcfVestingScheduleRelativeTrigger with
+          period = OcfVestingPeriodDays with length_ = 30, occurrences = 1, cliff_installment = None
+          relative_to_condition_id = "anchor")
+        []
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_RELATIVE_DOMINATOR" [start, anchor, bypass, relative])
+  pure ()
+
+testVestingTerms_EventOnlyRootIsValid = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let eventRoot = vestingCondition "qualifying-sale" OcfVestingEventTrigger []
+  _ <- createVestingTermsData issuer cap_table (vestingTermsData "VT_EVENT_ONLY_ROOT" [eventRoot])
+  pure ()
+
+testVestingTerms_OrphanConditionFails = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let start = vestingCondition "start" OcfVestingStartTrigger []
+  let orphan = vestingCondition "orphan" OcfVestingEventTrigger []
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_ORPHAN" [start, orphan])
+  pure ()
+
+testVestingTerms_FirstConditionIsGraphRoot = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let start = vestingCondition "start" OcfVestingStartTrigger ["next"]
+  let next = vestingCondition "next" OcfVestingEventTrigger []
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_UNORDERED_START" [next, start])
+  pure ()
+
+testVestingTerms_ReachableSecondStartConditionFails = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let firstStart = vestingCondition "start_one" OcfVestingStartTrigger ["start_two"]
+  let secondStart = vestingCondition "start_two" OcfVestingStartTrigger ["next"]
+  let next = vestingCondition "next" OcfVestingEventTrigger []
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_MULTIPLE_STARTS" [firstStart, secondStart, next])
+  pure ()
+
+testVestingTerms_CyclicNextConditionsFail = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let first = vestingCondition "first" OcfVestingStartTrigger ["second"]
+  let second = vestingCondition "second" OcfVestingEventTrigger ["first"]
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_CYCLE" [first, second])
+  pure ()
+
+testVestingTerms_MutualRelativeConditionsWithoutRootFail = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let first = vestingCondition
+        "first"
+        (OcfVestingScheduleRelativeTrigger with
+          period = OcfVestingPeriodDays with length_ = 30, occurrences = 1, cliff_installment = None
+          relative_to_condition_id = "second")
+        []
+  let second = vestingCondition
+        "second"
+        (OcfVestingScheduleRelativeTrigger with
+          period = OcfVestingPeriodDays with length_ = 30, occurrences = 1, cliff_installment = None
+          relative_to_condition_id = "first")
+        []
+  createVestingTermsDataMustFail issuer cap_table (vestingTermsData "VT_CYCLE_RELATIVE" [first, second])
+  pure ()
+
+testVestingTerms_EditCannotCreateInvalidGraph = script do
+  TestOcp{issuer, cap_table} <- setupTestOcp
+  let validStart = vestingCondition "start" OcfVestingStartTrigger ["next"]
+  let validNext = vestingCondition "next" OcfVestingEventTrigger []
+  result <- createVestingTermsData issuer cap_table (vestingTermsData "VT_EDIT_GRAPH" [validStart, validNext])
+  let invalidEdit = vestingTermsData "VT_EDIT_GRAPH" [(validStart with next_condition_ids = ["missing"]), validNext]
+  submitMustFail issuer do
+    exerciseCmd result.updatedCapTableCid CT.UpdateCapTable with
+      creates = []
+      edits = [CT.OcfEditVestingTerms invalidEdit]
+      deletes = []
+  pure ()

dars/dars.lock

@@ -32,6 +32,13 @@
       "uploadedAt": "2026-07-11T15:08:11.000Z",
       "networks": []
     },
+    "OpenCapTable-v34/0.0.13/OpenCapTable-v34.dar": {
+      "sha256": "24923ebd1e8699a23d1e5c23ac94ecfd8fd465655fbd13aaa593079a942d0334",
+      "size": 3193070,
+      "sdkVersion": "3.4.10",
+      "uploadedAt": "2026-07-11T15:31:43.000Z",
+      "networks": []
+    },
     "OpenCapTable-v34/0.0.2/OpenCapTable-v34.dar": {
       "sha256": "2ce462b8afcb1bcdbe351c56b0a47de478477f3c655da00e41cb397f63e997d6",
       "size": 2446238,