diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,2702 @@ +# Changelog + +All notable changes to baikai are recorded here. + +The format follows [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and +this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## [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 + +- `BaikaiError.refusalCategory` preserves an Anthropic refusal's + provider category. JSON adds `refusal_category`; older errors still decode. + Evidence schema 2.5 records the addition without changing digest inputs. + __Breaking__ to construct a `BaikaiError` from its full field list. + +- `Speed`, `Options.speed`, catalog-owned fast rates and + `computeCostAtSpeed`. Anthropic gates fast mode by model capability, adds the + beta header and records unsupported drops. Terminal pricing uses observed + speed, including cache duration; unreported speed is an explicit estimate. + Older `Model` JSON defaults the new fields safely. __Breaking__: public + records and sum types gain fields and constructors. + +- API usage now records observed service tiers, inference speed and server-tool + use in optional billing facts covered by evidence schema 2.2. Missing service + information and uncurated products produce explicit standard-rate estimates. + `computeCostForService` separates requested and observed service, while + `computeCostAtRates` prices a resolved rate set once for future speed policies. + Empty billing facts preserve legacy availability JSON; a CLI-reported zero + cost retains its reported-total source. __Breaking__: the public vocabulary + and records gain members. + +- Failed trace terminals now retain partial response token counts, cost basis, + usage availability and USD totals. Synthetic aborts leave unreported billing + absent; legacy failed trace JSON still decodes. __Breaking__: `TraceEvent`'s + `CallFailed` gains fields. See `baikai-trace-otel 0.4.0.1` for the export. + +- Successful trace terminals and call-log records carry optional cost basis and + usage availability; call logs also carry cache-write counts. Old JSON decodes + with absent metadata and empty additive-zero bases stay omitted from traces. + __Breaking__: `CallFinished` and the call-log record gain fields. + +- Optional `Usage.availability` and shared inclusive/exclusive billing + normalization, in the new `Baikai.Usage.Normalize`. OpenAI Chat/Responses and + Claude preserve missing cache counters as explicit estimation reasons, + distinguish reported zeroes, and merge cumulative usage without + double-counting. Schema 2.2 commits provider availability while preserving + legacy usage digests. __Breaking__: `Usage` gains a field. + +- Optional `Model.pricingPolicy`, exact whole-request context tiers, + and an explicit cache-duration rate resolver. Generated Astra pricing changes + above 272000 input tokens; Fable exposes its one-hour write price. `Cost.basis` + preserves calculation sources and estimation reasons when summed. Evidence + schema 2.2 serializes the local basis without including local pricing metadata + in provider commitments. __Breaking__: `Model` and `Cost` gain fields. + +- Separate `OpenAIResponses` dispatch and compatibility types, and + optional provider/model-scoped `ThinkingContent.replayState` with opaque + diagnostic output and backward-compatible JSON decoding. Evidence schema 2.2 + includes replay state and optional billing facts in commitments while preserving + legacy encodings when those fields are absent. __Breaking__ for a `case` over + `Api` that is exhaustive without a wildcard. + +- `Baikai.Evidence.ThinkingTranslation` gains `displayText` and + `ThinkingAdjustment` gains `ThinkingSummaryUnavailable`, so a transport can + record the thinking display setting it asked for and diagnose a successful + response whose thinking blocks carry no readable summary. `Baikai.Compat` + gains `supportsForcedToolChoice`; legacy JSON defaults it to True. + __Breaking__ for an exhaustive `case` over `ThinkingAdjustment`. + +- GPT-6 Astra and Claude Fable 5.1 catalog bindings, with verified + pricing, token limits, and Anthropic thinking/sampling compatibility. + +- Repository `update-models` skill for verifying provider releases and refreshing + the curated JSON and generated Haskell catalog. + +### Fixed + +- Preserve OpenAI endpoint capability facts through catalog refreshes. + +- Chat and Claude reject provider-scoped reasoning replay they cannot encode. + +- Widened the `http-client-tls` bound to admit 0.4 (carried forward from the + tagged but never-published 0.6.0.1). + +## [baikai-claude 0.7.0.0] - 2026-09-08 + +### Changed + +- Refusal messages include the reported category and explanation, + retaining the original message when neither exists. Classification remains + non-retryable `ContentFiltered`. Server-side fallbacks remain deliberately + unsupported, as recorded in ADR 0005. + +- Adaptive reasoning requests explicitly ask for summarized + thinking. Evidence schema 2.4 records the display setting and diagnoses + successful responses whose thinking blocks contain no readable summary. + Budget and absent-thinking request shapes, signed empty blocks, redacted + content and multi-turn replay are preserved. + +- Fast mode is gated by the generated model capability: it adds the Anthropic + beta header for a model that advertises it and records an evidence adjustment + for one that does not. + +### Fixed + +- Price Fable cache writes using the TTL in the shaped request, + including compatibility downgrades. Missing write-duration context is explicit + in the cost basis. + +- Reject forced tool choices locally on Fable 5.1, using the + generated `supportsForcedToolChoice` capability. Automatic tool rounds retain + signed empty/visible thinking, redacted blocks and prior-message order. + +- Widened the `http-client-tls` bound to admit 0.4 (carried forward from the + tagged but never-published 0.6.0.1). + +### Changed (dependencies) + +- Requires `baikai ^>=0.7.0`. + +## [baikai-openai 0.7.0.0] - 2026-09-08 + +### Added + +- Explicit `Baikai.Provider.OpenAI.Responses` registration and + stream/complete provider with stateless reasoning replay, function tool turns, + structured output and bounded worker cleanup, across the new + `Baikai.Provider.OpenAI.Responses.{Request,Stream,Assembler}` modules. Astra + now selects this provider through a per-model catalog override; callers must + register it explicitly. Cache writes, billing availability and context pricing + are integrated. + +- `Baikai.Provider.OpenAI.Internal.Usage`, the shared usage mapping both the + Chat Completions and Responses transports read. + +### Fixed + +- Reject tools locally for models whose Chat Completions endpoint + disallows them, including GPT-6 Astra. Respect generated effort policies and + sampling restrictions, with matching translation evidence and strict refusal. + +- Validate Responses terminals and enforce the stream contracts. + +- Widened the `http-client-tls` bound to admit 0.4 (carried forward from the + tagged but never-published 0.6.0.1). + +### Changed (dependencies) + +- Requires `baikai ^>=0.7.0`. + +## [baikai-trace-otel 0.4.0.1] - 2026-09-08 + +### Added + +- Successful and failed spans export `baikai.cost.basis` and + `baikai.usage.availability` as canonically encoded JSON. A failed span now + also carries the input/output token counts and USD total that + `baikai 0.7.0.0` retains on `CallFailed`, alongside its error status. + +### Changed (dependencies) + +- Requires `baikai ^>=0.7.0`, and now depends on `aeson ^>=2.2` to encode the + two new attributes. + +## [baikai-effectful 0.4.0.1] - 2026-09-08 + +### Changed (dependencies) + +- Requires `baikai ^>=0.7.0`. No API change. + +## [baikai-kit 0.2.0.1] - 2026-09-08 + +### Changed (dependencies) + +- Requires `baikai ^>=0.7.0`. No API change. + +## [baikai-agent 0.2.0.1] - 2026-09-08 + +### Changed (dependencies) + +- Requires `baikai ^>=0.7.0`, `baikai-claude ^>=0.7` and + `baikai-openai ^>=0.7`. No API change. + +## [baikai 0.6.0.1] - 2026-08-30 + +### Fixed + +- widened the `http-client-tls` bound to admit 0.4. The 0.4 API retains the + manager functions this package uses and belongs to the same TLS 2.x / Crypton + 1.1 dependency cohort as baikai 0.6; the old `^>=0.3` cap made baikai 0.6 + impossible to solve in applications that require Crypton 1.1. + +## [baikai-claude 0.6.0.1] - 2026-08-30 + +### Fixed + +- widened the `http-client-tls` bound to admit 0.4, allowing applications that + require Crypton 1.1 to solve the dependency set. + +## [baikai-openai 0.6.0.1] - 2026-08-30 + +### Fixed + +- widened the `http-client-tls` bound to admit 0.4, allowing applications that + require Crypton 1.1 to solve the dependency set. + +## [baikai 0.6.0.0] - 2026-08-28 + +### Added + +- `baikai`: `Baikai.ThinkingLevel.parseThinkingLevel :: Text -> Maybe + ThinkingLevel` and `Baikai.Evidence.parseEvidenceStrength :: Text -> Maybe + EvidenceStrength`, each beside its renderer. Three hand-copied tables — the + evidence schema's level parser, `baikai-agent`'s KDL `effort` decoder, and its + `--require-evidence` parser — now read them instead, so a level or strength + added later cannot be added in one place and missed in three. (REV-2 G.6.) + +- `baikai`: `Baikai.Agent.AgentRunResult` exports its selectors (`provider`, + `exitCode`, `stdout`, `stderr`, `duration`). It exported neither them nor its + constructor, so a consumer without generic-lens could not read a run's exit + code at all. (REV-2 G.6.) + +- `baikai`: `Baikai.Api.normaliseApi :: Api -> Api`, which collapses a `Custom` + tag that spells a built-in API onto that constructor. The registry applies it + to the key it stores and to the tag it is asked for, so a handler registered + under `Custom "anthropic-messages"` answers a model tagged `AnthropicMessages` + and the reverse; the two used to be separate entries and dispatch depended on + which spelling the model happened to carry. Derived `Eq`/`Ord` on `Api` are + deliberately unchanged: altering them would silently rearrange every + `Map Api` a consumer holds. (REV-2 G.4.) + +- `baikai`: `Baikai.Header`, a new module exporting `HeaderName` with + `headerName` and `renderHeaderName`. See the `headers` retype under Changed. + +- `baikai`: `Baikai.Error.ErrorCategory` gains `ContentFiltered` (wire tag + `content_filtered`, never retryable) with the smart constructor + `contentFiltered`. OpenAI's `finish_reason: "content_filter"` and Anthropic's + `refusal` stop now carry it. Both used to be `OtherError`, so the only way to + tell a filtered response from any other non-retryable failure was to match on + the message text. __Breaking__ for a consumer whose `case` over + `ErrorCategory` is exhaustive without a wildcard. (REV-1 1.7 residual.) + +- `baikai` (breaking to construct, not to read): every record that can still + grow a field is now built from an exported base value and refined by record + update, and its constructor is no longer exported — + `Baikai.Provider.Registry.ApiProvider` (`apiProvider` /`apiProviderWith`), + `Baikai.Evidence.ModelCallEvidence` (`baseEvidence`), + `Baikai.Evidence.EvidenceRequest` (`evidenceRequest`), `Baikai.Tool.Tool` + (`mkTool`, with `emptyTool` kept for fixtures), + `Baikai.Embedding.EmbeddingModel` (`emptyEmbeddingModel`), + `Baikai.Cost.Log.CallLogConfig` (`callLogConfig`), + `baikai-trace-otel`'s `OtelSinkOptions` (`defaultOtelSinkOptions`), and + `baikai-agent`'s `AgentCliOptions` (`agentCliOptions`), `AgentCliRun` + (`agentCliRun`), `AgentJob` (`agentJob`) and `AgentConfigPaths` + (`emptyAgentConfigPaths`). Selectors, record update, `OverloadedRecordDot` + reads and generic-lens labels all keep working; only construction from the + constructor stops. Adding `describeThinking` to `ApiProvider` in 0.5.0.0 broke + every third-party registration site, and `strengthCeiling` would have broken + them again; from this release such an addition is a minor bump. (REV-2 G.1.) + +- `baikai`: `Baikai.Provider.apiProvider`, which builds an `ApiProvider` from an + `Api` tag and a streaming producer, deriving `complete` with + `streamingComplete`; and `Baikai.Provider.Registry.apiProviderWith`, which + takes the completer explicitly. Both default `describeThinking` to + "nothing requested, nothing translated" and `strengthCeiling` to + `EvidenceRequestedOnly`, matching `declaredStrength (Custom _)`. + +- `baikai`: `Baikai.Tool.mkTool` — a tool from its name, description and JSON + Schema. A tool built from `emptyTool` and sent unchanged reaches the wire with + `input_schema: null`; `mkTool` has no such shape. + +- `baikai`: `Baikai.Agent.AgentOutputFormat` (`TextFormat`, `JsonFormat`) with + `renderAgentOutputFormat` and `parseAgentOutputFormat`, and + `AgentRunRequest.outputFormat`, defaulting to `TextFormat`. `baikai-claude` + renders `--output-format json` and `baikai-openai` renders `--json`, both + right after the effort flags; `baikai-agent` reads it from + `jobs..output-format`. This is the one setting an evidence record needs + in order to observe a run's session, model and usage, and asking for it used + to require the `provider-args` channel that an operator ceiling closes by + default — an operator should not have to open a privileged channel to get a + record. (REV-2 F.14.) + +- `baikai`: `Baikai.Agent.AgentCeiling` gains three fields and the module gains + the vocabulary they need. `allowedTools :: [Text]` names tool grants the + operator permits beyond the ones `toolGrantsImpliedBy` (also new) says a + capability implies on its own; `maxTimeout :: Maybe NominalDiffTime` and + `maxOutputLimit :: Maybe Int` bound what any job may request, the second + defaulting to the new `defaultMaxOutputLimit` (67108864, sixty-four + mebibytes). `Baikai.Agent.ceilingViolations` is `applyAgentCeiling`'s violation + list on its own, so a caller can concatenate it with violations of its own. + (REV-2 F.3.) + +- `baikai`: `Baikai.Content.toolArgumentsFromText` and + `Baikai.Content.isCutOffToolCall`. The first is the single rule that turns a + tool call's accumulated argument text into its `arguments` value — empty text + is an empty object, non-empty text that does not decode is kept verbatim as a + `String` — and both provider assemblers and core's stream-recovery path now + use it, so the second means the same thing at every layer. + +- `baikai`: new exposed module `Baikai.Provider.Internal.StreamWorker` — the + bounded hand-off both HTTP providers now use between their SSE worker thread + and the consumer draining the stream. `FrameQueue` is a 64-slot `TBQueue` plus + a closed flag; `forkFrameWorker` closes the queue however the body ends, and + `withFrameWorker` runs the consumer under `Stream.bracketIO` so the worker is + killed when the stream stops. The module is exposed like + `Baikai.Provider.Cli.Internal`, outside the PVP promise. See + [docs/adr/0010](docs/adr/0010-a-stream-consumer-that-stops-owns-cancelling-the-producer.md). + +- `baikai`: every Anthropic model in the generated catalog now carries an + explicit `CompatAnthropicMessages` record stating the two request-shaping + facts of its generation: `AnthropicMessagesCompat.thinkingStyle` (which + extended-thinking wire shape it accepts) and the new + `AnthropicMessagesCompat.supportsSamplingParameters` (whether it accepts + `temperature`, `top_p` and `top_k`). Both are sourced from + `baikai/data/models/anthropic.json`, which the fetcher writes from its + curated `anthropicInclude` table, and `baikai-gen-models` now refuses an + `anthropic-messages` entry that reaches it without a `compat` block rather + than falling back to host auto-detection, which cannot know a generation. + This is what fixes `claude-sonnet-5`, whose thinking requests were shaped by + a prefix table that did not know the id. See + [docs/adr/0009](docs/adr/0009-provider-capability-facts-live-in-the-generated-catalog-record.md). + +- `baikai`: two new `Baikai.Evidence.ThinkingAdjustment` constructors, + `SamplingDroppedUnsupportedModel` and `SamplingDroppedUnsupportedApi`, encoding as + `{"kind":"sampling_dropped_unsupported_model","fields":["temperature","top_p"]}` and + `{"kind":"sampling_dropped_unsupported_api","fields":["seed"]}`. They record sampling + parameters removed because the model generation rejects them, or because the API has no + such field on any generation. Both carry a `fields` array and no `requested` level, so + they can appear on a call whose thinking mode is `absent`. + +- `baikai`: `Baikai.Evidence.weakensThinking`, which says whether an adjustment weakens the + thinking the caller asked for. Strict evidence mode filters through it, so a dropped + sampling parameter is recorded without refusing the call — the documented contract is + refusing a call that would weaken the requested *thinking level*. + +- `baikai`: new exposed module `Baikai.Url` — the one place baikai turns a URL + into a host name. `parseUrl` yields a `UrlParts` record with the scheme, host, + port and path, plus flags saying whether userinfo, a query string or a + fragment were present; it never holds their text, so the value cannot carry a + secret into a log line. Alongside it: `urlHost`, `hostMatchesSuffix` (moved + from `Baikai.Compat`, which now re-exports both), `renderEndpoint`, + `stripApiVersion`, and `baseUrlProblem`, which says why a URL is unusable as a + `Model.baseUrl` and what to do instead. See + [docs/adr/0008](docs/adr/0008-one-url-host-parser-and-every-consumer-uses-it.md). + +- `baikai`: new exposed module `Baikai.Provider.Transport.Classify` — the one + rule every HTTP provider uses to classify a transport failure, exporting + `classifyTransportException` plus the per-type functions it composes. The rule + is *where* the failure happened, not what type it is: anything that breaks or + ends the connection after the request went out is `TransientError`, anything + that says the request or the configuration is wrong is not retryable, and a + programming error stays `OtherError`. It understands all three shapes + `http-client` can deliver — an `HttpException` of any constructor, a raw socket + `IOException`, and a raw or wrapped `TLSException` — because the manager wraps + the connect phase but not the body reader. Core gains direct `build-depends` on + `http-types` and `tls`, both already in its install plan. Written for + third-party `Custom` providers built on `http-client` as much as for baikai's + own two. See + [docs/adr/0011](docs/adr/0011-core-owns-transport-failure-classification.md). + +- `baikai`: `Baikai.Error.parseHttpDate` and `Baikai.Error.retryAfterSecondsAt`. + The first parses an HTTP-date in the IMF-fixdate form servers must send plus + the two obsolete forms a recipient must accept; the second converts a + `Retry-After` header in either of its forms to seconds against a reference + instant, clamping a date already in the past to `0`. + `parseRetryAfterSeconds` keeps its integer-only contract, now a deliberate + division of labour rather than a limitation. + +- `baikai`: new exposed module `Baikai.Http` — `canonicalBaseUrl`, + `getClientEnvCached` and `cachedClientEnvCount`, the process-global + `ClientEnv` cache that both HTTP provider packages now share instead of each + keeping its own. Core gains direct `build-depends` on `servant-client`, + `http-client` and `http-client-tls`, which were already in its install plan + through the `openai` SDK. + +- `baikai`: `Baikai.Evidence.ThinkingModeNotTranslated`, encoded as + `"not_translated"`, and `Baikai.Evidence.untranslatedThinking`; and + `Baikai.Evidence.Build.requestedTranslation`. A path where no adapter ran to + translate the caller's level now records the level and says the translation is + unknown, instead of saying nothing was asked. (REV-2 D.2.) + +- `baikai`: `Baikai.Evidence.Build.missingEvidenceError`, + `Baikai.Evidence.Build.strictnessOf` (moved here from `Baikai.Trace`, where it + was private), `Baikai.Stream.requireEvidenceOnTerminal` and + `Baikai.Provider.Registry.requireEvidenceOnResponse`. (REV-2 D.3.) + +- `baikai`: `Baikai.Evidence.usageEnvelope`, and + `Baikai.Evidence.Build.endpointIdentityAt`, `prepareEvidenceAt` and + `minimalEvidenceAt`, which take the base URL the adapter actually resolved. + The three unsuffixed functions remain and pass the model's own field. + (REV-2 D.8, D.11.) + +- `baikai`: `Baikai.Evidence.deriveStrength`, the single rule that turns an + observed model, a provider request id and a response id into an + `EvidenceStrength`. (REV-2 D.10.) + +### Changed + +- `baikai`: catalog refresh. `claude-opus-5` joins the curated Anthropic include + set (adaptive thinking, sampling parameters rejected — the facts + `docs/plans/60-make-anthropic-thinking-style-and-sampling-support-catalog-driven.md` + said whoever curated it in would have to state), and the `gpt-5.6` family + picks up its price cut: `gpt-5.6` and `gpt-5.6-sol` to $4.00/$20.00, + `gpt-5.6-terra` to $2.00/$12.00, `gpt-5.6-luna` to $0.20/$1.20 per Mtok, cache + rates in step. `Baikai.Models.Generated` gains `anthropic_claude_opus_5` and + now carries 36 enabled models. No OpenAI id was added: the `gpt-5.6` family is + still the newest one models.dev reports that speaks + `openai-chat-completions`. + +- `baikai` (breaking): `ResponseFormat`'s `JsonSchema` carries a + `JsonSchemaFormat` record — `name`, `schema`, `strict`, exported + selector-only with the base `jsonSchemaFormat name schema` — instead of + holding the three fields directly. As fields of a sum they were partial + selectors: `name f` on a `JsonObject` crashed at runtime rather than failing to + typecheck, which contradicted the module's own documentation. + `-Wno-partial-fields` is dropped from the module. The JSON encoding is + deliberately unchanged (`{"tag":"JsonSchema","name":…,"schema":…,"strict":…}`) + and is now pinned by a test, because `Options` derives `ToJSON` through it and + at least one consumer keys a cache on the result. (REV-2 G.2.) + +- `baikai`: `Baikai.Context.appendToolResult` returns its input context + unchanged, and runs no dispatcher, when the response is error-shaped. A failed + call has no assistant turn worth replaying and no tool calls to answer; + appending its empty message put a turn into the transcript the model never + took. `runToolLoop` has always stopped on such a response — the documented + direct round trip in `docs/user/tools.md` reaches `appendToolResult` instead, + and now behaves the same way. Its Haddock also stops claiming multi-call + concurrency lives in the dispatcher: the calls are traversed in order. + (REV-2 G.7.) + +- Release metadata (REV-2 G.8): every publishable package now declares + `tested-with: GHC ==9.12.4` and ships its `CHANGELOG.md` (a symlink to the + root one, as `baikai` already did) via `extra-doc-files`, so Hackage shows a + changelog and a tested compiler for all seven. `baikai-claude` and + `baikai-openai` describe what they actually contain — four surfaces each, not + "wraps package X" — and `baikai-trace-otel`'s `streamly-core` bound is + `>=0.3 && <0.5`, matching every other package in the workspace rather than + excluding the 0.4 series the others accept. + +- `baikai` (breaking): `Options.headers` and `Model.headers` are keyed on + `Baikai.Header.HeaderName` — a newtype over a case-insensitive `CI Text` that + keeps the original spelling — instead of `Text`. A header name is + case-insensitive on the wire, so a `Map Text Text` holding both + `Authorization` and `authorization` sent whichever the assembling fold reached + last; the map now holds one entry per header and the last write wins, as a + caller writing two spellings would expect. `HeaderName` has an `IsString` + instance, so `Map.singleton "x-test" "1"` and `#headers` updates keep + compiling; the spelling given is what goes out on the wire and into JSON. + (REV-2 G.5.) + +- `baikai` (breaking): `Options.stopSequences` is `[Text]`, where empty means + "send nothing", instead of `Maybe (Vector Text)` — `Nothing` and `Just []` + were indistinguishable on the wire and only one of them could be right. Plan + 43's rule is lists for caller-side configuration and `Vector` for + provider-bound sequences; this was the one field breaking it. `Options.seed` + is `Maybe Int` rather than `Maybe Integer`: a seed is a machine integer at + every provider that accepts one, and it now sits beside + `timeoutMs :: Maybe Int`. (REV-2 G.5, R14.) + +- `baikai` (breaking): `StopReason.Aborted` is removed. Nothing produced it — + timeouts are `ErrorReason`/`TransientError`, and a consumer abort is recorded + as evidence `CallAborted` — while `responseError`, `eventsFor` and + `runToolLoop` all treated it as a *success*, so a value that reached any of + them would have been silently mishandled. Since 0.6.0.0 a stream consumer that + stops cancels the producer, so no consumer is left to receive such a terminal + either. (REV-2 B.6.) + +- `baikai`: dispatching a model whose `api` is still `emptyModel`'s + `Custom ""` says so — `No provider registered for API: ` — where the message used to end after the + colon. `emptyModel`'s Haddock says the same thing. (REV-2 G.4.) + +- `baikai`: `withTrace` and `withTraceStream` wait at most one second for the + trace sink after writing the shutdown sentinel. On expiry the worker is + abandoned — not killed, which would abort the sink's fold mid-step and lose + its end-of-stream action — the call proceeds, and one stderr line reports + `the trace sink did not confirm delivery within 1000 ms; its worker was + abandoned, and events already queued may still be delivered later`. A sink + that blocked forever used to hold the call forever and swallow the first + attempt to cancel it. A caller under `EvidenceRequired` whose sink did not + confirm delivery gets a failed call, through the same path a throwing sink + takes; `Baikai.Evidence.Build.sinkFailureError` now says "its record was not + confirmed written" rather than "not written", which is the honest claim for + an abandoned worker whose events are still queued. The synthetic terminal a + consumer's abort produces is delivered from a garbage-collection hook and is + not guaranteed before process exit; that was always true and is now stated in + `docs/user/model-call-evidence.md`, `docs/capabilities/call-tracing.md` and + the `Baikai.Trace` module documentation, with the pattern for callers who need + the record. See + [docs/adr/0015](docs/adr/0015-trace-cleanup-is-bounded-and-abort-cleanup-is-gc-eventual.md). + (REV-2 D.5, Theme 7.3.) + +- `baikai`: `Baikai.Trace.Sink.multiSink` runs each member on its own drain + thread behind its own unbounded channel, instead of folding `Fold.tee` across + the list. `Fold.tee` runs one member then the other and lets either's + exception escape, so a single throwing member stopped delivery to every + sibling for the rest of the call and skipped their end-of-stream actions — an + OpenTelemetry span paired with an unwritable file sink was opened and never + ended, and nothing was exported. The step never blocks; the final action sends + every member the sentinel, waits for every member, and reports one aggregate + failure naming each failed member by zero-based index + (`1 of 2 member sinks failed: member 0: …`). (REV-2 D.6.) + +- `baikai`: `AgentSafety.allowedTools` is documented as the __grant__ it is. + On Claude Code it renders `--allowedTools`, whose help reads "list of tool + names to allow": it pre-approves tools the permission mode would otherwise + raise a request for, and in an unattended run a request nobody answers is + denied. The old Haddock called it "optional narrowing of the provider's tool + set", which was the opposite, and `applyAgentCeiling` never looked at it. It + is now bounded: a grant passes when the maximum capability implies it + (`read-only` implies `Read`, `Glob`, `Grep`, `NotebookRead`, `TodoWrite`; + `edit-workspace` adds `Edit`, `MultiEdit`, `Write`, `NotebookEdit`; + `full-access` implies every grant) or when the operator named it in + `policy.allowed-tools`. Matching is exact, so `Bash(git *)` is not `Bash`. + A repository job that grants itself `Bash` under `edit-workspace` — which + passed unexamined before — is now refused with exit 77 before any process is + created. (REV-2 F.3.) + +- `baikai` (breaking): `Baikai.Agent.CeilingViolation` gains five constructors: + `ToolGrantForbidden`, `TimeoutExceeded`, `OutputLimitExceeded`, + `RepositoryScopeForbidden` and `WorkingDirOutsideRepository`. A `case` over + the type that was exhaustive is no longer. + +- `baikai` (behaviour): the default ceiling has a finite `maxOutputLimit`, so + `applyAgentCeiling defaultAgentCeiling` now refuses a request whose + `outputLimit` is `Nothing` — capture without bound is exactly what the + maximum exists to refuse. Jobs resolved through `baikai-agent` are unaffected: + that layer's own default supplies a finite limit, and only an explicit + `output-limit "unlimited"` reaches the ceiling as `Nothing`. + +- `baikai`: a tool call cut off by the output cap is no longer executed. + `runToolLoop` stops with the response and its tool calls intact when any call + is cut off, and `appendToolResult` appends a `ToolResultMessage` with + `isError = True` explaining why instead of calling the dispatcher. Previously + both assemblers replaced truncated arguments with `{}` and a tool loop + happily ran the call with no arguments at all. (REV-2 B.2.) + +- `baikai`: `Baikai.Model.anthropicMessagesCompatFor` no longer overlays a + thinking style guessed from the model id onto a model whose `compat` is + `CompatNone`. `CompatNone` now means host auto-detection alone — the budget + thinking shape, sampling parameters supported. Every catalog model carries an + explicit record, so this changes nothing for them; a **hand-rolled** model + naming an adaptive-era id (`claude-sonnet-5`, `claude-opus-4-7`, + `claude-opus-4-8`, `claude-fable-5`) must now carry + `CompatAnthropicMessages (defaultAnthropicMessagesCompat {thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False})` + or start from the catalog value. + +- `baikai`: `Baikai.Evidence.evidenceSchemaVersion` is now + `baikai.model-call-evidence/1.1`. A minor bump: the two sampling adjustment kinds are a + compatible addition, and no previously recorded digest changes. + +- `baikai`: HTTP 413 classifies as `ContextOverflow` rather than `OtherError`, + from the status alone and whatever the body says. 413 *is* the size-limit + status and the caller's remedy — shrink the input — is the same either way; + making the category depend on body wording would recreate for 413 the + inconsistency this release fixes for connection resets. (REV-2 A.7.) + +- `baikai`, `baikai-claude`, `baikai-openai`: an HTTP-date `Retry-After` is + converted to seconds instead of ignored. Both transports use the response's own + `Date` header as the reference instant, falling back to the local clock, so a + CDN-fronted `429` — the common case for a date-valued `Retry-After` — now + carries a hint rather than leaving the caller to guess. (REV-2 A.9.) + +- `baikai`: **breaking.** `Baikai.Embedding.EmbeddingModel.apiKey` is now + `Maybe ApiKeySource` rather than `ApiKeySource`. `Nothing` means the + conventional environment variable for the model's host, from + `defaultApiKeyEnvForBaseUrl` — the same table the chat providers use — and a + host that table does not know refuses with an `AuthError` naming + `EmbeddingModel.apiKey`. Migration: `apiKey = source` becomes + `apiKey = Just source`. `EmbeddingModel` also derives `Eq` and `Generic`, so + the `#field .~ value` idiom works on it as it does on every other record. + (REV-2 E.3.) + +- `baikai`: **breaking.** `AgentRunFailure`'s `RunTimedOut` constructor now + carries a new record `AgentTimedOut` — the configured `limit` plus the + `stdout` and `stderr` a timed-out run drained before its process group was + killed — instead of a bare `NominalDiffTime`. A caller matching + `RunTimedOut limit` becomes `RunTimedOut timedOut` and reads `timedOut ^. + #limit`; `renderAgentRunFailure` is unchanged in what it says. The bytes were + always there, drained from the moment the child was spawned, and were simply + dropped on the timeout path — which is the run an operator most wants an + account of, because the tool started, may have consumed tokens, and may + already have changed the working tree. + +- `baikai`: under `EvidenceRequired`, a successful terminal that carries no + evidence record fails the call with `missingEvidenceError` rather than + returning a silent success with zero `call_evidence` lines. Strict mode + guaranteed that a record which was built and then lost fails the call; it did + not guarantee that one was built. The rule is applied at both dispatch points, + so `completeRequest` with no sink gets the same guarantee as a streaming call; + a failed call keeps the provider's own error, and best effort is unchanged. + See `docs/adr/0014-strict-evidence-means-a-record-exists.md`. (REV-2 D.3.) + +- `baikai`: a caller's thinking level is recorded on every evidence path — the + consumer abort, an unregistered provider, a `complete` handler that threw, and + each provider's `immediateError`. The abort path asks the registered adapter's + own `describeThinking`; the others record `not_translated`. All four used to + record the caller's request as `absent`, which + `docs/adr/0002-requested-translated-observed-are-never-collapsed.md` forbids. + (REV-2 D.2.) + +- **`baikai.model-call-evidence/2.0`.** Two digests cover different bytes, so a + verifier must now select its rules by `schema_version`. `response_commitment` + covers the provider-reported token counts and never baikai's computed cost: + the cost comes from the caller's catalog rates rather than from the response, + so the digest used to change whenever a price was edited and a verifier + holding only the response could not recompute it. `request_configuration` + summarises `output_config` and `response_format` as it already summarised + `tools`, because a structured-output JSON schema carries author-written + `description` strings and is content wherever it appears — the same schema was + stripped from `tools[].input_schema` and survived verbatim through the other + two keys. `thinking.mode` may also now be `"not_translated"`, which is a + compatible addition. (REV-2 D.7, D.11.) + +- **Breaking.** `baikai`: `Baikai.Provider.Registry.ApiProvider` gains a fifth + field, `strengthCeiling :: EvidenceStrength`, and + `Baikai.Evidence.Build.checkEvidenceRequirements` takes that ceiling where it + took an `Api`. The gate compared against `declaredStrength`, a table keyed by + the API tag, which necessarily answered `EvidenceRequestedOnly` for every + `Custom` transport — so a gateway that genuinely observes a model could never + satisfy a strict caller who required that it did. Only a provider knows what + its evidence reaches. `EvidenceRequestedOnly` reproduces the old behaviour for + any custom provider; the four built-in providers fill the field from + `declaredStrength`, which is unchanged in value and still used by the + unattended-agent surface. (REV-2 D.10, G.1.) + +- `baikai`, `baikai-claude`, `baikai-openai`: one strength derivation replaces + three. An observed **response id** now counts as correlation alongside a + captured request-id header, so a host that names its model and its response id + on every chunk but sends no header reaches `model_observed` instead of + `requested_only` — which had put it *below* a host that sent only a header and + named nothing. `anthropicStrength` and `openaiStrength` are removed; + `Baikai.Provider.Cli.Internal.subprocessStrength` keeps its signature and + delegates. (REV-2 D.10.) + +### Removed + +- `baikai` **0.6.0.0** (breaking): the sixteen `_Type` base-value aliases deprecated in + 0.3.0.0 — `_Options`, `_Context`, `_Model`, `_ModelCost`, `_Response`, + `_Usage`, `_Cost`, `_CostBreakdown`, `_Tool`, `_TextContent`, + `_ThinkingContent`, `_ToolCall`, `_ImageContent`, `_EmbeddingModel`, + `_InteractiveLaunchRequest` and `_InteractiveLaunchResult`. Each has an + `empty…` or `zero…` replacement of the same value, named in the pragma that + has been on it since 0.3.0.0. The 0.3.0.0 entry said they remained "for this + release"; 0.4.0.0 and 0.5.0.0 shipped without removing them because no entry + named a version. + `docs/adr/0016-deprecated-names-are-removed-at-the-next-major.md` now fixes + the rule: a name deprecated in `A.B.0.0` is removed in `A.(B+1).0.0`, and + every pragma says so. (REV-2 G.3.) + +- `baikai` **0.6.0.0** (breaking): `Baikai.Trace.newEventId`. It has delegated to + `Baikai.Evidence.newCallId` since 0.5.0.0; call that. (REV-2 G.3.) + +- `baikai` **0.6.0.0** (breaking): `Baikai.Compat.defaultAnthropicThinkingStyle`, deprecated + earlier in this cycle. Nothing in baikai consults it — the thinking style of a + first-party Anthropic model is a field of its generated catalog record + (`Baikai.Models.Generated`); start from that value, or set + `CompatAnthropicMessages` explicitly. + +- `baikai` (breaking): `AgentRunRequest.envPassthrough` is renamed `envRequires`. + The field is a list of variables the job declares it requires, checked as a + precondition; it has never passed anything through, and the KDL key has said + `env-requires` since the setting existed. + +- `baikai` (breaking): `AgentRunFailure.OutputMalformed`, and with it + `baikai-agent`'s exit code 70 and its `internalExitCode` export. Nothing ever + constructed the constructor, and giving it a producer would have been wrong: + the runner treats the tool's output as best-effort observation and its + deliverable is the changed working tree, so a run that edited files correctly + and then printed an unparseable final line would have been reported as a + failure with its exit code and output discarded. A record's `strength` and + `unobserved` fields already say when output could not be read. (REV-2 F.13.) + +### Fixed + +- `baikai`: the terminal event and its evidence record are pushed to the trace + sink exactly once under asynchronous exceptions. The terminal path pushed the + evidence record, pushed the terminal event and only then set the + already-sent flag; an exception delivered between the last two made the + stream finaliser read the flag as unset and push a second `CallEvidence` and + an `aborted` `CallFailed` after the real `CallFinished`, so a sink saw two + records and two contradictory terminals for one call. All three writes now + run inside one `uninterruptibleMask_` with the flag first. (REV-2 D.4.) + +- `baikai`: `Baikai.Cost.Log.closeCallLog` is idempotent. The first caller + claims the handle and waits for the worker; a second returns at once instead + of blocking forever on an `MVar` the worker had already emptied — a shape + `withCallLog` makes easy to reach, since its bracket closes a handle the body + may also have closed. An `appendEntry` after the close enqueues nothing. + +- `baikai`: `reassembleResponse` is total under duplicated, late and + timestamp-less input. The first `EventStart` wins the skeleton and + `responseId` merges with `<|>`, so a later `Nothing` cannot erase an id an + earlier event supplied; events after the first terminal are ignored, so a + producer that keeps talking cannot rewrite the answer; and `latencyMs` falls + back to the reassembler's own wall clock when neither the skeleton nor the + terminal carries a provider timestamp, instead of reporting a zero that reads + as "instant". (REV-2 B.7.) + +- `baikai`: an `EmbeddingModel` pointed at a non-OpenAI host no longer sends + `OPENAI_API_KEY` to it. The default key source was that variable whatever the + base URL said, so pointing the client at DeepSeek handed DeepSeek an OpenAI + credential. It now resolves per host, and refuses an unknown one. New + `resolveEmbeddingKey` and `embeddingClientEnv` expose both decisions without + making a request. (REV-2 E.3.) + +- `baikai`: `Baikai.Embedding.embed` no longer allocates a TLS manager per call. + It used the `openai` SDK's own `getClientEnv`, which builds a fresh manager + every time; it now takes one from `Baikai.Http`'s process-global cache, the + same one the chat providers use, so an embedding call and a chat call to one + host share a connection pool. + +- `baikai`: **a credential in a header is no longer printed.** `Options.headers` + and `Model.headers` went through derived `Show` and `ToJSON` instances that + rendered every value verbatim — while `Baikai.Options`' own documentation + invites callers to put a gateway's `Authorization` header there and the + getting-started guide tells them to `print resp`, which renders the embedded + `Model`. Both types now have hand-written instances that render exactly what + the derived ones did, except that the value of a header whose name looks + credential-carrying (`authorization`, `api-key`, `apikey`, `token`, `secret`, + `cookie`, `password`, or any name ending in `-key`, case-insensitively) prints + as ``. `Baikai.Auth` exports the three pieces — `redactedMarker`, + `isCredentialHeader`, `redactHeaderValues` — so a caller can apply the same + rule to its own logging. Only the rendering changes: the field is untouched, + `Eq` is untouched, and the header is still sent as written. A JSON round trip + of a `Model` is deliberately lossy, since a serialised `Model` is exactly the + thing that should not carry a key. (REV-2 E.2.) + +- `baikai`: an API-key environment variable set to the empty string, or to + nothing but whitespace, now counts as **unset**. `ApiKeyEnv` fails with an + `AuthError` naming the variable and saying it is not set or is empty; + `ApiKeyEnvChain` skips it and continues, and reports every name when none + yields a key. Previously an empty variable resolved to an empty key, which + short-circuited a chain and produced `Authorization: Bearer ` and a provider + 401 that said nothing about the cause. A key with real content is still passed + through untrimmed. (REV-2 E.6.) + +- `baikai`: **the host parse no longer lets a base URL choose which key baikai + sends.** `urlHost` took the text after the *last* `@` anywhere in a URL, so + `https://proxy.example.com/v1?u=@api.openai.com` named the host + `api.openai.com`: `defaultApiKeyEnvForBaseUrl` resolved `OPENAI_API_KEY`, + `autoDetectOpenAICompletions` returned OpenAI's own compatibility record, and + the bearer token went to `proxy.example.com`. Anyone who could set `baseUrl` — + a `Model` decoded from JSON, a proxy override — could pick which provider's + credential to be handed. The same defect broke the benign direction: + `https://api.openai.com/v1/@x` named the host `x` and resolved no key at all. + The authority now ends at the first `/`, `?` or `#`, and userinfo is only ever + the last `@` inside it. (REV-2 A.1 / E.1.) + +- `baikai`: `Baikai.Evidence.Build.sanitizeEndpoint` was a second, separately + written parser that bounded the authority at the first `/` only, so a URL with + a query and no path recorded the wrong host. It is now `renderEndpoint <$> + parseUrl`, which also means a recorded endpoint has a lower-cased scheme and + host; the path keeps its case and trailing slash. + +- `baikai`: `parseCodexJsonlStream` assembles lines in **linear time**. It + previously unpacked every chunk into a stream of bytes and appended them one + at a time with `BS.snoc`, copying the whole accumulator per byte — quadratic + in line length, so one codex event carrying a two-million-character message + cost on the order of a trillion byte moves and in practice never finished. + Lines are now cut out of each chunk with `BS.elemIndex` and `BS.splitAt`, and + the pieces of a line that spans a chunk boundary are joined once. Behaviour is + unchanged: a non-JSON line is still skipped, and a last line without a + trailing newline is still parsed. + +- `baikai`: a Codex custom agent's instructions body renders as a TOML + **literal** multi-line string (`'''`), which interprets nothing, instead of a + basic one (`"""`), which interprets backslash escapes. As a basic string an + instruction as ordinary as "match `\d+`" made Codex refuse to load the file; + `tomllib` rejects the old output with `Unescaped '\' in a string`. A body a + literal string cannot hold — one containing three apostrophes, a bare carriage + return, or a control character other than tab and newline — falls back to a + fully escaped basic string. `tomlString`, which renders `name` and + `description`, now escapes every control character as TOML 1.0 requires + instead of only the five it happened to name. + +- Documentation: `baikai`'s Haddock no longer describes behaviour the code left + behind. The trace event's token counts are `Maybe` because a non-assistant + terminal has no usage, not because the CLI providers report nothing — since + 0.5.0.0 both carry what the tool reported. `EventStart`'s `partial` is a + message skeleton with empty content, zero usage and no stop reason; the api, + provider and model id live on the `Response`. A lifted stream's `EventStart` + carries the final usage and stop reason already filled in, because the + response is complete before the stream begins. `Baikai.CacheRetention` no + longer mentions an OpenAI Responses 24-hour bucket no code emits. System + prompts are documented as living on `Context.systemPrompt` rather than on a + `Baikai.Request` module that no longer exists, `emptyModel`'s `compat` is + described as auto-detection rather than a placeholder, tool dispatch says + calls run one at a time in order, and every reference to a plan number is + gone. (REV-2 H.4.) + +## [baikai-claude 0.6.0.0] - 2026-08-28 + +### Added + +- `baikai-claude`: `Baikai.Provider.Claude.Internal.Request` exports `planRequest`, + `SamplingPlan`, `uncappedMaxTokensFloor` and `normalizeToolCallId` as test seams. + `planThinking` and `describeThinkingFor` are now projections of `planRequest`, so the + strict gate, the request builder and the evidence record read one answer. + +### Changed + +- `baikai-claude`, `baikai-openai` (breaking): each provider's streaming + machinery moved from `Baikai.Provider.

.Api` to + `Baikai.Provider.

.Internal.Stream` — the `SseDriver` seam, `liveSseDriver`, + `

StreamWith`, `Assembler`, `emptyAssembler`, `translate`, and on the OpenAI + side `RawChunk`, `RawToolDelta`, `parseChunk`, `parseFrame`, `TagScanState`, + `scanThinkTags`, `closeOpenStream`, `RawUsage`, `parseUsage` and + `rawUsageToUsage`. `Api` now exports exactly `register`, the provider value + and the live stream function. The `.Internal` module is exposed for the test + suites and sibling packages and, like every `.Internal` module, may change in + any release without a major bump — so changing the assembler stops being a + documented break. `Shape`, `Sse` and `Transport` keep their names and gain the + same no-guarantees header. `_TagScanState` is renamed `emptyTagScanState`. + (REV-2 G.1.) + +- `baikai-claude`, `baikai-openai`: a consumer that stops reading now stops the + provider. Both packages fork their SSE worker under `Stream.bracketIO` and + hand frames through the bounded `FrameQueue` above instead of an unbounded + `Chan`. A consumer that cancels — `Ctrl-C`, `System.Timeout.timeout`, + `cancel` — releases the HTTP connection immediately; a consumer that abandons + the stream (`Stream.take 3`) stops the socket read within 64 further frames + and releases the connection at the next major garbage collection. Previously + the worker read the entire generation into memory for a consumer that would + never look at it, and the provider billed all of it. The three cleanup + strengths are stated in + [docs/adr/0010](docs/adr/0010-a-stream-consumer-that-stops-owns-cancelling-the-producer.md) + and in caller terms in `docs/user/streaming.md`. + +- `baikai-claude`: `anthropic_claude_sonnet_4_6` now sends the adaptive + thinking shape rather than `budget_tokens`. The budget shape is deprecated + for that generation; baikai sends the shape Anthropic documents as current. + +- `baikai-claude`, `baikai-openai`: **behaviour change.** `Options.timeoutMs` of + `Just n` with `n <= 0` is refused as `InvalidRequest` before the action runs, so + no connection is opened. `System.Timeout.timeout` returns immediately at zero + and runs unbounded below it, and the previous `max 0` clamp made both spellings + fail instantly as a *retryable* `TransientError` — a classification a caller's + retry loop re-issues forever for what is a configuration mistake. `Nothing` + remains the only spelling of "no bound". (REV-2 A.10.) + +- `baikai-claude`, `baikai-openai`: an evidence record's `endpoint` names the + host the call actually went to. Both adapters substitute a vendor default for + an empty `Model.baseUrl` inside `prepareCall`, so a call with a perfectly + definite destination recorded `endpoint: null`. Where no adapter ran, `null` + remains the truthful answer. (REV-2 D.8.) + +- `baikai-claude`: the `claude` dependency moves from `^>=1.4` to `^>=1.5`. + 1.5.0 adds a `Pause_Turn` constructor to `Claude.V1.Messages.StopReason`, and + `mapStopReason` matches that type with no wildcard under + `-Werror=incomplete-patterns`, so the bump forced a decision. A paused turn + maps to `Stop`: Anthropic suspends the turn mid-flight for a long-running + server-side tool and expects the caller to send the message back to continue + it, so nothing failed, and `Baikai.StopReason` has no constructor that says + "resume me". Widening that public sum is a breaking change for every consumer + who matches on it exhaustively, and it is not this bump's to make. The general + rule is + [ADR 0018](docs/adr/0018-a-provider-stop-reason-with-no-baikai-equivalent-maps-to-the-nearest-truthful-one.md): + a provider stop reason with no baikai equivalent maps to the constructor that + is truthful about whether the call failed, and the sum widens only when baikai + would behave differently for it. + +- `baikai-claude`: `Messages.StreamUsage` lost its `Generic` instance in `claude` + 1.5.0, so the `message_delta` usage is read through `OverloadedRecordDot` + rather than a generic-lens label. `Messages.max_tokens` and + `Messages.output_config` became ambiguous selectors — `Messages.Fallback` + carries both names — so the provider's tests read them through `^. #max_tokens` + and `^. #output_config` instead. + +### Removed + +- `baikai-claude`, `baikai-openai` **0.6.0.0** (breaking): the eight registration shims — + `registerWith`, `registerWithRegistry` and `registerWithRegistryAndConfig` in + both `Cli` modules, and `registerWithRegistry` in both `Api` modules. Register + the exported provider value instead: + `registerApiProvider (claudeCliProvider cfg)`, + `registerApiProviderWith reg (codexCliProvider cfg)`, + `registerApiProviderWith reg claudeMessagesProvider`. The batch-mode note that + had accumulated on `registerWith` — why `complete` stays on the direct path + rather than going through `streamingComplete` — moves to the provider value it + describes. (REV-2 G.3.) + +- `baikai-claude`, `baikai-openai`: `responseToError` and `classifyErrorText` + (and its private `classifySdkHttpText` half) from both + `.Internal.ErrorClass` modules. Neither package runs a `servant-client` client + on the chat path any more, so the `ClientError` branch was unreachable, and the + text classifiers parsed a string shape the local SSE transports stopped + producing in July. The phrase table `classifyErrorText` held survives as the + message fallback inside `classifyErrorFrame`, pinned through the entry point the + runtime actually uses. Both modules are documented as outside the PVP-stable + surface, so this is not a major bump; version bumps are recorded once, later. + +- **Breaking.** `baikai-claude`: `Baikai.Provider.Claude.Api.anthropicStrength` + and `baikai-openai`: `Baikai.Provider.OpenAI.Api.openaiStrength`, both replaced + by `Baikai.Evidence.deriveStrength`. + +### Fixed + +- `baikai-claude`, `baikai-openai`: a failure that lands while the response body + is streaming is classified as the transient failure it is. A connection reset, + a server closing the socket mid-chunk, a body shorter than its declared length + and a TLS session torn down after the handshake all now terminate the stream + with `TransientError` and `isRetryable = True`, carrying whatever text had + already been drained. Every one of them used to be `OtherError` with + `isRetryable = False`, while the identical failure at connect time was + transient — because `http-client` wraps the connect phase with the manager's + exception wrapper and the body reader with nothing that converts a socket + `IOException` or a `TLSException`, so those reached the worker raw and missed + the `HttpException` branch entirely. (REV-2 A.2.) + +- `baikai-claude`, `baikai-openai`: a transport failure mid-stream now closes + the blocks that were open when it arrived, on both providers, so a consumer + reading raw events and a consumer reassembling them see the same partial + output. Both providers built their terminal from the closed blocks alone and + silently dropped open text, thinking and tool arguments. On the Claude side + this covers `translate (Left …)`, the in-band `error` frame, and the + unexpected end of stream. (REV-2 B.3.) + +- `baikai-claude`: an SSE frame whose event `type` — or whose + `content_block_delta` `delta.type` — the SDK has no constructor for is now + skipped instead of ending the stream with a decode error. The SDK decodes both + with no unknown-tag fallback, so a new frame type from Anthropic used to be a + terminal fault. A frame of a *known* type that still fails to decode remains + one. `Baikai.Provider.Claude.Sse` exports the new `decodeFrame`. (REV-2 B.5.) + +- `baikai-claude`, `baikai-openai`: an empty `data:` heartbeat is ignored, and + on the OpenAI side `[DONE]` is compared after trailing whitespace is trimmed, + so `data: [DONE] ` and `data: [DONE]\r` end the stream rather than failing to + decode. (REV-2 A.8.) + +- `baikai-claude`: every failing stream now begins with `EventStart`. The + producer pre-seeds the start event before the first wire read, exactly as the + OpenAI producer already did, and `message_start` updates the assembler without + emitting a second one. Previously a 401, a rate limit, an in-band `error` + frame or an EOF arriving before `message_start` produced a lone `EventError`, + breaking the protocol `Baikai.Stream.Event` documents. `StartPayload.responseId` + is consequently `Nothing` on both HTTP providers; the provider's message id + rides `TerminalPayload.responseId`, which `reassembleResponse` already prefers. + (REV-2 A.4, REV-1 Theme 1.1.) + +- `baikai-claude`, `baikai-openai`: an asynchronous exception delivered to the + stream worker can no longer strand its consumer. End-of-frames is a flag set + by the worker fork's own `finally` rather than a sentinel value pushed onto + the channel, so a worker that dies without running its normal exit path still + ends the stream in an `EventError`. Previously the consumer blocked until the + runtime's deadlock detector noticed. + +- `baikai-smoke`: two keyed cases against `claude-sonnet-5` — one asking for + thinking (which is a 400 before this release) and one setting `temperature` — plus + `deepseek-chat` and `openrouter/openai/gpt-4o-mini` in `apiCases`, so the tool and + structured-output smokes run against a compatible host that is not OpenAI. + `CompatSmoke` now asserts DeepSeek honoured the output cap rather than only that it + answered, and `CacheSmoke` asserts the cached token classes cost something. + +- `baikai-claude`: a thinking request on `claude-sonnet-5` no longer 400s. It sends + `"thinking":{"type":"adaptive"}` and no `budget_tokens`, because the shape is read off + the model's catalog record rather than guessed from its id. (REV-2 C.1.) + +- `baikai-claude`: `temperature` and `top_p` are no longer sent to a model generation that + rejects them with a 400. They are omitted and the omission is recorded as + `sampling_dropped_unsupported_model` in the call's evidence. `seed`, `frequencyPenalty` + and `presencePenalty`, which the Anthropic Messages API has no field for on any + generation, are recorded as `sampling_dropped_unsupported_api`. (REV-2 C.1, C.5.) + +- `baikai-claude`: a model whose `maxOutputTokens` is `0` no longer sends + `"max_tokens":0`, which Anthropic rejects — and, with thinking set, no longer had its + whole thinking plan discarded for not fitting inside a ceiling of zero. It sends + `uncappedMaxTokensFloor` (1024, the SDK's own default) instead. An explicit + `maxTokens = Just 0` is still forwarded as written. (REV-2 C.2.) + +- `baikai-claude`: replay no longer sends an empty text block or an empty `content` array, + both of which Anthropic rejects. An empty text block is dropped; an assistant turn left + with nothing is dropped whole (it is baikai's own artifact — a block that closed with no + deltas, or only unsigned thinking, which replay already omits); a user turn left with + nothing is refused locally with a message naming the turn. (REV-2 C.3.) + +- `baikai-claude`: tool-call ids that differ only in characters the alphabet forbids, or + only past character 64, no longer normalise onto the same id and misroute a tool result. + A conforming id passes through unchanged — every id Anthropic and OpenAI actually mint + does — and any other is truncated to 51 characters and suffixed with twelve hex + characters of its SHA-256. Two `tool_use` blocks in one turn that still collide are + refused rather than sent. (REV-2 C.7.) + +- Documentation: `baikai-claude`'s and `baikai-openai`'s Haddock point at the + functions that exist. `Baikai.Compat` named + `Baikai.Provider.OpenAI.Api.mkOpenAIResponseFormat`, + `…Api.applyThinkingFormat` and `…Api.translateTextLikeDelta`; the first two + moved to `…Internal.Request` and the third is + `…Internal.Stream.scanThinkTags`. `ThinkingFormat`'s note said the six + non-native shapes all clamp through `compatibleEffort`; three do, Z.ai and + Qwen send a bare toggle, and `ThinkingFormatNone` drops the control. + `immediateError` carried two `-- |` headers where one was intended. + (REV-2 H.4.) + +- `baikai-claude`: an Anthropic call reports its thinking tokens. `Usage.reasoningTokens` + was hard-coded to `Nothing` on this provider because `claude` 1.4.0's + `Messages.Usage` had no breakdown to read; 1.5.0 adds + `output_tokens_details.thinking_tokens`, and both `message_start` and + `message_delta` now fill the field from it. `reasoningTokens` is an + informational subset of `outputTokens`, so no total and no cost moves. + +- `baikai-claude`: the prompt-side token counts survive a server-side tool run. + The final `message_delta` used to contribute only `output_tokens`, and + `inputTokens`, `cacheReadTokens` and `cacheWriteTokens` kept whatever + `message_start` had reported — which is wrong for a call whose prompt grew + mid-stream. `claude` 1.5.0 exposes those three on `Messages.StreamUsage`, and + each is now taken when present. An absent field still keeps the + `message_start` figure rather than zeroing it, so a model that sends only + `output_tokens` is accounted for exactly as before. + +## [baikai-openai 0.6.0.0] - 2026-08-28 + +### Added + +- `baikai-openai`: `Baikai.Provider.OpenAI.Internal.ErrorClass.classifyErrorFrame` + and `Baikai.Provider.OpenAI.Api.parseFrame`, which sort a decoded SSE payload + into a classified in-band error or a completion chunk. + +### Changed + +- `baikai-openai`: **breaking.** `Baikai.Provider.OpenAI.Shape`'s + `injectThinkingShape`, `describeThinkingShape`, `shapeRequestBody` and + `streamRequestBody` take a `Bool` after the compat record — whether the model + advertises reasoning support (`Model.reasoning`). A level on a `reasoning = False` + model now sends no `reasoning_effort`, `reasoning`, `thinking` or `enable_thinking` + key on any host, and records `thinking_dropped_unsupported_model` instead. The model + check runs before the host-format check. This is what stops `gpt-4o-mini` plus a + level from 400ing. (REV-2 C.4.) + +### Fixed + +- `baikai-openai`: an in-band `{"error": …}` frame on a `2xx` stream terminates + the call with the frame's own classification, status and message. Compatible + hosts (OpenRouter, DeepSeek, Together) report an upstream failure they only + learned about after committing to a `200` this way, and `parseChunk` never + looked at `error`. The pre-fix behaviour was worse than a bad category: + OpenRouter's frame carries `choices[0].finish_reason = "error"`, which mapped + to `Stop`, so the call ended as `EventDone` with `errorInfo = Nothing` — a + consumer switching on the terminal saw a *completed* call. A frame with no + `choices` beside the error ended as + `OtherError "openai stream ended without finish_reason"`. (REV-2 A.3.) + +- `baikai-openai`: reasoning that arrives after visible text closes the open + text block before opening the thinking block, so at most one of the two is + open at a time, every `_End` precedes the next `_Start`, and no `contentIndex` + is revisited after a later one. (REV-2 B.4.) + +- `baikai-openai`, `baikai-claude`: **a provider POST no longer follows + redirects.** `http-client`'s default is to follow up to ten with every header + intact, so a 3xx would have re-sent the bearer token (or `x-api-key`) to + whatever host the `Location` header named. `redirectCount` is now zero and the + 3xx is delivered as the one in-band terminal error carrying its status. Each + transport's request builder is exported as `buildRequest`, so the method, the + composed path and the redirect policy are assertable without a connection. + (REV-2 A.5 / E.4.) + +- `baikai-openai`, `baikai-claude`, `baikai`: **the base-URL convention is + stated and enforced.** `Model.baseUrl` and `EmbeddingModel.baseUrl` are the + API *root* — the host, or the prefix a host mounts the API under — because + baikai appends `/v1/chat/completions`, `/v1/messages` or `/v1/embeddings` + itself. A trailing `/v1` is accepted and removed rather than doubled, so + `https://api.deepseek.com/v1` now requests `/v1/chat/completions` instead of + `/v1/v1/chat/completions`. A base URL with no scheme, a scheme other than + `http`/`https`, credentials, a query string, a fragment, or a path that is + already an endpoint is refused as an `InvalidRequest` naming the problem — + and refused *before* a key is read, so an unusable base URL never causes a + credential to be looked up. The message renders the URL without its userinfo + or query, so it is safe to log. `docs/user/models-and-providers.md` gains a + **Base URLs** section stating all of it. (REV-2 A.6.) + +- `baikai-openai`, `baikai-claude`: the `ClientEnv` cache was duplicated in each + package and keyed on the raw base-URL text, so `https://h` and `https://h/` + were two TLS managers and two connection pools to one host. There is now one + cache, in `Baikai.Http`, keyed on the canonical rendering of the parsed base + URL. `Transport.getClientEnvCached` and `Transport.cachedClientEnvCount` are + re-exports of the core functions and keep their signatures. + +- `baikai-openai`: the Codex interactive launcher now **refuses the two approval + policies the installed CLI rejects**. `codex --help` at `codex-cli 0.149.1` + lists exactly `on-request` and `never` for `--ask-for-approval`; + `CodexApprovalUntrusted` and `CodexApprovalOnFailure` are older spellings the + CLI answers with `error: invalid value 'untrusted' for + '--ask-for-approval'`. Rendering them made a launch return `Right` carrying a + non-zero exit code — a session that ran and failed — instead of the `Left + SafetyNotExpressible` this module promises for a policy that cannot be + honoured. They are refused before any process is created, and refused rather + than quietly mapped onto `on-request`, because substituting a different + approval policy would change what the caller asked for. The constructors and + their spellings are unchanged, so code that matches on `CodexApprovalPolicy` + keeps compiling. + +## [baikai-trace-otel 0.4.0.0] - 2026-08-28 + +### Added + +- `baikai-trace-otel`: `OtelSinkOptions` derives `Generic`, so `#spanName` + resolves on it. No `Eq` or `Show`: `OpenTelemetry.Context.Context` has neither, + and an instance that ignored `parentContext` would be a lie. (REV-2 G.6.) + +- `baikai-trace-otel`: `OtelSinkOptions.parentContext :: Maybe Context`, default + `Nothing`. When set, every span the sink opens becomes a child of the span in + that context instead of a root, so a call can be nested under the caller's own + request span. It is a value fixed when the sink is built rather than an action + run per call, because the fold runs on baikai's trace worker thread where the + caller's thread-local context is invisible: capture the context on your own + thread (`ctx <- getContext`, or `Context.insertSpan mySpan Context.empty`) and + build the sink for that request. __Breaking for positional construction__ of + `OtelSinkOptions`; the documented path is a record update on + `defaultOtelSinkOptions`. (REV-2 D.9.) + +### Changed + +- `baikai-trace-otel`: the `baikai.evidence.strength` span attribute is rendered + by `Baikai.Evidence.renderEvidenceStrength`, the function the JSON encoding + uses, instead of a second spelling local to the sink that could drift from it. + +- `baikai-trace-otel`: `gen_ai.response.model` is set only by the evidence + branch, from the model the provider reported. The terminal branch set it from + the *requested* id, and since evidence is pushed before the terminal and + `addAttributes` replaces a key, that both labelled a request as an observation + on every call without evidence and overwrote the genuinely observed value on + every call with one. (REV-2 D.1.) + +## [baikai-effectful 0.4.0.0] - 2026-08-28 + +### Changed + +- `baikai-effectful` (breaking): the version is a **major** bump although this + package's own exports are unchanged. Its `baikai` bound moves to `^>=0.6.0`, + and the `Baikai` effect's three operations are typed in `Model`, `Context`, + `Options` and `Response` — every one of which baikai 0.6.0.0 changes + breakingly. A consumer therefore meets a break through this package even + though nothing in it was renamed, so the number says so rather than making + `0.3.0.4` look like a safe upgrade. + +- `baikai-effectful`: no longer depends on `streamly`. Both stanzas listed it + while every module imports only `Streamly.Data.Fold` and + `Streamly.Data.Stream`, which are `streamly-core`. (REV-2 minor.) + +## [baikai-kit 0.2.0.0] - 2026-08-28 + +### Added + +- `baikai-kit`: `Baikai.Kit.Error` with the closed `KitError` sum, its + `Exception` instance and `renderKitError`; `Baikai.Kit.Path.safeSourcePath`, + which resolves an untrusted relative source below the kit checkout and refuses + a symbolic link in any component or a canonical path outside the checkout; + `Baikai.Kit.Manifest.itemSources`/`ItemSources`, the one pure derivation of an + item's source list, and `supportedManifestVersions`; + `Baikai.Kit.Sidecar.hashEntries`; `Baikai.Kit.Repo.KitRepo`/`RepoRefresh`; + `Baikai.Kit.Install.installFrom`, `renderAvailable` and `UpdateReport`; + `Baikai.Kit.Status.StatusReport`, `UpstreamAvailability` and the now-pure + `renderStatusTable`; `Baikai.Kit.Command.runKitCommand`. `KitState` gains + `KitUpstreamRefused`, rendered `refused`. (REV-2 E.5, F.10, F.11.) + +- `baikai-kit`: `Baikai.Kit.Install.OverwritePolicy` (`KeepLocalEdits`, + `OverwriteLocalEdits`), `reinstallPresent` (the network-free half of + `updateKit`), and `PlannedWrite`/`WriteContent`/`executePlan`/`executePlanWith` + as a test seam. `SidecarMeta` gains `installedFiles` and `installedHash`, + which record what this tool wrote for one provider and the hash of exactly + those bytes; `newSidecarMeta` takes both. `kit update` gains `--force`. + (REV-2 F.12, Theme 8.2.) + +### Changed + +- **Breaking.** `baikai-kit`: every library function returns + `Either KitError a` and prints nothing; only + `Baikai.Kit.Command.runKit` prints `Error: …` and exits 1. `loadManifest`, + `loadManifestMaybe`, `installItem`, `listAvailable`, `uninstallItem`, + `updateKit` and `ensureKitRepo` change shape accordingly, `computeKitHash` + takes the kit root, a base and relative file names, `kitStatus` returns a + `StatusReport` instead of printing, and `KitUpdate`'s report is rendered by + the caller. See `docs/adr/0013-library-code-never-calls-exitfailure.md`. A + consumer that only calls `runKit` and `kitCommandParser` needs no change; one + that calls the library directly binds `Right`. (REV-2 F.11.) + +- `baikai-kit`: a kit is plain files. Install, the content hash and `kit status` + resolve every listed source through `safeSourcePath`, so a kit repository that + commits a symbolic link can no longer have a file read through it and copied + into a provider directory. `kit status` shows such an item as `refused`. + (REV-2 E.5 = F.10.) + +- `baikai-kit`: a manifest whose `version` is not 1 or 2 is refused with + `KitManifestVersionUnsupported` instead of being decoded and installed. + (REV-2 F.12.) + +- `baikai-kit`: an agent that lists several `files` installs all of them. The + first becomes the provider's agent file as before, and each remaining file + goes into a resource directory named after the agent beside it + (`//`), which uninstall removes with the agent. Only + the first file used to be installed. (REV-2 F.12.) + +- `baikai-kit`: `kit update` skips an item whose installed files no longer hash + to what its sidecar recorded, printing the `--force` invocation that would + overwrite them; `kit update --force` reinstalls anyway. Sidecars written + before this release carry no such hash and are updated without the check. + (REV-2 Theme 8.2.) + +### Removed + +- **Breaking.** `baikai-kit`: `Baikai.Kit.Path.safeUnder` (exported and unused), + `Baikai.Kit.Manifest.agentSources` (replaced by `itemSources`) and + `Baikai.Kit.Install.uninstallOutcomes` (absorbed by `uninstallItem`, which now + returns the outcomes for the caller to render). The internal `requireSafe` and + `Baikai.Kit.Status.resolveCacheOrEmpty` are gone with the exits they wrapped. + +### Fixed + +- `baikai-kit`: `kit status` with no cache and no network prints + `No kit items installed.` and exits 0. It used to exit 1: the guard around + `ensureKitRepo` caught `IOException`, which is not what `exitFailure` throws. + (REV-2 F.11.) + +- `baikai-kit`: `Baikai.Kit.Status.upstreamHash` joined the manifest `path` + without validating it, a second unsanitised join that grew after the July + hardening pass validated the first. Both now go through `itemSources` and + `safeSourcePath`. (REV-2 Theme 8.1.) + +- `baikai-kit`: an install that fails while renaming files into place now + restores what was there before, or names the paths it could not restore. + Phase two was a bare loop of renames, so a failure part-way left earlier + renames in place while the message said "no changes were made". Temporary + files are also created with `openTempFile`, so two concurrent installs of one + item no longer clobber each other's staging file, and a destination that is a + directory is refused before anything is written. (REV-2 F.12.) + +- `baikai-kit`: `Baikai.Kit.Install.stripYamlFrontmatter` normalises line + endings to LF on every branch. Input without frontmatter, and input whose + frontmatter is never closed, used to keep their `\r` characters and leak them + into the Codex agent TOML. (REV-2 Theme 8.7.) + +- `baikai-kit`: an `IOException` raised while reinstalling during `kit update` + is returned as `KitWriteFailed` instead of escaping as an uncaught exception. + (REV-2 Theme 8.4.) + +## [baikai-agent 0.2.0.0] - 2026-08-28 + +### Added + +- `baikai-agent`: three operator-only `policy` keys — `policy.allowed-tools`, + `policy.max-timeout` (a duration or `"unlimited"`) and + `policy.max-output-limit` (a byte count or `"unlimited"`) — each defaulting + from `defaultAgentCeiling`, and all six ceiling fields now printed by + `agent show` and carried in its `--json` object. + +- `baikai-agent`: `Baikai.Agent.Config.repositoryScopeViolations`, which reads + the resolution report to say which values the untrusted repository file was + not allowed to supply at all. `Baikai.Agent.Cli` concatenates its answer with + the pure ceiling's, so an operator sees one refusal naming every problem. + +### Changed + +- `baikai-agent` (breaking): `AgentConfigScope`'s constructors are + `AgentUserScope` and `AgentRepositoryScope`. `UserScope` collided with + `baikai-kit`'s `KitScope` constructor of the same name, the one clash between + two baikai-family packages. (REV-2 G.5.) + +- `baikai-agent` (breaking): a relative `working-dir` resolves against the + repository root rather than the process's own directory, so `working-dir "."` + means the checkout whichever file declared it. Resolving against the process + directory made `"."` mean two places when two documents defined one job, since + which one it was depended on which layer won. An absolute path is unchanged. + (REV-2 F.14.) + +- `baikai-agent` (breaking): every `--json` output is now built with `aeson` + rather than a hand-rolled writer, and `agent show --json` always emits one + object with the same seven keys — `job`, `outcome` (`shown`, `refused` or + `failed`), `exitCode`, `message`, `configuration`, `ceiling`, `command` — + with `null` for the parts that do not apply. Previously a refusal emitted a + different shape from a success and a document that would not parse emitted a + bare resolution report or nothing at all, so a reader had to know which + failure mode it was looking at before it could find the exit code. `run --json` + keeps its `outcome` values and `list --json` is unchanged. (REV-2 F.14.) + +- `baikai-agent` (breaking): `--run-id` or `--require-evidence` without either + `--evidence-file` or `--json` is now a usage error (64) naming both fixes. + Before, the record was built — a `--version` probe of the tool and two digests + — and then dropped. Under `--json` the record now travels in the envelope as + `evidence`, encoded by the same `ToJSON` `--evidence-file` writes. + +- `baikai-agent`: `agent show` and `agent run` no longer print another job's + unknown-key warnings, or the operator file's `policy` keys. The declaration + describes one job and the ceiling is a separate declaration, so `settei` warns + about both; neither is a mistake and a document with four jobs printed three + jobs' worth of noise on every run. A misspelled key inside the selected job + still warns, and a `policy` node in the *repository* document earns exactly one + notice saying it has no effect. `Baikai.Agent.Config` exports the two filters, + `relevantWarnings` and `repositoryPolicyNotice`. (REV-2 F.13.) + +- `baikai-agent`: an evidence record's `endpoint` resolves a relative executable + against the job's working directory before probing it, because that is what + the child execs. A job whose `executable` is `./bin/agent` previously reported + a path resolved against the parent's own directory, which does not exist. + `Baikai.Agent.Run` exports `executableForEvidence`. (REV-2 F.13.) + +- `baikai-agent`: a failed run's `error_info.message` keeps the last + `errorInfoStderrTailBytes` (4096) bytes of standard error, prefixed with how + many earlier bytes were dropped, instead of the whole captured stream — which + the output limit allows to reach four mebibytes by default. `Baikai.Agent.Run` + exports the constant. (REV-2 F.13.) + +- `baikai-agent`: `--evidence-file` stages through a uniquely named temporary + file created with `O_EXCL` beside the destination, instead of the destination + plus `.partial`. A symbolic link planted at the old, guessable name was + followed, which let an unattended run overwrite a file of the planter's + choosing. (REV-2 F.13.) + +- `baikai-agent` (breaking): an operator configuration file that lies inside the + repository root is refused with exit 78, naming the file and the root, and no + ceiling is established. The source list already refused the repository + *document*; this closes the shape where the repository supplies the *operator* + document, which both `--user-config .baikai/policy.kdl` and + `XDG_CONFIG_HOME=$PWD/.baikai` produce. `--user-config`, `XDG_CONFIG_HOME` and + `HOME` remain the operator's own inputs: the ceiling is exactly as trustworthy + as the process environment that selects it, and the guide now says so. + (REV-2 F.4.) + +- `baikai-agent` (breaking): an unrecognised key under the operator file's + `policy` node is an error rather than a warning, naming the file and every + such key. Everywhere else a forward-compatible file should not stop an older + binary; under `policy` a misspelling would silently leave the default ceiling + in force, which for the one node whose purpose is limiting authority is + indefensible. Two `AgentConfigError` constructors are added, + `CeilingFileInsideRepository` and `UnknownPolicySetting`. + +- `baikai-agent` (breaking): `AgentConfigPaths` gains `repositoryRoot`, the + directory the process runs in. `--config PATH` chooses which file supplies + repository-scope settings and does not move the root, because the root is what + confines a repository-supplied `working-dir`. + +- `baikai-agent` (breaking): a repository configuration file may no longer set + `executable` or a non-empty `extra-dirs`, and its `working-dir` must resolve — + after following symbolic links — inside the repository root. Each is refused + with exit 77 naming the setting, or naming both directories. The operator's + own file and `--set` may still set all three. `executable` turns configuration + into code execution with the operator's environment and the prompt on standard + input; `extra-dirs` inside the root adds nothing the working directory does not + already give, so the only ones a checkout would ask for are outside it. + (REV-2 F.3.) + +### Removed + +- `baikai-agent` (breaking): the `BAIKAI_AGENT_EXECUTABLE` environment binding. + An environment variable is inherited by every child process and is easy to set + by accident, and naming the program to run is the widest widening there is. + An operator whose installation is not on `PATH` writes `executable` in their + own configuration file or passes `--set`. + +### Fixed + +- `baikai-agent`: a timed-out run now **escalates to `SIGKILL`**. The runner + interrupts the child's whole process group, then terminates it, then kills it, + each of the first two stages bounded by the grace period and ended early once + the leader has been reaped and no member of the group is left. Previously the + last resort was `terminateProcess` followed by an *unbounded* wait, so a + coding agent that ignored `SIGTERM` — or a grandchild holding the output pipe + — hung the run for as long as it chose to live, with the deadline already + past. Polling the group rather than waiting on the leader alone is also what + gives a grandchild the same grace the agent gets. + +- `baikai-agent`: a timed-out run **reports the output it drained**. `baikai + agent run` prints it under the same stream discipline a finished run gets, so + `response=$(baikai agent run job)` under `capture` receives the partial answer + with `$?` set to 75, and `--json`'s failure envelope carries the same + `stdout`, `stdoutTruncated`, `stderr` and `stderrTruncated` fields. A drain + interrupted because something outside the process group still held the pipe + open keeps its bytes too, reported as truncated. + +- `baikai-agent`: the `baikai` command writes its output as **UTF-8 bytes** + rather than through the locale encoding. Where an unattended run actually + happens — cron, a systemd unit, a container — the environment says `LANG=C`, + and on a platform whose locale encoding follows it a single accented character + in the agent's answer made the write throw after the run had already finished: + exit 1, answer lost. This mirrors what the prompt read and the prompt write + have always done. + +- `baikai-agent`: the `baikai` executable now links the **threaded runtime** + (`ghc-options: -threaded` on the `executable baikai` stanza). Without it a + blocking operating-system call — the `waitpid` inside + `System.Process.waitForProcess` — stopped every Haskell thread in the + installed binary, so a job's configured `timeout` could never fire and a + coding agent that wrote more than one pipe buffer deadlocked against the + runner's drain threads. Both defects existed only in the shipped executable: + the test suite was already compiled `-threaded`, so every runner test passed + under a runtime the binary did not have. + + The suite now proves the runtime the binary ships with rather than its own. + `baikai-agent/test/BinaryTests.hs` spawns the built executable — cabal builds + it first and puts it on the suite's `PATH` through + `build-tool-depends: baikai-agent:baikai` — asserts that `baikai +RTS --info` + reports `rts_thr`, and runs `baikai agent run` against a stub agent that + outlives its deadline, requiring exit 75 within seconds and the whole process + group gone. See + [docs/adr/0006](docs/adr/0006-a-process-spawning-executable-ships-on-the-threaded-runtime.md). + +## [baikai 0.5.0.0] - 2026-08-05 + +### Added + +- `baikai`: new exposed module `Baikai.Agent`, the provider-neutral vocabulary + for an **unattended coding-agent run** — a run with no terminal and no human, + which owns its own tool loop, may change files inside directories the caller + authorized, and returns a process result rather than a `Response`. It defines + `AgentRunRequest` (with a required `workingDir`), `AgentRunResult`, the + `AgentCapability` profile (`read-only`, `edit-workspace`, `full-access`), + `AgentSafety`, the `AgentOutputMode` and `AgentCapturedOutput` output + discipline, the `AgentCommand` renderer/runner boundary with an explicit + prompt transport, and the `AgentRenderError` / `AgentRunFailure` taxonomies. + +- `baikai`: the operator policy ceiling — `AgentCeiling`, + `defaultAgentCeiling`, `CeilingViolation`, and the pure `applyAgentCeiling`. + It returns a request unchanged when it is within the ceiling and reports + every violation when it is not; it never clamps an over-broad request to the + permitted value. The default ceiling permits read-only and edit-workspace + authority and refuses full access and raw provider arguments. + + `Baikai.Agent` itself is vocabulary and pure policy algebra only: it spawns no + process and renders no command-line flags. Those live in the vendor packages + and in `baikai-agent`, below. The module is deliberately not re-exported from + the umbrella `Baikai` module, because its field accessors share names with + `Baikai.Interactive`, so `import Baikai` continues to compile unchanged. + +- `baikai`: new exposed module `Baikai.Evidence`, the vocabulary for + **verifiable model-call evidence** — a record of what actually crossed the + boundary to a provider, as opposed to what the process was configured to ask + for. It defines `ModelCallEvidence` and the `evidenceSchemaVersion` string + consumers pin against, `Observed` (a deliberate non-`Maybe` for a value the + provider either did or did not report, with no function that supplies a + default), `ThinkingTranslation` with its `ThinkingMode` and + `ThinkingAdjustment` enumerations describing what a requested + reasoning-effort level actually became on the wire and every clamp, collapse, + or drop applied on the way, `EndpointIdentity` and `TransportKind`, + `CallStatus`, and the ascending `EvidenceStrength` scale. + + It also provides the canonical hashing core: `canonicalEncode` gives a JSON + value exactly one byte representation (object keys sorted, no insignificant + whitespace, numbers normalised so `1`, `1.0`, `1.00`, and `1e0` all encode as + `1`, and a hand-written string escaper so an aeson upgrade cannot silently + invalidate a recorded digest); `commitmentDigest` hashes a full request + envelope, and `configurationDigest` hashes an allow-list projection + (`configurationProjection`) that keeps configuration and replaces content with + structural summaries, so two calls that ask the same model the same way about + different subjects agree. The two digests are separate on purpose: the first + binds a record to a particular request, the second is safe to compare across + runs that legitimately differ in content. + + Nothing constructs a `ModelCallEvidence` from a real call yet, and no existing + behaviour changed. New dependencies: `cryptohash-sha256` and + `base16-bytestring`, both single-purpose packages chosen over a full + cryptographic framework. + +- `baikai`: `Options` gains an `evidence` field carrying an optional + `EvidenceRequest` — the caller's run identifier, retry provenance, and how + strictly they need evidence. A call whose `evidence` is `Nothing`, which is + every call that does not opt in, behaves exactly as it did before: no digest + is computed and no evidence is emitted. + +- (Entry added 2026-08-27; the behaviour shipped in 0.5.0.0.) `baikai`: **strict + evidence mode**. `EvidenceStrictness` is `EvidenceBestEffort` or + `EvidenceRequired !EvidenceStrength`, and a caller who asks for the second + gets a call that **refuses to start** — before any request is built or any + connection opened — when the configuration cannot reach the strength asked + for: `Baikai.Evidence.Build.checkEvidenceRequirements` compares the + requirement against what the provider can deliver and against the thinking + translation, and `completeRequest` / `streamRequest` return an error-shaped + response or a terminal `EventError` instead of dispatching. The gate is + pre-dispatch by design; that is the only point at which refusing is still + free. + +- (Entry added 2026-08-27; the behaviour shipped in 0.5.0.0.) `baikai`: + **sink-failure semantics under strict mode**. `Baikai.Evidence.Build` + exports `onSinkFailure`, `sinkFailureIsFatal` and `sinkFailureError`: a trace + sink that throws fails an `EvidenceRequired` caller's call, because a record + the sink did not confirm written is not a record, while a best-effort caller's + call succeeds with the failure reported on stderr. + +- (Entry added 2026-08-27; the behaviour shipped in 0.5.0.0.) **Breaking.** + `baikai`: `Baikai.Provider.Registry.ApiProvider` gained a fourth field, + `describeThinking :: Model -> Options -> ThinkingTranslation`, which the + pre-dispatch strictness gate calls to learn what a provider would do with the + caller's reasoning-effort request without sending anything. Every third-party + provider constructed with the `ApiProvider` constructor stopped compiling. + This was not recorded at the time; it is the defect that made 0.6.0.0 hide the + constructor behind `apiProvider` so that the next field addition is a minor + release. + +- `baikai`: model-call evidence is now **produced and emitted**. A caller who + sets `Options.evidence` gets exactly one `call_evidence` line per call from + their trace sink, under every way a call can end: success, provider failure, a + consumer that abandons the stream (status `aborted`, not `failed` — an abort + is the consumer's doing and reporting it as a provider failure would + misattribute it), and dispatch that found no registered handler. + + New exposed module `Baikai.Evidence.Build` bridges the vocabulary to the + `Model` and `Options` records: `minimalEvidence` and `prepareEvidence` build a + record, `dispatchEnvelope` supplies the request envelope for the paths where + no adapter ran, `sanitizeEndpoint` reduces a base URL to scheme/host/port/path + with the query string and any userinfo dropped wholesale, and `onSinkFailure` + is the hook a future release replaces to make a strict caller's call fail when + the trace sink does. + + Every record this release produces has `strength` `requested_only` and every + provider-observed field set to `"unobserved"`. That is not a placeholder: it + is a truthful record for a transport that has not yet been taught to observe + anything. Later releases teach each transport to observe more. + + (Correction added 2026-08-27: the two paragraphs above describe the release + inaccurately and are kept as shipped rather than rewritten. `onSinkFailure` + did not await a future release — it shipped in 0.5.0.0 together with + `sinkFailureIsFatal` and `sinkFailureError`, which already fail a strict + caller's call when the sink throws. And not every 0.5.0.0 record has `strength` + `requested_only`: the provider entries below describe what each transport + reports, and the HTTP adapters reach `correlated` and `model_observed`.) + + **A caller who does not opt in pays nothing.** With `Options.evidence` absent + no digest is computed, no call identifier is generated, no evidence event is + emitted, and the request envelope is never even forced — the gate lives inside + the shared builder rather than at each adapter's call site, and the envelope + parameter is deliberately lazy. Both facts are guarded by tests. + +- `baikai`: `TraceEvent` gains a `CallEvidence` constructor, encoded as + `{"kind":"call_evidence", …}`. A consumer whose pattern match over `TraceEvent` + is exhaustive must add a branch; one with a wildcard is unaffected. Filter for + it with `jq 'select(.kind == "call_evidence") | .evidence'`. Note that a trace + line carries its fields alongside the `kind` discriminator rather than nested + under a `data` key, and that the evidence record inside spells its own fields + in snake_case — the two encodings differ deliberately, because an evidence + record must render an absent field as explicit `null` while a trace line drops + it to stay small. + +- `baikai`: `Baikai.Provider.Cli.Internal` — the module the two subprocess + providers share — gains the vocabulary for reading what a coding-agent CLI + reported about its own run. `CodexRunReport` and the new + `parseCodexJsonlStream :: Stream IO ByteString -> IO CodexRunReport` fold the + `codex exec --json` event stream into its assistant text, its thread + identifier, and its token counts, instead of concatenating agent-message text + and discarding everything else. `ClaudeCliReport` and + `decodeClaudeCliResult` do the same for `claude -p --output-format json`. + Every field but the message text is optional, because both tools' event + schemas have changed across versions and an absent field is a genuine absence + rather than a parse failure. **Breaking** for anyone calling + `parseCodexJsonlStream` directly: its result type is no longer `Text`. This is + an internal module and is documented as outside the PVP guarantee. + +- `baikai`: `Baikai.Provider.Cli.Internal` also gains `ExecutableIdentity` and + `executableIdentity`, which resolve a configured executable name to an + absolute path and read the tool's own `--version` line. The probe is cached + per resolved name for the lifetime of the process, because spawning it per + model call would roughly double the process cost of the cheapest possible + call, and it is bounded by a five-second timeout so a tool that hangs on + `--version` cannot wedge a model call. (Corrected 2026-08-27: the entry said + two seconds; `versionProbeMicros` has always been five.) A probe that fails records the version + as absent rather than failing the call. It is only ever called from inside + the evidence branch: a caller who asked for no evidence must not pay for a + process whose only purpose is to describe a tool they were about to run + anyway. + +- `baikai`: `subprocessStrength` and `cliResponseEnvelope`, also in + `Baikai.Provider.Cli.Internal`. The former derives a subprocess call's + evidence strength from what the tool reported and **nothing else** — the exit + status is deliberately not one of its arguments. The latter spells the + response-commitment envelope with the same three keys, in the same shapes, as + the two API transports build by hand, so a verifier holding a response can + recompute the digest without first knowing which transport served it. + +- `baikai`: `Baikai.Agent` gains `AgentRunOutcome` and `agentRunOutcome`. It + pairs what an unattended run did — the existing + `Either AgentRunFailure AgentRunResult` — with the evidence the runner built + for it. The evidence is a sibling of the outcome rather than a field on + `AgentRunResult` because the run that most needs a record is one that did not + produce a result: a run killed by its own timeout reports + `Left (RunTimedOut …)`, so a record hanging off the `Right` would be + unreachable exactly there. + +### Fixed + +- `baikai`: a `call_evidence` event is now emitted **before** its call's + terminal `call_finished` or `call_failed`, rather than after. The + OpenTelemetry sink ends and removes a call's span on the terminal, so under + the old order its evidence-attribute branch was unreachable from any real + call and every backend saw a span with no evidence on it — nothing failed, + the attributes were simply never there. No consumer can have depended on the + old order, because no consumer has ever seen a `call_evidence` line. + +- `baikai`: the `ThinkingFormatOpenAI` Haddock in `Baikai.Compat` listed the + native `reasoning_effort` vocabulary as `minimal | low | medium | high`, which + predates `xhigh` and `max`. It now lists all six and states that this shape + alone sends the canonical baikai level verbatim while the other six clamp + through `compatibleEffort`. No behaviour changed: the native path's exclusion + from that clamp is deliberate and is guarded by two named tests in + `baikai-openai/test/ShapeSpec.hs`. A reader who consulted the comment to + decide whether `xhigh` was safe to use against OpenAI has until now been told + something untrue. + +### Changed + +- **Breaking:** `baikai`: `TerminalPayload` gains an `evidence` field and the two + terminal smart constructors take it as their new first argument: + `doneTerminal :: Maybe ModelCallEvidence -> Maybe Text -> StopReason -> Message -> TerminalPayload` + and `errorTerminal` likewise. `Response` gains the same field. A custom + provider implementation must pass `Nothing` (or a record it builds through + `Baikai.Evidence.Build`); a custom `Response` built with the record + constructor must add `evidence = Nothing`. Code that only pattern-matches on + these types is unaffected. + +- **Breaking:** `baikai`: `CallFinished` gains `cachedInputTokens`, + `cacheWriteTokens`, `reasoningTokens`, and `totalTokens`. The trace path used + to drop counts that `Baikai.Cost.Log.CallLogEntry` kept from the same `Usage` + value, which made the cost log strictly more faithful than the trace. + +- **Breaking:** `baikai`: a computed cost of **zero is now reported as zero** + rather than suppressed, in `CallFinished` and at all three `CallLogEntry` + construction sites. Previously `usd` was omitted whenever the cost came out at + zero, so "this call was free" and "baikai could not price this call" were + indistinguishable — and the subscription-based CLI providers always price at + zero, so that was the common case rather than a corner. **A cost dashboard + that treated an absent `usd` as "unpriced" will now count those calls as + costing zero.** That is the correct reading, but it changes what such a + dashboard shows. + +- **Breaking:** `baikai`: `FromJSON TraceEvent` is written out by hand instead of + derived. The three pre-existing kinds decode exactly as before; a + `call_evidence` line fails to parse with a message saying to read it as a + plain `Data.Aeson.Value`. `ModelCallEvidence` has no `FromJSON` on purpose — + it embeds a `Cost` whose exact `Rational` amounts encode through an + approximating `Scientific`, so a decoder would return a different value than + was encoded — and manufacturing that fidelity would be the precise failure + this vocabulary exists to eliminate. + +- `baikai`: `Baikai.Trace.Sink.renderHuman` renders a `CallEvidence` event as a + single `EVIDENCE run=… call=… strength=…` line rather than the whole record. A + human-readable sink is for watching calls go by; the full record is meant to + be read out of `fileSink` output by a machine. + +- `baikai`: call identifiers on the trace path are now globally unique. + `Baikai.Evidence.newCallId` produces 32 lowercase hexadecimal characters + carrying 128 bits — 48 bits of Unix time in milliseconds, 48 bits of a + per-process random seed drawn once from `/dev/urandom`, and a 32-bit counter. + The previous generator combined the process-start *second* with a + process-local counter into 16 characters, so two processes started within the + same second emitted identical identifier sequences; its own documentation + claimed only per-process uniqueness. Identifiers still sort chronologically + and are still not secrets. + + `Baikai.Trace.newEventId` keeps its name and signature, delegates to + `newCallId`, and is now deprecated. Anything that pinned the 16-character + width — a log parser, a fixture, a column type — must widen to 32. + +- `baikai`: `renderCeilingViolation` no longer prints the raw provider arguments + a `ProviderArgsForbidden` violation carries. It reports how many were + requested and states that their values are not shown. Raw provider arguments + are the one part of a job description that can hold a credential — the + configuration layer classifies the setting secret for that reason — and a + refusal message that quoted them defeated the classification. The constructor + keeps its `[Text]` payload so a programmatic caller can still inspect it. + +## [baikai-claude 0.5.0.0] - 2026-08-05 + +### Added + +- `baikai-claude`: new exposed module `Baikai.Provider.Claude.Agent` with + `ClaudeAgentConfig`, `defaultClaudeAgentConfig`, and `claudeAgentCommand`, a + pure renderer from an unattended `AgentRunRequest` to the `claude` argument + vector. It maps the capability profile onto `--permission-mode` + (`plan` / `acceptEdits` / `bypassPermissions`), joins a tool allow-list into + one `--allowedTools` argument, repeats `--add-dir` per extra directory, always + emits `-p`, and emits `--no-session-persistence` unless `persistSession` is + set. The prompt travels on standard input and appears nowhere in the argument + vector. A request naming a different provider is refused with + `ProviderMismatch`. Nothing is spawned. + +- `baikai-claude`: the Anthropic Messages provider now fills in the evidence + record it previously left blank. It records the model **Anthropic reported + running** (read from the `message_start` event, which the adapter already + decoded for the response id and then discarded), Anthropic's `request-id` + correlation header, the response id, the token counts Anthropic actually + reported, and a commitment digest over the assembled response. A field the + provider did not report stays `"unobserved"` and is never backfilled from the + request — in particular, a stream that fails before `message_start` reports no + observed model at all. `strength` is `model_observed` when both the model and a + correlation identifier arrived, `correlated` when only the identifier did, and + `requested_only` otherwise; a 2xx status never raises it, because a 200 means + the request was accepted, not that any particular model ran. + `fully_observed` is unreachable on this transport, since Anthropic does not + echo the thinking configuration it applied. + +- `baikai-claude`: an evidence record's `thinking` field now describes what the + caller's reasoning-effort preference actually became on the wire, including + three downgrades that were previously invisible everywhere in baikai's output: + asking for thinking on a model that does not advertise `reasoning` + (`thinking_dropped_unsupported_model`); asking for a level whose token budget + does not fit under the resolved output-token ceiling + (`thinking_dropped_budget_exceeded`, carrying both colliding numbers), which is + reachable by lowering `maxTokens` alone; and asking for `high` on an + adaptive-thinking model, which sends no effort field and so is + wire-indistinguishable from taking Anthropic's default depth + (`effort_omitted`). `minimal` on an adaptive model reports `effort_clamped`, + because Anthropic's adaptive vocabulary has no `minimal`. + +- `baikai-claude`: new exports from `Baikai.Provider.Claude.Sse` — + `ResponseMetadata` and `capturedHeaderNames` — and from + `Baikai.Provider.Claude.Api` — `claudeMessagesStreamWith`, `SseDriver`, and + `anthropicStrength`. Response-header capture is an **allow-list** + (`request-id`, `x-request-id`, `cf-ray`, in that preference order), not a + denylist, so a header a future gateway adds is not recorded by default. + +- `baikai-claude` and `baikai-openai`: both subprocess providers now fill in the + evidence record they previously left blank, and both export the translation + function that describes it — `claudeCliThinking` and `codexCliThinking`. They + record the session or thread identifier the tool reported, the token counts it + reported, the model it named when it names one, the resolved executable path + in place of an endpoint URL, the tool's own `--version` string as the + implementation version (for this transport the tool *is* the implementation), + a request commitment over the rendered argument vector, and a response + commitment over the assembled answer. + + **A zero exit status never raises the strength.** A coding-agent CLI that + exits zero has demonstrated that it ran and did not crash; it has not stated + which model served the request. Subprocess calls almost always exit zero, so + encoding that as corroboration would make the weakest evidence in the system + look like the strongest. `strength` is `model_observed` only when the tool + named both an identifier and a model, `correlated` when it named only an + identifier, and `requested_only` otherwise. + + The two transports differ in how far they can get. `claude` names the model + that consumed tokens in its result event's `modelUsage` map, complete with a + context-window variant marker such as `[1m]`, so a Claude CLI run can reach + `model_observed`. `codex-cli 0.146.0` names no model anywhere in its event + stream, so **no** Codex CLI run can exceed `correlated` — backfilling the + `--model` flag baikai passed would report the request as an observation. + +- `baikai-claude`: an evidence record's `thinking` field now describes what a + reasoning-effort request became on the `claude` command line: mode `flag`, + wire field `--effort`, and an `effort_clamped` adjustment recording the + `minimal` → `low` collapse, because the tool's `--effort` flag has no + `minimal`. A caller asking for `minimal` and a caller asking for `low` produce + byte-identical argument vectors — and therefore identical request commitment + digests — so the translation is the only place that difference survives. + +- **Breaking:** `baikai-claude` and `baikai-openai`: `claudeAgentCommand` and + `codexAgentCommand` return `(AgentCommand, ThinkingTranslation)` rather than + `AgentCommand`. The runner deliberately imports no vendor renderer, so it + cannot derive the translation and has to be handed it. A caller that only + wants the command writes `fmap fst`. Both modules also export the translation + function alone — `claudeAgentThinking` and `codexAgentThinking` — for asking + what a level would become without rendering anything. + +### Fixed + +- **Loud:** `baikai-claude` and `baikai-openai`: both subprocess providers + hardcoded `usage = zeroUsage` on every call, so a cost dashboard saw every + `claude -p` and `codex exec` call as consuming no tokens and costing nothing. + Both tools report their own token counts and baikai now carries them through, + normalized into the disjoint `Usage` convention: `claude`'s counts are + Anthropic-shaped and already disjoint, while `codex` reports OpenAI-style + inclusive prompt counts, so its cached tokens are subtracted out of + `inputTokens`. `claude` additionally reports a `total_cost_usd`, which now + populates `Usage.cost` exactly rather than being reported as zero. + + **A dashboard that read these calls as free will now see real tokens and, for + `claude`, a real cost.** That is the correction, not a regression — but it + changes what existing reports show, and totals over historical data will not + match totals over new data. + +- `baikai-claude`: `Response.responseId` was always `Nothing` on the `claude -p` + transport even though `ClaudeCliResult` decoded the tool's `session_id` one + screen earlier and then dropped it. It now carries that identifier, on both + the successful and the failed terminal. `baikai-openai`: the same for + `codex exec`, whose thread identifier was filtered out of the event stream + along with everything that was not an `agent_message`. These are the handles + each vendor's support tooling looks a run up by. + +### Changed + +- **Breaking:** `baikai-claude`: `Baikai.Provider.Claude.Sse`'s four streaming + entry points — `claudeSseStream`, `claudeSseStreamValue`, + `claudeSseStreamValueWithHeaders`, and `sseFromResponse` — take a new + `ResponseMetadata -> IO ()` callback immediately before the existing per-event + callback. It fires exactly once, before the first event, on both the success + and the non-2xx path. Pass `(\_ -> pure ())` to keep the previous behaviour. + The callback is separate rather than a widening of the per-event one because + the per-event callback runs once per SSE frame and response-level data does not + belong on that path. + +- **Breaking:** `baikai-claude`: `Baikai.Provider.Claude.Internal.Request`'s + `mapRequest` now returns + `Either Text (Messages.CreateMessage, ThinkingTranslation)` and + `computeThinking` returns `(ThinkingPlan, ThinkingTranslation)`. Take `fst` to + keep the previous value. This module is exposed for provider tests and + debugging and its header states it is not covered by PVP compatibility + guarantees, but the change is recorded here because that is not a licence to + break a consumer silently. + +- **Breaking:** `baikai-claude`: `claudeInteractiveCommand` now returns + `Either AgentRenderError (FilePath, [String])` and `launchClaudeInteractive` + returns `IO (Either AgentRenderError InteractiveLaunchResult)`. A request + whose `safety` is a `CodexSandbox` policy — which Claude Code cannot express + — is refused with `SafetyNotExpressible AgentClaude`, naming the rejected + sandbox mode and approval policy and suggesting `ClaudeAllowedTools` or + `DefaultSafety`. Previously the policy was silently discarded and an + **unrestricted** Claude session was started and reported as a success. A + `Left` means no process was started; a `Right` with a non-zero exit code + means the session ran and exited non-zero. `DefaultSafety` and an empty + `ClaudeAllowedTools` list still render no safety flag and are never refused, + and no previously rendered argument vector changed. Callers must handle the + refusal branch. + +## [baikai-openai 0.5.0.0] - 2026-08-05 + +### Added + +- `baikai-openai`: new exposed module `Baikai.Provider.OpenAI.Agent` with + `CodexAgentConfig`, `defaultCodexAgentConfig`, and `codexAgentCommand`, the + same renderer for `codex exec`. It maps the capability profile onto + `--sandbox` (`read-only` / `workspace-write` / `danger-full-access`), emits + `--cd` for the working root, and defaults `--skip-git-repo-check` and + `--ephemeral` on. A request carrying a tool allow-list is **refused** with + `UnsupportedToolRestriction`, because `codex exec` has no such flag and running + it with unrestricted tools would grant more authority than the caller asked + for. Nothing is spawned. + +- `baikai-openai`: an evidence record's `thinking` field now describes what the + caller's reasoning-effort preference became on the wire for the specific host + the call went to, across **all seven** OpenAI-compatible wire shapes. The + OpenAI-native shape sends the canonical level verbatim and records no + adjustment, because it expresses every level exactly. The four shapes that + carry an effort word for a non-native host record `effort_clamped` whenever + the word differs from the canonical name — `minimal` becomes `low`, and both + `xhigh` and `max` become `high`. Z.ai and Qwen accept a bare + `enable_thinking: true` with no depth, so **every** level records + `effort_collapsed_to_toggle`: a caller asking for `max` and a caller asking + for `low` produce byte-identical requests there, and only the evidence record + can tell them apart. A host with no reasoning controls records + `thinking_dropped_unsupported_host` where the option previously vanished with + no trace. A forty-two-row table test pins the translation and the shaped + request body for every shape at every level. + +- `baikai-openai`: the Chat Completions provider now fills in the evidence record + it previously left blank. It records the model **the host reported running** + (read from the first streamed chunk carrying a top-level `model` field and + never overwritten by a later one), the host's `x-request-id` correlation + header, the response id, the token counts the host actually reported, and a + commitment digest over the assembled response. A field the host did not report + stays `"unobserved"` and is never backfilled from the request — in particular, + a call that fails before any chunk arrives reports no observed model at all. + `strength` is `model_observed` when both the model and a correlation + identifier arrived, `correlated` when only the identifier did, and + `requested_only` otherwise; a 2xx status never raises it, because a 200 means + the request was accepted, not that any particular model ran. + `fully_observed` is unreachable on this transport, since no host in this + ecosystem echoes the reasoning configuration it applied. + +- `baikai-openai`: new exports from `Baikai.Provider.OpenAI.Sse` — + `ResponseMetadata` and `capturedHeaderNames` — and from + `Baikai.Provider.OpenAI.Api` — `openaiChatStreamWith` and `SseDriver`. + Response-header capture is an **allow-list** (`x-request-id`, `request-id`, + `x-amzn-requestid`, `x-ms-request-id`, `cf-ray`, in that preference order), + not a denylist, so a header a future gateway adds is not recorded by default. + The list is longer than the Anthropic one because this transport speaks to an + open-ended set of hosts and the gateways commonly in front of them. + +- `baikai-openai`: the same field for `codex exec`: mode `flag`, wire field + `model_reasoning_effort`, and **no** adjustments at any level. Codex is the + only transport in baikai that expresses all six canonical levels exactly, and + a test asserts each one reaches the command line verbatim. + +### Fixed + +- `baikai-openai`: `Response.responseId` was always `Nothing` on the Chat + Completions transport, although every compatible host sends a top-level `id` + on every streamed chunk. It now carries the identifier the host reported, on + both the successful and the failed terminal. + +### Changed + +- **Breaking:** `baikai-openai`: `Baikai.Provider.OpenAI.Sse`'s four streaming + entry points — `openaiSseStream`, `openaiSseStreamValue`, + `openaiSseStreamValueWithHeaders`, and `sseFromResponse` — take a new + `ResponseMetadata -> IO ()` callback immediately before the existing per-chunk + callback. It fires exactly once, before the first chunk, on both the success + and the non-2xx path — a failed call's correlation identifier is if anything + more valuable than a successful one's. Pass `(\_ -> pure ())` to keep the + previous behaviour. The callback is separate rather than a widening of the + per-chunk one because that one runs once per SSE frame and response-level data + does not belong on that path. + +- **Breaking:** `baikai-openai`: `Baikai.Provider.OpenAI.Api`'s `RawChunk` gains + `model` and `responseId` fields, both `Maybe Text`. Code that pattern-matches + on `RawChunk` is unaffected; code that constructs one with record syntax must + add them. + +- **Breaking:** `baikai-openai`: `Baikai.Provider.OpenAI.Shape`'s + `shapeRequestBody`, `streamRequestBody`, and `injectThinkingShape` now return + `(Aeson.Value, ThinkingTranslation)` instead of a bare body. Take `fst` to + keep the previous value. The description has to travel out of the shaping step + because nothing downstream can recompute it: it depends on the host's + `ThinkingFormat`, which only the compat lookup knows. **No request body + changed** — every one of the seven shapes puts exactly the same bytes on the + wire as before. + +- **Breaking:** `baikai-openai`: `codexInteractiveCommand` now returns + `Either AgentRenderError (FilePath, [String])` and `launchCodexInteractive` + returns `IO (Either AgentRenderError InteractiveLaunchResult)`. A request + whose `safety` is a non-empty `ClaudeAllowedTools` list — which `codex` has + no flag for — is refused with `SafetyNotExpressible AgentCodex`, quoting the + rejected tools and suggesting `CodexSandbox` or `DefaultSafety`. Previously + the allow-list was silently discarded and Codex was started with its default + sandbox. The same `Left`/`Right` reading applies, `DefaultSafety` and an + empty allow-list are never refused, and no previously rendered argument + vector changed. Callers must handle the refusal branch. + + Both changes make the interactive surface honor the same contract as the new + unattended surface: a safety policy the chosen provider cannot express fails + visibly instead of silently becoming a weaker policy. Downstream consumers + must adapt before upgrading; the known one is `shinzui/seihou`, whose + `Seihou.CLI.AgentLaunchExec` module builds interactive launch requests. + +## [baikai-trace-otel 0.3.0.3] - 2026-08-05 + +### Added + +- `baikai-trace-otel`: the sink attaches an evidence record's salient fields to + the open span as flat attributes (`baikai.evidence.run_id`, + `baikai.evidence.call_id`, `baikai.evidence.strength`, the two digests, and + `gen_ai.response.model` only when the provider actually reported one) rather + than serialising the record into one blob. A `CallEvidence` event neither + opens nor closes a span. + +### Changed + +- `baikai-trace-otel`: widened its `baikai` bound to admit `0.5`. No API change. + +## [baikai-effectful 0.3.0.3] - 2026-08-05 + +### Changed + +- Widened its `baikai` bound to admit `0.5`. No API change; the package's + own surface is untouched. + +## [baikai-kit 0.1.0.4] - 2026-08-05 + +### Changed + +- Widened its `baikai` bound to admit `0.5`. No API change; the package's + own surface is untouched. + +## [baikai-agent 0.1.0.0] - 2026-08-05 + +### Added + +- `baikai-agent`: **new package** (`0.1.0.0`) holding the unattended + coding-agent runner. `Baikai.Agent.Run.runAgentCommand` takes an + `AgentRunRequest` and an already-rendered `AgentCommand` and spawns the tool + with no terminal and no human present. It delivers the prompt on standard + input and closes the handle, drains standard output and standard error + concurrently so a chatty agent cannot deadlock on a full pipe, retains at most + `outputLimit` bytes per stream while reading and discarding the excess, and + honors the three output disciplines. Preconditions run before any spawn: a + missing working directory is `WorkingDirMissing` and unset or empty declared + variables are `MissingEnvironment`, listing all of them at once. On timeout + the child's whole process group is interrupted, given a grace period, and then + terminated, so the agent's own child processes go with it; the failure reports + the configured limit. A non-zero exit code is a successful run carrying that + code, not a failure. The runner consumes an already-rendered `AgentCommand` + and never imports a vendor renderer, so it is exercised entirely with + hand-written argument vectors. Its POSIX-signal escalation is conditional on a + non-Windows build. + +- `baikai-agent`: new exposed module `Baikai.Agent.Config`, the layered + configuration layer. `resolveAgentJob` resolves one named job across five + layers — built-in defaults, the operator file, the repository file, the + environment, then command-line overrides, later layers winning — and returns + the resolved `AgentJob` together with a report attributing every value to the + file, line, and column it came from. `agentJobRequest` converts a job into an + `AgentRunRequest`, taking the prompt at call time. `listAgentJobs` enumerates + configured job names, sorted, each attributed to the highest-precedence scope + defining it. `defaultAgentConfigPaths` locates + `$XDG_CONFIG_HOME/baikai/agents.kdl` (or `$HOME/.config/baikai/agents.kdl`) + and `./.baikai/agents.kdl`, with no upward search through parent directories. + + The **policy ceiling** is loaded by a separate function, `loadAgentCeiling`, + against a separate source list containing the operator file and nothing else: + no repository file, environment variable, or command-line override can raise + it. `applyCeilingToJob` refuses an over-broad request with `CeilingRejected` + rather than clamping it. With no operator file the ceiling is + `defaultAgentCeiling`. `safety.provider-args` is classified secret and renders + as `` in any report or structured error. + + New dependencies: `settei`, `settei-env`, `settei-kdl`, and + `settei-optparse-applicative` (all `^>=0.2`, published on Hackage at + `0.2.0.0`), plus `containers` and `filepath`. `settei-formats` is deliberately + excluded, because it bundles Dhall loading and repository configuration is + untrusted input here. + +- `baikai-agent`: the **`baikai` executable**, with the `agent run`, + `agent show`, and `agent list` commands, and the `Baikai.Agent.Cli` module + that implements them. A shell script now invokes one stable command, supplies + a prompt on standard input, and selects Claude Code or Codex entirely through + configuration. + + `agent run` resolves the named job, caps it against the operator ceiling, + renders it through the vendor renderer for its provider, and spawns it. The + agent's own exit code passes through unchanged; Baikai's own failures use 64 + and above following the `sysexits` convention — 64 for a usage error or an + empty prompt, 69 when the executable could not be started, 70 for malformed + output, 75 for a timeout, 77 for a policy refusal, and 78 for a configuration + problem. The prompt comes from `--prompt-stdin`, `--prompt-file`, or + `--prompt`, which are mutually exclusive, and is decoded as UTF-8 explicitly + rather than through the handle's locale encoding. + + `agent show` performs the whole pipeline except spawning and prints each + resolved value with the file, line, and column it came from, the policy + ceiling in force and where it was read, and the exact argument vector that + would be spawned — with `` in place of any raw provider argument. A + job whose policy is refused prints its configuration first and then the + refusal. `agent list` enumerates configured jobs and the scope each came from. + + Every Baikai diagnostic goes to standard error. The agent's own output follows + the job's output mode, so `response=$(baikai agent run job)` yields the + agent's answer alone for a capturing job. `--set KEY=VALUE` overrides one + setting of the selected job through `settei`'s own command-line source, so an + override is attributed with the same fidelity as a file. `--json` emits + exactly one JSON object per command. + + New dependencies for `baikai-agent`: `baikai-claude`, `baikai-openai`, and + `optparse-applicative`. The provider packages are needed only so that + `renderJobCommand`, the single provider dispatch point in the codebase, can + reach both renderers. This is the first dependency in the workspace from + `baikai-agent` onto the provider packages, so `baikai-agent` now publishes + after all three of `baikai`, `baikai-claude`, and `baikai-openai`. + + The user guide `docs/user/unattended-agent-runs.md` documents the whole + surface: the three commands with their flags, exit codes, and stream + discipline; the KDL job format and layer precedence; the operator ceiling and + redaction; the capability mapping tables for both tools; and a before-and-after + migration of a script that embeds provider flags today. + `docs/user/cli-providers.md` and `docs/user/interactive-launches.md` link to + it, and the capability mapping tables moved there from the latter. + +- `baikai-agent`: **an unattended coding-agent run now produces model-call + evidence.** This surface previously had no observability of any kind: no trace + sink, no `Response`, no usage, no identifiers. An operator could show that a + process started, exited, and took some time; they could not show which model + ran, which reasoning effort was applied, or which agent session the run + corresponds to in the vendor's records. + + A record carries the run and call identifiers, the resolved executable and its + own reported version, digests over the request, the requested model and what + the reasoning-effort request became on the command line, whatever the tool + reported about itself, the outcome, and an honest strength. + + **A zero exit status never raises the strength.** On this surface that rule + matters more than anywhere else, because almost every unattended run exits + zero. A coding agent that exits zero has demonstrated that it ran, not which + model served it. + + Two things gate what a record can prove, and neither is the default. The job + must **capture** output — under `inherit` the agent's bytes went to the + operator's terminal and baikai never held them — and the tool must be + configured to print a structured format, which means `--output-format json` + for `claude` or `--json` for `codex exec` through the job's `provider-args`. + Without both, the tool's session identifier, model, and token counts are + genuinely unavailable and the record says `"unobserved"` rather than inferring + anything. A timed-out run records `aborted`; a run that never started records + nothing at all. + +- **Breaking:** `baikai-agent`: `Baikai.Agent.Run.runAgentCommand` takes two new + leading arguments and returns the new outcome type: + `Maybe EvidenceRequest -> ThinkingTranslation -> AgentRunRequest -> AgentCommand -> IO AgentRunOutcome`. + A caller who wants the previous behaviour passes `Nothing` and + `Baikai.Evidence.noThinkingRequested` and reads the `outcome` field; that path + is byte-for-byte what it was, and costs what it cost — no digest is computed, + no call identifier is generated, and the tool is not invoked a second time to + read its version. + +- `baikai-agent`: `baikai agent run` gains `--evidence-file PATH` and + `--run-id TEXT`. Supplying neither leaves the run on the pre-existing path at + the pre-existing cost; supplying either turns recording on, with the job's own + name standing in as the run identifier when only a destination is given. The + file is written atomically — a staging file beside the destination, then a + rename — so a reader polling the path never sees a half-written object, and it + is never appended to. A failed write is reported on standard error and never + changes the exit code, because the agent's own status is what a calling script + branches on. `docs/user/unattended-agent-runs.md` documents both options and, + more importantly, what the record does and does not prove. + +- `baikai-agent`: `baikai agent run` gains `--require-evidence STRENGTH`, taking + `requested_only`, `correlated`, `model_observed`, or `fully_observed` — the + same words a record's `strength` field spells, so what one record showed can + be passed back as the next run's requirement. A job whose configuration cannot + produce evidence of at least that strength is refused before anything is + spawned, exiting 77 — the code a ceiling violation and an inexpressible safety + policy already use, so a script branching on 77 needs no new case. + +## [baikai-claude 0.4.0.1] - 2026-07-30 + +### Fixed + +- Widened the `crypton` bound from `^>=1.0` to `>=1.0 && <1.2` so consumers can + build `baikai-claude` alongside packages that require `crypton` 1.1.x (for + example `pg-migrate-1.1.0.0`), which previously had no solvable build plan. + The only `crypton` use is `Crypto.Hash` (`Digest`, `SHA256`) in + `Baikai.Provider.Claude.Transport`, whose API is identical across the 1.0/1.1 + boundary. No API change. + +## [baikai 0.4.1.0] - 2026-07-20 + +### Changed + +- Version bump only; no library API or code changes. Released so the umbrella + release tag `baikai-0.4.1.0` names a fresh core version alongside the breaking + `baikai-claude` / `baikai-openai` 0.4.0.0 releases, matching the tag + convention downstream consumers pin against. + +## [baikai-claude 0.4.0.0] - 2026-07-20 + +### Changed + +- **Breaking:** `claudeCliCommand` now takes the `Options` record and forwards + `Options.thinking` to batch `claude -p` as `--effort ` (`minimal` + collapses to `low`, matching the interactive launcher and the claude CLI's + lack of a `minimal` value). `thinking = Nothing` emits no effort flag, keeping + existing argv byte-for-byte. The added parameter is a PVP-major signature + change. + +## [baikai-openai 0.4.0.0] - 2026-07-20 + +### Changed + +- **Breaking:** `codexCliCommand` now takes the `Options` record and forwards + `Options.thinking` to `codex exec` as `-c model_reasoning_effort=` for + all six effort levels. `thinking = Nothing` emits no override, keeping + existing argv byte-for-byte. The added parameter is a PVP-major signature + change. + +## [baikai 0.4.0.0] - 2026-07-20 + +### Added + +- Added `ThinkingXHigh` and `ThinkingMax` to the exported `ThinkingLevel` + vocabulary and added a defaulted `InteractiveLaunchRequest.effort` field. + Extending the closed sum type is a PVP-major API change for downstream + exhaustive matches. + +## [baikai-claude 0.3.0.2] - 2026-07-20 + +### Added + +- Added `--effort` rendering to interactive Claude Code launches and preserved + `xhigh` / `max` on native adaptive Anthropic API requests, with larger fixed + budgets for manual-thinking models. + +### Changed + +- Bumped the internal `baikai` dependency bound to `^>=0.4.0` for the + baikai 0.4.0.0 release. + +## [baikai-openai 0.3.0.2] - 2026-07-20 + +### Added + +- Added `model_reasoning_effort` overrides to interactive Codex launches and + preserved `xhigh` / `max` in native OpenAI request JSON; non-native + OpenAI-compatible request shapes continue to clamp them to `high`. + +### Changed + +- Bumped the internal `baikai` dependency bound to `^>=0.4.0` for the + baikai 0.4.0.0 release. + +## [baikai-trace-otel 0.3.0.2] - 2026-07-20 + +### Changed + +- Bumped the internal `baikai` dependency bound to `^>=0.4.0` for the + baikai 0.4.0.0 release. No API changes. + +## [baikai-effectful 0.3.0.2] - 2026-07-20 + +### Changed + +- Bumped the internal `baikai` dependency bound to `^>=0.4.0` for the + baikai 0.4.0.0 release. No API changes. + +## [baikai-kit 0.1.0.3] - 2026-07-20 + +### Changed + +- Bumped the internal `baikai` dependency bound to `^>=0.4.0` for the + baikai 0.4.0.0 release. No API changes. + +## [baikai 0.3.1.0] - 2026-07-15 + +### Added + +- Added `claude-sonnet-5` to the Anthropic model catalog (1M context window, + 128k max output, `tool_call` + reasoning). +- Added the `gpt-5.6` family — `gpt-5.6`, `gpt-5.6-luna`, `gpt-5.6-sol`, and + `gpt-5.6-terra` — to the OpenAI model catalog (chat-completions with + `tool_call` support). + +### Changed + +- Corrected `claude-sonnet-4-5` context window to 1M tokens and + `claude-sonnet-4-6` max output to 128k tokens in the catalog. +- Added PVP-compliant upper bounds to all previously-unbounded library and + executable dependencies. + +## [baikai-claude 0.3.0.1] - 2026-07-15 + +### Changed + +- Added PVP-compliant upper bounds to all previously-unbounded library and + executable dependencies. + +## [baikai-openai 0.3.0.1] - 2026-07-15 + +### Changed + +- Added PVP-compliant upper bounds to all previously-unbounded library and + executable dependencies. + +## [baikai-trace-otel 0.3.0.1] - 2026-07-15 + +### Changed + +- Added PVP-compliant upper bounds to all previously-unbounded library and + executable dependencies. + +## [baikai-effectful 0.3.0.1] - 2026-07-15 + +### Changed + +- Added PVP-compliant upper bounds to all previously-unbounded library and + executable dependencies. + +## [baikai-kit 0.1.0.2] - 2026-07-15 + +### Changed + +- Added PVP-compliant upper bounds to all previously-unbounded library and + executable dependencies. + +## [baikai 0.3.0.0] - 2026-07-03 + +### Added + +- Added the documented record-update bases `emptyOptions`, `emptyContext`, + `emptyModel`, `emptyResponse`, `emptyTool`, `emptyTextContent`, + `emptyThinkingContent`, `emptyToolCall`, `emptyImageContent`, + `emptyEmbeddingModel`, plus zero-valued bases `zeroUsage`, `zeroCost`, + `zeroCostBreakdown`, and `zeroModelCost`. +- Added `firstEmbedding`, a total accessor for OpenAI-compatible embedding + responses. +- Added `responseError`, `errorResponse`, `httpError`, and + `parseRetryAfterSeconds` for the in-band error contract. + +### Changed + +- **Breaking:** Constructors for evolvable records are no longer exported: + `Options`, `Context`, `Model`, `OpenAICompletionsCompat`, + `AnthropicMessagesCompat`, and `InteractiveLaunchRequest` are built from + exported base values plus record updates. +- **Breaking:** The `_X` base values are deprecated in favor of the new + `empty*` and `zero*` names; the aliases remain for this release. +- **Breaking:** Removed `unModel`; use `mkModel` or `emptyModel` record + updates. +- **Breaking:** Renamed `InteractiveLaunchRequest.model` to `modelId`. +- **Breaking:** `Response.latencyMs` and trace event `latencyMs` fields are + now `Int`. +- **Breaking:** `completeRequest` / `completeRequestWith` no longer throw + `BaikaiError` for unregistered API tags; they return an error-shaped + `Response`. +- **Breaking:** CLI providers now report subprocess/decode/provider failures + in-band as error-shaped `Response`s. +- **Breaking:** `errorTerminal` now requires a `BaikaiError`, enforcing + structured error details for `EventError` construction sites. +- Documented that `Baikai.Prelude` is a convenience module outside the PVP + stability contract and that `.Internal` modules have no compatibility + guarantees. + +### Fixed + +- Empty embedding `data` arrays now produce a typed `decodeError` instead of + crashing on an empty vector. +- The model-fetch JSON renderer now delegates string escaping to aeson. +- The model generator now fails on sanitized Haskell identifier collisions + instead of rendering duplicate bindings. +- Live HTTP status, `Retry-After`, and network-failure classification now + works on both API providers. +- `content_filter` / Anthropic refusals terminate as classified `EventError` + terminals, and `liftCompleteToStream` preserves error-shaped responses. + +## [baikai-claude 0.3.0.0] - 2026-07-03 + +### Changed + +- **Breaking:** `Baikai.Provider.Claude.ErrorClass` moved to + `Baikai.Provider.Claude.Internal.ErrorClass`. +- **Breaking:** `mapRequest` and pure request-shaping helpers moved from + `Baikai.Provider.Claude.Api` to + `Baikai.Provider.Claude.Internal.Request`. +- **Breaking:** `ClaudeCliConfig` and `ClaudeInteractiveConfig` constructors + are no longer exported; start from their default config values and update + fields. +- **Breaking:** CLI and interactive `extraArgs` fields are now `[Text]`. + +## [baikai-openai 0.3.0.0] - 2026-07-03 + +### Changed + +- **Breaking:** `Baikai.Provider.OpenAI.ErrorClass` moved to + `Baikai.Provider.OpenAI.Internal.ErrorClass`. +- **Breaking:** `mapRequest` and pure request-shaping helpers moved from + `Baikai.Provider.OpenAI.Api` to + `Baikai.Provider.OpenAI.Internal.Request`. +- **Breaking:** `CodexCliConfig` and `CodexInteractiveConfig` constructors are + no longer exported; start from their default config values and update fields. +- **Breaking:** CLI and interactive `extraArgs` fields are now `[Text]`. + +## [baikai-trace-otel 0.3.0.0] - 2026-07-03 + +### Changed + +- Updated the `baikai` dependency bound to `^>=0.3.0`. +- Adjusted to the core trace event `latencyMs :: Int` type. + +## [baikai-effectful 0.3.0.0] - 2026-07-03 + +### Changed + +- Updated the `baikai` dependency bound to `^>=0.3.0`. + +## [baikai-kit 0.1.0.1] - 2026-07-03 + +### Changed + +- Updated the `baikai` dependency bound to `^>=0.3.0`. + +## [baikai 0.2.0.0] - 2026-06-21 + +### Added + +- `Usage`, `Cost`, and `CostBreakdown` now have `Semigroup`/`Monoid` + instances that add field-by-field, plus `sumUsage :: Foldable f => f + Usage -> Usage`, so callers can total per-call usage and cost. + `reasoningTokens` combines as presence-wins (`Nothing` only when both + operands are `Nothing`). +- A categorised error model: `BaikaiError` is now a record carrying an + `ErrorCategory` (`AuthError`, `RateLimited`, `ContextOverflow`, + `InvalidRequest`, `TransientError`, `DecodeFailure`, `ProcessFailure`, + `ProviderUnavailable`, `OtherError`), an optional HTTP `httpStatus`, a + `retryAfterSeconds` hint, and a subprocess `exitCode`. New smart + constructors (`providerError`, `invalidRequest`, `decodeError`, + `processError`, `rateLimited`, `authError`, `providerUnavailable`), + the `isRetryable` predicate, and the pure `classifyHttpStatus` / + `classifyHttpStatusWithBody` helpers let callers implement retry + policy without parsing error text. `ErrorCategory` and `BaikaiError` + serialize to JSON. +- `Response` and the streaming `EventError`'s `TerminalPayload` now + carry `errorInfo :: Maybe BaikaiError`, so a failed `completeRequest` + (or a drained stream) exposes the structured category/retry hint + in-band. `Baikai.Stream.Event` gains `doneTerminal` / `errorTerminal` + constructors. + +### Changed + +- **Breaking:** `BaikaiError`'s four flat constructors + (`ProviderError`, `RequestInvalid`, `DecodeError`, `ProcessError`) + were replaced by the record above. Migrate by lowercasing to the + smart constructors — `ProviderError "x"` becomes `providerError "x"`, + `ProcessError n "x"` becomes `processError n "x"`, etc. +- **Breaking:** `Baikai.Stream.Event.TerminalPayload` and + `Baikai.Response.Response` gained an `errorInfo` field; build + `TerminalPayload` via `doneTerminal` / `errorTerminal`. + +### Fixed + +- Restored JSON decoding for `BaikaiError` values with omitted optional + metadata fields. + +## [baikai-claude 0.2.0.0] - 2026-06-21 + +### Added + +- The Anthropic API and `claude -p` CLI providers now classify failures + into the typed `BaikaiError` categories: HTTP errors (via the caught + `servant-client` `ClientError`) map status/`Retry-After`/body onto + `AuthError` / `RateLimited` / `ContextOverflow` / `InvalidRequest` / + `TransientError`, and mid-stream Anthropic `error` events are + classified by their error type. The result is surfaced on + `Response.errorInfo`. + +## [baikai-openai 0.2.0.0] - 2026-06-21 + +### Added + +- The OpenAI/OpenAI-compatible API and `codex exec` CLI providers now + classify failures into the typed `BaikaiError` categories the same way + as `baikai-claude` (HTTP `ClientError` for status-based errors, + streamed error text for mid-stream errors), surfaced on + `Response.errorInfo`. + +## [baikai-trace-otel 0.2.0.0] - 2026-06-21 + +### Changed + +- Updated the `baikai` dependency bound to `^>=0.2.0` for compatibility with + the `baikai 0.2.0.0` breaking API release. + +## [baikai-effectful 0.2.0.0] - 2026-06-21 + +### Changed + +- Updated the `baikai` dependency bound to `^>=0.2.0` for compatibility with + the `baikai 0.2.0.0` breaking API release. + +## [baikai 0.1.1.0] - 2026-06-12 + +### Added + +- Added provider-agnostic `ResponseFormat` support on `Options`, including + plain JSON-object mode and named JSON-schema mode. +- Added `Baikai.Embedding`, an OpenAI `/v1/embeddings` client for text + embeddings. + +## [baikai-claude 0.1.1.0] - 2026-06-12 + +### Added + +- Mapped baikai `ResponseFormat` options onto Anthropic `output_config` for + Claude API requests. +- Exported `mapRequest` for request-mapping tests and downstream inspection. + +## [baikai-openai 0.1.1.0] - 2026-06-12 + +### Added + +- Mapped baikai `ResponseFormat` options onto OpenAI Chat Completions + `response_format`. +- Exported `mapRequest` for request-mapping tests and downstream inspection. + +## [baikai-effectful 0.1.0.0] - 2026-06-12 + +### Added + +- Initial release: effectful binding for baikai with the `Baikai` dynamic + effect, `complete`, `streamCollect`, `streamEach`, and registry-backed + interpreters. + +## [baikai 0.1.0.0] - 2026-06-04 + +### Added + +- Initial release: unified Haskell interface for working with multiple AI + providers. Core modules including `Baikai`, `Baikai.Prelude`, `Baikai.Api`, + `Baikai.Provider`, `Baikai.Provider.Registry`, `Baikai.Response`, + `Baikai.Stream`, `Baikai.Tool`, `Baikai.Trace`, and the cost/usage modules. +- Depends on released `streamly` (`>=0.11 && <0.13`) and `streamly-core` + (`>=0.3 && <0.5`) from Hackage, so all dependencies resolve from Hackage. + +## [baikai-claude 0.1.0.0] - 2026-06-04 + +### Added + +- Initial release: Anthropic Claude providers for the baikai abstraction, + wrapping the `claude` package for both the Anthropic API and the `claude -p` + CLI (`Baikai.Provider.Claude.Api`, `.Cli`, `.Interactive`). + +## [baikai-openai 0.1.0.0] - 2026-06-04 + +### Added + +- Initial release: OpenAI providers for the baikai abstraction, wrapping the + `openai` package for OpenAI's Chat Completions API + (`Baikai.Provider.OpenAI.Api`, `.Cli`, `.Interactive`). + +## [baikai-trace-otel 0.1.0.0] - 2026-06-04 + +### Added + +- Initial release: OpenTelemetry `TraceSink` adapter for baikai + (`Baikai.Trace.Sink.OpenTelemetry`), emitting one OTel span per provider call + with GenAI semantic-convention attributes plus baikai cost and latency. diff --git a/baikai-kit.cabal b/baikai-kit.cabal --- a/baikai-kit.cabal +++ b/baikai-kit.cabal @@ -1,25 +1,36 @@ cabal-version: 3.4 -name: baikai-kit -version: 0.1.0.4 -synopsis: Shared kit installer for AI-agent skills and subagents +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 +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 @@ -34,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 @@ -45,49 +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.5.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,22 +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 @@ -1,60 +1,253 @@ +-- | The optparse-applicative adapter a consuming tool wires up as its +-- @kit@ subcommand. +-- +-- 'runKit' is the only function in @baikai-kit@ that exits the process; +-- see @docs/adr/0013-library-code-never-calls-exitfailure.md@. module Baikai.Kit.Command ( KitCommand (..), + OutputFormat (..), kitCommandParser, runKit, + runKitCommand, ) where -import Baikai.Kit.Config (KitConfig, KitScope (..)) -import Baikai.Kit.Install (installItem, listAvailable, uninstallItem, updateKit) -import Baikai.Kit.Status (kitStatus) +import Baikai.Kit.Config (KitConfig, KitScope (..), scopeLabel) +import Baikai.Kit.Error (KitError (..), renderKitError) +import Baikai.Kit.Install + ( InstallOptions (..), + OverwritePolicy (..), + UpdateReport, + installFrom, + loadManifest, + renderAvailable, + renderUninstallReport, + uninstallItem, + updateKit, + ) +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 (..), 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 (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) + = 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 HumanOutput -> withRepo HumanOutput $ \repo -> + loadManifest (repo ^. #dir) `thenE` \manifest -> + printed (renderAvailable manifest) + 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 -> + 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 format -> do + report <- kitStatus config + noteUpstream report + 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. + -- 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) + Right resolved -> do + case resolved ^. #refresh of + RepoStale err -> + Text.IO.hPutStrLn stderr $ + "Warning: kit repository could not be refreshed (" <> Text.strip err <> "); using the cached copy." + RepoCloned -> + Text.IO.hPutStrLn (noticeHandle format) ("Fetched " <> (config ^. #toolName) <> "-kit.") + RepoPulled -> pure () + next resolved + + noteUpstream :: StatusReport -> IO () + noteUpstream report = case report ^. #upstream of + UpstreamReady -> pure () + UpstreamStale err -> + Text.IO.hPutStrLn stderr $ + "Warning: kit repository could not be refreshed (" + <> Text.strip err + <> "); comparing against the cached copy." + UpstreamUnavailable err -> + Text.IO.hPutStrLn stderr $ + "Note: kit repository unavailable (" + <> Text.strip (renderKitError err) + <> "); showing installed items without upstream comparison." + + thenE :: IO (Either KitError a) -> (a -> IO (Either KitError b)) -> IO (Either KitError b) + thenE step next = step >>= either (pure . Left) next + + 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. runKit :: KitConfig -> KitCommand -> IO () -runKit config = \case - KitList -> listAvailable config - KitInstall n scope -> installItem config n scope - KitUpdate n -> updateKit config n - KitUninstall n scope -> uninstallItem config n scope - KitStatus -> kitStatus config +runKit config kitCommand = do + result <- runKitCommand config kitCommand + case result of + Right () -> pure () + Left err -> do + Text.IO.hPutStrLn stderr ("Error: " <> renderKitError err) + exitWith (ExitFailure 1) -installParser :: Parser KitCommand -installParser = +renderUpdateReport :: UpdateReport -> Text +renderUpdateReport report = + Text.intercalate "\n" (headline ++ updatedLines ++ skippedLines ++ [summary] ++ skipSummary) + where + headline = case report ^. #refresh of + Nothing -> [] + Just RepoCloned -> ["Kit repository cloned."] + Just RepoPulled -> ["Kit repository updated."] + Just (RepoStale _) -> ["Kit repository updated."] + updatedLines = + [ "Updated '" <> n <> "' (" <> scopeLabel scope <> ")" + | (n, scope) <- report ^. #updated + ] + -- A skip is not a failure: the command still exits 0, and the line + -- says exactly which invocation would overwrite the edits. + skippedLines = + [ "Skipped '" + <> n + <> "' (" + <> scopeLabel scope + <> "): installed files were modified locally; run 'kit update " + <> n + <> " --force' to overwrite." + | (n, scope) <- report ^. #skipped + ] + summary = "Updated " <> Text.pack (show (length (report ^. #updated))) <> " item(s)." + skipSummary + | null (report ^. #skipped) = [] + | otherwise = ["Skipped " <> Text.pack (show (length (report ^. #skipped))) <> " item(s)."] + +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 = KitUpdate <$> optional (strArgument (metavar "NAME" <> help "Name of a specific item to update (default: all)")) + <*> flag + 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 new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Error.hs @@ -0,0 +1,122 @@ +-- | Every way a kit operation can fail. +-- +-- Library functions return these; only 'Baikai.Kit.Command.runKit' +-- turns one into a process exit. The 'Exception' instance exists for a +-- caller who prefers exceptions and can write @either throwIO pure@. +module Baikai.Kit.Error + ( KitError (..), + renderKitError, + ) +where + +import Baikai.Prelude +import Control.Exception (Exception) +import Data.Text qualified as Text + +-- | A kit operation's failure. Constructors are positional because +-- @-Wpartial-fields@ is on and a record sum would warn. +data KitError + = -- | The kit checkout holds no @kit.json@. + KitManifestMissing FilePath + | -- | The manifest did not decode; the 'Text' is aeson's message. + KitManifestInvalid FilePath Text + | -- | The manifest declares a @version@ this installer does not support. + 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 + -- 'Text' is that function's reason. + KitUnsafeName Text Text + | -- | A manifest path failed 'Baikai.Kit.Path.safeRelativePath'. + KitUnsafePath Text Text + | -- | A listed source file is not there. + KitSourceMissing FilePath + | -- | A component of a listed source path is a symbolic link. A kit is + -- plain files; see 'Baikai.Kit.Path.safeSourcePath'. + KitSourceSymlink FilePath + | -- | The canonical source path (first field) is not below the + -- canonical kit checkout (second field). + KitSourceEscapes FilePath FilePath + | -- | Inspecting or reading a source raised an 'IOException'. + KitSourceUnreadable FilePath Text + | -- | A first clone failed and no usable cache exists: the repository + -- URL and git's output. + KitCloneFailed Text Text + | -- | @git pull@ failed during @kit update@. + KitPullFailed Text + | -- | An install could not be completed: the reason, the destinations + -- 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) + +-- | The message a command adapter prints. One line, except where a +-- failure needs to say what it left behind. +renderKitError :: KitError -> Text +renderKitError = \case + KitManifestMissing path -> + "kit.json not found in kit repository (" <> Text.pack path <> ")." + KitManifestInvalid path reason -> + "failed to parse " <> Text.pack path <> ": " <> reason + -- The supported versions are spelled out rather than read from + -- 'Baikai.Kit.Manifest.supportedManifestVersions': Manifest imports + -- this module, so the dependency cannot run the other way. + KitManifestVersionUnsupported path n -> + Text.pack path + <> " declares manifest version " + <> 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 + KitSourceMissing path -> "source file does not exist: " <> Text.pack path + KitSourceSymlink path -> "refusing symbolic link in kit source: " <> Text.pack path + KitSourceEscapes path root -> + "kit source resolves outside the kit checkout: " + <> Text.pack path + <> " (checkout: " + <> Text.pack root + <> ")" + KitSourceUnreadable path reason -> + "cannot inspect kit source " <> Text.pack path <> ": " <> reason + KitCloneFailed url output -> + "failed to fetch kit repository " <> url <> ": " <> output + KitPullFailed output -> + "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 + aftermath + | null restored && null leftInconsistent = ["No changes were made."] + | otherwise = + ["Restored: " <> renderPaths restored | not (null restored)] + <> [ "Left inconsistent (repair by reinstalling): " <> renderPaths leftInconsistent + | not (null leftInconsistent) + ] + renderPaths = Text.intercalate ", " . map Text.pack 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 @@ -1,414 +1,993 @@ -module Baikai.Kit.Install - ( loadManifest, - loadManifestMaybe, - lookupItem, - installItem, - uninstallItem, - uninstallOutcomes, - renderUninstallReport, - RemovalOutcome (..), - updateKit, - listAvailable, - stripYamlFrontmatter, - ) -where - -import Baikai.AgentAssets - ( CodexCustomAgent (..), - agentTargetPath, - codexCustomAgentToml, - skillTargetPath, - ) -import Baikai.Interactive (InteractiveProvider (..), InteractiveScope (InteractiveProjectScope)) -import Baikai.Kit.Config (KitConfig, KitScope (..), kitCacheDir, providerAgentsBase, providerLabel, scopeLabel, sidecarFileName) -import Baikai.Kit.Manifest - ( AgentEntry, - KitItem (..), - KitItemKind (..), - KitManifest (..), - SkillEntry, - itemKind, - kitItemKind, - ) -import Baikai.Kit.Path (safeItemName, safeRelativePath) -import Baikai.Kit.Repo (PullResult (..), ensureKitRepo, pullKitRepo) -import Baikai.Kit.Sidecar (computeKitHash, newSidecarMeta, sidecarPath) -import Baikai.Prelude -import Control.Exception (IOException, catch, throwIO, try) -import Control.Monad (forM, forM_, unless, when) -import Data.Aeson (eitherDecodeFileStrict', encode) -import Data.ByteString.Lazy qualified as LBS -import Data.List (find, nub) -import Data.Text qualified as Text -import Data.Text.Encoding qualified as Text.Encoding -import Data.Text.IO qualified as Text.IO -import System.Directory - ( createDirectoryIfMissing, - doesDirectoryExist, - doesFileExist, - removeDirectoryRecursive, - removeFile, - renameFile, - ) -import System.Exit (exitFailure) -import System.FilePath (takeDirectory, takeFileName, ()) -import System.IO (hPutStrLn, stderr) - -data PlannedWrite = PlannedWrite - { destination :: !FilePath, - content :: !WriteContent - } - -data WriteContent - = CopyFrom !FilePath - | WriteBytes !LBS.ByteString - -data RemovalOutcome = RemovalOutcome - { provider :: !InteractiveProvider, - skillRemoved :: !Bool, - agentRemoved :: !Bool, - sidecarRemoved :: !Bool - } - deriving stock (Eq, Generic, Show) - -loadManifest :: FilePath -> IO KitManifest -loadManifest repoDir = do - let manifestPath = repoDir "kit.json" - exists <- doesFileExist manifestPath - unless exists $ do - hPutStrLn stderr "Error: kit.json not found in kit repository." - exitFailure - result <- eitherDecodeFileStrict' manifestPath - case result of - Left err -> do - hPutStrLn stderr $ "Error: Failed to parse kit.json: " <> err - exitFailure - Right manifest -> pure manifest - -loadManifestMaybe :: FilePath -> IO (Maybe KitManifest) -loadManifestMaybe "" = pure Nothing -loadManifestMaybe cacheDir = do - let manifestPath = cacheDir "kit.json" - exists <- doesFileExist manifestPath - if not exists - then pure Nothing - else do - result <- eitherDecodeFileStrict' manifestPath - case result of - Left err -> do - hPutStrLn stderr $ "Warning: failed to parse kit.json: " <> err - pure Nothing - Right manifest -> pure (Just manifest) - -lookupItem :: Text -> KitManifest -> Maybe KitItem -lookupItem n manifest = - case find (\entry -> entry ^. #name == n) (manifest ^. #skills) of - Just skill -> Just (KitSkillItem skill) - Nothing -> KitAgentItem <$> find (\entry -> entry ^. #name == n) (manifest ^. #agents) - -installItem :: KitConfig -> Text -> KitScope -> IO () -installItem config itemN scope = do - repoDir <- ensureKitRepo config - manifest <- loadManifest repoDir - case lookupItem itemN manifest of - Nothing -> do - hPutStrLn stderr $ "Error: '" <> Text.unpack itemN <> "' not found in kit manifest." - exitFailure - Just item -> do - result <- try @IOException (doInstall config repoDir item scope) - case result of - Right () -> - Text.IO.putStrLn $ - "Installed " <> itemKind item <> " '" <> itemN <> "' to " <> scopeLabel scope <> " scope." - Left e -> do - hPutStrLn stderr $ "Error: install failed, no changes were made: " <> show e - exitFailure - -uninstallItem :: KitConfig -> Text -> KitScope -> IO () -uninstallItem config n scope = do - outcomes <- uninstallOutcomes config n scope - Text.IO.putStrLn (renderUninstallReport n scope outcomes) - -uninstallOutcomes :: KitConfig -> Text -> KitScope -> IO [RemovalOutcome] -uninstallOutcomes config n scope = do - safeName <- requireSafe "item name" (safeItemName n) - forM (config ^. #providers) $ \provider -> do - providerBase <- providerAgentsBase config provider scope - skillRemoved <- removeIfDirectory (skillTarget config provider providerBase safeName) - agentRemoved <- removeIfFile (agentTarget config provider providerBase safeName) - sidecarRemoved <- removeIfFile (agentSidecarTarget config provider providerBase safeName) - pure RemovalOutcome {provider, skillRemoved, agentRemoved, sidecarRemoved} - -renderUninstallReport :: Text -> KitScope -> [RemovalOutcome] -> Text -renderUninstallReport n scope outcomes - | any assetRemoved outcomes = - "Uninstalled " - <> Text.intercalate "+" removedKinds - <> " '" - <> n - <> "' from " - <> scopeLabel scope - <> " scope (" - <> Text.intercalate "," removedProviders - <> ")." - | any (^. #sidecarRemoved) outcomes = - "Removed stale kit metadata for '" <> n <> "' from " <> scopeLabel scope <> " scope." - | otherwise = - "'" <> n <> "' is not installed in " <> scopeLabel scope <> " scope." - where - assetRemoved outcome = outcome ^. #skillRemoved || outcome ^. #agentRemoved - removedKinds = - nub $ - ["skill" | any (^. #skillRemoved) outcomes] - ++ ["agent" | any (^. #agentRemoved) outcomes] - removedProviders = map (providerLabel . view #provider) (filter assetRemoved outcomes) - -updateKit :: KitConfig -> Maybe Text -> IO () -updateKit config mName = do - cacheDir <- kitCacheDir config - exists <- doesDirectoryExist cacheDir - if exists - then do - result <- pullKitRepo config cacheDir - case result of - PullSucceeded -> Text.IO.putStrLn "Kit repository updated." - PullFailed err -> do - hPutStrLn stderr $ "Error: failed to update kit repository: " <> Text.unpack err - hPutStrLn stderr "The cached copy is unchanged; installed items were not reinstalled." - exitFailure - else do - _ <- ensureKitRepo config - Text.IO.putStrLn "Kit repository cloned." - manifest <- loadManifest =<< kitCacheDir config - case mName of - Just n -> do - reinstallIfPresent config n UserScope manifest - reinstallIfPresent config n ProjectScope manifest - Nothing -> reinstallAllPresent config manifest - -listAvailable :: KitConfig -> IO () -listAvailable config = do - repoDir <- ensureKitRepo config - manifest <- loadManifest repoDir - let sk = manifest ^. #skills - ag = manifest ^. #agents - if null sk && null ag - then Text.IO.putStrLn "No items available in the kit." - else do - unless (null sk) $ do - Text.IO.putStrLn "Skills:" - let maxLen = maximum $ map (Text.length . view #name) sk - mapM_ (printEntry maxLen . skillNameDesc) sk - unless (null ag) $ do - unless (null sk) (Text.IO.putStrLn "") - Text.IO.putStrLn "Agents:" - let maxLen = maximum $ map (Text.length . view #name) ag - mapM_ (printEntry maxLen . agentNameDesc) ag - where - printEntry maxLen (n, desc) = - Text.IO.putStrLn $ " " <> Text.justifyLeft (maxLen + 2) ' ' n <> desc - -doInstall :: KitConfig -> FilePath -> KitItem -> KitScope -> IO () -doInstall config repoDir item scope = - planInstall config repoDir item scope >>= executePlan - -planInstall :: KitConfig -> FilePath -> KitItem -> KitScope -> IO [PlannedWrite] -planInstall config repoDir item@(KitSkillItem entry) scope = do - safeName <- requireSafe "skill name" (safeItemName (entry ^. #name)) - safePath <- requireSafe "skill path" (safeRelativePath (entry ^. #path)) - safeFiles <- traverse (requireSafe "skill file" . safeRelativePath) (entry ^. #files) - let sourceDir = repoDir safePath - forM_ safeFiles $ \file -> requireSourceFile (sourceDir file) - hashStr <- computeKitHash sourceDir (map Text.pack safeFiles) - meta <- newSidecarMeta item hashStr - fmap concat $ - forM (config ^. #providers) $ \provider -> do - targetBase <- providerAgentsBase config provider scope - let targetDir = skillTarget config provider targetBase safeName - fileWrites = - [ PlannedWrite - { destination = targetDir file, - content = CopyFrom (sourceDir file) - } - | file <- safeFiles - ] - sidecarWrite = - PlannedWrite - { destination = sidecarPath provider (kitItemKind item) (Text.pack safeName) targetBase (sidecarFileName config), - content = WriteBytes (encode meta) - } - pure (fileWrites ++ [sidecarWrite]) -planInstall config repoDir item@(KitAgentItem entry) scope = do - safeName <- requireSafe "agent name" (safeItemName (entry ^. #name)) - (sourceBase, relFiles, primarySource) <- safeAgentSources repoDir entry - forM_ relFiles $ \file -> requireSourceFile (sourceBase file) - hashStr <- computeKitHash sourceBase (map Text.pack relFiles) - meta <- newSidecarMeta item hashStr - body <- Text.IO.readFile primarySource - fmap concat $ - forM (config ^. #providers) $ \provider -> do - targetBase <- providerAgentsBase config provider scope - let dstFile = agentTarget config provider targetBase safeName - agentWrite = - case provider of - InteractiveClaude -> - PlannedWrite {destination = dstFile, content = CopyFrom primarySource} - InteractiveCodex -> - PlannedWrite - { destination = dstFile, - content = WriteBytes (LBS.fromStrict (Text.Encoding.encodeUtf8 (agentAsCodexToml entry body))) - } - sidecarWrite = - PlannedWrite - { destination = sidecarPath provider (kitItemKind item) (Text.pack safeName) targetBase (sidecarFileName config), - content = WriteBytes (encode meta) - } - pure [agentWrite, sidecarWrite] - -safeAgentSources :: FilePath -> AgentEntry -> IO (FilePath, [FilePath], FilePath) -safeAgentSources repoDir entry = - case entry ^. #files of - Just files -> do - safePath <- requireSafe "agent path" (safeRelativePath (entry ^. #path)) - safeFiles <- traverse (requireSafe "agent file" . safeRelativePath) files - case safeFiles of - [] -> do - hPutStrLn stderr $ "Error: agent '" <> Text.unpack (entry ^. #name) <> "' has no source files." - exitFailure - primaryRel : _ -> do - let sourceBase = repoDir safePath - pure (sourceBase, safeFiles, sourceBase primaryRel) - Nothing -> do - safePath <- requireSafe "agent path" (safeRelativePath (entry ^. #path)) - let fileName = takeFileName safePath - pure (repoDir takeDirectory safePath, [fileName], repoDir safePath) - -requireSourceFile :: FilePath -> IO () -requireSourceFile path = do - exists <- doesFileExist path - unless exists (ioError (userError ("source file does not exist: " <> path))) - -executePlan :: [PlannedWrite] -> IO () -executePlan writes = do - tempPaths <- phaseOne [] writes - forM_ tempPaths $ \(temp, final) -> renameFile temp final - where - phaseOne temps [] = pure (reverse temps) - phaseOne temps (PlannedWrite {destination, content} : rest) = do - let temp = destination <> ".baikai-kit-tmp" - result <- - try @IOException $ do - createDirectoryIfMissing True (takeDirectory destination) - writeTemp content temp - pure (temp, destination) - case result of - Left e -> cleanupTemps temps >> throwIO e - Right tempPair -> - phaseOne (tempPair : temps) rest - `catch` \(e :: IOException) -> cleanupTemps (tempPair : temps) >> throwIO e - - writeTemp (CopyFrom src) temp = LBS.readFile src >>= LBS.writeFile temp - writeTemp (WriteBytes bytes) temp = LBS.writeFile temp bytes - - cleanupTemps temps = - forM_ temps $ \(temp, _) -> do - _ <- try @IOException (removeFile temp) - pure () - -requireSafe :: Text -> Either Text a -> IO a -requireSafe what = \case - Right a -> pure a - Left reason -> do - hPutStrLn stderr $ "Error: unsafe " <> Text.unpack what <> ": " <> Text.unpack reason - exitFailure - -reinstallIfPresent :: KitConfig -> Text -> KitScope -> KitManifest -> IO () -reinstallIfPresent config n scope manifest = do - installed <- isInstalled config n scope - when installed $ - case lookupItem n manifest of - Nothing -> pure () - Just item -> do - repoDir <- kitCacheDir config - doInstall config repoDir item scope - Text.IO.putStrLn $ "Updated '" <> n <> "' (" <> scopeLabel scope <> ")" - -reinstallAllPresent :: KitConfig -> KitManifest -> IO () -reinstallAllPresent config manifest = do - let allNames = - map (view #name) (manifest ^. #skills) - ++ map (view #name) (manifest ^. #agents) - repoDir <- kitCacheDir config - updated <- fmap sum $ forM allNames $ \n -> do - userInstalled <- isInstalled config n UserScope - projectInstalled <- isInstalled config n ProjectScope - let count = (if userInstalled then 1 else 0) + (if projectInstalled then 1 else 0) :: Int - when userInstalled $ - case lookupItem n manifest of - Nothing -> pure () - Just item -> doInstall config repoDir item UserScope - when projectInstalled $ - case lookupItem n manifest of - Nothing -> pure () - Just item -> doInstall config repoDir item ProjectScope - pure count - Text.IO.putStrLn $ "Updated " <> Text.pack (show updated) <> " item(s)." - -isInstalled :: KitConfig -> Text -> KitScope -> IO Bool -isInstalled config n scope = do - safeName <- requireSafe "item name" (safeItemName n) - results <- forM (config ^. #providers) $ \provider -> do - providerBase <- providerAgentsBase config provider scope - skillExists <- doesDirectoryExist (skillTarget config provider providerBase safeName) - agentExists <- doesFileExist (agentTarget config provider providerBase safeName) - pure (skillExists || agentExists) - pure (or results) - -removeIfDirectory :: FilePath -> IO Bool -removeIfDirectory dir = do - exists <- doesDirectoryExist dir - when exists (removeDirectoryRecursive dir) - pure exists - -removeIfFile :: FilePath -> IO Bool -removeIfFile file = do - exists <- doesFileExist file - when exists (removeFile file) - pure exists - -skillTarget :: KitConfig -> InteractiveProvider -> FilePath -> FilePath -> FilePath -skillTarget _config provider targetBase n = - targetBase skillTargetPath provider InteractiveProjectScope n - -agentTarget :: KitConfig -> InteractiveProvider -> FilePath -> FilePath -> FilePath -agentTarget _config provider targetBase n = - targetBase agentTargetPath provider InteractiveProjectScope n - -agentSidecarTarget :: KitConfig -> InteractiveProvider -> FilePath -> FilePath -> FilePath -agentSidecarTarget config provider targetBase n = - sidecarPath provider AgentKind (Text.pack n) targetBase (sidecarFileName config) - -skillNameDesc :: SkillEntry -> (Text, Text) -skillNameDesc entry = (entry ^. #name, entry ^. #description) - -agentNameDesc :: AgentEntry -> (Text, Text) -agentNameDesc entry = (entry ^. #name, entry ^. #description) - -agentAsCodexToml :: AgentEntry -> Text -> Text -agentAsCodexToml entry body = - codexCustomAgentToml - CodexCustomAgent - { name = entry ^. #name, - description = entry ^. #description, - developerInstructions = stripYamlFrontmatter body - } - -stripYamlFrontmatter :: Text -> Text -stripYamlFrontmatter input = - case map dropCr (Text.splitOn "\n" input) of - "---" : rest - | (_, _ : body) <- break (== "---") rest -> - Text.intercalate "\n" body - _ -> input - where - dropCr = Text.dropWhileEnd (== '\r') +-- | Reading the manifest and installing what it lists. +-- +-- Every function here returns @'Either' 'KitError' a@ and prints +-- nothing: rendering and exiting belong to 'Baikai.Kit.Command.runKit'. +-- Internally the module raises 'KitError' and catches it at each +-- exported boundary, which keeps the plumbing readable without changing +-- what a caller observes. +module Baikai.Kit.Install + ( InstallOptions (..), + defaultInstallOptions, + VisibilityCheck (..), + checkVisibility, + checkVisibilityWithEntries, + relativeLinkTarget, + loadManifest, + loadManifestMaybe, + lookupItem, + installItem, + installFrom, + uninstallItem, + renderUninstallReport, + RemovalOutcome (..), + OverwritePolicy (..), + UpdateReport (..), + updateKit, + reinstallPresent, + LocalEdits (..), + checkLocalEdits, + listAvailable, + renderAvailable, + PlannedWrite (..), + WriteContent (..), + executePlan, + executePlanWith, + stripYamlFrontmatter, + ) +where + +import Baikai.AgentAssets + ( 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, + KitItem (..), + KitItemKind (..), + KitManifest (..), + 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 (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 (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 + ( createDirectoryIfMissing, + doesDirectoryExist, + doesFileExist, + removeDirectoryRecursive, + 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 + { destination :: !FilePath, + content :: !WriteContent + } + deriving stock (Generic, Show) + +data WriteContent + = CopyFrom !FilePath + | WriteBytes !LBS.ByteString + deriving stock (Show) + +data RemovalOutcome = RemovalOutcome + { provider :: !InteractiveProvider, + skillRemoved :: !Bool, + agentRemoved :: !Bool, + sidecarRemoved :: !Bool, + linksRemoved :: ![FilePath], + configEntriesRemoved :: ![FilePath] + } + deriving stock (Eq, Generic, Show) + +-- | What @kit update@ should do with an item whose installed files were +-- edited after they were installed. +data OverwritePolicy + = KeepLocalEdits + | OverwriteLocalEdits + deriving stock (Eq, Show) + +-- | What @kit update@ did, for the caller to render. @refresh@ is +-- 'Nothing' when no refresh was attempted, which is what +-- 'reinstallPresent' reports. +data UpdateReport = UpdateReport + { refresh :: !(Maybe RepoRefresh), + updated :: ![(Text, KitScope)], + skipped :: ![(Text, KitScope)] + } + deriving stock (Eq, Generic, Show) + +-- | Read and validate the manifest at @

/kit.json@. +loadManifest :: FilePath -> IO (Either KitError KitManifest) +loadManifest = kitTry . loadManifestIO + +-- | The same, tolerating an absent cache or an absent manifest. A +-- manifest that is present but unreadable is still a 'Left'. +loadManifestMaybe :: FilePath -> IO (Either KitError (Maybe KitManifest)) +loadManifestMaybe "" = pure (Right Nothing) +loadManifestMaybe cacheDir = kitTry $ do + exists <- doesFileExist (cacheDir "kit.json") + if exists then Just <$> loadManifestIO cacheDir else pure Nothing + +lookupItem :: Text -> KitManifest -> Maybe KitItem +lookupItem n manifest = + case find (\entry -> entry ^. #name == n) (manifest ^. #skills) of + Just skill -> Just (KitSkillItem skill) + Nothing -> KitAgentItem <$> find (\entry -> entry ^. #name == n) (manifest ^. #agents) + +-- | Refresh the cache, read the manifest and install one item. The +-- '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 -> 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 options + +-- | The network-free half of 'installItem': install one item from a +-- manifest already read out of @repoDir@. +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. +uninstallItem :: KitConfig -> Text -> KitScope -> IO (Either KitError [RemovalOutcome]) +uninstallItem config n scope = kitTry $ do + safeName <- orThrow (KitUnsafeName n) (safeItemName n) + forM (config ^. #providers) $ \provider -> do + providerBase <- providerAgentsBase config provider scope + 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 <- 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, + linksRemoved = links, + configEntriesRemoved = removedEntries + } + +renderUninstallReport :: Text -> KitScope -> [RemovalOutcome] -> Text +renderUninstallReport n scope outcomes + | any assetRemoved outcomes = + "Uninstalled " + <> Text.intercalate "+" removedKinds + <> " '" + <> n + <> "' from " + <> scopeLabel scope + <> " scope (" + <> Text.intercalate "," removedProviders + <> ")." + <> visibilityRemovalNote + | any (^. #sidecarRemoved) outcomes = + "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] + ++ ["agent" | any (^. #agentRemoved) outcomes] + removedProviders = map (providerLabel . view #provider) (filter assetRemoved outcomes) + +-- | Refresh the cache and reinstall the items that are already installed. +-- A failed refresh is an error here, unlike the other verbs: fetching +-- is what update is for. +updateKit :: KitConfig -> Maybe Text -> OverwritePolicy -> IO (Either KitError UpdateReport) +updateKit config mName policy = kitTry $ do + cacheDir <- kitCacheDir config + isCheckout <- doesDirectoryExist (cacheDir ".git") + refreshed <- + if isCheckout + then do + result <- pullKitRepo config cacheDir + case result of + PullSucceeded -> pure RepoPulled + PullFailed err -> throwIO (KitPullFailed err) + else do + repo <- requireRepo config + case repo ^. #refresh of + RepoStale err -> throwIO (KitCloneFailed (config ^. #repoUrl) err) + fresh -> pure fresh + manifest <- loadManifestIO cacheDir + report <- reinstallPresentIO config cacheDir manifest mName policy + pure (report & #refresh .~ Just refreshed) + +-- | The network-free second half of 'updateKit': reinstall what is +-- already installed from a manifest already read out of @repoDir@. +-- +-- Under 'KeepLocalEdits' an item whose installed files no longer hash +-- to what its sidecar recorded is skipped rather than overwritten. A +-- sidecar written before those fields existed carries no hash, so such +-- an item is reinstalled without the check. +reinstallPresent :: + KitConfig -> + FilePath -> + KitManifest -> + Maybe Text -> + OverwritePolicy -> + IO (Either KitError UpdateReport) +reinstallPresent config repoDir manifest mName policy = + kitTry (reinstallPresentIO config repoDir manifest mName policy) + +-- | Refresh the cache and read the manifest of what the kit offers. +listAvailable :: KitConfig -> IO (Either KitError KitManifest) +listAvailable config = kitTry $ do + repo <- requireRepo config + loadManifestIO (repo ^. #dir) + +-- | The listing @kit list@ prints, without a trailing newline. +renderAvailable :: KitManifest -> Text +renderAvailable manifest + | null skills && null agents = "No items available in the kit." + | otherwise = Text.intercalate "\n" (skillBlock ++ gap ++ agentBlock) + where + skills = manifest ^. #skills + agents = manifest ^. #agents + gap = ["" | not (null skills), not (null agents)] + skillBlock + | null skills = [] + | otherwise = "Skills:" : map (entryLine (columnWidth (map (view #name) skills)) . skillNameDesc) skills + agentBlock + | null agents = [] + | otherwise = "Agents:" : map (entryLine (columnWidth (map (view #name) agents)) . agentNameDesc) agents + columnWidth names = maximum (map Text.length names) + entryLine width (n, desc) = " " <> Text.justifyLeft (width + 2) ' ' n <> desc + +-- | Put a plan in place, or leave the filesystem as it was. +-- +-- Phase one writes every payload to a uniquely named temporary file in +-- its destination's directory. Phase two, per entry, moves an existing +-- destination aside to a unique backup and renames the temporary into +-- place, journalling both; a failure restores every completed entry in +-- reverse, removes the remaining temporaries and reports which paths +-- were restored and which could not be. Same-directory renames are +-- atomic on POSIX, so a reader sees either the old file or the new one. +executePlan :: [PlannedWrite] -> IO (Either KitError ()) +executePlan = executePlanWith renameFile + +-- | 'executePlan' with an injectable rename step. A test seam; not part +-- of the stable surface. +executePlanWith :: (FilePath -> FilePath -> IO ()) -> [PlannedWrite] -> IO (Either KitError ()) +executePlanWith renameInto writes = do + clash <- firstDirectoryDestination writes + case clash of + Just dest -> pure (Left (writeFailed ("destination is a directory: " <> Text.pack dest))) + Nothing -> do + staged <- stage [] writes + case staged of + Left err -> pure (Left err) + Right temps -> commit [] temps + where + writeFailed reason = KitWriteFailed reason [] [] + + firstDirectoryDestination [] = pure Nothing + firstDirectoryDestination (planned : rest) = do + let dest = planned ^. #destination + isDir <- doesDirectoryExist dest + if isDir then pure (Just dest) else firstDirectoryDestination rest + + -- Phase one. Nothing observable has changed while this runs, so a + -- failure removes the temporaries and reports no changes. + stage staged [] = pure (Right (reverse staged)) + stage staged (planned : rest) = do + result <- try @IOException (stageOne planned) + case result of + Left e -> do + removeTemps staged + pure (Left (writeFailed (Text.pack (show e)))) + Right pair -> stage (pair : staged) rest + + stageOne planned = do + let dest = planned ^. #destination + dir = takeDirectory dest + bytes <- payload (planned ^. #content) + createDirectoryIfMissing True dir + -- 'openTempFile' splits the template at its last extension, so the + -- file is named .baikai-kit-tmp: unique, and still + -- carrying the suffix a residue check looks for. + (temp, handle) <- openTempFile dir (takeFileName dest <> ".baikai-kit-tmp") + (LBS.hPut handle bytes >> hClose handle) + `onException` (hClose handle >> ignoring (removeFile temp)) + pure (temp, dest) + + payload (CopyFrom src) = LBS.readFile src + payload (WriteBytes bytes) = pure bytes + + -- Phase two. Every entry that changed anything is journalled with the + -- backup it displaced and whether its rename completed. + commit journal [] = do + forM_ journal $ \(_, mBackup, _) -> forM_ mBackup (ignoring . removeFile) + pure (Right ()) + commit journal (entry@(temp, dest) : rest) = do + backed <- try @IOException (backupExisting dest) + case backed of + Left e -> unwind journal (entry : rest) e + Right mBackup -> do + renamed <- try @IOException (renameInto temp dest) + case renamed of + Left e -> unwind ((dest, mBackup, False) : journal) (entry : rest) e + Right () -> commit ((dest, mBackup, True) : journal) rest + + backupExisting dest = do + exists <- doesFileExist dest + if not exists + then pure Nothing + else do + (backup, handle) <- openTempFile (takeDirectory dest) (takeFileName dest <> ".baikai-kit-bak") + hClose handle + renameFile dest backup + pure (Just backup) + + unwind journal remaining e = do + outcomes <- forM (filter changedSomething journal) $ \(dest, mBackup, renamed) -> do + restored <- try @IOException (restoreEntry dest mBackup renamed) + pure (dest, either (const False) (const True) (restored :: Either IOException ())) + removeTemps remaining + pure . Left $ + KitWriteFailed + (Text.pack (show e)) + [dest | (dest, True) <- outcomes] + [dest | (dest, False) <- outcomes] + + changedSomething (_, mBackup, renamed) = renamed || has _Just mBackup + + restoreEntry dest (Just backup) _ = renameFile backup dest + restoreEntry dest Nothing True = removeFile dest + restoreEntry _ Nothing False = pure () + + removeTemps entries = forM_ entries $ \(temp, _) -> ignoring (removeFile temp) + + ignoring action = do + _ <- try @IOException action + pure () + +-- Internal ------------------------------------------------------------ + +loadManifestIO :: FilePath -> IO KitManifest +loadManifestIO repoDir = do + let manifestPath = repoDir "kit.json" + exists <- doesFileExist manifestPath + unless exists (throwIO (KitManifestMissing manifestPath)) + result <- eitherDecodeFileStrict' manifestPath + case result of + Left err -> throwIO (KitManifestInvalid manifestPath (Text.pack err)) + Right manifest -> do + let declared = manifest ^. #version + unless (declared `elem` supportedManifestVersions) $ + throwIO (KitManifestVersionUnsupported manifestPath declared) + pure manifest + +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 + choices <- prepareVisibility config item scope (Just options) + doInstall config repoDir item scope choices + pure item + +requireRepo :: KitConfig -> IO KitRepo +requireRepo config = ensureKitRepo config >>= either throwIO pure + +reinstallPresentIO :: + KitConfig -> + FilePath -> + KitManifest -> + Maybe Text -> + OverwritePolicy -> + IO UpdateReport +reinstallPresentIO config repoDir manifest mName policy = do + results <- + fmap concat . forM candidates $ \n -> + fmap concat . forM [UserScope, ProjectScope] $ \scope -> do + installed <- isInstalled config n scope + case (installed, lookupItem n manifest) of + (True, Just item) -> do + modified <- case policy of + OverwriteLocalEdits -> pure False + KeepLocalEdits -> locallyModified config item scope + choices <- prepareVisibility config item scope Nothing + if modified + then do + repairSkippedVisibility choices + pure [Left (n, scope)] + else do + doInstall config repoDir item scope choices + pure [Right (n, scope)] + _ -> pure [] + pure + UpdateReport + { refresh = Nothing, + updated = [entry | Right entry <- results], + skipped = [entry | Left entry <- results] + } + where + candidates = case mName of + Just n -> [n] + Nothing -> + map (view #name) (manifest ^. #skills) + ++ map (view #name) (manifest ^. #agents) + +-- | 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 + checks <- forM (config ^. #providers) $ \provider -> + localEditsIO config provider scope (kitItemKind item) (itemName item) + pure (Edited `elem` checks) + +-- | 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 + { relativeName :: !FilePath, + target :: !FilePath, + bytes :: !LBS.ByteString + } + deriving stock (Generic) + +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 + contents <- forM resolved $ \(rel, path) -> do + read' <- try @IOException (BS.readFile path) + case read' of + Left e -> throwIO (KitSourceUnreadable path (Text.pack (show e))) + Right raw -> pure (rel, path, raw) + let upstreamHash = hashEntries [(rel, raw) | (rel, _, raw) <- contents] + fmap concat $ + 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 + (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 + ] + sidecarWrite = + PlannedWrite + { destination = + sidecarPath provider (kitItemKind item) (Text.pack safeName) targetBase (sidecarFileName config), + content = WriteBytes (encode meta) + } + pure (assetWrites ++ [sidecarWrite]) + +-- | Turn an item's sources into what one provider gets. A skill's files +-- keep their names below the skill directory. An agent's first file +-- becomes the provider's agent file — copied for Claude, rendered to +-- TOML for Codex — and every remaining file goes into a resource +-- directory named after the agent beside it, because both providers' +-- agent directories are flat and a stray Markdown file there would be +-- discovered as a bogus agent. +providerAssets :: + KitConfig -> + InteractiveProvider -> + FilePath -> + FilePath -> + KitItem -> + [(FilePath, FilePath, BS.ByteString)] -> + IO [PlannedAsset] +providerAssets config provider targetBase safeName (KitSkillItem _) contents = + pure + [ PlannedAsset + { relativeName = rel, + target = skillTarget config provider targetBase safeName rel, + bytes = LBS.fromStrict raw + } + | (rel, _, raw) <- contents + ] +providerAssets config provider targetBase safeName (KitAgentItem entry) contents = + case contents of + [] -> throwIO (KitItemHasNoFiles (entry ^. #name)) + (_, primaryPath, primaryRaw) : extras -> do + let agentFile = agentTarget config provider targetBase safeName + resourceDir = agentResourceDir config provider targetBase safeName + body <- decodeSource primaryPath primaryRaw + let primaryBytes = case provider of + InteractiveClaude -> LBS.fromStrict primaryRaw + InteractiveCodex -> LBS.fromStrict (Text.Encoding.encodeUtf8 (agentAsCodexToml entry body)) + pure $ + PlannedAsset + { relativeName = takeFileName agentFile, + target = agentFile, + bytes = primaryBytes + } + : [ PlannedAsset + { relativeName = safeName rel, + target = resourceDir rel, + bytes = LBS.fromStrict raw + } + | (rel, _, raw) <- extras + ] + +-- | Agent bodies are UTF-8, not whatever the locale says. (ADR 0007.) +decodeSource :: FilePath -> BS.ByteString -> IO Text +decodeSource path raw = + case Text.Encoding.decodeUtf8' raw of + Left err -> throwIO (KitSourceUnreadable path (Text.pack (show err))) + Right text -> pure text + +-- | Resolve every listed file through 'safeSourcePath', pairing the name +-- relative to the item's base with the absolute path to read. +resolveSources :: FilePath -> ItemSources -> IO [(FilePath, FilePath)] +resolveSources repoDir sources = + forM (sources ^. #files) $ \rel -> do + resolved <- safeSourcePath repoDir ((sources ^. #base) rel) + (rel,) <$> either throwIO pure resolved + +isInstalled :: KitConfig -> Text -> KitScope -> IO Bool +isInstalled config n scope = do + safeName <- orThrow (KitUnsafeName n) (safeItemName n) + results <- forM (config ^. #providers) $ \provider -> do + providerBase <- providerAgentsBase config provider scope + skillExists <- doesDirectoryExist (skillTarget config provider providerBase safeName) + agentExists <- doesFileExist (agentTarget config provider providerBase safeName) + 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 +-- value. Only 'KitError' is caught; anything else propagates. +kitTry :: IO a -> IO (Either KitError a) +kitTry = try + +orThrow :: (Text -> KitError) -> Either Text a -> IO a +orThrow toError = either (throwIO . toError) pure + +removeIfDirectory :: FilePath -> IO Bool +removeIfDirectory dir = do + exists <- doesDirectoryExist dir + when exists (removeDirectoryRecursive dir) + pure exists + +removeIfFile :: FilePath -> IO Bool +removeIfFile file = do + exists <- doesFileExist file + when exists (removeFile file) + pure exists + +skillTarget :: KitConfig -> InteractiveProvider -> FilePath -> FilePath -> FilePath +skillTarget _config provider targetBase n = + targetBase skillTargetPath provider InteractiveProjectScope n + +agentTarget :: KitConfig -> InteractiveProvider -> FilePath -> FilePath -> FilePath +agentTarget _config provider targetBase n = + targetBase agentTargetPath provider InteractiveProjectScope n + +-- | Where a multi-file agent's extra files live: beside its agent file, +-- in a directory named after the agent. +agentResourceDir :: KitConfig -> InteractiveProvider -> FilePath -> FilePath -> FilePath +agentResourceDir config provider targetBase n = + takeDirectory (agentTarget config provider targetBase n) n + +-- | The directory the names in a sidecar's @installedFiles@ are relative +-- to, per provider and kind. +installedRoot :: KitConfig -> InteractiveProvider -> FilePath -> KitItemKind -> FilePath -> FilePath +installedRoot config provider targetBase SkillKind n = skillTarget config provider targetBase n +installedRoot config provider targetBase AgentKind n = + takeDirectory (agentTarget config provider targetBase n) + +agentSidecarTarget :: KitConfig -> InteractiveProvider -> FilePath -> FilePath -> FilePath +agentSidecarTarget config provider targetBase n = + sidecarPath provider AgentKind (Text.pack n) targetBase (sidecarFileName config) + +skillNameDesc :: SkillEntry -> (Text, Text) +skillNameDesc entry = (entry ^. #name, entry ^. #description) + +agentNameDesc :: AgentEntry -> (Text, Text) +agentNameDesc entry = (entry ^. #name, entry ^. #description) + +agentAsCodexToml :: AgentEntry -> Text -> Text +agentAsCodexToml entry body = + codexCustomAgentToml + CodexCustomAgent + { name = entry ^. #name, + description = entry ^. #description, + developerInstructions = stripYamlFrontmatter body + } + +-- | Drop a leading YAML frontmatter block and normalise line endings to +-- LF. Every branch normalises, including input with no frontmatter and +-- input whose frontmatter is never closed. +stripYamlFrontmatter :: Text -> Text +stripYamlFrontmatter input = + case textLines of + firstLine : rest + | isDelimiter firstLine, + (_, _ : body) <- break isDelimiter rest -> + Text.intercalate "\n" body + _ -> Text.intercalate "\n" textLines + where + textLines = map (Text.dropWhileEnd (== '\r')) (Text.splitOn "\n" input) + isDelimiter = (== "---") . Text.stripEnd 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 @@ -1,21 +1,27 @@ module Baikai.Kit.Manifest ( AgentEntry (..), + ItemSources (..), KitItem (..), KitItemKind (..), KitManifest (..), SkillEntry (..), - agentSources, itemKind, itemName, + itemSources, itemVersion, + itemVisibility, kitItemKind, kindLabel, + supportedManifestVersions, ) where +import Baikai.Kit.Error (KitError (..)) +import Baikai.Kit.Path (safeItemName, safeRelativePath) +import Baikai.Kit.Visibility (KitVisibility (..)) import Baikai.Prelude -import Data.Text qualified as Text -import System.FilePath (takeFileName, ()) +import Data.Bifunctor (first) +import System.FilePath (takeDirectory, takeFileName) data KitManifest = KitManifest { version :: !Int, @@ -30,7 +36,8 @@ description :: !Text, version :: !(Maybe Text), path :: !Text, - files :: ![Text] + files :: ![Text], + visibility :: !(Maybe KitVisibility) } deriving stock (Generic, Show) deriving anyclass (FromJSON) @@ -40,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) @@ -55,14 +63,50 @@ | AgentKind deriving stock (Eq, Ord, Show) -agentSources :: AgentEntry -> [(FilePath, FilePath)] -agentSources entry = - case entry ^. #files of - Just fs -> [(Text.unpack (entry ^. #path) Text.unpack f, Text.unpack f) | f <- fs] - Nothing -> - let source = Text.unpack (entry ^. #path) - in [(source, takeFileName source)] +-- | The manifest versions this installer understands. Both decode +-- identically today; a future version with different semantics must be +-- refused rather than misinstalled. +supportedManifestVersions :: [Int] +supportedManifestVersions = [1, 2] +-- | Where an item's files live inside the kit checkout: a directory +-- relative to the checkout and file names relative to that directory +-- (the first is the agent body for agents). +-- +-- Lexically validated; physical checks are +-- 'Baikai.Kit.Path.safeSourcePath'. +data ItemSources = ItemSources + { base :: !FilePath, + files :: ![FilePath] + } + deriving stock (Eq, Generic, Show) + +-- | Derive an item's source list. Fails with 'KitUnsafeName', +-- 'KitUnsafePath' or 'KitItemHasNoFiles'. The item name is validated +-- here too, so every consumer of the result has already seen it pass. +itemSources :: KitItem -> Either KitError ItemSources +itemSources item = do + _ <- first (KitUnsafeName (itemName item)) (safeItemName (itemName item)) + case item of + KitSkillItem entry -> do + base <- lexPath (entry ^. #path) + files <- traverse lexPath (entry ^. #files) + nonEmpty ItemSources {base, files} + KitAgentItem entry -> + case entry ^. #files of + Just declared -> do + base <- lexPath (entry ^. #path) + files <- traverse lexPath declared + nonEmpty ItemSources {base, files} + Nothing -> do + source <- lexPath (entry ^. #path) + pure ItemSources {base = takeDirectory source, files = [takeFileName source]} + where + lexPath raw = first (KitUnsafePath raw) (safeRelativePath raw) + nonEmpty sources + | null (sources ^. #files) = Left (KitItemHasNoFiles (itemName item)) + | otherwise = Right sources + itemName :: KitItem -> Text itemName (KitSkillItem entry) = entry ^. #name itemName (KitAgentItem entry) = entry ^. #name @@ -82,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/Path.hs b/src/Baikai/Kit/Path.hs --- a/src/Baikai/Kit/Path.hs +++ b/src/Baikai/Kit/Path.hs @@ -1,12 +1,16 @@ module Baikai.Kit.Path ( safeItemName, safeRelativePath, - safeUnder, + safeSourcePath, ) where +import Baikai.Kit.Error (KitError (..)) import Baikai.Prelude +import Control.Exception (IOException, try) +import Data.List (isPrefixOf) import Data.Text qualified as Text +import System.Directory (canonicalizePath, doesFileExist, doesPathExist, pathIsSymbolicLink) import System.FilePath (isAbsolute, normalise, splitDirectories, ()) safeRelativePath :: Text -> Either Text FilePath @@ -36,5 +40,58 @@ | length (splitDirectories name) /= 1 = Left "name must be a single path segment" | otherwise = Right name -safeUnder :: FilePath -> Text -> Either Text FilePath -safeUnder base rel = (base ) <$> safeRelativePath rel +-- | Resolve an untrusted relative source path below a trusted kit +-- checkout. +-- +-- Runs 'safeRelativePath' on the relative path, then walks every prefix +-- of it below @root@: a prefix that does not exist is +-- 'KitSourceMissing', a prefix that is a symbolic link +-- ('pathIsSymbolicLink') is 'KitSourceSymlink'. Finally the canonical +-- form of the full path must lie component-wise below the canonical +-- form of @root@ ('canonicalizePath' on both, compared with +-- 'splitDirectories'), else 'KitSourceEscapes', and the full path must +-- be a regular file ('doesFileExist'), else 'KitSourceMissing'. Any +-- 'IOException' raised while inspecting a prefix is +-- 'KitSourceUnreadable'. Returns @root '' rel@. +-- +-- Check-then-read: the caller reads the returned path afterwards; a +-- writer to the checkout could swap a file for a link in between, which +-- is accepted because the checkout is owned by the invoking user and +-- written only by git before this runs. +safeSourcePath :: FilePath -> FilePath -> IO (Either KitError FilePath) +safeSourcePath root rel = + case safeRelativePath (Text.pack rel) of + Left reason -> pure (Left (KitUnsafePath (Text.pack rel) reason)) + Right validated -> do + let full = root validated + components = filter (/= ".") (splitDirectories validated) + outcome <- try @IOException (inspect root full components) + pure (either (Left . KitSourceUnreadable full . Text.pack . show) id outcome) + where + inspect base full components = do + walked <- walkPrefixes base components + case walked of + Just err -> pure (Left err) + Nothing -> do + canonRoot <- canonicalizePath base + canonFull <- canonicalizePath full + if not (splitDirectories canonRoot `isPrefixOf` splitDirectories canonFull) + then pure (Left (KitSourceEscapes canonFull canonRoot)) + else do + isFile <- doesFileExist full + pure (if isFile then Right full else Left (KitSourceMissing full)) + + walkPrefixes _ [] = pure Nothing + walkPrefixes base (component : rest) = do + let here = base component + -- 'doesPathExist' is False for a dangling link, which refuses the + -- path without following it; 'pathIsSymbolicLink' throws when the + -- path is absent, so the existence check comes first. + exists <- doesPathExist here + if not exists + then pure (Just (KitSourceMissing here)) + else do + isLink <- pathIsSymbolicLink here + if isLink + then pure (Just (KitSourceSymlink here)) + else walkPrefixes here rest diff --git a/src/Baikai/Kit/Repo.hs b/src/Baikai/Kit/Repo.hs --- a/src/Baikai/Kit/Repo.hs +++ b/src/Baikai/Kit/Repo.hs @@ -1,19 +1,20 @@ module Baikai.Kit.Repo - ( ensureKitRepo, + ( KitRepo (..), + RepoRefresh (..), + ensureKitRepo, PullResult (..), pullKitRepo, ) where import Baikai.Kit.Config (KitConfig, kitCacheDir) +import Baikai.Kit.Error (KitError (..)) import Baikai.Prelude import Control.Exception (IOException, try) import Data.Text qualified as Text -import Data.Text.IO qualified as Text.IO import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist) -import System.Exit (ExitCode (..), exitFailure) +import System.Exit (ExitCode (..)) import System.FilePath (()) -import System.IO (hPutStrLn, stderr) import System.Process (readProcessWithExitCode) data PullResult @@ -21,37 +22,58 @@ | PullFailed !Text deriving stock (Eq, Show) -ensureKitRepo :: KitConfig -> IO FilePath +-- | What happened to the cache on the way to returning it. +data RepoRefresh + = -- | The cache did not exist and was cloned. + RepoCloned + | -- | The cache existed and was pulled. + RepoPulled + | -- | The refresh failed and the cached copy is being used as it is; + -- the 'Text' is git's output. A caller that needs fresh content + -- (@kit update@) treats this as a failure; the others warn. + RepoStale !Text + deriving stock (Eq, Show) + +data KitRepo = KitRepo + { dir :: !FilePath, + refresh :: !RepoRefresh + } + deriving stock (Eq, Generic, Show) + +-- | Resolve the kit cache, refreshing it if it is already a checkout and +-- cloning it if it is not. Never prints and never exits: a first clone +-- that fails with no usable cache is 'KitCloneFailed', and a failed +-- refresh over a usable cache is 'RepoStale'. +ensureKitRepo :: KitConfig -> IO (Either KitError KitRepo) ensureKitRepo config = do cacheDir <- kitCacheDir config exists <- doesDirectoryExist (cacheDir ".git") if exists then do result <- pullKitRepo config cacheDir - case result of - PullSucceeded -> pure () - PullFailed err -> - hPutStrLn stderr $ "Warning: git pull failed, using cached data. " <> Text.unpack err - pure cacheDir + pure . Right $ case result of + PullSucceeded -> KitRepo {dir = cacheDir, refresh = RepoPulled} + PullFailed err -> KitRepo {dir = cacheDir, refresh = RepoStale err} else do - Text.IO.putStrLn $ "Fetching " <> (config ^. #toolName) <> "-kit..." - createDirectoryIfMissing True cacheDir - (exitCode, _, errOut) <- - readProcessWithExitCode - "git" - ["clone", "--depth", "1", Text.unpack (config ^. #repoUrl), cacheDir] - "" - case exitCode of - ExitSuccess -> pure cacheDir - ExitFailure _ -> do - manifestExists <- doesFileExist (cacheDir "kit.json") - if manifestExists - then do - hPutStrLn stderr $ "Warning: git clone failed, using cached data. " <> errOut - pure cacheDir - else do - hPutStrLn stderr $ "Error: Failed to fetch kit repository: " <> errOut - exitFailure + cloned <- + try @IOException $ do + createDirectoryIfMissing True cacheDir + readProcessWithExitCode + "git" + ["clone", "--depth", "1", Text.unpack (config ^. #repoUrl), cacheDir] + "" + case cloned of + -- A missing `git` binary arrives here as an IOException. + Left e -> staleOrFailed cacheDir (Text.pack (show e)) + Right (ExitSuccess, _, _) -> pure (Right KitRepo {dir = cacheDir, refresh = RepoCloned}) + Right (ExitFailure _, _, errOut) -> staleOrFailed cacheDir (Text.pack errOut) + where + staleOrFailed cacheDir output = do + manifestExists <- doesFileExist (cacheDir "kit.json") + pure $ + if manifestExists + then Right KitRepo {dir = cacheDir, refresh = RepoStale output} + else Left (KitCloneFailed (config ^. #repoUrl) output) pullKitRepo :: KitConfig -> FilePath -> IO PullResult pullKitRepo _config cacheDir = do 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 @@ -1,58 +1,97 @@ module Baikai.Kit.Sidecar ( SidecarMeta (..), computeKitHash, + hashEntries, newSidecarMeta, sidecarPath, readSidecar, - writeSidecar, ) where import Baikai.AgentAssets (AgentAssetProvider, agentTargetPath, skillTargetPath) import Baikai.Interactive (InteractiveScope (InteractiveProjectScope)) -import Baikai.Kit.Manifest (KitItem, KitItemKind (..), itemKind, itemName, itemVersion, kitItemKind) -import Baikai.Kit.Path (safeRelativePath) +import Baikai.Kit.Error (KitError (..)) +import Baikai.Kit.Manifest (KitItem, KitItemKind (..), itemKind, itemName, itemVersion) +import Baikai.Kit.Path (safeSourcePath) import Baikai.Prelude +import Control.Exception (IOException, try) import Crypto.Hash (Digest, SHA256) import Crypto.Hash qualified as Hash -import Data.Aeson (eitherDecodeFileStrict', encode) +import Data.Aeson (eitherDecodeFileStrict') import Data.Binary.Put (putWord64be, runPut) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS -import Data.List (sort) +import Data.List (sortOn) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text.Encoding import Data.Time.Clock (getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime) -import System.Directory (createDirectoryIfMissing, doesFileExist) -import System.FilePath (dropExtension, takeDirectory, ()) +import System.Directory (doesFileExist) +import System.FilePath (dropExtension, ()) import System.IO (hPutStrLn, stderr) +-- | The metadata written beside each installed asset. +-- +-- @installedFiles@ and @installedHash@ describe what this tool wrote +-- for one provider — the file names relative to that provider's target +-- directory, and the hash of exactly those bytes — so @kit update@ can +-- tell a file the user edited from one it installed. Both are 'Nothing' +-- in sidecars written before those fields existed, and such an item is +-- updated without the check. data SidecarMeta = SidecarMeta { name :: !Text, kind :: !Text, version :: !(Maybe Text), hash :: !Text, - installedAt :: !Text + installedAt :: !Text, + installedFiles :: !(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) -computeKitHash :: FilePath -> [Text] -> IO Text -computeKitHash baseDir relFiles = do - chunks <- mapM (readOne baseDir) (sort relFiles) - let digest = Hash.hash (BS.concat chunks) :: Digest SHA256 - hex = Text.pack (show digest) - pure ("sha256:" <> hex) +-- | Content hash of the listed files, which lie at @base '' file@ +-- below the kit checkout @root@. +-- +-- The hashed bytes are, per file sorted by name: the file name relative +-- to @base@, NUL, the big-endian length, the content, NUL — unchanged +-- from earlier releases, so existing sidecars keep matching. Every file +-- is resolved through 'safeSourcePath' first, so a symbolic link +-- anywhere below @root@ refuses the hash instead of being read through. +computeKitHash :: FilePath -> FilePath -> [FilePath] -> IO (Either KitError Text) +computeKitHash root base relFiles = do + results <- traverse readOne relFiles + pure (hashEntries <$> sequence results) where - readOne :: FilePath -> Text -> IO BS.ByteString - readOne dir rel = do - safeRel <- either (ioError . userError . Text.unpack) pure (safeRelativePath rel) - content <- BS.readFile (dir safeRel) - let pathBytes = Text.Encoding.encodeUtf8 (Text.pack safeRel) - lenBytes = LBS.toStrict (runPut (putWord64be (fromIntegral (BS.length content)))) - pure $ BS.concat [pathBytes, BS.singleton 0x00, lenBytes, content, BS.singleton 0x00] + readOne :: FilePath -> IO (Either KitError (FilePath, BS.ByteString)) + readOne rel = do + resolved <- safeSourcePath root (base rel) + case resolved of + Left err -> pure (Left err) + Right path -> do + content <- try @IOException (BS.readFile path) + pure $ case content of + Left e -> Left (KitSourceUnreadable path (Text.pack (show e))) + Right bytes -> Right (rel, bytes) +-- | The pure core: hash already-read (relative name, bytes) pairs. +hashEntries :: [(FilePath, BS.ByteString)] -> Text +hashEntries entries = "sha256:" <> Text.pack (show digest) + where + digest = Hash.hash (BS.concat (map chunk (sortOn fst entries))) :: Digest SHA256 + chunk (rel, content) = + BS.concat + [ Text.Encoding.encodeUtf8 (Text.pack rel), + BS.singleton 0x00, + LBS.toStrict (runPut (putWord64be (fromIntegral (BS.length content)))), + content, + BS.singleton 0x00 + ] + sidecarPath :: AgentAssetProvider -> KitItemKind -> Text -> FilePath -> Text -> FilePath sidecarPath provider SkillKind itemName' targetBase sidecarName = targetBase @@ -76,15 +115,11 @@ hPutStrLn stderr $ "Warning: failed to parse sidecar " <> p <> ": " <> err pure Nothing -writeSidecar :: AgentAssetProvider -> KitItem -> FilePath -> Text -> Text -> IO () -writeSidecar provider item targetBase sidecarName hashStr = do - meta <- newSidecarMeta item hashStr - let out = sidecarPath provider (kitItemKind item) (itemName item) targetBase sidecarName - createDirectoryIfMissing True (takeDirectory out) - LBS.writeFile out (encode meta) - -newSidecarMeta :: KitItem -> Text -> IO SidecarMeta -newSidecarMeta item hashStr = do +-- | 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 -> 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 @@ -93,5 +128,11 @@ kind = itemKind item, version = itemVersion item, hash = hashStr, - installedAt = stamp + installedAt = stamp, + installedFiles = Just writtenFiles, + 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,39 +1,82 @@ 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.Install (loadManifestMaybe, lookupItem) -import Baikai.Kit.Manifest (AgentEntry, KitItem (..), KitItemKind (..), agentSources, itemKind, itemVersion, kindLabel) -import Baikai.Kit.Repo (ensureKitRepo) +import Baikai.Kit.Error (KitError (..)) +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.Exception (IOException, try) 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 Data.Text.IO qualified as Text.IO -import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) +import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath (takeDirectory, ()) -data KitState - = KitUpToDate - | KitOutdated - | KitDirty - | KitDirtyOutdated - | KitDelisted - | 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 + = -- | The cache was refreshed and its manifest read. + UpstreamReady + | -- | The cache could not be refreshed; the rows compare against the + -- copy already on disk. The 'Text' is git's output. + UpstreamStale !Text + | -- | There is no usable cache: the rows say what is installed and + -- nothing about how it compares. + UpstreamUnavailable !KitError + deriving stock (Eq, Show) + +-- | What @kit status@ found, for the caller to render. +data StatusReport = StatusReport + { upstream :: !UpstreamAvailability, + rows :: ![StatusRow] + } + deriving stock (Eq, Generic, Show) + data StatusRow = StatusRow { name :: !Text, kind :: !Text, @@ -41,51 +84,101 @@ 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" - KitDelisted -> "delisted" +-- | 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" + 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] -kitStatus :: KitConfig -> IO () +-- | Collect the status of everything installed. Needs no network: a kit +-- repository that cannot be reached is reported as +-- 'UpstreamUnavailable' and the installed rows are still returned. +kitStatus :: KitConfig -> IO StatusReport kitStatus config = do - cacheDir <- resolveCacheOrEmpty config - rows <- collectStatus config cacheDir [(UserScope, "user"), (ProjectScope, "project")] - renderStatusTable rows + repo <- ensureKitRepo config + case repo of + Left err -> report (UpstreamUnavailable err) "" + Right resolved -> do + let availability = case resolved ^. #refresh of + RepoStale err -> UpstreamStale err + RepoCloned -> UpstreamReady + RepoPulled -> UpstreamReady + manifest <- loadManifestMaybe (resolved ^. #dir) + case manifest of + Left err -> report (UpstreamUnavailable err) "" + Right Nothing -> report availability "" + Right (Just _) -> report availability (resolved ^. #dir) + where + report upstream cacheDir = do + rows <- collectStatus config cacheDir [(UserScope, "user"), (ProjectScope, "project")] + pure StatusReport {upstream, rows} collectStatus :: KitConfig -> FilePath -> [(KitScope, Text)] -> IO [StatusRow] collectStatus config cacheDir scopes = do - mManifest <- loadManifestMaybe cacheDir + -- 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)) - mUpstreamHash <- upstreamHash cacheDir mItem - let state' = classify mSidecar mItem mUpstreamHash + upstream <- upstreamHash cacheDir mItem + 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', @@ -94,32 +187,64 @@ providers = providerLabel provider, installedVersion = mSidecar >>= (^. #version), latestVersion = mItem >>= itemVersion, - state = state' + conditions = sort (nub (upstreamConditions ++ localConditions ++ visibilityConditions)), + requestedVisibility, + effectiveVisibility } -resolveCacheOrEmpty :: KitConfig -> IO FilePath -resolveCacheOrEmpty config = do - result <- try @IOException (ensureKitRepo config) - case result of - Right dir -> do - manifestExists <- doesFileExist (dir "kit.json") - pure (if manifestExists then dir else "") - Left _ -> pure "" +-- | 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) -upstreamHash :: FilePath -> Maybe KitItem -> IO (Maybe Text) -upstreamHash "" _ = pure Nothing -upstreamHash _ Nothing = pure Nothing -upstreamHash cacheDir (Just (KitSkillItem entry)) = - tryHash (cacheDir Text.unpack (entry ^. #path)) (entry ^. #files) -upstreamHash cacheDir (Just (KitAgentItem entry)) = - tryHash (agentSourceBase cacheDir entry) (map (Text.pack . snd) (agentSources entry)) +-- | 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) + } -tryHash :: FilePath -> [Text] -> IO (Maybe Text) -tryHash base files = do - result <- try @IOException (computeKitHash base files) - case result of - Right h -> pure (Just h) - Left _ -> pure Nothing +-- | 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, +-- no manifest entry, or an upstream source that is simply gone. A +-- 'Left' means the upstream listing is one this installer refuses to +-- read — a symbolic link, an escaping path, an unsafe manifest string — +-- which 'collectStatus' shows as 'KitUpstreamRefused'. +upstreamHash :: FilePath -> Maybe KitItem -> IO (Either KitError (Maybe Text)) +upstreamHash "" _ = pure (Right Nothing) +upstreamHash _ Nothing = pure (Right Nothing) +upstreamHash cacheDir (Just item) = + case itemSources item of + Left err -> pure (Left err) + Right sources -> do + result <- computeKitHash cacheDir (sources ^. #base) (sources ^. #files) + pure $ case result of + Left (KitSourceMissing _) -> Right Nothing + Left err -> Left err + Right h -> Right (Just h) scanInstalled :: KitConfig -> KitScope -> IO [(AgentAssetProvider, FilePath, Text, KitItemKind)] scanInstalled config scope = fmap concat $ @@ -148,41 +273,61 @@ pure [(provider, Text.pack (dropAgentExtension provider f), AgentKind) | f <- files] else pure [] -renderStatusTable :: [StatusRow] -> IO () -renderStatusTable [] = Text.IO.putStrLn "No kit items installed." -renderStatusTable rows = do - let displayRows = aggregateStatusRows rows - nameW = colWidth displayRows "NAME" (^. #name) - kindW = colWidth displayRows "TYPE" (^. #kind) - scopeW = colWidth displayRows "SCOPE" (^. #scope) - providersW = colWidth displayRows "PROVIDERS" (^. #providers) - instW = colWidth displayRows "INSTALLED" (renderMVer . view #installedVersion) - latW = colWidth displayRows "LATEST" (renderMVer . view #latestVersion) - hdr = - Text.justifyLeft (nameW + 2) ' ' "NAME" - <> Text.justifyLeft (kindW + 2) ' ' "TYPE" - <> Text.justifyLeft (scopeW + 2) ' ' "SCOPE" - <> Text.justifyLeft (providersW + 2) ' ' "PROVIDERS" - <> Text.justifyLeft (instW + 2) ' ' "INSTALLED" - <> Text.justifyLeft (latW + 2) ' ' "LATEST" - <> "STATE" - Text.IO.putStrLn hdr - mapM_ (printRow nameW kindW scopeW providersW instW latW) displayRows +-- | 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 ++ legacyNote) where - colWidth displayRows colTitle f = + 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 = + Text.justifyLeft (nameW + 2) ' ' "NAME" + <> 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" + + 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 nameW kindW scopeW providersW instW latW row = - Text.IO.putStrLn $ - Text.justifyLeft (nameW + 2) ' ' (row ^. #name) - <> Text.justifyLeft (kindW + 2) ' ' (row ^. #kind) - <> Text.justifyLeft (scopeW + 2) ' ' (row ^. #scope) - <> Text.justifyLeft (providersW + 2) ' ' (row ^. #providers) - <> Text.justifyLeft (instW + 2) ' ' (renderMVer (row ^. #installedVersion)) - <> Text.justifyLeft (latW + 2) ' ' (renderMVer (row ^. #latestVersion)) - <> renderState (row ^. #state) + printRow row = + Text.justifyLeft (nameW + 2) ' ' (row ^. #name) + <> 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)) + <> renderConditions (row ^. #conditions) aggregateStatusRows :: [StatusRow] -> [StatusRow] aggregateStatusRows rows = @@ -195,18 +340,14 @@ row ^. #scope, row ^. #installedVersion, row ^. #latestVersion, - row ^. #state + row ^. #conditions, + row ^. #requestedVisibility, + row ^. #effectiveVisibility ) sameKey a b = rowKey a == rowKey b summarize groupRows@(firstRow : _) = firstRow & #providers .~ Text.intercalate "," (sort (nub (map (^. #providers) groupRows))) summarize [] = error "aggregateStatusRows: empty group" - -agentSourceBase :: FilePath -> AgentEntry -> FilePath -agentSourceBase repoDir entry = - case entry ^. #files of - Just _ -> repoDir Text.unpack (entry ^. #path) - Nothing -> repoDir takeDirectory (Text.unpack (entry ^. #path)) agentExtension :: AgentAssetProvider -> String agentExtension provider = 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,494 +5,1858 @@ import Baikai.Interactive (InteractiveProvider (InteractiveClaude, InteractiveCodex)) import Baikai.Kit ( AgentEntry (..), - KitConfig (..), - KitItem (..), - KitItemKind (..), - KitManifest (..), - KitScope (UserScope), - KitState (..), - PullResult (..), - RemovalOutcome (..), - SidecarMeta (..), - SkillEntry (..), - classify, - collectStatus, - computeKitHash, - installItem, - pullKitRepo, - readSidecar, - renderUninstallReport, - safeItemName, - safeRelativePath, - safeUnder, - sidecarFileName, - sidecarPath, - stripYamlFrontmatter, - uninstallItem, - uninstallOutcomes, - 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, - doesDirectoryExist, - doesFileExist, - doesPathExist, - listDirectory, - removeDirectoryRecursive, - ) -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, - frontmatterTests, - classifyTests, - statusFilesystemTests, - installRoundTripTests - ] - -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 <- computeKitHash dir ["a.md", "b.md", "c.md"] - h2 <- 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 <- computeKitHash dir ["a.md"] - BS.writeFile (dir "a.md") "alpha-modified" - after <- 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 "safeUnder rejects an absolute right operand" $ - assertLeft (safeUnder "/base" "/etc/passwd"), - testCase "install refuses a manifest file path that escapes the install root" $ - withPreparedKitHome $ \home cache -> do - BS.writeFile (cache "kit.json") maliciousManifestJson - result <- try @ExitCode (installItem testConfig "evil" UserScope) - result @?= Left (ExitFailure 1) - assertFileMissing (takeDirectory home "escape.txt"), - testCase "uninstall refuses a traversal name" $ - withPreparedKitHome $ \home _cache -> do - let victim = home "victim" - createDirectoryIfMissing True victim - result <- try @ExitCode (uninstallItem testConfig "../victim" UserScope) - result @?= Left (ExitFailure 1) - assertDirectoryExists victim - ] - -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" - ] - -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 - 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 - 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" - 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" - uninstallItem config "demo" UserScope - assertDirectoryMissing claudeSkill - assertDirectoryMissing codexSkill - 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) - 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" - 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 <- try @ExitCode (installItem testConfig "reviewer" UserScope) - result @?= Left (ExitFailure 1) - 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 "uninstallOutcomes reports per-provider removals" $ - withPreparedKitHome $ \home _cache -> do - let codexSkill = home ".agents" "skills" "demo" - installItem testConfig "demo" UserScope - removeDirectoryRecursive codexSkill - outcomes <- uninstallOutcomes 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 and update exits nonzero" $ - withPreparedKitHome $ \_home cache -> do - result <- pullKitRepo testConfig cache - case result of - PullFailed _ -> pure () - PullSucceeded -> assertFailure "expected fake .git cache pull to fail" - updateResult <- try @ExitCode (updateKit testConfig Nothing) - updateResult @?= Left (ExitFailure 1) - ] - -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" - } - -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 - where - restoreHome Nothing = unsetEnv "HOME" - restoreHome (Just value) = setEnv "HOME" value - -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\":[]} " - ] - -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"}]}