diff --git a/data/module-reference.md b/data/module-reference.md --- a/data/module-reference.md +++ b/data/module-reference.md @@ -177,3 +177,19 @@ `seihou upgrade` only refreshes the installed cache. For blocked updates, inspect `seihou agent upgrade TARGET --check` before requesting an agent repair. See `seihou help update`, `seihou help migrations`, and `seihou help manifest`. + + +Recipe policy: defaults are overridable fallbacks. Literal member bindings outrank +ambient config and saved input; CLI still wins. Add a recipe input constraint to +reject disallowed overrides. For example, bind `git.githubOwner=topagentnetwork` +and declare `validation = Some "^topagentnetwork\$"`. Binding names allow +`[a-z][A-Za-z0-9.-]*`, including camelCase. Patterns are case-sensitive POSIX +extended regexes matching the whole text value with multiline anchors disabled; +`private|public|internal` accepts exactly those values. Malformed patterns fail, +even on absent optional inputs. Recipe and consumer constraints apply independently +to every selected source; errors name the original source and a supported +correction before generation or commands. Ordinary update revalidates saved inputs. + +Recipe and blueprint producers using camelCase bindings or relying on POSIX +pattern enforcement require Seihou 0.13.0.0 or newer. Older runtimes can reject +those binding names or silently accept patterns they do not recognize. diff --git a/data/upgrade-prompt.md b/data/upgrade-prompt.md --- a/data/upgrade-prompt.md +++ b/data/upgrade-prompt.md @@ -173,10 +173,14 @@ module rather than a change to the project. ### variable_errors and configuration_failed -A variable has no value or the configuration does not load. Supply values with -`--var KEY=VALUE` or `seihou config set KEY VALUE`, asking the user for anything -that is not already recorded. `seihou vars {{module}} --explain` shows where each -value comes from. +A variable is missing, cannot be converted, violates a declared constraint, or +the configuration does not load. Read the named variable, original source and +constraint in the error. Supply a permitted `--var KEY=VALUE` or correct the +configuration; a malformed pattern requires correcting the producer declaration. +Recipe constraints also validate explicit overrides and saved inputs. Personal +global preferences need no cleanup when a recipe binding supplies its own value. +Ask for required values that are not already recorded. Use +`seihou vars {{module}} --explain` to inspect resolution sources. ### migration_plan_failed, migration_stage_failed, migration_failed, changed_after_migration_command A module migration between the recorded and the new version failed. The update diff --git a/help/recipes.md b/help/recipes.md --- a/help/recipes.md +++ b/help/recipes.md @@ -104,3 +104,15 @@ `seihou run RECIPE` asks once; `seihou run RECIPE --var git.createGithub=false` supplies an explicit answer without a terminal. Modules declaring that name receive the answer above their own defaults. + + +Recipe policy: defaults are overridable fallbacks. Literal member bindings outrank +ambient config and saved input; CLI still wins. Add a recipe input constraint to +reject disallowed overrides. For example, bind `git.githubOwner=topagentnetwork` +and declare `validation = Some "^topagentnetwork\$"`. Binding names allow +`[a-z][A-Za-z0-9.-]*`, including camelCase. Patterns are case-sensitive POSIX +extended regexes matching the whole text value with multiline anchors disabled; +`private|public|internal` accepts exactly those values. Malformed patterns fail, +even on absent optional inputs. Recipe and consumer constraints apply independently +to every selected source; errors name the original source and a supported +correction before generation or commands. Ordinary update revalidates saved inputs. diff --git a/help/variables.md b/help/variables.md --- a/help/variables.md +++ b/help/variables.md @@ -72,3 +72,15 @@ values during ordinary preview; conflicts require `--var KEY=VALUE` or `--reconfigure`. Saving prompted values to local config remains optional and respects `--save-prompted` and `--no-save-prompted`; previews do not save them. + + +Recipe policy: defaults are overridable fallbacks. Literal member bindings outrank +ambient config and saved input; CLI still wins. Add a recipe input constraint to +reject disallowed overrides. For example, bind `git.githubOwner=topagentnetwork` +and declare `validation = Some "^topagentnetwork\$"`. Binding names allow +`[a-z][A-Za-z0-9.-]*`, including camelCase. Patterns are case-sensitive POSIX +extended regexes matching the whole text value with multiline anchors disabled; +`private|public|internal` accepts exactly those values. Malformed patterns fail, +even on absent optional inputs. Recipe and consumer constraints apply independently +to every selected source; errors name the original source and a supported +correction before generation or commands. Ordinary update revalidates saved inputs. diff --git a/seihou-cli.cabal b/seihou-cli.cabal --- a/seihou-cli.cabal +++ b/seihou-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: seihou-cli -version: 0.12.1.0 +version: 0.13.0.0 synopsis: CLI for Seihou project scaffolding description: Command-line interface for Seihou, a composable project scaffolding @@ -144,7 +144,7 @@ generic-lens >=2.2 && <3, lens >=5.2 && <6, process >=1.6 && <2, - seihou-core ^>=0.12.1.0, + seihou-core ^>=0.13.0.0, streamly-core >=0.3 && <0.5, temporary >=1.3 && <2, text >=2.0 && <3, @@ -232,7 +232,7 @@ optparse-applicative >=0.18 && <1, process >=1.6 && <2, seihou-cli-internal, - seihou-core ^>=0.12.1.0, + seihou-core ^>=0.13.0.0, temporary >=1.3 && <2, text >=2.0 && <3, time >=1.12 && <2, @@ -328,7 +328,7 @@ lens >=5.2 && <6, process >=1.6 && <2, seihou-cli-internal, - seihou-core ^>=0.12.1.0, + seihou-core ^>=0.13.0.0, streamly-core >=0.3 && <0.5, tasty >=1.4 && <2, tasty-hspec >=1.2 && <2, diff --git a/src/Seihou/CLI/InstallShared.hs b/src/Seihou/CLI/InstallShared.hs --- a/src/Seihou/CLI/InstallShared.hs +++ b/src/Seihou/CLI/InstallShared.hs @@ -3,6 +3,7 @@ OriginInfo (..), OriginMeta (..), readOriginInfo, + writeOriginMeta, -- * Install collisions InstallCollision (..), @@ -61,8 +62,8 @@ -- "Seihou.Core.ArtifactOriginDetect" because @seihou-core@ needs it to -- classify an artifact directory into a portable manifest origin and cannot -- depend on @seihou-cli-internal@. It is re-exported here so existing --- importers are unaffected. The write side below stays in the CLI, which is --- the only place that installs anything. +-- importers are unaffected. The write side below stays in the CLI, which +-- installs artifacts and stages fetched candidates for project updates. -- | Write side of @.seihou-origin.json@. Captures everything 'seihou -- install' / 'seihou upgrade' want to record at install time, including @@ -86,6 +87,15 @@ "tags" .= (m ^. #tags) ] +-- | Record the source used to obtain an artifact, replacing any metadata +-- carried by its files. Shared by installation and temporary update staging +-- so both supply the resolver's provenance checks with the same contract. +writeOriginMeta :: FilePath -> Text -> Maybe Text -> Maybe Text -> [Text] -> IO () +writeOriginMeta directory source registryName artifactVersion artifactTags = do + now <- getCurrentTime + let origin = OriginMeta source registryName (T.pack (iso8601Show now)) artifactVersion artifactTags + LBS.writeFile (directory ".seihou-origin.json") (encodePretty origin) + -- ---------------------------------------------------------------------------- -- Install collisions -- ---------------------------------------------------------------------------- @@ -374,9 +384,7 @@ createDirectoryIfMissing True installDir copyDirectoryRecursive moduleDir installDir - now <- getCurrentTime - let origin = OriginMeta source registryName (T.pack (iso8601Show now)) moduleVersion moduleTags - LBS.writeFile (installDir ".seihou-origin.json") (encodePretty origin) + writeOriginMeta installDir source registryName moduleVersion moduleTags pure InstallPerformed -- | Recursively copy a directory tree, excluding the @.git@ directory. diff --git a/src/Seihou/CLI/Update.hs b/src/Seihou/CLI/Update.hs --- a/src/Seihou/CLI/Update.hs +++ b/src/Seihou/CLI/Update.hs @@ -1050,7 +1050,7 @@ + length [ () | (instanceId, name, value) <- resolvedList, - value ^. #source == FromCLI, + value ^. #source `elem` [FromCLI, FromRecipeBinding], Map.member name (Map.findWithDefault Map.empty instanceId prior) ] newCount = diff --git a/src/Seihou/CLI/Update/Source.hs b/src/Seihou/CLI/Update/Source.hs --- a/src/Seihou/CLI/Update/Source.hs +++ b/src/Seihou/CLI/Update/Source.hs @@ -5,7 +5,7 @@ where import Control.Exception (SomeException, displayException, try) -import Control.Monad (foldM, forM) +import Control.Monad (foldM, forM, forM_) import Data.ByteString qualified as BS import Data.Foldable (traverse_) import Data.Generics.Labels () @@ -16,6 +16,7 @@ ( OriginInfo (..), cloneRepo, copyDirectoryRecursive, + writeOriginMeta, ) import Seihou.CLI.Update.Types import Seihou.Core.ArtifactIdentity (normalizeOriginUrl) @@ -318,7 +319,13 @@ Nothing -> do let destination = searchRoot T.unpack (candidate ^. #name) Directory.createDirectoryIfMissing True destination - copied <- try @SomeException (copyDirectoryRecursive (candidate ^. #sourceDirectory) destination) + copied <- try @SomeException $ do + copyDirectoryRecursive (candidate ^. #sourceDirectory) destination + -- Resolution reads provenance from the staged directory, not from + -- CandidateCatalog. Use the fetched URL, overriding any origin file + -- in the repository; local fallbacks get no invented remote origin. + forM_ (candidate ^. #sourceUrl) $ \source -> + writeOriginMeta destination source (candidate ^. #repoName) (candidate ^. #version) (candidate ^. #tags) pure $ case copied of Left err -> Left (CandidateRepositoryInvalid (candidate ^. #name) [T.pack (displayException err)]) Right () -> diff --git a/test/Seihou/CLI/RecipeInputsE2ESpec.hs b/test/Seihou/CLI/RecipeInputsE2ESpec.hs --- a/test/Seihou/CLI/RecipeInputsE2ESpec.hs +++ b/test/Seihou/CLI/RecipeInputsE2ESpec.hs @@ -31,8 +31,91 @@ TIO.writeFile (recipe "recipe.dhall") "let S = ../demo/schema/package.dhall in S.Recipe::{name=\"recipe-input-probe\",version=Some \"1.0.0\",modules=[S.Dependency::{module=\"demo\"},S.Dependency::{module=\"other\"}],vars=[S.VarDecl::{name=\"feature\",type=\"bool\",required=True}],prompts=[S.Prompt::{var=\"feature\",text=\"Enable feature?\"}]}" pure binary +-- A harmless command records its rendered destination. Rejected runs must +-- preserve both generated bytes and this command log, including on update. +prepareOwnerPolicy root binding recipePolicy memberPolicy = do + (binary, modul) <- prepare root + let recipe = root ".seihou/modules/owner-policy" + constraint enabled = if enabled then ",validation=Some \"^topagentnetwork\\$\"" else "" + declaration enabled = "S.VarDecl::{name=\"git.githubOwner\",type=\"text\",default=Some \"topagentnetwork\"" <> constraint enabled <> "}" + writeRecipe bound constrained = + TIO.writeFile (recipe "recipe.dhall") $ + "let S = ../demo/schema/package.dhall in S.Recipe::{name=\"owner-policy\",version=Some \"1.0.0\",modules=[S.Dependency::{module=\"demo\"" + <> (if bound then ",vars=[{name=\"git.githubOwner\",value=\"topagentnetwork\"}]" else "") + <> "}],vars=[" + <> declaration constrained + <> "]}" + D.createDirectoryIfMissing True recipe + TIO.writeFile (modul "module.dhall") $ + "let S = ./schema/package.dhall in S.Module::{name=\"demo\",version=Some \"1.0.0\",vars=[" <> declaration memberPolicy <> "],steps=[S.Step::{strategy=\"template\",src=\"owner\",dest=\"owner.txt\"}],commands=[S.Command::{action=S.Command.Action.Apply \"printf '%s\\n' '{{git.githubOwner}}/probe' >> command-log\"}]}" + TIO.writeFile (modul "files/owner") "{{git.githubOwner}}" + writeRecipe binding recipePolicy + pure (binary, writeRecipe) + tests :: IO TestTree tests = testSpec "Recipe inputs" $ do + it "uses a camelCase owner binding above global config and rejects CLI violations before effects" $ + withSystemTempDirectory "owner-policy" $ \root -> do + (binary, _) <- prepareOwnerPolicy root True True False + _ <- success binary root ["config", "set", "git.githubOwner", "someone-else", "--global"] + _ <- success binary root ["validate-recipe", root ".seihou/modules/owner-policy"] + _ <- success binary root ["run", "owner-policy", "--dry-run"] + D.doesPathExist (root "owner.txt") `shouldReturn` False + D.doesPathExist (root "command-log") `shouldReturn` False + (code, out, err) <- invoke binary root ["run", "owner-policy", "--var", "git.githubOwner=someone-else"] + code `shouldBe` ExitFailure 1 + let message = T.pack (out <> err) + mapM_ (\needle -> message `shouldSatisfy` T.isInfixOf needle) ["git.githubOwner", "--var", "^topagentnetwork$", "--var git.githubOwner=topagentnetwork"] + D.doesPathExist (root "owner.txt") `shouldReturn` False + D.doesPathExist (root "command-log") `shouldReturn` False + D.doesPathExist (root ".seihou/manifest.json") `shouldReturn` False + D.doesPathExist (root ".seihou/config.dhall") `shouldReturn` False + _ <- success binary root ["run", "owner-policy"] + TIO.readFile (root "owner.txt") `shouldReturn` "topagentnetwork" + TIO.readFile (root "command-log") `shouldReturn` "topagentnetwork/probe\n" + before <- LBS.readFile (root ".seihou/manifest.json") + forM_ [[], ["--reconfigure"], ["--json"], ["--reconfigure", "--json"]] $ \extra -> do + (refused, stdout, stderr) <- invoke binary root (["update", "owner-policy", "--var", "git.githubOwner=someone-else"] <> extra) + refused `shouldBe` ExitFailure 1 + let output = T.pack (stdout <> stderr) + output `shouldSatisfy` T.isInfixOf "git.githubOwner" + if "--json" `elem` extra then output `shouldSatisfy` T.isInfixOf "\"code\":\"variable_errors\"" else pure () + LBS.readFile (root ".seihou/manifest.json") `shouldReturn` before + TIO.readFile (root "owner.txt") `shouldReturn` "topagentnetwork" + TIO.readFile (root "command-log") `shouldReturn` "topagentnetwork/probe\n" + forM_ [True, False] $ \recipePolicy -> + it ("revalidates historical personal owner independently; recipe policy=" <> show recipePolicy) $ + withSystemTempDirectory "owner-history" $ \root -> do + (binary, writeRecipe) <- prepareOwnerPolicy root False False False + _ <- success binary root ["run", "owner-policy", "--var", "git.githubOwner=someone-else"] + if recipePolicy + then writeRecipe False True + else do + let modul = root ".seihou/modules/demo/module.dhall" + body <- TIO.readFile modul + TIO.writeFile modul (T.replace "default=Some \"topagentnetwork\"" "default=Some \"topagentnetwork\",validation=Some \"^topagentnetwork\\$\"" body) + before <- LBS.readFile (root ".seihou/manifest.json") + (code, out, err) <- invoke binary root ["update", "owner-policy"] + code `shouldBe` ExitFailure 1 + T.pack (out <> err) `shouldSatisfy` T.isInfixOf "application" + TIO.readFile (root "owner.txt") `shouldReturn` "someone-else" + TIO.readFile (root "command-log") `shouldReturn` "someone-else/probe\n" + LBS.readFile (root ".seihou/manifest.json") `shouldReturn` before + -- Adoption owns replacing old accepted input when the producer adds a binding. + writeRecipe True True + output <- success binary root ["update", "owner-policy", "--json"] + value <- TIO.readFile (root "owner.txt") + if value == "topagentnetwork" then pure () else expectationFailure (T.unpack output) + it "validates global config against a consuming module with the original source" $ + withSystemTempDirectory "owner-consumer" $ \root -> do + (binary, _) <- prepareOwnerPolicy root False False True + _ <- success binary root ["config", "set", "git.githubOwner", "someone-else", "--global"] + (code, out, err) <- invoke binary root ["run", "owner-policy"] + code `shouldBe` ExitFailure 1 + T.pack (out <> err) `shouldSatisfy` T.isInfixOf "global config" + D.doesPathExist (root "owner.txt") `shouldReturn` False + D.doesPathExist (root "command-log") `shouldReturn` False + it "refuses missing recipe decisions before writing files or manifest" $ withSystemTempDirectory "recipe-missing" $ \root -> do binary <- prepareRecipe root diff --git a/test/Seihou/CLI/UpdateE2ESpec.hs b/test/Seihou/CLI/UpdateE2ESpec.hs --- a/test/Seihou/CLI/UpdateE2ESpec.hs +++ b/test/Seihou/CLI/UpdateE2ESpec.hs @@ -15,6 +15,7 @@ UpdateFixture (..), installBetaVersion, prepareSharedPathFixture, + prepareSourcePinnedUpdateFixture, prepareUpdateFixture, publishBetaReleases, ) @@ -35,6 +36,31 @@ spec :: Spec spec = do + it "updates a source-pinned dependency using its fetched provenance" $ + withSystemTempDirectory "seihou-update-source-pinned" $ \root -> do + fixture <- prepareSourcePinnedUpdateFixture root Nothing + binary <- seihouBinary + TIO.writeFile (fixture ^. #projectFile) "hello accepted by-user\nkeep\nv1\n" + (exitCode, stdoutText, stderrText) <- runSeihou binary fixture ["update", "demo", "--json"] + case exitCode of + ExitSuccess -> pure () + ExitFailure code -> expectationFailure ("update exited " <> show code <> "\nstdout:\n" <> T.unpack stdoutText <> "\nstderr:\n" <> T.unpack stderrText) + TIO.readFile (fixture ^. #projectFile) `shouldReturn` "hello accepted by-user\nkeep\nv2\n" + + it "rejects a source-pinned dependency fetched from another source without changing the project or cache" $ + withSystemTempDirectory "seihou-update-source-mismatch" $ \root -> do + fixture <- prepareSourcePinnedUpdateFixture root (Just "https://example.com/required-registry.git") + binary <- seihouBinary + beforeProject <- LBS.readFile (fixture ^. #projectFile) + beforeManifest <- LBS.readFile (fixture ^. #manifestPath) + beforeInstalled <- LBS.readFile (fixture ^. #installedModule "module.dhall") + (exitCode, stdoutText, _) <- runSeihou binary fixture ["update", "demo", "--json"] + exitCode `shouldBe` ExitFailure 1 + stdoutText `shouldSatisfy` T.isInfixOf "different or unknown provenance" + LBS.readFile (fixture ^. #projectFile) `shouldReturn` beforeProject + LBS.readFile (fixture ^. #manifestPath) `shouldReturn` beforeManifest + LBS.readFile (fixture ^. #installedModule "module.dhall") `shouldReturn` beforeInstalled + it "updates through the executable and preserves a non-overlapping user edit" $ withSystemTempDirectory "seihou-update-executable" $ \root -> do fixture <- prepareUpdateFixture root diff --git a/test/Seihou/CLI/UpdateSpec.hs b/test/Seihou/CLI/UpdateSpec.hs --- a/test/Seihou/CLI/UpdateSpec.hs +++ b/test/Seihou/CLI/UpdateSpec.hs @@ -2,6 +2,7 @@ ( tests, UpdateFixture (..), prepareUpdateFixture, + prepareSourcePinnedUpdateFixture, SharedPathFixture (..), CoOwnerWriteMode (..), prepareSharedPathFixture, @@ -780,6 +781,38 @@ baselineContent LBS.writeFile manifestPath (manifestToJSON manifest) pure UpdateFixture {projectRoot, projectFile, manifestPath, xdgHome, installedModule, remote, applicationId} + +-- | Two fetched repositories with a source-pinned edge between them. The +-- dependency deliberately carries stale origin metadata in its Git content; +-- staging must record the fetched source rather than trust that file. +prepareSourcePinnedUpdateFixture :: FilePath -> Maybe Text -> IO UpdateFixture +prepareSourcePinnedUpdateFixture root requiredSource = do + fixture <- prepareUpdateFixture root + let dependencyRemote = root "shared-remote" + sourceUrl = T.pack dependencyRemote + sharedOrigin = RemoteOrigin sourceUrl "shared" Nothing + dependency = + "dependencies = [{ module = \"shared\", source = Some \"" + <> fromMaybe sourceUrl requiredSource + <> "\", vars = [] : List { name : Text, value : Text } }]" + demoFile = fixture ^. #remote "module.dhall" + createDirectoryIfMissing True dependencyRemote + TIO.writeFile (dependencyRemote "module.dhall") (moduleDhall "shared" "2.0.0") + writeOrigin "https://example.com/stale-origin.git" dependencyRemote + callProcess "git" ["-C", dependencyRemote, "init", "-q"] + callProcess "git" ["-C", dependencyRemote, "add", "."] + callProcess "git" ["-C", dependencyRemote, "-c", "user.name=Seihou Test", "-c", "user.email=test@example.com", "commit", "-qm", "shared v2"] + demo <- TIO.readFile demoFile + TIO.writeFile demoFile (T.replace "dependencies = [] : List Text" dependency demo) + callProcess "git" ["-C", fixture ^. #remote, "add", "."] + callProcess "git" ["-C", fixture ^. #remote, "-c", "user.name=Seihou Test", "-c", "user.email=test@example.com", "commit", "-qm", "pin shared source"] + manifest <- either fail pure . manifestFromJSON =<< LBS.readFile (fixture ^. #manifestPath) + let updated = + manifest + & #applications .~ map (\app -> app & #instances .~ (app ^. #instances <> [instanceStateFrom "shared" sharedOrigin])) (manifest ^. #applications) + & #modules .~ (manifest ^. #modules <> [AppliedModule "shared" emptyParentVars sharedOrigin (Just "1.0.0") testTime Nothing]) + LBS.writeFile (fixture ^. #manifestPath) (manifestToJSON updated) + pure fixture -- | How the co-owning application @beta@ writes the shared @.gitignore@. data CoOwnerWriteMode diff --git a/test/Seihou/CLI/ValidateRecipeE2ESpec.hs b/test/Seihou/CLI/ValidateRecipeE2ESpec.hs --- a/test/Seihou/CLI/ValidateRecipeE2ESpec.hs +++ b/test/Seihou/CLI/ValidateRecipeE2ESpec.hs @@ -133,6 +133,7 @@ ("invalid type", replace "type = \"bool\"" "type = \"mystery\"", ["type", "mystery"]), ("invalid nested type", replace "type = \"bool\"" "type = \"list mystery\"", ["type", "mystery"]), ("invalid default", replace "type = \"bool\", default = None Text" "type = \"bool\", default = Some \"invalid\"", ["default", "github.enabled"]), + ("malformed optional pattern", replace "required = True, validation = None Text } ]" "required = False, validation = Some \"[\" } ]", ["vars", "github.owner", "invalid pattern"]), ("invalid condition syntax", replace "Eq github.enabled true" "Eq github.enabled", ["prompts", "github.owner", "when"]), ("empty members", replace "modules = [{module = \"demo\", vars = [{name = \"member.only\", value = \"literal\"}]}]" "modules = [] : List Text", ["modules", "at least one"]), ("invalid name", replace "name = \"my-stack\"" "name = \"BadName\"", ["name", "BadName"]),