diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,221 @@ ## [Unreleased] +### Changed + +- Documentation: the 2026-10-02 model refresh found no new OpenAI or Anthropic + models; the catalog is unchanged. `docs/user/models-and-providers.md` notes + Anthropic's retirement of Claude Sonnet 4.5 on 2026-11-30 (deprecation of + `anthropic_claude_sonnet_4_5` is planned in plan 89 for removal in 0.8.0.0), + why the access-gated Claude Mythos models are not curated, and how GPT-6 + Astra's new ultrafast service tier is costed. + +## [baikai-kit 0.4.0.0] - 2026-10-02 + +### Added + +- Per-item `visibility` (`tool-only` by default, or `shared`) for manifest + versions 1 and 2, with `kit install --shared`, `--tool-only`, and + `--accept-shared-codex`. Shared Claude skills and agents use tracked links; + tool-only Codex skills use tracked disabled entries in `config.toml`. +- `codexSessionArgs`, required in the `extraArgs` of a consumer's own Codex + launches to re-enable its tool-only skills. This is the one launcher step + beyond a dependency bump; the standard `kitConfig`/`kitCommandParser`/`runKit` + integration otherwise compiles unchanged. Codex custom agents cannot be + isolated and require explicit acceptance, or shared visibility. +- Requested and effective visibility in status (table and JSON), the + `visibility-broken` condition, and a migration note for legacy shared Codex + skills. Update repairs visibility even for items skipped for local edits; + uninstall removes only owned links and config entries. + +### Changed (breaking) + +- `SkillEntry` and `AgentEntry` gain `visibility`; `SidecarMeta` gains + `visibility`, `visibilitySource`, `sharedLinks`, and `codexDisabledSkills`; + `newSidecarMeta` takes these values. `RemovalOutcome` gains `linksRemoved` + and `configEntriesRemoved`; `StatusRow` gains `requestedVisibility` and + `effectiveVisibility`; `KitConfig` gains `confirmSharedCodex` (default + `Nothing` in `kitConfig`). +- `KitInstall` gains `InstallOptions`; `installItem` and `installFrom` take + it as their last argument. Use `defaultInstallOptions` to follow the + manifest. Explicit install flags persist across updates, while new + manifest-driven installs follow updated defaults. Legacy placement is kept. +- JSON adds list `visibility`, status `requestedVisibility` and + `effectiveVisibility`, and the new condition value. `formatVersion` stays + 1 because all additions preserve existing keys and their meaning. + +### Fixed + +- Codex installs refuse destinations without this tool's sidecar instead of + overwriting user or other-tool assets. Uninstall also preserves foreign + Codex assets. Shared Claude names are checked before any provider write. +- Codex config edits preserve UTF-8 text, comments and permissions, refuse + symlinks and invalid/conflicting config, and verify the semantic change + before atomic rename. Reused user-owned disabled entries survive uninstall. + Shared visibility refuses a user-owned entry that would keep the skill hidden. +- The source distribution ships the test suite's manifest fixtures and JSON + goldens, so the test suite passes when run from the Hackage tarball. Since + 0.3.0.0 it had failed there, because those files were missing. + +## [baikai 0.7.2.0] - 2026-09-30 + +### Added + +- Curated GPT-6.1 Sol on OpenAI Responses and Claude Sonnet 5.5 on Anthropic + Messages (`openai_gpt_6_1_sol`, `anthropic_claude_sonnet_5_5`), with endpoint + compatibility facts, standard prices, GPT-6.1 Sol's 272K-token context tier, + and Sonnet 5.5's one-hour cache-write rate. Sonnet 5.5 rejects forced tool + choice locally and has no fast mode. Both passed live text and function-tool + acceptance on 2026-09-30 through `/v1/responses` and `/v1/messages` + ([record](docs/validation/plan-85/2026-09-30-complete.json), + [plan 85](docs/plans/85-prove-gpt-6-1-sol-and-claude-sonnet-5-5-live-compatibility.md)). + The focused smoke runner gains the `sol61-*` and `sonnet55-*` cases. +- `Baikai.ResponseFormat.StructuredOutputSupport` + (`NativeJsonSchema | NoStructuredOutput`), `declaredStructuredOutput :: Api -> + StructuredOutputSupport`, and a `structuredOutput` field on `ApiProvider` + (default `NoStructuredOutput` in `apiProviderWith`), so a caller can ask + whether a transport enforces a schema without calling it. Every built-in + provider declares `NativeJsonSchema`. + +## [baikai-claude 0.7.1.0] - 2026-09-30 + +Requires `baikai >=0.7.2`. + +### Added + +- `claude -p` honours a `JsonSchema` response format (IR-11): it receives + `--json-schema ''` and the response text is the tool's validated + `structured_output`. A missing `structured_output` is a `DecodeFailure`; a + `claude` too old for the flag yields an `InvalidRequest` error with the exit + code rather than unconstrained text. `JsonObject`, `name` and `strict` are not + forwarded; requests without a schema render the same argument vector as + before. Both Claude providers declare `structuredOutput = NativeJsonSchema`. + +### Fixed + +- Anthropic adaptive `ThinkingHigh` now sends + `output_config.effort: "high"` instead of omitting the field. Claude Opus 5.5 + defaults to `medium`, so it previously ran `ThinkingHigh` at medium effort; + other adaptive models default to `high` and behave as before. Evidence for + these calls records `effortText = "high"` and no longer carries + `effort_omitted`, so strict evidence mode no longer refuses them. + `Baikai.Evidence.EffortOmitted` stays exported, and older records still decode. + +## [baikai-openai 0.7.1.0] - 2026-09-30 + +Requires `baikai >=0.7.2`. + +### Added + +- `codex exec` honours a `JsonSchema` response format (IR-11): the schema is + written to a temporary file passed as `--output-schema ` and deleted + however the call ends. A `codex` too old for the flag yields an + `InvalidRequest` error with the exit code rather than unconstrained text. + `JsonObject`, `name` and `strict` are not forwarded; requests without a schema + render the same argument vector as before. All three OpenAI providers declare + `structuredOutput = NativeJsonSchema`. +- `codexCliCommandWith`, which renders the `codex exec` + vector with a given `--output-schema` file. `codexCliCommand` is unchanged + and never renders the flag. + +## [baikai 0.7.1.0] - 2026-09-23 + +### Added + +- Curated GPT-6 Sol and Luna on OpenAI Responses and Claude Opus 5.5 on + Anthropic Messages (`openai_gpt_6_sol`, `openai_gpt_6_luna`, + `anthropic_claude_opus_5_5`), with endpoint compatibility and standard, + long-context, cache-duration, and fast-mode prices where applicable. All + three passed live acceptance on 2026-09-23. Sol and Luna dispatch to + `OpenAIResponses`, so calling them requires the + `Baikai.Provider.OpenAI.Responses.register` call that `baikai-openai 0.7.0.0` + introduced. + +## [baikai-kit 0.3.0.0] - 2026-09-23 + +Closes four improvement requests from the tools that ship `baikai-kit` as their +`kit` command: project scope resolves from a configurable root (IR-8), +`kit status` reports local edits separately from upstream drift (IR-7), +`kit install` without a name asks a tool-supplied chooser (IR-6), and `list`, +`status` and `update` print versioned JSON (IR-9). A consumer raising its bound +builds `KitConfig` with `kitConfig`, passes it to `kitCommandParser`, and +matches on `StatusRow.conditions`; each break is at a call site the compiler +names. + +### Added + +- `baikai-kit`: `KitConfig.projectRoot :: IO FilePath` says where project scope + lives. Install, status, update, uninstall and `agentDirsForSession` all derive + project-scope paths from it, so they agree whichever subdirectory a command + runs from. `kitConfig` builds a configuration with every optional field at its + default (project scope is the current directory, as before); + `projectRootByMarkers [".git", ".mytool"]` is a ready-made resolver that walks + up to the nearest marker and falls back to the current directory, and + `findProjectRoot` is the underlying walk. Resolves IR-8. + +- `baikai-kit`: `kit status` reports local edits. It runs the same + installed-file check `kit update` uses to skip an item, and shows + `modified` for an edited copy and `edits-unknown` for one whose sidecar + predates the installed-file hash. The check is exported as + `checkLocalEdits`, returning `LocalEdits` (`Unedited`, `Edited`, + `EditsUnknown`). Resolves IR-7. + +- `baikai-kit`: `kit install` with no name asks a chooser the tool supplies in + the new `KitConfig.chooseItem :: Maybe (KitManifest -> IO (Maybe Text))` + field. The engine refreshes the kit, passes the whole manifest, and installs + what the chooser returns; a cancelled choice prints + `No item chosen; nothing installed.` and exits 0. With no chooser (the + `kitConfig` default) the command fails with the new `KitItemNameRequired` + error, which tells the user to pass `NAME`. The engine ships no picker. + `KitCommand` derives `Eq`, and `kit install --help` names the tool's + `./agents` directory. Resolves IR-6. + +- `baikai-kit`: `kit list`, `kit status` and `kit update` accept `--json` and + print exactly one versioned JSON document on stdout + (`{"formatVersion": 1, "document": "kit-list" | "kit-status" | "kit-update", …}`); + warnings and the first-clone notice go to stderr, and a failed command writes + nothing to stdout. The shapes are written by explicit encoders — + `Baikai.Kit.Json.listDocument`, `statusDocument`, `updateDocument`, and + `kitJsonFormatVersion` — so library callers get the same values, and they are + pinned by golden tests. `Baikai.Kit.Command.OutputFormat` selects the mode, + and `Baikai.Kit.Status.InstalledCopy` / `installedCopies` report where each + item is installed. Resolves IR-9. + +### Changed + +- `baikai-kit`: `KitConfig` gains the strict field `projectRoot`, so a record + literal must set it; build the configuration with + `kitConfig toolName repoUrl providers` instead and override fields with record + update syntax. `KitConfig`'s `Show` instance is now hand-written and prints + `` for the resolver. __Breaking__. + +- `baikai-kit`: `kit status` conditions compose, and `dirty` is renamed + `changed-upstream` (it meant the upstream sources changed without a version + bump, not local edits); `dirty+outdated` now reads + `outdated+changed-upstream`. `StatusRow.state :: KitState` is replaced by + `StatusRow.conditions :: [KitCondition]` (sorted; empty means up to date), + `renderState` by `conditionLabel` and `renderConditions`, and `classify` + returns `[KitCondition]`. `KitUpToDate`, `KitDirty` and `KitDirtyOutdated` + are gone; match on the list instead. __Breaking__. + +- `baikai-kit`: `KitInstall` takes `Maybe Text` (`Nothing` asks the chooser), + `kitCommandParser` takes the `KitConfig` (migration: `kitCommandParser` + becomes `kitCommandParser myKitConfig`), `KitConfig` gains the `chooseItem` + field (set by `kitConfig`), and `KitError` gains `KitItemNameRequired`. + __Breaking__. + +- `baikai-kit`: `KitList`, `KitStatus` and `KitUpdate` gain a trailing + `OutputFormat` field (`HumanOutput` for the previous behaviour). + __Breaking__. + +## [baikai-effectful 0.4.0.2] - 2026-09-15 + +### Changed (dependencies) + +- Requires `effectful-core ^>=2.7` (was `^>=2.6`). No API change: none of the + 2.7 breaking APIs (`LocalEnv`'s second type parameter, `SharedSuffix`, + `KnownEffects`, the ticked strict modules) are used. + ## [baikai 0.7.0.0] - 2026-09-08 ### Added diff --git a/baikai-kit.cabal b/baikai-kit.cabal --- a/baikai-kit.cabal +++ b/baikai-kit.cabal @@ -1,27 +1,36 @@ -cabal-version: 3.4 -name: baikai-kit -version: 0.2.0.1 -synopsis: Shared kit installer for AI-agent skills and subagents +cabal-version: 3.4 +name: baikai-kit +version: 0.4.0.0 +synopsis: Shared kit installer for AI-agent skills and subagents description: Shared implementation of kit listing, installation, update, uninstall, status, and discovery helpers for command-line tools that install local AI-agent skills and subagents. -category: AI -license: BSD-3-Clause -license-file: LICENSE -author: Nadeem Bitar -maintainer: nadeem@gmail.com -copyright: (c) 2026 Nadeem Bitar -build-type: Simple -tested-with: GHC ==9.12.4 +category: AI +license: BSD-3-Clause +license-file: LICENSE +author: Nadeem Bitar +maintainer: nadeem@gmail.com +copyright: (c) 2026 Nadeem Bitar +build-type: Simple +tested-with: ghc ==9.12.4 extra-doc-files: CHANGELOG.md +extra-source-files: + test/fixtures/*.json + test/golden/*.json common common-options ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-uni-patterns - -Wincomplete-record-updates -Wredundant-constraints - -fhide-source-paths -Wmissing-export-lists -Wpartial-fields + -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + -fhide-source-paths + -Wmissing-export-lists + -Wpartial-fields -Wmissing-deriving-strategies -- Exhaustiveness is an error, not a warning. A non-exhaustive match @@ -36,10 +45,11 @@ -- fail the build on warnings that are stylistic or that a future GHC -- invents, and would push people toward blanket suppression. ghc-options: - -Werror=incomplete-patterns -Werror=incomplete-uni-patterns + -Werror=incomplete-patterns + -Werror=incomplete-uni-patterns -Werror=incomplete-record-updates - default-language: GHC2024 + default-language: GHC2024 default-extensions: DeriveAnyClass DuplicateRecordFields @@ -47,50 +57,63 @@ OverloadedStrings library - import: common-options - hs-source-dirs: src + import: common-options + hs-source-dirs: src exposed-modules: Baikai.Kit + Baikai.Kit.CodexConfig Baikai.Kit.Command Baikai.Kit.Config Baikai.Kit.Error Baikai.Kit.Install + Baikai.Kit.Json Baikai.Kit.Manifest Baikai.Kit.Path Baikai.Kit.Repo Baikai.Kit.Session Baikai.Kit.Sidecar Baikai.Kit.Status + Baikai.Kit.Visibility + other-modules: Baikai.Kit.Link build-depends: - , aeson ^>=2.2 - , baikai ^>=0.7.0 - , base >=4.20 && <5 - , binary ^>=0.8 - , bytestring ^>=0.12 - , crypton ^>=1.0 - , directory ^>=1.3 - , filepath ^>=1.5 - , optparse-applicative ^>=0.19 - , process ^>=1.6 - , text ^>=2.1 - , time ^>=1.14 + aeson ^>=2.2, + baikai ^>=0.7.0, + base >=4.20 && <5, + binary ^>=0.8, + bytestring ^>=0.12, + containers ^>=0.7, + crypton ^>=1.0, + directory ^>=1.3, + filepath ^>=1.5, + optparse-applicative ^>=0.19, + process ^>=1.6, + text ^>=2.1, + time ^>=1.14, + toml-parser ^>=2.0.2, test-suite baikai-kit-test - import: common-options - type: exitcode-stdio-1.0 + import: common-options + type: exitcode-stdio-1.0 hs-source-dirs: test - main-is: Main.hs - ghc-options: -threaded -with-rtsopts=-N + main-is: Main.hs + ghc-options: + -threaded + -with-rtsopts=-N + build-depends: - , aeson - , baikai - , baikai-kit - , base - , bytestring - , directory - , filepath - , tasty - , tasty-hunit - , temporary - , text + aeson, + baikai, + baikai-kit, + base, + bytestring, + directory, + filepath, + optparse-applicative, + process, + tasty, + tasty-hunit, + temporary, + text, + toml-parser, + unix, diff --git a/src/Baikai/Kit.hs b/src/Baikai/Kit.hs --- a/src/Baikai/Kit.hs +++ b/src/Baikai/Kit.hs @@ -1,24 +1,30 @@ module Baikai.Kit ( module Baikai.Kit.Command, module Baikai.Kit.Config, + module Baikai.Kit.CodexConfig, module Baikai.Kit.Error, module Baikai.Kit.Install, + module Baikai.Kit.Json, module Baikai.Kit.Manifest, module Baikai.Kit.Path, module Baikai.Kit.Repo, module Baikai.Kit.Session, module Baikai.Kit.Sidecar, module Baikai.Kit.Status, + module Baikai.Kit.Visibility, ) where +import Baikai.Kit.CodexConfig import Baikai.Kit.Command import Baikai.Kit.Config import Baikai.Kit.Error import Baikai.Kit.Install +import Baikai.Kit.Json import Baikai.Kit.Manifest import Baikai.Kit.Path import Baikai.Kit.Repo import Baikai.Kit.Session import Baikai.Kit.Sidecar import Baikai.Kit.Status +import Baikai.Kit.Visibility diff --git a/src/Baikai/Kit/CodexConfig.hs b/src/Baikai/Kit/CodexConfig.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/CodexConfig.hs @@ -0,0 +1,298 @@ +-- | Preserve the user's TOML text; parse both sides of every surgical edit. +module Baikai.Kit.CodexConfig + ( codexConfigPath, + readSkillEntries, + addDisabledSkill, + removeDisabledSkill, + checkDisabledSkill, + checkRemoveDisabledSkill, + enableSkillsArgs, + ) +where + +import Baikai.Kit.Error (KitError (..)) +import Baikai.Prelude +import Control.Exception (IOException, onException, try) +import Control.Monad (forM_, unless, when) +import Data.ByteString qualified as BS +import Data.Char (ord) +import Data.List (nub) +import Data.Map.Strict qualified as Map +import Data.Maybe (fromMaybe) +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Encoding +import Numeric (showHex) +import System.Directory + ( canonicalizePath, + createDirectoryIfMissing, + doesDirectoryExist, + doesFileExist, + getHomeDirectory, + getPermissions, + pathIsSymbolicLink, + readable, + removeFile, + renameFile, + setPermissions, + writable, + ) +import System.Environment (lookupEnv) +import System.FilePath (takeDirectory, takeFileName, ()) +import System.IO (hClose, openTempFile) +import Toml qualified + +codexConfigPath :: IO FilePath +codexConfigPath = do + home <- getHomeDirectory + root <- fromMaybe (home ".codex") <$> lookupEnv "CODEX_HOME" + pure (root "config.toml") + +readSkillEntries :: FilePath -> IO (Either KitError [(FilePath, Bool)]) +readSkillEntries config = configTry config "" $ do + text <- readConfig config + pure $ do + table <- parseConfig text + traverse entry (configValues table) + where + entry (Toml.Table t) = do + p <- case value "path" t of + Just (Toml.Text p) -> pure (Text.unpack p) + _ -> Left "skills.config entry has no string path" + enabled <- case value "enabled" t of + Nothing -> Right True + Just (Toml.Bool b) -> Right b + _ -> Left "skills.config entry has no boolean enabled" + Right (p, enabled) + entry _ = Left "skills.config must contain tables" + +-- | Validate without writing: True means we would add and own this entry. +checkDisabledSkill :: FilePath -> FilePath -> IO (Either KitError Bool) +checkDisabledSkill config skill = fmap (fmap (has _Just)) (prepareEdit True config skill) + +checkRemoveDisabledSkill :: FilePath -> FilePath -> IO (Either KitError Bool) +checkRemoveDisabledSkill config skill = fmap (fmap (has _Just)) (prepareEdit False config skill) + +addDisabledSkill :: FilePath -> FilePath -> IO (Either KitError Bool) +addDisabledSkill = editSkill True + +removeDisabledSkill :: FilePath -> FilePath -> IO (Either KitError Bool) +removeDisabledSkill = editSkill False + +editSkill :: Bool -> FilePath -> FilePath -> IO (Either KitError Bool) +editSkill adding config skill = do + prepared <- prepareEdit adding config skill + case prepared of + Left err -> pure (Left err) + Right Nothing -> pure (Right False) + Right (Just text) -> configTry config skill $ do + atomicWrite config text + pure (Right True) + +prepareEdit :: Bool -> FilePath -> FilePath -> IO (Either KitError (Maybe Text)) +prepareEdit adding config skill = configTry config skill $ do + linked <- either (const False) id <$> try @IOException (pathIsSymbolicLink config) + if linked + then pure (Left "config.toml is a symbolic link (possibly generated); refusing to replace it") + else do + exists <- doesFileExist config + permissions <- if exists then Just <$> getPermissions config else pure Nothing + case permissions of + Just perms | not (readable perms && writable perms) -> ioError (userError "config.toml is not readable and writable") + _ -> pure () + checkParentWritable (takeDirectory config) + text <- readConfig config + case parseConfig text of + Left err -> pure (Left err) + Right old -> do + absolute <- canonicalizePath skill + matches <- traverse (matchesPath absolute) (configValues old) + let matchedEntries = [v | (v, True) <- zip (configValues old) matches] + pure $ do + selected <- case matchedEntries of + [] -> Right Nothing + [v@(Toml.Table t)] -> case value "enabled" t of + Just (Toml.Bool False) -> Right (Just v) + _ + | adding -> Left "the user already enabled this skill; refusing to override that entry" + | otherwise -> Right Nothing + _ -> Left "multiple skills.config entries name this path" + case (adding, selected) of + (True, Just _) -> Right Nothing + (False, Nothing) -> Right Nothing + _ -> do + let newText = if adding then appendBlock text absolute else removeBlock text absolute + expected = + if adding + then configValues old ++ [disabledValue absolute] + else filter (\v -> Just v /= selected) (configValues old) + new <- parseConfig newText + unless (configValues new == expected && withoutConfig old == withoutConfig new) $ + Left "the edit would change other TOML values; use array-of-table [[skills.config]] entries" + Right (Just newText) + where + matchesPath absolute (Toml.Table t) = case value "path" t of + Just (Toml.Text p) -> (== absolute) <$> canonicalizePath (Text.unpack p) + _ -> pure False + matchesPath _ _ = pure False + +checkParentWritable :: FilePath -> IO () +checkParentWritable path = do + exists <- doesDirectoryExist path + if exists + then do + permissions <- getPermissions path + unless (writable permissions) (ioError (userError "Codex config directory is not writable")) + else do + let parent = takeDirectory path + when (parent == path || parent == "/") (ioError (userError "Codex config has no writable parent")) + checkParentWritable parent + +readConfig :: FilePath -> IO Text +readConfig config = do + exists <- doesFileExist config + if not exists + then pure "" + else do + bytes <- BS.readFile config + either (ioError . userError . show) pure (Encoding.decodeUtf8' bytes) + +parseConfig :: Text -> Either Text Toml.Table +parseConfig text = do + t <- either (Left . Text.pack) (Right . Toml.forgetTableAnns) (Toml.parse text) + case value "skills" t of + Nothing -> Right t + Just (Toml.Table skills) -> case value "config" skills of + Nothing -> Right t + Just (Toml.List _) -> Right t + _ -> Left "skills.config is not an array" + _ -> Left "skills is not a table" + +value :: Text -> Toml.Table -> Maybe Toml.Value +value key (Toml.MkTable t) = snd <$> Map.lookup key t + +configValues :: Toml.Table -> [Toml.Value] +configValues t = case value "skills" t of + Just (Toml.Table skills) -> case value "config" skills of + Just (Toml.List values) -> values + _ -> [] + _ -> [] + +withoutConfig :: Toml.Table -> Toml.Table +withoutConfig (Toml.MkTable t) = Toml.MkTable $ Map.update clean "skills" t + where + clean (_, Toml.Table (Toml.MkTable skills)) = + let rest = Map.delete "config" skills + in if Map.null rest then Nothing else Just ((), Toml.Table (Toml.MkTable rest)) + clean other = Just other + +disabledValue :: FilePath -> Toml.Value +disabledValue skill = + Toml.Table + ( Toml.MkTable + ( Map.fromList + [("path", ((), Toml.Text (Text.pack skill))), ("enabled", ((), Toml.Bool False))] + ) + ) + +disabledBlock :: FilePath -> Text +disabledBlock skill = "[[skills.config]]\npath = " <> tomlString (Text.pack skill) <> "\nenabled = false\n" + +-- Mark the separator so uninstall restores even a seed with no final newline. +appendBlock :: Text -> FilePath -> Text +appendBlock text skill = text <> "\n# baikai-kit begin\n" <> disabledBlock skill <> "# baikai-kit end\n" + +removeBlock :: Text -> FilePath -> Text +removeBlock text skill = + let marked = go "" (Text.splitOn "\n# baikai-kit begin\n" text) + in if marked /= text then marked else removeUnmarked text skill + where + go prefix [] = prefix + go prefix [lastPart] = prefix <> lastPart + go prefix (part : block : remaining) = + let (body, suffix) = Text.breakOn "# baikai-kit end\n" block + matches = case parseConfig body of + Right table -> configValues table == [disabledValue skill] + Left _ -> False + in if matches && not (Text.null suffix) + then + prefix + <> part + <> Text.drop (Text.length "# baikai-kit end\n") suffix + <> Text.concat ["\n# baikai-kit begin\n" <> r | r <- remaining] + else go (prefix <> part <> "\n# baikai-kit begin\n") (block : remaining) + +-- A user may remove our delimiter comments. Locate the table block; the +-- caller still verifies that removing it changes exactly one parsed entry. +removeUnmarked :: Text -> FilePath -> Text +removeUnmarked text skill = go [] (Text.splitOn "\n" text) + where + go before [] = Text.intercalate "\n" before + go before (line : rest) + | Text.strip (Text.takeWhile (/= '#') line) == "[[skills.config]]" = + let (body, after) = break (Text.isPrefixOf "[" . Text.stripStart) rest + block = Text.intercalate "\n" (line : body) + matches = case parseConfig block of + Right table -> case configValues table of + [Toml.Table entry] -> + value "path" entry == Just (Toml.Text (Text.pack skill)) + && value "enabled" entry == Just (Toml.Bool False) + _ -> False + Left _ -> False + in if matches + then Text.intercalate "\n" (before ++ after) + else go (before ++ [line]) rest + | otherwise = go (before ++ [line]) rest + +atomicWrite :: FilePath -> Text -> IO () +atomicWrite path text = do + let dir = takeDirectory path + createDirectoryIfMissing True dir + exists <- doesFileExist path + permissions <- if exists then Just <$> getPermissions path else pure Nothing + (temp, handle) <- openTempFile dir (takeFileName path <> ".baikai-kit-tmp") + ( do + BS.hPut handle (Encoding.encodeUtf8 text) + hClose handle + forM_ permissions (setPermissions temp) + renameFile temp path + ) + `onException` (hClose handle >> removeFile temp) + +configTry :: FilePath -> FilePath -> IO (Either Text a) -> IO (Either KitError a) +configTry config skill action = do + result <- try @IOException action + pure $ case result of + Left e -> Left (failure (Text.pack (show e))) + Right (Left reason) -> Left (failure reason) + Right (Right v) -> Right v + where + failure reason = + KitCodexConfigUnusable + config + ( reason + <> "\nAdd this block by hand:\n" + <> disabledBlock skill + <> "Use --shared to install without the entry. --accept-shared-codex applies to agents that cannot be isolated." + ) + +enableSkillsArgs :: [FilePath] -> [Text] +enableSkillsArgs [] = [] +enableSkillsArgs skills = + [ "-c", + "skills.config=[" + <> Text.intercalate + "," + ["{path=" <> tomlString (Text.pack p) <> ",enabled=true}" | p <- nub skills] + <> "]" + ] + +tomlString :: Text -> Text +tomlString input = "\"" <> Text.concatMap escape input <> "\"" + where + escape '"' = "\\\"" + escape '\\' = "\\\\" + escape c + | ord c < 32 || ord c == 127 = + let digits = showHex (ord c) "" + in "\\u" <> Text.pack (replicate (4 - length digits) '0' ++ digits) + escape c = Text.singleton c diff --git a/src/Baikai/Kit/Command.hs b/src/Baikai/Kit/Command.hs --- a/src/Baikai/Kit/Command.hs +++ b/src/Baikai/Kit/Command.hs @@ -5,6 +5,7 @@ -- see @docs/adr/0013-library-code-never-calls-exitfailure.md@. module Baikai.Kit.Command ( KitCommand (..), + OutputFormat (..), kitCommandParser, runKit, runKitCommand, @@ -12,9 +13,10 @@ where import Baikai.Kit.Config (KitConfig, KitScope (..), scopeLabel) -import Baikai.Kit.Error (KitError, renderKitError) +import Baikai.Kit.Error (KitError (..), renderKitError) import Baikai.Kit.Install - ( OverwritePolicy (..), + ( InstallOptions (..), + OverwritePolicy (..), UpdateReport, installFrom, loadManifest, @@ -23,61 +25,99 @@ uninstallItem, updateKit, ) -import Baikai.Kit.Manifest (itemKind, itemName) +import Baikai.Kit.Json (listDocument, statusDocument, updateDocument) +import Baikai.Kit.Manifest (KitManifest, itemKind, itemName) import Baikai.Kit.Repo (KitRepo, RepoRefresh (..), ensureKitRepo) -import Baikai.Kit.Status (StatusReport, UpstreamAvailability (..), kitStatus, renderStatusTable) +import Baikai.Kit.Status (StatusReport, UpstreamAvailability (..), installedCopies, kitStatus, renderStatusTable) +import Baikai.Kit.Visibility (KitVisibility (..)) import Baikai.Prelude +import Data.Aeson (Value) +import Data.Aeson qualified as Aeson +import Data.ByteString.Lazy qualified as LBS import Data.Text qualified as Text import Data.Text.IO qualified as Text.IO import Options.Applicative import System.Exit (ExitCode (ExitFailure), exitWith) -import System.IO (stderr) +import System.IO (Handle, stderr, stdout) +-- | How @list@, @status@ and @update@ print their result: the terminal +-- table, or exactly one JSON document on stdout (see "Baikai.Kit.Json"). +data OutputFormat + = HumanOutput + | JsonOutput + deriving stock (Eq, Show) + data KitCommand - = KitList - | KitInstall !Text !KitScope - | KitUpdate !(Maybe Text) !OverwritePolicy + = KitList !OutputFormat + | -- | 'Nothing' asks the configured 'Baikai.Kit.Config.chooseItem'. + KitInstall !(Maybe Text) !KitScope !InstallOptions + | KitUpdate !(Maybe Text) !OverwritePolicy !OutputFormat | KitUninstall !Text !KitScope - | KitStatus - deriving stock (Show) + | KitStatus !OutputFormat + deriving stock (Eq, Show) -kitCommandParser :: Parser KitCommand -kitCommandParser = +-- | The @kit@ subcommands. Takes the configuration so help text can name +-- the tool's own project directory. +kitCommandParser :: KitConfig -> Parser KitCommand +kitCommandParser config = hsubparser - ( command "list" (info (pure KitList) (progDesc "List available skills and subagents")) - <> command "install" (info installParser (progDesc "Install a skill or subagent")) + ( command "list" (info (KitList <$> formatParser) (progDesc "List available skills and subagents")) + <> command "install" (info (installParser config) (progDesc "Install a skill or subagent")) <> command "update" (info updateParser (progDesc "Update installed skills and subagents")) - <> command "uninstall" (info uninstallParser (progDesc "Uninstall a skill or subagent")) - <> command "status" (info (pure KitStatus) (progDesc "Show installed skills and subagents")) + <> command "uninstall" (info (uninstallParser config) (progDesc "Uninstall a skill or subagent")) + <> command "status" (info (KitStatus <$> formatParser) (progDesc "Show installed skills and subagents")) ) - <|> pure KitList + <|> pure (KitList HumanOutput) -- | Run one verb and print its normal output. Never exits, so a consumer -- that wants its own exit codes can map the 'KitError' itself. runKitCommand :: KitConfig -> KitCommand -> IO (Either KitError ()) runKitCommand config = \case - KitList -> withRepo $ \repo -> + KitList HumanOutput -> withRepo HumanOutput $ \repo -> loadManifest (repo ^. #dir) `thenE` \manifest -> printed (renderAvailable manifest) - KitInstall n scope -> withRepo $ \repo -> + KitList JsonOutput -> withRepo JsonOutput $ \repo -> + loadManifest (repo ^. #dir) `thenE` \manifest -> do + copies <- installedCopies config + emit (listDocument (repoAvailability repo) manifest copies) + KitInstall (Just n) scope options -> withRepo HumanOutput $ \repo -> loadManifest (repo ^. #dir) `thenE` \manifest -> - installFrom config (repo ^. #dir) manifest n scope `thenE` \item -> - printed $ - "Installed " <> itemKind item <> " '" <> itemName item <> "' to " <> scopeLabel scope <> " scope." - KitUpdate n policy -> + installNamed repo manifest n scope options + -- Without a chooser nothing the refresh could do changes the outcome, + -- so fail before touching the network. + KitInstall Nothing scope options -> case config ^. #chooseItem of + Nothing -> pure (Left KitItemNameRequired) + Just choose -> withRepo HumanOutput $ \repo -> + loadManifest (repo ^. #dir) `thenE` \manifest -> do + picked <- choose manifest + case picked of + Nothing -> printed "No item chosen; nothing installed." + Just n -> installNamed repo manifest n scope options + KitUpdate n policy HumanOutput -> updateKit config n policy `thenE` (printed . renderUpdateReport) + KitUpdate n policy JsonOutput -> + updateKit config n policy `thenE` (emit . updateDocument) KitUninstall n scope -> uninstallItem config n scope `thenE` (printed . renderUninstallReport n scope) - KitStatus -> do + KitStatus format -> do report <- kitStatus config noteUpstream report - Text.IO.putStrLn (renderStatusTable (report ^. #rows)) - pure (Right ()) + case format of + HumanOutput -> printed (renderStatusTable (report ^. #rows)) + JsonOutput -> emit (statusDocument report) where + installNamed :: KitRepo -> KitManifest -> Text -> KitScope -> InstallOptions -> IO (Either KitError ()) + installNamed repo manifest n scope options = + installFrom config (repo ^. #dir) manifest n scope options `thenE` \item -> + printed $ + "Installed " <> itemKind item <> " '" <> itemName item <> "' to " <> scopeLabel scope <> " scope." + -- List and install need the manifest, so a repository they cannot -- reach is an error; a stale cache is a warning and the work goes on. - withRepo :: (KitRepo -> IO (Either KitError ())) -> IO (Either KitError ()) - withRepo next = do + -- In JSON mode stdout carries only the document, so the clone notice + -- goes to stderr with the warnings. + withRepo :: OutputFormat -> (KitRepo -> IO (Either KitError ())) -> IO (Either KitError ()) + withRepo format next = do repo <- ensureKitRepo config case repo of Left err -> pure (Left err) @@ -86,7 +126,8 @@ RepoStale err -> Text.IO.hPutStrLn stderr $ "Warning: kit repository could not be refreshed (" <> Text.strip err <> "); using the cached copy." - RepoCloned -> Text.IO.putStrLn ("Fetched " <> (config ^. #toolName) <> "-kit.") + RepoCloned -> + Text.IO.hPutStrLn (noticeHandle format) ("Fetched " <> (config ^. #toolName) <> "-kit.") RepoPulled -> pure () next resolved @@ -110,6 +151,20 @@ printed :: Text -> IO (Either KitError ()) printed message = Right <$> Text.IO.putStrLn message + -- One document, UTF-8 encoded whatever the locale (ADR 0007). + emit :: Value -> IO (Either KitError ()) + emit document = Right <$> LBS.hPut stdout (Aeson.encode document <> "\n") + + noticeHandle :: OutputFormat -> Handle + noticeHandle HumanOutput = stdout + noticeHandle JsonOutput = stderr + + repoAvailability :: KitRepo -> UpstreamAvailability + repoAvailability repo = case repo ^. #refresh of + RepoStale err -> UpstreamStale err + RepoCloned -> UpstreamReady + RepoPulled -> UpstreamReady + -- | The command adapter: 'runKitCommand', then on 'Left' print -- @Error: \@ to stderr and exit 1. This is the only -- function in @baikai-kit@ that exits the process. @@ -152,11 +207,23 @@ | null (report ^. #skipped) = [] | otherwise = ["Skipped " <> Text.pack (show (length (report ^. #skipped))) <> " item(s)."] -installParser :: Parser KitCommand -installParser = +installParser :: KitConfig -> Parser KitCommand +installParser config = KitInstall - <$> strArgument (metavar "NAME" <> help "Name of the skill or subagent to install") - <*> scopeParser "Install to project scope instead of user scope" + <$> optional + ( strArgument + ( metavar "NAME" + <> help "Name of the skill or subagent to install; omit it to choose interactively if this tool offers a chooser" + ) + ) + <*> scopeParser ("Install to project scope (" <> projectDirLabel config <> " under the project root) instead of user scope") + <*> ( InstallOptions + <$> optional + ( flag' SharedVisibility (long "shared" <> help "Make the item visible in every Claude Code and Codex session") + <|> flag' ToolOnlyVisibility (long "tool-only" <> help "Make the item visible only in sessions this tool launches") + ) + <*> switch (long "accept-shared-codex" <> help "Accept shared visibility when Codex cannot isolate an agent") + ) updateParser :: Parser KitCommand updateParser = @@ -166,13 +233,21 @@ KeepLocalEdits OverwriteLocalEdits (long "force" <> help "Reinstall items even if their installed files were modified locally") + <*> formatParser -uninstallParser :: Parser KitCommand -uninstallParser = +formatParser :: Parser OutputFormat +formatParser = flag HumanOutput JsonOutput (long "json" <> help "Print one JSON document on stdout") + +uninstallParser :: KitConfig -> Parser KitCommand +uninstallParser config = KitUninstall <$> strArgument (metavar "NAME" <> help "Name of the skill or subagent to uninstall") - <*> scopeParser "Uninstall from project scope instead of user scope" + <*> scopeParser ("Uninstall from project scope (" <> projectDirLabel config <> ") instead of user scope") scopeParser :: String -> Parser KitScope scopeParser helpText = flag UserScope ProjectScope (long "project" <> help helpText) + +-- | The tool's project directory as help text shows it, e.g. @.mytool/agents@. +projectDirLabel :: KitConfig -> String +projectDirLabel config = "." <> Text.unpack (config ^. #toolName) <> "/agents" diff --git a/src/Baikai/Kit/Config.hs b/src/Baikai/Kit/Config.hs --- a/src/Baikai/Kit/Config.hs +++ b/src/Baikai/Kit/Config.hs @@ -1,11 +1,15 @@ module Baikai.Kit.Config ( KitConfig (..), KitScope (..), + kitConfig, + findProjectRoot, + projectRootByMarkers, kitCacheDir, userAgentsDir, projectAgentsDir, resolveAgentsBase, providerAgentsBase, + sharedClaudeBase, providerLabel, sidecarFileName, scopeLabel, @@ -14,18 +18,92 @@ import Baikai.AgentAssets (AgentAssetProvider) import Baikai.Interactive (InteractiveProvider (..)) +import Baikai.Kit.Manifest (KitItem, KitManifest) import Baikai.Prelude +import Data.Maybe (fromMaybe) import Data.Text qualified as Text -import System.Directory (getCurrentDirectory, getHomeDirectory) -import System.FilePath (()) +import System.Directory (doesPathExist, getCurrentDirectory, getHomeDirectory, makeAbsolute) +import System.FilePath (takeDirectory, ()) +-- | How a tool configures the kit engine. Build one with 'kitConfig' and +-- override optional fields with record update syntax; a record literal +-- must set every field. data KitConfig = KitConfig { toolName :: !Text, repoUrl :: !Text, - providers :: ![AgentAssetProvider] + providers :: ![AgentAssetProvider], + -- | The directory project scope lives under. It is run once per + -- project-scope path lookup, so install, status, update, uninstall, + -- and 'Baikai.Kit.Session.agentDirsForSession' all agree on it. The + -- default ('kitConfig') is the current directory; 'projectRootByMarkers' + -- walks up to the nearest marker such as @.git@. An exception thrown + -- by this action propagates to the caller. + projectRoot :: !(IO FilePath), + -- | Called by @kit install@ when no name is given, with the whole + -- manifest. 'Just' a name installs that item (a name the manifest + -- does not list fails with 'Baikai.Kit.Error.KitItemNotFound'); + -- 'Nothing' means the user cancelled, and nothing is installed. When + -- this field is 'Nothing', @kit install@ without a name fails with + -- 'Baikai.Kit.Error.KitItemNameRequired'. The engine ships no picker: + -- the tool owns presentation. An exception thrown by the chooser + -- propagates to the caller. + chooseItem :: !(Maybe (KitManifest -> IO (Maybe Text))), + -- | Confirmation for a tool-only agent whose Codex copy must be shared. + confirmSharedCodex :: !(Maybe (KitItem -> IO Bool)) } - deriving stock (Generic, Show) + deriving stock (Generic) +instance Show KitConfig where + showsPrec d config = + showParen (d > 10) $ + showString "KitConfig {toolName = " + . shows (config ^. #toolName) + . showString ", repoUrl = " + . shows (config ^. #repoUrl) + . showString ", providers = " + . shows (config ^. #providers) + . showString ", projectRoot = , chooseItem = " + . showString (maybe "Nothing" (const "Just ") (config ^. #chooseItem)) + . showString ", confirmSharedCodex = " + . showString (maybe "Nothing" (const "Just ") (config ^. #confirmSharedCodex)) + . showString "}" + +-- | A configuration with every optional behaviour at its default: +-- project scope is the current directory, and @kit install@ requires a +-- name (no chooser). +kitConfig :: Text -> Text -> [AgentAssetProvider] -> KitConfig +kitConfig toolName repoUrl providers = + KitConfig + { toolName, + repoUrl, + providers, + projectRoot = getCurrentDirectory, + chooseItem = Nothing, + confirmSharedCodex = Nothing + } + +-- | The nearest directory, starting at @start@ and walking towards the +-- filesystem root, that contains any of @markers@ (a file or a +-- directory, e.g. @.git@ or @.mytool@). 'Nothing' if none does. +findProjectRoot :: [FilePath] -> FilePath -> IO (Maybe FilePath) +findProjectRoot markers start = makeAbsolute start >>= go + where + go dir = do + found <- or <$> traverse (doesPathExist . (dir )) markers + if found + then pure (Just dir) + else + let parent = takeDirectory dir + in if parent == dir then pure Nothing else go parent + +-- | A ready-made 'projectRoot': the nearest ancestor of the current +-- directory holding one of @markers@, or the current directory itself +-- when there is none. +projectRootByMarkers :: [FilePath] -> IO FilePath +projectRootByMarkers markers = do + cwd <- getCurrentDirectory + fromMaybe cwd <$> findProjectRoot markers cwd + data KitScope = UserScope | ProjectScope @@ -41,10 +119,12 @@ home <- getHomeDirectory pure (home ".config" Text.unpack (config ^. #toolName) "agents") +-- | Every project-scope path derives from 'projectRoot' through this +-- function, 'resolveAgentsBase', or 'providerAgentsBase'. projectAgentsDir :: KitConfig -> IO FilePath projectAgentsDir config = do - cwd <- getCurrentDirectory - pure (cwd "." <> Text.unpack (config ^. #toolName) "agents") + root <- config ^. #projectRoot + pure (root "." <> Text.unpack (config ^. #toolName) "agents") resolveAgentsBase :: KitConfig -> KitScope -> IO FilePath resolveAgentsBase config UserScope = userAgentsDir config @@ -53,7 +133,7 @@ providerAgentsBase :: KitConfig -> AgentAssetProvider -> KitScope -> IO FilePath providerAgentsBase config InteractiveClaude scope = resolveAgentsBase config scope providerAgentsBase _config InteractiveCodex UserScope = getHomeDirectory -providerAgentsBase _config InteractiveCodex ProjectScope = getCurrentDirectory +providerAgentsBase config InteractiveCodex ProjectScope = config ^. #projectRoot providerLabel :: AgentAssetProvider -> Text providerLabel InteractiveClaude = "claude" @@ -65,3 +145,8 @@ scopeLabel :: KitScope -> Text scopeLabel UserScope = "user" scopeLabel ProjectScope = "project" + +-- | The provider-native shared root; project scope uses the configured root. +sharedClaudeBase :: KitConfig -> KitScope -> IO FilePath +sharedClaudeBase _ UserScope = getHomeDirectory +sharedClaudeBase config ProjectScope = config ^. #projectRoot diff --git a/src/Baikai/Kit/Error.hs b/src/Baikai/Kit/Error.hs --- a/src/Baikai/Kit/Error.hs +++ b/src/Baikai/Kit/Error.hs @@ -24,6 +24,9 @@ KitManifestVersionUnsupported FilePath Int | -- | No skill or agent of that name is listed. KitItemNotFound Text + | -- | @kit install@ was given no name and the tool supplies no chooser + -- ('Baikai.Kit.Config.chooseItem' is 'Nothing'). + KitItemNameRequired | -- | The item lists no source files. KitItemHasNoFiles Text | -- | An item name failed 'Baikai.Kit.Path.safeItemName'; the second @@ -50,6 +53,10 @@ -- restored by rollback, and the destinations left inconsistent. -- Both lists are empty when nothing was changed. KitWriteFailed Text [FilePath] [FilePath] + | KitSharedNameTaken FilePath (Maybe Text) + | KitCodexConfigUnusable FilePath Text + | KitCodexCannotIsolate Text + | KitVisibilityNotApplied Text [FilePath] deriving stock (Eq, Show) deriving anyclass (Exception) @@ -70,6 +77,8 @@ <> Text.pack (show n) <> "; this installer supports versions 1 and 2." KitItemNotFound n -> "'" <> n <> "' not found in kit manifest." + KitItemNameRequired -> + "no item name given: pass NAME to 'kit install' (run 'kit list' to see what is available)." KitItemHasNoFiles n -> "'" <> n <> "' lists no source files." KitUnsafeName raw reason -> "unsafe item name '" <> raw <> "': " <> reason KitUnsafePath raw reason -> "unsafe manifest path '" <> raw <> "': " <> reason @@ -89,6 +98,17 @@ "failed to update kit repository: " <> output <> "\nThe cached copy is unchanged; installed items were not reinstalled." + KitSharedNameTaken path owner -> + Text.pack path + <> " already exists and was not created by this tool" + <> maybe "" (\tool -> " (it belongs to " <> tool <> ")") owner + <> "; refusing to replace it." + KitCodexConfigUnusable path reason -> + "cannot edit Codex config " <> Text.pack path <> ": " <> reason + KitCodexCannotIsolate n -> + "'" <> n <> "' is a tool-only agent, but Codex cannot hide a custom agent from other sessions: its Codex copy would be visible to every Codex session. Pass --accept-shared-codex to install it anyway, or --shared." + KitVisibilityNotApplied reason paths -> + "visibility was not applied: " <> reason <> " (" <> Text.intercalate ", " (map Text.pack paths) <> "); run 'kit update NAME' to retry." KitWriteFailed reason restored leftInconsistent -> Text.intercalate "\n" ("install failed: " <> reason : aftermath) where diff --git a/src/Baikai/Kit/Install.hs b/src/Baikai/Kit/Install.hs --- a/src/Baikai/Kit/Install.hs +++ b/src/Baikai/Kit/Install.hs @@ -6,7 +6,13 @@ -- exported boundary, which keeps the plumbing readable without changing -- what a caller observes. module Baikai.Kit.Install - ( loadManifest, + ( InstallOptions (..), + defaultInstallOptions, + VisibilityCheck (..), + checkVisibility, + checkVisibilityWithEntries, + relativeLinkTarget, + loadManifest, loadManifestMaybe, lookupItem, installItem, @@ -18,6 +24,8 @@ UpdateReport (..), updateKit, reinstallPresent, + LocalEdits (..), + checkLocalEdits, listAvailable, renderAvailable, PlannedWrite (..), @@ -29,14 +37,17 @@ where import Baikai.AgentAssets - ( CodexCustomAgent (..), + ( AgentAssetProvider, + CodexCustomAgent (..), agentTargetPath, codexCustomAgentToml, skillTargetPath, ) import Baikai.Interactive (InteractiveProvider (..), InteractiveScope (InteractiveProjectScope)) +import Baikai.Kit.CodexConfig (addDisabledSkill, checkDisabledSkill, checkRemoveDisabledSkill, codexConfigPath, readSkillEntries, removeDisabledSkill) import Baikai.Kit.Config (KitConfig, KitScope (..), kitCacheDir, providerAgentsBase, providerLabel, scopeLabel, sidecarFileName) import Baikai.Kit.Error (KitError (..)) +import Baikai.Kit.Link (SharedLink, applyLink, claudeLinks, foreignOwner, linkIsOurs, pathExists, preflightLink, relativeLinkTarget, removeLink) import Baikai.Kit.Manifest ( AgentEntry, ItemSources, @@ -46,19 +57,22 @@ SkillEntry, itemName, itemSources, + itemVisibility, kitItemKind, supportedManifestVersions, ) import Baikai.Kit.Path (safeItemName, safeSourcePath) import Baikai.Kit.Repo (KitRepo, PullResult (..), RepoRefresh (..), ensureKitRepo, pullKitRepo) -import Baikai.Kit.Sidecar (hashEntries, newSidecarMeta, readSidecar, sidecarPath) +import Baikai.Kit.Sidecar (SidecarMeta, hashEntries, newSidecarMeta, readSidecar, sidecarPath) +import Baikai.Kit.Visibility (KitVisibility (..), parseVisibility, visibilityLabel) import Baikai.Prelude import Control.Exception (IOException, onException, throwIO, try) -import Control.Monad (forM, forM_, unless, when) +import Control.Monad (filterM, forM, forM_, unless, when) import Data.Aeson (eitherDecodeFileStrict', encode) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS import Data.List (find, nub) +import Data.Maybe (fromMaybe) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text.Encoding import System.Directory @@ -69,9 +83,19 @@ removeFile, renameFile, ) +import System.Directory qualified import System.FilePath (takeDirectory, takeFileName, ()) import System.IO (hClose, openTempFile) +data InstallOptions = InstallOptions + { visibility :: !(Maybe KitVisibility), + acceptSharedCodex :: !Bool + } + deriving stock (Eq, Generic, Show) + +defaultInstallOptions :: InstallOptions +defaultInstallOptions = InstallOptions Nothing False + -- | One file this install will put in place. Exposed as a test seam -- together with 'executePlanWith'; not part of the stable surface. data PlannedWrite = PlannedWrite @@ -89,7 +113,9 @@ { provider :: !InteractiveProvider, skillRemoved :: !Bool, agentRemoved :: !Bool, - sidecarRemoved :: !Bool + sidecarRemoved :: !Bool, + linksRemoved :: ![FilePath], + configEntriesRemoved :: ![FilePath] } deriving stock (Eq, Generic, Show) @@ -132,17 +158,17 @@ -- 'KitRepo'\'s refresh state is dropped by this convenience; a command -- that wants to warn about a stale cache composes 'ensureKitRepo', -- 'loadManifest' and 'installFrom' itself. -installItem :: KitConfig -> Text -> KitScope -> IO (Either KitError KitItem) -installItem config itemN scope = kitTry $ do +installItem :: KitConfig -> Text -> KitScope -> InstallOptions -> IO (Either KitError KitItem) +installItem config itemN scope options = kitTry $ do repo <- requireRepo config manifest <- loadManifestIO (repo ^. #dir) - installFromIO config (repo ^. #dir) manifest itemN scope + installFromIO config (repo ^. #dir) manifest itemN scope options -- | The network-free half of 'installItem': install one item from a -- manifest already read out of @repoDir@. -installFrom :: KitConfig -> FilePath -> KitManifest -> Text -> KitScope -> IO (Either KitError KitItem) -installFrom config repoDir manifest itemN scope = - kitTry (installFromIO config repoDir manifest itemN scope) +installFrom :: KitConfig -> FilePath -> KitManifest -> Text -> KitScope -> InstallOptions -> IO (Either KitError KitItem) +installFrom config repoDir manifest itemN scope options = + kitTry (installFromIO config repoDir manifest itemN scope options) -- | Remove an item's assets, its resource directory and its sidecar from -- every provider at one scope. @@ -151,18 +177,38 @@ safeName <- orThrow (KitUnsafeName n) (safeItemName n) forM (config ^. #providers) $ \provider -> do providerBase <- providerAgentsBase config provider scope - skillRemoved <- removeIfDirectory (skillTarget config provider providerBase safeName) - agentFileRemoved <- removeIfFile (agentTarget config provider providerBase safeName) + old <- traverse (\kind -> readSidecar (sidecarPath provider kind n providerBase (sidecarFileName config))) [SkillKind, AgentKind] + links <- + if provider == InteractiveClaude + then do + skillLinks <- claudeLinks config scope SkillKind n False + agentLinks <- claudeLinks config scope AgentKind n True + fmap concat . forM (skillLinks ++ agentLinks) $ \link -> do + removed <- removeLink link + pure [link ^. #location | removed] + else pure [] + -- Sidecars are read before deleting assets so owned entries remain known. + removedEntries <- fmap concat . forM old $ \meta -> + fmap concat . forM (fromMaybe [] (meta >>= (^. #codexDisabledSkills))) $ \raw -> do + path <- codexConfigPath + removed <- removeDisabledSkill path (Text.unpack raw) >>= either throwIO pure + pure [Text.unpack raw | removed] + let ownsSkill = provider /= InteractiveCodex || any (maybe False ((== "skill") . view #kind)) old + ownsAgent = provider /= InteractiveCodex || any (maybe False ((== "agent") . view #kind)) old + skillRemoved <- if ownsSkill then removeIfDirectory (skillTarget config provider providerBase safeName) else pure False + agentFileRemoved <- if ownsAgent then removeIfFile (agentTarget config provider providerBase safeName) else pure False -- A multi-file agent owns a directory beside its agent file; it is -- part of the agent, not a kind of its own. - agentDirRemoved <- removeIfDirectory (agentResourceDir config provider providerBase safeName) + agentDirRemoved <- if ownsAgent then removeIfDirectory (agentResourceDir config provider providerBase safeName) else pure False sidecarRemoved <- removeIfFile (agentSidecarTarget config provider providerBase safeName) pure RemovalOutcome { provider, skillRemoved, agentRemoved = agentFileRemoved || agentDirRemoved, - sidecarRemoved + sidecarRemoved, + linksRemoved = links, + configEntriesRemoved = removedEntries } renderUninstallReport :: Text -> KitScope -> [RemovalOutcome] -> Text @@ -177,12 +223,24 @@ <> " scope (" <> Text.intercalate "," removedProviders <> ")." + <> visibilityRemovalNote | any (^. #sidecarRemoved) outcomes = - "Removed stale kit metadata for '" <> n <> "' from " <> scopeLabel scope <> " scope." + "Removed stale kit metadata for '" <> n <> "' from " <> scopeLabel scope <> " scope." <> visibilityRemovalNote + | any visibilityRemoved outcomes = + "Removed stale visibility for '" <> n <> "' from " <> scopeLabel scope <> " scope." <> visibilityRemovalNote | otherwise = "'" <> n <> "' is not installed in " <> scopeLabel scope <> " scope." where + visibilityRemovalNote = + let links = sum (map (length . view #linksRemoved) outcomes) + entries = sum (map (length . view #configEntriesRemoved) outcomes) + in Text.concat + [ " Removed " <> Text.pack (show count) <> " " <> label <> "." + | (count, label) <- [(links, "shared link(s)"), (entries, "Codex config entry/entries")], + count > 0 + ] assetRemoved outcome = outcome ^. #skillRemoved || outcome ^. #agentRemoved + visibilityRemoved outcome = not (null (outcome ^. #linksRemoved) && null (outcome ^. #configEntriesRemoved)) removedKinds = nub $ ["skill" | any (^. #skillRemoved) outcomes] @@ -377,12 +435,13 @@ throwIO (KitManifestVersionUnsupported manifestPath declared) pure manifest -installFromIO :: KitConfig -> FilePath -> KitManifest -> Text -> KitScope -> IO KitItem -installFromIO config repoDir manifest itemN scope = +installFromIO :: KitConfig -> FilePath -> KitManifest -> Text -> KitScope -> InstallOptions -> IO KitItem +installFromIO config repoDir manifest itemN scope options = case lookupItem itemN manifest of Nothing -> throwIO (KitItemNotFound itemN) Just item -> do - doInstall config repoDir item scope + choices <- prepareVisibility config item scope (Just options) + doInstall config repoDir item scope choices pure item requireRepo :: KitConfig -> IO KitRepo @@ -405,10 +464,13 @@ modified <- case policy of OverwriteLocalEdits -> pure False KeepLocalEdits -> locallyModified config item scope + choices <- prepareVisibility config item scope Nothing if modified - then pure [Left (n, scope)] + then do + repairSkippedVisibility choices + pure [Left (n, scope)] else do - doInstall config repoDir item scope + doInstall config repoDir item scope choices pure [Right (n, scope)] _ -> pure [] pure @@ -424,36 +486,312 @@ map (view #name) (manifest ^. #skills) ++ map (view #name) (manifest ^. #agents) --- | Do this item's installed files still hash to what its sidecar --- recorded? A file that cannot be read counts as modified; a sidecar --- without the recorded names and hash is not checked. +-- | Whether one provider's installed copy of an item still matches what +-- was installed. +data LocalEdits + = -- | Every recorded file reads back with the recorded hash. + Unedited + | -- | A recorded file differs, or cannot be read. + Edited + | -- | There is nothing to compare against: no sidecar, or a sidecar + -- written before @installedFiles@ and @installedHash@ existed. + EditsUnknown + deriving stock (Eq, Show) + +-- | Do one provider's installed files for an item still hash to what its +-- sidecar recorded? This is the one local-edit check: @kit update@ skips +-- an 'Edited' item under 'KeepLocalEdits', and @kit status@ reports it +-- as modified. Reads only local files. +checkLocalEdits :: + KitConfig -> AgentAssetProvider -> KitScope -> KitItemKind -> Text -> IO (Either KitError LocalEdits) +checkLocalEdits config provider scope kind n = kitTry (localEditsIO config provider scope kind n) + +localEditsIO :: KitConfig -> AgentAssetProvider -> KitScope -> KitItemKind -> Text -> IO LocalEdits +localEditsIO config provider scope kind n = do + safeName <- orThrow (KitUnsafeName n) (safeItemName n) + providerBase <- providerAgentsBase config provider scope + let root = installedRoot config provider providerBase kind safeName + mSidecar <- readSidecar (sidecarPath provider kind (Text.pack safeName) providerBase (sidecarFileName config)) + case mSidecar of + Nothing -> pure EditsUnknown + Just sidecar -> + case (sidecar ^. #installedFiles, sidecar ^. #installedHash) of + (Just recorded, Just expected) -> do + entries <- forM recorded $ \rel -> do + bytes <- try @IOException (BS.readFile (root Text.unpack rel)) + pure (either (const Nothing) (Just . (Text.unpack rel,)) (bytes :: Either IOException BS.ByteString)) + pure $ case sequence entries of + Nothing -> Edited + Just pairs + | hashEntries pairs /= expected -> Edited + | otherwise -> Unedited + _ -> pure EditsUnknown + +-- | Was any provider's copy of this item edited locally? A missing or +-- legacy sidecar is not an edit. locallyModified :: KitConfig -> KitItem -> KitScope -> IO Bool locallyModified config item scope = do - safeName <- orThrow (KitUnsafeName (itemName item)) (safeItemName (itemName item)) - checks <- forM (config ^. #providers) $ \provider -> do - providerBase <- providerAgentsBase config provider scope - let kind = kitItemKind item - root = installedRoot config provider providerBase kind safeName - mSidecar <- readSidecar (sidecarPath provider kind (Text.pack safeName) providerBase (sidecarFileName config)) - case mSidecar of - Nothing -> pure False - Just sidecar -> - case (sidecar ^. #installedFiles, sidecar ^. #installedHash) of - (Just recorded, Just expected) -> do - entries <- forM recorded $ \rel -> do - bytes <- try @IOException (BS.readFile (root Text.unpack rel)) - pure (either (const Nothing) (Just . (Text.unpack rel,)) (bytes :: Either IOException BS.ByteString)) - pure $ case sequence entries of - Nothing -> True - Just pairs -> hashEntries pairs /= expected - _ -> pure False - pure (or checks) + checks <- forM (config ^. #providers) $ \provider -> + localEditsIO config provider scope (kitItemKind item) (itemName item) + pure (Edited `elem` checks) -doInstall :: KitConfig -> FilePath -> KitItem -> KitScope -> IO () -doInstall config repoDir item scope = do - writes <- planInstall config repoDir item scope +-- | The one visibility check shared by status and update. An absent +-- requested value marks an installation that predates visibility tracking. +data VisibilityCheck = VisibilityCheck + { requested :: !(Maybe KitVisibility), + effective :: !KitVisibility, + broken :: ![FilePath] + } + deriving stock (Eq, Generic, Show) + +checkVisibility :: KitConfig -> AgentAssetProvider -> KitScope -> KitItemKind -> Text -> IO (Either KitError VisibilityCheck) +checkVisibility config provider scope kind n = do + entries <- + if provider == InteractiveCodex && kind == SkillKind + then codexConfigPath >>= readSkillEntries + else pure (Right []) + checkVisibilityWithEntries entries config provider scope kind n + +-- | A status run supplies one parsed Codex snapshot for every row. +checkVisibilityWithEntries :: Either KitError [(FilePath, Bool)] -> KitConfig -> AgentAssetProvider -> KitScope -> KitItemKind -> Text -> IO (Either KitError VisibilityCheck) +checkVisibilityWithEntries entries config provider scope kind n = kitTry $ do + _ <- orThrow (KitUnsafeName n) (safeItemName n) + base <- providerAgentsBase config provider scope + meta <- readSidecar (sidecarPath provider kind n base (sidecarFileName config)) + let requested = meta >>= (^. #visibility) >>= either (const Nothing) Just . parseVisibility + case provider of + InteractiveClaude -> do + links <- claudeLinks config scope kind n True + states <- forM links $ \link -> do + ours <- linkIsOurs link + exists <- System.Directory.doesPathExist (link ^. #location) + pure (link ^. #location, ours && exists) + let shared = case states of + (_, True) : _ -> True + _ -> False + recorded = fromMaybe [] (meta >>= (^. #sharedLinks)) + hasResources = maybe False ((> 1) . length) (meta >>= (^. #installedFiles)) + wanted = + [ p + | (ordinal, (p, _)) <- zip [0 :: Int ..] states, + requested == Just SharedVisibility, + ordinal == 0 || hasResources + ] + broken = + [ p + | raw <- recorded, + let p = Text.unpack raw, + if p `elem` wanted then lookup p states /= Just True else lookup p states == Just True + ] + pure VisibilityCheck {requested, effective = if shared then SharedVisibility else ToolOnlyVisibility, broken} + InteractiveCodex + | kind == AgentKind -> + pure VisibilityCheck {requested, effective = SharedVisibility, broken = []} + InteractiveCodex -> do + path <- System.Directory.canonicalizePath (skillTarget config provider base (Text.unpack n) "SKILL.md") + canonical <- case entries of + Left _ -> pure [] + Right values -> forM values $ \(p, enabled) -> do + absolute <- System.Directory.canonicalizePath p + pure (absolute, enabled) + let disabled p = (p, False) `elem` canonical && (p, True) `notElem` canonical + tracked = map Text.unpack (fromMaybe [] (meta >>= (^. #codexDisabledSkills))) + trackedPaths <- traverse System.Directory.canonicalizePath tracked + let broken = nub [p | p <- trackedPaths ++ [path | has _Just requested], if requested == Just SharedVisibility then disabled p else not (disabled p)] + pure VisibilityCheck {requested, effective = if disabled path then ToolOnlyVisibility else SharedVisibility, broken} + +-- Visibility intent is prepared for every provider before writing any asset. +data ProviderVisibility = ProviderVisibility + { provider :: !AgentAssetProvider, + baseDir :: !FilePath, + sidecarFile :: !FilePath, + previous :: !(Maybe SidecarMeta), + requested :: !(Maybe KitVisibility), + source :: !(Maybe Text), + links :: ![SharedLink], + oldLinks :: ![SharedLink], + configFile :: !FilePath, + disablePaths :: ![FilePath], + trackedDisabled :: ![Text], + oldDisabled :: ![Text] + } + deriving stock (Generic) + +prepareVisibility :: KitConfig -> KitItem -> KitScope -> Maybe InstallOptions -> IO [ProviderVisibility] +prepareVisibility config item scope options = do + case options of + Just opts + | InteractiveCodex `elem` (config ^. #providers), + kitItemKind item == AgentKind, + fromMaybe (itemVisibility item) (opts ^. #visibility) == ToolOnlyVisibility -> do + accepted <- + if opts ^. #acceptSharedCodex + then pure True + else maybe (pure False) ($ item) (config ^. #confirmSharedCodex) + unless accepted (throwIO (KitCodexCannotIsolate (itemName item))) + _ -> pure () + providers <- case options of + Just _ -> pure (config ^. #providers) + Nothing -> filterM (installedProvider config item scope) (config ^. #providers) + forM providers $ \provider -> do + baseDir <- providerAgentsBase config provider scope + let n = itemName item + kind = kitItemKind item + sidecarFile = sidecarPath provider kind n baseDir (sidecarFileName config) + assetPath = case kind of + SkillKind -> skillTarget config provider baseDir (Text.unpack n) + AgentKind -> agentTarget config provider baseDir (Text.unpack n) + previous <- readSidecar sidecarFile + current <- checkVisibility config provider scope kind n >>= either throwIO pure + when (provider == InteractiveCodex) $ do + let protected = assetPath : [agentResourceDir config provider baseDir (Text.unpack n) | kind == AgentKind] + forM_ protected $ \path -> do + exists <- pathExists path + when (exists && not (has _Just previous)) $ do + owner <- foreignOwner path + throwIO (KitSharedNameTaken path owner) + let (requested, source) = case options of + Just opts -> + ( Just (fromMaybe (itemVisibility item) (opts ^. #visibility)), + Just (if has _Just (opts ^. #visibility) then "install-flag" else "manifest") + ) + Nothing -> case current ^. #requested of + Nothing -> (Nothing, Nothing) + Just old -> + if (previous >>= (^. #visibilitySource)) == Just "install-flag" + then (Just old, Just "install-flag") + else (Just (itemVisibility item), Just "manifest") + sources <- either throwIO pure (itemSources item) + possible <- + if provider == InteractiveClaude + then claudeLinks config scope kind n (kind == AgentKind && length (sources ^. #files) > 1) + else pure [] + allLinks <- if provider == InteractiveClaude then claudeLinks config scope kind n True else pure [] + let links = [link | link <- possible, requested == Just SharedVisibility] + recorded = fromMaybe [] (previous >>= (^. #sharedLinks)) + owned <- forM allLinks linkIsOurs + let oldLinks = [link | (link, ours) <- zip allLinks owned, ours || Text.pack (link ^. #location) `elem` recorded] + forM_ links preflightLink + configFile <- codexConfigPath + let oldDisabled = fromMaybe [] (previous >>= (^. #codexDisabledSkills)) + when (provider == InteractiveCodex && kind == SkillKind && requested == Just SharedVisibility) $ do + path <- System.Directory.canonicalizePath (assetPath "SKILL.md") + entries <- readSkillEntries configFile >>= either throwIO pure + disabled <- forM [p | (p, False) <- entries] System.Directory.canonicalizePath + ownedPaths <- traverse (System.Directory.canonicalizePath . Text.unpack) oldDisabled + when (path `elem` disabled && path `notElem` ownedPaths) $ + throwIO (KitCodexConfigUnusable configFile "a user-owned disabled entry hides this skill; remove that entry by hand before installing --shared") + disablePaths <- + if provider == InteractiveCodex && kind == SkillKind && requested == Just ToolOnlyVisibility + then do + unless ("SKILL.md" `elem` (sources ^. #files)) $ + throwIO (KitCodexConfigUnusable configFile "tool-only visibility on Codex needs a SKILL.md; use --shared") + path <- System.Directory.canonicalizePath (assetPath "SKILL.md") + pure [path] + else pure [] + needed <- forM disablePaths $ \path -> do + added <- checkDisabledSkill configFile path >>= either throwIO pure + pure [Text.pack path | added || Text.pack path `elem` oldDisabled] + let trackedDisabled = concat needed + forM_ oldDisabled $ \path -> when (has _Just requested && Text.unpack path `notElem` disablePaths) $ do + _ <- checkRemoveDisabledSkill configFile (Text.unpack path) >>= either throwIO pure + pure () + pure + ProviderVisibility + { provider, + baseDir, + sidecarFile, + previous, + requested, + source, + links, + oldLinks, + configFile, + disablePaths, + trackedDisabled, + oldDisabled + } + +-- Update reconciles copies already installed, including a surviving sidecar +-- with missing assets. It does not introduce a new unaccepted provider copy. +installedProvider :: KitConfig -> KitItem -> KitScope -> AgentAssetProvider -> IO Bool +installedProvider config item scope provider = do + base <- providerAgentsBase config provider scope + let kind = kitItemKind item + name = itemName item + asset = case kind of + SkillKind -> skillTarget config provider base (Text.unpack name) + AgentKind -> agentTarget config provider base (Text.unpack name) + exists <- pathExists asset + metadata <- doesFileExist (sidecarPath provider kind name base (sidecarFileName config)) + pure (exists || metadata) + +applyVisibility :: ProviderVisibility -> IO () +applyVisibility choice = when (has _Just (choice ^. #requested)) $ do + result <- try @IOException . try @KitError $ do + forM_ (choice ^. #links) applyLink + forM_ (choice ^. #disablePaths) $ \path -> do + addDisabledSkill (choice ^. #configFile) path >>= either throwIO (const (pure ())) + forM_ (choice ^. #oldDisabled) $ \path -> + unless (Text.unpack path `elem` (choice ^. #disablePaths)) $ + removeDisabledSkill (choice ^. #configFile) (Text.unpack path) >>= either throwIO (const (pure ())) + forM_ (choice ^. #oldLinks) $ \link -> + unless (any ((== link ^. #location) . view #location) (choice ^. #links)) $ do + _ <- removeLink link + pure () + case result of + Left e -> throwIO (KitVisibilityNotApplied (Text.pack (show e)) (map (view #location) (choice ^. #links ++ choice ^. #oldLinks))) + Right (Left err) -> + throwIO + ( KitVisibilityNotApplied + (Text.pack (show err)) + (map (view #location) (choice ^. #links ++ choice ^. #oldLinks) ++ [choice ^. #configFile]) + ) + Right (Right ()) -> do + meta <- readSidecar (choice ^. #sidecarFile) + forM_ meta $ \current -> do + let final = + current + & #sharedLinks + .~ Just (map (Text.pack . view #location) (choice ^. #links)) + & #codexDisabledSkills + .~ Just (choice ^. #trackedDisabled) + when (current /= final) $ + executePlan [PlannedWrite (choice ^. #sidecarFile) (WriteBytes (encode final))] + >>= either (\err -> throwIO (KitVisibilityNotApplied (Text.pack (show err)) [choice ^. #sidecarFile])) pure + +repairSkippedVisibility :: [ProviderVisibility] -> IO () +repairSkippedVisibility choices = do + let writes = + [ PlannedWrite + (choice ^. #sidecarFile) + ( WriteBytes + ( encode + ( old + & #visibility + .~ (visibilityLabel <$> (choice ^. #requested)) + & #visibilitySource + .~ (choice ^. #source) + & #sharedLinks + .~ Just (nub (map (Text.pack . view #location) (choice ^. #links ++ choice ^. #oldLinks))) + & #codexDisabledSkills + .~ Just (nub (choice ^. #trackedDisabled ++ choice ^. #oldDisabled)) + ) + ) + ) + | choice <- choices, + Just old <- [choice ^. #previous], + has _Just (choice ^. #requested) + ] executePlan writes >>= either throwIO pure + forM_ choices applyVisibility +doInstall :: KitConfig -> FilePath -> KitItem -> KitScope -> [ProviderVisibility] -> IO () +doInstall config repoDir item scope choices = do + writes <- planInstall config repoDir item scope choices + executePlan writes >>= either throwIO pure + forM_ choices applyVisibility + -- | One installed asset: its name relative to the provider's installed -- root, where it goes, and the bytes to put there. data PlannedAsset = PlannedAsset @@ -463,8 +801,8 @@ } deriving stock (Generic) -planInstall :: KitConfig -> FilePath -> KitItem -> KitScope -> IO [PlannedWrite] -planInstall config repoDir item scope = do +planInstall :: KitConfig -> FilePath -> KitItem -> KitScope -> [ProviderVisibility] -> IO [PlannedWrite] +planInstall config repoDir item _scope choices = do safeName <- orThrow (KitUnsafeName (itemName item)) (safeItemName (itemName item)) sources <- either throwIO pure (itemSources item) resolved <- resolveSources repoDir sources @@ -475,13 +813,23 @@ Right raw -> pure (rel, path, raw) let upstreamHash = hashEntries [(rel, raw) | (rel, _, raw) <- contents] fmap concat $ - forM (config ^. #providers) $ \provider -> do - targetBase <- providerAgentsBase config provider scope + forM choices $ \choice -> do + let provider = choice ^. #provider + targetBase = choice ^. #baseDir assets <- providerAssets config provider targetBase safeName item contents let installedNames = [Text.pack (asset ^. #relativeName) | asset <- assets] installedDigest = hashEntries [(asset ^. #relativeName, LBS.toStrict (asset ^. #bytes)) | asset <- assets] - meta <- newSidecarMeta item upstreamHash installedNames installedDigest + meta <- + newSidecarMeta + item + upstreamHash + installedNames + installedDigest + (visibilityLabel <$> (choice ^. #requested)) + (choice ^. #source) + (nub (map (Text.pack . view #location) (choice ^. #links ++ choice ^. #oldLinks))) + (nub (choice ^. #trackedDisabled ++ choice ^. #oldDisabled)) let assetWrites = [ PlannedWrite {destination = asset ^. #target, content = WriteBytes (asset ^. #bytes)} | asset <- assets @@ -564,7 +912,9 @@ providerBase <- providerAgentsBase config provider scope skillExists <- doesDirectoryExist (skillTarget config provider providerBase safeName) agentExists <- doesFileExist (agentTarget config provider providerBase safeName) - pure (skillExists || agentExists) + skillMetadata <- doesFileExist (sidecarPath provider SkillKind n providerBase (sidecarFileName config)) + agentMetadata <- doesFileExist (agentSidecarTarget config provider providerBase safeName) + pure (skillExists || agentExists || skillMetadata || agentMetadata) pure (or results) -- | Run an action that may raise a 'KitError' and hand the caller a diff --git a/src/Baikai/Kit/Json.hs b/src/Baikai/Kit/Json.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Json.hs @@ -0,0 +1,147 @@ +-- | The machine-readable documents @kit list --json@, @kit status --json@ +-- and @kit update --json@ print, as explicit encoders. +-- +-- These shapes are a public, versioned contract, pinned by golden tests +-- in @baikai-kit/test/golden/@. They are written here by hand rather +-- than derived, so renaming a Haskell field cannot change them. Every +-- document carries 'kitJsonFormatVersion' and a @document@ name. Adding +-- a key keeps the version; removing or renaming one, or changing what a +-- value means, increments it. Every documented key is always present, +-- with @null@ for an absent value. +-- +-- See @docs/adr/0024-machine-readable-kit-output-is-a-versioned-contract.md@. +module Baikai.Kit.Json + ( kitJsonFormatVersion, + listDocument, + statusDocument, + updateDocument, + ) +where + +import Baikai.Kit.Config (KitScope, providerLabel, scopeLabel) +import Baikai.Kit.Error (renderKitError) +import Baikai.Kit.Install (UpdateReport) +import Baikai.Kit.Manifest (KitItemKind (..), KitManifest, kindLabel) +import Baikai.Kit.Repo (RepoRefresh (..)) +import Baikai.Kit.Status + ( InstalledCopy, + StatusReport, + StatusRow, + UpstreamAvailability (..), + conditionLabel, + ) +import Baikai.Kit.Visibility (KitVisibility (..), visibilityLabel) +import Baikai.Prelude hiding ((.=)) +import Data.Aeson (Value (Null), object, (.=)) +import Data.List (sortOn) +import Data.Maybe (fromMaybe) + +-- | The @formatVersion@ every document carries. +kitJsonFormatVersion :: Int +kitJsonFormatVersion = 1 + +-- | @kit-list@: what the kit offers, skills then agents in manifest order, +-- each with the copies installed of it (sorted user before project, +-- then by provider). +listDocument :: UpstreamAvailability -> KitManifest -> [InstalledCopy] -> Value +listDocument availability manifest copies = + object + [ "formatVersion" .= kitJsonFormatVersion, + "document" .= ("kit-list" :: Text), + "upstream" .= upstreamValue availability, + "items" + .= ( [ itemValue SkillKind (entry ^. #name) (entry ^. #description) (entry ^. #version) (visibilityLabel (fromMaybe ToolOnlyVisibility (entry ^. #visibility))) + | entry <- manifest ^. #skills + ] + ++ [ itemValue AgentKind (entry ^. #name) (entry ^. #description) (entry ^. #version) (visibilityLabel (fromMaybe ToolOnlyVisibility (entry ^. #visibility))) + | entry <- manifest ^. #agents + ] + ) + ] + where + itemValue :: KitItemKind -> Text -> Text -> Maybe Text -> Text -> Value + itemValue kind n description version visibility = + object + [ "name" .= n, + "kind" .= kindLabel kind, + "description" .= description, + "version" .= version, + "visibility" .= visibility, + "installed" + .= map + copyValue + ( sortOn + (\copy -> (copy ^. #scope, providerLabel (copy ^. #provider))) + [copy | copy <- copies, copy ^. #name == n, copy ^. #kind == kind] + ) + ] + copyValue :: InstalledCopy -> Value + copyValue copy = + object + [ "scope" .= scopeLabel (copy ^. #scope), + "provider" .= providerLabel (copy ^. #provider), + "version" .= (copy ^. #version), + "path" .= (copy ^. #path) + ] + +-- | @kit-status@: one entry per installed copy — item, scope, and +-- provider — never aggregated, sorted by name, kind, scope, provider. +statusDocument :: StatusReport -> Value +statusDocument report = + object + [ "formatVersion" .= kitJsonFormatVersion, + "document" .= ("kit-status" :: Text), + "upstream" .= upstreamValue (report ^. #upstream), + "items" .= map rowValue (sortOn rowKey (report ^. #rows)) + ] + where + rowKey row = (row ^. #name, row ^. #kind, row ^. #scope, row ^. #providers) + rowValue :: StatusRow -> Value + rowValue row = + object + [ "name" .= (row ^. #name), + "kind" .= (row ^. #kind), + "scope" .= (row ^. #scope), + "provider" .= (row ^. #providers), + "installedVersion" .= (row ^. #installedVersion), + "latestVersion" .= (row ^. #latestVersion), + "requestedVisibility" .= fmap visibilityLabel (row ^. #requestedVisibility), + "effectiveVisibility" .= visibilityLabel (row ^. #effectiveVisibility), + "conditions" .= map conditionLabel (row ^. #conditions), + "upToDate" .= null (row ^. #conditions) + ] + +-- | @kit-update@: how the cache was refreshed and what was updated or +-- skipped, in the report's order. +updateDocument :: UpdateReport -> Value +updateDocument report = + object + [ "formatVersion" .= kitJsonFormatVersion, + "document" .= ("kit-update" :: Text), + "refresh" .= fmap refreshLabel (report ^. #refresh), + "updated" .= map updatedValue (report ^. #updated), + "skipped" .= map skippedValue (report ^. #skipped) + ] + where + refreshLabel :: RepoRefresh -> Text + refreshLabel = \case + RepoCloned -> "cloned" + RepoPulled -> "pulled" + RepoStale _ -> "stale" + updatedValue :: (Text, KitScope) -> Value + updatedValue (n, scope) = object ["name" .= n, "scope" .= scopeLabel scope] + -- 'UpdateReport' skips an item only for local edits today; the reason + -- is spelled out so a later reason is an added value, not a new key. + skippedValue :: (Text, KitScope) -> Value + skippedValue (n, scope) = + object + [ "name" .= n, + "scope" .= scopeLabel scope, + "reason" .= ("locally-modified" :: Text) + ] + +upstreamValue :: UpstreamAvailability -> Value +upstreamValue = \case + UpstreamReady -> object ["state" .= ("ready" :: Text), "detail" .= Null] + UpstreamStale detail -> object ["state" .= ("stale" :: Text), "detail" .= detail] + UpstreamUnavailable err -> object ["state" .= ("unavailable" :: Text), "detail" .= renderKitError err] diff --git a/src/Baikai/Kit/Link.hs b/src/Baikai/Kit/Link.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Link.hs @@ -0,0 +1,129 @@ +-- | Shared Claude names are aliases to tool-owned copies, never copies. +module Baikai.Kit.Link + ( SharedLink (..), + claudeLinks, + linkIsOurs, + preflightLink, + applyLink, + removeLink, + foreignOwner, + pathExists, + relativeLinkTarget, + ) +where + +import Baikai.AgentAssets (agentTargetPath, skillTargetPath) +import Baikai.Interactive (InteractiveProvider (InteractiveClaude), InteractiveScope (InteractiveProjectScope)) +import Baikai.Kit.Config (KitConfig, KitScope (..), providerAgentsBase, sharedClaudeBase) +import Baikai.Kit.Error (KitError (..)) +import Baikai.Kit.Manifest (KitItemKind (..)) +import Baikai.Prelude +import Control.Exception (IOException, throwIO, try) +import Control.Monad (unless, when) +import Data.List (find, isPrefixOf, isSuffixOf) +import Data.Text qualified as Text +import System.Directory + ( canonicalizePath, + createDirectoryIfMissing, + createDirectoryLink, + createFileLink, + doesDirectoryExist, + doesPathExist, + getSymbolicLinkTarget, + listDirectory, + makeAbsolute, + pathIsSymbolicLink, + removeFile, + ) +import System.FilePath (joinPath, splitDirectories, takeDirectory, ()) + +data SharedLink = SharedLink + { location :: !FilePath, + target :: !FilePath, + directory :: !Bool, + relative :: !Bool + } + deriving stock (Generic, Show) + +claudeLinks :: KitConfig -> KitScope -> KitItemKind -> Text -> Bool -> IO [SharedLink] +claudeLinks config scope kind n resources = do + shared <- sharedClaudeBase config scope >>= makeAbsolute + owned <- providerAgentsBase config InteractiveClaude scope >>= makeAbsolute + let name = Text.unpack n + path = case kind of + SkillKind -> skillTargetPath InteractiveClaude InteractiveProjectScope name + AgentKind -> agentTargetPath InteractiveClaude InteractiveProjectScope name + paths = + (path, kind == SkillKind) + : [(takeDirectory path name, True) | kind == AgentKind, resources] + pure [SharedLink (shared p) (owned p) isDir (scope == ProjectScope) | (p, isDir) <- paths] + +pathExists :: FilePath -> IO Bool +pathExists path = do + exists <- doesPathExist path + linked <- either (const False) id <$> try @IOException (pathIsSymbolicLink path) + pure (exists || linked) + +linkIsOurs :: SharedLink -> IO Bool +linkIsOurs link = do + linked <- either (const False) id <$> try @IOException (pathIsSymbolicLink (link ^. #location)) + if not linked + then pure False + else do + raw <- getSymbolicLinkTarget (link ^. #location) + actual <- canonicalizePath (takeDirectory (link ^. #location) raw) + expected <- canonicalizePath (link ^. #target) + pure (actual == expected) + +preflightLink :: SharedLink -> IO () +preflightLink link = do + exists <- pathExists (link ^. #location) + ours <- linkIsOurs link + when (exists && not ours) $ do + owner <- foreignOwner (link ^. #location) + throwIO (KitSharedNameTaken (link ^. #location) owner) + +applyLink :: SharedLink -> IO () +applyLink link = do + preflightLink link + ours <- linkIsOurs link + unless ours $ do + createDirectoryIfMissing True (takeDirectory (link ^. #location)) + let target = + if link ^. #relative + then relativeLinkTarget (takeDirectory (link ^. #location)) (link ^. #target) + else link ^. #target + (if link ^. #directory then createDirectoryLink else createFileLink) target (link ^. #location) + +removeLink :: SharedLink -> IO Bool +removeLink link = do + ours <- linkIsOurs link + when ours (removeFile (link ^. #location)) + pure ours + +-- | A lexical relative target, including sibling directories. +relativeLinkTarget :: FilePath -> FilePath -> FilePath +relativeLinkTarget parent target = go (splitDirectories parent) (splitDirectories target) + where + go (a : as) (b : bs) | a == b = go as bs + go as bs = joinPath (replicate (length as) ".." ++ bs) + +foreignOwner :: FilePath -> IO (Maybe Text) +foreignOwner path = do + linked <- either (const False) id <$> try @IOException (pathIsSymbolicLink path) + if linked + then do + raw <- getSymbolicLinkTarget path + absolute <- canonicalizePath (takeDirectory path raw) + pure (ownerOf (splitDirectories absolute)) + else do + isDir <- doesDirectoryExist path + files <- if isDir then listDirectory path else pure [] + pure $ Text.pack . drop 1 . takeWhileSuffix <$> find sidecar files + where + sidecar f = "." `isPrefixOf` f && "-kit.json" `isSuffixOf` f + takeWhileSuffix f = take (length f - length ("-kit.json" :: String)) f + ownerOf (".config" : tool : "agents" : _) = Just (Text.pack tool) + ownerOf (tool : "agents" : _) | "." `isPrefixOf` tool = Just (Text.pack (drop 1 tool)) + ownerOf (_ : rest) = ownerOf rest + ownerOf [] = Nothing diff --git a/src/Baikai/Kit/Manifest.hs b/src/Baikai/Kit/Manifest.hs --- a/src/Baikai/Kit/Manifest.hs +++ b/src/Baikai/Kit/Manifest.hs @@ -9,6 +9,7 @@ itemName, itemSources, itemVersion, + itemVisibility, kitItemKind, kindLabel, supportedManifestVersions, @@ -17,6 +18,7 @@ import Baikai.Kit.Error (KitError (..)) import Baikai.Kit.Path (safeItemName, safeRelativePath) +import Baikai.Kit.Visibility (KitVisibility (..)) import Baikai.Prelude import Data.Bifunctor (first) import System.FilePath (takeDirectory, takeFileName) @@ -34,7 +36,8 @@ description :: !Text, version :: !(Maybe Text), path :: !Text, - files :: ![Text] + files :: ![Text], + visibility :: !(Maybe KitVisibility) } deriving stock (Generic, Show) deriving anyclass (FromJSON) @@ -44,7 +47,8 @@ description :: !Text, version :: !(Maybe Text), path :: !Text, - files :: !(Maybe [Text]) + files :: !(Maybe [Text]), + visibility :: !(Maybe KitVisibility) } deriving stock (Generic, Show) deriving anyclass (FromJSON) @@ -122,3 +126,7 @@ itemVersion :: KitItem -> Maybe Text itemVersion (KitSkillItem entry) = entry ^. #version itemVersion (KitAgentItem entry) = entry ^. #version + +itemVisibility :: KitItem -> KitVisibility +itemVisibility (KitSkillItem entry) = maybe ToolOnlyVisibility id (entry ^. #visibility) +itemVisibility (KitAgentItem entry) = maybe ToolOnlyVisibility id (entry ^. #visibility) diff --git a/src/Baikai/Kit/Session.hs b/src/Baikai/Kit/Session.hs --- a/src/Baikai/Kit/Session.hs +++ b/src/Baikai/Kit/Session.hs @@ -1,14 +1,42 @@ module Baikai.Kit.Session ( agentDirsForSession, + codexSessionArgs, ) where -import Baikai.Kit.Config (KitConfig, projectAgentsDir, userAgentsDir) -import Control.Monad (filterM) -import System.Directory (doesDirectoryExist) +import Baikai.Interactive (InteractiveProvider (InteractiveCodex)) +import Baikai.Kit.CodexConfig (enableSkillsArgs) +import Baikai.Kit.Config (KitConfig, KitScope (..), projectAgentsDir, providerAgentsBase, sidecarFileName, userAgentsDir) +import Baikai.Kit.Sidecar (readSidecar) +import Baikai.Prelude +import Control.Monad (filterM, forM) +import Data.List (nub, sort) +import Data.Maybe (fromMaybe) +import Data.Text qualified as Text +import System.Directory (canonicalizePath, doesDirectoryExist, listDirectory) +import System.FilePath (()) agentDirsForSession :: KitConfig -> IO [FilePath] agentDirsForSession config = do userDir <- userAgentsDir config projectDir <- projectAgentsDir config filterM doesDirectoryExist [userDir, projectDir] + +-- | Add these to a tool's Codex launch request's extraArgs. Other providers +-- use agentDirsForSession instead. Only this tool's sidecars contribute. +codexSessionArgs :: KitConfig -> IO [Text] +codexSessionArgs config + | InteractiveCodex `notElem` (config ^. #providers) = pure [] + | otherwise = do + paths <- fmap concat . forM [UserScope, ProjectScope] $ \scope -> do + base <- providerAgentsBase config InteractiveCodex scope + let root = base ".agents/skills" + exists <- doesDirectoryExist root + names <- if exists then sort <$> listDirectory root else pure [] + fmap concat . forM names $ \name -> do + meta <- readSidecar (root name Text.unpack (sidecarFileName config)) + let tracked = map Text.unpack (fromMaybe [] (meta >>= (^. #codexDisabledSkills))) + hidden = [root name "SKILL.md" | (meta >>= (^. #visibility)) == Just "tool-only"] + pure (hidden ++ tracked) + canonical <- traverse canonicalizePath paths + pure (enableSkillsArgs (nub canonical)) diff --git a/src/Baikai/Kit/Sidecar.hs b/src/Baikai/Kit/Sidecar.hs --- a/src/Baikai/Kit/Sidecar.hs +++ b/src/Baikai/Kit/Sidecar.hs @@ -45,7 +45,11 @@ hash :: !Text, installedAt :: !Text, installedFiles :: !(Maybe [Text]), - installedHash :: !(Maybe Text) + installedHash :: !(Maybe Text), + visibility :: !(Maybe Text), + visibilitySource :: !(Maybe Text), + sharedLinks :: !(Maybe [Text]), + codexDisabledSkills :: !(Maybe [Text]) } deriving stock (Eq, Generic, Show) deriving anyclass (FromJSON, ToJSON) @@ -114,8 +118,8 @@ -- | Build the sidecar for one provider: the upstream content hash, the -- names this install writes for that provider, and the hash of the -- bytes it writes. -newSidecarMeta :: KitItem -> Text -> [Text] -> Text -> IO SidecarMeta -newSidecarMeta item hashStr writtenFiles writtenHash = do +newSidecarMeta :: KitItem -> Text -> [Text] -> Text -> Maybe Text -> Maybe Text -> [Text] -> [Text] -> IO SidecarMeta +newSidecarMeta item hashStr writtenFiles writtenHash visibility visibilitySource sharedLinks codexDisabledSkills = do now <- getCurrentTime let stamp = Text.pack (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" now) pure @@ -126,5 +130,9 @@ hash = hashStr, installedAt = stamp, installedFiles = Just writtenFiles, - installedHash = Just writtenHash + installedHash = Just writtenHash, + visibility, + visibilitySource, + sharedLinks = Just sharedLinks, + codexDisabledSkills = Just codexDisabledSkills } diff --git a/src/Baikai/Kit/Status.hs b/src/Baikai/Kit/Status.hs --- a/src/Baikai/Kit/Status.hs +++ b/src/Baikai/Kit/Status.hs @@ -1,41 +1,62 @@ module Baikai.Kit.Status - ( KitState (..), + ( KitCondition (..), + InstalledCopy (..), StatusReport (..), StatusRow (..), UpstreamAvailability (..), classify, collectStatus, + installedCopies, kitStatus, - renderState, + conditionLabel, + renderConditions, renderStatusTable, ) where import Baikai.AgentAssets (AgentAssetProvider, agentTargetPath, skillTargetPath) -import Baikai.Interactive (InteractiveScope (InteractiveProjectScope)) +import Baikai.Interactive (InteractiveProvider (InteractiveCodex), InteractiveScope (InteractiveProjectScope)) +import Baikai.Kit.CodexConfig (codexConfigPath, readSkillEntries) import Baikai.Kit.Config (KitConfig, KitScope (..), providerAgentsBase, providerLabel, sidecarFileName) import Baikai.Kit.Error (KitError (..)) -import Baikai.Kit.Install (loadManifestMaybe, lookupItem) +import Baikai.Kit.Install (LocalEdits (..), checkLocalEdits, checkVisibilityWithEntries, loadManifestMaybe, lookupItem) import Baikai.Kit.Manifest (KitItem, KitItemKind (..), itemKind, itemSources, itemVersion, kindLabel) import Baikai.Kit.Repo (RepoRefresh (..), ensureKitRepo) import Baikai.Kit.Sidecar (SidecarMeta, computeKitHash, readSidecar, sidecarPath) +import Baikai.Kit.Visibility (KitVisibility (..), visibilityLabel) import Baikai.Prelude import Control.Monad (forM) import Data.List (groupBy, isPrefixOf, isSuffixOf, nub, sort, sortOn) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isNothing) import Data.Text qualified as Text import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath (takeDirectory, ()) -data KitState - = KitUpToDate - | KitOutdated - | KitDirty - | KitDirtyOutdated - | KitDelisted - | KitUpstreamRefused - | KitUnknown - deriving stock (Eq, Ord, Show) +-- | One thing @kit status@ can say about an installed copy. A row carries +-- a sorted, duplicate-free list of these; an empty list means the copy +-- is up to date. The order of the constructors is the order the labels +-- are rendered in. +data KitCondition + = -- | @unknown@: no readable sidecar, so nothing can be compared. + KitUnknown + | -- | @delisted@: the manifest no longer lists the item. + KitDelisted + | -- | @refused@: the upstream lists a source the installer refuses — a + -- symbolic link, or a path outside the kit. + KitUpstreamRefused + | -- | @outdated@: the manifest version differs from the installed one. + KitOutdated + | -- | @changed-upstream@: the upstream sources changed since install + -- without a version change. @kit update@ reinstalls it. + KitChangedUpstream + | -- | @modified@: installed files were edited since install. @kit update@ + -- skips it unless @--force@. + KitLocallyModified + | -- | @edits-unknown@: the sidecar predates the installed-file hash, so + -- local edits cannot be detected. + KitLocalEditsUnknown + | KitVisibilityBroken + deriving stock (Eq, Ord, Show, Enum, Bounded) -- | Whether the cached upstream could be consulted for this report. data UpstreamAvailability @@ -63,35 +84,46 @@ providers :: !Text, installedVersion :: !(Maybe Text), latestVersion :: !(Maybe Text), - state :: !KitState + -- | Sorted and duplicate-free; empty means up to date. + conditions :: ![KitCondition], + requestedVisibility :: !(Maybe KitVisibility), + effectiveVisibility :: !KitVisibility } deriving stock (Eq, Generic, Show) -renderState :: KitState -> Text -renderState = \case - KitUpToDate -> "up-to-date" - KitOutdated -> "outdated" - KitDirty -> "dirty" - KitDirtyOutdated -> "dirty+outdated" +-- | The stable spelling of a condition, shared by the status table and any +-- machine-readable output. +conditionLabel :: KitCondition -> Text +conditionLabel = \case + KitUnknown -> "unknown" KitDelisted -> "delisted" KitUpstreamRefused -> "refused" - KitUnknown -> "unknown" + KitOutdated -> "outdated" + KitChangedUpstream -> "changed-upstream" + KitLocallyModified -> "modified" + KitLocalEditsUnknown -> "edits-unknown" + KitVisibilityBroken -> "visibility-broken" -classify :: Maybe SidecarMeta -> Maybe KitItem -> Maybe Text -> KitState -classify Nothing _ _ = KitUnknown -classify (Just _) Nothing _ = KitDelisted +-- | @up-to-date@ for no conditions; otherwise the labels in constructor +-- order joined with @+@, e.g. @outdated+changed-upstream+modified@. +renderConditions :: [KitCondition] -> Text +renderConditions [] = "up-to-date" +renderConditions conds = Text.intercalate "+" (map conditionLabel (sort (nub conds))) + +-- | The conditions that compare an installed copy with the upstream: +-- whether it is known, listed, outdated, or changed upstream. Local +-- edits are checked separately, by 'checkLocalEdits'. +classify :: Maybe SidecarMeta -> Maybe KitItem -> Maybe Text -> [KitCondition] +classify Nothing _ _ = [KitUnknown] +classify (Just _) Nothing _ = [KitDelisted] classify (Just sm) (Just it) mUpstreamHash = let outdated = case itemVersion it of Just latest -> sm ^. #version /= Just latest Nothing -> False - dirty = case mUpstreamHash of + changed = case mUpstreamHash of Just up -> up /= sm ^. #hash Nothing -> False - in case (outdated, dirty) of - (True, True) -> KitDirtyOutdated - (True, False) -> KitOutdated - (False, True) -> KitDirty - (False, False) -> KitUpToDate + in [KitOutdated | outdated] ++ [KitChangedUpstream | changed] -- | Collect the status of everything installed. Needs no network: a kit -- repository that cannot be reached is reported as @@ -121,15 +153,32 @@ -- A manifest that cannot be read is treated here as no manifest; the -- report as a whole says so through 'UpstreamUnavailable'. mManifest <- either (const Nothing) id <$> loadManifestMaybe cacheDir + entries <- + if InteractiveCodex `elem` (config ^. #providers) + then codexConfigPath >>= readSkillEntries + else pure (Right []) fmap concat . forM scopes $ \(scope, scopeText) -> do items <- scanInstalled config scope forM items $ \(provider, baseDir, itemName', scannedKind) -> do let mItem = lookupItem itemName' =<< mManifest mSidecar <- readSidecar (sidecarPath provider scannedKind itemName' baseDir (sidecarFileName config)) upstream <- upstreamHash cacheDir mItem - let state' = case upstream of - Left _ -> KitUpstreamRefused + let upstreamConditions = case upstream of + Left _ -> KitUpstreamRefused : [KitUnknown | isNothing mSidecar] Right mUpstreamHash -> classify mSidecar mItem mUpstreamHash + localConditions <- case mSidecar of + Nothing -> pure [] + Just _ -> do + edits <- checkLocalEdits config provider scope scannedKind itemName' + pure $ case edits of + Right Unedited -> [] + Right Edited -> [KitLocallyModified] + Right EditsUnknown -> [KitLocalEditsUnknown] + Left _ -> [KitLocalEditsUnknown] + visibility <- checkVisibilityWithEntries entries config provider scope scannedKind itemName' + let requestedVisibility = either (const Nothing) (view #requested) visibility + effectiveVisibility = either (const SharedVisibility) (view #effective) visibility + visibilityConditions = [KitVisibilityBroken | either (const True) (not . null . view #broken) visibility] pure StatusRow { name = itemName', @@ -138,9 +187,45 @@ providers = providerLabel provider, installedVersion = mSidecar >>= (^. #version), latestVersion = mItem >>= itemVersion, - state = state' + conditions = sort (nub (upstreamConditions ++ localConditions ++ visibilityConditions)), + requestedVisibility, + effectiveVisibility } +-- | One item at one scope for one provider, and where it is. +data InstalledCopy = InstalledCopy + { name :: !Text, + kind :: !KitItemKind, + scope :: !KitScope, + provider :: !AgentAssetProvider, + -- | The skill directory or the agent file. + path :: !FilePath, + -- | From the sidecar; 'Nothing' without a readable one. + version :: !(Maybe Text) + } + deriving stock (Eq, Generic, Show) + +-- | Every installed copy at user and project scope, in filesystem order. +-- Reads only local files. +installedCopies :: KitConfig -> IO [InstalledCopy] +installedCopies config = + fmap concat . forM [UserScope, ProjectScope] $ \scope -> do + items <- scanInstalled config scope + forM items $ \(provider, baseDir, itemName', scannedKind) -> do + mSidecar <- readSidecar (sidecarPath provider scannedKind itemName' baseDir (sidecarFileName config)) + let relative = case scannedKind of + SkillKind -> skillTargetPath provider InteractiveProjectScope (Text.unpack itemName') + AgentKind -> agentTargetPath provider InteractiveProjectScope (Text.unpack itemName') + pure + InstalledCopy + { name = itemName', + kind = scannedKind, + scope, + provider, + path = baseDir relative, + version = mSidecar >>= (^. #version) + } + -- | The hash of an item's sources as they are in the cached checkout. -- -- @Right Nothing@ means there is nothing to compare against: no cache, @@ -191,13 +276,14 @@ -- | The table @kit status@ prints, without a trailing newline. renderStatusTable :: [StatusRow] -> Text renderStatusTable [] = "No kit items installed." -renderStatusTable rows = Text.intercalate "\n" (hdr : map printRow displayRows) +renderStatusTable rows = Text.intercalate "\n" (hdr : map printRow displayRows ++ legacyNote) where displayRows = aggregateStatusRows rows nameW = colWidth "NAME" (^. #name) kindW = colWidth "TYPE" (^. #kind) scopeW = colWidth "SCOPE" (^. #scope) providersW = colWidth "PROVIDERS" (^. #providers) + visibilityW = colWidth "VISIBILITY" renderVisibility instW = colWidth "INSTALLED" (renderMVer . view #installedVersion) latW = colWidth "LATEST" (renderMVer . view #latestVersion) hdr = @@ -205,6 +291,7 @@ <> Text.justifyLeft (kindW + 2) ' ' "TYPE" <> Text.justifyLeft (scopeW + 2) ' ' "SCOPE" <> Text.justifyLeft (providersW + 2) ' ' "PROVIDERS" + <> Text.justifyLeft (visibilityW + 2) ' ' "VISIBILITY" <> Text.justifyLeft (instW + 2) ' ' "INSTALLED" <> Text.justifyLeft (latW + 2) ' ' "LATEST" <> "STATE" @@ -212,6 +299,24 @@ colWidth colTitle f = maximum (Text.length colTitle : map (Text.length . f) displayRows) + legacyNote = + if any legacy rows + then + [ "", + "Note: Codex skills installed before baikai-kit 0.4.0.0 are visible to every Codex session.", + "Reinstall one with 'kit install NAME --tool-only' to limit it to this tool's sessions." + ] + else [] + legacy row = + row ^. #kind == "skill" + && row ^. #providers == "codex" + && isNothing (row ^. #requestedVisibility) + && row ^. #effectiveVisibility == SharedVisibility + renderVisibility row = + visibilityLabel (row ^. #effectiveVisibility) + <> case row ^. #requestedVisibility of + Just requested | requested /= row ^. #effectiveVisibility -> " (requested " <> visibilityLabel requested <> ")" + _ -> "" renderMVer = fromMaybe "-" printRow row = @@ -219,9 +324,10 @@ <> Text.justifyLeft (kindW + 2) ' ' (row ^. #kind) <> Text.justifyLeft (scopeW + 2) ' ' (row ^. #scope) <> Text.justifyLeft (providersW + 2) ' ' (row ^. #providers) + <> Text.justifyLeft (visibilityW + 2) ' ' (renderVisibility row) <> Text.justifyLeft (instW + 2) ' ' (renderMVer (row ^. #installedVersion)) <> Text.justifyLeft (latW + 2) ' ' (renderMVer (row ^. #latestVersion)) - <> renderState (row ^. #state) + <> renderConditions (row ^. #conditions) aggregateStatusRows :: [StatusRow] -> [StatusRow] aggregateStatusRows rows = @@ -234,7 +340,9 @@ row ^. #scope, row ^. #installedVersion, row ^. #latestVersion, - row ^. #state + row ^. #conditions, + row ^. #requestedVisibility, + row ^. #effectiveVisibility ) sameKey a b = rowKey a == rowKey b summarize groupRows@(firstRow : _) = diff --git a/src/Baikai/Kit/Visibility.hs b/src/Baikai/Kit/Visibility.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Visibility.hs @@ -0,0 +1,30 @@ +-- | Visibility is independent of user/project scope. +module Baikai.Kit.Visibility + ( KitVisibility (..), + VisibilitySource (..), + visibilityLabel, + parseVisibility, + ) +where + +import Baikai.Prelude +import Data.Aeson (withText) +import Data.Text qualified as Text + +data KitVisibility = ToolOnlyVisibility | SharedVisibility + deriving stock (Eq, Ord, Show, Enum, Bounded) + +data VisibilitySource = FromManifest | FromInstallFlag + deriving stock (Eq, Show) + +visibilityLabel :: KitVisibility -> Text +visibilityLabel ToolOnlyVisibility = "tool-only" +visibilityLabel SharedVisibility = "shared" + +parseVisibility :: Text -> Either Text KitVisibility +parseVisibility "tool-only" = Right ToolOnlyVisibility +parseVisibility "shared" = Right SharedVisibility +parseVisibility other = Left ("unknown visibility '" <> other <> "'; expected tool-only or shared") + +instance FromJSON KitVisibility where + parseJSON = withText "KitVisibility" (either (fail . Text.unpack) pure . parseVisibility) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -5,804 +5,1858 @@ import Baikai.Interactive (InteractiveProvider (InteractiveClaude, InteractiveCodex)) import Baikai.Kit ( AgentEntry (..), - KitCommand (..), - KitConfig (..), - KitError (..), - KitItem (..), - KitItemKind (..), - KitManifest (..), - KitScope (UserScope), - KitState (..), - OverwritePolicy (..), - PlannedWrite (..), - PullResult (..), - RemovalOutcome (..), - SidecarMeta (..), - SkillEntry (..), - UpstreamAvailability (..), - WriteContent (..), - classify, - collectStatus, - computeKitHash, - executePlanWith, - installItem, - kitStatus, - loadManifest, - pullKitRepo, - readSidecar, - reinstallPresent, - renderState, - renderUninstallReport, - runKit, - safeItemName, - safeRelativePath, - safeSourcePath, - sidecarFileName, - sidecarPath, - stripYamlFrontmatter, - uninstallItem, - updateKit, - ) -import Baikai.Prelude -import Control.Exception (finally, try) -import Data.Aeson qualified as Aeson -import Data.ByteString qualified as BS -import Data.List (find, isSuffixOf) -import Data.Text qualified as Text -import Data.Text.Encoding qualified as Text.Encoding -import System.Directory - ( createDirectoryIfMissing, - createDirectoryLink, - doesDirectoryExist, - doesFileExist, - doesPathExist, - listDirectory, - removeDirectoryRecursive, - removeFile, - renameFile, - ) -import System.Environment (lookupEnv, setEnv, unsetEnv) -import System.Exit (ExitCode (..)) -import System.FilePath (takeDirectory, ()) -import System.IO.Temp (withSystemTempDirectory) -import Test.Tasty (TestTree, defaultMain, localOption, testGroup) -import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) -import Test.Tasty.Runners (NumThreads (NumThreads)) - -main :: IO () -main = - defaultMain $ - localOption (NumThreads 1) $ - testGroup - "baikai-kit" - [ manifestTests, - hashTests, - pathSafetyTests, - symlinkSafetyTests, - frontmatterTests, - classifyTests, - statusFilesystemTests, - installRoundTripTests, - typedErrorTests, - installFidelityTests - ] - -manifestTests :: TestTree -manifestTests = - testGroup - "Manifest backward compatibility" - [ fixtureCase "mori-kit.json" 2 4 0, - fixtureCase "rei-kit.json" 1 9 1, - fixtureCase "seihou-kit.json" 1 2 0 - ] - -fixtureCase :: FilePath -> Int -> Int -> Int -> TestTree -fixtureCase file expectedVersion expectedSkills expectedAgents = - testCase (file <> " decodes") $ do - manifest <- decodeFixture file - (manifest ^. #version) @?= expectedVersion - length (manifest ^. #skills) @?= expectedSkills - length (manifest ^. #agents) @?= expectedAgents - -hashTests :: TestTree -hashTests = - testGroup - "Hash" - [ testCase "computeKitHash is deterministic regardless of input order" $ - withSystemTempDirectory "baikai-kit-hash" $ \dir -> do - BS.writeFile (dir "a.md") "alpha" - BS.writeFile (dir "b.md") "beta" - BS.writeFile (dir "c.md") "gamma" - h1 <- assertRight =<< computeKitHash dir "." ["a.md", "b.md", "c.md"] - h2 <- assertRight =<< computeKitHash dir "." ["c.md", "a.md", "b.md"] - h1 @?= h2 - assertBool "hash should carry sha256 prefix" ("sha256:" `Text.isPrefixOf` h1), - testCase "computeKitHash changes when file content changes" $ - withSystemTempDirectory "baikai-kit-hash-mut" $ \dir -> do - BS.writeFile (dir "a.md") "alpha" - before <- assertRight =<< computeKitHash dir "." ["a.md"] - BS.writeFile (dir "a.md") "alpha-modified" - after <- assertRight =<< computeKitHash dir "." ["a.md"] - assertBool "hashes must differ after content change" (before /= after) - ] - -classifyTests :: TestTree -classifyTests = - testGroup - "Status.classify" - [ testCase "no sidecar => unknown" $ - classify Nothing (Just (mkSkillItem "foo" (Just "1.0"))) (Just "h") @?= KitUnknown, - testCase "no upstream entry with a sidecar => delisted" $ - classify (Just (mkSidecar (Just "1.0") "h")) Nothing (Just "h") @?= KitDelisted, - testCase "version mismatch => outdated" $ - classify - (Just (mkSidecar (Just "1.0") "h")) - (Just (mkSkillItem "foo" (Just "2.0"))) - (Just "h") - @?= KitOutdated, - testCase "version and hash mismatch => dirty+outdated" $ - classify - (Just (mkSidecar (Just "1.0") "h1")) - (Just (mkSkillItem "foo" (Just "2.0"))) - (Just "h2") - @?= KitDirtyOutdated, - testCase "hash mismatch => dirty" $ - classify - (Just (mkSidecar (Just "1.0") "h1")) - (Just (mkSkillItem "foo" (Just "1.0"))) - (Just "h2") - @?= KitDirty, - testCase "version and hash match => up-to-date" $ - classify - (Just (mkSidecar (Just "1.0") "h")) - (Just (mkSkillItem "foo" (Just "1.0"))) - (Just "h") - @?= KitUpToDate, - testCase "no upstream hash on matching version => up-to-date" $ - classify - (Just (mkSidecar (Just "1.0") "h")) - (Just (mkAgentItem "foo" (Just "1.0"))) - Nothing - @?= KitUpToDate - ] - -pathSafetyTests :: TestTree -pathSafetyTests = - testGroup - "Path safety" - [ testCase "safeRelativePath accepts and normalises harmless paths" $ do - safeRelativePath "SKILL.md" @?= Right "SKILL.md" - safeRelativePath "skills/review" @?= Right "skills/review" - safeRelativePath "a/./b" @?= Right ("a" "b"), - testCase "safeRelativePath rejects zip-slip, absolute paths, backslashes, and NUL" $ do - mapM_ - (assertLeft . safeRelativePath) - ["", "/etc/passwd", "../x", "a/../../x", "..", "a/..", "a\\..\\b", "a\0b"], - testCase "safeItemName rejects multi-component and hidden names" $ do - safeItemName "reviewer" @?= Right "reviewer" - mapM_ (assertLeft . safeItemName) ["a/b", ".", ".hidden"], - testCase "install refuses a manifest file path that escapes the install root" $ - withPreparedKitHome $ \home cache -> do - BS.writeFile (cache "kit.json") maliciousManifestJson - result <- installItem testConfig "evil" UserScope - assertKitError "KitUnsafePath" isUnsafePath result - assertFileMissing (takeDirectory home "escape.txt") - exitResult <- try @ExitCode (runKit testConfig (KitInstall "evil" UserScope)) - exitResult @?= Left (ExitFailure 1), - testCase "uninstall refuses a traversal name" $ - withPreparedKitHome $ \home _cache -> do - let victim = home "victim" - createDirectoryIfMissing True victim - result <- uninstallItem testConfig "../victim" UserScope - assertKitError "KitUnsafeName" isUnsafeName result - assertDirectoryExists victim - exitResult <- try @ExitCode (runKit testConfig (KitUninstall "../victim" UserScope)) - exitResult @?= Left (ExitFailure 1) - assertDirectoryExists victim - ] - -symlinkSafetyTests :: TestTree -symlinkSafetyTests = - testGroup - "Symlink safety" - [ testCase "safeSourcePath refuses a symlinked component" $ - withPreparedKitHome $ \home cache -> do - plantSymlinkedSource home cache - refused <- safeSourcePath cache ("skills" "demo" "sub" "secret.txt") - refused @?= Left (KitSourceSymlink (cache "skills" "demo" "sub")) - absolute <- safeSourcePath cache "/etc/passwd" - case absolute of - Left (KitUnsafePath _ _) -> pure () - other -> assertFailure ("expected KitUnsafePath, got " <> show other) - plain <- safeSourcePath cache ("skills" "demo" "SKILL.md") - plain @?= Right (cache "skills" "demo" "SKILL.md"), - testCase "computeKitHash refuses a symlinked source" $ - withPreparedKitHome $ \home cache -> do - plantSymlinkedSource home cache - hashed <- computeKitHash cache ("skills" "demo") ["SKILL.md", "sub" "secret.txt"] - hashed @?= Left (KitSourceSymlink (cache "skills" "demo" "sub")), - testCase "install refuses a symlinked source and writes nothing" $ - withPreparedKitHome $ \home cache -> do - plantSymlinkedSource home cache - let claudeSkill = home ".config" "testkit" "agents" ".claude" "skills" "demo" - result <- installItem testConfig "demo" UserScope - assertKitError "KitSourceSymlink" isSourceSymlink result - assertFileMissing (claudeSkill "sub" "secret.txt") - assertFileMissing (claudeSkill "SKILL.md"), - testCase "status reports refused when upstream lists a symlinked source" $ - withPreparedKitHome $ \home cache -> do - _ <- assertRight =<< installItem testConfig "demo" UserScope - plantSymlinkedSource home cache - rows <- collectStatus testConfig cache [(UserScope, "user")] - let demoRows = filter ((== "demo") . view #name) rows - assertBool "expected demo status rows" (not (null demoRows)) - mapM_ (\row -> row ^. #state @?= KitUpstreamRefused) demoRows, - testCase "renderState names the refused state" $ - renderState KitUpstreamRefused @?= "refused" - ] - -frontmatterTests :: TestTree -frontmatterTests = - testGroup - "Frontmatter" - [ testCase "stripYamlFrontmatter handles LF, CRLF, and final delimiter without newline" $ do - stripYamlFrontmatter "---\nname: x\n---\nBody.\n" @?= "Body.\n" - stripYamlFrontmatter "---\r\nname: x\r\n---\r\nBody.\r\n" @?= "Body.\n" - stripYamlFrontmatter "---\nname: x\n---" @?= "", - testCase "stripYamlFrontmatter leaves non-frontmatter and unterminated blocks unchanged" $ do - stripYamlFrontmatter "Body.\n" @?= "Body.\n" - stripYamlFrontmatter "---\nname: x\nBody.\n" @?= "---\nname: x\nBody.\n", - testCase "stripYamlFrontmatter normalises line endings on every branch" $ do - stripYamlFrontmatter "Body.\r\n" @?= "Body.\n" - stripYamlFrontmatter "---\r\nname: x\r\nBody.\r\n" @?= "---\nname: x\nBody.\n" - ] - -statusFilesystemTests :: TestTree -statusFilesystemTests = - testGroup - "Status filesystem" - [ testCase "sidecarPath drops any agent target extension" $ - withPreparedKitHome $ \home _cache -> do - let claudeBase = home ".config" "testkit" "agents" - codexBase = home - sidecar = sidecarFileName testConfig - sidecarPath InteractiveClaude AgentKind "reviewer" claudeBase sidecar - @?= claudeBase ".claude" "agents" "reviewer.testkit-kit.json" - sidecarPath InteractiveCodex AgentKind "reviewer" codexBase sidecar - @?= codexBase ".codex" "agents" "reviewer.testkit-kit.json", - testCase "delisted installed item keeps sidecar version in status" $ - withPreparedKitHome $ \_home cache -> do - _ <- assertRight =<< installItem testConfig "demo" UserScope - BS.writeFile (cache "kit.json") manifestWithoutDemoJson - rows <- collectStatus testConfig cache [(UserScope, "user")] - let demoRows = filter ((== "demo") . view #name) rows - assertBool "expected demo status rows" (not (null demoRows)) - mapM_ (\row -> row ^. #state @?= KitDelisted) demoRows - mapM_ (\row -> row ^. #installedVersion @?= Just "0.1.0") demoRows, - testCase "version and cached hash drift reports dirty+outdated" $ - withPreparedKitHome $ \_home cache -> do - _ <- assertRight =<< installItem testConfig "demo" UserScope - BS.writeFile (cache "skills" "demo" "SKILL.md") "changed instructions\n" - BS.writeFile (cache "kit.json") manifestWithDemoVersionJson - rows <- collectStatus testConfig cache [(UserScope, "user")] - let demoRows = filter ((== "demo") . view #name) rows - assertBool "expected demo status rows" (not (null demoRows)) - mapM_ (\row -> row ^. #state @?= KitDirtyOutdated) demoRows - ] - -installRoundTripTests :: TestTree -installRoundTripTests = - testGroup - "Install" - [ testCase "skill and agent round-trip through Claude and Codex layouts with sidecars" $ - withPreparedKitHome $ \home _cache -> do - let config = testConfig - claudeBase = home ".config" "testkit" "agents" - codexBase = home - claudeSkill = claudeBase ".claude" "skills" "demo" - codexSkill = codexBase ".agents" "skills" "demo" - claudeAgent = claudeBase ".claude" "agents" "reviewer.md" - codexAgent = codexBase ".codex" "agents" "reviewer.toml" - claudeAgentSidecar = claudeBase ".claude" "agents" "reviewer.testkit-kit.json" - codexAgentSidecar = codexBase ".codex" "agents" "reviewer.testkit-kit.json" - _ <- assertRight =<< installItem config "demo" UserScope - assertFileExists (claudeSkill "SKILL.md") - assertFileExists (codexSkill "SKILL.md") - assertFileExists (claudeSkill ".testkit-kit.json") - meta <- readSidecar (claudeSkill ".testkit-kit.json") - case meta of - Just sidecar -> do - (sidecar ^. #name) @?= ("demo" :: Text) - (sidecar ^. #kind) @?= ("skill" :: Text) - Nothing -> assertFailure "expected a skill sidecar" - _ <- assertRight =<< uninstallItem config "demo" UserScope - assertDirectoryMissing claudeSkill - assertDirectoryMissing codexSkill - _ <- assertRight =<< installItem config "reviewer" UserScope - assertFileExists claudeAgent - assertFileExists codexAgent - assertFileExists claudeAgentSidecar - assertFileExists codexAgentSidecar - toml <- Text.Encoding.decodeUtf8 <$> BS.readFile codexAgent - assertBool "Codex agent TOML should contain developer instructions" ("developer_instructions" `Text.isInfixOf` toml) - _ <- assertRight =<< uninstallItem config "reviewer" UserScope - assertFileMissing claudeAgent - assertFileMissing codexAgent - assertFileMissing claudeAgentSidecar - assertFileMissing codexAgentSidecar, - testCase "Codex TOML strips CRLF YAML frontmatter" $ - withPreparedKitHome $ \home cache -> do - let codexAgent = home ".codex" "agents" "reviewer.toml" - BS.writeFile (cache "agents" "reviewer.md") "---\r\nname: reviewer\r\n---\r\nReview carefully.\r\n" - _ <- assertRight =<< installItem testConfig "reviewer" UserScope - toml <- Text.Encoding.decodeUtf8 <$> BS.readFile codexAgent - assertBool "frontmatter name should be stripped" (not ("name: reviewer" `Text.isInfixOf` toml)) - assertBool "CR characters should be stripped" (not ("\r" `Text.isInfixOf` toml)), - testCase "failed provider write rolls back all staged writes" $ - withPreparedKitHome $ \home _cache -> do - let claudeBase = home ".config" "testkit" "agents" - claudeAgent = claudeBase ".claude" "agents" "reviewer.md" - claudeAgentSidecar = claudeBase ".claude" "agents" "reviewer.testkit-kit.json" - BS.writeFile (home ".codex") "" - result <- installItem testConfig "reviewer" UserScope - assertKitError "KitWriteFailed" isWriteFailed result - assertFileMissing claudeAgent - assertFileMissing claudeAgentSidecar - tmpFiles <- findFilesWithSuffix home ".baikai-kit-tmp" - tmpFiles @?= [], - testCase "renderUninstallReport names actual assets and stale metadata" $ do - renderUninstallReport "demo" UserScope [RemovalOutcome InteractiveClaude True False False] - @?= "Uninstalled skill 'demo' from user scope (claude)." - renderUninstallReport "demo" UserScope [RemovalOutcome InteractiveClaude True False False, RemovalOutcome InteractiveCodex True False False] - @?= "Uninstalled skill 'demo' from user scope (claude,codex)." - renderUninstallReport "reviewer" UserScope [RemovalOutcome InteractiveClaude False False True] - @?= "Removed stale kit metadata for 'reviewer' from user scope." - renderUninstallReport "demo" UserScope [RemovalOutcome InteractiveClaude False False False] - @?= "'demo' is not installed in user scope.", - testCase "uninstallItem reports per-provider removals" $ - withPreparedKitHome $ \home _cache -> do - let codexSkill = home ".agents" "skills" "demo" - _ <- assertRight =<< installItem testConfig "demo" UserScope - removeDirectoryRecursive codexSkill - outcomes <- assertRight =<< uninstallItem testConfig "demo" UserScope - let claudeOutcome = findOutcome InteractiveClaude outcomes - codexOutcome = findOutcome InteractiveCodex outcomes - view #skillRemoved claudeOutcome @?= True - view #skillRemoved codexOutcome @?= False - view #agentRemoved codexOutcome @?= False - view #sidecarRemoved codexOutcome @?= False, - testCase "pull failure is returned as a typed error" $ - withPreparedKitHome $ \_home cache -> do - result <- pullKitRepo testConfig cache - case result of - PullFailed _ -> pure () - PullSucceeded -> assertFailure "expected fake .git cache pull to fail" - updateResult <- updateKit testConfig Nothing KeepLocalEdits - assertKitError "KitPullFailed" isPullFailed updateResult - ] - -typedErrorTests :: TestTree -typedErrorTests = - testGroup - "Typed errors" - [ testCase "loadManifest returns typed errors" $ - withSystemTempDirectory "baikai-kit-manifest" $ \dir -> do - missing <- loadManifest dir - assertKitError "KitManifestMissing" isManifestMissing missing - BS.writeFile (dir "kit.json") "{" - invalid <- loadManifest dir - assertKitError "KitManifestInvalid" isManifestInvalid invalid, - testCase "installItem returns KitItemNotFound" $ - withPreparedKitHome $ \_home _cache -> do - result <- installItem testConfig "nope" UserScope - assertKitError "KitItemNotFound" (== KitItemNotFound "nope") result, - testCase "kit status offline on a fresh HOME exits 0" $ - withSystemTempDirectory "baikai-kit-offline" $ \tmp -> do - oldHome <- lookupEnv "HOME" - let home = tmp "home" - config = testConfig & #repoUrl .~ "file:///nonexistent-kit" - createDirectoryIfMissing True home - setEnv "HOME" home - flip finally (restoreHome oldHome) $ do - exitResult <- try @ExitCode (runKit config KitStatus) - exitResult @?= Right () - report <- kitStatus config - (report ^. #rows) @?= [] - case report ^. #upstream of - UpstreamUnavailable (KitCloneFailed _ _) -> pure () - other -> assertFailure ("expected an unavailable upstream, got " <> show other) - ] - -installFidelityTests :: TestTree -installFidelityTests = - testGroup - "Install fidelity" - [ testCase "multi-file agent installs every listed file" $ - withPreparedKitHome $ \home cache -> do - plantMultiFileAgent cache - let claudeBase = home ".config" "testkit" "agents" - claudeAgents = claudeBase ".claude" "agents" - codexAgents = home ".codex" "agents" - _ <- assertRight =<< installItem testConfig "reviewer" UserScope - assertFileExists (claudeAgents "reviewer.md") - assertFileExists (claudeAgents "reviewer" "guide.md") - assertFileExists (codexAgents "reviewer.toml") - assertFileExists (codexAgents "reviewer" "guide.md") - meta <- readSidecar (claudeAgents "reviewer.testkit-kit.json") - case meta of - Just sidecar -> (sidecar ^. #installedFiles) @?= Just ["reviewer.md", "reviewer" <> "/" <> "guide.md"] - Nothing -> assertFailure "expected an agent sidecar" - _ <- assertRight =<< uninstallItem testConfig "reviewer" UserScope - assertDirectoryMissing (claudeAgents "reviewer") - assertDirectoryMissing (codexAgents "reviewer"), - testCase "phase-two failure restores the previous files" $ - withSystemTempDirectory "baikai-kit-journal" $ \dir -> do - BS.writeFile (dir "a.txt") "old" - let writes = - [ PlannedWrite {destination = dir "a.txt", content = WriteBytes "new"}, - PlannedWrite {destination = dir "b.txt", content = WriteBytes "new"} - ] - failingRename temp dest - | "b.txt" `isSuffixOf` dest = do - takeDirectory temp @?= dir - assertBool "temporary should keep the tmp suffix" (".baikai-kit-tmp" `isSuffixOf` temp) - assertBool "temporary name should be unique" (temp /= dest <> ".baikai-kit-tmp") - ioError (userError "boom") - | otherwise = renameFile temp dest - result <- executePlanWith failingRename writes - case result of - Left (KitWriteFailed _ restored broken) -> do - restored @?= [dir "a.txt"] - broken @?= [] - other -> assertFailure ("expected KitWriteFailed, got " <> show other) - kept <- BS.readFile (dir "a.txt") - kept @?= "old" - assertFileMissing (dir "b.txt") - tmpFiles <- findFilesWithSuffix dir ".baikai-kit-tmp" - tmpFiles @?= [] - bakFiles <- findFilesWithSuffix dir ".baikai-kit-bak" - bakFiles @?= [], - testCase "destination directory is refused before any write" $ - withPreparedKitHome $ \home _cache -> do - let claudeAgents = home ".config" "testkit" "agents" ".claude" "agents" - createDirectoryIfMissing True (claudeAgents "reviewer.md") - result <- installItem testConfig "reviewer" UserScope - assertKitError "KitWriteFailed" isWriteFailed result - assertFileMissing (home ".codex" "agents" "reviewer.toml"), - testCase "unsupported manifest version is refused" $ - withPreparedKitHome $ \_home cache -> do - BS.writeFile (cache "kit.json") manifestWithUnsupportedVersionJson - loaded <- loadManifest cache - case loaded of - Left (KitManifestVersionUnsupported _ 99) -> pure () - other -> assertFailure ("expected KitManifestVersionUnsupported 99, got " <> show other) - installed <- installItem testConfig "demo" UserScope - assertKitError "KitManifestVersionUnsupported" isVersionUnsupported installed, - testCase "a sidecar written before the installed-file fields still decodes" $ - case Aeson.eitherDecodeStrict' legacySidecarJson :: Either String SidecarMeta of - Right meta -> do - (meta ^. #name) @?= ("demo" :: Text) - (meta ^. #installedFiles) @?= Nothing - (meta ^. #installedHash) @?= Nothing - Left err -> assertFailure ("expected a legacy sidecar to decode: " <> err), - testCase "update skips locally modified items unless forced" $ - withPreparedKitHome $ \home cache -> do - let claudeSkill = home ".config" "testkit" "agents" ".claude" "skills" "demo" - upstream = cache "skills" "demo" "SKILL.md" - _ <- assertRight =<< installItem testConfig "demo" UserScope - BS.writeFile (claudeSkill "SKILL.md") "my edits" - BS.writeFile upstream "new upstream" - manifest <- assertRight =<< loadManifest cache - kept <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") KeepLocalEdits - (kept ^. #skipped) @?= [("demo", UserScope)] - (kept ^. #updated) @?= [] - mine <- BS.readFile (claudeSkill "SKILL.md") - mine @?= "my edits" - forced <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") OverwriteLocalEdits - (forced ^. #updated) @?= [("demo", UserScope)] - (forced ^. #skipped) @?= [] - fresh <- BS.readFile (claudeSkill "SKILL.md") - fresh @?= "new upstream" - -- A sidecar from before this release records no installed hash, - -- so the item is reinstalled without the check. - BS.writeFile (claudeSkill ".testkit-kit.json") legacySidecarJson - BS.writeFile (claudeSkill "SKILL.md") "my edits again" - legacy <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") KeepLocalEdits - (legacy ^. #updated) @?= [("demo", UserScope)] - (legacy ^. #skipped) @?= [], - testCase "a write failure during update is returned, not thrown" $ - withPreparedKitHome $ \home _cache -> do - let claudeAgents = home ".config" "testkit" "agents" ".claude" "agents" - cache = home ".cache" "testkit" "kit" - _ <- assertRight =<< installItem testConfig "reviewer" UserScope - removeFile (claudeAgents "reviewer.md") - createDirectoryIfMissing True (claudeAgents "reviewer.md") - manifest <- assertRight =<< loadManifest cache - result <- reinstallPresent testConfig cache manifest (Just "reviewer") OverwriteLocalEdits - assertKitError "KitWriteFailed" isWriteFailed result - ] - -decodeFixture :: FilePath -> IO KitManifest -decodeFixture file = do - bytes <- BS.readFile ("test/fixtures" file) - case Aeson.eitherDecodeStrict' bytes of - Right manifest -> pure manifest - Left err -> assertFailure ("failed to decode " <> file <> ": " <> err) - -mkSidecar :: Maybe Text -> Text -> SidecarMeta -mkSidecar mVersion h = - SidecarMeta - { name = "foo", - kind = "skill", - version = mVersion, - hash = h, - installedAt = "2026-05-13T00:00:00Z", - installedFiles = Nothing, - installedHash = Nothing - } - -mkSkillItem :: Text -> Maybe Text -> KitItem -mkSkillItem n mVersion = - KitSkillItem - SkillEntry - { name = n, - description = "x", - version = mVersion, - path = "skills/foo", - files = ["SKILL.md"] - } - -mkAgentItem :: Text -> Maybe Text -> KitItem -mkAgentItem n mVersion = - KitAgentItem - AgentEntry - { name = n, - description = "x", - version = mVersion, - path = "agents/foo.md", - files = Nothing - } - -testConfig :: KitConfig -testConfig = - KitConfig - { toolName = "testkit", - repoUrl = "file:///not-used", - providers = [InteractiveClaude, InteractiveCodex] - } - -withPreparedKitHome :: (FilePath -> FilePath -> IO a) -> IO a -withPreparedKitHome action = - withSystemTempDirectory "baikai-kit-home" $ \tmp -> do - oldHome <- lookupEnv "HOME" - let home = tmp "home" - cache = home ".cache" "testkit" "kit" - createDirectoryIfMissing True (cache ".git") - createDirectoryIfMissing True (cache "skills" "demo") - createDirectoryIfMissing True (cache "agents") - BS.writeFile (cache "skills" "demo" "SKILL.md") "skill instructions\n" - BS.writeFile (cache "agents" "reviewer.md") "---\nname: reviewer\n---\nReview carefully.\n" - BS.writeFile (cache "kit.json") manifestJson - setEnv "HOME" home - action home cache `finally` restoreHome oldHome - -restoreHome :: Maybe String -> IO () -restoreHome Nothing = unsetEnv "HOME" -restoreHome (Just value) = setEnv "HOME" value - --- | Plant a committed-symlink kit: a directory link out of the checkout --- and a manifest that lists a file below it. -plantSymlinkedSource :: FilePath -> FilePath -> IO () -plantSymlinkedSource home cache = do - let outsideDir = takeDirectory home "outside" - createDirectoryIfMissing True outsideDir - BS.writeFile (outsideDir "secret.txt") "top secret\n" - createDirectoryLink outsideDir (cache "skills" "demo" "sub") - BS.writeFile (cache "kit.json") manifestWithSymlinkedFileJson - -manifestWithSymlinkedFileJson :: BS.ByteString -manifestWithSymlinkedFileJson = - Text.Encoding.encodeUtf8 $ - Text.concat - [ "{\"version\":2,", - "\"skills\":[{", - "\"name\":\"demo\",", - "\"description\":\"Demo skill\",", - "\"version\":\"0.1.0\",", - "\"path\":\"skills/demo\",", - "\"files\":[\"SKILL.md\",\"sub/secret.txt\"]", - "}],", - "\"agents\":[]} " - ] - --- | Rewrite the fixture kit so its agent lists two files below a --- directory of its own. -plantMultiFileAgent :: FilePath -> IO () -plantMultiFileAgent cache = do - createDirectoryIfMissing True (cache "agents" "reviewer") - BS.writeFile (cache "agents" "reviewer" "reviewer.md") "---\nname: reviewer\n---\nReview carefully.\n" - BS.writeFile (cache "agents" "reviewer" "guide.md") "How to review.\n" - BS.writeFile (cache "kit.json") manifestWithMultiFileAgentJson - -manifestWithMultiFileAgentJson :: BS.ByteString -manifestWithMultiFileAgentJson = - Text.Encoding.encodeUtf8 $ - Text.concat - [ "{\"version\":2,", - "\"skills\":[],", - "\"agents\":[{", - "\"name\":\"reviewer\",", - "\"description\":\"Review agent\",", - "\"version\":\"0.1.0\",", - "\"path\":\"agents/reviewer\",", - "\"files\":[\"reviewer.md\",\"guide.md\"]", - "}]} " - ] - -manifestWithUnsupportedVersionJson :: BS.ByteString -manifestWithUnsupportedVersionJson = - Text.Encoding.encodeUtf8 $ - Text.concat - [ "{\"version\":99,", - "\"skills\":[{", - "\"name\":\"demo\",", - "\"description\":\"Demo skill\",", - "\"version\":\"0.1.0\",", - "\"path\":\"skills/demo\",", - "\"files\":[\"SKILL.md\"]", - "}],", - "\"agents\":[]} " - ] - -legacySidecarJson :: BS.ByteString -legacySidecarJson = - "{\"name\":\"demo\",\"kind\":\"skill\",\"version\":\"0.1.0\",\"hash\":\"sha256:x\",\"installedAt\":\"t\"}" - -manifestJson :: BS.ByteString -manifestJson = - Text.Encoding.encodeUtf8 $ - Text.concat - [ "{\"version\":2,", - "\"skills\":[{", - "\"name\":\"demo\",", - "\"description\":\"Demo skill\",", - "\"version\":\"0.1.0\",", - "\"path\":\"skills/demo\",", - "\"files\":[\"SKILL.md\"]", - "}],", - "\"agents\":[{", - "\"name\":\"reviewer\",", - "\"description\":\"Review agent\",", - "\"version\":\"0.1.0\",", - "\"path\":\"agents/reviewer.md\"", - "}]} " - ] - -manifestWithoutDemoJson :: BS.ByteString -manifestWithoutDemoJson = - Text.Encoding.encodeUtf8 $ - Text.concat - [ "{\"version\":2,", - "\"skills\":[],", - "\"agents\":[{", - "\"name\":\"reviewer\",", - "\"description\":\"Review agent\",", - "\"version\":\"0.1.0\",", - "\"path\":\"agents/reviewer.md\"", - "}]} " - ] - -manifestWithDemoVersionJson :: BS.ByteString -manifestWithDemoVersionJson = - Text.Encoding.encodeUtf8 $ - Text.concat - [ "{\"version\":2,", - "\"skills\":[{", - "\"name\":\"demo\",", - "\"description\":\"Demo skill\",", - "\"version\":\"0.2.0\",", - "\"path\":\"skills/demo\",", - "\"files\":[\"SKILL.md\"]", - "}],", - "\"agents\":[{", - "\"name\":\"reviewer\",", - "\"description\":\"Review agent\",", - "\"version\":\"0.1.0\",", - "\"path\":\"agents/reviewer.md\"", - "}]} " - ] - -maliciousManifestJson :: BS.ByteString -maliciousManifestJson = - Text.Encoding.encodeUtf8 $ - Text.concat - [ "{\"version\":2,", - "\"skills\":[{", - "\"name\":\"evil\",", - "\"description\":\"Evil skill\",", - "\"version\":\"0.1.0\",", - "\"path\":\"skills/demo\",", - "\"files\":[\"../../../../escape.txt\"]", - "}],", - "\"agents\":[]} " - ] - -isUnsafePath :: KitError -> Bool -isUnsafePath = \case KitUnsafePath _ _ -> True; _ -> False - -isUnsafeName :: KitError -> Bool -isUnsafeName = \case KitUnsafeName _ _ -> True; _ -> False - -isSourceSymlink :: KitError -> Bool -isSourceSymlink = \case KitSourceSymlink _ -> True; _ -> False - -isWriteFailed :: KitError -> Bool -isWriteFailed = \case KitWriteFailed {} -> True; _ -> False - -isPullFailed :: KitError -> Bool -isPullFailed = \case KitPullFailed _ -> True; _ -> False - -isManifestMissing :: KitError -> Bool -isManifestMissing = \case KitManifestMissing _ -> True; _ -> False - -isVersionUnsupported :: KitError -> Bool -isVersionUnsupported = \case KitManifestVersionUnsupported _ _ -> True; _ -> False - -isManifestInvalid :: KitError -> Bool -isManifestInvalid = \case KitManifestInvalid _ _ -> True; _ -> False - -assertKitError :: (Show a) => String -> (KitError -> Bool) -> Either KitError a -> IO () -assertKitError label matches result = - case result of - Left err | matches err -> pure () - other -> assertFailure ("expected " <> label <> ", got " <> show other) - -assertRight :: (Show e) => Either e a -> IO a -assertRight = \case - Right value -> pure value - Left err -> assertFailure ("expected Right, got Left " <> show err) - -assertLeft :: (Show b) => Either a b -> IO () -assertLeft result = - case result of - Left _ -> pure () - Right value -> assertFailure ("expected Left, got Right " <> show value) - -assertFileExists :: FilePath -> IO () -assertFileExists path = do - exists <- doesFileExist path - assertBool ("expected file to exist: " <> path) exists - -assertFileMissing :: FilePath -> IO () -assertFileMissing path = do - exists <- doesFileExist path - assertBool ("expected file to be missing: " <> path) (not exists) - -assertDirectoryMissing :: FilePath -> IO () -assertDirectoryMissing path = do - exists <- doesDirectoryExist path - assertBool ("expected directory to be missing: " <> path) (not exists) - -assertDirectoryExists :: FilePath -> IO () -assertDirectoryExists path = do - exists <- doesDirectoryExist path - assertBool ("expected directory to exist: " <> path) exists - -findFilesWithSuffix :: FilePath -> String -> IO [FilePath] -findFilesWithSuffix root suffix = do - exists <- doesPathExist root - if not exists - then pure [] - else do - isDir <- doesDirectoryExist root - if not isDir - then pure [root | suffix `isSuffixOf` root] - else do - names <- listDirectory root - fmap concat $ mapM (\name -> findFilesWithSuffix (root name) suffix) names - -findOutcome :: InteractiveProvider -> [RemovalOutcome] -> RemovalOutcome -findOutcome expected outcomes = - case find ((== expected) . view #provider) outcomes of - Just outcome -> outcome - Nothing -> error "expected provider outcome" + InstallOptions (..), + KitCommand (..), + KitCondition (..), + KitConfig (..), + KitError (..), + KitItem (..), + KitItemKind (..), + KitManifest (..), + KitScope (..), + KitVisibility (..), + OutputFormat (..), + OverwritePolicy (..), + PlannedWrite (..), + PullResult (..), + RemovalOutcome (..), + RepoRefresh (..), + SidecarMeta (..), + SkillEntry (..), + UpstreamAvailability (..), + WriteContent (..), + addDisabledSkill, + agentDirsForSession, + checkVisibility, + classify, + codexSessionArgs, + collectStatus, + computeKitHash, + conditionLabel, + defaultInstallOptions, + enableSkillsArgs, + executePlanWith, + findProjectRoot, + installItem, + installedCopies, + kitCommandParser, + kitConfig, + kitJsonFormatVersion, + kitStatus, + listDocument, + loadManifest, + projectRootByMarkers, + pullKitRepo, + readSidecar, + readSkillEntries, + reinstallPresent, + relativeLinkTarget, + removeDisabledSkill, + renderConditions, + renderStatusTable, + renderUninstallReport, + runKit, + runKitCommand, + safeItemName, + safeRelativePath, + safeSourcePath, + sidecarFileName, + sidecarPath, + statusDocument, + stripYamlFrontmatter, + uninstallItem, + updateDocument, + updateKit, + ) +import Baikai.Prelude +import Control.Concurrent (threadDelay) +import Control.Exception (finally, try) +import Control.Monad (forM_, void) +import Data.Aeson (Value (..)) +import Data.Aeson qualified as Aeson +import Data.Aeson.KeyMap qualified as KeyMap +import Data.Bits ((.&.)) +import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as LBS +import Data.Foldable (toList) +import Data.IORef (newIORef, readIORef, writeIORef) +import Data.List (find, isInfixOf, isSuffixOf, nub, sort) +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text.Encoding +import GHC.IO.Handle (hDuplicate, hDuplicateTo) +import Options.Applicative + ( ParserResult (..), + defaultPrefs, + execParserPure, + getParseResult, + helper, + info, + renderFailure, + (<**>), + ) +import System.Directory + ( canonicalizePath, + createDirectoryIfMissing, + createDirectoryLink, + createFileLink, + doesDirectoryExist, + doesFileExist, + doesPathExist, + getCurrentDirectory, + getSymbolicLinkTarget, + listDirectory, + pathIsSymbolicLink, + removeDirectoryRecursive, + removeFile, + renameFile, + withCurrentDirectory, + ) +import System.Environment (lookupEnv, setEnv, unsetEnv) +import System.Exit (ExitCode (..)) +import System.FilePath (takeDirectory, ()) +import System.IO (hClose, hFlush, stdout) +import System.IO.Temp (withSystemTempDirectory, withSystemTempFile) +import System.Posix.Files qualified as Posix +import System.Process (readProcessWithExitCode) +import Test.Tasty (TestTree, defaultMain, localOption, testGroup) +import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=)) +import Test.Tasty.Runners (NumThreads (NumThreads)) +import Toml qualified + +main :: IO () +main = + defaultMain $ + localOption (NumThreads 1) $ + testGroup + "baikai-kit" + [ manifestTests, + hashTests, + pathSafetyTests, + symlinkSafetyTests, + frontmatterTests, + classifyTests, + statusFilesystemTests, + installRoundTripTests, + typedErrorTests, + installFidelityTests, + projectRootTests, + commandTests, + jsonTests, + visibilityTests, + codexVisibilityTests, + visibilityStatusTests, + visibilityRecoveryTests + ] + +manifestTests :: TestTree +manifestTests = + testGroup + "Manifest backward compatibility" + [ fixtureCase "mori-kit.json" 2 4 0, + fixtureCase "rei-kit.json" 1 9 1, + fixtureCase "seihou-kit.json" 1 2 0 + ] + +fixtureCase :: FilePath -> Int -> Int -> Int -> TestTree +fixtureCase file expectedVersion expectedSkills expectedAgents = + testCase (file <> " decodes") $ do + manifest <- decodeFixture file + (manifest ^. #version) @?= expectedVersion + length (manifest ^. #skills) @?= expectedSkills + length (manifest ^. #agents) @?= expectedAgents + +hashTests :: TestTree +hashTests = + testGroup + "Hash" + [ testCase "computeKitHash is deterministic regardless of input order" $ + withSystemTempDirectory "baikai-kit-hash" $ \dir -> do + BS.writeFile (dir "a.md") "alpha" + BS.writeFile (dir "b.md") "beta" + BS.writeFile (dir "c.md") "gamma" + h1 <- assertRight =<< computeKitHash dir "." ["a.md", "b.md", "c.md"] + h2 <- assertRight =<< computeKitHash dir "." ["c.md", "a.md", "b.md"] + h1 @?= h2 + assertBool "hash should carry sha256 prefix" ("sha256:" `Text.isPrefixOf` h1), + testCase "computeKitHash changes when file content changes" $ + withSystemTempDirectory "baikai-kit-hash-mut" $ \dir -> do + BS.writeFile (dir "a.md") "alpha" + before <- assertRight =<< computeKitHash dir "." ["a.md"] + BS.writeFile (dir "a.md") "alpha-modified" + after <- assertRight =<< computeKitHash dir "." ["a.md"] + assertBool "hashes must differ after content change" (before /= after) + ] + +classifyTests :: TestTree +classifyTests = + testGroup + "Status.classify" + [ testCase "no sidecar => unknown" $ + classify Nothing (Just (mkSkillItem "foo" (Just "1.0"))) (Just "h") @?= [KitUnknown], + testCase "no upstream entry with a sidecar => delisted" $ + classify (Just (mkSidecar (Just "1.0") "h")) Nothing (Just "h") @?= [KitDelisted], + testCase "version mismatch => outdated" $ + classify + (Just (mkSidecar (Just "1.0") "h")) + (Just (mkSkillItem "foo" (Just "2.0"))) + (Just "h") + @?= [KitOutdated], + testCase "version and hash mismatch => outdated+changed-upstream" $ + classify + (Just (mkSidecar (Just "1.0") "h1")) + (Just (mkSkillItem "foo" (Just "2.0"))) + (Just "h2") + @?= [KitOutdated, KitChangedUpstream], + testCase "hash mismatch => changed-upstream" $ + classify + (Just (mkSidecar (Just "1.0") "h1")) + (Just (mkSkillItem "foo" (Just "1.0"))) + (Just "h2") + @?= [KitChangedUpstream], + testCase "version and hash match => up-to-date" $ + classify + (Just (mkSidecar (Just "1.0") "h")) + (Just (mkSkillItem "foo" (Just "1.0"))) + (Just "h") + @?= [], + testCase "no upstream hash on matching version => up-to-date" $ + classify + (Just (mkSidecar (Just "1.0") "h")) + (Just (mkAgentItem "foo" (Just "1.0"))) + Nothing + @?= [], + testCase "renderConditions joins labels in order" $ do + renderConditions [] @?= "up-to-date" + renderConditions [KitOutdated, KitChangedUpstream, KitLocallyModified] @?= "outdated+changed-upstream+modified" + ] + +pathSafetyTests :: TestTree +pathSafetyTests = + testGroup + "Path safety" + [ testCase "safeRelativePath accepts and normalises harmless paths" $ do + safeRelativePath "SKILL.md" @?= Right "SKILL.md" + safeRelativePath "skills/review" @?= Right "skills/review" + safeRelativePath "a/./b" @?= Right ("a" "b"), + testCase "safeRelativePath rejects zip-slip, absolute paths, backslashes, and NUL" $ do + mapM_ + (assertLeft . safeRelativePath) + ["", "/etc/passwd", "../x", "a/../../x", "..", "a/..", "a\\..\\b", "a\0b"], + testCase "safeItemName rejects multi-component and hidden names" $ do + safeItemName "reviewer" @?= Right "reviewer" + mapM_ (assertLeft . safeItemName) ["a/b", ".", ".hidden"], + testCase "install refuses a manifest file path that escapes the install root" $ + withPreparedKitHome $ \home cache -> do + BS.writeFile (cache "kit.json") maliciousManifestJson + result <- installItem testConfig "evil" UserScope defaultInstallOptions + assertKitError "KitUnsafePath" isUnsafePath result + assertFileMissing (takeDirectory home "escape.txt") + exitResult <- try @ExitCode (runKit testConfig (KitInstall (Just "evil") UserScope defaultInstallOptions)) + exitResult @?= Left (ExitFailure 1), + testCase "uninstall refuses a traversal name" $ + withPreparedKitHome $ \home _cache -> do + let victim = home "victim" + createDirectoryIfMissing True victim + result <- uninstallItem testConfig "../victim" UserScope + assertKitError "KitUnsafeName" isUnsafeName result + assertDirectoryExists victim + exitResult <- try @ExitCode (runKit testConfig (KitUninstall "../victim" UserScope)) + exitResult @?= Left (ExitFailure 1) + assertDirectoryExists victim + ] + +symlinkSafetyTests :: TestTree +symlinkSafetyTests = + testGroup + "Symlink safety" + [ testCase "safeSourcePath refuses a symlinked component" $ + withPreparedKitHome $ \home cache -> do + plantSymlinkedSource home cache + refused <- safeSourcePath cache ("skills" "demo" "sub" "secret.txt") + refused @?= Left (KitSourceSymlink (cache "skills" "demo" "sub")) + absolute <- safeSourcePath cache "/etc/passwd" + case absolute of + Left (KitUnsafePath _ _) -> pure () + other -> assertFailure ("expected KitUnsafePath, got " <> show other) + plain <- safeSourcePath cache ("skills" "demo" "SKILL.md") + plain @?= Right (cache "skills" "demo" "SKILL.md"), + testCase "computeKitHash refuses a symlinked source" $ + withPreparedKitHome $ \home cache -> do + plantSymlinkedSource home cache + hashed <- computeKitHash cache ("skills" "demo") ["SKILL.md", "sub" "secret.txt"] + hashed @?= Left (KitSourceSymlink (cache "skills" "demo" "sub")), + testCase "install refuses a symlinked source and writes nothing" $ + withPreparedKitHome $ \home cache -> do + plantSymlinkedSource home cache + let claudeSkill = home ".config" "testkit" "agents" ".claude" "skills" "demo" + result <- installItem testConfig "demo" UserScope defaultInstallOptions + assertKitError "KitSourceSymlink" isSourceSymlink result + assertFileMissing (claudeSkill "sub" "secret.txt") + assertFileMissing (claudeSkill "SKILL.md"), + testCase "status reports refused when upstream lists a symlinked source" $ + withPreparedKitHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + plantSymlinkedSource home cache + rows <- collectStatus testConfig cache [(UserScope, "user")] + let demoRows = filter ((== "demo") . view #name) rows + assertBool "expected demo status rows" (not (null demoRows)) + mapM_ (\row -> row ^. #conditions @?= [KitUpstreamRefused]) demoRows, + testCase "conditionLabel names the refused condition" $ + conditionLabel KitUpstreamRefused @?= "refused" + ] + +frontmatterTests :: TestTree +frontmatterTests = + testGroup + "Frontmatter" + [ testCase "stripYamlFrontmatter handles LF, CRLF, and final delimiter without newline" $ do + stripYamlFrontmatter "---\nname: x\n---\nBody.\n" @?= "Body.\n" + stripYamlFrontmatter "---\r\nname: x\r\n---\r\nBody.\r\n" @?= "Body.\n" + stripYamlFrontmatter "---\nname: x\n---" @?= "", + testCase "stripYamlFrontmatter leaves non-frontmatter and unterminated blocks unchanged" $ do + stripYamlFrontmatter "Body.\n" @?= "Body.\n" + stripYamlFrontmatter "---\nname: x\nBody.\n" @?= "---\nname: x\nBody.\n", + testCase "stripYamlFrontmatter normalises line endings on every branch" $ do + stripYamlFrontmatter "Body.\r\n" @?= "Body.\n" + stripYamlFrontmatter "---\r\nname: x\r\nBody.\r\n" @?= "---\nname: x\nBody.\n" + ] + +statusFilesystemTests :: TestTree +statusFilesystemTests = + testGroup + "Status filesystem" + [ testCase "sidecarPath drops any agent target extension" $ + withPreparedKitHome $ \home _cache -> do + let claudeBase = home ".config" "testkit" "agents" + codexBase = home + sidecar = sidecarFileName testConfig + sidecarPath InteractiveClaude AgentKind "reviewer" claudeBase sidecar + @?= claudeBase ".claude" "agents" "reviewer.testkit-kit.json" + sidecarPath InteractiveCodex AgentKind "reviewer" codexBase sidecar + @?= codexBase ".codex" "agents" "reviewer.testkit-kit.json", + testCase "delisted installed item keeps sidecar version in status" $ + withPreparedKitHome $ \_home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + BS.writeFile (cache "kit.json") manifestWithoutDemoJson + rows <- collectStatus testConfig cache [(UserScope, "user")] + let demoRows = filter ((== "demo") . view #name) rows + assertBool "expected demo status rows" (not (null demoRows)) + mapM_ (\row -> row ^. #conditions @?= [KitDelisted]) demoRows + mapM_ (\row -> row ^. #installedVersion @?= Just "0.1.0") demoRows, + testCase "version and cached hash drift reports outdated+changed-upstream" $ + withPreparedKitHome $ \_home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + BS.writeFile (cache "skills" "demo" "SKILL.md") "changed instructions\n" + BS.writeFile (cache "kit.json") manifestWithDemoVersionJson + rows <- collectStatus testConfig cache [(UserScope, "user")] + let demoRows = filter ((== "demo") . view #name) rows + assertBool "expected demo status rows" (not (null demoRows)) + mapM_ (\row -> row ^. #conditions @?= [KitOutdated, KitChangedUpstream]) demoRows, + testCase "an installed item reports no conditions before an edit" $ + withPreparedKitHome $ \_home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + rows <- collectStatus testConfig cache [(UserScope, "user")] + let demoRows = filter ((== "demo") . view #name) rows + assertBool "expected demo status rows" (not (null demoRows)) + mapM_ (\row -> row ^. #conditions @?= []) demoRows, + testCase "editing an installed file reports modified" $ + withPreparedKitHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + BS.writeFile (userClaudeSkill home "SKILL.md") "my edits" + rows <- collectStatus testConfig cache [(UserScope, "user")] + demoConditions rows "claude" >>= (@?= [KitLocallyModified]) + demoConditions rows "codex" >>= (@?= []), + testCase "a legacy sidecar reports edits-unknown" $ + withPreparedKitHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + BS.writeFile (userClaudeSkill home ".testkit-kit.json") legacySidecarJson + rows <- collectStatus testConfig cache [(UserScope, "user")] + conditions <- demoConditions rows "claude" + assertBool ("expected edits-unknown in " <> show conditions) (KitLocalEditsUnknown `elem` conditions) + assertBool ("expected no modified in " <> show conditions) (KitLocallyModified `notElem` conditions), + testCase "modified composes with outdated and changed-upstream" $ + withPreparedKitHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + BS.writeFile (userClaudeSkill home "SKILL.md") "my edits" + BS.writeFile (cache "skills" "demo" "SKILL.md") "changed instructions\n" + BS.writeFile (cache "kit.json") manifestWithDemoVersionJson + rows <- collectStatus testConfig cache [(UserScope, "user")] + demoConditions rows "claude" >>= (@?= [KitOutdated, KitChangedUpstream, KitLocallyModified]), + testCase "status reports modified for exactly what update would skip" $ + withPreparedKitHome $ \home cache -> do + -- Keep project scope inside the temporary HOME so the update's + -- project-scope scan never looks at the working directory. + let config = testConfig & #projectRoot .~ pure (home "project") + _ <- assertRight =<< installItem config "demo" UserScope defaultInstallOptions + _ <- assertRight =<< installItem config "reviewer" UserScope (InstallOptions Nothing True) + BS.writeFile (userClaudeSkill home "SKILL.md") "my edits" + rows <- collectStatus config cache [(UserScope, "user"), (ProjectScope, "project")] + let toScope scopeText = if scopeText == "project" then ProjectScope else UserScope + modifiedByStatus = + nub + [ (row ^. #name, toScope (row ^. #scope)) + | row <- rows, + KitLocallyModified `elem` row ^. #conditions + ] + manifest <- assertRight =<< loadManifest cache + report <- assertRight =<< reinstallPresent config cache manifest Nothing KeepLocalEdits + sort (report ^. #skipped) @?= sort modifiedByStatus + modifiedByStatus @?= [("demo", UserScope)] + ] + where + userClaudeSkill home = home ".config" "testkit" "agents" ".claude" "skills" "demo" + demoConditions rows providerText = + case filter (\row -> row ^. #name == "demo" && row ^. #providers == providerText) rows of + [row] -> pure (row ^. #conditions) + other -> assertFailure ("expected one " <> Text.unpack providerText <> " demo row, got " <> show other) + +installRoundTripTests :: TestTree +installRoundTripTests = + testGroup + "Install" + [ testCase "skill and agent round-trip through Claude and Codex layouts with sidecars" $ + withPreparedKitHome $ \home _cache -> do + let config = testConfig + claudeBase = home ".config" "testkit" "agents" + codexBase = home + claudeSkill = claudeBase ".claude" "skills" "demo" + codexSkill = codexBase ".agents" "skills" "demo" + claudeAgent = claudeBase ".claude" "agents" "reviewer.md" + codexAgent = codexBase ".codex" "agents" "reviewer.toml" + claudeAgentSidecar = claudeBase ".claude" "agents" "reviewer.testkit-kit.json" + codexAgentSidecar = codexBase ".codex" "agents" "reviewer.testkit-kit.json" + _ <- assertRight =<< installItem config "demo" UserScope defaultInstallOptions + assertFileExists (claudeSkill "SKILL.md") + assertFileExists (codexSkill "SKILL.md") + assertFileExists (claudeSkill ".testkit-kit.json") + meta <- readSidecar (claudeSkill ".testkit-kit.json") + case meta of + Just sidecar -> do + (sidecar ^. #name) @?= ("demo" :: Text) + (sidecar ^. #kind) @?= ("skill" :: Text) + Nothing -> assertFailure "expected a skill sidecar" + _ <- assertRight =<< uninstallItem config "demo" UserScope + assertDirectoryMissing claudeSkill + assertDirectoryMissing codexSkill + _ <- assertRight =<< installItem config "reviewer" UserScope (InstallOptions Nothing True) + assertFileExists claudeAgent + assertFileExists codexAgent + assertFileExists claudeAgentSidecar + assertFileExists codexAgentSidecar + toml <- Text.Encoding.decodeUtf8 <$> BS.readFile codexAgent + assertBool "Codex agent TOML should contain developer instructions" ("developer_instructions" `Text.isInfixOf` toml) + _ <- assertRight =<< uninstallItem config "reviewer" UserScope + assertFileMissing claudeAgent + assertFileMissing codexAgent + assertFileMissing claudeAgentSidecar + assertFileMissing codexAgentSidecar, + testCase "Codex TOML strips CRLF YAML frontmatter" $ + withPreparedKitHome $ \home cache -> do + let codexAgent = home ".codex" "agents" "reviewer.toml" + BS.writeFile (cache "agents" "reviewer.md") "---\r\nname: reviewer\r\n---\r\nReview carefully.\r\n" + _ <- assertRight =<< installItem testConfig "reviewer" UserScope (InstallOptions Nothing True) + toml <- Text.Encoding.decodeUtf8 <$> BS.readFile codexAgent + assertBool "frontmatter name should be stripped" (not ("name: reviewer" `Text.isInfixOf` toml)) + assertBool "CR characters should be stripped" (not ("\r" `Text.isInfixOf` toml)), + testCase "failed provider write rolls back all staged writes" $ + withPreparedKitHome $ \home _cache -> do + let claudeBase = home ".config" "testkit" "agents" + claudeAgent = claudeBase ".claude" "agents" "reviewer.md" + claudeAgentSidecar = claudeBase ".claude" "agents" "reviewer.testkit-kit.json" + BS.writeFile (home ".codex") "" + result <- installItem testConfig "reviewer" UserScope (InstallOptions Nothing True) + assertKitError "KitWriteFailed" isWriteFailed result + assertFileMissing claudeAgent + assertFileMissing claudeAgentSidecar + tmpFiles <- findFilesWithSuffix home ".baikai-kit-tmp" + tmpFiles @?= [], + testCase "renderUninstallReport names actual assets and stale metadata" $ do + renderUninstallReport "demo" UserScope [RemovalOutcome InteractiveClaude True False False [] []] + @?= "Uninstalled skill 'demo' from user scope (claude)." + renderUninstallReport "demo" UserScope [RemovalOutcome InteractiveClaude True False False [] [], RemovalOutcome InteractiveCodex True False False [] []] + @?= "Uninstalled skill 'demo' from user scope (claude,codex)." + renderUninstallReport "reviewer" UserScope [RemovalOutcome InteractiveClaude False False True [] []] + @?= "Removed stale kit metadata for 'reviewer' from user scope." + renderUninstallReport "demo" UserScope [RemovalOutcome InteractiveClaude False False False [] []] + @?= "'demo' is not installed in user scope.", + testCase "uninstallItem reports per-provider removals" $ + withPreparedKitHome $ \home _cache -> do + let codexSkill = home ".agents" "skills" "demo" + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + removeDirectoryRecursive codexSkill + outcomes <- assertRight =<< uninstallItem testConfig "demo" UserScope + let claudeOutcome = findOutcome InteractiveClaude outcomes + codexOutcome = findOutcome InteractiveCodex outcomes + view #skillRemoved claudeOutcome @?= True + view #skillRemoved codexOutcome @?= False + view #agentRemoved codexOutcome @?= False + view #sidecarRemoved codexOutcome @?= False, + testCase "pull failure is returned as a typed error" $ + withPreparedKitHome $ \_home cache -> do + result <- pullKitRepo testConfig cache + case result of + PullFailed _ -> pure () + PullSucceeded -> assertFailure "expected fake .git cache pull to fail" + updateResult <- updateKit testConfig Nothing KeepLocalEdits + assertKitError "KitPullFailed" isPullFailed updateResult + ] + +typedErrorTests :: TestTree +typedErrorTests = + testGroup + "Typed errors" + [ testCase "loadManifest returns typed errors" $ + withSystemTempDirectory "baikai-kit-manifest" $ \dir -> do + missing <- loadManifest dir + assertKitError "KitManifestMissing" isManifestMissing missing + BS.writeFile (dir "kit.json") "{" + invalid <- loadManifest dir + assertKitError "KitManifestInvalid" isManifestInvalid invalid, + testCase "installItem returns KitItemNotFound" $ + withPreparedKitHome $ \_home _cache -> do + result <- installItem testConfig "nope" UserScope defaultInstallOptions + assertKitError "KitItemNotFound" (== KitItemNotFound "nope") result, + testCase "kit status offline on a fresh HOME exits 0" $ + withSystemTempDirectory "baikai-kit-offline" $ \tmp -> do + oldHome <- lookupEnv "HOME" + oldCodexHome <- lookupEnv "CODEX_HOME" + let home = tmp "home" + config = testConfig & #repoUrl .~ "file:///nonexistent-kit" + createDirectoryIfMissing True home + setEnv "HOME" home + setEnv "CODEX_HOME" (home ".codex") + flip finally (restoreHome oldHome >> restoreCodexHome oldCodexHome) $ do + exitResult <- try @ExitCode (runKit config (KitStatus HumanOutput)) + exitResult @?= Right () + report <- kitStatus config + (report ^. #rows) @?= [] + case report ^. #upstream of + UpstreamUnavailable (KitCloneFailed _ _) -> pure () + other -> assertFailure ("expected an unavailable upstream, got " <> show other) + ] + +installFidelityTests :: TestTree +installFidelityTests = + testGroup + "Install fidelity" + [ testCase "multi-file agent installs every listed file" $ + withPreparedKitHome $ \home cache -> do + plantMultiFileAgent cache + let claudeBase = home ".config" "testkit" "agents" + claudeAgents = claudeBase ".claude" "agents" + codexAgents = home ".codex" "agents" + _ <- assertRight =<< installItem testConfig "reviewer" UserScope (InstallOptions Nothing True) + assertFileExists (claudeAgents "reviewer.md") + assertFileExists (claudeAgents "reviewer" "guide.md") + assertFileExists (codexAgents "reviewer.toml") + assertFileExists (codexAgents "reviewer" "guide.md") + meta <- readSidecar (claudeAgents "reviewer.testkit-kit.json") + case meta of + Just sidecar -> (sidecar ^. #installedFiles) @?= Just ["reviewer.md", "reviewer" <> "/" <> "guide.md"] + Nothing -> assertFailure "expected an agent sidecar" + _ <- assertRight =<< uninstallItem testConfig "reviewer" UserScope + assertDirectoryMissing (claudeAgents "reviewer") + assertDirectoryMissing (codexAgents "reviewer"), + testCase "phase-two failure restores the previous files" $ + withSystemTempDirectory "baikai-kit-journal" $ \dir -> do + BS.writeFile (dir "a.txt") "old" + let writes = + [ PlannedWrite {destination = dir "a.txt", content = WriteBytes "new"}, + PlannedWrite {destination = dir "b.txt", content = WriteBytes "new"} + ] + failingRename temp dest + | "b.txt" `isSuffixOf` dest = do + takeDirectory temp @?= dir + assertBool "temporary should keep the tmp suffix" (".baikai-kit-tmp" `isSuffixOf` temp) + assertBool "temporary name should be unique" (temp /= dest <> ".baikai-kit-tmp") + ioError (userError "boom") + | otherwise = renameFile temp dest + result <- executePlanWith failingRename writes + case result of + Left (KitWriteFailed _ restored broken) -> do + restored @?= [dir "a.txt"] + broken @?= [] + other -> assertFailure ("expected KitWriteFailed, got " <> show other) + kept <- BS.readFile (dir "a.txt") + kept @?= "old" + assertFileMissing (dir "b.txt") + tmpFiles <- findFilesWithSuffix dir ".baikai-kit-tmp" + tmpFiles @?= [] + bakFiles <- findFilesWithSuffix dir ".baikai-kit-bak" + bakFiles @?= [], + testCase "destination directory is refused before any write" $ + withPreparedKitHome $ \home _cache -> do + let claudeAgents = home ".config" "testkit" "agents" ".claude" "agents" + createDirectoryIfMissing True (claudeAgents "reviewer.md") + result <- installItem testConfig "reviewer" UserScope (InstallOptions Nothing True) + assertKitError "KitWriteFailed" isWriteFailed result + assertFileMissing (home ".codex" "agents" "reviewer.toml"), + testCase "unsupported manifest version is refused" $ + withPreparedKitHome $ \_home cache -> do + BS.writeFile (cache "kit.json") manifestWithUnsupportedVersionJson + loaded <- loadManifest cache + case loaded of + Left (KitManifestVersionUnsupported _ 99) -> pure () + other -> assertFailure ("expected KitManifestVersionUnsupported 99, got " <> show other) + installed <- installItem testConfig "demo" UserScope defaultInstallOptions + assertKitError "KitManifestVersionUnsupported" isVersionUnsupported installed, + testCase "a sidecar written before the installed-file fields still decodes" $ + case Aeson.eitherDecodeStrict' legacySidecarJson :: Either String SidecarMeta of + Right meta -> do + (meta ^. #name) @?= ("demo" :: Text) + (meta ^. #installedFiles) @?= Nothing + (meta ^. #installedHash) @?= Nothing + Left err -> assertFailure ("expected a legacy sidecar to decode: " <> err), + testCase "update skips locally modified items unless forced" $ + withPreparedKitHome $ \home cache -> do + let claudeSkill = home ".config" "testkit" "agents" ".claude" "skills" "demo" + upstream = cache "skills" "demo" "SKILL.md" + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + BS.writeFile (claudeSkill "SKILL.md") "my edits" + BS.writeFile upstream "new upstream" + manifest <- assertRight =<< loadManifest cache + kept <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") KeepLocalEdits + (kept ^. #skipped) @?= [("demo", UserScope)] + (kept ^. #updated) @?= [] + mine <- BS.readFile (claudeSkill "SKILL.md") + mine @?= "my edits" + forced <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") OverwriteLocalEdits + (forced ^. #updated) @?= [("demo", UserScope)] + (forced ^. #skipped) @?= [] + fresh <- BS.readFile (claudeSkill "SKILL.md") + fresh @?= "new upstream" + -- A sidecar from before this release records no installed hash, + -- so the item is reinstalled without the check. + BS.writeFile (claudeSkill ".testkit-kit.json") legacySidecarJson + BS.writeFile (claudeSkill "SKILL.md") "my edits again" + legacy <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") KeepLocalEdits + (legacy ^. #updated) @?= [("demo", UserScope)] + (legacy ^. #skipped) @?= [], + testCase "a write failure during update is returned, not thrown" $ + withPreparedKitHome $ \home _cache -> do + let claudeAgents = home ".config" "testkit" "agents" ".claude" "agents" + cache = home ".cache" "testkit" "kit" + _ <- assertRight =<< installItem testConfig "reviewer" UserScope (InstallOptions Nothing True) + removeFile (claudeAgents "reviewer.md") + createDirectoryIfMissing True (claudeAgents "reviewer.md") + manifest <- assertRight =<< loadManifest cache + result <- reinstallPresent testConfig cache manifest (Just "reviewer") OverwriteLocalEdits + assertKitError "KitWriteFailed" isWriteFailed result + ] + +decodeFixture :: FilePath -> IO KitManifest +decodeFixture file = do + bytes <- BS.readFile ("test/fixtures" file) + case Aeson.eitherDecodeStrict' bytes of + Right manifest -> pure manifest + Left err -> assertFailure ("failed to decode " <> file <> ": " <> err) + +mkSidecar :: Maybe Text -> Text -> SidecarMeta +mkSidecar mVersion h = + SidecarMeta + { name = "foo", + kind = "skill", + version = mVersion, + hash = h, + installedAt = "2026-05-13T00:00:00Z", + installedFiles = Nothing, + installedHash = Nothing, + visibility = Nothing, + visibilitySource = Nothing, + sharedLinks = Nothing, + codexDisabledSkills = Nothing + } + +mkSkillItem :: Text -> Maybe Text -> KitItem +mkSkillItem n mVersion = + KitSkillItem + SkillEntry + { name = n, + description = "x", + version = mVersion, + path = "skills/foo", + files = ["SKILL.md"], + visibility = Nothing + } + +mkAgentItem :: Text -> Maybe Text -> KitItem +mkAgentItem n mVersion = + KitAgentItem + AgentEntry + { name = n, + description = "x", + version = mVersion, + path = "agents/foo.md", + files = Nothing, + visibility = Nothing + } + +jsonTests :: TestTree +jsonTests = + testGroup + "JSON" + [ testCase "kit-status document matches the golden" $ + withStatusFixture $ \home proj config -> do + document <- statusDocument <$> kitStatus config + golden "status.json" (normalise home proj document), + testCase "kit-list document matches the golden" $ + withStatusFixture $ \home proj config -> do + manifest <- assertRight =<< loadManifest (fixtureCache home) + copies <- installedCopies config + golden "list.json" (normalise home proj (listDocument (UpstreamStale "x") manifest copies)), + testCase "kit-update document matches the golden" $ + withPreparedKitHome $ \home cache -> do + let config = testConfig & #projectRoot .~ pure (home "project") + _ <- assertRight =<< installItem config "demo" UserScope defaultInstallOptions + _ <- assertRight =<< installItem config "reviewer" UserScope (InstallOptions Nothing True) + BS.writeFile (home ".config" "testkit" "agents" ".claude" "skills" "demo" "SKILL.md") "my edits" + manifest <- assertRight =<< loadManifest cache + report <- assertRight =<< reinstallPresent config cache manifest Nothing KeepLocalEdits + golden "update.json" (updateDocument report) + jsonKey "refresh" (updateDocument (report & #refresh .~ Just RepoPulled)) @?= Just (String "pulled"), + testCase "every document names its format version" $ + withStatusFixture $ \home _proj config -> do + manifest <- assertRight =<< loadManifest (fixtureCache home) + copies <- installedCopies config + statusDoc <- statusDocument <$> kitStatus config + report <- assertRight =<< reinstallPresent config (fixtureCache home) manifest (Just "no-such-item") KeepLocalEdits + let documents = + [ ("kit-list", listDocument UpstreamReady manifest copies), + ("kit-status", statusDoc), + ("kit-update", updateDocument report) + ] + forM_ documents $ \(name, document) -> do + jsonKey "formatVersion" document @?= Just (Aeson.toJSON kitJsonFormatVersion) + jsonKey "document" document @?= Just (String name), + testCase "status --json parses as one document when the cache is stale" $ + withPreparedKitHome $ \_home _cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + (result, out) <- captureStdout (runKitCommand testConfig (KitStatus JsonOutput)) + result @?= Right () + document <- decodeDocument out + (jsonKey "upstream" document >>= jsonKey "state") @?= Just (String "stale"), + testCase "status --json parses as one document when the repository is unreachable" $ + withFreshHome $ \_home -> do + let config = testConfig & #repoUrl .~ "file:///nonexistent-kit" + (result, out) <- captureStdout (runKitCommand config (KitStatus JsonOutput)) + result @?= Right () + document <- decodeDocument out + (jsonKey "upstream" document >>= jsonKey "state") @?= Just (String "unavailable") + jsonKey "items" document @?= Just (Array mempty), + testCase "list --json writes nothing to stdout when the repository is unreachable" $ + withFreshHome $ \_home -> do + let config = testConfig & #repoUrl .~ "file:///nonexistent-kit" + (result, out) <- captureStdout (runKitCommand config (KitList JsonOutput)) + assertKitError "KitCloneFailed" isCloneFailed result + out @?= "", + testCase "list --json keeps the first-clone notice off stdout" $ + withFreshHome $ \home -> do + let repoDir = takeDirectory home "kit-repo" + createDirectoryIfMissing True (repoDir "skills" "demo") + createDirectoryIfMissing True (repoDir "agents") + BS.writeFile (repoDir "skills" "demo" "SKILL.md") "skill instructions\n" + BS.writeFile (repoDir "agents" "reviewer.md") "---\nname: reviewer\n---\nReview carefully.\n" + BS.writeFile (repoDir "kit.json") manifestJson + git repoDir ["init", "--quiet"] + git repoDir ["add", "."] + git repoDir ["-c", "user.name=test", "-c", "user.email=test@example.com", "commit", "--quiet", "-m", "kit"] + let config = testConfig & #repoUrl .~ ("file://" <> Text.pack repoDir) + (result, out) <- captureStdout (runKitCommand config (KitList JsonOutput)) + result @?= Right () + document <- decodeDocument out + (jsonKey "upstream" document >>= jsonKey "state") @?= Just (String "ready") + case jsonKey "items" document of + Just (Array items) -> map (jsonKey "name") (toList items) @?= [Just (String "demo"), Just (String "reviewer")] + other -> assertFailure ("expected an items array, got " <> show other), + testCase "update --json writes nothing to stdout when the pull fails" $ + withPreparedKitHome $ \_home _cache -> do + (result, out) <- captureStdout (runKitCommand testConfig (KitUpdate Nothing KeepLocalEdits JsonOutput)) + assertKitError "KitPullFailed" isPullFailed result + out @?= "", + testCase "the command and the encoder agree" $ + withStatusFixture $ \home proj config -> do + (result, out) <- captureStdout (runKitCommand config (KitStatus JsonOutput)) + result @?= Right () + document <- decodeDocument out + golden "status.json" (normalise home proj document), + testCase "--json parses on list, status, and update only" $ do + let parse = getParseResult . execParserPure defaultPrefs (info (kitCommandParser testConfig) mempty) + parse ["list", "--json"] @?= Just (KitList JsonOutput) + parse ["status", "--json"] @?= Just (KitStatus JsonOutput) + parse ["update", "--json"] @?= Just (KitUpdate Nothing KeepLocalEdits JsonOutput) + parse ["install", "demo", "--json"] @?= Nothing + ] + where + isCloneFailed = \case + KitCloneFailed _ _ -> True + _ -> False + git dir args = do + (code, _out, err) <- readProcessWithExitCode "git" ("-C" : dir : args) "" + assertBool ("git " <> unwords args <> " failed: " <> err) (code == ExitSuccess) + decodeDocument out = case Aeson.eitherDecodeStrict' out of + Right document -> pure document + Left err -> assertFailure ("stdout is not one JSON document (" <> err <> "): " <> show out) + +-- | A temporary, empty @HOME@ for the duration of the action. +withFreshHome :: (FilePath -> IO a) -> IO a +withFreshHome action = + withSystemTempDirectory "baikai-kit-fresh" $ \tmp -> do + oldHome <- lookupEnv "HOME" + oldCodexHome <- lookupEnv "CODEX_HOME" + let home = tmp "home" + createDirectoryIfMissing True home + setEnv "HOME" home + setEnv "CODEX_HOME" (home ".codex") + action home `finally` (restoreHome oldHome >> restoreCodexHome oldCodexHome) + +fixtureCache :: FilePath -> FilePath +fixtureCache home = home ".cache" "testkit" "kit" + +-- | Seven items covering every status condition, both kinds, both scopes, +-- and both providers. The action gets @HOME@, the project root, and a +-- config whose project scope is that root. +withStatusFixture :: (FilePath -> FilePath -> KitConfig -> IO a) -> IO a +withStatusFixture action = + withPreparedKitHome $ \home cache -> do + let proj = takeDirectory home "project" + config = testConfig & #projectRoot .~ pure proj + skills = ["alpha", "beta", "gamma", "delta", "epsilon"] + agents = ["reviewer", "planner"] + claudeBase = home ".config" "testkit" "agents" ".claude" + createDirectoryIfMissing True proj + forM_ skills $ \n -> do + createDirectoryIfMissing True (cache "skills" n) + BS.writeFile (cache "skills" n "SKILL.md") ("the " <> Text.Encoding.encodeUtf8 (Text.pack n) <> " skill\n") + forM_ agents $ \n -> + BS.writeFile (cache "agents" (n <> ".md")) ("---\nname: " <> Text.Encoding.encodeUtf8 (Text.pack n) <> "\n---\nBe helpful.\n") + BS.writeFile (cache "kit.json") (fixtureManifest [] []) + forM_ ["alpha", "gamma", "epsilon", "reviewer"] $ \n -> + void (assertRight =<< installItem config n UserScope (InstallOptions Nothing True)) + forM_ ["beta", "delta", "planner"] $ \n -> + void (assertRight =<< installItem config n ProjectScope (InstallOptions Nothing True)) + -- alpha: the Codex copy loses its sidecar => unknown. + removeFile (home ".agents" "skills" "alpha" ".testkit-kit.json") + -- gamma: its Claude shared link is lost; the Codex copy predates visibility. + removeFile (home ".claude/skills/gamma") + let gammaSidecar = home ".agents/skills/gamma/.testkit-kit.json" + gammaMeta <- requireSidecar gammaSidecar + LBS.writeFile gammaSidecar (Aeson.encode (gammaMeta & #visibility .~ Nothing & #visibilitySource .~ Nothing)) + -- gamma: upstream sources change without a version bump => changed-upstream. + BS.writeFile (cache "skills" "gamma" "SKILL.md") "the gamma skill, revised\n" + -- epsilon: upstream now lists a file through a symbolic link => refused. + let outsideDir = takeDirectory home "outside" + createDirectoryIfMissing True outsideDir + BS.writeFile (outsideDir "secret.txt") "top secret\n" + createDirectoryLink outsideDir (cache "skills" "epsilon" "sub") + -- reviewer: the Claude copy is edited => modified. + BS.writeFile (claudeBase "agents" "reviewer.md") "my own reviewer\n" + -- planner: the Claude sidecar predates the installed-file hash => edits-unknown. + let plannerSidecar = proj ".testkit" "agents" ".claude" "agents" "planner.testkit-kit.json" + sidecar <- maybe (assertFailure "expected the planner sidecar") pure =<< readSidecar plannerSidecar + LBS.writeFile plannerSidecar (Aeson.encode (sidecar & #installedFiles .~ Nothing & #installedHash .~ Nothing)) + -- beta: version bump => outdated; delta: removed => delisted. + BS.writeFile (cache "kit.json") (fixtureManifest ["beta"] ["delta"]) + action home proj config + +-- | The fixture manifest: every item at 0.1.0 except those in @bumped@ +-- (0.2.0), without those in @removed@; once anything is bumped, epsilon +-- also lists a file below its symlinked @sub@ directory. +fixtureManifest :: [Text] -> [Text] -> BS.ByteString +fixtureManifest bumped removed = + Text.Encoding.encodeUtf8 $ + "{\"version\":2,\"skills\":[" + <> Text.intercalate "," [skill n | n <- ["alpha", "beta", "gamma", "delta", "epsilon"], n `notElem` removed] + <> "],\"agents\":[" + <> Text.intercalate "," [agent n | n <- ["reviewer", "planner"], n `notElem` removed] + <> "]}" + where + final = not (null bumped) + version n = if n `elem` bumped then "0.2.0" else "0.1.0" + files n + | n == "epsilon" && final = "[\"SKILL.md\",\"sub/secret.txt\"]" + | otherwise = "[\"SKILL.md\"]" + skill n = + "{\"name\":\"" + <> n + <> "\",\"description\":\"The " + <> n + <> " skill\",\"version\":\"" + <> version n + <> "\",\"path\":\"skills/" + <> n + <> "\",\"files\":" + <> files n + <> (if n `elem` ["alpha", "gamma"] then ",\"visibility\":\"shared\"" else "") + <> "}" + agent n = + "{\"name\":\"" + <> n + <> "\",\"description\":\"The " + <> n + <> " agent\",\"version\":\"" + <> version n + <> "\",\"path\":\"agents/" + <> n + <> ".md\"}" + +-- | Run an action with stdout sent to a file, and return what it wrote. +-- The pause first lets tasty's reporter finish writing the test name, +-- which it does on stdout from another thread as the test starts. +captureStdout :: IO a -> IO (a, BS.ByteString) +captureStdout action = + withSystemTempFile "baikai-kit-stdout" $ \file fileHandle -> do + threadDelay 200000 + hFlush stdout + saved <- hDuplicate stdout + hDuplicateTo fileHandle stdout + result <- + action `finally` do + hFlush stdout + hDuplicateTo saved stdout + hClose saved + hClose fileHandle + out <- BS.readFile file + pure (result, out) + +-- | Replace the temporary directories in every string with @$HOME@ and +-- @$PROJECT@, and any upstream detail (git's message, which names paths +-- and varies by git version) with @@. +normalise :: FilePath -> FilePath -> Value -> Value +normalise home proj = go + where + go = \case + String t -> String (Text.replace (Text.pack proj) "$PROJECT" (Text.replace (Text.pack home) "$HOME" t)) + Array values -> Array (fmap go values) + Object o -> Object (KeyMap.mapWithKey (\key value -> if key == "upstream" then upstream value else go value) o) + other -> other + upstream = \case + Object o -> Object (KeyMap.mapWithKey (\key value -> if key == "detail" && value /= Null then String "" else value) o) + other -> other + +-- | Compare with @test/golden/@, or write it when +-- @BAIKAI_KIT_ACCEPT_GOLDEN@ is set. Values are compared decoded, so key +-- order and whitespace are not part of the contract. +golden :: FilePath -> Value -> Assertion +golden file value = do + let path = "test" "golden" file + accept <- lookupEnv "BAIKAI_KIT_ACCEPT_GOLDEN" + case accept of + Just _ -> do + createDirectoryIfMissing True ("test" "golden") + LBS.writeFile path (Aeson.encode value <> "\n") + Nothing -> do + expected <- Aeson.eitherDecodeFileStrict' path + case expected of + Left err -> assertFailure ("cannot read golden " <> path <> ": " <> err) + Right expectedValue -> + assertBool + ("golden " <> path <> " differs.\nexpected: " <> show (Aeson.encode expectedValue) <> "\nactual: " <> show (Aeson.encode value)) + (expectedValue == (value :: Value)) + +jsonKey :: Aeson.Key -> Value -> Maybe Value +jsonKey key = \case + Object o -> KeyMap.lookup key o + _ -> Nothing + +commandTests :: TestTree +commandTests = + testGroup + "Command" + [ testCase "install parses with and without a name" $ do + parse ["install"] @?= Just (KitInstall Nothing UserScope defaultInstallOptions) + parse ["install", "demo", "--project"] @?= Just (KitInstall (Just "demo") ProjectScope defaultInstallOptions) + parse [] @?= Just (KitList HumanOutput), + testCase "install help names the tool's project directory" $ + case execParserPure defaultPrefs (info (kitCommandParser testConfig <**> helper) mempty) ["install", "--help"] of + Failure failure -> do + let rendered = fst (renderFailure failure "kit") + assertBool ("expected .testkit/agents in help:\n" <> rendered) (".testkit/agents" `isInfixOf` rendered) + _ -> assertFailure "expected --help to produce help text", + testCase "install with no name and no chooser is a KitItemNameRequired error" $ do + result <- runKitCommand testConfig (KitInstall Nothing UserScope defaultInstallOptions) + result @?= Left KitItemNameRequired + exitResult <- try @ExitCode (runKit testConfig (KitInstall Nothing UserScope defaultInstallOptions)) + exitResult @?= Left (ExitFailure 1), + testCase "install with no name installs what the chooser returns" $ + withPreparedKitHome $ \home _cache -> do + seen <- newIORef [] + let chooser manifest = do + writeIORef seen (map (view #name) (manifest ^. #skills) ++ map (view #name) (manifest ^. #agents)) + pure (Just "demo") + config = testConfig & #chooseItem .~ Just chooser + result <- runKitCommand config (KitInstall Nothing UserScope defaultInstallOptions) + result @?= Right () + assertFileExists (userClaudeDemo home "SKILL.md") + readIORef seen >>= (@?= ["demo", "reviewer"]), + testCase "a cancelled choice installs nothing and succeeds" $ + withPreparedKitHome $ \home _cache -> do + let config = testConfig & #chooseItem .~ Just (\_ -> pure Nothing) + result <- runKitCommand config (KitInstall Nothing UserScope defaultInstallOptions) + result @?= Right () + assertDirectoryMissing (userClaudeDemo home) + exitResult <- try @ExitCode (runKit config (KitInstall Nothing UserScope defaultInstallOptions)) + exitResult @?= Right () + assertDirectoryMissing (userClaudeDemo home), + testCase "a chosen name the manifest lacks is KitItemNotFound" $ + withPreparedKitHome $ \_home _cache -> do + let config = testConfig & #chooseItem .~ Just (\_ -> pure (Just "nope")) + result <- runKitCommand config (KitInstall Nothing UserScope defaultInstallOptions) + result @?= Left (KitItemNotFound "nope") + ] + where + parse = getParseResult . execParserPure defaultPrefs (info (kitCommandParser testConfig) mempty) + userClaudeDemo home = home ".config" "testkit" "agents" ".claude" "skills" "demo" + +projectRootTests :: TestTree +projectRootTests = + testGroup + "Project root" + [ testCase "findProjectRoot walks up from a nested directory" $ + withMarkedTree $ \root -> do + found <- findProjectRoot [rootMarker] (root "a" "b") + found @?= Just root, + testCase "findProjectRoot accepts a start directory that is itself the root" $ + withMarkedTree $ \root -> do + found <- findProjectRoot [rootMarker] root + found @?= Just root, + testCase "findProjectRoot returns Nothing when no marker exists" $ + withMarkedTree $ \root -> do + found <- findProjectRoot [".testkit-no-such-marker"] (root "a") + found @?= Nothing + withCurrentDirectory (root "a") $ do + resolved <- projectRootByMarkers [".testkit-no-such-marker"] + cwd <- getCurrentDirectory + resolved @?= cwd, + testCase "a configured root puts project scope in one place" $ + withPreparedKitHome $ \_home _cache -> + withProjectTree $ \proj -> do + let config = testConfig & #projectRoot .~ pure proj + claudeSkill = proj ".testkit" "agents" ".claude" "skills" "demo" + withCurrentDirectory (proj "src" "deep") $ + void (assertRight =<< installItem config "demo" ProjectScope defaultInstallOptions) + assertFileExists (claudeSkill "SKILL.md") + assertFileExists (proj ".agents" "skills" "demo" "SKILL.md") + assertDirectoryMissing (proj "src" "deep" ".testkit") + withCurrentDirectory (proj "docs") $ do + assertProjectRow config + dirs <- agentDirsForSession config + assertBool + ("expected the project agents dir in " <> show dirs) + ((proj ".testkit" "agents") `elem` dirs) + outcomes <- assertRight =<< uninstallItem config "demo" ProjectScope + let rendered = renderUninstallReport "demo" ProjectScope outcomes + assertBool + ("unexpected uninstall report: " <> Text.unpack rendered) + ("Uninstalled skill 'demo' from project scope" `Text.isPrefixOf` rendered) + assertDirectoryMissing claudeSkill + let markerConfig = testConfig & #projectRoot .~ projectRootByMarkers [rootMarker] + withCurrentDirectory (proj "src" "deep") $ + void (assertRight =<< installItem markerConfig "demo" ProjectScope defaultInstallOptions) + assertFileExists (claudeSkill "SKILL.md") + withCurrentDirectory (proj "docs") $ assertProjectRow markerConfig, + testCase "without a resolver, project scope is the current directory" $ + withPreparedKitHome $ \_home _cache -> + withProjectTree $ \proj -> + withCurrentDirectory (proj "src" "deep") $ do + _ <- assertRight =<< installItem testConfig "demo" ProjectScope defaultInstallOptions + cwd <- getCurrentDirectory + assertFileExists (cwd ".testkit" "agents" ".claude" "skills" "demo" "SKILL.md") + assertDirectoryMissing (proj ".testkit") + ] + where + assertProjectRow config = do + report <- kitStatus config + let projectRows = filter (\row -> row ^. #name == "demo" && row ^. #scope == "project") (report ^. #rows) + assertBool "expected a project-scope status row for demo" (not (null projectRows)) + +-- | A marker no real directory above the system temporary directory can +-- hold, so a walk to the filesystem root cannot find someone's @.git@. +rootMarker :: FilePath +rootMarker = ".testkit-root-marker" + +-- | @root/.testkit-root-marker@ and @root/a/b@, with @root@ canonical so +-- it compares equal to paths the resolver builds. +withMarkedTree :: (FilePath -> IO a) -> IO a +withMarkedTree action = + withSystemTempDirectory "baikai-kit-root" $ \tmp -> do + root <- ( "root") <$> canonicalizePath tmp + createDirectoryIfMissing True (root "a" "b") + BS.writeFile (root rootMarker) "" + action root + +-- | A project with a root marker, @src/deep@, and @docs@. +withProjectTree :: (FilePath -> IO a) -> IO a +withProjectTree action = + withSystemTempDirectory "baikai-kit-project" $ \tmp -> do + proj <- ( "proj") <$> canonicalizePath tmp + createDirectoryIfMissing True (proj "src" "deep") + createDirectoryIfMissing True (proj "docs") + BS.writeFile (proj rootMarker) "" + action proj + +testConfig :: KitConfig +testConfig = kitConfig "testkit" "file:///not-used" [InteractiveClaude, InteractiveCodex] + +withPreparedKitHome :: (FilePath -> FilePath -> IO a) -> IO a +withPreparedKitHome action = + withSystemTempDirectory "baikai-kit-home" $ \tmp -> do + oldHome <- lookupEnv "HOME" + oldCodexHome <- lookupEnv "CODEX_HOME" + let home = tmp "home" + cache = home ".cache" "testkit" "kit" + createDirectoryIfMissing True (cache ".git") + createDirectoryIfMissing True (cache "skills" "demo") + createDirectoryIfMissing True (cache "agents") + BS.writeFile (cache "skills" "demo" "SKILL.md") "skill instructions\n" + BS.writeFile (cache "agents" "reviewer.md") "---\nname: reviewer\n---\nReview carefully.\n" + BS.writeFile (cache "kit.json") manifestJson + setEnv "HOME" home + setEnv "CODEX_HOME" (home ".codex") + action home cache `finally` (restoreHome oldHome >> restoreCodexHome oldCodexHome) + +restoreCodexHome :: Maybe String -> IO () +restoreCodexHome Nothing = unsetEnv "CODEX_HOME" +restoreCodexHome (Just value) = setEnv "CODEX_HOME" value + +restoreHome :: Maybe String -> IO () +restoreHome Nothing = unsetEnv "HOME" +restoreHome (Just value) = setEnv "HOME" value + +-- | Plant a committed-symlink kit: a directory link out of the checkout +-- and a manifest that lists a file below it. +plantSymlinkedSource :: FilePath -> FilePath -> IO () +plantSymlinkedSource home cache = do + let outsideDir = takeDirectory home "outside" + createDirectoryIfMissing True outsideDir + BS.writeFile (outsideDir "secret.txt") "top secret\n" + createDirectoryLink outsideDir (cache "skills" "demo" "sub") + BS.writeFile (cache "kit.json") manifestWithSymlinkedFileJson + +manifestWithSymlinkedFileJson :: BS.ByteString +manifestWithSymlinkedFileJson = + Text.Encoding.encodeUtf8 $ + Text.concat + [ "{\"version\":2,", + "\"skills\":[{", + "\"name\":\"demo\",", + "\"description\":\"Demo skill\",", + "\"version\":\"0.1.0\",", + "\"path\":\"skills/demo\",", + "\"files\":[\"SKILL.md\",\"sub/secret.txt\"]", + "}],", + "\"agents\":[]} " + ] + +-- | Rewrite the fixture kit so its agent lists two files below a +-- directory of its own. +plantMultiFileAgent :: FilePath -> IO () +plantMultiFileAgent cache = do + createDirectoryIfMissing True (cache "agents" "reviewer") + BS.writeFile (cache "agents" "reviewer" "reviewer.md") "---\nname: reviewer\n---\nReview carefully.\n" + BS.writeFile (cache "agents" "reviewer" "guide.md") "How to review.\n" + BS.writeFile (cache "kit.json") manifestWithMultiFileAgentJson + +manifestWithMultiFileAgentJson :: BS.ByteString +manifestWithMultiFileAgentJson = + Text.Encoding.encodeUtf8 $ + Text.concat + [ "{\"version\":2,", + "\"skills\":[],", + "\"agents\":[{", + "\"name\":\"reviewer\",", + "\"description\":\"Review agent\",", + "\"version\":\"0.1.0\",", + "\"path\":\"agents/reviewer\",", + "\"files\":[\"reviewer.md\",\"guide.md\"]", + "}]} " + ] + +manifestWithUnsupportedVersionJson :: BS.ByteString +manifestWithUnsupportedVersionJson = + Text.Encoding.encodeUtf8 $ + Text.concat + [ "{\"version\":99,", + "\"skills\":[{", + "\"name\":\"demo\",", + "\"description\":\"Demo skill\",", + "\"version\":\"0.1.0\",", + "\"path\":\"skills/demo\",", + "\"files\":[\"SKILL.md\"]", + "}],", + "\"agents\":[]} " + ] + +legacySidecarJson :: BS.ByteString +legacySidecarJson = + "{\"name\":\"demo\",\"kind\":\"skill\",\"version\":\"0.1.0\",\"hash\":\"sha256:x\",\"installedAt\":\"t\"}" + +manifestJson :: BS.ByteString +manifestJson = + Text.Encoding.encodeUtf8 $ + Text.concat + [ "{\"version\":2,", + "\"skills\":[{", + "\"name\":\"demo\",", + "\"description\":\"Demo skill\",", + "\"version\":\"0.1.0\",", + "\"path\":\"skills/demo\",", + "\"files\":[\"SKILL.md\"]", + "}],", + "\"agents\":[{", + "\"name\":\"reviewer\",", + "\"description\":\"Review agent\",", + "\"version\":\"0.1.0\",", + "\"path\":\"agents/reviewer.md\"", + "}]} " + ] + +manifestWithoutDemoJson :: BS.ByteString +manifestWithoutDemoJson = + Text.Encoding.encodeUtf8 $ + Text.concat + [ "{\"version\":2,", + "\"skills\":[],", + "\"agents\":[{", + "\"name\":\"reviewer\",", + "\"description\":\"Review agent\",", + "\"version\":\"0.1.0\",", + "\"path\":\"agents/reviewer.md\"", + "}]} " + ] + +manifestWithDemoVersionJson :: BS.ByteString +manifestWithDemoVersionJson = + Text.Encoding.encodeUtf8 $ + Text.concat + [ "{\"version\":2,", + "\"skills\":[{", + "\"name\":\"demo\",", + "\"description\":\"Demo skill\",", + "\"version\":\"0.2.0\",", + "\"path\":\"skills/demo\",", + "\"files\":[\"SKILL.md\"]", + "}],", + "\"agents\":[{", + "\"name\":\"reviewer\",", + "\"description\":\"Review agent\",", + "\"version\":\"0.1.0\",", + "\"path\":\"agents/reviewer.md\"", + "}]} " + ] + +maliciousManifestJson :: BS.ByteString +maliciousManifestJson = + Text.Encoding.encodeUtf8 $ + Text.concat + [ "{\"version\":2,", + "\"skills\":[{", + "\"name\":\"evil\",", + "\"description\":\"Evil skill\",", + "\"version\":\"0.1.0\",", + "\"path\":\"skills/demo\",", + "\"files\":[\"../../../../escape.txt\"]", + "}],", + "\"agents\":[]} " + ] + +isUnsafePath :: KitError -> Bool +isUnsafePath = \case KitUnsafePath _ _ -> True; _ -> False + +isUnsafeName :: KitError -> Bool +isUnsafeName = \case KitUnsafeName _ _ -> True; _ -> False + +isSourceSymlink :: KitError -> Bool +isSourceSymlink = \case KitSourceSymlink _ -> True; _ -> False + +isWriteFailed :: KitError -> Bool +isWriteFailed = \case KitWriteFailed {} -> True; _ -> False + +isPullFailed :: KitError -> Bool +isPullFailed = \case KitPullFailed _ -> True; _ -> False + +isManifestMissing :: KitError -> Bool +isManifestMissing = \case KitManifestMissing _ -> True; _ -> False + +isVersionUnsupported :: KitError -> Bool +isVersionUnsupported = \case KitManifestVersionUnsupported _ _ -> True; _ -> False + +isManifestInvalid :: KitError -> Bool +isManifestInvalid = \case KitManifestInvalid _ _ -> True; _ -> False + +assertKitError :: (Show a) => String -> (KitError -> Bool) -> Either KitError a -> IO () +assertKitError label matches result = + case result of + Left err | matches err -> pure () + other -> assertFailure ("expected " <> label <> ", got " <> show other) + +assertRight :: (Show e) => Either e a -> IO a +assertRight = \case + Right value -> pure value + Left err -> assertFailure ("expected Right, got Left " <> show err) + +assertLeft :: (Show b) => Either a b -> IO () +assertLeft result = + case result of + Left _ -> pure () + Right value -> assertFailure ("expected Left, got Right " <> show value) + +assertFileExists :: FilePath -> IO () +assertFileExists path = do + exists <- doesFileExist path + assertBool ("expected file to exist: " <> path) exists + +assertFileMissing :: FilePath -> IO () +assertFileMissing path = do + exists <- doesFileExist path + assertBool ("expected file to be missing: " <> path) (not exists) + +assertDirectoryMissing :: FilePath -> IO () +assertDirectoryMissing path = do + exists <- doesDirectoryExist path + assertBool ("expected directory to be missing: " <> path) (not exists) + +assertDirectoryExists :: FilePath -> IO () +assertDirectoryExists path = do + exists <- doesDirectoryExist path + assertBool ("expected directory to exist: " <> path) exists + +findFilesWithSuffix :: FilePath -> String -> IO [FilePath] +findFilesWithSuffix root suffix = do + exists <- doesPathExist root + if not exists + then pure [] + else do + isDir <- doesDirectoryExist root + if not isDir + then pure [root | suffix `isSuffixOf` root] + else do + names <- listDirectory root + fmap concat $ mapM (\name -> findFilesWithSuffix (root name) suffix) names + +findOutcome :: InteractiveProvider -> [RemovalOutcome] -> RemovalOutcome +findOutcome expected outcomes = + case find ((== expected) . view #provider) outcomes of + Just outcome -> outcome + Nothing -> error "expected provider outcome" + +visibilityTests :: TestTree +visibilityTests = + testGroup + "visibility" + [ testCase "a manifest item without visibility installs tool-only" $ + withPreparedKitHome $ \home _ -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + assertFileExists (ownedDemo home "SKILL.md") + assertDirectoryMissing (sharedDemo home) + meta <- demoSidecar home + meta ^. #visibility @?= Just "tool-only" + meta ^. #visibilitySource @?= Just "manifest", + testCase "a shared item links into ~/.claude/skills" $ + withPreparedKitHome $ \home cache -> do + declareShared cache + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + getSymbolicLinkTarget (sharedDemo home) >>= (@?= ownedDemo home) + BS.readFile (sharedDemo home "SKILL.md") >>= (@?= "skill instructions\n") + meta <- demoSidecar home + meta ^. #sharedLinks @?= Just [Text.pack (sharedDemo home)], + testCase "a project-scope shared item uses a relative link" $ + withPreparedKitHome $ \home _ -> do + let root = takeDirectory home "project" + config = testConfig & #projectRoot .~ pure root + _ <- assertRight =<< installItem config "demo" ProjectScope sharedOptions + getSymbolicLinkTarget (root ".claude/skills/demo") >>= (@?= "../../.testkit/agents/.claude/skills/demo"), + testCase "relativeLinkTarget handles siblings and descendants" $ do + relativeLinkTarget "/a/.claude/skills" "/a/.tool/agents/.claude/skills/demo" @?= "../../.tool/agents/.claude/skills/demo" + relativeLinkTarget "/a" "/a/b/c" @?= "b/c", + testCase "kit install --shared overrides the manifest and update keeps it" $ + withPreparedKitHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions + updateDemo cache + assertBool "shared link survives" =<< pathIsSymbolicLink (sharedDemo home) + meta <- demoSidecar home + meta ^. #visibilitySource @?= Just "install-flag", + testCase "update follows a changed manifest default" $ + withPreparedKitHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + declareShared cache + updateDemo cache + assertBool "new manifest creates link" =<< pathIsSymbolicLink (sharedDemo home), + testCase "update changes linked content without touching the link" $ + withPreparedKitHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions + before <- getSymbolicLinkTarget (sharedDemo home) + inodeBefore <- Posix.getSymbolicLinkStatus (sharedDemo home) + BS.writeFile (cache "skills/demo/SKILL.md") "new content\n" + updateDemo cache + getSymbolicLinkTarget (sharedDemo home) >>= (@?= before) + inodeAfter <- Posix.getSymbolicLinkStatus (sharedDemo home) + Posix.fileID inodeAfter @?= Posix.fileID inodeBefore + Posix.modificationTimeHiRes inodeAfter @?= Posix.modificationTimeHiRes inodeBefore + BS.readFile (sharedDemo home "SKILL.md") >>= (@?= "new content\n"), + testCase "update recreates a deleted link including when local edits skip content" $ + withPreparedKitHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions + removeFile (sharedDemo home) + updateDemo cache + assertBool "link repaired" =<< pathIsSymbolicLink (sharedDemo home) + BS.writeFile (ownedDemo home "SKILL.md") "local edits\n" + removeFile (sharedDemo home) + manifest <- assertRight =<< loadManifest cache + report <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") KeepLocalEdits + report ^. #skipped @?= [("demo", UserScope)] + BS.readFile (sharedDemo home "SKILL.md") >>= (@?= "local edits\n"), + testCase "uninstall removes the link and nothing else" $ + withPreparedKitHome $ \home _ -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions + createDirectoryIfMissing True (home ".claude/skills/other") + outcomes <- assertRight =<< uninstallItem testConfig "demo" UserScope + concatMap (view #linksRemoved) outcomes @?= [sharedDemo home] + assertDirectoryExists (home ".claude/skills/other") + assertDirectoryMissing (sharedDemo home), + testCase "a shared install refuses a foreign skill directory before any write" $ + withPreparedKitHome $ \home _ -> do + createDirectoryIfMissing True (sharedDemo home) + BS.writeFile (sharedDemo home "SKILL.md") "foreign\n" + result <- installItem testConfig "demo" UserScope sharedOptions + assertKitError "shared name taken" isNameTaken result + BS.readFile (sharedDemo home "SKILL.md") >>= (@?= "foreign\n") + assertDirectoryMissing (ownedDemo home) + assertDirectoryMissing (home ".agents/skills/demo"), + testCase "a shared install names the owning tool even for a dangling link" $ + withPreparedKitHome $ \home _ -> do + createDirectoryIfMissing True (home ".claude/skills") + createDirectoryLink (home ".config/rei/agents/.claude/skills/demo") (sharedDemo home) + result <- installItem testConfig "demo" UserScope sharedOptions + case result of + Left (KitSharedNameTaken _ owner) -> owner @?= Just "rei" + other -> assertFailure (show other), + testCase "a Codex install refuses a skill directory without this tool's sidecar" $ + withPreparedKitHome $ \home _ -> do + let path = home ".agents/skills/demo" + createDirectoryIfMissing True path + BS.writeFile (path "SKILL.md") "foreign\n" + result <- installItem testConfig "demo" UserScope defaultInstallOptions + assertKitError "shared name taken" isNameTaken result + BS.readFile (path "SKILL.md") >>= (@?= "foreign\n") + assertDirectoryMissing (ownedDemo home), + testCase "the parser accepts --shared, --tool-only and --accept-shared-codex" $ do + let parse = getParseResult . execParserPure defaultPrefs (info (kitCommandParser testConfig) mempty) + parse ["install", "demo"] @?= Just (KitInstall (Just "demo") UserScope defaultInstallOptions) + parse ["install", "demo", "--shared"] @?= Just (KitInstall (Just "demo") UserScope sharedOptions) + parse ["install", "demo", "--tool-only"] @?= Just (KitInstall (Just "demo") UserScope (InstallOptions (Just ToolOnlyVisibility) False)) + parse ["install", "demo", "--accept-shared-codex"] @?= Just (KitInstall (Just "demo") UserScope (InstallOptions Nothing True)) + parse ["install", "demo", "--shared", "--tool-only"] @?= Nothing, + testCase "an unknown visibility value is an invalid manifest" $ + withPreparedKitHome $ \_ cache -> do + BS.writeFile (cache "kit.json") (Text.Encoding.encodeUtf8 (Text.replace "\"name\":\"demo\"" "\"visibility\":\"public\",\"name\":\"demo\"" (Text.Encoding.decodeUtf8 manifestJson))) + assertKitError "invalid manifest" isInvalid =<< loadManifest cache, + testCase "legacy visibility survives update until explicit reinstall" $ + withPreparedKitHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + _ <- assertRight =<< removeDisabledSkill (codexConfig home) (codexDemo home) + forM_ [ownedDemo home, home ".agents/skills/demo"] $ \dir -> do + meta <- requireSidecar (dir ".testkit-kit.json") + LBS.writeFile (dir ".testkit-kit.json") (Aeson.encode (meta & #visibility .~ Nothing & #visibilitySource .~ Nothing & #sharedLinks .~ Nothing & #codexDisabledSkills .~ Nothing)) + declareShared cache + updateDemo cache + assertDirectoryMissing (sharedDemo home) + meta <- demoSidecar home + meta ^. #visibility @?= Nothing + legacy <- assertRight =<< checkVisibility testConfig InteractiveCodex UserScope SkillKind "demo" + legacy ^. #effective @?= SharedVisibility + _ <- assertRight =<< installItem testConfig "demo" UserScope (InstallOptions (Just ToolOnlyVisibility) False) + modern <- assertRight =<< checkVisibility testConfig InteractiveCodex UserScope SkillKind "demo" + modern ^. #requested @?= Just ToolOnlyVisibility + modern ^. #effective @?= ToolOnlyVisibility, + testCase "shared multi-file agents link the body and resources" $ + withPreparedKitHome $ \home cache -> do + plantMultiFileAgent cache + _ <- assertRight =<< installItem testConfig "reviewer" UserScope sharedOptions + BS.readFile (home ".claude/agents/reviewer/guide.md") >>= (@?= "How to review.\n") + assertBool "agent link" =<< pathIsSymbolicLink (home ".claude/agents/reviewer.md") + outcomes <- assertRight =<< uninstallItem testConfig "reviewer" UserScope + length (concatMap (view #linksRemoved) outcomes) @?= 2 + ] + where + isNameTaken KitSharedNameTaken {} = True + isNameTaken _ = False + isInvalid KitManifestInvalid {} = True + isInvalid _ = False + +sharedOptions :: InstallOptions +sharedOptions = InstallOptions (Just SharedVisibility) False + +ownedDemo :: FilePath -> FilePath +ownedDemo home = home ".config/testkit/agents/.claude/skills/demo" + +sharedDemo :: FilePath -> FilePath +sharedDemo home = home ".claude/skills/demo" + +requireSidecar :: FilePath -> IO SidecarMeta +requireSidecar path = maybe (assertFailure ("missing sidecar: " <> path)) pure =<< readSidecar path + +demoSidecar :: FilePath -> IO SidecarMeta +demoSidecar home = requireSidecar (ownedDemo home ".testkit-kit.json") + +declareShared :: FilePath -> IO () +declareShared cache = do + bytes <- BS.readFile (cache "kit.json") + BS.writeFile (cache "kit.json") (Text.Encoding.encodeUtf8 (Text.replace "\"name\":\"demo\"" "\"visibility\":\"shared\",\"name\":\"demo\"" (Text.Encoding.decodeUtf8 bytes))) + +updateDemo :: FilePath -> IO () +updateDemo cache = do + manifest <- assertRight =<< loadManifest cache + void (assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") KeepLocalEdits) + +codexVisibilityTests :: TestTree +codexVisibilityTests = + testGroup + "visibility" + [ testCase "a tool-only Codex skill adds one disabled config entry" $ + withCodexHome $ \home _ -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + expected <- canonicalizePath (codexDemo home) + entries <- assertRight =<< readSkillEntries (codexConfig home) + entries @?= [(expected, False)] + meta <- requireSidecar (takeDirectory (codexDemo home) ".testkit-kit.json") + meta ^. #codexDisabledSkills @?= Just [Text.pack expected] + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + entries2 <- assertRight =<< readSkillEntries (codexConfig home) + entries2 @?= entries, + testCase "the config edit preserves the user's text and permissions" $ + withCodexHome $ \home _ -> do + forM_ ["", "# no final newline", "# my config\n[projects.\"/x\"]\ntrust_level = \"trusted\"\n\n[[skills.config]]\npath = \"/user/other/SKILL.md\"\nenabled = false\n"] $ \seed -> do + createDirectoryIfMissing True (home ".codex") + BS.writeFile (codexConfig home) seed + Posix.setFileMode (codexConfig home) 0o600 + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + infoBefore <- Posix.getFileStatus (codexConfig home) + Posix.fileMode infoBefore .&. 0o777 @?= 0o600 + outcomes <- assertRight =<< uninstallItem testConfig "demo" UserScope + expected <- canonicalizePath (codexDemo home) + concatMap (view #configEntriesRemoved) outcomes @?= [expected] + BS.readFile (codexConfig home) >>= (@?= seed), + testCase "a shared Codex skill writes no entry and switching to shared removes ours" $ + withCodexHome $ \home _ -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions + assertFileMissing (codexConfig home) + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + _ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions + entries <- assertRight =<< readSkillEntries (codexConfig home) + entries @?= [], + testCase "codexSessionArgs re-enables exactly this tool's hidden skills" $ + withCodexHome $ \home _ -> do + let root = takeDirectory home "project" + config = testConfig & #projectRoot .~ pure root + _ <- assertRight =<< installItem config "demo" UserScope defaultInstallOptions + _ <- assertRight =<< installItem config "demo" ProjectScope defaultInstallOptions + _ <- assertRight =<< addDisabledSkill (codexConfig home) (home "other/SKILL.md") + user <- canonicalizePath (codexDemo home) + project <- canonicalizePath (root ".agents/skills/demo/SKILL.md") + args <- codexSessionArgs config + parseArgs args @?= parseArgs (enableSkillsArgs [user, project]) + codexSessionArgs (config & #providers .~ [InteractiveClaude]) >>= (@?= []), + testCase "a symlinked Codex config is refused untouched before writes" $ + withCodexHome $ \home _ -> do + createDirectoryIfMissing True (home ".codex") + BS.writeFile (home "generated.toml") "# generated\n" + createFileLink (home "generated.toml") (codexConfig home) + result <- installItem testConfig "demo" UserScope defaultInstallOptions + case result of + Left (KitCodexConfigUnusable _ message) -> assertBool "manual block is in error" ("[[skills.config]]" `Text.isInfixOf` message) + other -> assertFailure (show other) + assertDirectoryMissing (ownedDemo home) + assertFileMissing (codexDemo home) + getSymbolicLinkTarget (codexConfig home) >>= (@?= home "generated.toml") + BS.readFile (home "generated.toml") >>= (@?= "# generated\n"), + testCase "inline arrays, malformed TOML, and enabled=true are refused" $ + withCodexHome $ \home _ -> do + createDirectoryIfMissing True (home ".codex") + path <- canonicalizePath (codexDemo home) + forM_ ["[skills]\nconfig = []\n", "invalid = [", "[[skills.config]]\npath = \"" <> Text.Encoding.encodeUtf8 (Text.pack path) <> "\"\nenabled = true\n"] $ \seed -> do + BS.writeFile (codexConfig home) seed + result <- installItem testConfig "demo" UserScope defaultInstallOptions + assertKitError "unusable config" isConfigError result + BS.readFile (codexConfig home) >>= (@?= seed) + assertDirectoryMissing (ownedDemo home), + testCase "an existing disabled entry is reused and survives uninstall" $ + withCodexHome $ \home _ -> do + _ <- assertRight =<< addDisabledSkill (codexConfig home) (codexDemo home) + seed <- BS.readFile (codexConfig home) + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + meta <- requireSidecar (takeDirectory (codexDemo home) ".testkit-kit.json") + meta ^. #codexDisabledSkills @?= Just [] + args <- codexSessionArgs (testConfig & #projectRoot .~ pure (takeDirectory home "project")) + path <- canonicalizePath (codexDemo home) + parseArgs args @?= parseArgs (enableSkillsArgs [path]) + _ <- assertRight =<< uninstallItem testConfig "demo" UserScope + BS.readFile (codexConfig home) >>= (@?= seed), + testCase "update re-adds a deleted config entry including for local edits" $ + withCodexHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + _ <- assertRight =<< removeDisabledSkill (codexConfig home) (codexDemo home) + updateDemo cache + entries <- assertRight =<< readSkillEntries (codexConfig home) + assertBool "entry repaired" (length entries == 1) + _ <- assertRight =<< removeDisabledSkill (codexConfig home) (codexDemo home) + BS.writeFile (ownedDemo home "SKILL.md") "local edits\n" + updateDemo cache + entries2 <- assertRight =<< readSkillEntries (codexConfig home) + entries2 @?= entries + BS.readFile (ownedDemo home "SKILL.md") >>= (@?= "local edits\n"), + testCase "a tool-only agent with Codex is refused without acceptance" $ + withCodexHome $ \home _ -> do + result <- installItem testConfig "reviewer" UserScope defaultInstallOptions + assertKitError "cannot isolate agent" (== KitCodexCannotIsolate "reviewer") result + assertFileMissing (home ".config/testkit/agents/.claude/agents/reviewer.md") + assertFileMissing (home ".codex/agents/reviewer.toml"), + testCase "agent acceptance flag and callbacks work and update never asks" $ + withCodexHome $ \home cache -> do + let refusing = testConfig & #confirmSharedCodex .~ Just (\_ -> pure False) + accepting = testConfig & #confirmSharedCodex .~ Just (\_ -> pure True) + result <- installItem refusing "reviewer" UserScope defaultInstallOptions + assertKitError "callback refused" (== KitCodexCannotIsolate "reviewer") result + _ <- assertRight =<< installItem accepting "reviewer" UserScope defaultInstallOptions + manifest <- assertRight =<< loadManifest cache + _ <- assertRight =<< reinstallPresent refusing cache manifest (Just "reviewer") KeepLocalEdits + _ <- assertRight =<< uninstallItem testConfig "reviewer" UserScope + _ <- assertRight =<< installItem refusing "reviewer" UserScope (InstallOptions Nothing True) + assertFileExists (home ".codex/agents/reviewer.toml") + _ <- assertRight =<< uninstallItem testConfig "reviewer" UserScope + _ <- assertRight =<< installItem (refusing & #providers .~ [InteractiveClaude]) "reviewer" UserScope defaultInstallOptions + assertFileMissing (home ".codex/agents/reviewer.toml"), + testCase "the TOML escaper round-trips quotes, backslashes and controls" $ + withCodexHome $ \home _ -> do + let path = home "quote\"slash\\tab\t/SKILL.md" + _ <- assertRight =<< addDisabledSkill (codexConfig home) path + expected <- canonicalizePath path + entries <- assertRight =<< readSkillEntries (codexConfig home) + entries @?= [(expected, False)] + assertBool "launch override parses" (has _Right (parseArgs (enableSkillsArgs [expected]))), + testCase "a tool-only Codex skill must list SKILL.md" $ + withCodexHome $ \home cache -> do + BS.writeFile (cache "skills/demo/OTHER.md") "other" + BS.writeFile (cache "kit.json") (Text.Encoding.encodeUtf8 (Text.replace "SKILL.md" "OTHER.md" (Text.Encoding.decodeUtf8 manifestJson))) + assertKitError "no SKILL.md" isConfigError =<< installItem testConfig "demo" UserScope defaultInstallOptions + assertDirectoryMissing (ownedDemo home) + ] + where + isConfigError KitCodexConfigUnusable {} = True + isConfigError _ = False + +-- Every visibility test uses both isolated roots, as do the older fixtures. +withCodexHome :: (FilePath -> FilePath -> IO a) -> IO a +withCodexHome = withPreparedKitHome + +codexConfig :: FilePath -> FilePath +codexConfig home = home ".codex/config.toml" + +codexDemo :: FilePath -> FilePath +codexDemo home = home ".agents/skills/demo/SKILL.md" + +parseArgs :: [Text] -> Either String Toml.Table +parseArgs ["-c", override] = Toml.forgetTableAnns <$> Toml.parse override +parseArgs other = Left ("unexpected arguments: " <> show other) + +visibilityStatusTests :: TestTree +visibilityStatusTests = + testGroup + "visibility" + [ testCase "status reports requested and effective visibility" $ + withStatusFixture $ \home _ config -> do + rows <- collectStatus config (fixtureCache home) [(UserScope, "user")] + let one n p = case filter (\r -> r ^. #name == n && r ^. #providers == p) rows of + [r] -> pure r + other -> assertFailure (show other) + shared <- one "alpha" "claude" + shared ^. #requestedVisibility @?= Just SharedVisibility + shared ^. #effectiveVisibility @?= SharedVisibility + hidden <- one "epsilon" "codex" + hidden ^. #requestedVisibility @?= Just ToolOnlyVisibility + hidden ^. #effectiveVisibility @?= ToolOnlyVisibility + legacy <- one "gamma" "codex" + legacy ^. #requestedVisibility @?= Nothing + legacy ^. #effectiveVisibility @?= SharedVisibility + broken <- one "gamma" "claude" + broken ^. #requestedVisibility @?= Just SharedVisibility + broken ^. #effectiveVisibility @?= ToolOnlyVisibility + assertBool "broken condition" (KitVisibilityBroken `elem` (broken ^. #conditions)) + assertBool "table carries requested mismatch" ("tool-only (requested shared)" `Text.isInfixOf` renderStatusTable rows) + assertBool "agent mismatch" ("shared (requested tool-only)" `Text.isInfixOf` renderStatusTable rows), + testCase "a deleted link reports visibility-broken and update clears it" $ + withCodexHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions + removeFile (sharedDemo home) + before <- assertRight =<< checkVisibility testConfig InteractiveClaude UserScope SkillKind "demo" + before ^. #broken @?= [sharedDemo home] + rows <- collectStatus testConfig cache [(UserScope, "user")] + assertBool "status detects missing link" (any (elem KitVisibilityBroken . view #conditions) rows) + updateDemo cache + after <- assertRight =<< checkVisibility testConfig InteractiveClaude UserScope SkillKind "demo" + after ^. #broken @?= [], + testCase "a deleted disabled entry reports visibility-broken and update clears it" $ + withCodexHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + _ <- assertRight =<< removeDisabledSkill (codexConfig home) (codexDemo home) + rows <- collectStatus testConfig cache [(UserScope, "user")] + assertBool "Codex is now shared and broken" (any (\r -> r ^. #providers == "codex" && r ^. #effectiveVisibility == SharedVisibility && KitVisibilityBroken `elem` (r ^. #conditions)) rows) + updateDemo cache + after <- assertRight =<< checkVisibility testConfig InteractiveCodex UserScope SkillKind "demo" + after ^. #effective @?= ToolOnlyVisibility + after ^. #broken @?= [], + testCase "status table prints the legacy note only for a shared legacy Codex skill" $ + withStatusFixture $ \home _ config -> do + rows <- collectStatus config (fixtureCache home) [(UserScope, "user")] + assertBool "legacy note" ("installed before baikai-kit 0.4.0.0" `Text.isInfixOf` renderStatusTable rows) + let modern = filter (\r -> has _Just (r ^. #requestedVisibility)) rows + assertBool "no legacy note for modern copies" (not ("installed before baikai-kit 0.4.0.0" `Text.isInfixOf` renderStatusTable modern)), + testCase "uninstall preserves foreign Codex assets and a replaced Claude link" $ + withCodexHome $ \home _ -> do + _ <- assertRight =<< installItem (testConfig & #providers .~ [InteractiveClaude]) "demo" UserScope sharedOptions + removeFile (sharedDemo home) + createDirectoryIfMissing True (home "foreign") + createDirectoryLink (home "foreign") (sharedDemo home) + createDirectoryIfMissing True (takeDirectory (codexDemo home)) + BS.writeFile (codexDemo home) "foreign skill\n" + outcomes <- assertRight =<< uninstallItem testConfig "demo" UserScope + concatMap (view #linksRemoved) outcomes @?= [] + BS.readFile (codexDemo home) >>= (@?= "foreign skill\n") + getSymbolicLinkTarget (sharedDemo home) >>= (@?= home "foreign") + ] + +visibilityRecoveryTests :: TestTree +visibilityRecoveryTests = + testGroup + "visibility" + [ testCase "shared visibility refuses a user-owned disabled entry before writing assets" $ + withCodexHome $ \home _ -> do + _ <- assertRight =<< addDisabledSkill (codexConfig home) (codexDemo home) + seed <- BS.readFile (codexConfig home) + result <- installItem testConfig "demo" UserScope sharedOptions + case result of + Left KitCodexConfigUnusable {} -> pure () + other -> assertFailure (show other) + BS.readFile (codexConfig home) >>= (@?= seed) + assertDirectoryMissing (ownedDemo home) + assertFileMissing (codexDemo home), + testCase "uninstall reports an owned dangling link after its copy and sidecar are lost" $ + withCodexHome $ \home _ -> do + let config = testConfig & #providers .~ [InteractiveClaude] + _ <- assertRight =<< installItem config "demo" UserScope sharedOptions + removeDirectoryRecursive (ownedDemo home) + outcomes <- assertRight =<< uninstallItem config "demo" UserScope + concatMap (view #linksRemoved) outcomes @?= [sharedDemo home] + assertBool "report names removed link" ("1 shared link" `Text.isInfixOf` renderUninstallReport "demo" UserScope outcomes), + testCase "update does not introduce an unaccepted Codex agent copy" $ + withCodexHome $ \home cache -> do + _ <- assertRight =<< installItem (testConfig & #providers .~ [InteractiveClaude]) "reviewer" UserScope defaultInstallOptions + manifest <- assertRight =<< loadManifest cache + _ <- assertRight =<< reinstallPresent testConfig cache manifest (Just "reviewer") KeepLocalEdits + assertFileMissing (home ".codex/agents/reviewer.toml"), + testCase "multiple config entries preserve each other when one is removed" $ + withCodexHome $ \home _ -> do + _ <- assertRight =<< addDisabledSkill (codexConfig home) (codexDemo home) + _ <- assertRight =<< addDisabledSkill (codexConfig home) (home "other/SKILL.md") + _ <- assertRight =<< removeDisabledSkill (codexConfig home) (codexDemo home) + expected <- canonicalizePath (home "other/SKILL.md") + entries <- assertRight =<< readSkillEntries (codexConfig home) + entries @?= [(expected, False)], + testCase "update finishes pending visibility removals from sidecar ownership" $ + withCodexHome $ \home cache -> do + _ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions + meta <- demoSidecar home + LBS.writeFile (ownedDemo home ".testkit-kit.json") (Aeson.encode (meta & #visibility .~ Just "tool-only")) + before <- assertRight =<< checkVisibility testConfig InteractiveClaude UserScope SkillKind "demo" + before ^. #broken @?= [sharedDemo home] + updateDemo cache + assertDirectoryMissing (sharedDemo home) + _ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions + let sidecar = takeDirectory (codexDemo home) ".testkit-kit.json" + codexMeta <- requireSidecar sidecar + LBS.writeFile sidecar (Aeson.encode (codexMeta & #visibility .~ Just "shared" & #visibilitySource .~ Just "install-flag")) + pending <- assertRight =<< checkVisibility testConfig InteractiveCodex UserScope SkillKind "demo" + assertBool "pending config cleanup" (not (null (pending ^. #broken))) + updateDemo cache + entries <- assertRight =<< readSkillEntries (codexConfig home) + entries @?= [] + final <- requireSidecar sidecar + final ^. #codexDisabledSkills @?= Just [], + testCase "removal tolerates deleted delimiter comments and keeps other TOML" $ + withCodexHome $ \home _ -> do + path <- canonicalizePath (codexDemo home) + createDirectoryIfMissing True (home ".codex") + let suffix = "[projects.\"/x\"]\ntrust_level = \"trusted\"\n" + seed = "# user comment\n[[skills.config]]\npath = \"" <> Text.Encoding.encodeUtf8 (Text.pack path) <> "\"\nenabled = false\n" <> suffix + BS.writeFile (codexConfig home) seed + removed <- assertRight =<< removeDisabledSkill (codexConfig home) path + removed @?= True + BS.readFile (codexConfig home) >>= (@?= "# user comment\n" <> suffix), + testCase "a read-only Codex config is refused before writing assets" $ + withCodexHome $ \home _ -> do + createDirectoryIfMissing True (home ".codex") + BS.writeFile (codexConfig home) "# read only\n" + Posix.setFileMode (codexConfig home) 0o400 + result <- installItem testConfig "demo" UserScope defaultInstallOptions + case result of + Left KitCodexConfigUnusable {} -> pure () + other -> assertFailure (show other) + assertDirectoryMissing (ownedDemo home) + BS.readFile (codexConfig home) >>= (@?= "# read only\n"), + testCase "a read-only Codex config parent is refused before writing assets" $ + withCodexHome $ \home _ -> do + let parent = home ".codex" + createDirectoryIfMissing True parent + Posix.setFileMode parent 0o500 + flip finally (Posix.setFileMode parent 0o700) $ do + result <- installItem testConfig "demo" UserScope defaultInstallOptions + case result of + Left KitCodexConfigUnusable {} -> pure () + other -> assertFailure (show other) + assertDirectoryMissing (ownedDemo home) + assertFileMissing (codexConfig home), + testCase "foreign Codex agent resources are protected without a body file" $ + withCodexHome $ \home _ -> do + let resource = home ".codex/agents/reviewer/data.txt" + createDirectoryIfMissing True (takeDirectory resource) + BS.writeFile resource "foreign resource" + result <- installItem testConfig "reviewer" UserScope sharedOptions + case result of + Left KitSharedNameTaken {} -> pure () + other -> assertFailure (show other) + BS.readFile resource >>= (@?= "foreign resource") + assertFileMissing (home ".codex/agents/reviewer.toml") + assertDirectoryMissing (ownedDemo home), + testCase "project shared names and foreign Codex agents are protected" $ + withCodexHome $ \home _ -> do + let root = takeDirectory home "project" + config = testConfig & #projectRoot .~ pure root + createDirectoryIfMissing True (root ".claude/skills/demo") + result <- installItem config "demo" ProjectScope sharedOptions + case result of + Left KitSharedNameTaken {} -> pure () + other -> assertFailure (show other) + assertDirectoryMissing (root ".testkit") + createDirectoryIfMissing True (home ".codex/agents") + BS.writeFile (home ".codex/agents/reviewer.toml") "foreign" + result2 <- installItem testConfig "reviewer" UserScope sharedOptions + case result2 of + Left KitSharedNameTaken {} -> pure () + other -> assertFailure (show other) + BS.readFile (home ".codex/agents/reviewer.toml") >>= (@?= "foreign"), + testCase "post-content visibility failure remains tracked and update repairs it" $ + withCodexHome $ \home cache -> do + let config = testConfig & #providers .~ [InteractiveClaude] + createDirectoryIfMissing True (home ".claude") + BS.writeFile (home ".claude/skills") "blocking parent" + result <- installItem config "demo" UserScope sharedOptions + case result of + Left KitVisibilityNotApplied {} -> pure () + other -> assertFailure (show other) + meta <- demoSidecar home + meta ^. #sharedLinks @?= Just [Text.pack (sharedDemo home)] + assertFileExists (ownedDemo home "SKILL.md") + removeFile (home ".claude/skills") + manifest <- assertRight =<< loadManifest cache + _ <- assertRight =<< reinstallPresent config cache manifest (Just "demo") KeepLocalEdits + assertBool "repair after blocker clears" =<< pathIsSymbolicLink (sharedDemo home) + ] diff --git a/test/fixtures/mori-kit.json b/test/fixtures/mori-kit.json new file mode 100644 --- /dev/null +++ b/test/fixtures/mori-kit.json @@ -0,0 +1,34 @@ +{ + "version": 2, + "skills": [ + { + "name": "automation-config", + "version": "0.1.0", + "description": "Author, validate, and debug mori automation configurations", + "path": "skills/automation-config", + "files": ["SKILL.md"] + }, + { + "name": "mori-config", + "version": "0.1.0", + "description": "Author, validate, and edit mori.dhall project configurations", + "path": "skills/mori-config", + "files": ["SKILL.md"] + }, + { + "name": "cookbook-config", + "version": "0.1.0", + "description": "Author, validate, and edit mori/cookbook.dhall cookbook catalogs", + "path": "skills/cookbook-config", + "files": ["SKILL.md"] + }, + { + "name": "mori-bootstrap-corpus", + "version": "0.1.0", + "description": "Bootstrap a complete corpus project from a repo name", + "path": "skills/mori-bootstrap-corpus", + "files": ["SKILL.md"] + } + ], + "agents": [] +} diff --git a/test/fixtures/rei-kit.json b/test/fixtures/rei-kit.json new file mode 100644 --- /dev/null +++ b/test/fixtures/rei-kit.json @@ -0,0 +1,67 @@ +{ + "version": 1, + "skills": [ + { + "name": "rei-bootstrap", + "description": "Interactively bootstrap intentions, habits, and reflections for Rei personal coaching", + "path": "skills/rei-bootstrap", + "files": ["SKILL.md"] + }, + { + "name": "rei-bootstrap-habit", + "description": "Interactively bootstrap a new habit for Rei personal coaching", + "path": "skills/rei-bootstrap-habit", + "files": ["SKILL.md"] + }, + { + "name": "rei-summarize-links", + "description": "Extract markdown links from a document, summarize each URL, create Rei notes with summaries, and connect them to links via edges", + "path": "skills/rei-summarize-links", + "files": ["SKILL.md"] + }, + { + "name": "rei-scaffold-kit-skill", + "description": "Scaffold new Claude Code skills and agents for Rei, following established conventions from the rei codebase", + "path": "skills/rei-scaffold-kit-skill", + "files": ["SKILL.md"] + }, + { + "name": "rei-ingest-url", + "description": "Ingest a single URL into Rei — reuse or create a link, summarize the content into a note, connect them with a summarizes edge, and classify the link with author-type, content-type, media, platform, and reused/new topical tags", + "path": "skills/rei-ingest-url", + "files": ["SKILL.md"] + }, + { + "name": "rei-collection-epub", + "description": "Export a Rei collection to EPUB format using pandoc, with automatic chapter ordering inferred from titles, edges, content analysis, and timestamps", + "path": "skills/rei-collection-epub", + "files": ["SKILL.md"] + }, + { + "name": "rei-ingest-url-collection", + "description": "Read a markdown file of links, run the full rei-ingest-url workflow for each URL, and gather every resulting summary note into a single Rei collection", + "path": "skills/rei-ingest-url-collection", + "files": ["SKILL.md"] + }, + { + "name": "rei-complete-from-commits", + "description": "Backlog cleanup — for a given Rei intention and git repository, find commits whose Intention: trailer matches the intention's children and bulk-complete each with --at set to the latest matching commit timestamp; optionally infer dates for children with no trailer matches from pre-trailer commit subjects", + "path": "skills/rei-complete-from-commits", + "files": ["SKILL.md"] + }, + { + "name": "rei-ingest-markdown", + "description": "Ingest a pre-converted markdown file (with frontmatter) into Rei — reuse or create a link from the source URL, save the full markdown as an archive note, summarize it into a separate summary note, wire them with `archives` and `summarizes` edges, and classify the link with author-type, content-type, media, platform, and reused/new topical tags", + "path": "skills/rei-ingest-markdown", + "files": ["SKILL.md"] + } + ], + "agents": [ + { + "name": "rei-custom-property-guide", + "description": "Guide users through creating and managing custom properties in Rei. Helps design property schemas, choose value types, configure category scopes, and create state machine workflows.", + "path": "agents", + "files": ["rei-custom-property-guide.md"] + } + ] +} diff --git a/test/fixtures/seihou-kit.json b/test/fixtures/seihou-kit.json new file mode 100644 --- /dev/null +++ b/test/fixtures/seihou-kit.json @@ -0,0 +1,18 @@ +{ + "version": 1, + "skills": [ + { + "name": "seihou-scaffold-kit-skill", + "description": "Scaffold new Claude Code skills and agents for Seihou, following established conventions.", + "path": "skills/seihou-scaffold-kit-skill", + "files": ["SKILL.md"] + }, + { + "name": "seihou-module-readme", + "description": "Generate or refresh a human-readable README.md for a Seihou module, documenting its version, variables, prompts, dependencies, exports, generated files, and usage.", + "path": "skills/seihou-module-readme", + "files": ["SKILL.md"] + } + ], + "agents": [] +} diff --git a/test/golden/list.json b/test/golden/list.json new file mode 100644 --- /dev/null +++ b/test/golden/list.json @@ -0,0 +1,1 @@ +{"document":"kit-list","formatVersion":1,"items":[{"description":"The alpha skill","installed":[{"path":"$HOME/.config/testkit/agents/.claude/skills/alpha","provider":"claude","scope":"user","version":"0.1.0"},{"path":"$HOME/.agents/skills/alpha","provider":"codex","scope":"user","version":null}],"kind":"skill","name":"alpha","version":"0.1.0","visibility":"shared"},{"description":"The beta skill","installed":[{"path":"$PROJECT/.testkit/agents/.claude/skills/beta","provider":"claude","scope":"project","version":"0.1.0"},{"path":"$PROJECT/.agents/skills/beta","provider":"codex","scope":"project","version":"0.1.0"}],"kind":"skill","name":"beta","version":"0.2.0","visibility":"tool-only"},{"description":"The gamma skill","installed":[{"path":"$HOME/.config/testkit/agents/.claude/skills/gamma","provider":"claude","scope":"user","version":"0.1.0"},{"path":"$HOME/.agents/skills/gamma","provider":"codex","scope":"user","version":"0.1.0"}],"kind":"skill","name":"gamma","version":"0.1.0","visibility":"shared"},{"description":"The epsilon skill","installed":[{"path":"$HOME/.config/testkit/agents/.claude/skills/epsilon","provider":"claude","scope":"user","version":"0.1.0"},{"path":"$HOME/.agents/skills/epsilon","provider":"codex","scope":"user","version":"0.1.0"}],"kind":"skill","name":"epsilon","version":"0.1.0","visibility":"tool-only"},{"description":"The reviewer agent","installed":[{"path":"$HOME/.config/testkit/agents/.claude/agents/reviewer.md","provider":"claude","scope":"user","version":"0.1.0"},{"path":"$HOME/.codex/agents/reviewer.toml","provider":"codex","scope":"user","version":"0.1.0"}],"kind":"agent","name":"reviewer","version":"0.1.0","visibility":"tool-only"},{"description":"The planner agent","installed":[{"path":"$PROJECT/.testkit/agents/.claude/agents/planner.md","provider":"claude","scope":"project","version":"0.1.0"},{"path":"$PROJECT/.codex/agents/planner.toml","provider":"codex","scope":"project","version":"0.1.0"}],"kind":"agent","name":"planner","version":"0.1.0","visibility":"tool-only"}],"upstream":{"detail":"","state":"stale"}} diff --git a/test/golden/status.json b/test/golden/status.json new file mode 100644 --- /dev/null +++ b/test/golden/status.json @@ -0,0 +1,1 @@ +{"document":"kit-status","formatVersion":1,"items":[{"conditions":[],"effectiveVisibility":"shared","installedVersion":"0.1.0","kind":"skill","latestVersion":"0.1.0","name":"alpha","provider":"claude","requestedVisibility":"shared","scope":"user","upToDate":true},{"conditions":["unknown"],"effectiveVisibility":"shared","installedVersion":null,"kind":"skill","latestVersion":"0.1.0","name":"alpha","provider":"codex","requestedVisibility":null,"scope":"user","upToDate":false},{"conditions":["outdated"],"effectiveVisibility":"tool-only","installedVersion":"0.1.0","kind":"skill","latestVersion":"0.2.0","name":"beta","provider":"claude","requestedVisibility":"tool-only","scope":"project","upToDate":false},{"conditions":["outdated"],"effectiveVisibility":"tool-only","installedVersion":"0.1.0","kind":"skill","latestVersion":"0.2.0","name":"beta","provider":"codex","requestedVisibility":"tool-only","scope":"project","upToDate":false},{"conditions":["delisted"],"effectiveVisibility":"tool-only","installedVersion":"0.1.0","kind":"skill","latestVersion":null,"name":"delta","provider":"claude","requestedVisibility":"tool-only","scope":"project","upToDate":false},{"conditions":["delisted"],"effectiveVisibility":"tool-only","installedVersion":"0.1.0","kind":"skill","latestVersion":null,"name":"delta","provider":"codex","requestedVisibility":"tool-only","scope":"project","upToDate":false},{"conditions":["refused"],"effectiveVisibility":"tool-only","installedVersion":"0.1.0","kind":"skill","latestVersion":"0.1.0","name":"epsilon","provider":"claude","requestedVisibility":"tool-only","scope":"user","upToDate":false},{"conditions":["refused"],"effectiveVisibility":"tool-only","installedVersion":"0.1.0","kind":"skill","latestVersion":"0.1.0","name":"epsilon","provider":"codex","requestedVisibility":"tool-only","scope":"user","upToDate":false},{"conditions":["changed-upstream","visibility-broken"],"effectiveVisibility":"tool-only","installedVersion":"0.1.0","kind":"skill","latestVersion":"0.1.0","name":"gamma","provider":"claude","requestedVisibility":"shared","scope":"user","upToDate":false},{"conditions":["changed-upstream"],"effectiveVisibility":"shared","installedVersion":"0.1.0","kind":"skill","latestVersion":"0.1.0","name":"gamma","provider":"codex","requestedVisibility":null,"scope":"user","upToDate":false},{"conditions":["edits-unknown"],"effectiveVisibility":"tool-only","installedVersion":"0.1.0","kind":"agent","latestVersion":"0.1.0","name":"planner","provider":"claude","requestedVisibility":"tool-only","scope":"project","upToDate":false},{"conditions":[],"effectiveVisibility":"shared","installedVersion":"0.1.0","kind":"agent","latestVersion":"0.1.0","name":"planner","provider":"codex","requestedVisibility":"tool-only","scope":"project","upToDate":true},{"conditions":["modified"],"effectiveVisibility":"tool-only","installedVersion":"0.1.0","kind":"agent","latestVersion":"0.1.0","name":"reviewer","provider":"claude","requestedVisibility":"tool-only","scope":"user","upToDate":false},{"conditions":[],"effectiveVisibility":"shared","installedVersion":"0.1.0","kind":"agent","latestVersion":"0.1.0","name":"reviewer","provider":"codex","requestedVisibility":"tool-only","scope":"user","upToDate":true}],"upstream":{"detail":"","state":"stale"}} diff --git a/test/golden/update.json b/test/golden/update.json new file mode 100644 --- /dev/null +++ b/test/golden/update.json @@ -0,0 +1,1 @@ +{"document":"kit-update","formatVersion":1,"refresh":null,"skipped":[{"name":"demo","reason":"locally-modified","scope":"user"}],"updated":[{"name":"reviewer","scope":"user"}]}