seihou-core 0.8.0.0 → 0.9.0.0

raw patch · 18 files changed

+504/−53 lines, 18 filesdep ~effectful-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: effectful-core

API changes (from Hackage documentation)

Files

• seihou-core.cabal +3/−3
• src/Seihou/Core/Application.hs +13/−0
• src/Seihou/Core/Types.hs +45/−1
• src/Seihou/Engine/Execute.hs +31/−5
• src/Seihou/Engine/Reconcile.hs +29/−10
• src/Seihou/Engine/UpdateTransaction.hs +34/−6
• src/Seihou/Manifest/Types.hs +18/−0
• test/Seihou/Core/ApplicationSpec.hs +35/−2
• test/Seihou/Core/StatusSpec.hs +2/−1
• test/Seihou/Effect/ManifestStoreSpec.hs +1/−1
• test/Seihou/Engine/BaselineSpec.hs +5/−4
• test/Seihou/Engine/DiffSpec.hs +10/−5
• test/Seihou/Engine/ExecuteSpec.hs +49/−0
• test/Seihou/Engine/MigrateSpec.hs +1/−1
• test/Seihou/Engine/ReconcileSpec.hs +97/−1
• test/Seihou/Engine/RemoveSpec.hs +4/−4
• test/Seihou/Engine/UpdateTransactionSpec.hs +74/−3
• test/Seihou/Manifest/TypesSpec.hs +53/−6

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-core-version: 0.8.0.0+version: 0.9.0.0 synopsis: Core library for Seihou project scaffolding description:   Core library for Seihou, a composable project scaffolding system.@@ -120,7 +120,7 @@     cryptohash-sha256 >=0.11 && <1,     dhall >=1.42 && <2,     directory >=1.3 && <2,-    effectful-core >=2.4 && <3,+    effectful-core >=2.7.1.1 && <3,     either >=5 && <6,     filepath >=1.4 && <2,     generic-lens >=2.2 && <3,@@ -216,7 +216,7 @@     containers >=0.6 && <1,     dhall >=1.42 && <2,     directory >=1.3 && <2,-    effectful-core >=2.4 && <3,+    effectful-core >=2.7.1.1 && <3,     filepath >=1.4 && <2,     generic-lens >=2.2 && <3,     hspec >=2.11 && <3,

@@ -92,12 +92,25 @@ -- ownership from the prior record and any ownership already on the result. -- The current record's baseline is preserved: EP-65 captures the exact -- post-execution generated content before ownership is attached.+--+-- @additiveOnly@ can only be weakened here, never strengthened. This run+-- executed only its own application's operations, so its answer covers only+-- its own contributions; when a prior owner survives outside this run, the+-- prior record is the only evidence about that owner's write mode, and a+-- co-owner that rewrites the whole file must keep the path under the+-- ownership closure. This is the @seihou run@ counterpart of the+-- partial-update merge rule in+-- 'Seihou.Engine.UpdateTransaction.prepareCandidateManifest'. attachApplication :: ApplicationId -> Maybe FileRecord -> FileRecord -> FileRecord attachApplication applicationId previous current =   current     & #applicationIds .~ Set.insert applicationId (Set.union (current ^. #applicationIds) priorApplications)+    & #additiveOnly .~ ((current ^. #additiveOnly) && (not partial || priorAdditive))   where     priorApplications = maybe Set.empty (^. #applicationIds) previous+    retainedOwners = Set.delete applicationId priorApplications+    partial = not (Set.null retainedOwners)+    priorAdditive = maybe False (^. #additiveOnly) previous  varValueToText :: VarValue -> Text varValueToText (VText value) = value

@@ -10,6 +10,7 @@     Expr (..),     Strategy (..),     PatchOp (..),+    isAdditivePatchOp,     Step (..),     Command (..),     Dependency (..),@@ -33,6 +34,7 @@     Runnable (..),     recipeNameToModuleName,     Operation (..),+    isAdditiveOperation,     ModuleLoadError (..),     Manifest (..),     ApplicationId (..),@@ -172,6 +174,26 @@   | AppendLineIfAbsent   deriving stock (Eq, Show, Generic) +-- | Does this patch operation occupy a slice of the file that no other+-- contributor can disturb?+--+-- 'AppendLineIfAbsent' filters out lines already present, so it is+-- idempotent and commutative. 'AppendSection' writes a region delimited by+-- the contributing module's own markers, which no other module's region+-- overlaps. Replaying either one on top of a baseline that already holds+-- another owner's content leaves that content byte for byte where it was.+--+-- 'AppendFile' and 'PrependFile' place bytes relative to whatever is already+-- in the file, so replaying one contributor without the others can reorder+-- the result. They are not additive in this sense.+--+-- See docs/adr/0012-an-additive-co-write-is-not-a-shared-path-conflict.md.+isAdditivePatchOp :: PatchOp -> Bool+isAdditivePatchOp AppendSection = True+isAdditivePatchOp AppendLineIfAbsent = True+isAdditivePatchOp AppendFile = False+isAdditivePatchOp PrependFile = False+ -- | A generation step within a module. data Step = Step   { strategy :: !Strategy,@@ -424,6 +446,22 @@       }   deriving stock (Eq, Show, Generic) +-- | Does this operation contribute to its destination through an additive,+-- non-overlapping patch?+--+-- Only a 'PatchFileOp' whose 'PatchOp' satisfies 'isAdditivePatchOp'+-- qualifies. A 'WriteFileOp' or 'CopyFileOp' discards whatever the file+-- already held, so it never does. Operations with no file destination+-- ('CreateDirOp', 'RunCommandOp') are not contributions to a path and+-- answer 'False'; callers group operations by destination first, so they+-- never ask.+isAdditiveOperation :: Operation -> Bool+isAdditiveOperation (PatchFileOp _ _ op' _ _) = isAdditivePatchOp op'+isAdditiveOperation WriteFileOp {} = False+isAdditiveOperation CopyFileOp {} = False+isAdditiveOperation CreateDirOp {} = False+isAdditiveOperation RunCommandOp {} = False+ -- | Errors that can occur during module loading and validation. data ModuleLoadError   = ModuleNotFound ModuleName [FilePath]@@ -714,7 +752,13 @@     strategy :: !Strategy,     generatedAt :: !UTCTime,     baseline :: !(Maybe BaselineRef),-    applicationIds :: !(Set ApplicationId)+    applicationIds :: !(Set ApplicationId),+    -- | Does /every/ contribution to this path go through an additive,+    -- non-overlapping patch ('isAdditivePatchOp')? When true, reconciling+    -- one owner provably cannot disturb another's bytes, so a targeted+    -- update need not name every owner. Absent from older manifests, where+    -- it decodes as 'False' and the closure keeps being enforced.+    additiveOnly :: !Bool   }   deriving stock (Eq, Show, Generic) 

@@ -21,6 +21,11 @@ -- (by its qualified name) that produced it. Paths not present in the -- map fall back to the default @moduleName'@ — this preserves single- -- module call-sites and test usage that do not build an ownership map.+--+-- Each record's @additiveOnly@ is folded across /every/ operation that+-- targets the same destination, so a path a module both writes and patches+-- records 'False'. Only a path reached exclusively through additive patches+-- records 'True'. executePlan ::   (Filesystem :> es) =>   FilePath ->@@ -31,18 +36,36 @@   Eff es (Map FilePath FileRecord) executePlan targetDir ops ownerMap moduleName' now = do   let ownerFor dest = Map.findWithDefault moduleName' dest ownerMap-  records <- mapM (executeOp targetDir ownerFor now) ops+      additiveFor dest = Map.findWithDefault False dest additiveMap+  records <- mapM (executeOp targetDir ownerFor additiveFor now) ops   pure (Map.fromList [(k, v) | Just (k, v) <- records])+  where+    additiveMap =+      Map.fromListWith+        (&&)+        [ (dest, isAdditiveOperation op)+        | op <- ops,+          Just dest <- [operationDestination op]+        ] +-- | The file a generated operation targets, if it targets one at all.+operationDestination :: Operation -> Maybe FilePath+operationDestination (WriteFileOp dest _ _) = Just dest+operationDestination (CopyFileOp _ dest) = Just dest+operationDestination (PatchFileOp dest _ _ _ _) = Just dest+operationDestination CreateDirOp {} = Nothing+operationDestination RunCommandOp {} = Nothing+ -- | Execute a single operation and return a FileRecord if a file was written. executeOp ::   (Filesystem :> es) =>   FilePath ->   (FilePath -> ModuleName) ->+  (FilePath -> Bool) ->   UTCTime ->   Operation ->   Eff es (Maybe (FilePath, FileRecord))-executeOp targetDir ownerFor now op = case op of+executeOp targetDir ownerFor additiveFor now op = case op of   WriteFileOp dest content strat -> do     let fullPath = targetDir </> dest     writeFileText fullPath content@@ -53,7 +76,8 @@               strategy = strat,               generatedAt = now,               baseline = Nothing,-              applicationIds = mempty+              applicationIds = mempty,+              additiveOnly = additiveFor dest             }     pure (Just (dest, record))   CreateDirOp path -> do@@ -71,7 +95,8 @@               strategy = Copy,               generatedAt = now,               baseline = Nothing,-              applicationIds = mempty+              applicationIds = mempty,+              additiveOnly = additiveFor dest             }     pure (Just (dest, record))   RunCommandOp {} -> do@@ -97,7 +122,8 @@                   strategy = strat,                   generatedAt = now,                   baseline = Nothing,-                  applicationIds = mempty+                  applicationIds = mempty,+                  additiveOnly = additiveFor dest                 }         pure (Just (dest, record)) 

@@ -53,7 +53,12 @@     generatedContent :: !Text,     moduleName :: !ModuleName,     strategy :: !Strategy,-    applicationIds :: !(Set ApplicationId)+    applicationIds :: !(Set ApplicationId),+    -- | Does every operation /this run/ contributes to the path go through+    -- an additive, non-overlapping patch ('isAdditiveOperation')? This is+    -- the candidate's own answer, independent of what the manifest recorded+    -- for the owners that are not part of this run.+    additiveOnly :: !Bool   }   deriving stock (Eq, Generic, Show) @@ -252,27 +257,40 @@       directories = Set.fromList [path | CreateDirOp path <- operations]   traverse_ validateManagedPath (Map.keys grouped)   traverse_ validateManagedPath (Set.toList directories)-  traverse_ (validateOwner selected ownerMap manifest) (Map.keys grouped)+  traverse_ (validateOwner selected ownerMap manifest) (Map.toList grouped)   pure (grouped, directories) +-- | Defence in depth behind the CLI's selection preflight: refuse to write a+-- path an unselected application also owns.+--+-- A path every owner reaches through an additive, non-overlapping patch is+-- exempt, because replaying one owner's patch on top of the trusted baseline+-- provably leaves the others' bytes where they were. The exemption requires+-- /both/ halves: the manifest's record must say the path was additive-only,+-- and every operation this run contributes to it must still be additive. The+-- second half is what catches a module whose new version changed a shared+-- file from a patch step to a whole-file step — the manifest still says+-- additive, the candidate is not, and the update refuses before writing+-- anything rather than trusting last release's record.+--+-- See docs/adr/0012-an-additive-co-write-is-not-a-shared-path-conflict.md. validateOwner ::   Set ApplicationId ->   Map FilePath DesiredFileOwner ->   Manifest ->-  FilePath ->+  (FilePath, [Operation]) ->   Either ReconciliationError ()-validateOwner selected ownerMap manifest path = case Map.lookup path ownerMap of+validateOwner selected ownerMap manifest (path, pathOperations) = case Map.lookup path ownerMap of   Nothing -> Left (MissingDesiredOwner path)   Just owner     | not ((owner ^. #applicationIds) `Set.isSubsetOf` selected) ->         Left (DesiredOwnerOutsideSelection path ((owner ^. #applicationIds) Set.\\ selected))     | otherwise -> case Map.lookup path (manifest ^. #files) of         Nothing -> Right ()-        Just record ->-          let unselectedOwners = (record ^. #applicationIds) Set.\\ selected-           in if Set.null unselectedOwners-                then Right ()-                else Left (SharedPathRequiresApplications path (record ^. #applicationIds))+        Just record+          | Set.null ((record ^. #applicationIds) Set.\\ selected) -> Right ()+          | record ^. #additiveOnly && all isAdditiveOperation pathOperations -> Right ()+          | otherwise -> Left (SharedPathRequiresApplications path (record ^. #applicationIds))  validateManagedPath :: FilePath -> Either ReconciliationError () validateManagedPath rawPath = case validateProjectRelativePath (T.pack rawPath) of@@ -355,7 +373,8 @@               generatedContent = generated,               moduleName = owner ^. #moduleName,               strategy = finalStrategy,-              applicationIds = owner ^. #applicationIds+              applicationIds = owner ^. #applicationIds,+              additiveOnly = all isAdditiveOperation pathOperations             }     Right       DesiredContext

@@ -231,25 +231,52 @@       pure (ObservedFile True (Just (hashContent content)))     else pure (ObservedFile False Nothing) +-- | Fold the reconciliation result into the manifest's file records.+--+-- A targeted update plans only the applications it selected, so for a+-- co-owned path the reconciliation result describes a /subset/ of the+-- owners. Everything belonging to an owner outside this update therefore has+-- to survive the write untouched: its ownership, and the recorded facts about+-- the path as a whole. See+-- docs/plans/90-exempt-additive-patch-paths-from-the-shared-ownership-closure.md. prepareCandidateManifest :: UpdateTransaction -> ReconciliationPlan -> Manifest -> IO Manifest prepareCandidateManifest transaction plan manifest = do   nextFiles <- foldM applyManifestAction (manifest ^. #files) (Map.toAscList (plan ^. #files))   pure (replaceManifestFiles manifest nextFiles)   where+    selected = plan ^. #applicationIds     applyManifestAction files (path, reconciliation) = case desiredState reconciliation of       Just (desired, state) -> do         baseline <- writeBaselineBlob (transaction ^. #projectRoot) (state ^. #generatedBaseline)-        let record =+        let prior = Map.lookup path (manifest ^. #files)+            -- Owners this update did not touch. Subtracting the /selection/+            -- rather than the desired set matters: a selected application+            -- that stopped writing the path must genuinely lose ownership,+            -- while an unselected one must keep it.+            retainedOwners = maybe Set.empty (^. #applicationIds) prior Set.\\ selected+            partial = not (Set.null retainedOwners)+            -- The prior flag summarises every owner, including the ones absent+            -- from this run, so a partial update can only weaken it.+            priorAdditive = maybe False (^. #additiveOnly) prior+            record =               FileRecord                 { hash = state ^. #recordedHash,-                  moduleName = desired ^. #moduleName,-                  strategy = desired ^. #strategy,+                  -- A partial update has no standing to re-credit a path it+                  -- only partly wrote; keeping the prior attribution also+                  -- avoids manifest churn between targeted runs.+                  moduleName = case prior of+                    Just priorRecord | partial -> priorRecord ^. #moduleName+                    _ -> desired ^. #moduleName,+                  strategy = case prior of+                    Just priorRecord | partial -> priorRecord ^. #strategy+                    _ -> desired ^. #strategy,                   generatedAt = manifest ^. #genAt,                   baseline = Just baseline,-                  applicationIds = desired ^. #applicationIds+                  applicationIds = (desired ^. #applicationIds) `Set.union` retainedOwners,+                  additiveOnly = (desired ^. #additiveOnly) && (not partial || priorAdditive)                 }         pure (Map.insert path record files)-      Nothing -> pure (applyOrphanManifestAction (plan ^. #applicationIds) reconciliation files)+      Nothing -> pure (applyOrphanManifestAction selected reconciliation files)  desiredState :: FileReconciliation -> Maybe (DesiredFile, PlannedFileState) desiredState reconciliation = case reconciliation of@@ -290,7 +317,8 @@       strategy = record ^. #strategy,       generatedAt = record ^. #generatedAt,       baseline = record ^. #baseline,-      applicationIds = owners+      applicationIds = owners,+      additiveOnly = record ^. #additiveOnly     }  replaceManifestFiles :: Manifest -> Map FilePath FileRecord -> Manifest

@@ -52,6 +52,14 @@ -- (see docs/plans/76-record-portable-artifact-origins-in-the-manifest.md). -- Version-5-and-earlier manifests are not readable directly; see -- docs/plans/79-upgrade-legacy-absolute-path-manifests-in-place.md.+--+-- Deliberately /not/ bumped from 6 to 7 when 'FileRecord' gained+-- @additiveOnly@. The field is emitted only when true, so a manifest with no+-- additive-only paths is byte-identical to one written before it existed, and+-- a reader that predates it treats every path as requiring the full ownership+-- closure -- the conservative reading. Bumping would make every manifest this+-- release writes unreadable to 0.8.x binaries in exchange for nothing. See+-- docs/plans/90-exempt-additive-patch-paths-from-the-shared-ownership-closure.md. currentManifestVersion :: Int currentManifestVersion = 6 @@ -566,10 +574,19 @@       ]         ++ maybe [] (\ref -> ["baseline" .= (ref ^. #unBaselineRef . #unSHA256)]) (fr ^. #baseline)         ++ applicationIdsField (fr ^. #applicationIds)+        ++ additiveOnlyField (fr ^. #additiveOnly)     where       applicationIdsField ids         | Set.null ids = []         | otherwise = ["applications" .= map (^. #unApplicationId) (Set.toAscList ids)]+      -- Emitted only when true, so a manifest with no additive-only paths is+      -- byte-identical to one written before the field existed. A reader that+      -- predates the field ignores it and keeps enforcing the ownership+      -- closure everywhere, which is the conservative behaviour; that is why+      -- 'currentManifestVersion' does not move for this field.+      additiveOnlyField additive+        | additive = ["additiveOnly" .= True]+        | otherwise = []  instance FromJSON FileRecord where   parseJSON = Aeson.withObject "FileRecord" $ \o -> do@@ -582,6 +599,7 @@       <*> o .: "generatedAt"       <*> pure baseline       <*> (Set.fromList . map ApplicationId <$> o Aeson..:? "applications" Aeson..!= [])+      <*> (o Aeson..:? "additiveOnly" Aeson..!= False)     where       parseBaselineRef value = case baselineRefFromText value of         Just ref -> pure ref

@@ -158,8 +158,41 @@     it "unions prior and current ownership and preserves the generated baseline" $ do       let priorId = ApplicationId "prior"           currentId = ApplicationId "current"-          prior = FileRecord (hashContent "old") "module" Template fixedTime Nothing (Set.singleton priorId)-          current = FileRecord (hashContent "new") "module" Template fixedTime (Just (BaselineRef (hashContent "generated"))) Set.empty+          prior = FileRecord (hashContent "old") "module" Template fixedTime Nothing (Set.singleton priorId) False+          current = FileRecord (hashContent "new") "module" Template fixedTime (Just (BaselineRef (hashContent "generated"))) Set.empty False           attached = attachApplication currentId (Just prior) current       (attached ^. #applicationIds) `shouldBe` Set.fromList [priorId, currentId]       (attached ^. #baseline) `shouldBe` Just (BaselineRef (hashContent "generated"))++    it "cannot strengthen additiveOnly while a prior owner survives" $ do+      -- This run executed only its own application's operations, so its+      -- answer covers only its own contributions. A co-owner that rewrites+      -- the whole file must keep the path under the ownership closure.+      let priorId = ApplicationId "prior"+          currentId = ApplicationId "current"+          prior = record (Set.singleton priorId) False+          current = record Set.empty True+      (attachApplication currentId (Just prior) current ^. #additiveOnly) `shouldBe` False++    it "keeps additiveOnly true when the prior record and this run agree" $ do+      let priorId = ApplicationId "prior"+          currentId = ApplicationId "current"+      (attachApplication currentId (Just (record (Set.singleton priorId) True)) (record Set.empty True) ^. #additiveOnly)+        `shouldBe` True++    it "weakens additiveOnly when this run is no longer additive" $ do+      let priorId = ApplicationId "prior"+          currentId = ApplicationId "current"+      (attachApplication currentId (Just (record (Set.singleton priorId) True)) (record Set.empty False) ^. #additiveOnly)+        `shouldBe` False++    it "trusts this run's answer when it is the only owner" $ do+      let currentId = ApplicationId "current"+          prior = record (Set.singleton currentId) False+      (attachApplication currentId (Just prior) (record Set.empty True) ^. #additiveOnly) `shouldBe` True+      (attachApplication currentId Nothing (record Set.empty True) ^. #additiveOnly) `shouldBe` True++-- | A file record carrying the given owners and additive-only verdict.+record :: Set.Set ApplicationId -> Bool -> FileRecord+record owners additive =+  FileRecord (hashContent "content") "module" Template fixedTime Nothing owners additive

@@ -32,7 +32,8 @@       strategy = Template,       generatedAt = fixedTime,       baseline = Nothing,-      applicationIds = mempty+      applicationIds = mempty,+      additiveOnly = False     }  runStatus :: PureFS -> Manifest -> [TrackedFile]

@@ -33,7 +33,7 @@   (emptyManifest fixedTime)     & #modules .~ [AppliedModule (ModuleName "haskell-base") emptyParentVars (LocalOrigin "haskell-base") Nothing fixedTime Nothing]     & #vars .~ Map.fromList [(VarName "project.name", "my-app")]-    & #files .~ Map.fromList [("README.md", FileRecord (SHA256 "abc123") (ModuleName "haskell-base") Template fixedTime Nothing mempty)]+    & #files .~ Map.fromList [("README.md", FileRecord (SHA256 "abc123") (ModuleName "haskell-base") Template fixedTime Nothing mempty False)]  spec :: Spec spec = do

@@ -37,7 +37,8 @@                 strategy = Template,                 generatedAt = fixedTime,                 baseline = Nothing,-                applicationIds = Set.singleton applicationId+                applicationIds = Set.singleton applicationId,+                additiveOnly = False               }           initialFS = PureFS (Map.singleton ("/project/" <> path) content) Set.empty           ((result, stored), _) =@@ -56,7 +57,7 @@           Map.lookup expectedRef stored `shouldBe` Just content      it "returns an error and publishes no reference when a generated file is missing" $ do-      let record = FileRecord (hashContent "planned") "module" Template fixedTime Nothing Set.empty+      let record = FileRecord (hashContent "planned") "module" Template fixedTime Nothing Set.empty False           ((result, stored), _) =             runPureEff $               runFilesystemPure (PureFS Map.empty Set.empty) $@@ -67,7 +68,7 @@      it "stores content that can be read back through the baseline effect" $ do       let content = "round trip"-          record = FileRecord (hashContent content) "module" Copy fixedTime Nothing Set.empty+          record = FileRecord (hashContent content) "module" Copy fixedTime Nothing Set.empty False           initialFS = PureFS (Map.singleton "copy.txt" content) Set.empty           ((result, readBack), _) =             runPureEff $@@ -86,7 +87,7 @@     it "collects and deduplicates every referenced blob" $ do       let first = baselineRefForContent "first"           second = baselineRefForContent "second"-          mkRecord ref = FileRecord (hashContent "applied") "module" Template fixedTime ref Set.empty+          mkRecord ref = FileRecord (hashContent "applied") "module" Template fixedTime ref Set.empty False           manifest :: Manifest           manifest =             ( (emptyManifest fixedTime)

@@ -40,7 +40,8 @@       strategy = Template,       generatedAt = fixedTime,       baseline = Nothing,-      applicationIds = mempty+      applicationIds = mempty,+      additiveOnly = False     }  -- | Helper to create a manifest with file records (avoids ambiguous record update).@@ -208,7 +209,8 @@                 strategy = Template,                 generatedAt = fixedTime,                 baseline = Nothing,-                applicationIds = mempty+                applicationIds = mempty,+                additiveOnly = False               }           manifest = manifestWithFiles (Map.singleton "other.txt" record)           planned = [("new.txt", "new content", modName, Nothing)]@@ -237,7 +239,8 @@                 strategy = Copy,                 generatedAt = fixedTime,                 baseline = Nothing,-                applicationIds = mempty+                applicationIds = mempty,+                additiveOnly = False               }           manifest =             manifestWithFiles@@ -270,7 +273,8 @@                 strategy = Template,                 generatedAt = fixedTime,                 baseline = Nothing,-                applicationIds = mempty+                applicationIds = mempty,+                additiveOnly = False               }           manifest = manifestWithFiles (Map.singleton "shared.txt" otherRecord)           -- active module wants to write to same path owned by inactive module@@ -293,7 +297,8 @@                 strategy = Template,                 generatedAt = fixedTime,                 baseline = Nothing,-                applicationIds = mempty+                applicationIds = mempty,+                additiveOnly = False               }           manifest =             manifestWithFiles

@@ -176,6 +176,55 @@       let content = (fs ^. #files) Map.! "/project/.gitignore"       content `shouldBe` "node_modules/\n.claude/\n" +  describe "executePlan additiveOnly" $ do+    it "records an additive patch as additive-only" $ do+      let ops = [PatchFileOp ".gitignore" "/result\n" AppendLineIfAbsent Template modName]+          (records, _) = runExecFS emptyFS ops+      ((records Map.! ".gitignore") ^. #additiveOnly) `shouldBe` True++    it "records an appended section as additive-only" $ do+      let ops = [PatchFileOp ".gitignore" "/dist\n" AppendSection Template modName]+          (records, _) = runExecFS emptyFS ops+      ((records Map.! ".gitignore") ^. #additiveOnly) `shouldBe` True++    it "does not record a position-dependent patch as additive-only" $ do+      -- AppendFile and PrependFile place bytes relative to whatever is+      -- already in the file, so replaying one owner can reorder the result.+      let appendOps = [PatchFileOp "notes.md" "tail\n" AppendFile Template modName]+          prependOps = [PatchFileOp "notes.md" "head\n" PrependFile Template modName]+      ((fst (runExecFS emptyFS appendOps) Map.! "notes.md") ^. #additiveOnly) `shouldBe` False+      ((fst (runExecFS emptyFS prependOps) Map.! "notes.md") ^. #additiveOnly) `shouldBe` False++    it "does not record a whole-file write as additive-only" $ do+      let ops = [WriteFileOp "README.md" "# Title\n" Template]+          (records, _) = runExecFS emptyFS ops+      ((records Map.! "README.md") ^. #additiveOnly) `shouldBe` False++    it "does not record a copied file as additive-only" $ do+      let initial = PureFS (Map.singleton "/source/file.txt" "copied") mempty+          ops = [CopyFileOp "/source/file.txt" "dest.txt"]+          (records, _) = runExecFS initial ops+      ((records Map.! "dest.txt") ^. #additiveOnly) `shouldBe` False++    it "folds the flag across every operation targeting one destination" $ do+      -- A path this module both writes and patches is not additive-only, and+      -- the patch arriving last must not hide the write.+      let ops =+            [ WriteFileOp ".gitignore" "/dist\n" Template,+              PatchFileOp ".gitignore" "/result\n" AppendLineIfAbsent Template modName+            ]+          (records, _) = runExecFS emptyFS ops+      ((records Map.! ".gitignore") ^. #additiveOnly) `shouldBe` False++    it "keeps one destination's write mode out of another's record" $ do+      let ops =+            [ WriteFileOp "README.md" "# Title\n" Template,+              PatchFileOp ".gitignore" "/result\n" AppendLineIfAbsent Template modName+            ]+          (records, _) = runExecFS emptyFS ops+      ((records Map.! "README.md") ^. #additiveOnly) `shouldBe` False+      ((records Map.! ".gitignore") ^. #additiveOnly) `shouldBe` True+   describe "dryRunPlan" $ do     it "formats WriteFileOp" $ do       let result = dryRunPlan [WriteFileOp "README.md" "content" Template]

@@ -58,7 +58,7 @@ mkManifest entries =   (emptyManifest fixedTime)     & #modules .~ [AppliedModule {name = modName, parentVars = emptyParentVars, origin = LocalOrigin "demo", moduleVersion = Just "1.0.0", appliedAt = fixedTime, removal = Nothing}]-    & #files .~ Map.fromList [(path, FileRecord {hash = hashContent content, moduleName = modName, strategy = Template, generatedAt = fixedTime, baseline = Nothing, applicationIds = mempty}) | (path, content) <- entries]+    & #files .~ Map.fromList [(path, FileRecord {hash = hashContent content, moduleName = modName, strategy = Template, generatedAt = fixedTime, baseline = Nothing, applicationIds = mempty, additiveOnly = False}) | (path, content) <- entries]  -- | Build an in-memory filesystem from (path, content) pairs. mkFS :: [(FilePath, Text)] -> PureFS

@@ -136,6 +136,88 @@               cleanMerge       result `shouldBe` Left (SharedPathRequiresApplications "shared.txt" (Set.singleton appB)) +    it "lets a targeted update through an additive-only shared path" $ do+      -- Replaying appA's append on top of the trusted baseline leaves appB's+      -- lines where they were, so the closure has nothing to protect here.+      let baseline = baselineRefForContent "/dist\n/result\n"+          prior = additiveRecord "/dist\n/result\n" (Just baseline) [appA, appB]+          manifest = withFile ".gitignore" prior empty+          result =+            planWith+              (Map.singleton ".gitignore" "/dist\n/result\n")+              Map.empty+              (Map.singleton baseline "/dist\n/result\n")+              manifest+              [appA]+              [patch "/dist-newstyle" "mod-a"]+              (owners ".gitignore" [appA])+              cleanMerge+      case result of+        Left err -> expectationFailure ("expected the plan to be accepted, got " <> show err)+        Right reconciliation -> do+          Map.keys (reconciliation ^. #files) `shouldBe` [".gitignore"]+          case (reconciliation ^. #files) Map.! ".gitignore" of+            FileUpdate desired _ _ _ -> do+              -- appB's line survives the replay byte for byte.+              (desired ^. #generatedContent) `shouldBe` "/dist\n/result\n/dist-newstyle\n"+              (desired ^. #additiveOnly) `shouldBe` True+            other -> expectationFailure ("expected a file update, got " <> show other)++    it "refuses an additive-only shared path when the candidate writes the whole file" $ do+      -- The manifest still says additive, but this module's new version+      -- replaced its patch step with a whole-file step. The candidate's own+      -- operations settle it, before anything is written.+      let baseline = baselineRefForContent "/dist\n/result\n"+          prior = additiveRecord "/dist\n/result\n" (Just baseline) [appA, appB]+          manifest = withFile ".gitignore" prior empty+          result =+            planWith+              (Map.singleton ".gitignore" "/dist\n/result\n")+              Map.empty+              (Map.singleton baseline "/dist\n/result\n")+              manifest+              [appA]+              [WriteFileOp ".gitignore" "/dist-newstyle\n" Template]+              (owners ".gitignore" [appA])+              cleanMerge+      result `shouldBe` Left (SharedPathRequiresApplications ".gitignore" (Set.fromList [appA, appB]))++    it "refuses an additive-only shared path when the candidate adds a position-dependent patch" $ do+      let baseline = baselineRefForContent "/dist\n/result\n"+          prior = additiveRecord "/dist\n/result\n" (Just baseline) [appA, appB]+          manifest = withFile ".gitignore" prior empty+          result =+            planWith+              (Map.singleton ".gitignore" "/dist\n/result\n")+              Map.empty+              (Map.singleton baseline "/dist\n/result\n")+              manifest+              [appA]+              [ patch "/dist-newstyle" "mod-a",+                PatchFileOp ".gitignore" "/tail\n" AppendFile Template "mod-a"+              ]+              (owners ".gitignore" [appA])+              cleanMerge+      result `shouldBe` Left (SharedPathRequiresApplications ".gitignore" (Set.fromList [appA, appB]))++    it "refuses a shared path the manifest does not record as additive-only" $ do+      -- A manifest written before the field existed reads as False, and must+      -- keep requiring every owner regardless of how additive this run is.+      let baseline = baselineRefForContent "/dist\n/result\n"+          prior = record "/dist\n/result\n" (Just baseline) [appA, appB]+          manifest = withFile ".gitignore" prior empty+          result =+            planWith+              (Map.singleton ".gitignore" "/dist\n/result\n")+              Map.empty+              (Map.singleton baseline "/dist\n/result\n")+              manifest+              [appA]+              [patch "/dist-newstyle" "mod-a"]+              (owners ".gitignore" [appA])+              cleanMerge+      result `shouldBe` Left (SharedPathRequiresApplications ".gitignore" (Set.fromList [appA, appB]))+     it "rejects control paths before reading or planning" $ do       let result =             planWith@@ -281,7 +363,21 @@       strategy = Template,       generatedAt = fixedTime,       baseline = baseline,-      applicationIds = Set.fromList owners'+      applicationIds = Set.fromList owners',+      additiveOnly = False+    }++-- | A record for a path every owner reaches through an additive patch.+additiveRecord :: Text -> Maybe BaselineRef -> [ApplicationId] -> FileRecord+additiveRecord content baseline owners' =+  FileRecord+    { hash = hashContent content,+      moduleName = "owner",+      strategy = Template,+      generatedAt = fixedTime,+      baseline = baseline,+      applicationIds = Set.fromList owners',+      additiveOnly = True     }  owners :: FilePath -> [ApplicationId] -> Map.Map FilePath DesiredFileOwner

@@ -36,14 +36,14 @@ mkManifest isRemovable fileContents =   (emptyManifest fixedTime)     & #modules .~ [AppliedModule {name = modName, parentVars = emptyParentVars, origin = LocalOrigin "test-module", moduleVersion = Nothing, appliedAt = fixedTime, removal = if isRemovable then Just (Removal [] []) else Nothing}]-    & #files .~ Map.fromList [(path, FileRecord {hash = hashContent content, moduleName = modName, strategy = Template, generatedAt = fixedTime, baseline = Nothing, applicationIds = mempty}) | (path, content) <- fileContents]+    & #files .~ Map.fromList [(path, FileRecord {hash = hashContent content, moduleName = modName, strategy = Template, generatedAt = fixedTime, baseline = Nothing, applicationIds = mempty, additiveOnly = False}) | (path, content) <- fileContents]  -- | Helper: create a manifest with a specific removal spec. mkManifestWithRemoval :: Removal -> [(FilePath, Text)] -> Manifest mkManifestWithRemoval removal fileContents =   (emptyManifest fixedTime)     & #modules .~ [AppliedModule {name = modName, parentVars = emptyParentVars, origin = LocalOrigin "test-module", moduleVersion = Nothing, appliedAt = fixedTime, removal = Just removal}]-    & #files .~ Map.fromList [(path, FileRecord {hash = hashContent content, moduleName = modName, strategy = Template, generatedAt = fixedTime, baseline = Nothing, applicationIds = mempty}) | (path, content) <- fileContents]+    & #files .~ Map.fromList [(path, FileRecord {hash = hashContent content, moduleName = modName, strategy = Template, generatedAt = fixedTime, baseline = Nothing, applicationIds = mempty, additiveOnly = False}) | (path, content) <- fileContents]  -- | Helper: create a PureFS with files. mkFS :: [(FilePath, Text)] -> PureFS@@ -158,7 +158,7 @@      it "preserves files from other modules in manifest" $ do       let base = mkManifest True [("mine.txt", "mine")]-          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime Nothing mempty+          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime Nothing mempty False           manifest =             Manifest               { version = base ^. #version,@@ -341,7 +341,7 @@      it "preserves other modules' files in manifest" $ do       let base = mkManifest True [("mine.txt", "mine")]-          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime Nothing mempty+          otherRec = FileRecord (hashContent "other") otherMod Template fixedTime Nothing mempty False           manifest =             Manifest               { version = base ^. #version,

@@ -1,7 +1,7 @@ module Seihou.Engine.UpdateTransactionSpec (tests) where  import Control.Exception (throwIO)-import Control.Lens ((^.))+import Control.Lens ((&), (.~), (^.)) import Control.Monad (unless, when) import Data.ByteString.Lazy qualified as LBS import Data.Foldable (traverse_)@@ -187,6 +187,75 @@         readProject projectRoot "file.txt" `shouldReturn` "user\n"         Directory.doesDirectoryExist (transaction ^. #transactionDirectory) `shouldReturn` False +  describe "partial update of a co-owned path" $ do+    -- A targeted update plans only the applications it selected, so for a+    -- co-owned path the reconciliation result describes a subset of the+    -- owners. Everything belonging to an unselected owner must survive.+    let coOwned additive =+          ( ( fileRecord "/dist\n" (Just (baselineRefForContent "/dist\n")) [appA, appB]+                & #moduleName+                  .~ "co-owner"+            )+              & #strategy+                .~ DhallText+          )+            & #additiveOnly+              .~ additive+        alphaOnly additive =+          (desiredFile ".gitignore" "/dist\n/result\n" [appA] & #moduleName .~ "alpha")+            & #additiveOnly+              .~ additive+        runPartial selection prior desired =+          withSystemTempDirectory "seihou-update-partial" $ \projectRoot -> do+            writeProject projectRoot ".gitignore" "/dist\n"+            let state = plannedState "/dist\n/result\n" "/dist\n/result\n" True+                plan =+                  ReconciliationPlan+                    selection+                    ( Map.singleton+                        ".gitignore"+                        (FileUpdate desired state (observed "/dist\n") (Just prior))+                    )+                    Set.empty+                manifest = manifestWithFiles (Map.singleton ".gitignore" prior)+            transaction <- expectRight =<< beginUpdateTransaction projectRoot (Set.singleton ".gitignore")+            candidate <- expectRight =<< applyReconciliation transaction plan manifest+            pure ((candidate ^. #files) Map.! ".gitignore")++    it "keeps an unselected co-owner in the record" $ do+      record <- runPartial (Set.singleton appA) (coOwned True) (alphaOnly True)+      (record ^. #applicationIds) `shouldBe` Set.fromList [appA, appB]++    it "keeps the prior attribution when an unselected co-owner survives" $ do+      record <- runPartial (Set.singleton appA) (coOwned True) (alphaOnly True)+      (record ^. #moduleName) `shouldBe` "co-owner"+      (record ^. #strategy) `shouldBe` DhallText++    it "keeps additiveOnly true when both the prior record and the candidate agree" $ do+      record <- runPartial (Set.singleton appA) (coOwned True) (alphaOnly True)+      (record ^. #additiveOnly) `shouldBe` True++    it "cannot strengthen additiveOnly from a partial update" $ do+      -- The prior False may have been set because the unselected co-owner+      -- writes the whole file. This run has no evidence about that owner, so+      -- flipping the flag open here would let a later update through unsafely.+      record <- runPartial (Set.singleton appA) (coOwned False) (alphaOnly True)+      (record ^. #additiveOnly) `shouldBe` False++    it "weakens additiveOnly when the candidate is no longer additive" $ do+      record <- runPartial (Set.singleton appA) (coOwned True) (alphaOnly False)+      (record ^. #additiveOnly) `shouldBe` False++    it "re-credits the path and trusts the candidate once every owner is selected" $ do+      -- Subtracting the selection rather than the desired set matters here:+      -- appA stopped writing the path but was part of this update, so it+      -- genuinely loses ownership and the candidate's own answer stands.+      record <- runPartial (Set.fromList [appA, appB]) (coOwned False) (alphaOnly True)+      (record ^. #applicationIds) `shouldBe` Set.singleton appA+      (record ^. #moduleName) `shouldBe` "alpha"+      (record ^. #strategy) `shouldBe` Template+      (record ^. #additiveOnly) `shouldBe` True+   describe "rollback and recovery" $ do     it "rolls every earlier mutation back after an injected failure" $       withSystemTempDirectory "seihou-update-rollback" $ \projectRoot -> do@@ -388,7 +457,8 @@       strategy = Template,       generatedAt = fixedTime,       baseline = baseline,-      applicationIds = Set.fromList owners+      applicationIds = Set.fromList owners,+      additiveOnly = False     }  desiredFile :: FilePath -> Text -> [ApplicationId] -> DesiredFile@@ -398,7 +468,8 @@       generatedContent = content,       moduleName = "owner",       strategy = Template,-      applicationIds = Set.fromList owners+      applicationIds = Set.fromList owners,+      additiveOnly = False     }  plannedState :: Text -> Text -> Bool -> PlannedFileState

@@ -148,6 +148,7 @@             fixedTime             (Just (BaselineRef (hashContent "flake")))             (Set.singleton (ApplicationId "app"))+            False         )     & #applications       %~ map (withCommandReceipts (Map.singleton receiptFingerprint receipt))@@ -351,7 +352,7 @@       let m :: Manifest           m =             ( (emptyManifest fixedTime)-                & #files .~ Map.fromList [("README.md", FileRecord {hash = SHA256 "abc123", moduleName = ModuleName "haskell-base", strategy = Template, generatedAt = fixedTime, baseline = Nothing, applicationIds = mempty}), ("my-app.cabal", FileRecord {hash = SHA256 "def456", moduleName = ModuleName "haskell-base", strategy = DhallText, generatedAt = fixedTime, baseline = Nothing, applicationIds = mempty})]+                & #files .~ Map.fromList [("README.md", FileRecord {hash = SHA256 "abc123", moduleName = ModuleName "haskell-base", strategy = Template, generatedAt = fixedTime, baseline = Nothing, applicationIds = mempty, additiveOnly = False}), ("my-app.cabal", FileRecord {hash = SHA256 "def456", moduleName = ModuleName "haskell-base", strategy = DhallText, generatedAt = fixedTime, baseline = Nothing, applicationIds = mempty, additiveOnly = False})]             )       manifestFromJSON (manifestToJSON m) `shouldBe` Right m @@ -372,10 +373,10 @@                 files =                   Map.fromList                     [ ( "README.md",-                        FileRecord (SHA256 "aaa") (ModuleName "haskell-base") Template fixedTime Nothing mempty+                        FileRecord (SHA256 "aaa") (ModuleName "haskell-base") Template fixedTime Nothing mempty False                       ),                       ( "LICENSE",-                        FileRecord (SHA256 "bbb") (ModuleName "haskell-base") Copy fixedTime Nothing mempty+                        FileRecord (SHA256 "bbb") (ModuleName "haskell-base") Copy fixedTime Nothing mempty False                       )                     ],                 applications = [],@@ -388,7 +389,7 @@     it "roundtrips all strategy types" $ do       let strategies = [Copy, Template, DhallText, Structured]           makeRecord s =-            FileRecord (SHA256 "hash") (ModuleName "mod") s fixedTime Nothing mempty+            FileRecord (SHA256 "hash") (ModuleName "mod") s fixedTime Nothing mempty False           m :: Manifest           m =             ( (emptyManifest fixedTime)@@ -501,7 +502,8 @@                 strategy = Template,                 generatedAt = fixedTime,                 baseline = Just (BaselineRef (hashContent "generated baseline")),-                applicationIds = Set.fromList [appId1, appId2]+                applicationIds = Set.fromList [appId1, appId2],+                additiveOnly = False               }           manifest =             ( (emptyManifest fixedTime)@@ -662,7 +664,7 @@                 commandReceipts = Map.empty,                 appliedAt = fixedTime               }-          fileRecord = FileRecord (SHA256 "hash") "base" Template fixedTime Nothing mempty+          fileRecord = FileRecord (SHA256 "hash") "base" Template fixedTime Nothing mempty False           recipe = AppliedRecipe "recipe" (LocalOrigin "recipe") (Just "1.0.0") fixedTime           normalBlueprint = AppliedBlueprint "payments" (LocalOrigin "payments") (Just "0.4.0") fixedTime [] False Nothing Nothing           seed =@@ -704,6 +706,51 @@       case manifestFromJSON json of         Right _ -> expectationFailure "a version-1 manifest should not decode directly"         Left err -> err `shouldSatisfy` isInfixOf "seihou manifest upgrade"++  describe "additive-only file records" $ do+    let additiveRecord additive =+          FileRecord+            { hash = SHA256 "aaa",+              moduleName = ModuleName "nix-haskell-flake",+              strategy = Template,+              generatedAt = fixedTime,+              baseline = Nothing,+              applicationIds = Set.fromList [ApplicationId "app-one", ApplicationId "app-two"],+              additiveOnly = additive+            }+        manifestWith additive =+          (emptyManifest fixedTime) & #files .~ Map.singleton ".gitignore" (additiveRecord additive)+        recordKeys manifest = case Aeson.decode (manifestToJSON manifest) of+          Just (Aeson.Object top) -> case KeyMap.lookup "files" top of+            Just (Aeson.Object files) -> case KeyMap.lookup ".gitignore" files of+              Just (Aeson.Object record) -> map Key.toText (KeyMap.keys record)+              _ -> []+            _ -> []+          _ -> []++    it "roundtrips a record whose additiveOnly is true" $ do+      manifestFromJSON (manifestToJSON (manifestWith True)) `shouldBe` Right (manifestWith True)++    it "roundtrips a record whose additiveOnly is false" $ do+      manifestFromJSON (manifestToJSON (manifestWith False)) `shouldBe` Right (manifestWith False)++    it "emits the additiveOnly key only when the flag is true" $ do+      recordKeys (manifestWith True) `shouldContain` ["additiveOnly"]+      recordKeys (manifestWith False) `shouldNotContain` ["additiveOnly"]++    it "decodes a record with no additiveOnly key as not additive-only" $ do+      -- A manifest written before the field existed must keep every shared+      -- path under the ownership closure, so the absent key must fail closed.+      let json =+            "{\"version\":6,\"generatedAt\":\"2026-03-01T10:30:00Z\",\"modules\":[]"+              <> ",\"variables\":{},\"applications\":[],\"files\":{\".gitignore\":{\"hash\":\"aaa\""+              <> ",\"module\":\"nix-haskell-flake\",\"strategy\":\"template\""+              <> ",\"generatedAt\":\"2026-03-01T10:30:00Z\"}}}"+      case manifestFromJSON json of+        Left err -> expectationFailure ("expected the manifest to decode, got: " <> err)+        Right decoded -> case Map.lookup ".gitignore" (decoded ^. #files) of+          Nothing -> expectationFailure "expected a .gitignore record"+          Just decodedRecord -> (decodedRecord ^. #additiveOnly) `shouldBe` False    describe "version checking" $ do     it "rejects manifests with version higher than current" $ do