packages feed

baikai-claude 0.4.0.1 → 0.7.0.0

raw patch · 25 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,2487 @@+# 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]++## [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.<name>.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: <blank Custom tag —+  emptyModel.api was never set>` — 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 `<redacted>`. `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.<P>.Api` to+  `Baikai.Provider.<P>.Internal.Stream` — the `SseDriver` seam, `liveSseDriver`,+  `<p>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+  (`<agents dir>/<name>/<file>`), 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 `<redacted>` 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 `<redacted>` 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 <level>` (`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=<level>` 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.
baikai-claude.cabal view
@@ -1,18 +1,21 @@-cabal-version: 3.4-name:          baikai-claude-version:       0.4.0.1-synopsis:      Anthropic Claude providers for the baikai abstraction+cabal-version:   3.4+name:            baikai-claude+version:         0.7.0.0+synopsis:        Anthropic Claude providers for the baikai abstraction description:-  Wraps the claude Haskell package as a Baikai Provider for both the Anthropic API and the-  claude -p CLI.+  Anthropic backends for baikai: the Messages API over SSE, the claude -p batch+  provider, a launcher for interactive Claude Code sessions, and the renderer for+  unattended claude runs driven by baikai-agent. -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  common common-options   ghc-options:@@ -21,6 +24,21 @@     -fhide-source-paths -Wmissing-export-lists -Wpartial-fields     -Wmissing-deriving-strategies +  -- Exhaustiveness is an error, not a warning. A non-exhaustive match+  -- is a crash the compiler already found: it fails at runtime, on+  -- whichever input reaches the missing branch, usually in front of a+  -- user. This is not hypothetical here — adding a constructor to+  -- AgentRunFailure left `failureExitCode` non-exhaustive and shipped a+  -- pattern-match failure on `baikai agent run --require-evidence`,+  -- because the warning scrolled past in a build log.+  --+  -- Promoted individually rather than through -Werror, which would also+  -- 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-record-updates+   default-language:   GHC2024   default-extensions:     DeriveAnyClass@@ -32,29 +50,35 @@   import:          common-options   hs-source-dirs:  src   exposed-modules:+    Baikai.Provider.Claude.Agent     Baikai.Provider.Claude.Api     Baikai.Provider.Claude.Cli     Baikai.Provider.Claude.Interactive     Baikai.Provider.Claude.Internal.ErrorClass     Baikai.Provider.Claude.Internal.Request+    Baikai.Provider.Claude.Internal.Stream     Baikai.Provider.Claude.Shape     Baikai.Provider.Claude.Sse     Baikai.Provider.Claude.Transport +  other-modules:   Paths_baikai_claude+  autogen-modules: Paths_baikai_claude   build-depends:     , aeson              ^>=2.2-    , baikai             ^>=0.4.0+    , baikai             ^>=0.7.0     , base               >=4.20   && <5+    , base16-bytestring  ^>=1.0     , base64-bytestring  ^>=1.2     , bytestring         ^>=0.12     , case-insensitive   ^>=1.2-    , claude             ^>=1.4+    , claude             ^>=1.5     , containers         ^>=0.7     , cradle             ^>=0.0+    , cryptohash-sha256  ^>=0.11     , crypton            >=1.0    && <1.2     , generic-lens       ^>=2.3     , http-client        ^>=0.7-    , http-client-tls    ^>=0.3+    , http-client-tls    >=0.3    && <0.5     , http-types         ^>=0.12     , lens               ^>=5.3     , servant-client     ^>=0.20@@ -70,7 +94,14 @@   hs-source-dirs: test   main-is:        Main.hs   other-modules:+    CliEvidenceSpec+    Contract     ErrorClassSpec+    EvidenceSpec+    FableContractsSpec+    LifecycleSpec+    MidStreamSpec+    PublicSurfaceSpec     ShapeSpec     SseSpec     ThinkingSpec@@ -80,7 +111,7 @@   ghc-options:    -threaded -with-rtsopts=-N   build-depends:     , aeson-    , baikai            ^>=0.4.0+    , baikai            ^>=0.7.0     , baikai-claude     , base              >=4.20   && <5     , bytestring@@ -93,10 +124,15 @@     , http-client     , http-types     , lens              ^>=5.3+    , network     , servant-client+    , stm+    , streamly     , streamly-core     >=0.3    && <0.5     , tasty     , tasty-hunit+    , temporary     , text              ^>=2.1     , time+    , tls     , vector
+ src/Baikai/Provider/Claude/Agent.hs view
@@ -0,0 +1,227 @@+-- | Render the argument vector for an __unattended__ Claude Code run+-- from Baikai's provider-neutral unattended request type.+--+-- This module is intentionally separate from the other two Claude+-- surfaces. "Baikai.Provider.Claude.Cli" drives @claude -p@ as a batch+-- completion provider and returns a parsed response.+-- "Baikai.Provider.Claude.Interactive" starts the interactive terminal+-- UI and returns when the human quits. This module describes a run with+-- no terminal and no human, whose deliverable is the changed working+-- tree.+--+-- Every function here is pure: nothing is spawned, and the prompt is+-- carried as data rather than as an argument. A policy Claude Code+-- cannot express is refused with an 'AgentRenderError' before a process+-- would ever be created; it is never approximated with a near-miss+-- flag.+module Baikai.Provider.Claude.Agent+  ( ClaudeAgentConfig (executable, extraArgs, persistSession),+    defaultClaudeAgentConfig,+    claudeAgentCommand,+    claudeAgentThinking,+  )+where++import Baikai.Agent+  ( AgentCapability (..),+    AgentCommand (..),+    AgentOutputFormat (..),+    AgentPromptTransport (..),+    AgentProvider (..),+    AgentRenderError (..),+    AgentRunRequest,+  )+import Baikai.Evidence+  ( ThinkingAdjustment (..),+    ThinkingMode (..),+    ThinkingTranslation (..),+    noThinkingRequested,+  )+import Baikai.Prelude+import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel)+import Data.Generics.Labels ()+import Data.Text qualified as Text++-- | Configuration for the unattended @claude@ process.+data ClaudeAgentConfig = ClaudeAgentConfig+  { -- | The program to run, either a bare name resolved on @PATH@ or+    -- an explicit path.+    executable :: !FilePath,+    -- | Raw provider defaults an application always wants. Rendered+    -- after every structured flag and before the request's own raw+    -- arguments.+    extraArgs :: ![Text],+    -- | Whether the run may leave a resumable session on disk.+    -- Defaults to 'False', which emits @--no-session-persistence@:+    -- automation runs are one-shot, and a session file nobody will+    -- clean up is just litter. The flag only works together with @-p@,+    -- which this renderer always emits.+    persistSession :: !Bool+  }+  deriving stock (Eq, Show, Generic)++defaultClaudeAgentConfig :: ClaudeAgentConfig+defaultClaudeAgentConfig =+  ClaudeAgentConfig+    { executable = "claude",+      extraArgs = mempty,+      persistSession = False+    }++-- | Render the executable, argument vector, and prompt transport for an+-- unattended Claude Code run, or refuse the request.+--+-- The prompt appears nowhere in the argument vector: the transport is+-- 'PromptOnStdin', so a prompt beginning with a dash cannot be mistaken+-- for a flag and cannot be swallowed by a preceding variadic flag such+-- as @--allowedTools@ or @--add-dir@.+--+-- No working-directory flag is rendered, because Claude Code has none.+-- The runner sets the child's working directory from the request's+-- @workingDir@ field.+--+-- The second half of the pair describes what the request's reasoning+-- effort became on that command line, including the one collapse this+-- renderer applies. The runner cannot derive it — it never imports a+-- vendor renderer — so it travels alongside the command.+claudeAgentCommand ::+  ClaudeAgentConfig ->+  AgentRunRequest ->+  Either AgentRenderError (AgentCommand, ThinkingTranslation)+claudeAgentCommand cfg req+  | req ^. #provider /= AgentClaude =+      Left (ProviderMismatch AgentClaude (req ^. #provider))+  | otherwise = do+      permission <- permissionModeArgs (req ^. #safety . #capability)+      pure+        ( AgentCommand+            { executable = cfg ^. #executable,+              arguments =+                ["-p"]+                  <> sessionArgs cfg+                  <> modelArgs req+                  <> effortArgs req+                  <> outputFormatArgs req+                  <> permission+                  <> allowedToolArgs req+                  <> extraDirArgs req+                  <> fmap Text.unpack (cfg ^. #extraArgs)+                  <> fmap Text.unpack (req ^. #safety . #providerArgs),+              promptTransport = PromptOnStdin,+              promptText = req ^. #prompt+            },+          claudeAgentThinking req+        )++-- | What the request's reasoning effort became on the @claude@ command+-- line.+--+-- The adjustment is derived from 'claudeEffortValue' itself — recorded+-- exactly when the word that reaches @--effort@ differs from the+-- canonical level name — rather than from a table written beside it, so+-- the description cannot drift away from what the argument vector+-- actually carries. Today that is the single @minimal@ collapse, which+-- makes a run at @minimal@ and a run at @low@ produce byte-identical+-- command lines.+--+-- A request with no effort at all yields 'noThinkingRequested'. That is+-- a different fact from a request whose level the tool weakened: the+-- tool then applies its own default, and nothing was downgraded.+claudeAgentThinking :: AgentRunRequest -> ThinkingTranslation+claudeAgentThinking req = case req ^. #effort of+  Nothing -> noThinkingRequested+  Just lvl ->+    let wire = claudeEffortValue lvl+     in ThinkingTranslation+          { requested = Just lvl,+            mode = ThinkingModeFlag,+            effortText = Just wire,+            budgetTokens = Nothing,+            wireField = Just "--effort",+            displayText = Nothing,+            adjustments = [EffortClamped lvl wire | wire /= renderThinkingLevel lvl]+          }++-- | Map a capability profile onto Claude Code's @--permission-mode@.+--+-- The result is an 'Either' even though all three capabilities map+-- today. The type is the promise that an unmappable capability would be+-- refused rather than approximated: a later contributor adding a fourth+-- capability gets an incomplete-pattern warning pointing at this+-- decision instead of a silently missing flag.+permissionModeArgs :: AgentCapability -> Either AgentRenderError [String]+permissionModeArgs = \case+  -- Claude Code has no mode meaning exactly "may read, must not+  -- write". Of its six modes, `manual` and `dontAsk` can block waiting+  -- for a human and are unusable unattended, `acceptEdits` and+  -- `bypassPermissions` permit writes, and `auto` delegates the+  -- decision to a classifier whose behavior is not a stable contract.+  -- `plan` is the only mode that reliably does not modify the tree, at+  -- the documented cost of also framing the task as producing a plan.+  AgentReadOnly -> Right ["--permission-mode", "plan"]+  AgentEditWorkspace -> Right ["--permission-mode", "acceptEdits"]+  AgentFullAccess -> Right ["--permission-mode", "bypassPermissions"]++sessionArgs :: ClaudeAgentConfig -> [String]+sessionArgs cfg+  | cfg ^. #persistSession = []+  | otherwise = ["--no-session-persistence"]++-- | A blank model value must not produce @--model ""@, which Claude+-- rejects.+modelArgs :: AgentRunRequest -> [String]+modelArgs req = case Text.strip <$> req ^. #modelId of+  Nothing -> []+  Just "" -> []+  Just mid -> ["--model", Text.unpack mid]++-- | Claude's @--effort@ accepts @low|medium|high|xhigh|max@, but not+-- @minimal@, so the lowest Baikai level maps up to @low@. This matches+-- "Baikai.Provider.Claude.Interactive" exactly so the two surfaces+-- cannot drift.+effortArgs :: AgentRunRequest -> [String]+effortArgs req = case req ^. #effort of+  Nothing -> []+  Just lvl -> ["--effort", Text.unpack (claudeEffortValue lvl)]++claudeEffortValue :: ThinkingLevel -> Text+claudeEffortValue ThinkingMinimal = "low"+claudeEffortValue lvl = renderThinkingLevel lvl++-- | Ask @claude -p@ for a machine-readable result.+--+-- @--output-format@ takes @text@ (the default), @json@ (one result+-- object) or @stream-json@. Baikai models the first two: @text@ renders+-- nothing, because a flag that restates the default is noise a reader+-- has to check. The @json@ shape is the one+-- 'Baikai.Provider.Cli.Internal.decodeClaudeCliResult' already parses,+-- which is what lets an evidence record name the session and the model.+outputFormatArgs :: AgentRunRequest -> [String]+outputFormatArgs req = case req ^. #outputFormat of+  TextFormat -> []+  JsonFormat -> ["--output-format", "json"]++-- | Render the request's tool __grants__.+--+-- @--allowedTools@ pre-approves the named tools: its help reads "list+-- of tool names to allow", so this widens what the permission mode+-- would approve on its own rather than narrowing it. Whether the+-- operator permits each grant has already been decided by+-- 'Baikai.Agent.applyAgentCeiling' before a renderer is reached, so+-- nothing is checked here.+--+-- The names are joined with commas into one argument rather than passed+-- as several values, because @--allowedTools@ is variadic and separate+-- values could absorb a following flag.+allowedToolArgs :: AgentRunRequest -> [String]+allowedToolArgs req = case req ^. #safety . #allowedTools of+  [] -> []+  tools -> ["--allowedTools", Text.unpack (Text.intercalate "," tools)]++-- | On Claude Code @--add-dir@ grants tool /access/ to a directory. The+-- identically named @codex exec@ flag grants /write/ access, so the+-- shared @extraDirs@ field means "directories this run may reach" and+-- the precise authority is provider-dependent.+extraDirArgs :: AgentRunRequest -> [String]+extraDirArgs req =+  concatMap (\dir -> ["--add-dir", dir]) (req ^. #extraDirs)
src/Baikai/Provider/Claude/Api.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE LambdaCase #-}- -- | Provider wrapping the @claude@ package's Messages API. -- -- Call 'register' once (typically from @main@) to install the@@ -13,87 +11,37 @@ -- 'Baikai.Auth.defaultApiKeyEnvForBaseUrl'. Unknown hosts require an -- explicit key source. ----- EP-3 promotes streaming to the primary entry point. The handler--- exposes a 'streamly' 'Stream' of 'AssistantMessageEvent' values--- bridged from a local SSE transport that preserves HTTP status,--- headers, and body for error classification. Requests start as the--- SDK's typed 'Claude.V1.Messages.CreateMessage' value, then--- 'Baikai.Provider.Claude.Shape.streamRequestBody' patches the raw--- JSON body for tool-schema, @tool_choice@, and tool-cache compat--- before 'Baikai.Provider.Claude.Sse.claudeSseStreamValueWithHeaders'--- sends it with cached transport settings and caller headers. The--- synchronous 'complete' field is derived via 'streamingComplete',--- so callers that drain the stream get the same fully-assembled--- 'Response' they had before.+-- Streaming is the primary entry point. The handler exposes a+-- 'streamly' 'Stream' of 'AssistantMessageEvent' values bridged from a+-- local SSE transport that preserves HTTP status, headers, and body for+-- error classification. The synchronous @complete@ field is derived via+-- 'Baikai.Stream.streamingComplete', so callers that drain the stream+-- get the same fully-assembled 'Baikai.Response.Response'.+--+-- The machinery behind these three names — the transport driver seam,+-- the assembler and the event translator — lives in+-- "Baikai.Provider.Claude.Internal.Stream", which carries no stability+-- guarantees. module Baikai.Provider.Claude.Api   ( register,-    registerWithRegistry,     claudeMessagesProvider,     claudeMessagesStream,-    Assembler (..),-    emptyAssembler,-    translate,   ) where  import Baikai.Api (Api (..))-import Baikai.Content qualified as Content-import Baikai.Context (Context (..))-import Baikai.Cost (zeroCost)-import Baikai.Cost.Pricing qualified as Pricing-import Baikai.Error (BaikaiError, invalidRequest, providerError)-import Baikai.Message qualified as Msg-import Baikai.Model (Model, anthropicMessagesCompatFor)-import Baikai.Options (Options (..))-import Baikai.Provider.Claude.Internal.ErrorClass (classifyErrorValue, classifyException)-import Baikai.Provider.Claude.Internal.Request (mapRequest)-import Baikai.Provider.Claude.Shape (streamRequestBody)-import Baikai.Provider.Claude.Sse (claudeSseStreamValueWithHeaders)-import Baikai.Provider.Claude.Transport qualified as Transport-import Baikai.Provider.Registry-  ( ApiProvider (..),-    ProviderRegistry,-    registerApiProvider,-    registerApiProviderWith,-  )-import Baikai.StopReason qualified as Stop-import Baikai.Stream (streamingComplete)-import Baikai.Stream.Event-  ( AssistantMessageEvent (..),-    BlockEndPayload (..),-    DeltaPayload (..),-    IndexPayload (..),-    StartPayload (..),-    ThinkingEndPayload (..),-    ToolCallEndPayload (..),-    doneTerminal,-    errorTerminal,-  )-import Baikai.Usage qualified as Usage-import Claude.V1.Messages qualified as Messages-import Control.Concurrent (forkIO)-import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)-import Control.Exception (SomeAsyncException (..), SomeException, fromException, throwIO, try)-import Control.Lens ((%~), (&), (.~), (^.))-import Data.Aeson (Value)-import Data.Aeson qualified as Aeson-import Data.ByteString.Lazy qualified as BSL+import Baikai.Context (Context)+import Baikai.Evidence qualified as Ev+import Baikai.Model (Model)+import Baikai.Options (Options)+import Baikai.Provider (ApiProvider, apiProvider)+import Baikai.Provider.Claude.Internal.Request (describeThinkingFor)+import Baikai.Provider.Claude.Internal.Stream (claudeMessagesStreamWith, liveSseDriver)+import Baikai.Provider.Registry (registerApiProvider)+import Baikai.Stream.Event (AssistantMessageEvent)+import Control.Lens ((&), (.~)) import Data.Generics.Labels ()-import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Data.IntMap.Strict (IntMap)-import Data.IntMap.Strict qualified as IntMap-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import Data.Text qualified as Text-import Data.Text.Encoding qualified as Text-import Data.Time.Clock (UTCTime, getCurrentTime)-import Data.Vector (Vector)-import Data.Vector qualified as Vector-import GHC.Generics (Generic)-import Network.HTTP.Types.Header (RequestHeaders)-import Servant.Client qualified as Client import Streamly.Data.Stream (Stream)-import Streamly.Data.Stream qualified as Stream  -- | Install the Anthropic Messages handler into the registry. -- Calling 'register' twice keeps only the second handler — the@@ -102,534 +50,46 @@ register = registerApiProvider claudeMessagesProvider  -- | First-class Anthropic Messages provider value. Use with--- 'registerApiProviderWith' or 'newProviderRegistryFrom' for explicit--- registries.+-- 'Baikai.Provider.registerApiProviderWith' or+-- 'Baikai.Provider.newProviderRegistryFrom' for explicit registries. claudeMessagesProvider :: ApiProvider claudeMessagesProvider =-  ApiProvider-    { apiTag = AnthropicMessages,-      stream = claudeMessagesStream,-      complete = streamingComplete claudeMessagesStream-    }---- | Install the Anthropic Messages handler into an explicit registry.-registerWithRegistry :: ProviderRegistry -> IO ()-registerWithRegistry reg =-  registerApiProviderWith-    reg-    claudeMessagesProvider-{-# DEPRECATED registerWithRegistry "use registerApiProviderWith reg claudeMessagesProvider" #-}+  apiProvider AnthropicMessages claudeMessagesStream+    -- 'describeThinkingFor' is the same function 'mapRequest' uses, so+    -- the gate's answer and the wire's behaviour cannot disagree.+    & #describeThinking .~ describeThinkingFor+    & #strengthCeiling .~ Ev.declaredStrength AnthropicMessages  -- | Streaming producer for the Anthropic Messages API. ----- Forks one worker thread per call that drives--- the local Claude SSE transport; the worker pushes classified--- errors or typed 'Messages.MessageStreamEvent' values onto a bounded--- 'Chan' terminated by 'Nothing'. The returned 'Stream' is a--- translator: it pulls raw events from the channel and emits zero or--- more 'AssistantMessageEvent' values per upstream event, terminating--- with exactly one 'EventDone' or 'EventError'.+-- Forks one worker thread per call that drives the local Claude SSE+-- transport, pushing classified errors and typed+-- 'Claude.V1.Messages.MessageStreamEvent' values onto a bounded+-- 'Baikai.Provider.Internal.StreamWorker.FrameQueue'. The returned+-- 'Stream' is a translator: it pulls raw events off that queue and emits+-- zero or more 'AssistantMessageEvent' values per upstream event,+-- beginning with exactly one 'Baikai.Stream.Event.EventStart' and+-- terminating with exactly one 'Baikai.Stream.Event.EventDone' or+-- 'Baikai.Stream.Event.EventError'. --+-- The queue is bounded at+-- 'Baikai.Provider.Internal.StreamWorker.frameQueueCapacity' frames, so+-- a consumer that stops pulling stops the socket read after at most that+-- many further frames rather than letting the worker drain a whole+-- generation nobody will read.+--+-- The worker runs under a bracket, so the connection comes back+-- immediately when the stream ends normally or when an exception reaches+-- the draining thread (@Ctrl-C@, 'System.Timeout.timeout', @cancel@),+-- and at the next major garbage collection when a consumer simply+-- abandons the stream. "Baikai.Provider.Internal.StreamWorker" documents+-- why those three strengths differ and how a caller stops+-- deterministically.+-- -- Producer-side exceptions (HTTP failure, decode failure inside the--- SDK, etc.) are caught with 'try' and re-encoded into an--- 'EventError' carrying whatever content was already assembled —--- the masterplan's "partial output is always recoverable" promise.+-- SDK, etc.) are caught and re-encoded into an+-- 'Baikai.Stream.Event.EventError' carrying whatever content was already+-- assembled — the "partial output is always recoverable" promise. claudeMessagesStream ::   Model -> Context -> Options -> Stream IO AssistantMessageEvent-claudeMessagesStream m ctx opts =-  Stream.concatEffect $ do-    setupResult <- trySync (prepareCall m ctx opts)-    let setup = either (Left . exceptionToError) id setupResult-    case setup of-      Left err -> Stream.fromList <$> immediateError err-      Right call -> do-        ch <- newChan :: IO (Chan (Maybe (Either BaikaiError Messages.MessageStreamEvent)))-        tref <- newIORef False-        _ <- forkIO (worker call ch)-        startTime <- getCurrentTime-        let initialState =-              ProducerState-                { chan = ch,-                  pending = [],-                  assembler = emptyAssembler m startTime,-                  finished = False,-                  terminalRef = tref-                }-        pure (Stream.unfoldrM step initialState)---- | Per-call prepared values, including the shaped JSON request body--- passed to the local streaming transport.-data ClaudeCall = ClaudeCall-  { clientEnv :: !Client.ClientEnv,-    requestHeaders :: !RequestHeaders,-    timeoutMs :: !(Maybe Int),-    requestBody :: !Aeson.Value-  }-  deriving stock (Generic)--prepareCall ::-  Model -> Context -> Options -> IO (Either BaikaiError ClaudeCall)-prepareCall m ctx opts = do-  case mapRequest m ctx opts of-    Left e -> pure (Left (invalidRequest e))-    Right req -> do-      let url = case m ^. #baseUrl of-            "" -> "https://api.anthropic.com"-            u -> u-          compat = anthropicMessagesCompatFor m-          version = Just "2023-06-01"-      key <- Transport.resolveKey url opts-      env <- Transport.getClientEnvCached url-      let body = streamRequestBody compat ctx opts req-          headers = Transport.requestHeaders key version compat ctx m opts-      pure-        ( Right-            ClaudeCall-              { clientEnv = env,-                requestHeaders = headers,-                timeoutMs = opts ^. #timeoutMs,-                requestBody = body-              }-        )---- | Worker body: drive the SDK's typed callback, forwarding events--- onto the channel. Any exception is converted into a synthetic--- @Error@ raw event so the consumer side can translate it through--- the normal channel. After the SDK call returns (success or--- handled failure) we close the channel with 'Nothing'.-worker ::-  ClaudeCall ->-  Chan (Maybe (Either BaikaiError Messages.MessageStreamEvent)) ->-  IO ()-worker call ch = do-  r <--    trySync $-      Transport.runWithTimeout (call ^. #timeoutMs) $-        claudeSseStreamValueWithHeaders-          (call ^. #clientEnv)-          (call ^. #requestHeaders)-          (call ^. #requestBody)-          (writeChan ch . Just)-  case r of-    Right Nothing -> pure ()-    Right (Just be) -> writeChan ch (Just (Left be))-    Left e -> writeChan ch (Just (Left (exceptionToError e)))-  writeChan ch Nothing---- | The streaming 'Stream' state.-data ProducerState = ProducerState-  { chan :: !(Chan (Maybe (Either BaikaiError Messages.MessageStreamEvent))),-    pending :: ![AssistantMessageEvent],-    assembler :: !Assembler,-    finished :: !Bool,-    terminalRef :: !(IORef Bool)-  }-  deriving stock (Generic)--step :: ProducerState -> IO (Maybe (AssistantMessageEvent, ProducerState))-step s-  | (e : rest) <- s ^. #pending = do-      writeTerminal s e-      pure-        ( Just-            ( e,-              s-                & #pending .~ rest-                & #finished .~ (s ^. #finished || terminal e)-            )-        )-  | s ^. #finished = pure Nothing-  | otherwise = do-      mRaw <- readChan (s ^. #chan)-      case mRaw of-        Nothing -> do-          alreadyTerminal <- readIORef (s ^. #terminalRef)-          if alreadyTerminal-            then pure Nothing-            else do-              now <- getCurrentTime-              let (ev, ass') = unexpectedEoS now (s ^. #assembler)-              writeTerminal s ev-              pure-                ( Just-                    ( ev,-                      s & #assembler .~ ass' & #finished .~ True-                    )-                )-        Just raw -> do-          now <- getCurrentTime-          let (events, ass') = translate raw (s ^. #assembler) now-          case events of-            [] -> step (s & #assembler .~ ass')-            (e : rest) -> do-              writeTerminal s e-              pure-                ( Just-                    ( e,-                      s-                        & #pending .~ rest-                        & #assembler .~ ass'-                        & #finished .~ (s ^. #finished || terminal e)-                    )-                )--writeTerminal :: ProducerState -> AssistantMessageEvent -> IO ()-writeTerminal s ev-  | terminal ev = writeIORef (s ^. #terminalRef) True-  | otherwise = pure ()--terminal :: AssistantMessageEvent -> Bool-terminal = \case-  EventDone {} -> True-  EventError {} -> True-  _ -> False---- | The recovery path: channel closed before any terminal event.-unexpectedEoS ::-  UTCTime -> Assembler -> (AssistantMessageEvent, Assembler)-unexpectedEoS now ass =-  let errText = "claude stream ended without message_stop"-      msg = finalMessageOnError ass now errText-   in (EventError (errorTerminal (ass ^. #responseId) Stop.ErrorReason msg (providerError errText)), ass)---- | Translation state across one streaming call.-data Assembler = Assembler-  { model :: !Model,-    start :: !UTCTime,-    responseId :: !(Maybe Text),-    closed :: !(IntMap Content.AssistantContent),-    textBuf :: !(IntMap Text),-    thinkBuf :: !(IntMap Text),-    thinkSig :: !(IntMap Text),-    redactedBuf :: !(IntMap Text),-    toolArgsBuf :: !(IntMap Text),-    toolMeta :: !(IntMap (Text, Text)),-    usage :: !Usage.Usage,-    stopReason :: !Stop.StopReason-  }-  deriving stock (Generic)--emptyAssembler :: Model -> UTCTime -> Assembler-emptyAssembler m s =-  Assembler-    { model = m,-      start = s,-      responseId = Nothing,-      closed = IntMap.empty,-      textBuf = IntMap.empty,-      thinkBuf = IntMap.empty,-      thinkSig = IntMap.empty,-      redactedBuf = IntMap.empty,-      toolArgsBuf = IntMap.empty,-      toolMeta = IntMap.empty,-      usage = Usage.zeroUsage,-      stopReason = Stop.Stop-    }--translate ::-  Either BaikaiError Messages.MessageStreamEvent ->-  Assembler ->-  UTCTime ->-  ([AssistantMessageEvent], Assembler)-translate raw ass now = case raw of-  Left be ->-    let msg = finalMessageOnError ass now (be ^. #message)-     in ([EventError (errorTerminal (ass ^. #responseId) Stop.ErrorReason msg be)], ass)-  Right ev -> translateEvent ev ass now--translateEvent ::-  Messages.MessageStreamEvent ->-  Assembler ->-  UTCTime ->-  ([AssistantMessageEvent], Assembler)-translateEvent raw ass now = case raw of-  Messages.Ping -> ([], ass)-  Messages.Message_Start {Messages.message = mr} ->-    let usage0 = anthroUsageToBaikai (mr ^. #usage)-        ass' = ass & #responseId .~ Just (mr ^. #id) & #usage .~ usage0-        skeleton = skeletonMessage ass' now-     in ([EventStart StartPayload {partial = skeleton, responseId = Just (mr ^. #id)}], ass')-  Messages.Content_Block_Start {Messages.index = idx, Messages.content_block = block} ->-    handleBlockStart (fromIntegral idx) block ass-  Messages.Content_Block_Delta {Messages.index = idx, Messages.delta = d} ->-    handleBlockDelta (fromIntegral idx) d ass-  Messages.Content_Block_Stop {Messages.index = idx} ->-    handleBlockStop (fromIntegral idx) ass-  Messages.Message_Delta {Messages.message_delta = md, Messages.usage = su} ->-    let stopR = mapStopReason (md ^. #stop_reason)-        u = ass ^. #usage-        outputTokensFinal = fromMaybe (u ^. #outputTokens) (Just (su ^. #output_tokens))-        u' =-          u-            & #outputTokens .~ outputTokensFinal-            & #totalTokens-              .~ ((u ^. #inputTokens) + outputTokensFinal + (u ^. #cacheReadTokens) + (u ^. #cacheWriteTokens))-     in ([], ass & #stopReason .~ stopR & #usage .~ u')-  Messages.Message_Stop ->-    let reason = ass ^. #stopReason-        refusal = providerError "Anthropic refused to generate a response (stop_reason=refusal)"-        msg =-          if reason == Stop.ErrorReason-            then finalMessageOnError ass now (refusal ^. #message)-            else finalMessage ass now-        terminalEvent =-          if reason == Stop.ErrorReason-            then EventError (errorTerminal (ass ^. #responseId) reason msg refusal)-            else EventDone (doneTerminal (ass ^. #responseId) reason msg)-     in ([terminalEvent], ass)-  Messages.Error {Messages.error = errVal} ->-    let errText = renderAnthropicError errVal-        mErr = classifyErrorValue errVal-        msg = finalMessageOnError ass now errText-        errInfo = fromMaybe (providerError errText) mErr-     in ([EventError (errorTerminal (ass ^. #responseId) Stop.ErrorReason msg errInfo)], ass)--handleBlockStart ::-  Int ->-  Messages.ContentBlock ->-  Assembler ->-  ([AssistantMessageEvent], Assembler)-handleBlockStart i block ass = case block of-  Messages.ContentBlock_Text {} ->-    ( [TextStart IndexPayload {contentIndex = i}],-      ass & #textBuf %~ IntMap.insert i Text.empty-    )-  Messages.ContentBlock_Thinking {} ->-    ( [ThinkingStart IndexPayload {contentIndex = i}],-      ass & #thinkBuf %~ IntMap.insert i Text.empty-    )-  Messages.ContentBlock_Redacted_Thinking {Messages.data_ = payload} ->-    ( [ThinkingStart IndexPayload {contentIndex = i}],-      ass & #redactedBuf %~ IntMap.insert i payload-    )-  Messages.ContentBlock_Tool_Use {Messages.id = tid, Messages.name = tn} ->-    ( [ToolCallStart IndexPayload {contentIndex = i}],-      ass-        & #toolArgsBuf %~ IntMap.insert i Text.empty-        & #toolMeta %~ IntMap.insert i (tid, tn)-    )-  _ ->-    -- Server-tool, code-execution-tool, unknown — pass-through with no events.-    ([], ass)--handleBlockDelta ::-  Int ->-  Messages.ContentBlockDelta ->-  Assembler ->-  ([AssistantMessageEvent], Assembler)-handleBlockDelta i d ass = case d of-  Messages.Delta_Text_Delta {Messages.text = t} ->-    if IntMap.member i (ass ^. #textBuf)-      then-        ( [TextDelta DeltaPayload {contentIndex = i, delta = t}],-          ass & #textBuf %~ IntMap.adjust (<> t) i-        )-      else ([], ass)-  Messages.Delta_Thinking_Delta {Messages.thinking = t} ->-    if IntMap.member i (ass ^. #thinkBuf)-      then-        ( [ThinkingDelta DeltaPayload {contentIndex = i, delta = t}],-          ass & #thinkBuf %~ IntMap.adjust (<> t) i-        )-      else ([], ass)-  Messages.Delta_Signature_Delta {Messages.signature = sig} ->-    -- Signatures are tail-end metadata on thinking blocks; they-    -- attach to the ThinkingEnd event's content build, not a public-    -- delta event.-    if IntMap.member i (ass ^. #thinkBuf)-      then-        ( [],-          ass & #thinkSig %~ IntMap.insertWith (\new old -> old <> new) i sig-        )-      else ([], ass)-  Messages.Delta_Input_Json_Delta {Messages.partial_json = j} ->-    if IntMap.member i (ass ^. #toolArgsBuf)-      then-        ( [ToolCallDelta DeltaPayload {contentIndex = i, delta = j}],-          ass & #toolArgsBuf %~ IntMap.adjust (<> j) i-        )-      else ([], ass)--handleBlockStop ::-  Int -> Assembler -> ([AssistantMessageEvent], Assembler)-handleBlockStop i ass-  | Just body <- IntMap.lookup i (ass ^. #textBuf) =-      let block = Content.AssistantText (Content.TextContent body)-       in ( [TextEnd BlockEndPayload {contentIndex = i, content = body}],-            ass-              & #closed %~ IntMap.insert i block-              & #textBuf %~ IntMap.delete i-          )-  | Just payload <- IntMap.lookup i (ass ^. #redactedBuf) =-      let thinkingContent =-            Content.ThinkingContent-              { Content.thinking = payload,-                Content.signature = Nothing,-                Content.redacted = True-              }-          block = Content.AssistantThinking thinkingContent-       in ( [ThinkingEnd ThinkingEndPayload {contentIndex = i, content = thinkingContent}],-            ass-              & #closed %~ IntMap.insert i block-              & #redactedBuf %~ IntMap.delete i-          )-  | Just body <- IntMap.lookup i (ass ^. #thinkBuf) =-      let sig = IntMap.lookup i (ass ^. #thinkSig)-          thinkingContent =-            Content.ThinkingContent-              { Content.thinking = body,-                Content.signature = if maybe True Text.null sig then Nothing else sig,-                Content.redacted = False-              }-          block = Content.AssistantThinking thinkingContent-       in ( [ThinkingEnd ThinkingEndPayload {contentIndex = i, content = thinkingContent}],-            ass-              & #closed %~ IntMap.insert i block-              & #thinkBuf %~ IntMap.delete i-              & #thinkSig %~ IntMap.delete i-          )-  | Just argsText <- IntMap.lookup i (ass ^. #toolArgsBuf) =-      let (tid, tn) =-            -- A tool args buffer is opened together with metadata in-            -- handleBlockStart; the fallback is defensive only.-            fromMaybe ("", "") (IntMap.lookup i (ass ^. #toolMeta))-          decoded :: Value-          decoded = case Aeson.eitherDecodeStrict (Text.encodeUtf8 argsText) of-            Right v -> v-            Left _ ->-              -- Anthropic sometimes opens a tool_use block with an-              -- empty input that never streams any delta. Fall back-              -- to an empty object so the resulting ToolCall is-              -- well-formed.-              Aeson.Object mempty-          tc =-            Content.ToolCall-              { Content.id_ = tid,-                Content.name = tn,-                Content.arguments = decoded-              }-          block = Content.AssistantToolCall tc-       in ( [ToolCallEnd ToolCallEndPayload {contentIndex = i, toolCall = tc}],-            ass-              & #closed %~ IntMap.insert i block-              & #toolArgsBuf %~ IntMap.delete i-              & #toolMeta %~ IntMap.delete i-          )-  | otherwise = ([], ass)---- | The 'EventStart' message skeleton (empty content; usage/etc.--- carried for downstream consumers that want metadata up front).-skeletonMessage :: Assembler -> UTCTime -> Msg.Message-skeletonMessage ass _now =-  Msg.AssistantMessage-    Msg.AssistantPayload-      { Msg.content = Vector.empty,-        Msg.usage = ass ^. #usage,-        Msg.stopReason = Stop.Stop,-        Msg.errorMessage = Nothing,-        Msg.timestamp = Just (ass ^. #start)-      }--finalMessage :: Assembler -> UTCTime -> Msg.Message-finalMessage ass now =-  let blocks = blocksInOrder ass-      m = ass ^. #model-      usageBare = ass ^. #usage-      computed = Pricing.computeCost m usageBare-      usage' = usageBare & #cost .~ computed-   in Msg.AssistantMessage-        Msg.AssistantPayload-          { Msg.content = blocks,-            Msg.usage = usage',-            Msg.stopReason = ass ^. #stopReason,-            Msg.errorMessage = Nothing,-            Msg.timestamp = Just now-          }--finalMessageOnError :: Assembler -> UTCTime -> Text -> Msg.Message-finalMessageOnError ass now reason =-  let blocks = blocksInOrder ass-      m = ass ^. #model-      usageBare = ass ^. #usage-      computed = Pricing.computeCost m usageBare-      usage' = usageBare & #cost .~ computed-   in Msg.AssistantMessage-        Msg.AssistantPayload-          { Msg.content = blocks,-            Msg.usage = usage',-            Msg.stopReason = Stop.ErrorReason,-            Msg.errorMessage = Just reason,-            Msg.timestamp = Just now-          }--blocksInOrder :: Assembler -> Vector Content.AssistantContent-blocksInOrder ass = Vector.fromList (IntMap.elems (ass ^. #closed))---- | The immediate "request invalid" stream — emitted when--- 'mapRequest' fails or 'prepareCall' is otherwise unable to build--- a valid SDK request.-immediateError :: BaikaiError -> IO [AssistantMessageEvent]-immediateError err = do-  now <- getCurrentTime-  let errText = err ^. #message-  let msg =-        Msg.AssistantMessage-          Msg.AssistantPayload-            { Msg.content = Vector.empty,-              Msg.usage = Usage.zeroUsage,-              Msg.stopReason = Stop.ErrorReason,-              Msg.errorMessage = Just errText,-              Msg.timestamp = Just now-            }-  pure-    [ EventStart StartPayload {partial = msg, responseId = Nothing},-      EventError (errorTerminal Nothing Stop.ErrorReason msg err)-    ]--trySync :: IO a -> IO (Either SomeException a)-trySync action = do-  r <- try action-  case r of-    Left e-      | Just (SomeAsyncException _) <- (fromException e :: Maybe SomeAsyncException) ->-          throwIO e-      | otherwise -> pure (Left e)-    Right a -> pure (Right a)--exceptionToError :: SomeException -> BaikaiError-exceptionToError e = fromMaybe (classifyException e) (fromException e)--renderAnthropicError :: Value -> Text-renderAnthropicError v = case v of-  Aeson.String t -> t-  _ -> Text.decodeUtf8 (BSL.toStrict (Aeson.encode v))---- | Map the Anthropic streaming 'Message_Start.message.usage' value--- into baikai's 'Usage' shape. Cache-related counters are populated--- where present; cost is left at zero (the terminal event--- recomputes it).-anthroUsageToBaikai :: Messages.Usage -> Usage.Usage-anthroUsageToBaikai u =-  let i = u ^. #input_tokens-      o = u ^. #output_tokens-      cr = fromMaybe 0 (u ^. #cache_read_input_tokens)-      cw = fromMaybe 0 (u ^. #cache_creation_input_tokens)-   in Usage.Usage-        { Usage.inputTokens = i,-          Usage.outputTokens = o,-          Usage.cacheReadTokens = cr,-          Usage.cacheWriteTokens = cw,-          Usage.reasoningTokens = Nothing,-          Usage.totalTokens = i + o + cr + cw,-          Usage.cost = zeroCost-        }--mapStopReason :: Maybe Messages.StopReason -> Stop.StopReason-mapStopReason = \case-  Just Messages.End_Turn -> Stop.Stop-  Just Messages.Max_Tokens -> Stop.Length-  Just Messages.Stop_Sequence -> Stop.Stop-  Just Messages.Tool_Use -> Stop.ToolUse-  Just Messages.Refusal -> Stop.ErrorReason-  Just Messages.Model_Context_Window_Exceeded -> Stop.Length-  Nothing -> Stop.Stop+claudeMessagesStream = claudeMessagesStreamWith liveSseDriver
src/Baikai/Provider/Claude/Cli.hs view
@@ -3,52 +3,59 @@ -- -- Call 'register' once (typically from @main@) to install the -- 'Baikai.Api.AnthropicMessagesCli' handler with default config.--- For non-default executable paths or extra args, use 'registerWith'--- and supply a custom 'ClaudeCliConfig'.+-- For non-default executable paths or extra args, register+-- @claudeCliProvider cfg@ with a custom 'ClaudeCliConfig'. ----- The CLI provider always returns a 'Response' whose embedded--- assistant message carries zero token counts (and therefore zero--- cost): the @claude@ CLI runs under a flat subscription, so--- per-token billing does not apply. CLI providers do not participate--- in tool calling. Provider failures are returned in-band as--- error-shaped responses; the masterplan's Decision Log records the+-- The 'Response' this provider returns carries whatever the tool+-- reported about its own run: the token counts and total cost from the+-- result event's @usage@ block, and the tool's @session_id@ as the+-- response identifier. A tool that reports none of that yields zeroes+-- and 'Nothing', which is an accurate record of its silence rather+-- than a claim that the call was free. CLI providers do not+-- participate in tool calling. Provider failures are returned in-band+-- as error-shaped responses; the masterplan's Decision Log records the -- reasoning.+--+-- Evidence from this transport is deliberately weaker than from the+-- Messages API. A tool that exits zero has demonstrated that it ran,+-- not which model served the request, so a successful exit never+-- raises the recorded 'Baikai.Evidence.EvidenceStrength' — see+-- 'Baikai.Provider.Cli.Internal.subprocessStrength'. module Baikai.Provider.Claude.Cli   ( ClaudeCliConfig,     executable,     extraArgs,     workingDir,     claudeCliCommand,+    claudeCliThinking,     defaultClaudeCliConfig,     claudeCliProvider,     register,-    registerWith,-    registerWithRegistry,-    registerWithRegistryAndConfig,   ) where  import Baikai.Api (Api (..)) import Baikai.Content (AssistantContent (..), TextContent (..)) import Baikai.Context (Context)-import Baikai.Error (BaikaiError, decodeError, processError, providerError)+import Baikai.Error (BaikaiError, processError, providerError)+import Baikai.Evidence qualified as Ev+import Baikai.Evidence.Build qualified as Build import Baikai.Message (AssistantPayload (..)) import Baikai.Model (Model) import Baikai.Options (Options) import Baikai.Provider.Cli.Internal qualified as Internal import Baikai.Provider.Registry   ( ApiProvider (..),-    ProviderRegistry,+    apiProviderWith,     registerApiProvider,-    registerApiProviderWith,   ) import Baikai.Response qualified as Resp import Baikai.StopReason (StopReason (..)) import Baikai.Stream (liftCompleteToStream) import Baikai.ThinkingLevel (ThinkingLevel (ThinkingMinimal), renderThinkingLevel)-import Baikai.Usage (zeroUsage)-import Control.Exception (SomeAsyncException (..), SomeException, displayException, fromException, throwIO, try)-import Control.Lens ((^.))+import Baikai.Usage (Usage, zeroUsage)+import Control.Exception (SomeException, displayException, fromException)+import Control.Lens ((&), (.~), (^.)) import Cradle   ( ExitCode (..),     StderrRaw (..),@@ -59,18 +66,11 @@     setNoStdin,     setWorkingDir,   )-import Data.Aeson (FromJSON, Value (..), eitherDecodeStrict)-import Data.Aeson qualified as Aeson-import Data.Aeson.KeyMap qualified as KeyMap-import Data.Aeson.Types (parseEither, parseJSON)-import Data.ByteString (ByteString)-import Data.Function ((&)) import Data.Generics.Labels () import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as Text import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)-import Data.Vector (Vector) import Data.Vector qualified as Vector import GHC.Generics (Generic) @@ -95,46 +95,27 @@ register = registerApiProvider (claudeCliProvider defaultClaudeCliConfig)  -- | First-class Claude CLI provider value for a caller-supplied config.-claudeCliProvider :: ClaudeCliConfig -> ApiProvider-claudeCliProvider cfg =-  ApiProvider-    { apiTag = AnthropicMessagesCli,-      stream = liftCompleteToStream (runClaudeCli cfg),-      complete = runClaudeCli cfg-    }---- | Install the CLI handler with a caller-supplied config. -- -- The CLI binary runs in batch mode; there is no intra-response--- streaming on the wire. The 'stream' field therefore wraps the+-- streaming on the wire. The @stream@ field therefore wraps the -- batch 'runClaudeCli' through 'liftCompleteToStream', producing a -- synthetic one-shot event stream -- (@EventStart, TextStart 0, TextDelta 0 body, TextEnd 0, EventDone@)--- the moment the subprocess returns. 'complete' is left as the--- direct batch path so it preserves 'Response.responseId' and the--- measured 'Response.latencyMs' (going through a--- 'streamingComplete' round trip would lose the former and recompute--- the latter from synthetic events). EP-3's Decision Log explains--- the deviation from the plan's "complete = streamingComplete .--- stream" default.-registerWith :: ClaudeCliConfig -> IO ()-registerWith cfg = registerApiProvider (claudeCliProvider cfg)-{-# DEPRECATED registerWith "use registerApiProvider (claudeCliProvider cfg)" #-}---- | Install the CLI handler with 'defaultClaudeCliConfig' into an explicit--- registry.-registerWithRegistry :: ProviderRegistry -> IO ()-registerWithRegistry reg = registerWithRegistryAndConfig reg defaultClaudeCliConfig-{-# DEPRECATED registerWithRegistry "use registerApiProviderWith reg (claudeCliProvider defaultClaudeCliConfig)" #-}---- | Install the CLI handler with a caller-supplied config into an explicit--- registry.-registerWithRegistryAndConfig :: ProviderRegistry -> ClaudeCliConfig -> IO ()-registerWithRegistryAndConfig reg cfg =-  registerApiProviderWith-    reg-    (claudeCliProvider cfg)-{-# DEPRECATED registerWithRegistryAndConfig "use registerApiProviderWith reg (claudeCliProvider cfg)" #-}+-- the moment the subprocess returns. @complete@ is left as the+-- direct batch path so it preserves 'Baikai.Response.responseId' and+-- the measured 'Baikai.Response.latencyMs' (going through a+-- 'Baikai.Stream.streamingComplete' round trip would lose the former+-- and recompute the latter from synthetic events).+claudeCliProvider :: ClaudeCliConfig -> ApiProvider+claudeCliProvider cfg =+  apiProviderWith+    AnthropicMessagesCli+    (liftCompleteToStream (runClaudeCli cfg))+    (runClaudeCli cfg)+    -- The model plays no part: this transport's only reasoning+    -- control is a command-line flag derived from Options alone.+    & #describeThinking .~ (\_ opts -> claudeCliThinking opts)+    & #strengthCeiling .~ Ev.declaredStrength AnthropicMessagesCli  -- | Render the executable and arguments for a @claude -p@ batch call. -- The prompt is preceded by @--@ so dash-leading prompts and variadic@@ -163,14 +144,31 @@ claudeEffortValue ThinkingMinimal = "low" claudeEffortValue lvl = renderThinkingLevel lvl --- | The shape of @claude -p --output-format json@ stdout.-data ClaudeCliResult = ClaudeCliResult-  { result :: !Text,-    is_error :: !Bool,-    session_id :: !(Maybe Text)-  }-  deriving stock (Eq, Show, Generic)-  deriving anyclass (FromJSON)+-- | What the caller's reasoning-effort preference became on this+-- transport's command line.+--+-- Derived from 'claudeEffortValue' itself rather than from a table+-- written beside it: the adjustment is recorded exactly when the word+-- that reaches @--effort@ differs from the canonical level name, so the+-- description cannot drift away from what the argument vector actually+-- carries. At present that is the single @minimal -> low@ collapse, and+-- a caller asking for @minimal@ and a caller asking for @low@ produce+-- byte-identical command lines — which is precisely why the collapse+-- has to be written down somewhere.+claudeCliThinking :: Options -> Ev.ThinkingTranslation+claudeCliThinking opts = case opts ^. #thinking of+  Nothing -> Ev.noThinkingRequested+  Just lvl ->+    let wire = claudeEffortValue lvl+     in Ev.ThinkingTranslation+          { requested = Just lvl,+            mode = Ev.ThinkingModeFlag,+            effortText = Just wire,+            budgetTokens = Nothing,+            wireField = Just "--effort",+            displayText = Nothing,+            adjustments = [Ev.EffortClamped lvl wire | wire /= renderThinkingLevel lvl]+          }  systemPromptArgs :: Context -> [String] systemPromptArgs ctx = case ctx ^. #systemPrompt of@@ -182,57 +180,110 @@   "" -> []   mid -> ["--model", Text.unpack mid] -decodeResult :: ByteString -> Either BaikaiError ClaudeCliResult-decodeResult bs = case eitherDecodeStrict bs of-  Left err -> Left (decodeError (Text.pack err))-  Right (Aeson.Array events) -> case findResultEvent events of-    Nothing -> Left (decodeError "claude -p: no result event in stdout array")-    Just ev -> case parseEither parseJSON ev of-      Left err -> Left (decodeError (Text.pack err))-      Right r -> Right r-  Right v@(Aeson.Object _) -> case parseEither parseJSON v of-    Left err -> Left (decodeError (Text.pack err))-    Right r -> Right r-  Right _ -> Left (decodeError "claude -p: expected JSON object or array")--findResultEvent :: Vector Value -> Maybe Value-findResultEvent = Vector.find isResult-  where-    isResult (Aeson.Object o) = case KeyMap.lookup "type" o of-      Just (Aeson.String "result") -> True-      _ -> False-    isResult _ = False- runClaudeCli :: ClaudeCliConfig -> Model -> Context -> Options -> IO Resp.Response runClaudeCli cfg m ctx opts = do   let (exe, args) = claudeCliCommand cfg m ctx opts   start <- getCurrentTime   executed <--    trySync $+    Internal.trySync $       run $         cmd exe           & addArgs args           & setNoStdin           & Internal.maybeApply (cfg ^. #workingDir) setWorkingDir   end <- getCurrentTime+  -- The argument vector is the envelope: for a subprocess it is what+  -- crossed the boundary, and there is nothing else to describe the+  -- launch with. Built lazily and dropped unforced when the caller+  -- asked for no evidence.+  let evidenceFor mReport st mErr = do+        prepared <-+          Build.minimalEvidence+            m+            opts+            Ev.TransportSubprocess+            (claudeCliThinking opts)+            (Internal.argvEnvelope exe args)+            start+            end+            st+            mErr+        traverse (observeClaudeCli exe mReport st) prepared+      failedWith mReport err = do+        ev <- evidenceFor mReport Ev.CallFailed (Just err)+        let resp = Resp.errorResponse m end (millisBetween start end) err+        pure resp {Resp.evidence = ev, Resp.responseId = mReport >>= (^. #sessionId)}   case executed of-    Left ex -> pure (Resp.errorResponse m end (millisBetween start end) (exceptionToError ex))+    Left ex -> failedWith Nothing (exceptionToError ex)     Right (exitCode, StdoutRaw out, StderrRaw err) -> case exitCode of-      ExitFailure n -> pure (Resp.errorResponse m end (millisBetween start end) (processError n (Internal.decodeUtf8Lenient err)))-      ExitSuccess -> case decodeResult out of-        Left e -> pure (Resp.errorResponse m end (millisBetween start end) e)+      ExitFailure n -> failedWith Nothing (processError n (Internal.decodeUtf8Lenient err))+      ExitSuccess -> case Internal.decodeClaudeCliResult out of+        Left e -> failedWith Nothing e         Right r ->-          if is_error r-            then pure (Resp.errorResponse m end (millisBetween start end) (providerError (result r)))-            else pure (mkResponse m start end (result r))+          if r ^. #isError+            then failedWith (Just r) (providerError (r ^. #result))+            else do+              ev <- evidenceFor (Just r) Ev.CallSucceeded Nothing+              let resp = mkResponse m start end r+              pure resp {Resp.evidence = ev} -mkResponse :: Model -> UTCTime -> UTCTime -> Text -> Resp.Response-mkResponse m start end body =+-- | Fill in what the tool reported and what baikai knows about the+-- process it launched.+--+-- Only ever reached on a call whose caller asked for evidence, which is+-- what makes the version probe affordable here: it spawns a whole extra+-- subprocess, and charging that to a caller who only wanted an answer+-- from a tool they were about to run anyway would be a visible cost on+-- the cheapest possible call. The parsing it reads is the opposite case+-- and happens unconditionally, because the provider had already decoded+-- the tool's output to find the assistant text.+--+-- Nothing here consults the request. A field the tool did not report+-- stays 'Ev.Unobserved'.+observeClaudeCli ::+  FilePath ->+  Maybe Internal.ClaudeCliReport ->+  Ev.CallStatus ->+  Ev.ModelCallEvidence ->+  IO Ev.ModelCallEvidence+observeClaudeCli exe mReport st ev = do+  identity <- Internal.executableIdentity exe+  let session = observedOf (mReport >>= (^. #sessionId))+      reported = observedOf (mReport >>= (^. #reportedModel))+      used = mReport >>= (^. #usage)+  pure $+    ev+      -- A subprocess has no endpoint URL. Recording the model's base+      -- URL here would suggest an HTTP request that was never made, so+      -- the resolved executable path takes its place.+      & #endpoint . #endpoint .~ Just (fromMaybe (Text.pack exe) (identity ^. #resolvedPath))+      -- For this transport the tool is the implementation, so its own+      -- version is what determines behaviour — not this package's.+      & #endpoint . #implementationVersion .~ (identity ^. #version)+      & #responseId .~ session+      & #observedModel .~ reported+      & #usage .~ observedOf used+      & #responseCommitment .~ commitment used+      & #strength .~ Internal.subprocessStrength session reported+  where+    commitment used = case (st, mReport) of+      (Ev.CallSucceeded, Just r) ->+        Ev.Observed+          ( Ev.commitmentDigest+              (Internal.cliResponseEnvelope (r ^. #result) (fromMaybe zeroUsage used))+          )+      _ -> Ev.Unobserved++observedOf :: Maybe a -> Ev.Observed a+observedOf = maybe Ev.Unobserved Ev.Observed++mkResponse :: Model -> UTCTime -> UTCTime -> Internal.ClaudeCliReport -> Resp.Response+mkResponse m start end r =   Resp.Response     { Resp.message =         AssistantPayload-          { content = Vector.singleton (AssistantText (TextContent body)),-            usage = zeroUsage,+          { content = Vector.singleton (AssistantText (TextContent (r ^. #result))),+            usage = reportedUsage r,             stopReason = Stop,             errorMessage = Nothing,             timestamp = Just end@@ -240,23 +291,22 @@       Resp.model = m,       Resp.api = AnthropicMessagesCli,       Resp.provider = m ^. #provider,-      Resp.responseId = Nothing,+      Resp.responseId = r ^. #sessionId,       Resp.latencyMs = millisBetween start end,-      Resp.errorInfo = Nothing+      Resp.errorInfo = Nothing,+      Resp.evidence = Nothing     } +-- | The tool's own token counts, or zeroes when it reported none.+--+-- 'Resp.Response' has nowhere to say "the tool stayed silent", so a+-- silent tool still yields 'zeroUsage' here. The evidence record does+-- have somewhere to say it, and says it: see 'observeClaudeCli'.+reportedUsage :: Internal.ClaudeCliReport -> Usage+reportedUsage r = fromMaybe zeroUsage (r ^. #usage)+ millisBetween :: UTCTime -> UTCTime -> Int millisBetween a b = round (realToFrac (diffUTCTime b a) * (1000 :: Double))--trySync :: IO a -> IO (Either SomeException a)-trySync action = do-  r <- try action-  case r of-    Left e-      | Just (SomeAsyncException _) <- (fromException e :: Maybe SomeAsyncException) ->-          throwIO e-      | otherwise -> pure (Left e)-    Right a -> pure (Right a)  exceptionToError :: SomeException -> BaikaiError exceptionToError e = fromMaybe (providerError (Text.pack (displayException e))) (fromException e)
src/Baikai/Provider/Claude/Interactive.hs view
@@ -5,6 +5,11 @@ -- "Baikai.Provider.Claude.Cli": that module drives @claude -p@ as a -- batch completion provider, while this module starts the interactive -- terminal UI and returns only after the CLI exits.+--+-- A safety policy Claude Code cannot express is refused before launch+-- rather than dropped: both the pure command builder and the launcher+-- return 'Either' 'AgentRenderError', and a 'Left' means no process was+-- started. module Baikai.Provider.Claude.Interactive   ( ClaudeInteractiveConfig,     executable,@@ -15,12 +20,15 @@   ) where +import Baikai.Agent (AgentProvider (..), AgentRenderError (..)) import Baikai.Interactive   ( InteractiveLaunchRequest,     InteractiveLaunchResult,     InteractiveProvider (..),     InteractiveSafety (..),     interactiveLaunchResult,+    renderCodexApprovalPolicy,+    renderCodexSandboxMode,   ) import Baikai.Prelude import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel)@@ -46,32 +54,47 @@ -- Code launch. The final positional argument is the initial user -- prompt. The prompt is preceded by @--@ because Claude's -- @--allowedTools@ and @--add-dir@ flags are variadic.+--+-- Returns 'Left' when the request's safety policy is one Claude Code+-- cannot express, so a caller who asked to be constrained never+-- receives a command that is not. claudeInteractiveCommand ::-  ClaudeInteractiveConfig -> InteractiveLaunchRequest -> (FilePath, [String])-claudeInteractiveCommand cfg req =-  ( cfg ^. #executable,-    modelArgs req-      <> effortArgs req-      <> systemPromptArgs req-      <> extraDirArgs req-      <> safetyArgs req-      <> fmap Text.unpack (cfg ^. #extraArgs)-      <> fmap Text.unpack (req ^. #extraArgs)-      <> ["--", Text.unpack (req ^. #userPrompt)]-  )+  ClaudeInteractiveConfig ->+  InteractiveLaunchRequest ->+  Either AgentRenderError (FilePath, [String])+claudeInteractiveCommand cfg req = do+  safety <- safetyArgs req+  pure+    ( cfg ^. #executable,+      modelArgs req+        <> effortArgs req+        <> systemPromptArgs req+        <> extraDirArgs req+        <> safety+        <> fmap Text.unpack (cfg ^. #extraArgs)+        <> fmap Text.unpack (req ^. #extraArgs)+        <> ["--", Text.unpack (req ^. #userPrompt)]+    )  -- | Launch Claude Code with inherited stdin, stdout, and stderr so -- the local CLI owns the interactive terminal experience.+--+-- A 'Left' result means no process was started: the requested safety+-- policy was refused before launch. A 'Right' carrying a non-zero+-- 'System.Exit.ExitCode' means the session ran and exited non-zero. launchClaudeInteractive ::-  ClaudeInteractiveConfig -> InteractiveLaunchRequest -> IO InteractiveLaunchResult-launchClaudeInteractive cfg req = do-  let (exe, args) = claudeInteractiveCommand cfg req-  code <--    run $-      cmd exe-        & addArgs args-        & maybe id setWorkingDir (req ^. #workingDir)-  pure (interactiveLaunchResult InteractiveClaude code)+  ClaudeInteractiveConfig ->+  InteractiveLaunchRequest ->+  IO (Either AgentRenderError InteractiveLaunchResult)+launchClaudeInteractive cfg req = case claudeInteractiveCommand cfg req of+  Left err -> pure (Left err)+  Right (exe, args) -> do+    code <-+      run $+        cmd exe+          & addArgs args+          & maybe id setWorkingDir (req ^. #workingDir)+    pure (Right (interactiveLaunchResult InteractiveClaude code))  modelArgs :: InteractiveLaunchRequest -> [String] modelArgs req = case Text.strip <$> req ^. #modelId of@@ -100,10 +123,25 @@ extraDirArgs req =   concatMap (\dir -> ["--add-dir", dir]) (req ^. #extraDirs) -safetyArgs :: InteractiveLaunchRequest -> [String]+-- | 'DefaultSafety' means the caller declined to specify a policy, so+-- rendering nothing honors it rather than downgrading it. An empty+-- allow-list restricts nothing, so it too renders nothing. Only a+-- Codex sandbox policy is a restriction Claude Code cannot express,+-- and that is refused.+safetyArgs :: InteractiveLaunchRequest -> Either AgentRenderError [String] safetyArgs req = case req ^. #safety of-  ClaudeAllowedTools [] -> []+  DefaultSafety -> Right []+  ClaudeAllowedTools [] -> Right []   ClaudeAllowedTools tools ->-    ["--allowedTools", Text.unpack (Text.intercalate "," tools)]-  DefaultSafety -> []-  CodexSandbox _ _ -> []+    Right ["--allowedTools", Text.unpack (Text.intercalate "," tools)]+  CodexSandbox sandbox approval ->+    Left+      ( SafetyNotExpressible+          AgentClaude+          ( "Claude Code cannot express a Codex sandbox policy ("+              <> renderCodexSandboxMode sandbox+              <> ", "+              <> renderCodexApprovalPolicy approval+              <> "); use ClaudeAllowedTools, or DefaultSafety to accept Claude's own default"+          )+      )
src/Baikai/Provider/Claude/Internal/ErrorClass.hs view
@@ -5,15 +5,14 @@ -- and semantics here may change in minor releases. -- -- Two entry points cover the two ways a failure reaches the provider:--- 'classifyException' for an exception thrown by the @servant-client@--- HTTP layer, and 'classifyErrorValue' for an Anthropic @error@ event+-- 'classifyException' for any exception the worker catches from the+-- transport — @http-client@, TLS and socket failures, all delegated to+-- "Baikai.Provider.Transport.Classify" so both providers classify them+-- identically — and 'classifyErrorValue' for an Anthropic @error@ event -- that arrives mid-stream as a JSON 'Value'. module Baikai.Provider.Claude.Internal.ErrorClass   ( classifyException,-    classifyErrorText,     classifyErrorValue,-    -- | Exposed for testing the HTTP-status mapping without a live call.-    responseToError,   ) where @@ -21,98 +20,30 @@   ( BaikaiError (..),     ErrorCategory (..),     bodyIndicatesOverflow,-    decodeError,-    httpError,-    invalidRequest,-    parseRetryAfterSeconds,     providerError,   )-import Control.Exception (SomeException, displayException, fromException)+import Baikai.Provider.Transport.Classify (classifyTransportException)+import Control.Exception (SomeException, displayException) import Data.Aeson (Value (..)) import Data.Aeson.KeyMap qualified as KeyMap-import Data.ByteString (ByteString)-import Data.ByteString.Lazy qualified as LBS-import Data.CaseInsensitive qualified as CI-import Data.Foldable (toList)-import Data.Sequence (Seq)+import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as Text-import Data.Text.Encoding qualified as Text-import Data.Text.Encoding.Error qualified as Text-import Network.HTTP.Client qualified as HTTP-import Network.HTTP.Types.Status (statusCode)-import Servant.Client (ClientError, ResponseF (..))-import Servant.Client qualified as Servant-import Text.Read (readMaybe) --- | Convert any exception caught from the Anthropic SDK into a--- categorised 'BaikaiError'. Recognises @servant-client@ 'ClientError'--- and raw @http-client@ 'HttpException'; anything else degrades to a--- generic provider error carrying the displayed exception text.+-- | Convert any exception caught while driving the Anthropic transport+-- into a categorised 'BaikaiError'.+--+-- Recognised transport failures — every @http-client@ 'HttpException'+-- constructor, a raw socket 'IOException' from the body read, and a raw+-- or wrapped TLS exception — are classified by the shared core rule.+-- Anything else is not a transport failure at all (a programming error+-- in a callback, say) and degrades to a generic provider error carrying+-- the displayed exception text, so it is never reported as retryable. classifyException :: SomeException -> BaikaiError-classifyException ex-  | Just clientErr <- fromException ex = fromClientError clientErr-  | Just httpEx <- fromException ex = fromHttpException httpEx-  | otherwise = providerError (Text.pack (displayException ex))--fromClientError :: ClientError -> BaikaiError-fromClientError clientErr = case clientErr of-  Servant.FailureResponse _req resp -> responseToError resp-  Servant.DecodeFailure detail _ -> decodeError detail-  Servant.UnsupportedContentType _ _ -> decodeError "unsupported content type in Anthropic response"-  Servant.InvalidContentTypeHeader _ -> decodeError "invalid content-type header in Anthropic response"-  Servant.ConnectionError exc ->-    (providerError ("connection error: " <> Text.pack (displayException exc)))-      { category = TransientError-      }---- | Build a 'BaikaiError' from a non-2xx HTTP response: status code,--- @Retry-After@ header (when integer-valued), and a snippet of the body--- (which also feeds context-overflow detection).-responseToError :: ResponseF LBS.ByteString -> BaikaiError-responseToError resp = httpError status retryAfter body-  where-    status = statusCode (responseStatusCode resp)-    body = decodeLenient (LBS.toStrict (responseBody resp))-    retryAfter = parseRetryAfter (responseHeaders resp)---- | Look up an integer @Retry-After@ header value (seconds). The HTTP--- date form is not parsed and yields 'Nothing'.-parseRetryAfter :: Seq (CI.CI ByteString, ByteString) -> Maybe Int-parseRetryAfter headers = do-  raw <- lookup (CI.mk "Retry-After") (toList headers)-  parseRetryAfterSeconds (decodeLenient raw)--fromHttpException :: HTTP.HttpException -> BaikaiError-fromHttpException = \case-  HTTP.InvalidUrlException url reason ->-    invalidRequest (Text.pack (url <> ": " <> reason))-  HTTP.HttpExceptionRequest _ content -> fromHttpExceptionContent content--fromHttpExceptionContent :: HTTP.HttpExceptionContent -> BaikaiError-fromHttpExceptionContent = \case-  HTTP.StatusCodeException resp body ->-    httpError-      (statusCode (HTTP.responseStatus resp))-      (parseRetryAfterHttp (HTTP.responseHeaders resp))-      (decodeLenient body)-  HTTP.ConnectionFailure e -> transient (Text.pack (displayException e))-  HTTP.ConnectionTimeout -> transient "connection timeout"-  HTTP.ResponseTimeout -> transient "response timeout"-  HTTP.ConnectionClosed -> transient "connection closed"-  HTTP.NoResponseDataReceived -> transient "no response data received"-  HTTP.IncompleteHeaders -> transient "incomplete response headers"-  other -> providerError (Text.pack (show other))-  where-    transient t = (providerError ("connection error: " <> t)) {category = TransientError}--parseRetryAfterHttp :: [(CI.CI ByteString, ByteString)] -> Maybe Int-parseRetryAfterHttp headers = do-  raw <- lookup (CI.mk "Retry-After") headers-  parseRetryAfterSeconds (decodeLenient raw)--decodeLenient :: ByteString -> Text-decodeLenient = Text.decodeUtf8With Text.lenientDecode+classifyException ex =+  fromMaybe+    (providerError (Text.pack (displayException ex)))+    (classifyTransportException ex)  -- | Classify a mid-stream Anthropic @error@ event. The value is the -- inner error object, e.g. @{"type":"overloaded_error","message":"…"}@;@@ -133,20 +64,6 @@     stringField k o = case KeyMap.lookup k o of       Just (String t) -> Just t       _ -> Nothing---- | Recover HTTP classification from the text shape emitted by the--- upstream SDK's non-2xx path. The local SSE transport preserves--- headers and should be preferred; this is a defense-in-depth parser.-classifyErrorText :: Text -> Maybe BaikaiError-classifyErrorText raw = do-  rest <- Text.stripPrefix "HTTP error " raw-  let (codeText, afterCode) = Text.breakOn " " rest-  code <- readMaybe (Text.unpack codeText)-  let body = case Text.breakOn ": " afterCode of-        (_, sepBody)-          | not (Text.null sepBody) -> Text.drop 2 sepBody-        _ -> ""-  pure (httpError code Nothing body)  -- | Map an Anthropic error @type@ string (plus its message, for the -- overflow special case) to a category.
src/Baikai/Provider/Claude/Internal/Request.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedRecordDot #-}  -- | Internal request mapping for the Anthropic Messages provider. --@@ -6,8 +7,15 @@ -- compatibility guarantees. Import the public provider module for stable application code. module Baikai.Provider.Claude.Internal.Request   ( mapRequest,+    planRequest,+    planSpeed,+    planThinking,+    describeThinkingFor,     ThinkingPlan (..),+    SamplingPlan (..),+    uncappedMaxTokensFloor,     computeThinking,+    normalizeToolCallId,   ) where @@ -15,21 +23,30 @@ import Baikai.Compat (AnthropicMessagesCompat (..), AnthropicThinkingStyle (..)) import Baikai.Content qualified as Content import Baikai.Context (Context (..))+import Baikai.Evidence+  ( ThinkingAdjustment (..),+    ThinkingMode (..),+    ThinkingTranslation (..),+    noThinkingRequested,+  ) import Baikai.Message qualified as Msg import Baikai.Model (Model, anthropicMessagesCompatFor) import Baikai.Options (Options (..))-import Baikai.ResponseFormat (ResponseFormat (..))-import Baikai.ThinkingLevel (ThinkingLevel (..), thinkingTokenBudget)+import Baikai.ResponseFormat (JsonSchemaFormat (..), ResponseFormat (..))+import Baikai.Speed (Speed (..))+import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel, thinkingTokenBudget) import Baikai.Tool qualified as Tool import Claude.V1.Messages qualified as Messages import Claude.V1.Tool qualified as ClaudeTool-import Control.Lens ((^.))+import Control.Lens ((%~), (&), (.~), (^.))+import Crypto.Hash.SHA256 qualified as SHA256 import Data.Aeson ((.=)) import Data.Aeson qualified as Aeson+import Data.ByteString.Base16 qualified as Base16 import Data.ByteString.Base64 qualified as Base64 import Data.Char (isAlphaNum, isAscii) import Data.Generics.Labels ()-import Data.Maybe (fromMaybe)+import Data.Maybe (catMaybes, fromMaybe) import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text@@ -39,23 +56,53 @@ import Numeric.Natural (Natural)  -- ============================================================--- Request mapping (preserved from EP-2 with minor refactoring to--- accept Context/Options directly).+-- Request mapping: Context and Options onto the SDK's request record. -- ============================================================ -mapRequest :: Model -> Context -> Options -> Either Text Messages.CreateMessage+-- | The wire wants an absent field for "no stop sequences", and+-- 'Baikai.Options.stopSequences' says that with an empty list — the one+-- representation, where @Nothing@ and @Just []@ used to be two.+nonEmptyStops :: [Text] -> Maybe (Vector.Vector Text)+nonEmptyStops [] = Nothing+nonEmptyStops xs = Just (Vector.fromList xs)++-- | Map a baikai request onto the SDK's 'Messages.CreateMessage', and+-- describe what the caller's reasoning-effort preference became on the+-- way.+--+-- The 'ThinkingTranslation' is returned rather than reconstructed+-- downstream because this is the only place that knows all of it: the+-- host compatibility lookup, the model's reasoning capability, the+-- adaptive effort vocabulary, and the max-tokens interaction below all+-- feed into it. A trace sink asked to re-derive it would have to+-- reimplement every one of them.+mapRequest ::+  Model -> Context -> Options -> Either Text (Messages.CreateMessage, ThinkingTranslation) mapRequest m ctx opts = do-  msgs <- traverse mapMessage (Vector.toList (ctx ^. #messages))+  case opts ^. #toolChoice of+    Just Tool.ToolChoiceRequired | not (anthropicMessagesCompatFor m).supportsForcedToolChoice -> unsupportedForcedChoice+    Just (Tool.ToolChoiceSpecific _) | not (anthropicMessagesCompatFor m).supportsForcedToolChoice -> unsupportedForcedChoice+    _ -> pure ()+  mapM_+    ( \msg -> case msg of+        Msg.AssistantMessage payload ->+          mapM_+            ( \block -> case block of+                Content.AssistantThinking th+                  | Just _ <- Content.replayState th ->+                      Left "This endpoint cannot replay provider-scoped reasoning state; use its originating API and model"+                _ -> pure ()+            )+            (payload ^. #content)+        _ -> pure ()+    )+    (ctx ^. #messages)+  msgs <- catMaybes <$> traverse mapMessage (Vector.toList (ctx ^. #messages))   let compat = anthropicMessagesCompatFor m       cap = m ^. #maxOutputTokens-      baseTokens = fromMaybe cap (opts ^. #maxTokens)+      baseTokens = resolveBaseTokens m opts       clamp n = if cap == 0 then n else min n cap-      plan0 = computeThinking compat m (opts ^. #thinking)-      requested = clamp (baseTokens + fromMaybe 0 (budget plan0))-      plan = case budget plan0 of-        Just b-          | requested <= b -> emptyThinkingPlan-        _ -> plan0+      (plan, sampling, translation) = planRequest m opts       maxTokensField_ = case budget plan of         Just b -> clamp (baseTokens + b)         Nothing -> clamp baseTokens@@ -71,21 +118,153 @@         Nothing -> Nothing       outputConfigField = mergeEffort (effort plan) (fmap mkAnthropicOutputConfig (opts ^. #responseFormat))   pure-    Messages._CreateMessage-      { Messages.model = m ^. #modelId,-        Messages.messages = Vector.fromList msgs,-        Messages.max_tokens = maxTokensField_,-        Messages.system = fmap Messages.SystemPromptText (ctx ^. #systemPrompt),-        Messages.temperature = opts ^. #temperature,-        Messages.top_p = opts ^. #topP,-        Messages.stop_sequences = opts ^. #stopSequences,-        Messages.tools = toolsField,-        Messages.tool_choice = toolChoiceField,-        Messages.cache_control = cacheControlField,-        Messages.thinking = field plan,-        Messages.output_config = outputConfigField-      }+    ( Messages._CreateMessage+        { Messages.model = m ^. #modelId,+          Messages.messages = Vector.fromList msgs,+          Messages.max_tokens = maxTokensField_,+          Messages.system = fmap Messages.SystemPromptText (ctx ^. #systemPrompt),+          Messages.temperature = sampling ^. #temperature,+          Messages.top_p = sampling ^. #topP,+          Messages.stop_sequences = nonEmptyStops (opts ^. #stopSequences),+          Messages.tools = toolsField,+          Messages.tool_choice = toolChoiceField,+          Messages.cache_control = cacheControlField,+          Messages.speed = fst (planSpeed compat (opts ^. #speed)),+          Messages.thinking = field plan,+          Messages.output_config = outputConfigField+        },+      translation+    ) +unsupportedForcedChoice :: Either Text ()+unsupportedForcedChoice = Left "This model does not support forced tool choice; use ToolChoiceAuto or ToolChoiceNone"++-- | The sampling parameters that will reach the wire, after the compat+-- record's gate. 'Nothing' means the field is omitted — the SDK encodes+-- 'Messages.CreateMessage' with @omitNothingFields = True@, so a+-- 'Nothing' is genuinely absent from the request body rather than a+-- JSON @null@ the provider would reject.+data SamplingPlan = SamplingPlan+  { temperature :: !(Maybe Double),+    topP :: !(Maybe Double)+  }+  deriving stock (Eq, Show, Generic)++-- | The @max_tokens@ sent for a model whose cap is unknown (@0@) when+-- the caller set no 'Baikai.Options.maxTokens'.+--+-- Anthropic requires @max_tokens@ on every request and rejects @0@, so+-- the OpenAI adapter's rule — omit the field entirely — is not+-- available here. 1024 is the SDK's own @_CreateMessage@ default and is+-- accepted by every generation and every known compatible host.+--+-- This is a default, not a downgrade of anything the caller asked for,+-- so no adjustment is recorded: it is visible in the request body, which+-- the evidence record already digests. An explicit+-- @maxTokens = Just 0@ is forwarded as written.+uncappedMaxTokensFloor :: Natural+uncappedMaxTokensFloor = 1024++-- | The output-token base this request resolves to before any thinking+-- budget is added: the caller's 'Baikai.Options.maxTokens' if they set+-- one, the model's cap if it knows one, and 'uncappedMaxTokensFloor'+-- when neither is available.+resolveBaseTokens :: Model -> Options -> Natural+resolveBaseTokens m opts = case opts ^. #maxTokens of+  Just n -> n+  Nothing+    | cap == 0 -> uncappedMaxTokensFloor+    | otherwise -> cap+  where+    cap = m ^. #maxOutputTokens++-- | Everything 'mapRequest' decides about thinking, sampling and the+-- output ceiling, and the one description of all of it.+--+-- Factored out of 'mapRequest' so the pre-dispatch strictness gate can+-- ask what /would/ happen without building a request. Both callers go+-- through this one function on purpose: a gate that reimplemented the+-- ceiling arithmetic would miss the least discoverable of baikai's+-- downgrades the first time either side changed, and it would miss it+-- silently. The same argument puts sampling here rather than in+-- 'mapRequest': the adapter that builds the request owns the+-- description of what it translated+-- (@docs\/adr\/0003-the-adapter-owns-the-translation-description.md@),+-- and a dropped @temperature@ is a translation, not an absence+-- (@docs\/adr\/0002-requested-translated-observed-are-never-collapsed.md@).+--+-- The thinking interaction it captures: the output-token ceiling this+-- request resolves to still has the thinking budget inside it, the+-- budget has to fit, and when it does not the entire thinking plan is+-- dropped. A caller who lowered @maxTokens@ on a reasoning model+-- silently loses thinking, which is why both colliding numbers are+-- recorded in the adjustment.+--+-- The sampling gate: 'Baikai.Compat.supportsSamplingParameters' says+-- whether the model generation accepts @temperature@ and @top_p@ at+-- all. Adaptive-era generations reject them with a 400, so they are+-- dropped and the drop is recorded. Three more sampling controls —+-- @seed@, @frequencyPenalty@ and @presencePenalty@ — have no field in+-- the Anthropic Messages API on any generation, so they are recorded+-- separately: one is a fact about the model, the other about the API.+planRequest :: Model -> Options -> (ThinkingPlan, SamplingPlan, ThinkingTranslation)+planRequest m opts =+  (plan, sampling, translation & #adjustments %~ (<> (samplingAdjustments <> snd (planSpeed compat (opts ^. #speed)))))+  where+    compat = anthropicMessagesCompatFor m+    cap = m ^. #maxOutputTokens+    baseTokens = resolveBaseTokens m opts+    clamp n = if cap == 0 then n else min n cap+    (plan0, translation0) = computeThinking compat m (opts ^. #thinking)+    resolvedCeiling = clamp (baseTokens + fromMaybe 0 (budget plan0))+    (plan, translation) = case (budget plan0, translation0 ^. #requested) of+      (Just b, Just lvl)+        | resolvedCeiling <= b ->+            ( emptyThinkingPlan,+              dropThinking (ThinkingDroppedBudgetExceeded lvl b resolvedCeiling) translation0+            )+      _ -> (plan0, translation0)++    gated = not (compat ^. #supportsSamplingParameters)+    sampling+      | gated = SamplingPlan {temperature = Nothing, topP = Nothing}+      | otherwise =+          SamplingPlan {temperature = opts ^. #temperature, topP = opts ^. #topP}++    -- In wire order, and only the ones the caller actually set.+    modelDropped =+      [name | (name, isSet) <- [("temperature", set_ (opts ^. #temperature)), ("top_p", set_ (opts ^. #topP))], isSet]+    apiDropped =+      [ name+      | (name, isSet) <-+          [ ("seed", set_ (opts ^. #seed)),+            ("frequency_penalty", set_ (opts ^. #frequencyPenalty)),+            ("presence_penalty", set_ (opts ^. #presencePenalty))+          ],+        isSet+      ]+    set_ :: Maybe a -> Bool+    set_ = maybe False (const True)++    samplingAdjustments =+      [SamplingDroppedUnsupportedModel modelDropped | gated, not (null modelDropped)]+        <> [SamplingDroppedUnsupportedApi apiDropped | not (null apiDropped)]++-- | The thinking half of 'planRequest', for callers that need only it.+planThinking :: Model -> Options -> (ThinkingPlan, ThinkingTranslation)+planThinking m opts = let (plan, _, translation) = planRequest m opts in (plan, translation)++-- | What this provider would do with the caller's reasoning-effort+-- request, without building or sending anything. The+-- 'Baikai.Provider.Registry.describeThinking' implementation for the+-- Anthropic Messages provider.+--+-- A projection of 'planRequest' rather than its own derivation, so the+-- gate, the builder and the evidence record all read one answer — the+-- sampling drops included.+describeThinkingFor :: Model -> Options -> ThinkingTranslation+describeThinkingFor m opts = snd (planThinking m opts)+ mergeEffort :: Maybe Text -> Maybe Messages.OutputConfig -> Maybe Messages.OutputConfig mergeEffort Nothing cfg = cfg mergeEffort (Just e) Nothing = Just (Messages.effortConfig e)@@ -101,7 +280,7 @@ -- schema, which still forces the model to emit a JSON object. mkAnthropicOutputConfig :: ResponseFormat -> Messages.OutputConfig mkAnthropicOutputConfig = \case-  JsonSchema {schema = s} -> Messages.jsonSchemaConfig s+  JsonSchema f -> Messages.jsonSchemaConfig f.schema   JsonObject ->     Messages.jsonSchemaConfig       (Aeson.object ["type" .= ("object" :: Text)])@@ -156,27 +335,70 @@       budget = Nothing     } +-- | Build the SDK's thinking configuration and, beside it, the+-- provider-neutral description of what the caller's level became.+--+-- The two travel together because they are two views of one decision.+-- Adaptive requests explicitly ask for summarized display, using the catalog+-- thinking style. Budget requests retain their existing provider default.+-- Display changes visibility only; it does not establish reasoning depth.+-- Returning only the first is what this provider used to do, and it is+-- why a caller could never tell an honoured request from a dropped one. computeThinking ::   AnthropicMessagesCompat ->   Model ->   Maybe ThinkingLevel ->-  ThinkingPlan-computeThinking _ _ Nothing = emptyThinkingPlan+  (ThinkingPlan, ThinkingTranslation)+computeThinking _ _ Nothing = (emptyThinkingPlan, noThinkingRequested) computeThinking compat m (Just lvl)-  | not (m ^. #reasoning) = emptyThinkingPlan+  | not (m ^. #reasoning) =+      ( emptyThinkingPlan,+        ThinkingTranslation+          { requested = Just lvl,+            mode = ThinkingModeUnsupported,+            effortText = Nothing,+            budgetTokens = Nothing,+            wireField = Nothing,+            displayText = Nothing,+            adjustments = [ThinkingDroppedUnsupportedModel lvl]+          }+      )   | thinkingStyle compat == AnthropicThinkingAdaptive =-      ThinkingPlan-        { field = Just Messages.ThinkingAdaptive,-          effort = adaptiveEffort lvl,-          budget = Nothing-        }+      let e = adaptiveEffort lvl+       in ( ThinkingPlan+              { field = Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized),+                effort = e,+                budget = Nothing+              },+            ThinkingTranslation+              { requested = Just lvl,+                mode = ThinkingModeAdaptive,+                effortText = e,+                budgetTokens = Nothing,+                wireField = Just "thinking",+                displayText = Just "summarized",+                adjustments = adaptiveAdjustments lvl e+              }+          )   | otherwise =       let b = thinkingTokenBudget lvl-       in ThinkingPlan-            { field = Just Messages.ThinkingEnabled {Messages.budget_tokens = b},-              effort = Nothing,-              budget = Just b-            }+       in ( ThinkingPlan+              { field = Just Messages.ThinkingEnabled {Messages.budget_tokens = b},+                effort = Nothing,+                budget = Just b+              },+            ThinkingTranslation+              { requested = Just lvl,+                mode = ThinkingModeBudget,+                effortText = Nothing,+                budgetTokens = Just b,+                -- A budget expresses the requested level exactly, so+                -- there is nothing to adjust.+                wireField = Just "thinking",+                displayText = Nothing,+                adjustments = []+              }+          )  adaptiveEffort :: ThinkingLevel -> Maybe Text adaptiveEffort = \case@@ -187,6 +409,37 @@   ThinkingXHigh -> Just "xhigh"   ThinkingMax -> Just "max" +-- | What Anthropic's adaptive vocabulary did to the requested level.+--+-- Derived from what 'adaptiveEffort' actually produced rather than from+-- a second table beside it, so the two cannot drift. 'Nothing' means no+-- effort field is sent at all, which leaves the request+-- wire-indistinguishable from a caller who expressed no preference and+-- took Anthropic's own default depth. An effort word that differs from+-- the level's canonical name is a clamp onto the nearest word the+-- adaptive vocabulary has — Anthropic's has no @minimal@.+adaptiveAdjustments :: ThinkingLevel -> Maybe Text -> [ThinkingAdjustment]+adaptiveAdjustments lvl = \case+  Nothing -> [EffortOmitted lvl]+  Just wire+    | wire == renderThinkingLevel lvl -> []+    | otherwise -> [EffortClamped lvl wire]++-- | Record that, after all, nothing about thinking reached the wire.+--+-- Every field describing a wire value is cleared, because after the drop+-- there is none. The adjustment is appended rather than replacing the+-- list so a reader sees the order things were applied in.+dropThinking :: ThinkingAdjustment -> ThinkingTranslation -> ThinkingTranslation+dropThinking adj t =+  t+    & #mode .~ ThinkingModeUnsupported+    & #effortText .~ Nothing+    & #budgetTokens .~ Nothing+    & #wireField .~ Nothing+    & #displayText .~ Nothing+    & #adjustments %~ (<> [adj])+ -- | Map a baikai 'Tool.Tool' into the upstream Anthropic -- 'ClaudeTool.ToolDefinition'. The SDK helper is used to populate -- the ordinary typed fields; the raw request shaper later restores@@ -218,37 +471,103 @@   -- Unreachable in typed requests: ToolChoiceNone is injected by the shaper.   Tool.ToolChoiceNone -> ClaudeTool.ToolChoice_Auto --- | Anthropic enforces @[a-zA-Z0-9_-]+@ on tool-call ids and caps--- their length at 64 characters. Callers may have used any--- naming convention, so the provider boundary normalizes here--- whenever an id is round-tripped back to Anthropic — both on--- assistant turn replay ('Content_Tool_Use') and on tool-result--- messages ('Content_Tool_Result').+-- | Anthropic enforces @[a-zA-Z0-9_-]@ on tool-call ids and caps their+-- length at 64 characters. Callers may have used any naming convention,+-- so the provider boundary normalizes here whenever an id is+-- round-tripped back to Anthropic — both on assistant turn replay+-- ('Messages.Content_Tool_Use') and on tool-result messages+-- ('Messages.Content_Tool_Result').+--+-- An id that already satisfies the rule passes through byte for byte.+-- That covers every id either provider actually mints — Anthropic's+-- @toolu_…@ and OpenAI's @call_…@ — and it must, because the+-- tool-result side normalizes with this same function and the two have+-- to agree.+--+-- Any other id is sanitised, truncated to 51 characters and suffixed+-- with @_@ plus twelve lowercase hex characters of the SHA-256 of the+-- /original/. Mapping every disallowed character to @_@ and truncating+-- is not injective: @a.b@ and @a_b@ both became @a_b@, and two ids+-- differing only after character 64 both became the same 64 characters+-- — two distinct calls in one turn collapsing onto one id, which+-- silently misroutes a tool result. Forty-eight bits of hash make a+-- collision among one conversation's calls negligible, and 'mapMessage'+-- turns a remaining collision into a clear error rather than a+-- misrouted result. Refusing non-conforming ids outright was rejected:+-- it would break replay of any conversation begun on a provider with a+-- different id alphabet. normalizeToolCallId :: Text -> Text-normalizeToolCallId =-  Text.take 64 . Text.map sanitise+normalizeToolCallId original+  | isValid original = original+  | otherwise = Text.take 51 (Text.map sanitise original) <> "_" <> suffix   where-    sanitise c-      | isAscii c && isAlphaNum c = c-      | c == '_' || c == '-' = c-      | otherwise = '_'+    isValid t = not (Text.null t) && Text.length t <= 64 && Text.all allowed t+    allowed c = (isAscii c && isAlphaNum c) || c == '_' || c == '-'+    sanitise c = if allowed c then c else '_'+    suffix =+      Text.take+        12+        (Text.decodeLatin1 (Base16.encode (SHA256.hash (Text.encodeUtf8 original)))) -mapMessage :: Msg.Message -> Either Text Messages.Message+-- | Map one baikai message onto an SDK message, or say why it cannot+-- be sent, or say that it should not be sent at all.+--+-- Three outcomes rather than two, because Anthropic rejects both an+-- empty text block and an empty @content@ array, and baikai can produce+-- either from its own bookkeeping:+--+-- * @Right (Just msg)@ — the ordinary case.+--+-- * @Right Nothing@ — an /assistant/ turn left with no blocks after+--   empty text was dropped. That turn is baikai's own artifact: a text+--   block that opened and closed with no deltas, or a turn whose only+--   content was unsigned thinking, which replay already omits because+--   Anthropic rejects a thinking block without its signature. Dropping+--   it loses nothing the model said, and Anthropic merges the adjacent+--   user turns itself. A placeholder would fabricate content the model+--   never produced.+--+-- * @Left reason@ — a /user/ turn left with no blocks. That is a caller+--   error, not baikai's, so it is refused locally with a better message+--   than the provider's 400 and with the same+--   'Baikai.Error.InvalidRequest' category, which 'prepareCall' already+--   assigns. It is also refused when two @tool_use@ blocks in one+--   assistant turn normalise onto the same id, which would misroute the+--   tool result answering one of them.+mapMessage :: Msg.Message -> Either Text (Maybe Messages.Message) mapMessage = \case   Msg.UserMessage Msg.UserPayload {Msg.content = uc} ->-    Right-      Messages.Message-        { Messages.role = Messages.User,-          Messages.content = Vector.mapMaybe userContentToBlock uc,-          Messages.cache_control = Nothing-        }+    let blocks = Vector.mapMaybe userContentToBlock uc+     in if Vector.null blocks+          then+            Left+              "Anthropic Messages rejects a user turn with no content blocks; \+              \this one had none, or only empty text"+          else+            Right+              ( Just+                  Messages.Message+                    { Messages.role = Messages.User,+                      Messages.content = blocks,+                      Messages.cache_control = Nothing+                    }+              )   Msg.AssistantMessage Msg.AssistantPayload {Msg.content = ac} ->-    Right-      Messages.Message-        { Messages.role = Messages.Assistant,-          Messages.content = Vector.mapMaybe assistantContentToBlock ac,-          Messages.cache_control = Nothing-        }+    let blocks = Vector.mapMaybe assistantContentToBlock ac+     in case duplicateToolUseId blocks of+          Just dup ->+            Left ("duplicate tool_use id after normalisation: " <> dup)+          Nothing+            | Vector.null blocks -> Right Nothing+            | otherwise ->+                Right+                  ( Just+                      Messages.Message+                        { Messages.role = Messages.Assistant,+                          Messages.content = blocks,+                          Messages.cache_control = Nothing+                        }+                  )   Msg.ToolResultMessage     Msg.ToolResultPayload       { Msg.toolCallId = tid,@@ -259,22 +578,41 @@         Left unsupported -> Left unsupported         Right body ->           Right-            Messages.Message-              { Messages.role = Messages.User,-                Messages.content =-                  Vector.singleton-                    Messages.Content_Tool_Result-                      { Messages.tool_use_id = normalizeToolCallId tid,-                        Messages.content = nonEmpty body,-                        Messages.is_error = Just err-                      },-                Messages.cache_control = Nothing-              }+            ( Just+                Messages.Message+                  { Messages.role = Messages.User,+                    Messages.content =+                      Vector.singleton+                        Messages.Content_Tool_Result+                          { Messages.tool_use_id = normalizeToolCallId tid,+                            Messages.content = nonEmpty body,+                            Messages.is_error = Just err+                          },+                    Messages.cache_control = Nothing+                  }+            ) +-- | The first @tool_use@ id that appears twice in one assistant turn,+-- if any. Ids are already normalised at this point, so this catches the+-- residual hash collision as well as a caller that reused an id.+duplicateToolUseId :: Vector Messages.Content -> Maybe Text+duplicateToolUseId = go [] . Vector.toList+  where+    go _ [] = Nothing+    go seen (Messages.Content_Tool_Use {Messages.id = i} : rest)+      | i `elem` seen = Just i+      | otherwise = go (i : seen) rest+    go seen (_ : rest) = go seen rest++-- | An empty text block is dropped: Anthropic rejects+-- @{"type":"text","text":""}@ outright, and an empty block carries+-- nothing the model or the caller said. userContentToBlock :: Content.UserContent -> Maybe Messages.Content userContentToBlock = \case-  Content.UserText (Content.TextContent t) ->-    Just Messages.Content_Text {Messages.text = t, Messages.cache_control = Nothing}+  Content.UserText (Content.TextContent t)+    | Text.null t -> Nothing+    | otherwise ->+        Just Messages.Content_Text {Messages.text = t, Messages.cache_control = Nothing}   Content.UserImage img ->     Just       Messages.Content_Image@@ -287,10 +625,16 @@           Messages.cache_control = Nothing         } +-- | As 'userContentToBlock' for empty text. Unsigned thinking is also+-- dropped, because Anthropic rejects a thinking block whose signature+-- is missing; a turn left with no blocks at all is then dropped+-- entirely by 'mapMessage'. assistantContentToBlock :: Content.AssistantContent -> Maybe Messages.Content assistantContentToBlock = \case-  Content.AssistantText (Content.TextContent t) ->-    Just Messages.Content_Text {Messages.text = t, Messages.cache_control = Nothing}+  Content.AssistantText (Content.TextContent t)+    | Text.null t -> Nothing+    | otherwise ->+        Just Messages.Content_Text {Messages.text = t, Messages.cache_control = Nothing}   Content.AssistantThinking th ->     if Content.redacted th       then Just Messages.Content_Redacted_Thinking {Messages.data_ = Content.thinking th}@@ -324,3 +668,12 @@ nonEmpty t   | Text.null t = Nothing   | otherwise = Just t++-- | One capability gate shared by wire mapping, headers and the describer.+planSpeed :: AnthropicMessagesCompat -> Maybe Speed -> (Maybe Messages.Speed, [ThinkingAdjustment])+planSpeed compat = \case+  Nothing -> (Nothing, [])+  Just SpeedStandard -> (Just Messages.SpeedStandard, [])+  Just SpeedFast+    | compat ^. #supportsFastMode -> (Just Messages.SpeedFast, [])+    | otherwise -> (Nothing, [FastModeDroppedUnsupportedModel])
+ src/Baikai/Provider/Claude/Internal/Stream.hs view
@@ -0,0 +1,1037 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedRecordDot #-}++-- | __Internal module — no stability guarantees.__ This module is+-- exposed so baikai's own test suites and sibling packages can reach+-- it, but it is not part of the public API: its contents may change+-- in /any/ release without a PVP major bump. Do not import it from+-- application code.+--+-- The Anthropic Messages streaming machinery: the SSE driver seam, the+-- event assembler and the translator that turns the SDK's typed+-- 'Claude.V1.Messages.MessageStreamEvent' values into baikai+-- 'AssistantMessageEvent' values. The public entry points built on it+-- live in "Baikai.Provider.Claude.Api".+--+-- Requests start as the SDK's typed 'Claude.V1.Messages.CreateMessage'+-- value, then 'Baikai.Provider.Claude.Shape.streamRequestBody' patches+-- the raw JSON body for tool-schema, @tool_choice@, and tool-cache+-- compat before+-- 'Baikai.Provider.Claude.Sse.claudeSseStreamValueWithHeaders' sends it+-- with cached transport settings and caller headers.+module Baikai.Provider.Claude.Internal.Stream+  ( claudeMessagesStreamWith,+    SseDriver,+    liveSseDriver,+    Assembler (..),+    emptyAssembler,+    translate,+  )+where++import Baikai.CacheRetention (CacheRetention (..))+import Baikai.Content qualified as Content+import Baikai.Context (Context (..))+import Baikai.Cost (CostEstimateReason (CacheDurationNotReported, SpeedNotReported), estimateCost)+import Baikai.Cost.Pricing qualified as Pricing+import Baikai.Error (BaikaiError, contentFiltered, invalidRequest, providerError)+import Baikai.Evidence qualified as Ev+import Baikai.Evidence.Build qualified as Build+import Baikai.Message qualified as Msg+import Baikai.Model (Model, anthropicMessagesCompatFor)+import Baikai.Options (Options (..))+import Baikai.Provider.Claude.Internal.ErrorClass (classifyErrorValue, classifyException)+import Baikai.Provider.Claude.Internal.Request (describeThinkingFor, mapRequest)+import Baikai.Provider.Claude.Shape (streamRequestBody)+import Baikai.Provider.Claude.Sse (claudeSseStreamValueWithHeaders)+import Baikai.Provider.Claude.Sse qualified as Sse+import Baikai.Provider.Claude.Transport qualified as Transport+import Baikai.Provider.Internal.StreamWorker+  ( FrameQueue,+    newFrameQueue,+    pullFrame,+    pushFrame,+    withFrameWorker,+  )+import Baikai.StopReason qualified as Stop+import Baikai.Stream.Event+  ( AssistantMessageEvent (..),+    BlockEndPayload (..),+    DeltaPayload (..),+    IndexPayload (..),+    StartPayload (..),+    ThinkingEndPayload (..),+    ToolCallEndPayload (..),+    doneTerminal,+    errorTerminal,+  )+import Baikai.Url qualified as Url+import Baikai.Usage qualified as Usage+import Baikai.Usage.Normalize qualified as Normalize+import Claude.V1.Messages qualified as Messages+import Control.Applicative ((<|>))+import Control.Exception (SomeAsyncException (..), SomeException, fromException, throwIO, try)+import Control.Lens ((%~), (&), (.~), (^.))+import Data.Aeson (Value)+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KeyMap+import Data.ByteString.Lazy qualified as BSL+import Data.CaseInsensitive qualified as CI+import Data.Generics.Labels ()+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.IntMap.Strict (IntMap)+import Data.IntMap.Strict qualified as IntMap+import Data.IntSet qualified as IntSet+import Data.Maybe (fromMaybe)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Time.Clock (UTCTime, getCurrentTime)+import Data.Vector (Vector)+import Data.Vector qualified as Vector+import Data.Version (showVersion)+import GHC.Generics (Generic)+import Network.HTTP.Types.Header (RequestHeaders)+import Paths_baikai_claude qualified as Paths+import Servant.Client qualified as Client+import Streamly.Data.Stream (Stream)+import Streamly.Data.Stream qualified as Stream++-- | How a call physically reaches Anthropic.+--+-- Production passes 'liveSseDriver'. A test passes one that replays a+-- recorded response through the same+-- 'Baikai.Provider.Claude.Sse.sseFromResponse' the live driver uses, so+-- header capture, status classification, and SSE frame decoding are all+-- the real implementations and only the socket is missing.+type SseDriver =+  ClaudeCall ->+  (Sse.ResponseMetadata -> IO ()) ->+  (Either BaikaiError Messages.MessageStreamEvent -> IO ()) ->+  IO ()++-- | The production driver: a real HTTPS request through the cached+-- transport settings.+liveSseDriver :: SseDriver+liveSseDriver call =+  claudeSseStreamValueWithHeaders+    (call ^. #clientEnv)+    (call ^. #requestHeaders)+    (call ^. #requestBody)++-- | 'Baikai.Provider.Claude.Api.claudeMessagesStream' over an explicit+-- transport driver.+claudeMessagesStreamWith ::+  SseDriver -> Model -> Context -> Options -> Stream IO AssistantMessageEvent+claudeMessagesStreamWith driver m ctx opts =+  Stream.concatEffect $ do+    setupResult <- trySync (prepareCall m ctx opts)+    let setup = either (Left . exceptionToError) id setupResult+    case setup of+      Left err -> Stream.fromList <$> immediateError m opts err+      Right call -> do+        q <- newFrameQueue :: IO (FrameQueue (Either BaikaiError Messages.MessageStreamEvent))+        tref <- newIORef False+        mref <- newIORef Nothing+        startTime <- getCurrentTime+        -- The request body is the envelope the two digests commit to:+        -- it is exactly the JSON this call is about to put on the wire.+        -- Credentials are not in it — they travel in the headers built+        -- separately by 'Transport.requestHeaders'.+        mkEvidence <-+          Build.prepareEvidenceAt+            (Text.pack (Client.showBaseUrl (Client.baseUrl (call ^. #clientEnv))) <> "/v1/messages")+            m+            opts+            Ev.TransportHttpApi+            (call ^. #thinking)+            (call ^. #requestBody)+            startTime+        let initialState =+              ProducerState+                { chan = q,+                  -- Pre-seeded, exactly as the OpenAI producer does it,+                  -- so the first event reaches the consumer immediately+                  -- and carries the request-start timestamp, and so+                  -- every failure path is 'EventStart'-first without+                  -- per-path bookkeeping. Anthropic's message id is not+                  -- known yet; it rides the terminal's @responseId@,+                  -- which 'Baikai.Stream.reassembleResponse' prefers+                  -- anyway.+                  pending =+                    [ EventStart+                        StartPayload+                          { partial = skeletonMessage (emptyAssembler m startTime) startTime,+                            responseId = Nothing+                          }+                    ],+                  assembler =+                    emptyAssembler m startTime+                      & #cacheDuration .~ shapedCacheDuration (call ^. #requestBody)+                      & #fastRequested .~ shapedFastRequested (call ^. #requestBody),+                  finished = False,+                  terminalRef = tref,+                  metadataRef = mref,+                  evidence = mkEvidence+                }+        pure (withFrameWorker q (worker driver call mref q) (Stream.unfoldrM step initialState))++-- | Per-call prepared values, including the shaped JSON request body+-- passed to the local streaming transport.+data ClaudeCall = ClaudeCall+  { clientEnv :: !Client.ClientEnv,+    requestHeaders :: !RequestHeaders,+    timeoutMs :: !(Maybe Int),+    requestBody :: !Aeson.Value,+    -- | The base URL this call actually resolved to, which is the+    -- vendor default when the model carries none. Carried so the+    -- evidence endpoint names the host the call went to; the model's+    -- own field can be @""@ for a call with a perfectly definite+    -- destination.+    baseUrl :: !Text,+    -- | What the caller's reasoning-effort preference became on this+    -- request, as 'mapRequest' described it. Carried from here rather+    -- than recomputed at the terminal: only the request mapper knows+    -- the host compat lookup and the max-tokens interaction that+    -- produced it.+    thinking :: !Ev.ThinkingTranslation+  }+  deriving stock (Generic)++-- | The host this call goes to: the model's base URL, or Anthropic's+-- when it carries none.+resolvedBaseUrl :: Model -> Text+resolvedBaseUrl m = case m ^. #baseUrl of+  "" -> "https://api.anthropic.com"+  u -> u++prepareCall ::+  Model -> Context -> Options -> IO (Either BaikaiError ClaudeCall)+prepareCall m ctx opts = do+  case mapRequest m ctx opts of+    Left e -> pure (Left (invalidRequest e))+    Right (req, translation) -> do+      let url = resolvedBaseUrl m+          compat = anthropicMessagesCompatFor m+          version = Just "2023-06-01"+      -- Checked before the key is resolved, so a base URL baikai will+      -- not send to never causes a credential to be read out of the+      -- environment. The message names the problem and what to write+      -- instead; it renders the URL without its userinfo or query, so an+      -- error reaching a log cannot carry a key someone put in either.+      case Url.baseUrlProblem url of+        Just problem ->+          pure (Left (invalidRequest ("Model.baseUrl is not usable: " <> problem)))+        Nothing -> do+          key <- Transport.resolveKey url opts+          env <- Transport.getClientEnvCached url+          let body = streamRequestBody compat ctx opts req+              headers = Transport.requestHeaders key version compat ctx m opts+          pure+            ( Right+                ClaudeCall+                  { clientEnv = env,+                    requestHeaders = headers,+                    timeoutMs = opts ^. #timeoutMs,+                    requestBody = body,+                    baseUrl = url,+                    thinking = translation+                  }+            )++-- | Worker body: drive the SDK's typed callback, forwarding events onto+-- the frame queue. Any synchronous exception is converted into a+-- classified error frame so the consumer side can translate it through+-- the normal path.+--+-- Nothing here signals end-of-frames: that is the queue's closed flag,+-- set by 'Baikai.Provider.Internal.StreamWorker.forkFrameWorker''s+-- @finally@ however this body ends. A sentinel push would block on a+-- full queue, which is exactly the state a stopped consumer leaves+-- behind.+worker ::+  SseDriver ->+  ClaudeCall ->+  IORef (Maybe Sse.ResponseMetadata) ->+  FrameQueue (Either BaikaiError Messages.MessageStreamEvent) ->+  IO ()+worker driver call metaRef q = do+  r <-+    trySync $+      Transport.runWithTimeout (call ^. #timeoutMs) $+        driver+          call+          (writeIORef metaRef . Just)+          (pushFrame q)+  case r of+    Right Nothing -> pure ()+    Right (Just be) -> pushFrame q (Left be)+    Left e -> pushFrame q (Left (exceptionToError e))++-- | The streaming 'Stream' state.+data ProducerState = ProducerState+  { chan :: !(FrameQueue (Either BaikaiError Messages.MessageStreamEvent)),+    pending :: ![AssistantMessageEvent],+    assembler :: !Assembler,+    finished :: !Bool,+    terminalRef :: !(IORef Bool),+    -- | Where the worker leaves the response-level metadata it captured+    -- before the first event. Read on this side rather than pushed+    -- through 'chan' so the channel keeps carrying exactly one kind of+    -- thing; 'absorbMetadata' folds it into the assembler.+    metadataRef :: !(IORef (Maybe Sse.ResponseMetadata)),+    -- | Everything about this call's evidence that was knowable before+    -- the first byte came back, waiting on the terminal timestamp and+    -- outcome. 'Nothing' when the caller did not ask for evidence.+    -- 'sealTerminal' applies it.+    evidence ::+      !(Maybe (UTCTime -> Ev.CallStatus -> Maybe BaikaiError -> Ev.ModelCallEvidence))+  }+  deriving stock (Generic)++step :: ProducerState -> IO (Maybe (AssistantMessageEvent, ProducerState))+step s+  | (e : rest) <- s ^. #pending = do+      sealed <- sealTerminal s e+      pure+        ( Just+            ( sealed,+              s+                & #pending .~ rest+                & #finished .~ (s ^. #finished || terminal sealed)+            )+        )+  | s ^. #finished = pure Nothing+  | otherwise = do+      mRaw <- pullFrame (s ^. #chan)+      -- After the read, because the worker writes the metadata before it+      -- writes anything onto the channel: taking it here means every+      -- path out of this branch — including the one where the channel+      -- closed without ever producing an event — sees it.+      ass0 <- absorbMetadata (s ^. #metadataRef) (s ^. #assembler)+      let s' = s & #assembler .~ ass0+      case mRaw of+        Nothing -> do+          alreadyTerminal <- readIORef (s' ^. #terminalRef)+          if alreadyTerminal+            then pure Nothing+            else do+              now <- getCurrentTime+              let (events, ass') = unexpectedEoS now ass0+              case events of+                [] -> pure Nothing+                (e : rest) -> do+                  sealed <- sealTerminal (s' & #assembler .~ ass') e+                  pure+                    ( Just+                        ( sealed,+                          s'+                            & #pending .~ rest+                            & #assembler .~ ass'+                            & #finished .~ True+                        )+                    )+        Just raw -> do+          now <- getCurrentTime+          let (events, ass') = translate raw ass0 now+          case events of+            [] -> step (s' & #assembler .~ ass')+            (e : rest) -> do+              sealed <- sealTerminal (s' & #assembler .~ ass') e+              pure+                ( Just+                    ( sealed,+                      s'+                        & #pending .~ rest+                        & #assembler .~ ass'+                        & #finished .~ (s' ^. #finished || terminal sealed)+                    )+                )++-- | Mark the stream terminated and attach the call's evidence to the+-- terminal event.+--+-- Every event this producer yields goes through here, and the three+-- sites that can produce a terminal — a translated upstream event, a+-- queued event drained from 'pending', and the unexpected-end-of-stream+-- recovery — therefore all seal identically. Doing it here rather than+-- inside 'translate' keeps that function pure; evidence construction+-- needs 'IO' for the call identifier.+--+-- A non-terminal event passes through unchanged, and so does a terminal+-- on a call whose caller asked for no evidence.+sealTerminal :: ProducerState -> AssistantMessageEvent -> IO AssistantMessageEvent+sealTerminal s ev+  | not (terminal ev) = pure ev+  | otherwise = do+      writeIORef (s ^. #terminalRef) True+      case s ^. #evidence of+        Nothing -> pure ev+        Just finish -> do+          now <- getCurrentTime+          let st = statusOf ev+              record = observeAnthropic st (s ^. #assembler) (finish now st (errorOf ev))+          pure (withEvidence record ev)+  where+    statusOf = \case+      EventDone {} -> Ev.CallSucceeded+      _ -> Ev.CallFailed+    -- The terminal payload already carries the normalized error, and+    -- 'errorTerminal' guarantees it is 'Just' on every 'EventError'.+    errorOf = \case+      EventError p -> p ^. #errorInfo+      _ -> Nothing+    -- Set through the generic-lens label rather than a record update:+    -- 'Baikai.Options.Options' also has an @evidence@ field, so under+    -- @DuplicateRecordFields@ a bare @p {evidence = ...}@ has no unique+    -- constructor to resolve to.+    withEvidence record = \case+      EventDone p -> EventDone (p & #evidence .~ Just record)+      EventError p -> EventError (p & #evidence .~ Just record)+      other -> other++-- | Replace the observed fields of a prepared evidence record with what+-- this call actually saw, and derive the strength from that.+--+-- Only ever reached on a call whose caller asked for evidence, which is+-- what makes it safe to compute the response commitment here: that+-- digest hashes the model's entire output and is the most expensive+-- thing this provider adds. The observations it reads were gathered+-- unconditionally, because each costs a lookup and each improves the+-- 'Baikai.Response.Response' for every caller.+--+-- Observed fields never borrow the request. An observation the provider did+-- not make stays 'Ev.Unobserved'. The separate summary diagnostic relates+-- the translated request to completed blocks without claiming observed effort.+observeAnthropic ::+  Ev.CallStatus -> Assembler -> Ev.ModelCallEvidence -> Ev.ModelCallEvidence+observeAnthropic st ass ev =+  ev+    & #endpoint . #implementationVersion .~ Just claudePackageVersion+    & #observedModel .~ (ass ^. #observedModel)+    & #providerRequestId .~ (ass ^. #providerRequestId)+    & #responseId .~ maybe Ev.Unobserved Ev.Observed (ass ^. #responseId)+    & #usage .~ observedUsage ass+    & #thinking . #adjustments %~ (<> summaryDiagnostics st ass (ev ^. #thinking))+    & #responseCommitment .~ responseCommitment st ass+    & #strength+      .~ Ev.deriveStrength+        (ass ^. #observedModel)+        (ass ^. #providerRequestId)+        (maybe Ev.Unobserved Ev.Observed (ass ^. #responseId))++-- | Diagnose visibility after a successful response, without inventing an+-- observation of effort or weakening the original translation. Adaptive calls+-- may legitimately contain no thinking blocks. Failed streams may simply have+-- stopped before text arrived, so neither case claims an unavailable summary.+summaryDiagnostics :: Ev.CallStatus -> Assembler -> Ev.ThinkingTranslation -> [Ev.ThinkingAdjustment]+summaryDiagnostics st ass translation+  | st == Ev.CallSucceeded,+    Just _ <- translation ^. #requested,+    translation ^. #mode `elem` [Ev.ThinkingModeAdaptive, Ev.ThinkingModeBudget],+    not (null thinkingBlocks),+    all unreadable thinkingBlocks =+      [Ev.ThinkingSummaryUnavailable]+  | otherwise = []+  where+    thinkingBlocks = [t | Content.AssistantThinking t <- Vector.toList (blocksInOrder ass)]+    unreadable t = t ^. #redacted || Text.null (t ^. #thinking)++-- | The token accounting, but only if Anthropic actually reported it.+--+-- The assembler initialises 'usage' to zeroes, so reporting it+-- unconditionally would tell a reader the provider said this call+-- consumed nothing — which for a call that failed before any usage+-- arrived is a fabrication, and exactly what 'Ev.Observed' exists to+-- stop.+observedUsage :: Assembler -> Ev.Observed Usage.Usage+observedUsage ass+  | ass ^. #usageReported = Ev.Observed (finalUsage ass)+  | otherwise = Ev.Unobserved++-- | A commitment to what came back, on a call that produced a response.+--+-- Left 'Ev.Unobserved' otherwise: a digest of an empty envelope is a+-- real-looking value standing for a response that never arrived.+responseCommitment :: Ev.CallStatus -> Assembler -> Ev.Observed Text+responseCommitment Ev.CallSucceeded ass =+  Ev.Observed (Ev.commitmentDigest (responseEnvelope ass))+responseCommitment _ _ = Ev.Unobserved++-- | What that digest commits to: the assembled content blocks in order,+-- the stop reason, and the reported usage.+--+-- Deliberately the assembled response rather than the raw SSE bytes. Two+-- identical responses split into different frames must produce the same+-- digest, and the frame boundaries are a transport detail no verifier+-- holding the response could reproduce.+responseEnvelope :: Assembler -> Value+responseEnvelope ass =+  Aeson.object+    [ "content" Aeson..= blocksInOrder ass,+      "stop_reason" Aeson..= (ass ^. #stopReason),+      -- Token counts only: 'Ev.usageEnvelope' omits the cost, which+      -- baikai computes from the caller's catalog rather than reads off+      -- the response, and which a verifier therefore cannot reproduce.+      "usage" Aeson..= Ev.usageEnvelope (finalUsage ass)+    ]++-- | The version of this package, for the evidence record's endpoint+-- identity. Read from the cabal-generated module rather than written as+-- a literal, which becomes a lie the first time a release misses it.+claudePackageVersion :: Text+claudePackageVersion = Text.pack (showVersion Paths.version)++-- | Fold whatever response-level metadata the worker has captured into+-- the assembler.+--+-- Idempotent: applying it again overwrites the same fields with the same+-- values, which is what lets 'step' call it on every pass rather than+-- tracking whether it has run.+absorbMetadata :: IORef (Maybe Sse.ResponseMetadata) -> Assembler -> IO Assembler+absorbMetadata ref ass = do+  meta <- readIORef ref+  pure $ case meta of+    Nothing -> ass+    Just md ->+      ass+        & #httpStatus .~ Just (md ^. #httpStatus)+        & #providerRequestId .~ correlationId md++-- | Anthropic's correlation identifier for this response, or a+-- gateway's if Anthropic's own is absent.+--+-- The preference order is 'Sse.capturedHeaderNames' itself, so the+-- allow-list and the preference cannot disagree. Nothing is invented:+-- a response carrying none of those headers leaves this+-- 'Ev.Unobserved'.+correlationId :: Sse.ResponseMetadata -> Ev.Observed Text+correlationId md =+  case [v | n <- Sse.capturedHeaderNames, Just v <- [lookup (headerName n) (md ^. #headers)]] of+    (v : _) -> Ev.Observed v+    [] -> Ev.Unobserved+  where+    headerName = Text.decodeUtf8 . CI.foldedCase++terminal :: AssistantMessageEvent -> Bool+terminal = \case+  EventDone {} -> True+  EventError {} -> True+  _ -> False++-- | The recovery path: the frame queue closed before any terminal event.+--+-- Returns the block-closing events first and then the terminal, so a+-- consumer reading raw events and a consumer reassembling them see the+-- same partial output.+unexpectedEoS ::+  UTCTime -> Assembler -> ([AssistantMessageEvent], Assembler)+unexpectedEoS now ass =+  let (closeEvents, ass') = closeOpenBlocks ass+      errText = "claude stream ended without message_stop"+      msg = finalMessageOnError ass' now errText+   in ( closeEvents+          <> [EventError (errorTerminal Nothing (ass' ^. #responseId) Stop.ErrorReason msg (providerError errText))],+        ass'+      )++-- | Close every still-open block in ascending index order, exactly as a+-- @content_block_stop@ for each would.+--+-- Used on every failure path, because the terminal message is built from+-- 'blocksInOrder' — the /closed/ blocks — and a failure that left text,+-- thinking or tool arguments open would otherwise drop them from both+-- the events and the message. Core's reassembler recovers open buffers+-- on its own; a consumer reading raw events had no such recourse.+closeOpenBlocks :: Assembler -> ([AssistantMessageEvent], Assembler)+closeOpenBlocks ass = foldl' close ([], ass) openIndices+  where+    openIndices =+      IntSet.toAscList . IntSet.unions $+        map+          IntMap.keysSet+          [ ass ^. #textBuf,+            ass ^. #thinkBuf,+            ass ^. #redactedBuf,+            ass ^. #toolArgsBuf+          ]+    close (acc, a) i = let (evs, a') = handleBlockStop i a in (acc <> evs, a')++-- | Translation state across one streaming call.+--+-- The four fields below @stopReason@ are what this call /observed/, as+-- distinct from what it requested. They are kept here rather than+-- derived at the terminal because this record is the only state that+-- survives from the first event to the last, and because an observation+-- that never arrived must stay 'Ev.Unobserved' rather than falling back+-- to the caller's configuration.+data Assembler = Assembler+  { model :: !Model,+    start :: !UTCTime,+    responseId :: !(Maybe Text),+    closed :: !(IntMap Content.AssistantContent),+    textBuf :: !(IntMap Text),+    thinkBuf :: !(IntMap Text),+    thinkSig :: !(IntMap Text),+    redactedBuf :: !(IntMap Text),+    toolArgsBuf :: !(IntMap Text),+    toolMeta :: !(IntMap (Text, Text)),+    usage :: !Usage.Usage,+    cacheDuration :: !(Maybe CacheRetention),+    fastRequested :: !Bool,+    stopReason :: !Stop.StopReason,+    -- | Refusal detail reported in the delta, consumed at message_stop.+    stopDetails :: !(Maybe Messages.StopDetails),+    -- | Anthropic's own correlation identifier for this call, from the+    -- response headers.+    providerRequestId :: !(Ev.Observed Text),+    -- | The model identifier Anthropic reported running, from+    -- @message_start@. Never the configured model.+    observedModel :: !(Ev.Observed Text),+    -- | The response's HTTP status. Recorded because the transport has+    -- it; 'Baikai.Evidence.ModelCallEvidence' has no field for it, and+    -- adding one to the evidence schema is a core decision, not this+    -- module's.+    httpStatus :: !(Maybe Int),+    -- | Whether Anthropic actually reported token counts, as opposed to+    -- 'usage' still holding the zeroes it was initialised with. Without+    -- this a failed call would claim the provider reported consuming+    -- nothing.+    usageReported :: !Bool+  }+  deriving stock (Generic)++emptyAssembler :: Model -> UTCTime -> Assembler+emptyAssembler m s =+  Assembler+    { model = m,+      start = s,+      responseId = Nothing,+      closed = IntMap.empty,+      textBuf = IntMap.empty,+      thinkBuf = IntMap.empty,+      thinkSig = IntMap.empty,+      redactedBuf = IntMap.empty,+      toolArgsBuf = IntMap.empty,+      toolMeta = IntMap.empty,+      usage = Usage.zeroUsage,+      cacheDuration = Nothing,+      fastRequested = False,+      stopReason = Stop.Stop,+      stopDetails = Nothing,+      providerRequestId = Ev.Unobserved,+      observedModel = Ev.Unobserved,+      httpStatus = Nothing,+      usageReported = False+    }++translate ::+  Either BaikaiError Messages.MessageStreamEvent ->+  Assembler ->+  UTCTime ->+  ([AssistantMessageEvent], Assembler)+translate raw ass now = case raw of+  Left be ->+    let (closeEvents, ass') = closeOpenBlocks ass+        msg = finalMessageOnError ass' now (be ^. #message)+     in ( closeEvents+            <> [EventError (errorTerminal Nothing (ass' ^. #responseId) Stop.ErrorReason msg be)],+          ass'+        )+  Right ev -> translateEvent ev ass now++translateEvent ::+  Messages.MessageStreamEvent ->+  Assembler ->+  UTCTime ->+  ([AssistantMessageEvent], Assembler)+translateEvent raw ass now = case raw of+  Messages.Ping -> ([], ass)+  -- Updates the assembler and emits nothing: the stream's one+  -- 'EventStart' was pre-seeded before the first wire read, so that a+  -- failure arriving before this frame — a 401, a rate limit, an+  -- in-band error event, an EOF — still begins the stream the way the+  -- protocol says every stream begins.+  Messages.Message_Start {Messages.message = mr} ->+    let usage0 = anthroUsageToBaikai (mr ^. #usage)+        ass' =+          ass+            & #responseId .~ Just (mr ^. #id)+            -- The provider's value, never the caller's. The SDK's+            -- @model@ field is not optional, so a @message_start@ that+            -- arrives at all is a genuine observation; a stream that+            -- fails before one arrives leaves this 'Ev.Unobserved'.+            & #observedModel .~ Ev.Observed (mr ^. #model)+            & #usage .~ usage0+            & #usageReported .~ True+     in ([], ass')+  Messages.Content_Block_Start {Messages.index = idx, Messages.content_block = block} ->+    handleBlockStart (fromIntegral idx) block ass+  Messages.Content_Block_Delta {Messages.index = idx, Messages.delta = d} ->+    handleBlockDelta (fromIntegral idx) d ass+  Messages.Content_Block_Stop {Messages.index = idx} ->+    handleBlockStop (fromIntegral idx) ass+  Messages.Message_Delta {Messages.message_delta = md, Messages.usage = su} ->+    let stopR = mapStopReason (md ^. #stop_reason)+        u = ass ^. #usage+        -- @message_delta@ carries the call's final counts. Older models+        -- send only @output_tokens@; Claude 5 repeats the prompt-side+        -- classes too, which matters because a server-side tool run+        -- grows them after @message_start@. An absent field keeps what+        -- @message_start@ reported rather than zeroing it.+        --+        -- 'Messages.StreamUsage' has no 'GHC.Generics.Generic' instance,+        -- so these are record dots rather than the generic-lens labels+        -- used for 'Messages.Usage'.+        known category getter = case u ^. #availability of+          Just facts | category `Set.notMember` Usage.missingCategories facts -> Just (getter u)+          _ -> Nothing+        u' =+          Usage.observeBilling (maybe [] (Set.toList . Usage.billingFacts) (u ^. #availability) <> toolBilling su.stream_server_tool_use) $+            Normalize.normalizeUsage+              Normalize.ExclusiveInput+              ( Normalize.ReportedUsage+                  (su.stream_input_tokens <|> known Usage.InputUsage Usage.inputTokens)+                  (Just su.output_tokens)+                  (su.stream_cache_read_input_tokens <|> known Usage.CacheReadUsage Usage.cacheReadTokens)+                  (su.stream_cache_creation_input_tokens <|> known Usage.CacheWriteUsage Usage.cacheWriteTokens)+                  ((Messages.thinking_tokens <$> su.stream_output_tokens_details) <|> (u ^. #reasoningTokens))+              )+     in ([], ass & #stopReason .~ stopR & #stopDetails .~ (md ^. #stop_details) & #usage .~ u' & #usageReported .~ True)+  Messages.Message_Stop ->+    let reason = ass ^. #stopReason+        -- A refusal is a filter: the content, not the transport, is+        -- the problem, and a caller can branch on the category.+        details = ass ^. #stopDetails+        refusalCategory = details >>= (\d -> d.category)+        explanation = details >>= (\d -> d.explanation)+        refusal =+          contentFiltered+            ( "Anthropic refused to generate a response (stop_reason=refusal)"+                <> maybe "" (\c -> " [category=" <> c <> "]") refusalCategory+                <> maybe "" (": " <>) explanation+            )+            & #refusalCategory .~ refusalCategory+        msg =+          if reason == Stop.ErrorReason+            then finalMessageOnError ass now (refusal ^. #message)+            else finalMessage ass now+        terminalEvent =+          if reason == Stop.ErrorReason+            then EventError (errorTerminal Nothing (ass ^. #responseId) reason msg refusal)+            else EventDone (doneTerminal Nothing (ass ^. #responseId) reason msg)+     in ([terminalEvent], ass)+  Messages.Error {Messages.error = errVal} ->+    let (closeEvents, ass') = closeOpenBlocks ass+        errText = renderAnthropicError errVal+        mErr = classifyErrorValue errVal+        msg = finalMessageOnError ass' now errText+        errInfo = fromMaybe (providerError errText) mErr+     in ( closeEvents+            <> [EventError (errorTerminal Nothing (ass' ^. #responseId) Stop.ErrorReason msg errInfo)],+          ass'+        )++handleBlockStart ::+  Int ->+  Messages.ContentBlock ->+  Assembler ->+  ([AssistantMessageEvent], Assembler)+handleBlockStart i block ass = case block of+  Messages.ContentBlock_Text {} ->+    ( [TextStart IndexPayload {contentIndex = i}],+      ass & #textBuf %~ IntMap.insert i Text.empty+    )+  Messages.ContentBlock_Thinking {} ->+    ( [ThinkingStart IndexPayload {contentIndex = i}],+      ass & #thinkBuf %~ IntMap.insert i Text.empty+    )+  Messages.ContentBlock_Redacted_Thinking {Messages.data_ = payload} ->+    ( [ThinkingStart IndexPayload {contentIndex = i}],+      ass & #redactedBuf %~ IntMap.insert i payload+    )+  Messages.ContentBlock_Tool_Use {Messages.id = tid, Messages.name = tn} ->+    ( [ToolCallStart IndexPayload {contentIndex = i}],+      ass+        & #toolArgsBuf %~ IntMap.insert i Text.empty+        & #toolMeta %~ IntMap.insert i (tid, tn)+    )+  _ ->+    -- Server-tool, code-execution-tool, unknown — pass-through with no events.+    ([], ass)++handleBlockDelta ::+  Int ->+  Messages.ContentBlockDelta ->+  Assembler ->+  ([AssistantMessageEvent], Assembler)+handleBlockDelta i d ass = case d of+  Messages.Delta_Text_Delta {Messages.text = t} ->+    if IntMap.member i (ass ^. #textBuf)+      then+        ( [TextDelta DeltaPayload {contentIndex = i, delta = t}],+          ass & #textBuf %~ IntMap.adjust (<> t) i+        )+      else ([], ass)+  Messages.Delta_Thinking_Delta {Messages.thinking = t} ->+    if IntMap.member i (ass ^. #thinkBuf)+      then+        ( [ThinkingDelta DeltaPayload {contentIndex = i, delta = t}],+          ass & #thinkBuf %~ IntMap.adjust (<> t) i+        )+      else ([], ass)+  Messages.Delta_Signature_Delta {Messages.signature = sig} ->+    -- Signatures are tail-end metadata on thinking blocks; they+    -- attach to the ThinkingEnd event's content build, not a public+    -- delta event.+    if IntMap.member i (ass ^. #thinkBuf)+      then+        ( [],+          ass & #thinkSig %~ IntMap.insertWith (\new old -> old <> new) i sig+        )+      else ([], ass)+  Messages.Delta_Input_Json_Delta {Messages.partial_json = j} ->+    if IntMap.member i (ass ^. #toolArgsBuf)+      then+        ( [ToolCallDelta DeltaPayload {contentIndex = i, delta = j}],+          ass & #toolArgsBuf %~ IntMap.adjust (<> j) i+        )+      else ([], ass)++handleBlockStop ::+  Int -> Assembler -> ([AssistantMessageEvent], Assembler)+handleBlockStop i ass+  | Just body <- IntMap.lookup i (ass ^. #textBuf) =+      let block = Content.AssistantText (Content.TextContent body)+       in ( [TextEnd BlockEndPayload {contentIndex = i, content = body}],+            ass+              & #closed %~ IntMap.insert i block+              & #textBuf %~ IntMap.delete i+          )+  | Just payload <- IntMap.lookup i (ass ^. #redactedBuf) =+      let thinkingContent =+            Content.ThinkingContent+              { Content.thinking = payload,+                Content.signature = Nothing,+                Content.redacted = True,+                Content.replayState = Nothing+              }+          block = Content.AssistantThinking thinkingContent+       in ( [ThinkingEnd ThinkingEndPayload {contentIndex = i, content = thinkingContent}],+            ass+              & #closed %~ IntMap.insert i block+              & #redactedBuf %~ IntMap.delete i+          )+  | Just body <- IntMap.lookup i (ass ^. #thinkBuf) =+      let sig = IntMap.lookup i (ass ^. #thinkSig)+          thinkingContent =+            Content.ThinkingContent+              { Content.thinking = body,+                Content.signature = if maybe True Text.null sig then Nothing else sig,+                Content.redacted = False,+                Content.replayState = Nothing+              }+          block = Content.AssistantThinking thinkingContent+       in ( [ThinkingEnd ThinkingEndPayload {contentIndex = i, content = thinkingContent}],+            ass+              & #closed %~ IntMap.insert i block+              & #thinkBuf %~ IntMap.delete i+              & #thinkSig %~ IntMap.delete i+          )+  | Just argsText <- IntMap.lookup i (ass ^. #toolArgsBuf) =+      let (tid, tn) =+            -- A tool args buffer is opened together with metadata in+            -- handleBlockStart; the fallback is defensive only.+            fromMaybe ("", "") (IntMap.lookup i (ass ^. #toolMeta))+          -- One rule, shared with the OpenAI assembler and with core's+          -- stream recovery: empty text is an empty object (Anthropic+          -- opens a tool_use block with no input and streams no delta),+          -- and text that does not decode is kept verbatim as a String,+          -- marking the call cut off. This module used to answer @{}@+          -- to both, which handed a tool loop a well-formed call the+          -- model never finished asking for.+          decoded :: Value+          decoded = Content.toolArgumentsFromText argsText+          tc =+            Content.ToolCall+              { Content.id_ = tid,+                Content.name = tn,+                Content.arguments = decoded+              }+          block = Content.AssistantToolCall tc+       in ( [ToolCallEnd ToolCallEndPayload {contentIndex = i, toolCall = tc}],+            ass+              & #closed %~ IntMap.insert i block+              & #toolArgsBuf %~ IntMap.delete i+              & #toolMeta %~ IntMap.delete i+          )+  | otherwise = ([], ass)++-- | The 'EventStart' message skeleton (empty content; usage/etc.+-- carried for downstream consumers that want metadata up front).+skeletonMessage :: Assembler -> UTCTime -> Msg.Message+skeletonMessage ass _now =+  Msg.AssistantMessage+    Msg.AssistantPayload+      { Msg.content = Vector.empty,+        Msg.usage = ass ^. #usage,+        Msg.stopReason = Stop.Stop,+        Msg.errorMessage = Nothing,+        Msg.timestamp = Just (ass ^. #start)+      }++-- | The assembler's token accounting with this model's pricing applied.+-- Shared so the terminal message and the evidence record cannot report+-- two different figures for one call.+--+-- The duration comes from the shaped request body, so a compatibility+-- downgrade to a short cache cannot accidentally incur the long-write rate.+finalUsage :: Assembler -> Usage.Usage+finalUsage ass =+  let usageBare = if ass ^. #usageReported then ass ^. #usage else Normalize.normalizeUsage Normalize.ExclusiveInput (Normalize.ReportedUsage Nothing Nothing Nothing Nothing Nothing)+      calculated = Pricing.computeCostForService (ass ^. #cacheDuration) Nothing (ass ^. #model) usageBare+      reasons =+        [CacheDurationNotReported | usageBare ^. #cacheWriteTokens > 0, Nothing <- [ass ^. #cacheDuration]]+          <> [SpeedNotReported | ass ^. #fastRequested, not (any isSpeed (maybe [] (Set.toList . Usage.billingFacts) (usageBare ^. #availability)))]+      isSpeed (Usage.BillingSpeed _) = True+      isSpeed _ = False+   in usageBare & #cost .~ estimateCost reasons calculated++shapedFastRequested :: Aeson.Value -> Bool+shapedFastRequested (Aeson.Object body) = KeyMap.lookup "speed" body == Just (Aeson.String "fast")+shapedFastRequested _ = False++shapedCacheDuration :: Aeson.Value -> Maybe CacheRetention+shapedCacheDuration (Aeson.Object body) = case KeyMap.lookup "cache_control" body of+  Just (Aeson.Object marker) -> Just $ case KeyMap.lookup "ttl" marker of+    Just (Aeson.String "1h") -> CacheRetentionLong+    _ -> CacheRetentionShort+  _ -> Nothing+shapedCacheDuration _ = Nothing++finalMessage :: Assembler -> UTCTime -> Msg.Message+finalMessage ass now =+  Msg.AssistantMessage+    Msg.AssistantPayload+      { Msg.content = blocksInOrder ass,+        Msg.usage = finalUsage ass,+        Msg.stopReason = ass ^. #stopReason,+        Msg.errorMessage = Nothing,+        Msg.timestamp = Just now+      }++finalMessageOnError :: Assembler -> UTCTime -> Text -> Msg.Message+finalMessageOnError ass now reason =+  Msg.AssistantMessage+    Msg.AssistantPayload+      { Msg.content = blocksInOrder ass,+        Msg.usage = finalUsage ass,+        Msg.stopReason = Stop.ErrorReason,+        Msg.errorMessage = Just reason,+        Msg.timestamp = Just now+      }++blocksInOrder :: Assembler -> Vector Content.AssistantContent+blocksInOrder ass = Vector.fromList (IntMap.elems (ass ^. #closed))++-- | The immediate "request invalid" stream, emitted when 'mapRequest'+-- fails or 'prepareCall' is otherwise unable to build a valid SDK+-- request.+--+-- Nothing was sent, so there is no wire body to digest and the evidence+-- commits to 'Build.dispatchEnvelope' instead — see its documentation.+immediateError :: Model -> Options -> BaikaiError -> IO [AssistantMessageEvent]+immediateError m opts err = do+  now <- getCurrentTime+  let errText = err ^. #message+  let msg =+        Msg.AssistantMessage+          Msg.AssistantPayload+            { Msg.content = Vector.empty,+              Msg.usage = Usage.zeroUsage,+              Msg.stopReason = Stop.ErrorReason,+              Msg.errorMessage = Just errText,+              Msg.timestamp = Just now+            }+  ev <-+    Build.minimalEvidenceAt+      (resolvedBaseUrl m)+      m+      opts+      Ev.TransportHttpApi+      -- The adapter's own describer, not 'Ev.noThinkingRequested': the+      -- caller's level is a fact about the call even when the request+      -- was never built, and this function is the only description+      -- ADR 0003 permits anyone to use for this provider.+      (describeThinkingFor m opts)+      (Build.dispatchEnvelope m opts)+      now+      now+      Ev.CallFailed+      (Just err)+  pure+    [ EventStart StartPayload {partial = msg, responseId = Nothing},+      EventError (errorTerminal ev Nothing Stop.ErrorReason msg err)+    ]++trySync :: IO a -> IO (Either SomeException a)+trySync action = do+  r <- try action+  case r of+    Left e+      | Just (SomeAsyncException _) <- (fromException e :: Maybe SomeAsyncException) ->+          throwIO e+      | otherwise -> pure (Left e)+    Right a -> pure (Right a)++exceptionToError :: SomeException -> BaikaiError+exceptionToError e = fromMaybe (classifyException e) (fromException e)++renderAnthropicError :: Value -> Text+renderAnthropicError v = case v of+  Aeson.String t -> t+  _ -> Text.decodeUtf8 (BSL.toStrict (Aeson.encode v))++-- | Map the Anthropic streaming 'Message_Start.message.usage' value+-- into baikai's 'Usage' shape. Cache-related counters are populated+-- where present; cost is left at zero (the terminal event+-- recomputes it). A thinking-token breakdown, when Anthropic reports+-- one, becomes 'Usage.reasoningTokens' — an informational subset of the+-- output tokens rather than a billed class of its own, so it moves no+-- total.+--+-- @cache_creation_input_tokens@ is a total across cache writes. The final+-- calculation uses the duration selected by the actual shaped request body.+anthroUsageToBaikai :: Messages.Usage -> Usage.Usage+anthroUsageToBaikai u =+  Usage.observeBilling ([Usage.BillingServiceTier tier | Just tier <- [u ^. #service_tier]] <> [Usage.BillingSpeed speed | Just value <- [u ^. #speed], Aeson.String speed <- [Aeson.toJSON value]] <> toolBilling (u ^. #server_tool_use)) $+    Normalize.normalizeUsage+      Normalize.ExclusiveInput+      ( Normalize.ReportedUsage+          (Just (u ^. #input_tokens))+          (Just (u ^. #output_tokens))+          (u ^. #cache_read_input_tokens)+          (u ^. #cache_creation_input_tokens)+          (fmap (^. #thinking_tokens) (u ^. #output_tokens_details))+      )++-- Server-side tool products are outside the token-rate calculation.+toolBilling :: Maybe Messages.ServerToolUseUsage -> [Usage.BillingFact]+toolBilling Nothing = []+toolBilling (Just usage) = [Usage.BillingServerToolUse | fromMaybe 0 (usage ^. #web_search_requests) + fromMaybe 0 (usage ^. #tool_search_requests) > 0]++mapStopReason :: Maybe Messages.StopReason -> Stop.StopReason+mapStopReason = \case+  Just Messages.End_Turn -> Stop.Stop+  Just Messages.Max_Tokens -> Stop.Length+  Just Messages.Stop_Sequence -> Stop.Stop+  Just Messages.Tool_Use -> Stop.ToolUse+  -- The turn was suspended mid-flight (a long-running server-side tool)+  -- and Anthropic expects the caller to send the message back to+  -- continue it. Nothing failed, so this is a stop, not an error;+  -- baikai's 'Stop.StopReason' has no constructor that says "resume me".+  Just Messages.Pause_Turn -> Stop.Stop+  Just Messages.Refusal -> Stop.ErrorReason+  Just Messages.Model_Context_Window_Exceeded -> Stop.Length+  Nothing -> Stop.Stop
src/Baikai/Provider/Claude/Shape.hs view
@@ -1,6 +1,11 @@ {-# LANGUAGE LambdaCase #-} --- | Pure request-body shaping for Anthropic-compatible Messages hosts.+-- | __Exposed with no stability guarantees.__ This module is exposed so+-- the test suites can drive the transport without a socket, and so+-- sibling packages can reuse its pieces; it is not part of the public+-- API and may change in /any/ release without a PVP major bump.+--+-- Pure request-body shaping for Anthropic-compatible Messages hosts. module Baikai.Provider.Claude.Shape   ( shapeRequestBody,     streamRequestBody,
src/Baikai/Provider/Claude/Sse.hs view
@@ -1,7 +1,12 @@ {-# LANGUAGE LambdaCase #-} --- | Local SSE transport for Anthropic Messages streams.+-- | __Exposed with no stability guarantees.__ This module is exposed so+-- the test suites can drive the transport without a socket, and so+-- sibling packages can reuse its pieces; it is not part of the public+-- API and may change in /any/ release without a PVP major bump. --+-- Local SSE transport for Anthropic Messages streams.+-- -- The upstream @claude@ SDK exposes the right event decoder, but its -- non-2xx path collapses status, headers, and body into plain text. This -- wrapper keeps the SDK's request and SSE parsing shape while surfacing@@ -11,34 +16,90 @@     claudeSseStreamValue,     claudeSseStreamValueWithHeaders,     sseFromResponse,+    decodeFrame,+    buildRequest,+    ResponseMetadata (..),+    capturedHeaderNames,   ) where -import Baikai.Error (BaikaiError, decodeError, httpError, parseRetryAfterSeconds)+import Baikai.Error (BaikaiError, decodeError, httpError, parseHttpDate, retryAfterSecondsAt) import Claude.V1.Messages qualified as Messages import Control.Monad (foldM, when) import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as Aeson.Key import Data.ByteString qualified as SBS import Data.ByteString.Char8 qualified as S8+import Data.CaseInsensitive (CI) import Data.CaseInsensitive qualified as CI+import Data.Char (isSpace) import Data.IORef qualified as IORef+import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Text.Encoding.Error qualified as Text+import Data.Time.Clock (getCurrentTime)+import GHC.Generics (Generic) import Network.HTTP.Client qualified as HTTP import Network.HTTP.Types.Header (RequestHeaders) import Network.HTTP.Types.Status qualified as Status import Servant.Client qualified as Client +-- | Response-level metadata captured once, before the first event.+--+-- Header capture is an allow-list: a response header is recorded only+-- if its name appears in 'capturedHeaderNames'. A denylist would leak+-- whatever header a future gateway decides to add.+--+-- Names are recorded folded to lowercase, so a reader can look one up+-- without case-folding first.+data ResponseMetadata = ResponseMetadata+  { httpStatus :: !Int,+    headers :: ![(Text, Text)]+  }+  deriving stock (Eq, Show, Generic)++-- | The response headers worth recording. Anthropic issues+-- @request-id@; gateways in front of it commonly add @x-request-id@+-- and @cf-ray@. None of these can carry a credential: they are values+-- the server chose, not values baikai sent.+--+-- The order is a preference order as well as an allow-list. A consumer+-- picking one correlation identifier out of a response should take the+-- first of these that is present, so Anthropic's own identifier wins+-- over a gateway's when both are there.+capturedHeaderNames :: [CI SBS.ByteString]+capturedHeaderNames = ["request-id", "x-request-id", "cf-ray"]++-- | Status and allow-listed headers, read straight off the response.+responseMetadata :: HTTP.Response body -> ResponseMetadata+responseMetadata response =+  ResponseMetadata+    { httpStatus = Status.statusCode (HTTP.responseStatus response),+      headers =+        [ (decodeLenient (CI.foldedCase name), decodeLenient value)+        | (name, value) <- HTTP.responseHeaders response,+          name `elem` capturedHeaderNames+        ]+    }+ -- | POST the request to @/v1/messages@ with @stream=true@ and feed each--- decoded SSE event to the callback. A non-2xx response is classified--- from status, @Retry-After@, and body and delivered as one 'Left'.+-- decoded SSE event to the second callback. A non-2xx response is+-- classified from status, @Retry-After@, and body and delivered as one+-- 'Left'.+--+-- The first callback receives the response's 'ResponseMetadata' exactly+-- once, before any event. It is a separate callback rather than a+-- widening of the per-event one because the per-event callback runs+-- once per SSE event — potentially thousands of times per call — and+-- response-level data does not belong on that hot path. claudeSseStream ::   Client.ClientEnv ->   Text ->   Maybe Text ->   Messages.CreateMessage ->+  (ResponseMetadata -> IO ()) ->   (Either BaikaiError Messages.MessageStreamEvent -> IO ()) ->   IO () claudeSseStream env apiKey anthropicVersion req =@@ -49,6 +110,7 @@   Text ->   Maybe Text ->   Aeson.Value ->+  (ResponseMetadata -> IO ()) ->   (Either BaikaiError Messages.MessageStreamEvent -> IO ()) ->   IO () claudeSseStreamValue env apiKey anthropicVersion =@@ -68,41 +130,75 @@   Client.ClientEnv ->   RequestHeaders ->   Aeson.Value ->+  (ResponseMetadata -> IO ()) ->   (Either BaikaiError Messages.MessageStreamEvent -> IO ()) ->   IO ()-claudeSseStreamValueWithHeaders env requestHeaders requestBody onEvent = do-  let base = Client.baseUrl env-      secure = case Client.baseUrlScheme base of+claudeSseStreamValueWithHeaders env requestHeaders requestBody onMetadata onEvent = do+  HTTP.withResponse (buildRequest (Client.baseUrl env) requestHeaders requestBody) (Client.manager env) $ \response ->+    sseFromResponse response onMetadata onEvent++-- | The exact request this transport sends.+--+-- Pure and exported so that what goes on the wire — the method, the+-- composed path, and the redirect policy — is assertable without opening+-- a connection.+--+-- The path is the base URL's path plus @/v1/messages@. The base URL+-- reaching here has already been through+-- 'Baikai.Http.canonicalBaseUrl', which strips a trailing @\/v1@+-- segment, so a caller who writes the base URL the way every OpenAI SDK+-- teaches it — @https:\/\/api.deepseek.com\/v1@ — gets one @\/v1@ here+-- rather than two.+buildRequest :: Client.BaseUrl -> RequestHeaders -> Aeson.Value -> HTTP.Request+buildRequest base requestHeaders requestBody =+  HTTP.defaultRequest+    { HTTP.secure = case Client.baseUrlScheme base of         Client.Http -> False-        Client.Https -> True-      request =-        HTTP.defaultRequest-          { HTTP.secure = secure,-            HTTP.host = S8.pack (Client.baseUrlHost base),-            HTTP.port = Client.baseUrlPort base,-            HTTP.method = "POST",-            HTTP.path = S8.pack (normalizePath (Client.baseUrlPath base) <> "/v1/messages"),-            HTTP.requestHeaders = requestHeaders,-            HTTP.requestBody = HTTP.RequestBodyLBS (Aeson.encode requestBody),-            -- EP-8 wires Options.timeoutMs through this local transport.-            HTTP.responseTimeout = HTTP.responseTimeoutNone-          }-  HTTP.withResponse request (Client.manager env) (`sseFromResponse` onEvent)+        Client.Https -> True,+      HTTP.host = S8.pack (Client.baseUrlHost base),+      HTTP.port = Client.baseUrlPort base,+      HTTP.method = "POST",+      HTTP.path = S8.pack (normalizePath (Client.baseUrlPath base) <> "/v1/messages"),+      HTTP.requestHeaders = requestHeaders,+      HTTP.requestBody = HTTP.RequestBodyLBS (Aeson.encode requestBody),+      -- This POST has no legitimate redirect, and http-client's default+      -- is to follow up to ten of them with every header intact — which+      -- would re-send the credential to whatever host a Location names.+      -- At zero the 3xx comes back untouched and 'sseFromResponse'+      -- delivers it as the one in-band terminal error, carrying its+      -- status.+      HTTP.redirectCount = 0,+      -- No per-response bound here: Options.timeoutMs is enforced around+      -- the whole call by Transport.runWithTimeout.+      HTTP.responseTimeout = HTTP.responseTimeoutNone+    }  -- | Consume an @http-client@ response as an Anthropic SSE stream.+--+-- 'onMetadata' fires exactly once, before any event, 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, since it is+-- precisely what a provider support request needs. sseFromResponse ::   HTTP.Response HTTP.BodyReader ->+  (ResponseMetadata -> IO ()) ->   (Either BaikaiError Messages.MessageStreamEvent -> IO ()) ->   IO ()-sseFromResponse response onEvent = do+sseFromResponse response onMetadata onEvent = do   let st = HTTP.responseStatus response+  onMetadata (responseMetadata response)   if not (Status.statusIsSuccessful st)     then do       bodyChunks <- HTTP.brConsume (HTTP.responseBody response)+      now <- getCurrentTime       let bodyText = decodeLenient (SBS.concat bodyChunks)-          retryAfter =-            parseRetryAfterSeconds . decodeLenient-              =<< lookup (CI.mk "Retry-After") (HTTP.responseHeaders response)+          headerText name = decodeLenient <$> lookup (CI.mk name) (HTTP.responseHeaders response)+          -- The server's own Date is the reference instant for an+          -- HTTP-date Retry-After, which CDN-fronted hosts send on a+          -- 429; the local clock is the fallback. Using the response's+          -- clock keeps this machine's skew out of the hint.+          reference = fromMaybe now (parseHttpDate =<< headerText "Date")+          retryAfter = retryAfterSecondsAt reference =<< headerText "Retry-After"       onEvent (Left (httpError (Status.statusCode st) retryAfter bodyText))     else do       lineBufRef <- IORef.newIORef SBS.empty@@ -112,12 +208,14 @@             case es of               [] -> pure False               _ -> do-                let payload = S8.concat es-                case Aeson.eitherDecodeStrict payload of-                  Left err -> onEvent (Left (decodeError (Text.pack err))) >> pure False-                  Right val -> case Aeson.fromJSON val of-                    Aeson.Error err -> onEvent (Left (decodeError (Text.pack err))) >> pure False-                    Aeson.Success ev -> onEvent (Right ev) >> pure False+                let payload = S8.dropWhileEnd isSpace (S8.concat es)+                if SBS.null payload+                  then -- An empty @data:@ line is a heartbeat, not a frame.+                    pure False+                  else case decodeFrame payload of+                    Left e -> onEvent (Left e) >> pure False+                    Right Nothing -> pure False+                    Right (Just ev) -> onEvent (Right ev) >> pure False            handleLine line =             let l = stripCR line@@ -152,6 +250,62 @@                     stop <- foldM (\acc ln -> if acc then pure True else handleLine ln) False completeLines                     if stop then pure () else loop       loop++-- | Decode one SSE frame.+--+-- @Right Nothing@ is a frame this transport deliberately skips: an event+-- @type@, or a @content_block_delta@ whose @delta.type@, that the SDK+-- has no constructor for. The SDK decodes both with aeson's tagged-object+-- encoding and no unknown-tag fallback, so an unrecognised tag is a+-- decode /failure/ there — and a new frame type from Anthropic must not+-- end an otherwise healthy stream. A frame of a __known__ type that+-- still fails to decode is a genuine fault and stays a 'decodeError'.+--+-- Both tag lists are copied from the SDK's @constructorTagModifier@+-- tables in @Claude.V1.Messages@. A frame carrying no @type@ field at+-- all is not "unknown" — it is malformed, and fails as before.+decodeFrame :: SBS.ByteString -> Either BaikaiError (Maybe Messages.MessageStreamEvent)+decodeFrame payload = case Aeson.eitherDecodeStrict payload of+  Left err -> Left (decodeError (Text.pack err))+  Right val+    | frameIsUnknown val -> Right Nothing+    | otherwise -> case Aeson.fromJSON val of+        Aeson.Error err -> Left (decodeError (Text.pack err))+        Aeson.Success ev -> Right (Just ev)++-- | Whether this frame names a type the SDK has no constructor for.+frameIsUnknown :: Aeson.Value -> Bool+frameIsUnknown val = case val of+  Aeson.Object o -> case Aeson.Key.lookup "type" o of+    Just (Aeson.String "content_block_delta") ->+      case Aeson.Key.lookup "delta" o of+        Just (Aeson.Object d) -> case Aeson.Key.lookup "type" d of+          Just (Aeson.String dt) -> dt `notElem` knownDeltaTypes+          _ -> False+        _ -> False+    Just (Aeson.String t) -> t `notElem` knownEventTypes+    _ -> False+  _ -> False++knownEventTypes :: [Text]+knownEventTypes =+  [ "message_start",+    "content_block_start",+    "content_block_delta",+    "content_block_stop",+    "message_delta",+    "message_stop",+    "ping",+    "error"+  ]++knownDeltaTypes :: [Text]+knownDeltaTypes =+  [ "text_delta",+    "input_json_delta",+    "thinking_delta",+    "signature_delta"+  ]  normalizePath :: String -> String normalizePath = \case
src/Baikai/Provider/Claude/Transport.hs view
@@ -1,3 +1,10 @@+-- | __Exposed with no stability guarantees.__ This module is exposed so+-- the test suites can drive the transport without a socket, and so+-- sibling packages can reuse its pieces; it is not part of the public+-- API and may change in /any/ release without a PVP major bump.+--+-- Transport settings, header assembly and key resolution for the+-- Anthropic Messages API. module Baikai.Provider.Claude.Transport   ( getClientEnvCached,     cachedClientEnvCount,@@ -12,11 +19,14 @@ import Baikai.Compat (AnthropicMessagesCompat (..)) import Baikai.Content qualified as Content import Baikai.Context (Context (..))-import Baikai.Error (BaikaiError (..), ErrorCategory (..), authError)+import Baikai.Error (BaikaiError (..), ErrorCategory (..), authError, invalidRequest)+import Baikai.Header (HeaderName, renderHeaderName)+import Baikai.Http (cachedClientEnvCount, getClientEnvCached) import Baikai.Message qualified as Msg import Baikai.Model (Model (..)) import Baikai.Options (Options (..))-import Control.Concurrent.MVar (MVar, modifyMVar, newMVar)+import Baikai.Provider.Claude.Internal.Request (planSpeed)+import Claude.V1.Messages qualified as Messages import Control.Exception (throwIO) import Control.Lens ((^.)) import Crypto.Hash (Digest, SHA256)@@ -28,26 +38,9 @@ import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Vector qualified as Vector-import Network.HTTP.Client qualified as HTTP-import Network.HTTP.Client.TLS qualified as TLS import Network.HTTP.Types.Header (RequestHeaders)-import Servant.Client qualified as Client-import System.IO.Unsafe (unsafePerformIO) import System.Timeout qualified as Timeout -getClientEnvCached :: Text -> IO Client.ClientEnv-getClientEnvCached baseUrl =-  modifyMVar clientEnvCache $ \cache ->-    case Map.lookup baseUrl cache of-      Just env -> pure (cache, env)-      Nothing -> do-        env <- newClientEnv baseUrl-        pure (Map.insert baseUrl env cache, env)--cachedClientEnvCount :: IO Int-cachedClientEnvCount =-  modifyMVar clientEnvCache $ \cache -> pure (cache, Map.size cache)- requestHeaders ::   Text ->   Maybe Text ->@@ -64,12 +57,16 @@         id         (\v -> (("anthropic-version", Text.encodeUtf8 v) :))         anthropicVersion-        ( sessionHeaders+        ( speedHeaders+            <> sessionHeaders             <> [ ("x-api-key", Text.encodeUtf8 apiKey),                  ("Accept", "text/event-stream"),                  ("Content-Type", "application/json")                ]         )+    speedHeaders = case fst (planSpeed compat (opts ^. #speed)) of+      Just Messages.SpeedFast -> [("anthropic-beta", "fast-mode-2026-02-01")]+      _ -> []     sessionHeaders =       if sendSessionAffinityHeaders compat         then [("x-session-affinity", Text.encodeUtf8 (sessionAffinityValue ctx))]@@ -85,13 +82,30 @@         authError $           "no default API key env is known for " <> baseUrl <> "; set Options.apiKey explicitly" +-- | Run the transport action under 'Baikai.Options.timeoutMs'.+--+-- 'Nothing' is no bound. A non-positive bound is a caller error and is+-- refused as 'InvalidRequest' /without running the action/, so no+-- connection is opened: 'System.Timeout.timeout' returns immediately at+-- zero and runs unbounded below it, and both spellings used to fail as+-- a retryable 'TransientError' — a classification a retry loop will+-- re-issue forever for a configuration mistake. runWithTimeout :: Maybe Int -> IO () -> IO (Maybe BaikaiError) runWithTimeout Nothing action = action >> pure Nothing-runWithTimeout (Just ms) action = do-  result <- Timeout.timeout (max 0 ms * 1000) action-  pure $ case result of-    Just () -> Nothing-    Nothing -> Just (timeoutError ms)+runWithTimeout (Just ms) action+  | ms <= 0 =+      pure . Just . invalidRequest $+        "Options.timeoutMs must be positive, got "+          <> Text.pack (show ms)+          <> "; use Nothing for no bound"+  -- ms * 1000 would wrap negative, and a negative interval is silently+  -- "no bound". A bound this large is one in practice.+  | ms > maxBound `div` 1000 = action >> pure Nothing+  | otherwise = do+      result <- Timeout.timeout (ms * 1000) action+      pure $ case result of+        Just () -> Nothing+        Nothing -> Just (timeoutError ms)  sessionAffinityValue :: Context -> Text sessionAffinityValue ctx =@@ -134,31 +148,22 @@       message = "provider stream exceeded timeoutMs=" <> Text.pack (show ms),       httpStatus = Nothing,       retryAfterSeconds = Nothing,-      exitCode = Nothing+      exitCode = Nothing,+      refusalCategory = Nothing     } -newClientEnv :: Text -> IO Client.ClientEnv-newClientEnv baseUrl = do-  parsed <- Client.parseBaseUrl (Text.unpack baseUrl)-  manager <--    TLS.newTlsManagerWith-      TLS.tlsManagerSettings-        { HTTP.managerResponseTimeout = HTTP.responseTimeoutNone-        }-  pure (Client.mkClientEnv manager parsed)-+-- | Apply caller overrides over the provider's own headers.+--+-- The key type already carries the case-insensitivity rule, so the+-- overrides cannot contain two spellings of one name and the fold only+-- has to replace what the provider set. applyHeaderOverrides ::   RequestHeaders ->-  [(Text, Text)] ->+  [(HeaderName, Text)] ->   RequestHeaders applyHeaderOverrides =   foldl addHeader   where     addHeader headers (name, value) =-      let nameBytes = Text.encodeUtf8 name-          ciName = CI.mk nameBytes+      let ciName = CI.mk (Text.encodeUtf8 (renderHeaderName name))        in (ciName, Text.encodeUtf8 value) : filter ((/= ciName) . fst) headers--{-# NOINLINE clientEnvCache #-}-clientEnvCache :: MVar (Map.Map Text Client.ClientEnv)-clientEnvCache = unsafePerformIO (newMVar Map.empty)
+ test/CliEvidenceSpec.hs view
@@ -0,0 +1,397 @@+-- | End-to-end model-call evidence for the @claude -p@ subprocess+-- provider.+--+-- Every case here runs a real child process — a few lines of @sh@+-- written into a temporary directory that print recorded @claude@ JSON+-- and exit. Nothing is stubbed: the argument vector is rendered by+-- 'ClaudeCli.claudeCliCommand', the process is spawned by the real+-- provider, the output is decoded by the real parser, and the evidence+-- is assembled and emitted through the real trace path. No credential+-- and no coding-agent binary is required.+--+-- Assertions go through the encoded JSON rather than through Haskell+-- record accessors, because the JSON is the contract other systems pin+-- against, and it spells its fields in snake_case where a Haskell+-- mirror would silently paper over a rename.+module CliEvidenceSpec (tests) where++import Baikai+import Baikai.Provider.Claude.Cli qualified as ClaudeCli+import Baikai.Trace (withTraceStreamWith)+import Baikai.Trace.Event (TraceEvent (..))+import Baikai.Trace.Sink (TraceSink (..))+import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVarIO)+import Control.Lens ((&), (.~), (^.))+import Data.Aeson (Value (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KeyMap+import Data.Generics.Labels ()+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.IO qualified as TextIO+import Data.Vector qualified as Vector+import GHC.Generics (Generic)+import Streamly.Data.Fold qualified as Fold+import Streamly.Data.Stream qualified as Stream+import System.Directory (getPermissions, setOwnerExecutable, setPermissions)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    -- Named so a documented @--test-options='--pattern CliEvidence'@+    -- actually selects it. A pattern that matches nothing reports+    -- "All 0 tests passed".+    "CliEvidenceSpec: Claude CLI model-call evidence"+    [ successEvidenceTest,+      silentToolTest,+      minimalCollapseTest,+      indistinguishableCallsTest,+      failedRunTest,+      optOutTest+    ]++-- ============================================================+-- The cases+-- ============================================================++successEvidenceTest :: TestTree+successEvidenceTest =+  testCase "a recorded run records what the tool reported" $ do+    outcome <- replay recordedResult baseOptions+    ev <- oneEvidence (outcome ^. #events)+    field "status" ev @?= Just (String "succeeded")+    field "run_id" ev @?= Just (String "run-55")+    field "requested_model" ev @?= Just (String "sonnet")++    -- The session identifier the provider used to decode and then throw+    -- away, one line before hardcoding responseId = Nothing.+    field "response_id" ev @?= Just (observedJson "01890000-0000-4000-8000-000000000001")++    -- The model the tool named as having consumed tokens, complete with+    -- its context-window variant marker, and demonstrably not the+    -- model the caller configured.+    field "observed_model" ev @?= Just (observedJson "claude-opus-5[1m]")+    assertBool+      "observed_model must not be the configured model"+      (field "observed_model" ev /= Just (observedJson "sonnet"))++    -- A subprocess cannot carry an HTTP correlation header, and the+    -- tool does not echo its effort setting. Neither is invented.+    field "provider_request_id" ev @?= Just (String "unobserved")+    field "observed_thinking" ev @?= Just (String "unobserved")++    -- Tied to the declaration mechanically: raising declaredStrength+    -- for this transport without the transport reaching it fails here.+    field "strength" ev @?= Just (Aeson.toJSON (declaredStrength AnthropicMessagesCli))+    assertDigest "request_commitment" ev+    assertDigest "request_configuration" ev+    assertObservedDigest "response_commitment" ev++    -- Not zeroUsage: the tool's own counts, with Anthropic's already+    -- disjoint prompt classes carried through unmodified.+    case observedObject "usage" ev of+      Nothing -> assertFailure ("expected an observed usage, got: " <> show (field "usage" ev))+      Just u -> do+        KeyMap.lookup "input_tokens" u @?= Just (Number 2)+        KeyMap.lookup "output_tokens" u @?= Just (Number 6)+        KeyMap.lookup "cache_read_input_tokens" u @?= Nothing+        KeyMap.lookup "cache_read_tokens" u @?= Just (Number 15185)+        KeyMap.lookup "cache_write_tokens" u @?= Just (Number 7455)++    -- A subprocess has no endpoint URL, so the resolved executable+    -- path stands in its place, and the tool's own version is the+    -- implementation version because for this transport the tool is+    -- the implementation.+    case field "endpoint" ev of+      Just (Object o) -> do+        KeyMap.lookup "transport" o @?= Just (String "subprocess")+        KeyMap.lookup "endpoint" o @?= Just (String (Text.pack (outcome ^. #executable)))+        KeyMap.lookup "implementation_version" o @?= Just (String "fake-claude 9.9.9")+      other -> assertFailure ("expected an endpoint object, got: " <> show other)++silentToolTest :: TestTree+silentToolTest =+  testCase "A ZERO EXIT WITH NO IDENTIFIER AND NO MODEL STAYS AT requested_only" $ do+    -- IR-3's rule and the reason this plan exists. A coding-agent CLI+    -- that exits zero has demonstrated that it ran and did not crash.+    -- Subprocess calls almost always exit zero, so encoding that as+    -- corroboration would make the weakest evidence in the system look+    -- like the strongest.+    outcome <- replay silentResult baseOptions+    ev <- oneEvidence (outcome ^. #events)+    field "status" ev @?= Just (String "succeeded")+    field "strength" ev @?= Just (String "requested_only")+    field "response_id" ev @?= Just (String "unobserved")+    field "observed_model" ev @?= Just (String "unobserved")+    field "usage" ev @?= Just (String "unobserved")++minimalCollapseTest :: TestTree+minimalCollapseTest =+  testCase "a minimal request records the --effort low collapse it actually sent" $ do+    -- The description and the argument vector are asserted together so+    -- they cannot drift apart.+    outcome <- replay recordedResult (baseOptions & #thinking .~ Just ThinkingMinimal)+    assertBool+      ("the argument vector must carry --effort low: " <> show (outcome ^. #argv))+      (["--effort", "low"] `isSublistOf` (outcome ^. #argv))+    ev <- oneEvidence (outcome ^. #events)+    case field "thinking" ev of+      Just (Object t) -> do+        KeyMap.lookup "requested" t @?= Just (String "minimal")+        KeyMap.lookup "mode" t @?= Just (String "flag")+        KeyMap.lookup "effort_text" t @?= Just (String "low")+        KeyMap.lookup "wire_field" t @?= Just (String "--effort")+        KeyMap.lookup "budget_tokens" t @?= Just Null+        KeyMap.lookup "adjustments" t+          @?= Just+            ( Array+                ( Vector.singleton+                    ( Object+                        ( KeyMap.fromList+                            [ ("kind", String "effort_clamped"),+                              ("requested", String "minimal"),+                              ("wire", String "low")+                            ]+                        )+                    )+                )+            )+      other -> assertFailure ("expected a thinking translation, got: " <> show other)++indistinguishableCallsTest :: TestTree+indistinguishableCallsTest =+  testCase "TWO CALLS THE TOOL CANNOT TELL APART PRODUCE EVIDENCE THAT CAN" $ do+    -- This is the case that demonstrates why the record exists rather+    -- than merely that a field is populated. A caller asking for+    -- minimal and a caller asking for low send byte-identical command+    -- lines, so nothing downstream of the argument vector could ever+    -- recover the difference — including the request commitment digest,+    -- which is computed over that vector. The translation is the only+    -- place the collapse survives.+    withFakeClaude recordedResult $ \runOnce -> do+      lowRun <- runOnce (baseOptions & #thinking .~ Just ThinkingLow)+      minimalRun <- runOnce (baseOptions & #thinking .~ Just ThinkingMinimal)+      minimalRun ^. #argv @?= lowRun ^. #argv++      lowEv <- oneEvidence (lowRun ^. #events)+      minimalEv <- oneEvidence (minimalRun ^. #events)+      field "request_commitment" minimalEv @?= field "request_commitment" lowEv++      requestedLevel lowEv @?= Just (String "low")+      requestedLevel minimalEv @?= Just (String "minimal")+      adjustmentCount lowEv @?= Just 0+      adjustmentCount minimalEv @?= Just 1++failedRunTest :: TestTree+failedRunTest =+  testCase "a tool that exits nonzero records the failure and commits to no response" $ do+    outcome <- replay Nothing baseOptions+    ev <- oneEvidence (outcome ^. #events)+    field "status" ev @?= Just (String "failed")+    case field "error_info" ev of+      Just (Object o) ->+        assertBool+          ("expected a populated error_info, got: " <> show o)+          (KeyMap.member "message" o)+      other -> assertFailure ("expected a populated error_info, got: " <> show other)+    -- No parseable result means nothing to commit to. A digest of an+    -- empty envelope would be a real-looking value standing for a+    -- response that never arrived.+    field "response_commitment" ev @?= Just (String "unobserved")+    field "usage" ev @?= Just (String "unobserved")+    field "strength" ev @?= Just (String "requested_only")++optOutTest :: TestTree+optOutTest =+  testCase "a call that asked for no evidence emits none" $ do+    outcome <- replay recordedResult emptyOptions+    [e | e@CallEvidence {} <- outcome ^. #events] @?= []+    length [e | e@CallStarted {} <- outcome ^. #events] @?= 1+    length [e | e@CallFinished {} <- outcome ^. #events] @?= 1++-- ============================================================+-- Replay harness+-- ============================================================++-- | What one replayed call produced.+data Replay = Replay+  { events :: ![TraceEvent],+    -- | The argument vector the fake executable actually received.+    argv :: ![Text],+    -- | The path the fake executable was written to.+    executable :: !FilePath+  }+  deriving stock (Generic)++-- | Run one call against a fake @claude@ that prints the given JSON on+-- standard output.+--+-- 'Nothing' makes the fake exit nonzero with a message on standard+-- error, which is how a failed run is replayed.+replay :: Maybe Text -> Options -> IO Replay+replay stdoutJson opts = withFakeClaude stdoutJson ($ opts)++-- | Write one fake @claude@ and hand back a function that runs calls+-- against it.+--+-- Two calls compared against each other must go through the __same__+-- fake, because the argument vector the request commitment digests+-- begins with the executable's path — so two fakes in two temporary+-- directories would differ for a reason that has nothing to do with+-- what the test is about.+withFakeClaude :: Maybe Text -> ((Options -> IO Replay) -> IO a) -> IO a+withFakeClaude stdoutJson k =+  withSystemTempDirectory "baikai-claude-cli-evidence" $ \dir -> do+    let argvPath = dir </> "argv"+    exe <- writeFakeExecutable dir "claude" (fakeClaude argvPath stdoutJson)+    k $ \opts -> do+      reg <- newProviderRegistry+      registerApiProviderWith+        reg+        ( ClaudeCli.claudeCliProvider+            ClaudeCli.defaultClaudeCliConfig {ClaudeCli.executable = exe}+        )+      (ref, sink) <- memorySink+      _ <- Stream.fold Fold.drain (withTraceStreamWith reg sink testModel testContext opts)+      recorded <- reverse <$> readTVarIO ref+      received <- Text.lines <$> TextIO.readFile argvPath+      pure Replay {events = recorded, argv = received, executable = exe}++-- | A fake @claude@ in a few lines of @sh@.+--+-- It answers @--version@ before recording anything, exactly as the real+-- tool does. That is not decoration: the evidence path probes the+-- executable's version with a second invocation, and a fake that+-- recorded that invocation's argument vector would overwrite the one+-- the test is about to assert on.+fakeClaude :: FilePath -> Maybe Text -> String+fakeClaude argvPath stdoutJson =+  unlines+    ( [ "#!/bin/sh",+        "if [ \"$1\" = \"--version\" ]; then echo 'fake-claude 9.9.9'; exit 0; fi",+        "printf '%s\\n' \"$@\" > '" <> argvPath <> "'"+      ]+        <> case stdoutJson of+          Nothing -> ["echo 'the tool refused' >&2", "exit 3"]+          Just body -> ["cat <<'BAIKAI_FIXTURE'", Text.unpack body, "BAIKAI_FIXTURE"]+    )++writeFakeExecutable :: FilePath -> String -> String -> IO FilePath+writeFakeExecutable dir name body = do+  let path = dir </> name+  writeFile path body+  perms <- getPermissions path+  setPermissions path (setOwnerExecutable True perms)+  pure path++memorySink :: IO (TVar [TraceEvent], TraceSink)+memorySink = do+  ref <- newTVarIO []+  let step () e = atomically (modifyTVar' ref (e :))+  pure (ref, TraceSink (Fold.foldlM' step (pure ())))++-- ============================================================+-- Fixtures+-- ============================================================++testModel :: Model+testModel =+  emptyModel+    & #modelId .~ "sonnet"+    & #api .~ AnthropicMessagesCli+    & #provider .~ "anthropic"++testContext :: Context+testContext = emptyContext & #messages .~ Vector.singleton (user "PROMPT-BODY-MARKER")++baseOptions :: Options+baseOptions = emptyOptions & #evidence .~ Just (evidenceRequest "run-55")++-- | The event array @claude 2.1.222@ emits, trimmed to the fields the+-- provider reads and with the identifiers scrubbed.+recordedResult :: Maybe Text+recordedResult =+  Just+    "[{\"type\":\"system\",\"subtype\":\"init\",\+    \\"session_id\":\"01890000-0000-4000-8000-000000000001\"},\+    \{\"type\":\"result\",\"subtype\":\"success\",\"is_error\":false,\"result\":\"ok\",\+    \\"session_id\":\"01890000-0000-4000-8000-000000000001\",\+    \\"total_cost_usd\":0.0823025,\+    \\"usage\":{\"input_tokens\":2,\"output_tokens\":6,\+    \\"cache_read_input_tokens\":15185,\"cache_creation_input_tokens\":7455},\+    \\"modelUsage\":{\"claude-opus-5[1m]\":{\"inputTokens\":2,\"outputTokens\":6}}}]"++-- | A run that succeeded and said nothing about itself.+silentResult :: Maybe Text+silentResult = Just "[{\"type\":\"result\",\"is_error\":false,\"result\":\"ok\"}]"++-- ============================================================+-- Assertions on the encoded record+-- ============================================================++oneEvidence :: [TraceEvent] -> IO ModelCallEvidence+oneEvidence recorded = case [ev | CallEvidence {evidence = ev} <- recorded] of+  [ev] -> pure ev+  other ->+    assertFailure+      ("expected exactly one CallEvidence, got " <> show (length other) <> ": " <> show recorded)++field :: Text -> ModelCallEvidence -> Maybe Value+field k ev = case Aeson.toJSON ev of+  Object o -> KeyMap.lookup (Key.fromText k) o+  _ -> Nothing++-- | How 'Baikai.Evidence.Observed' encodes a present value.+observedJson :: Text -> Value+observedJson v = Object (KeyMap.singleton "observed" (String v))++observedObject :: Text -> ModelCallEvidence -> Maybe (KeyMap.KeyMap Value)+observedObject k ev = case field k ev of+  Just (Object o) -> case KeyMap.lookup "observed" o of+    Just (Object inner) -> Just inner+    _ -> Nothing+  _ -> Nothing++requestedLevel :: ModelCallEvidence -> Maybe Value+requestedLevel ev = case field "thinking" ev of+  Just (Object t) -> KeyMap.lookup "requested" t+  _ -> Nothing++adjustmentCount :: ModelCallEvidence -> Maybe Int+adjustmentCount ev = case field "thinking" ev of+  Just (Object t) -> case KeyMap.lookup "adjustments" t of+    Just (Array a) -> Just (Vector.length a)+    _ -> Nothing+  _ -> Nothing++assertDigest :: Text -> ModelCallEvidence -> IO ()+assertDigest k ev = case field k ev of+  Just (String d) -> assertSha256 k d+  other -> assertFailure (Text.unpack k <> " missing or not a string: " <> show other)++assertObservedDigest :: Text -> ModelCallEvidence -> IO ()+assertObservedDigest k ev = case field k ev of+  Just (Object o) -> case KeyMap.lookup "observed" o of+    Just (String d) -> assertSha256 k d+    other -> assertFailure (Text.unpack k <> " not a digest: " <> show other)+  other -> assertFailure ("expected an observed " <> Text.unpack k <> ", got: " <> show other)++assertSha256 :: Text -> Text -> IO ()+assertSha256 k d =+  assertBool+    (Text.unpack k <> " must be a sha256 digest, got: " <> show d)+    ("sha256:" `Text.isPrefixOf` d && Text.length d == 71)++isSublistOf :: (Eq a) => [a] -> [a] -> Bool+isSublistOf needle haystack =+  any (\suffix -> needle == take (length needle) suffix) (suffixes haystack)+  where+    suffixes xs =+      xs : case xs of+        [] -> []+        (_ : rest) -> suffixes rest
+ test/Contract.hs view
@@ -0,0 +1,45 @@+-- | The stream protocol, as an assertion.+--+-- Lives in its own module rather than in @Main@ because three suites+-- need it — the end-to-end cases in @Main@, the failure-stream cases in+-- @SseSpec@, and the evidence cases in @EvidenceSpec@ — and a protocol+-- asserted three slightly different ways is not asserted at all.+module Contract (assertErrorContract, assertOneErrorTerminal) where++import Baikai.Stream.Event+  ( AssistantMessageEvent (..),+    StartPayload (..),+    TerminalPayload (..),+    isTerminal,+  )+import Test.Tasty.HUnit (Assertion, assertFailure, (@?=))++-- | The whole documented protocol for a failing stream: exactly one+-- 'EventStart', first; exactly one terminal; and that terminal an+-- 'EventError' carrying structured 'errorInfo'.+--+-- Use this on anything that drains a provider stream. A fragment folded+-- straight through @translate@ never carried a start event, so it gets+-- 'assertOneErrorTerminal' instead.+assertErrorContract :: [AssistantMessageEvent] -> Assertion+assertErrorContract events = do+  case events of+    EventStart StartPayload {} : _ -> pure ()+    other -> assertFailure ("stream must begin with EventStart, got: " <> show (take 1 other))+  length [() | EventStart {} <- events] @?= 1+  assertOneErrorTerminal events+  case reverse events of+    (EventError TerminalPayload {} : _) -> pure ()+    other -> assertFailure ("stream must end with EventError, got: " <> show (take 1 other))++-- | The terminal half of 'assertErrorContract', for translator-level+-- fragments that never carried a start event.+assertOneErrorTerminal :: [AssistantMessageEvent] -> Assertion+assertOneErrorTerminal events = do+  let terminals = filter isTerminal events+  length terminals @?= 1+  case terminals of+    [EventError TerminalPayload {errorInfo = Nothing}] ->+      assertFailure "terminal EventError omitted errorInfo"+    [EventError TerminalPayload {errorInfo = Just _}] -> pure ()+    other -> assertFailure ("expected exactly one terminal EventError, got: " <> show other)
test/ErrorClassSpec.hs view
@@ -2,22 +2,15 @@  import Baikai.Error (BaikaiError (..), ErrorCategory (..), isRetryable) import Baikai.Provider.Claude.Internal.ErrorClass-  ( classifyErrorText,-    classifyErrorValue,+  ( classifyErrorValue,     classifyException,-    responseToError,   ) import Control.Exception (toException) import Data.Aeson (Value, object, (.=))-import Data.ByteString (ByteString)-import Data.ByteString.Lazy qualified as LBS-import Data.CaseInsensitive qualified as CI-import Data.Sequence qualified as Seq import Data.Text qualified as Text+import Foreign.C.Error (Errno (..), eCONNRESET)+import GHC.IO.Exception qualified as IOE import Network.HTTP.Client qualified as HTTP-import Network.HTTP.Types.Status (mkStatus)-import Network.HTTP.Types.Version (http11)-import Servant.Client (ResponseF (..)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, testCase, (@?=)) @@ -25,50 +18,10 @@ tests =   testGroup     "Baikai.Provider.Claude.Internal.ErrorClass"-    [ httpStatusTests,-      sdkTextTests,-      streamedErrorTests,+    [ streamedErrorTests,       fallbackTests     ] --- | Build a synthetic servant 'ResponseF' for the HTTP-status mapper.-mkResp :: Int -> [(ByteString, ByteString)] -> LBS.ByteString -> ResponseF LBS.ByteString-mkResp status hdrs body =-  Response-    { responseStatusCode = mkStatus status "",-      responseHeaders = Seq.fromList [(CI.mk n, v) | (n, v) <- hdrs],-      responseHttpVersion = http11,-      responseBody = body-    }--httpStatusTests :: TestTree-httpStatusTests =-  testGroup-    "responseToError (HTTP status)"-    [ testCase "429 + Retry-After -> RateLimited with hint" $ do-        let e = responseToError (mkResp 429 [("Retry-After", "30")] "slow down")-        category e @?= RateLimited-        httpStatus e @?= Just 429-        retryAfterSeconds e @?= Just 30,-      testCase "429 without Retry-After -> RateLimited, no hint" $ do-        let e = responseToError (mkResp 429 [] "slow down")-        category e @?= RateLimited-        retryAfterSeconds e @?= Nothing,-      testCase "401 -> AuthError" $-        category (responseToError (mkResp 401 [] "bad key")) @?= AuthError,-      testCase "400 with overflow body -> ContextOverflow" $-        category (responseToError (mkResp 400 [] "prompt is too long: 9000 tokens"))-          @?= ContextOverflow,-      testCase "400 with ordinary body -> InvalidRequest" $-        category (responseToError (mkResp 400 [] "missing field model"))-          @?= InvalidRequest,-      testCase "503 -> TransientError" $-        category (responseToError (mkResp 503 [] "")) @?= TransientError,-      testCase "non-integer Retry-After is ignored" $-        retryAfterSeconds (responseToError (mkResp 429 [("Retry-After", "Wed, 21 Oct 2026 07:28:00 GMT")] ""))-          @?= Nothing-    ]- streamedErrorTests :: TestTree streamedErrorTests =   testGroup@@ -114,28 +67,27 @@                     HTTP.ResponseTimeout         category e @?= TransientError         assertBool "response timeout is retryable" (isRetryable e),-      testCase "non-ClientError exception -> OtherError, text preserved" $ do+      -- The delegation itself, through the provider's entry point: a+      -- reset raised from the body read reaches the worker as a raw+      -- IOException, which no HttpException branch would have matched.+      testCase "a body-read reset is transient through classifyException" $ do+        let e =+              classifyException . toException $+                IOE.IOError+                  { IOE.ioe_handle = Nothing,+                    IOE.ioe_type = IOE.ResourceVanished,+                    IOE.ioe_location = "Network.Socket.recvBuf",+                    IOE.ioe_description = "Connection reset by peer",+                    IOE.ioe_errno = Just (case eCONNRESET of Errno n -> n),+                    IOE.ioe_filename = Nothing+                  }+        category e @?= TransientError+        assertBool "a mid-stream reset is retryable" (isRetryable e),+      testCase "non-transport exception -> OtherError, text preserved" $ do         let e = classifyException (toException (userError "weird failure"))         category e @?= OtherError         assertBool "message keeps the original text" $           "weird failure" `Text.isInfixOf` message e-    ]--sdkTextTests :: TestTree-sdkTextTests =-  testGroup-    "classifyErrorText (SDK HTTP text)"-    [ testCase "429 text -> RateLimited" $ do-        let parsed =-              classifyErrorText-                "HTTP error 429 Too Many Requests: {\"type\":\"error\",\"error\":{\"type\":\"rate_limit_error\",\"message\":\"slow\"}}"-        fmap category parsed @?= Just RateLimited-        fmap httpStatus parsed @?= Just (Just 429),-      testCase "529 text -> TransientError" $-        fmap category (classifyErrorText "HTTP error 529 ")-          @?= Just TransientError,-      testCase "non-matching text -> Nothing" $-        classifyErrorText "ordinary stream error" @?= Nothing     ]  -- | The inner error object Anthropic streams as the @error@ field.
+ test/EvidenceSpec.hs view
@@ -0,0 +1,475 @@+-- | End-to-end model-call evidence for the Anthropic Messages provider.+--+-- Every case here replays a recorded HTTP response through the real+-- adapter and reads the evidence back out of a trace sink. Nothing is+-- stubbed but the socket: the request is built by @mapRequest@, the+-- response is decoded by @sseFromResponse@, the headers are captured by+-- the real allow-list, and the record is assembled and emitted by the+-- real trace path.+--+-- Assertions go through the encoded JSON rather than through Haskell+-- record accessors, because the JSON is the contract other systems pin+-- against, and it spells its fields in snake_case where a Haskell+-- mirror would silently paper over a rename.+module EvidenceSpec (tests) where++import Baikai+import Baikai.Models.Generated (anthropic_claude_haiku_4_5)+import Baikai.Provider.Claude.Internal.Request (describeThinkingFor)+import Baikai.Provider.Claude.Internal.Stream (SseDriver, claudeMessagesStreamWith)+import Baikai.Provider.Claude.Sse (sseFromResponse)+import Baikai.Trace (withTraceStreamWith)+import Baikai.Trace.Event (TraceEvent (..))+import Baikai.Trace.Sink (TraceSink (..))+import Contract (assertErrorContract)+import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVarIO)+import Control.Lens ((&), (.~), (^.))+import Data.Aeson (Value (..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KeyMap+import Data.ByteString (ByteString)+import Data.CaseInsensitive qualified as CI+import Data.Generics.Labels ()+import Data.IORef (newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Vector qualified as Vector+import Network.HTTP.Client.Internal qualified as HTTP+import Network.HTTP.Types.Status (mkStatus)+import Network.HTTP.Types.Version (http11)+import Streamly.Data.Fold qualified as Fold+import Streamly.Data.Stream qualified as Stream+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    -- Named so this plan's documented+    -- @--test-options='--pattern Evidence'@ actually selects it. A+    -- pattern that matches nothing reports "All 0 tests passed".+    "EvidenceSpec: Anthropic model-call evidence"+    [ successEvidenceTest,+      rateLimitEvidenceTest,+      thinkingEvidenceTest,+      samplingEvidenceTest,+      cacheUsageEvidenceTest,+      immediateErrorRecordsThinkingTest,+      defaultHostEndpointTest,+      responseIdCountsAsCorrelationTest,+      optOutTest+    ]++-- ============================================================+-- The cases+-- ============================================================++successEvidenceTest :: TestTree+successEvidenceTest =+  testCase "a replayed successful call records what Anthropic reported" $ do+    ev <- oneEvidence =<< replay 200 successHeaders successBody baseOptions+    field "status" ev @?= Just (String "succeeded")+    field "error_info" ev @?= Just Null+    field "run_id" ev @?= Just (String "run-53")++    -- The heart of it: requested and observed are different values, and+    -- the observed one came from the provider's own message_start.+    field "requested_model" ev @?= Just (String (anthropic_claude_haiku_4_5 ^. #modelId))+    field "observed_model" ev @?= Just (observedJson "claude-haiku-4-5-20990101-server-side")+    assertBool+      "observed_model must not be the configured model"+      (field "observed_model" ev /= Just (observedJson (anthropic_claude_haiku_4_5 ^. #modelId)))++    field "provider_request_id" ev @?= Just (observedJson "req_success_1")+    field "response_id" ev @?= Just (observedJson "msg_observed")+    -- Tied to the declaration mechanically: raising declaredStrength+    -- for this transport without the transport reaching it fails here.+    field "strength" ev @?= Just (Aeson.toJSON (declaredStrength AnthropicMessages))++    -- Anthropic never echoes the thinking configuration it applied, so+    -- this transport cannot reach fully_observed and must not pretend+    -- a reasoning-token count is such an echo.+    field "observed_thinking" ev @?= Just (String "unobserved")++    assertDigest "request_commitment" ev+    assertDigest "request_configuration" ev+    case field "response_commitment" ev of+      Just (Object o) -> case KeyMap.lookup "observed" o of+        Just (String d) -> assertSha256 "response_commitment" d+        other -> assertFailure ("response_commitment not a digest: " <> show other)+      other -> assertFailure ("expected an observed response_commitment, got: " <> show other)++    -- Usage is Observed because Anthropic reported it, and carries the+    -- fixture's counts rather than the assembler's initial zeroes.+    case field "usage" ev of+      Just (Object o) -> case KeyMap.lookup "observed" o of+        Just (Object u) -> do+          KeyMap.lookup "input_tokens" u @?= Just (Number 11)+          KeyMap.lookup "output_tokens" u @?= Just (Number 5)+        other -> assertFailure ("usage.observed not an object: " <> show other)+      other -> assertFailure ("expected an observed usage, got: " <> show other)++    -- The endpoint names this package's own version, read from the+    -- cabal-generated module.+    case field "endpoint" ev of+      Just (Object o) -> do+        KeyMap.lookup "transport" o @?= Just (String "http_api")+        case KeyMap.lookup "implementation_version" o of+          Just (String v) ->+            assertBool "implementation_version must not be empty" (not (Text.null v))+          other -> assertFailure ("expected an implementation_version, got: " <> show other)+      other -> assertFailure ("expected an endpoint object, got: " <> show other)++rateLimitEvidenceTest :: TestTree+rateLimitEvidenceTest =+  testCase "a replayed 429 records the correlation id and observes nothing else" $ do+    ev <-+      oneEvidence+        =<< replay+          429+          [("request-id", "req_rate_limited"), ("Retry-After", "7")]+          ["{\"type\":\"error\",\"error\":{\"type\":\"rate_limit_error\",\"message\":\"slow\"}}"]+          baseOptions+    field "status" ev @?= Just (String "failed")+    case field "error_info" ev of+      Just (Object o) ->+        assertBool+          ("expected the rate-limit message, got: " <> show o)+          (KeyMap.lookup "message" o /= Nothing)+      other -> assertFailure ("expected a populated error_info, got: " <> show other)++    -- The header is present on errors too, and it is the single most+    -- useful thing to have when opening a provider support request.+    field "provider_request_id" ev @?= Just (observedJson "req_rate_limited")++    -- Absent metadata stays absent. None of these is backfilled.+    field "observed_model" ev @?= Just (String "unobserved")+    field "response_id" ev @?= Just (String "unobserved")+    field "response_commitment" ev @?= Just (String "unobserved")+    field "usage" ev @?= Just (String "unobserved")+    field "strength" ev @?= Just (String "correlated")++    -- The same replay as a stream: an HTTP failure that arrives before+    -- @message_start@ still begins with 'EventStart'.+    assertErrorContract+      =<< replayStreamEvents+        429+        [("request-id", "req_rate_limited"), ("Retry-After", "7")]+        ["{\"type\":\"error\",\"error\":{\"type\":\"rate_limit_error\",\"message\":\"slow\"}}"]+        baseOptions++thinkingEvidenceTest :: TestTree+thinkingEvidenceTest =+  testCase "the evidence carries the thinking translation the request actually used" $ do+    ev <-+      oneEvidence+        =<< replay+          200+          successHeaders+          successBody+          (baseOptions & #thinking .~ Just ThinkingMinimal)+    case field "thinking" ev of+      Just (Object t) -> do+        KeyMap.lookup "requested" t @?= Just (String "minimal")+        -- haiku-4-5 is a budget-style model, so the level is expressed+        -- exactly and nothing is adjusted.+        KeyMap.lookup "mode" t @?= Just (String "budget")+        KeyMap.lookup "budget_tokens" t @?= Just (Number 1024)+        KeyMap.lookup "effort_text" t @?= Just Null+        KeyMap.lookup "wire_field" t @?= Just (String "thinking")+        KeyMap.lookup "adjustments" t @?= Just (Array Vector.empty)+      other -> assertFailure ("expected a thinking translation, got: " <> show other)++-- | A call refused before the request was built still records the level+-- the caller asked for, described by the adapter's own describer.+--+-- 'Transport.resolveKey' refuses an unknown host rather than reading an+-- environment variable, so 'prepareCall' fails with an AuthError+-- whatever the developer's shell holds, the adapter takes+-- 'immediateError', and the replay driver is never reached.+immediateErrorRecordsThinkingTest :: TestTree+immediateErrorRecordsThinkingTest =+  testCase "a call refused before the request was built still records the requested level" $ do+    let model = testModel & #baseUrl .~ "https://unknown-host.example"+        opts =+          emptyOptions+            & #evidence .~ Just (evidenceRequest "run-53")+            & #thinking .~ Just ThinkingHigh+    ev <- oneEvidence =<< replayWith model 200 successHeaders successBody opts+    field "status" ev @?= Just (String "failed")+    case field "thinking" ev of+      Just (Object t) -> do+        KeyMap.lookup "requested" t @?= Just (String "high")+        let expectedMode = case Aeson.toJSON (describeThinkingFor model opts) of+              Object d -> KeyMap.lookup "mode" d+              _ -> Nothing+        KeyMap.lookup "mode" t @?= expectedMode+        assertBool+          "the mode must not collapse the request into absent"+          (KeyMap.lookup "mode" t /= Just (String "absent"))+      other -> assertFailure ("expected a thinking translation, got: " <> show other)++-- | A model carrying no base URL still records the host the call went+-- to.+--+-- The adapter substitutes Anthropic's host inside 'prepareCall', so the+-- call had a perfectly definite destination while the record said+-- @endpoint: null@. The replay driver ignores the URL, so this asserts+-- what was recorded rather than where the bytes went.+defaultHostEndpointTest :: TestTree+defaultHostEndpointTest =+  testCase "a call with no base URL records the default host it went to" $ do+    ev <-+      oneEvidence+        =<< replayWith (testModel & #baseUrl .~ "") 200 successHeaders successBody baseOptions+    case field "endpoint" ev of+      Just (Object e) -> KeyMap.lookup "endpoint" e @?= Just (String "https://api.anthropic.com/v1/messages")+      other -> assertFailure ("expected an endpoint identity, got: " <> show other)++-- | A response that names its model and its message id but carries no+-- @request-id@ header still reaches @model_observed@. See the+-- OpenAI-compatible twin for why this shape matters.+responseIdCountsAsCorrelationTest :: TestTree+responseIdCountsAsCorrelationTest =+  testCase "A RESPONSE ID WITH NO HEADER STILL REACHES model_observed" $ do+    ev <- oneEvidence =<< replay 200 [] successBody baseOptions+    field "provider_request_id" ev @?= Just (String "unobserved")+    field "response_id" ev @?= Just (observedJson "msg_observed")+    field "observed_model" ev @?= Just (observedJson "claude-haiku-4-5-20990101-server-side")+    field "strength" ev @?= Just (String "model_observed")++optOutTest :: TestTree+optOutTest =+  testCase "a call that asked for no evidence emits none" $ do+    events <- replay 200 successHeaders successBody emptyCallOptions+    [e | e@CallEvidence {} <- events] @?= []+    -- The call itself still succeeded and still traced normally.+    length [e | e@CallStarted {} <- events] @?= 1+    length [e | e@CallFinished {} <- events] @?= 1++-- ============================================================+-- Replay harness+-- ============================================================++-- | Run one recorded response through the real adapter and the real+-- trace path, and return every trace event it produced.+replay :: Int -> [(ByteString, ByteString)] -> [ByteString] -> Options -> IO [TraceEvent]+replay = replayWith testModel++-- | 'replay' against a model of the caller's choosing, for the cases+-- whose point is a fact of the model's compat record.+replayWith ::+  Model -> Int -> [(ByteString, ByteString)] -> [ByteString] -> Options -> IO [TraceEvent]+replayWith model status headers chunks opts = do+  reg <- newProviderRegistry+  let driver = replayDriver status headers chunks+      provider =+        apiProviderWith+          AnthropicMessages+          (claudeMessagesStreamWith driver)+          (streamingComplete (claudeMessagesStreamWith driver))+          & #describeThinking .~ (describeThinkingFor)+          & #strengthCeiling .~ (declaredStrength AnthropicMessages)+  registerApiProviderWith reg provider+  (ref, sink) <- memorySink+  _ <-+    Stream.fold+      Fold.drain+      (withTraceStreamWith reg sink model emptyContext opts)+  reverse <$> readTVarIO ref++-- | The same recorded response, drained as the provider stream itself+-- rather than through the trace path.+--+-- The evidence cases assert what the record says; this asserts that the+-- stream carrying it was protocol-conformant. One replay cannot do both,+-- because 'withTraceStreamWith' hands back trace events, not stream+-- events.+replayStreamEvents ::+  Int -> [(ByteString, ByteString)] -> [ByteString] -> Options -> IO [AssistantMessageEvent]+replayStreamEvents status headers chunks opts =+  Stream.toList+    (claudeMessagesStreamWith (replayDriver status headers chunks) testModel emptyContext opts)++-- | A transport driver that serves a recorded response instead of+-- opening a socket.+--+-- It goes through 'sseFromResponse', so the status classification,+-- header allow-list, and SSE frame decoding under test are the ones+-- production uses. Only 'HTTP.withResponse' is replaced.+replayDriver :: Int -> [(ByteString, ByteString)] -> [ByteString] -> SseDriver+replayDriver status headers chunks _call onMetadata onEvent = do+  resp <- mkResponse status headers chunks+  sseFromResponse resp onMetadata onEvent++mkResponse ::+  Int -> [(ByteString, ByteString)] -> [ByteString] -> IO (HTTP.Response HTTP.BodyReader)+mkResponse status headers chunks = do+  ref <- newIORef chunks+  let bodyReader = do+        remaining <- readIORef ref+        case remaining of+          [] -> pure ""+          (x : xs) -> writeIORef ref xs >> pure x+  pure+    HTTP.Response+      { HTTP.responseStatus = mkStatus status "",+        HTTP.responseVersion = http11,+        HTTP.responseHeaders = [(CI.mk k, v) | (k, v) <- headers],+        HTTP.responseBody = bodyReader,+        HTTP.responseCookieJar = HTTP.createCookieJar [],+        HTTP.responseClose' = HTTP.ResponseClose (pure ()),+        HTTP.responseOriginalRequest = HTTP.defaultRequest,+        HTTP.responseEarlyHints = []+      }++memorySink :: IO (TVar [TraceEvent], TraceSink)+memorySink = do+  ref <- newTVarIO []+  let step () e = atomically (modifyTVar' ref (e :))+  pure (ref, TraceSink (Fold.foldlM' step (pure ())))++-- ============================================================+-- Fixtures+-- ============================================================++testModel :: Model+testModel =+  anthropic_claude_haiku_4_5+    & #api .~ AnthropicMessages+    & #baseUrl .~ "https://api.anthropic.com"++-- | A literal key, so 'prepareCall' resolves one without reading the+-- environment. It never reaches the replayed response.+emptyCallOptions :: Options+emptyCallOptions = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "test-key")++baseOptions :: Options+baseOptions = emptyCallOptions & #evidence .~ Just (evidenceRequest "run-53")++successHeaders :: [(ByteString, ByteString)]+successHeaders = [("request-id", "req_success_1")]++-- | A complete successful stream whose reported model is deliberately+-- not any model in the catalog, so it cannot be confused with a+-- configured one.+successBody :: [ByteString]+successBody =+  [ "data: {\"type\":\"message_start\",\"message\":{\"id\":\"msg_observed\",\"type\":\"message\",",+    "\"role\":\"assistant\",\"content\":[],\"model\":\"claude-haiku-4-5-20990101-server-side\",",+    "\"stop_reason\":null,\"stop_sequence\":null,",+    "\"usage\":{\"input_tokens\":11,\"output_tokens\":0}}}\n\n",+    "data: {\"type\":\"content_block_start\",\"index\":0,",+    "\"content_block\":{\"type\":\"text\",\"text\":\"\"}}\n\n",+    "data: {\"type\":\"content_block_delta\",\"index\":0,",+    "\"delta\":{\"type\":\"text_delta\",\"text\":\"pong\"}}\n\n",+    "data: {\"type\":\"content_block_stop\",\"index\":0}\n\n",+    "data: {\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},",+    "\"usage\":{\"output_tokens\":5}}\n\n",+    "data: {\"type\":\"message_stop\"}\n\n"+  ]++samplingEvidenceTest :: TestTree+samplingEvidenceTest =+  testCase "a dropped sampling parameter appears in the evidence record" $ do+    -- The generation rejects temperature with a 400, so baikai omits+    -- it. What must not happen is that it vanishes: the caller set a+    -- value, and the record says what became of it. The thinking mode+    -- is "absent" here — nothing about thinking was asked — which is+    -- exactly the case a reader would misread as "nothing happened".+    let model =+          testModel+            & #compat+              .~ CompatAnthropicMessages+                (defaultAnthropicMessagesCompat & #supportsSamplingParameters .~ False)+    ev <-+      oneEvidence+        =<< replayWith+          model+          200+          successHeaders+          successBody+          (baseOptions & #temperature .~ Just 0.2)+    case field "thinking" ev of+      Just (Object t) -> do+        KeyMap.lookup "mode" t @?= Just (String "absent")+        KeyMap.lookup "requested" t @?= Just Null+        case KeyMap.lookup "adjustments" t of+          Just (Array adjustments) -> case Vector.toList adjustments of+            [Object a] -> do+              KeyMap.lookup "kind" a+                @?= Just (String "sampling_dropped_unsupported_model")+              KeyMap.lookup "fields" a+                @?= Just (Array (Vector.fromList [String "temperature"]))+            other -> assertFailure ("expected exactly one adjustment, got: " <> show other)+          other -> assertFailure ("expected an adjustments array, got: " <> show other)+      other -> assertFailure ("expected a thinking object, got: " <> show other)++cacheUsageEvidenceTest :: TestTree+cacheUsageEvidenceTest =+  testCase "cache-write and cache-read counts reach the observed usage" $ do+    -- The counts are what the whole cache-pricing story rests on, and+    -- nothing pinned them: cache_creation_input_tokens is what baikai+    -- prices at the catalog's single cacheWriteCost, and totalTokens+    -- must count both cache classes as billed input.+    ev <- oneEvidence =<< replay 200 successHeaders cachedBody baseOptions+    case field "usage" ev of+      Just (Object u) -> case KeyMap.lookup "observed" u of+        Just (Object o) -> do+          KeyMap.lookup "input_tokens" o @?= Just (Number 11)+          KeyMap.lookup "cache_write_tokens" o @?= Just (Number 40)+          KeyMap.lookup "cache_read_tokens" o @?= Just (Number 60)+          KeyMap.lookup "output_tokens" o @?= Just (Number 5)+          KeyMap.lookup "total_tokens" o @?= Just (Number (11 + 40 + 60 + 5))+        other -> assertFailure ("expected an observed usage object, got: " <> show other)+      other -> assertFailure ("expected a usage object, got: " <> show other)++-- | 'successBody' with cache counters on its @message_start@.+cachedBody :: [ByteString]+cachedBody =+  [ "data: {\"type\":\"message_start\",\"message\":{\"id\":\"msg_observed\",\"type\":\"message\",",+    "\"role\":\"assistant\",\"content\":[],\"model\":\"claude-haiku-4-5-20990101-server-side\",",+    "\"stop_reason\":null,\"stop_sequence\":null,",+    "\"usage\":{\"input_tokens\":11,\"output_tokens\":0,",+    "\"cache_creation_input_tokens\":40,\"cache_read_input_tokens\":60}}}\n\n",+    "data: {\"type\":\"content_block_start\",\"index\":0,",+    "\"content_block\":{\"type\":\"text\",\"text\":\"\"}}\n\n",+    "data: {\"type\":\"content_block_delta\",\"index\":0,",+    "\"delta\":{\"type\":\"text_delta\",\"text\":\"pong\"}}\n\n",+    "data: {\"type\":\"content_block_stop\",\"index\":0}\n\n",+    "data: {\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},",+    "\"usage\":{\"output_tokens\":5}}\n\n",+    "data: {\"type\":\"message_stop\"}\n\n"+  ]++-- ============================================================+-- Assertions on the encoded record+-- ============================================================++oneEvidence :: [TraceEvent] -> IO ModelCallEvidence+oneEvidence events = case [ev | CallEvidence {evidence = ev} <- events] of+  [ev] -> pure ev+  other ->+    assertFailure+      ("expected exactly one CallEvidence, got " <> show (length other) <> ": " <> show events)++field :: Text -> ModelCallEvidence -> Maybe Value+field k ev = case Aeson.toJSON ev of+  Object o -> KeyMap.lookup (Key.fromText k) o+  _ -> Nothing++-- | How 'Baikai.Evidence.Observed' encodes a present value.+observedJson :: Text -> Value+observedJson v = Object (KeyMap.singleton "observed" (String v))++assertDigest :: Text -> ModelCallEvidence -> IO ()+assertDigest k ev = case field k ev of+  Just (String d) -> assertSha256 k d+  other -> assertFailure (Text.unpack k <> " missing or not a string: " <> show other)++assertSha256 :: Text -> Text -> IO ()+assertSha256 k d =+  assertBool+    (Text.unpack k <> " must be a sha256 digest, got: " <> show d)+    ("sha256:" `Text.isPrefixOf` d && Text.length d == 71)
+ test/FableContractsSpec.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE OverloadedRecordDot #-}++module FableContractsSpec (tests) where++import Baikai hiding (messages, model)+import Baikai.Models.Generated (anthropic_claude_fable_5_1)+import Baikai.Provider.Claude.Internal.Request qualified as R+import Baikai.Provider.Claude.Internal.Stream (SseDriver, claudeMessagesStreamWith)+import Claude.V1.Messages qualified as C+import Contract (assertErrorContract)+import Control.Lens ((&), (.~), (^.))+import Control.Monad (forM_)+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key (Key)+import Data.Aeson.KeyMap qualified as KM+import Data.IORef (newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Streamly.Data.Stream qualified as Stream+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Fable contracts"+    [ summaryTests,+      testCase "forced choices fail before the driver for complete and stream, including renamed models" $+        forM_ [model, model & #modelId .~ "renamed-generation"] $ \m ->+          forM_ [ToolChoiceRequired, ToolChoiceSpecific "lookup"] $ \choice -> do+            sent <- newIORef False+            let never _ _ _ = writeIORef sent True+                opts = options & #toolChoice .~ Just choice+            events <- Stream.toList (claudeMessagesStreamWith never m context opts)+            assertErrorContract events+            response <- streamingComplete (claudeMessagesStreamWith never) m context opts+            fmap (.category) (responseError response) @?= Just InvalidRequest+            assertBool "useful correction" (maybe False (T.isInfixOf "ToolChoiceAuto" . (.message)) (responseError response))+            readIORef sent >>= (@?= False),+      testCase "auto and none keep their exact wire meaning" $+        forM_ [(ToolChoiceAuto, "auto"), (ToolChoiceNone, "none")] $ \(choice, expected) -> do+          body <- newIORef Null+          let capture call _ emit = writeIORef body (call ^. #requestBody) >> send finalTurn emit+          _ <- streamingComplete (claudeMessagesStreamWith capture) model context (options & #toolChoice .~ Just choice)+          raw <- readIORef body+          (field "tool_choice" raw >>= field "type") @?= Just (String expected),+      testCase "supporting compatibility retains required and named choice" $+        forM_ [(ToolChoiceRequired, "any"), (ToolChoiceSpecific "lookup", "tool")] $ \(choice, expected) -> do+          let m = model & #modelId .~ "supporting-generation" & #compat .~ CompatAnthropicMessages (anthropicMessagesCompatFor model & #supportsForcedToolChoice .~ True)+          (req, _) <- either (\e -> assertFailure (T.unpack e) >> fail "map") pure (R.mapRequest m context (options & #toolChoice .~ Just choice))+          (field "tool_choice" (Aeson.toJSON req) >>= field "type") @?= Just (String expected),+      testCase "unset effort is no preference and small caps never create a manual budget" $+        forM_ [Nothing, Just ThinkingMinimal, Just ThinkingLow, Just ThinkingMedium, Just ThinkingHigh, Just ThinkingXHigh, Just ThinkingMax] $ \level -> do+          let opts = options & #thinking .~ level & #maxTokens .~ Just 1+          (req, translation) <- either (\e -> assertFailure (T.unpack e) >> fail "map") pure (R.mapRequest model context opts)+          let raw = Aeson.toJSON req+          field "max_tokens" raw @?= Just (Number 1)+          translation @?= R.describeThinkingFor model opts+          case level of+            Nothing -> do+              field "thinking" raw @?= Nothing+              translation @?= noThinkingRequested+            Just _ -> do+              (field "thinking" raw >>= field "type") @?= Just (String "adaptive")+              (field "thinking" raw >>= field "budget_tokens") @?= Nothing,+      testCase "legacy serialized compat defaults to supporting forced choice" $ do+        let raw = case Aeson.toJSON defaultAnthropicMessagesCompat of Object o -> Object (KM.delete "supportsForcedToolChoice" o); v -> v+        case Aeson.fromJSON raw of+          Aeson.Success c -> (c :: AnthropicMessagesCompat).supportsForcedToolChoice @?= True+          Aeson.Error err -> assertFailure err,+      testCase "two consecutive tool rounds preserve signed empty, visible and redacted thinking" $ do+        requests <- newIORef ([] :: [Value])+        executed <- newIORef ([] :: [Text])+        let scripted call _ emit = do+              previous <- readIORef requests+              writeIORef requests (previous <> [call ^. #requestBody])+              send (case length previous of 0 -> toolTurn "" "sig-one" "toolu_1" True; 1 -> toolTurn "visible summary" "sig-two" "toolu_2" False; _ -> finalTurn) emit+        reg <- newProviderRegistryFrom [apiProvider AnthropicMessages (claudeMessagesStreamWith scripted)]+        (history, response) <- runToolLoopWith reg 4 (\tc -> do xs <- readIORef executed; writeIORef executed (xs <> [tc.id_]); pure (toolResultText "found")) model context summaryOptions+        response.message.content @?= V.singleton (AssistantText (TextContent "done"))+        readIORef executed >>= (@?= ["toolu_1", "toolu_2"])+        bodies <- readIORef requests+        length bodies @?= 3+        case bodies of+          [first, second, third] -> do+            let a = messages first; b = messages second; c = messages third+            V.take (V.length a) b @?= a+            V.take (V.length b) c @?= b+            field "system" first @?= field "system" third+            field "tools" first @?= field "tools" third+            forM_ bodies $ \body -> (field "thinking" body >>= field "display") @?= Just (String "summarized")+            contentAt 1 b @?= V.fromList [signed "" "sig-one", redactedItem, toolItem "toolu_1"]+            contentAt 3 c @?= V.fromList [signed "visible summary" "sig-two", toolItem "toolu_2"]+            field "tool_use_id" (contentAt 2 b V.! 0) @?= Just (String "toolu_1")+            field "tool_use_id" (contentAt 4 c V.! 0) @?= Just (String "toolu_2")+            persisted <- V.mapM persistThinking (history ^. #messages)+            (req, _) <- either (\e -> assertFailure (T.unpack e) >> fail "map") pure (R.mapRequest model (history & #messages .~ persisted) summaryOptions)+            messages (Aeson.toJSON req) @?= c+          _ -> assertFailure "expected three requests",+      testCase "error cleanup retains completed signed thinking for persistence" $ do+        let partial _ _ emit = send (take 4 (toolTurn "" "sig-one" "toolu_1" False)) emit >> emit (Left (providerError "interrupted"))+        response <- streamingComplete (claudeMessagesStreamWith partial) model context options+        assertBool "failed response" (responseError response /= Nothing)+        case V.toList response.message.content of+          [AssistantThinking t] -> do+            t.thinking @?= ""+            t.signature @?= Just "sig-one"+            t.replayState @?= Nothing+          _ -> assertFailure "signed state was discarded on error"+    ]++model :: Model+model = anthropic_claude_fable_5_1++options :: Options+options = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "offline-key")++context :: Context+context = systemUser "unchanged system" "look twice" & #tools .~ V.singleton (mkTool "lookup" "lookup" (object ["type" .= ("object" :: Text)]))++send :: [Value] -> (Either BaikaiError C.MessageStreamEvent -> IO ()) -> IO ()+send frames emit = forM_ frames $ \raw -> case Aeson.fromJSON raw of+  Aeson.Error err -> assertFailure err+  Aeson.Success ev -> emit (Right ev)++start :: Value+start = object ["type" .= ("message_start" :: Text), "message" .= object ["id" .= ("msg" :: Text), "type" .= ("message" :: Text), "role" .= ("assistant" :: Text), "model" .= ("claude-fable-5-1" :: Text), "content" .= ([] :: [Value]), "usage" .= object ["input_tokens" .= (5 :: Int), "output_tokens" .= (0 :: Int)]]]++block :: Int -> Value -> Value+block n b = object ["type" .= ("content_block_start" :: Text), "index" .= n, "content_block" .= b]++stopBlock :: Int -> Value+stopBlock n = object ["type" .= ("content_block_stop" :: Text), "index" .= n]++end :: Text -> [Value]+end reason = [object ["type" .= ("message_delta" :: Text), "delta" .= object ["stop_reason" .= reason], "usage" .= object ["output_tokens" .= (5 :: Int)]], object ["type" .= ("message_stop" :: Text)]]++signed :: Text -> Text -> Value+signed text sig = object ["type" .= ("thinking" :: Text), "thinking" .= text, "signature" .= sig]++redactedItem :: Value+redactedItem = object ["type" .= ("redacted_thinking" :: Text), "data" .= ("encrypted-redacted" :: Text)]++toolItem :: Text -> Value+toolItem ident = object ["type" .= ("tool_use" :: Text), "id" .= ident, "name" .= ("lookup" :: Text), "input" .= object []]++toolTurn :: Text -> Text -> Text -> Bool -> [Value]+toolTurn text sig ident redacted =+  [start, block 0 (signed "" "")]+    <> (if T.null text then [] else [object ["type" .= ("content_block_delta" :: Text), "index" .= (0 :: Int), "delta" .= object ["type" .= ("thinking_delta" :: Text), "thinking" .= text]]])+    <> [object ["type" .= ("content_block_delta" :: Text), "index" .= (0 :: Int), "delta" .= object ["type" .= ("signature_delta" :: Text), "signature" .= sig]], stopBlock 0]+    <> (if redacted then [block 1 redactedItem, stopBlock 1] else [])+    <> [block (if redacted then 2 else 1) (toolItem ident), stopBlock (if redacted then 2 else 1)]+    <> end "tool_use"++finalTurn :: [Value]+finalTurn = [start, block 0 (object ["type" .= ("text" :: Text), "text" .= ("" :: Text)]), object ["type" .= ("content_block_delta" :: Text), "index" .= (0 :: Int), "delta" .= object ["type" .= ("text_delta" :: Text), "text" .= ("done" :: Text)]], stopBlock 0] <> end "end_turn"++field :: Key -> Value -> Maybe Value+field k (Object o) = KM.lookup k o+field _ _ = Nothing++messages :: Value -> V.Vector Value+messages raw = case field "messages" raw of Just (Array xs) -> xs; _ -> V.empty++contentAt :: Int -> V.Vector Value -> V.Vector Value+contentAt n xs = case xs V.!? n >>= field "content" of Just (Array cs) -> cs; _ -> V.empty++-- Applications own the surrounding history store; ThinkingContent supplies+-- its JSON round trip. Exercise that payload without inventing a Context decoder.+persistThinking :: Message -> IO Message+persistThinking (AssistantMessage payload) = do+  blocks <- V.mapM persist (payload ^. #content)+  pure (AssistantMessage (payload & #content .~ blocks))+  where+    persist (AssistantThinking t) = AssistantThinking <$> either assertFailure pure (Aeson.eitherDecode (Aeson.encode t))+    persist block = pure block+persistThinking other = pure other++summaryOptions :: Options+summaryOptions = options & #thinking .~ Just ThinkingLow & #evidence .~ Just (evidenceRequest "summary-replay")++summaryTests :: TestTree+summaryTests =+  testGroup+    "summary visibility"+    [ testCase "summarized reasoning assembles into non-empty thinking content" $ do+        response <- completeFrames (toolTurn "visible summary" "signed-summary" "toolu_summary" False) summaryOptions+        let blocks = [t | AssistantThinking t <- V.toList (response ^. #message . #content)]+        map (^. #thinking) blocks @?= ["visible summary"]+        map (^. #signature) blocks @?= [Just "signed-summary"]+        ev <- evidenceOf response+        ev ^. #thinking . #displayText @?= Just "summarized"+        ev ^. #thinking . #adjustments @?= []+        ev ^. #observedThinking @?= Unobserved,+      testCase "reasoning requested but returned empty is recorded in the evidence" $ do+        forM_ [[signed "" "empty-signature"], [redactedItem], [signed "" "empty-signature", redactedItem]] $ \blocks -> do+          response <- completeFrames (blocksTurn blocks) summaryOptions+          ev <- evidenceOf response+          ev ^. #thinking . #adjustments @?= [ThinkingSummaryUnavailable]+          ev ^. #thinking . #displayText @?= Just "summarized"+          ev ^. #observedThinking @?= Unobserved+          ev ^. #status @?= CallSucceeded+          responseError response @?= Nothing+          weakensThinking ThinkingSummaryUnavailable @?= False+          let actual = [t | AssistantThinking t <- V.toList (response ^. #message . #content)]+          length actual @?= length blocks+          -- Encrypted payloads and signed empty blocks remain usable history.+          (req, _) <- either (\e -> assertFailure (T.unpack e) >> fail "map") pure (R.mapRequest model (emptyContext & #messages .~ V.singleton (AssistantMessage (response ^. #message))) summaryOptions)+          contentAt 0 (messages (Aeson.toJSON req)) @?= V.fromList blocks,+      testCase "one visible block among empty and redacted blocks is a readable summary" $ do+        response <- completeFrames (blocksTurn [signed "" "empty", redactedItem, signed "visible" "visible-signature"]) summaryOptions+        ev <- evidenceOf response+        ev ^. #thinking . #adjustments @?= [],+      testCase "no thinking block and no thinking preference do not invent missing summaries" $ do+        noBlocks <- completeFrames finalTurn summaryOptions+        ev <- evidenceOf noBlocks+        ev ^. #thinking . #adjustments @?= []+        noPreference <- completeFrames (blocksTurn [signed "" "sig"]) (options & #evidence .~ Just (evidenceRequest "no-thinking"))+        ev2 <- evidenceOf noPreference+        ev2 ^. #thinking @?= noThinkingRequested,+      testCase "failed streams do not label partial thinking as a missing completed summary" $ do+        let driver _ _ emit = send [start, block 0 (signed "" "sig"), stopBlock 0] emit >> emit (Left (providerError "interrupted"))+        response <- streamingComplete (claudeMessagesStreamWith driver) model emptyContext summaryOptions+        ev <- evidenceOf response+        ev ^. #status @?= CallFailed+        ev ^. #thinking . #adjustments @?= []+        assertBool "failure retained" (responseError response /= Nothing)+    ]+  where+    completeFrames frames opts = streamingComplete (claudeMessagesStreamWith (\_ _ emit -> send frames emit)) model emptyContext opts+    blocksTurn blocks = [start] <> concat [blockFrames i b | (i, b) <- zip [0 ..] blocks] <> end "end_turn"+    blockFrames i b = case (field "type" b, field "thinking" b, field "signature" b) of+      (Just (String "thinking"), Just (String text), Just (String sig)) ->+        [ block i (signed "" ""),+          object ["type" .= ("content_block_delta" :: Text), "index" .= i, "delta" .= object ["type" .= ("thinking_delta" :: Text), "thinking" .= text]],+          object ["type" .= ("content_block_delta" :: Text), "index" .= i, "delta" .= object ["type" .= ("signature_delta" :: Text), "signature" .= sig]],+          stopBlock i+        ]+      _ -> [block i b, stopBlock i]+    evidenceOf response = maybe (assertFailure "missing evidence" >> fail "evidence") pure (response ^. #evidence)
+ test/LifecycleSpec.hs view
@@ -0,0 +1,213 @@+-- | What happens to the worker thread and the HTTP connection when the+-- consumer stops.+--+-- The driver below is the real 'sseFromResponse' over a fake response+-- whose body reader never ends and whose close hook is observable, so a+-- worker killed mid-read provably closes the response exactly as+-- production's @HTTP.withResponse@ bracket would.+--+-- "Baikai.Provider.Internal.StreamWorker" states the three cleanup+-- strengths these four cases pin: bounded read then eventual release on+-- abandonment, immediate release on cancellation, and a worker that+-- cannot strand its consumer however it dies.+module LifecycleSpec (tests) where++import Baikai+import Baikai.Models.Generated (anthropic_claude_haiku_4_5)+import Baikai.Provider.Claude.Internal.Stream (SseDriver, claudeMessagesStreamWith)+import Baikai.Provider.Claude.Sse (sseFromResponse)+import Baikai.Provider.Internal.StreamWorker (frameQueueCapacity)+import Control.Concurrent (forkIO, threadDelay, throwTo)+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)+import Control.Exception (AsyncException (ThreadKilled), SomeException, bracket, fromException, throwIO, try)+import Control.Lens ((&), (.~), (^.))+import Data.ByteString (ByteString)+import Data.CaseInsensitive qualified as CI+import Data.Generics.Labels ()+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)+import Network.HTTP.Client.Internal qualified as HTTP+import Network.HTTP.Types.Status (mkStatus)+import Network.HTTP.Types.Version (http11)+import Streamly.Data.Stream qualified as Stream+import System.Mem (performMajorGC)+import System.Timeout (timeout)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Baikai.Provider.Claude lifecycle"+    [ boundedReadTest,+      abandonedReleasesAfterGcTest,+      cancellationReleasesWithoutGcTest,+      workerDeathCannotStrandTest+    ]++-- | The bound alone stops the socket read: no garbage collection and no+-- timer is involved. Before the frame queue the counter grew without+-- limit, because the worker drained an endless body into an unbounded+-- channel.+boundedReadTest :: TestTree+boundedReadTest =+  testCase "a consumer that stops after three events stops the body reader within the queue bound" $ do+    reads' <- newIORef (0 :: Int)+    closedRef <- newIORef False+    events <-+      Stream.toList+        ( Stream.take+            3+            (claudeMessagesStreamWith (countingDriver reads' closedRef Nothing) testModel emptyContext testOptions)+        )+    length events @?= 3+    settled <- awaitSettled reads'+    assertBool+      ("body reader should stop within the queue bound, read " <> show settled <> " frames")+      (settled <= fromIntegral frameQueueCapacity + 8)++-- | The eventual guarantee. Nothing runs at the moment a consumer walks+-- away; streamly's finaliser kills the worker at the next major+-- collection, and that is when the connection goes back.+abandonedReleasesAfterGcTest :: TestTree+abandonedReleasesAfterGcTest =+  testCase "an abandoned stream releases its connection after a major GC" $ do+    reads' <- newIORef (0 :: Int)+    closedRef <- newIORef False+    _ <-+      Stream.toList+        ( Stream.take+            3+            (claudeMessagesStreamWith (countingDriver reads' closedRef Nothing) testModel emptyContext testOptions)+        )+    released <- pollFor 100 50000 (performMajorGC >> readIORef closedRef)+    assertBool "an abandoned stream's connection is released at a major GC" released++-- | The immediate guarantee. The exception lands while the consumer is+-- inside the stream's step, which is inside the bracket, so streamly+-- runs the release synchronously.+cancellationReleasesWithoutGcTest :: TestTree+cancellationReleasesWithoutGcTest =+  testCase "cancelling the consumer releases the connection without a GC" $ do+    reads' <- newIORef (0 :: Int)+    closedRef <- newIORef False+    gate <- newEmptyMVar+    outcome <- newEmptyMVar+    tid <-+      forkIO $ do+        r <-+          try+            ( Stream.toList+                (claudeMessagesStreamWith (countingDriver reads' closedRef (Just gate)) testModel emptyContext testOptions)+            )+        putMVar outcome (r :: Either SomeException [AssistantMessageEvent])+    threadDelay 100000+    throwTo tid ThreadKilled+    released <- pollFor 100 10000 (readIORef closedRef)+    assertBool "cancellation releases the connection without a GC" released+    r <- takeMVar outcome+    case r of+      Left e | Just ThreadKilled <- fromException e -> pure ()+      other -> assertFailure ("expected the drained thread to die by ThreadKilled, got: " <> show (fmap length other))++-- | The queue's closed flag is set by the fork's own @finally@, so a+-- worker that dies by asynchronous exception still ends the stream.+-- Before the frame queue the consumer blocked until the runtime's+-- deadlock detector fired.+workerDeathCannotStrandTest :: TestTree+workerDeathCannotStrandTest =+  testCase "an asynchronous exception in the worker still closes the channel" $ do+    let dyingDriver :: SseDriver+        dyingDriver _call _onMetadata _onEvent = throwIO ThreadKilled+    got <-+      timeout+        2000000+        (Stream.toList (claudeMessagesStreamWith dyingDriver testModel emptyContext testOptions))+    case got of+      Nothing -> assertFailure "a worker killed asynchronously left the consumer blocked"+      Just events -> case reverse events of+        -- 'errorInfo' is a 'Maybe': whether a stream error carries a+        -- typed error at all is itself worth asserting.+        (EventError p : _) ->+          fmap (^. #message) (p ^. #errorInfo) @?= Just "claude stream ended without message_stop"+        other -> assertFailure ("expected a terminal EventError, got: " <> show (take 1 other))++-- --------------------------------------------------------------------+-- Harness+-- --------------------------------------------------------------------++-- | A driver whose body reader is generated on demand and whose close+-- hook is observable. The bracket is the shape 'HTTP.withResponse' has,+-- so a worker killed mid-read closes the response as production would.+--+-- With a gate, the reader blocks forever from the fourth read on, which+-- is the state a cancelled consumer must be able to interrupt. Without+-- one, the body never ends, which is what makes the queue bound visible.+countingDriver :: IORef Int -> IORef Bool -> Maybe (MVar ()) -> SseDriver+countingDriver reads' closedRef gate _call onMetadata onEvent =+  bracket mkFakeResponse HTTP.responseClose $ \resp ->+    sseFromResponse resp onMetadata onEvent+  where+    mkFakeResponse =+      pure+        HTTP.Response+          { HTTP.responseStatus = mkStatus 200 "",+            HTTP.responseVersion = http11,+            HTTP.responseHeaders = [(CI.mk "request-id", "req-lifecycle")],+            HTTP.responseBody = bodyReader,+            HTTP.responseCookieJar = HTTP.createCookieJar [],+            HTTP.responseClose' = HTTP.ResponseClose (writeIORef closedRef True),+            HTTP.responseOriginalRequest = HTTP.defaultRequest,+            HTTP.responseEarlyHints = []+          }+    bodyReader = do+      n <- atomicModifyIORef' reads' (\k -> (k + 1, k))+      case gate of+        Just g | n >= 3 -> takeMVar g >> pure ""+        _ -> pure (frameAt n)++-- | An endless stream: a @message_start@, a text block start, then text+-- deltas without end.+frameAt :: Int -> ByteString+frameAt 0 =+  "data: {\"type\":\"message_start\",\"message\":{\"id\":\"msg_lifecycle\",\"type\":\"message\","+    <> "\"role\":\"assistant\",\"content\":[],\"model\":\"claude-lifecycle\","+    <> "\"stop_reason\":null,\"stop_sequence\":null,"+    <> "\"usage\":{\"input_tokens\":1,\"output_tokens\":0}}}\n\n"+frameAt 1 =+  "data: {\"type\":\"content_block_start\",\"index\":0,"+    <> "\"content_block\":{\"type\":\"text\",\"text\":\"\"}}\n\n"+frameAt _ =+  "data: {\"type\":\"content_block_delta\",\"index\":0,"+    <> "\"delta\":{\"type\":\"text_delta\",\"text\":\"x\"}}\n\n"++-- | Poll the counter until it has not moved for four consecutive reads,+-- then report where it stopped. A counter that never settles fails the+-- caller's bound rather than hanging: the ceiling is generous and+-- finite.+awaitSettled :: IORef Int -> IO Int+awaitSettled ref = go (200 :: Int) (-1) (0 :: Int)+  where+    go 0 _ _ = readIORef ref+    go budget lastSeen stableFor = do+      threadDelay 50000+      n <- readIORef ref+      if n == lastSeen+        then if stableFor >= 3 then pure n else go (budget - 1) n (stableFor + 1)+        else go (budget - 1) n 0++pollFor :: Int -> Int -> IO Bool -> IO Bool+pollFor 0 _ _ = pure False+pollFor n delay act = do+  ok <- act+  if ok+    then pure True+    else threadDelay delay >> pollFor (n - 1) delay act++testModel :: Model+testModel =+  anthropic_claude_haiku_4_5+    & #api .~ AnthropicMessages+    & #baseUrl .~ "https://api.anthropic.com"++testOptions :: Options+testOptions = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "test-key")
test/Main.hs view
@@ -1,11 +1,26 @@ module Main (main) where  import Baikai+import Baikai.Agent+  ( AgentCapability (..),+    AgentCommand,+    AgentOutputFormat (..),+    AgentPromptTransport (..),+    AgentProvider (..),+    AgentRenderError (..),+    AgentRunRequest,+    agentRunRequest,+    agentSafety,+    renderAgentRenderError,+  )+import Baikai.Provider.Claude.Agent qualified as ClaudeAgent import Baikai.Provider.Claude.Api import Baikai.Provider.Claude.Cli qualified as ClaudeCli import Baikai.Provider.Claude.Interactive-import Baikai.Provider.Claude.Internal.Request (mapRequest)+import Baikai.Provider.Claude.Internal.Request (describeThinkingFor, mapRequest) import Claude.V1.Messages qualified as Messages+import CliEvidenceSpec qualified+import Contract (assertErrorContract) import Control.Exception (bracket) import Control.Lens ((&), (.~), (^.)) import Data.Aeson qualified as Aeson@@ -14,6 +29,11 @@ import Data.Text qualified as Text import Data.Vector qualified as Vector import ErrorClassSpec qualified+import EvidenceSpec qualified+import FableContractsSpec qualified+import LifecycleSpec qualified+import MidStreamSpec qualified+import PublicSurfaceSpec qualified import ShapeSpec qualified import SseSpec qualified import Streamly.Data.Stream qualified as Stream@@ -22,7 +42,7 @@ import System.FilePath ((</>)) import System.Timeout (timeout) import Test.Tasty (TestTree, defaultMain, testGroup)-import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) import ThinkingSpec qualified import TransportSpec qualified @@ -33,6 +53,19 @@       "Baikai.Provider.Claude"       [ commandRenderingTest,         effortRenderingTests,+        safetyRefusalTest,+        safetyStillRendersTest,+        agentCommandRenderingTest,+        agentOutputFormatTest,+        agentCapabilityRenderingTests,+        agentEffortRenderingTests,+        agentThinkingTranslationTests,+        strictEvidenceTests,+        agentPromptTransportTest,+        agentBlankModelTest,+        agentSessionPersistenceTest,+        agentProviderGuardTest,+        agentKeiroFixtureTest,         batchCommandRenderingTest,         batchEffortRenderingTests,         stderrFloodTest,@@ -42,7 +75,13 @@         cliMissingBinaryTest,         responseFormatMappingTest,         optionsMappingTest,+        CliEvidenceSpec.tests,         ErrorClassSpec.tests,+        EvidenceSpec.tests,+        FableContractsSpec.tests,+        LifecycleSpec.tests,+        MidStreamSpec.tests,+        PublicSurfaceSpec.tests,         ShapeSpec.tests,         SseSpec.tests,         ThinkingSpec.tests,@@ -52,7 +91,7 @@ -- | A 'JsonSchema' on 'Options.responseFormat' maps onto Anthropic's -- native @output_config@, forwarding the schema 'Value' verbatim via -- 'Messages.jsonSchemaConfig'. Pure: 'mapRequest' is--- 'Either Text Messages.CreateMessage'.+-- 'Either Text (Messages.CreateMessage, ThinkingTranslation)'. responseFormatMappingTest :: TestTree responseFormatMappingTest =   testCase "responseFormat JsonSchema maps onto Anthropic output_config" $ do@@ -76,11 +115,11 @@         opts =           emptyOptions             & #responseFormat-              .~ Just (JsonSchema {name = "person", schema = personSchema, strict = True})+              .~ Just (JsonSchema (jsonSchemaFormat "person" personSchema) {strict = True})     case mapRequest model ctx opts of       Left e -> assertFailure ("mapRequest failed: " <> Text.unpack e)-      Right req ->-        Messages.output_config req+      Right (req, _) ->+        req ^. #output_config           @?= Just (Messages.jsonSchemaConfig personSchema)  optionsMappingTest :: TestTree@@ -94,15 +133,24 @@         opts =           emptyOptions             & #topP .~ Just 0.9-            & #stopSequences .~ Just (Vector.fromList ["END", "STOP"])+            & #stopSequences .~ ["END", "STOP"]             & #seed .~ Just 7             & #frequencyPenalty .~ Just 0.2             & #presencePenalty .~ Just 0.3     case mapRequest model emptyContext opts of       Left e -> assertFailure ("mapRequest failed: " <> Text.unpack e)-      Right req -> do+      Right (req, translation) -> do         Messages.top_p req @?= Just 0.9         Messages.stop_sequences req @?= Just (Vector.fromList ["END", "STOP"])+        -- seed, frequencyPenalty and presencePenalty have no Anthropic+        -- Messages field on any generation. They are dropped, but the+        -- drop is recorded rather than silent — the whole point of the+        -- adjustment list.+        translation+          ^. #adjustments+          @?= [ SamplingDroppedUnsupportedApi+                  ["seed", "frequency_penalty", "presence_penalty"]+              ]  commandRenderingTest :: TestTree commandRenderingTest =@@ -121,24 +169,25 @@             & #safety .~ ClaudeAllowedTools ["Read", "Bash(git status)"]             & #extraArgs .~ ["--permission-mode", "plan"]     claudeInteractiveCommand cfg req-      @?= ( "/bin/claude",-            [ "--model",-              "sonnet",-              "--system-prompt",-              "Be terse.",-              "--add-dir",-              "/work/shared",-              "--add-dir",-              "/work/docs",-              "--allowedTools",-              "Read,Bash(git status)",-              "--debug",-              "--permission-mode",-              "plan",-              "--",-              "inspect the repo"-            ]-          )+      @?= Right+        ( "/bin/claude",+          [ "--model",+            "sonnet",+            "--system-prompt",+            "Be terse.",+            "--add-dir",+            "/work/shared",+            "--add-dir",+            "/work/docs",+            "--allowedTools",+            "Read,Bash(git status)",+            "--debug",+            "--permission-mode",+            "plan",+            "--",+            "inspect the repo"+          ]+        )  effortRenderingTests :: TestTree effortRenderingTests =@@ -147,7 +196,7 @@     [ testCase name $ do         let req = interactiveLaunchRequest "prompt" & #effort .~ Just level         claudeInteractiveCommand defaultClaudeInteractiveConfig req-          @?= ("claude", ["--effort", expected, "--", "prompt"])+          @?= Right ("claude", ["--effort", expected, "--", "prompt"])     | (name, level, expected) <-         [ ("minimal as low", ThinkingMinimal, "low"),           ("low", ThinkingLow, "low"),@@ -158,6 +207,400 @@         ]     ] +safetyRefusalTest :: TestTree+safetyRefusalTest =+  testCase "refuses a Codex sandbox policy instead of launching unrestricted" $ do+    let req =+          interactiveLaunchRequest "inspect the repo"+            & #safety .~ CodexSandbox CodexReadOnly CodexApprovalNever+    case claudeInteractiveCommand defaultClaudeInteractiveConfig req of+      Right rendered -> assertFailure ("expected refusal, rendered: " <> show rendered)+      Left err -> do+        case err of+          SafetyNotExpressible p _ -> p @?= AgentClaude+          other -> assertFailure ("expected SafetyNotExpressible, got: " <> show other)+        let message = renderAgentRenderError err+        assertBool "names the provider" ("Claude" `Text.isInfixOf` message)+        assertBool "names the rejected sandbox mode" ("read-only" `Text.isInfixOf` message)+        assertBool "names the rejected approval policy" ("never" `Text.isInfixOf` message)+        assertBool "suggests an alternative" ("ClaudeAllowedTools" `Text.isInfixOf` message)++-- | The fix refuses only what Claude cannot express. An allow-list is+-- expressible and must still render, and an empty allow-list restricts+-- nothing so it renders no safety flag rather than being refused.+safetyStillRendersTest :: TestTree+safetyStillRendersTest =+  testGroup+    "still renders every safety policy Claude can express"+    [ testCase "a non-empty allow-list" $ do+        let req =+              interactiveLaunchRequest "inspect"+                & #safety .~ ClaudeAllowedTools ["Read", "Grep"]+        fmap snd (claudeInteractiveCommand defaultClaudeInteractiveConfig req)+          @?= Right ["--allowedTools", "Read,Grep", "--", "inspect"],+      testCase "an empty allow-list renders no safety flag" $ do+        let req = interactiveLaunchRequest "inspect" & #safety .~ ClaudeAllowedTools []+        fmap snd (claudeInteractiveCommand defaultClaudeInteractiveConfig req)+          @?= Right ["--", "inspect"],+      testCase "DefaultSafety renders no safety flag" $ do+        let req = interactiveLaunchRequest "inspect" & #safety .~ DefaultSafety+        fmap snd (claudeInteractiveCommand defaultClaudeInteractiveConfig req)+          @?= Right ["--", "inspect"]+    ]++-- | Render an unattended command or fail the test with the refusal's+-- own message.+renderedAgentCommand ::+  ClaudeAgent.ClaudeAgentConfig -> AgentRunRequest -> IO AgentCommand+renderedAgentCommand cfg req = fst <$> renderedAgentPair cfg req++-- | The command and the reasoning-effort translation the renderer+-- produced together.+renderedAgentPair ::+  ClaudeAgent.ClaudeAgentConfig ->+  AgentRunRequest ->+  IO (AgentCommand, ThinkingTranslation)+renderedAgentPair cfg req =+  either+    (assertFailure . Text.unpack . renderAgentRenderError)+    pure+    (ClaudeAgent.claudeAgentCommand cfg req)++agentCommandRenderingTest :: TestTree+agentCommandRenderingTest =+  testCase "unattended claude argv renders every structured flag in a fixed order" $ do+    let cfg =+          ClaudeAgent.defaultClaudeAgentConfig+            & #executable .~ "/bin/claude"+            & #extraArgs .~ ["--debug"]+        req =+          agentRunRequest AgentClaude "/work/project" "reconcile the grammar"+            & #modelId .~ Just "sonnet"+            & #effort .~ Just ThinkingHigh+            & #extraDirs .~ ["/work/shared", "/work/docs"]+            & #safety .~ (agentSafety AgentEditWorkspace & #allowedTools .~ ["Read", "Write"])+            & #safety . #providerArgs .~ ["--betas", "context-1m"]+    cmd <- renderedAgentCommand cfg req+    cmd ^. #executable @?= "/bin/claude"+    cmd ^. #arguments+      @?= [ "-p",+            "--no-session-persistence",+            "--model",+            "sonnet",+            "--effort",+            "high",+            "--permission-mode",+            "acceptEdits",+            "--allowedTools",+            "Read,Write",+            "--add-dir",+            "/work/shared",+            "--add-dir",+            "/work/docs",+            "--debug",+            "--betas",+            "context-1m"+          ]+    cmd ^. #promptTransport @?= PromptOnStdin+    cmd ^. #promptText @?= "reconcile the grammar"++-- | @output-format "json"@ is what lets an evidence record observe the+-- session, the model and the token usage of a run. Before it existed the+-- only way to ask was through the raw-argument channel, which an+-- operator ceiling closes by default — so a job needed a privileged+-- channel opened to produce a record.+agentOutputFormatTest :: TestTree+agentOutputFormatTest =+  testCase "unattended claude argv asks for a structured result, and only when asked" $ do+    let base = agentRunRequest AgentClaude "/work/project" "reconcile the grammar"+    textual <- renderedAgentCommand ClaudeAgent.defaultClaudeAgentConfig base+    -- The tool already defaults to text, so a flag restating it would be+    -- noise a reader has to check.+    textual ^. #arguments+      @?= ["-p", "--no-session-persistence", "--permission-mode", "plan"]+    structured <-+      renderedAgentCommand ClaudeAgent.defaultClaudeAgentConfig (base & #outputFormat .~ JsonFormat)+    structured ^. #arguments+      @?= [ "-p",+            "--no-session-persistence",+            "--output-format",+            "json",+            "--permission-mode",+            "plan"+          ]++agentCapabilityRenderingTests :: TestTree+agentCapabilityRenderingTests =+  testGroup+    "unattended claude argv maps every capability onto a permission mode"+    [ testCase name $ do+        let req =+              agentRunRequest AgentClaude "/work/project" "prompt"+                & #safety .~ agentSafety cap+        cmd <- renderedAgentCommand ClaudeAgent.defaultClaudeAgentConfig req+        cmd ^. #arguments+          @?= ["-p", "--no-session-persistence", "--permission-mode", expected]+    | (name, cap, expected) <-+        [ ("read-only as plan", AgentReadOnly, "plan"),+          ("edit-workspace as acceptEdits", AgentEditWorkspace, "acceptEdits"),+          ("full-access as bypassPermissions", AgentFullAccess, "bypassPermissions")+        ]+    ]++-- | Claude's @--effort@ has no @minimal@ value, so the lowest level+-- maps up to @low@. Codex passes all six through unchanged; pinning+-- both sides stops someone later \"unifying\" them.+agentEffortRenderingTests :: TestTree+agentEffortRenderingTests =+  testGroup+    "unattended claude argv clamps minimal effort up to low"+    [ testCase name $ do+        let req =+              agentRunRequest AgentClaude "/work/project" "prompt"+                & #effort .~ Just level+        cmd <- renderedAgentCommand ClaudeAgent.defaultClaudeAgentConfig req+        cmd ^. #arguments+          @?= [ "-p",+                "--no-session-persistence",+                "--effort",+                expected,+                "--permission-mode",+                "plan"+              ]+    | (name, level, expected) <-+        [ ("minimal as low", ThinkingMinimal, "low"),+          ("low", ThinkingLow, "low"),+          ("medium", ThinkingMedium, "medium"),+          ("high", ThinkingHigh, "high"),+          ("xhigh", ThinkingXHigh, "xhigh"),+          ("max", ThinkingMax, "max")+        ]+    ]++-- | The prompt travels on standard input, so a prompt that begins with+-- a dash cannot be parsed as a flag and cannot be swallowed by a+-- preceding variadic flag. Dash-leading directories still appear as+-- ordinary arguments following their own flag.+agentPromptTransportTest :: TestTree+agentPromptTransportTest =+  testCase "unattended claude argv never contains the prompt, even a dash-leading one" $ do+    let dashPrompt = "-rm -rf /"+        req =+          agentRunRequest AgentClaude "-/work/dashdir" dashPrompt+            & #extraDirs .~ ["-/work/dashshared"]+            & #safety .~ (agentSafety AgentEditWorkspace & #allowedTools .~ ["Read"])+    cmd <- renderedAgentCommand ClaudeAgent.defaultClaudeAgentConfig req+    assertBool+      ("prompt leaked into argv: " <> show (cmd ^. #arguments))+      (Text.unpack dashPrompt `notElem` cmd ^. #arguments)+    cmd ^. #promptText @?= dashPrompt+    cmd ^. #promptTransport @?= PromptOnStdin+    cmd ^. #arguments+      @?= [ "-p",+            "--no-session-persistence",+            "--permission-mode",+            "acceptEdits",+            "--allowedTools",+            "Read",+            "--add-dir",+            "-/work/dashshared"+          ]++agentBlankModelTest :: TestTree+agentBlankModelTest =+  testCase "unattended claude argv omits --model for a blank model value" $ do+    let req =+          agentRunRequest AgentClaude "/work/project" "prompt"+            & #modelId .~ Just "   "+    cmd <- renderedAgentCommand ClaudeAgent.defaultClaudeAgentConfig req+    cmd ^. #arguments+      @?= ["-p", "--no-session-persistence", "--permission-mode", "plan"]++agentSessionPersistenceTest :: TestTree+agentSessionPersistenceTest =+  testCase "unattended claude argv persists a session only when asked" $ do+    let req = agentRunRequest AgentClaude "/work/project" "prompt"+        persisting = ClaudeAgent.defaultClaudeAgentConfig & #persistSession .~ True+    byDefault <- renderedAgentCommand ClaudeAgent.defaultClaudeAgentConfig req+    byDefault ^. #arguments+      @?= ["-p", "--no-session-persistence", "--permission-mode", "plan"]+    persisted <- renderedAgentCommand persisting req+    persisted ^. #arguments @?= ["-p", "--permission-mode", "plan"]++-- | The unattended renderer describes what it did with the caller's+-- reasoning-effort request, and the description agrees with the argument+-- vector it produced.+--+-- Asserted together on purpose: the whole value of the translation is+-- that it survives a collapse the command line cannot express, and two+-- separate tests could drift apart without either failing.+agentThinkingTranslationTests :: TestTree+agentThinkingTranslationTests =+  testGroup+    "the unattended claude renderer records what --effort actually received"+    ( testCase+        "no effort requested is not a downgrade"+        ( do+            (cmd, translation) <- renderedAgentPair ClaudeAgent.defaultClaudeAgentConfig (effortRequest Nothing)+            assertBool+              ("no --effort flag is rendered: " <> show (cmd ^. #arguments))+              ("--effort" `notElem` (cmd ^. #arguments))+            translation @?= noThinkingRequested+        )+        : [ testCase (Text.unpack (renderThinkingLevel level)) $ do+              (cmd, translation) <-+                renderedAgentPair ClaudeAgent.defaultClaudeAgentConfig (effortRequest (Just level))+              assertBool+                ("--effort " <> Text.unpack wire <> " in " <> show (cmd ^. #arguments))+                (["--effort", Text.unpack wire] `isConsecutiveIn` (cmd ^. #arguments))+              translation+                @?= ThinkingTranslation+                  { requested = Just level,+                    mode = ThinkingModeFlag,+                    effortText = Just wire,+                    budgetTokens = Nothing,+                    wireField = Just "--effort",+                    displayText = Nothing,+                    adjustments = expected+                  }+          | (level, wire, expected) <-+              [ -- claude's --effort has no minimal, so the lowest level+                -- collapses and a run at minimal is wire-identical to a+                -- run at low.+                (ThinkingMinimal, "low", [EffortClamped ThinkingMinimal "low"]),+                (ThinkingLow, "low", []),+                (ThinkingMedium, "medium", []),+                (ThinkingHigh, "high", []),+                (ThinkingXHigh, "xhigh", []),+                (ThinkingMax, "max", [])+              ]+          ]+    )+  where+    effortRequest level =+      agentRunRequest AgentClaude "/work/project" "prompt" & #effort .~ level++-- | Whether the needle appears as consecutive elements of the haystack.+isConsecutiveIn :: (Eq a) => [a] -> [a] -> Bool+isConsecutiveIn needle haystack =+  any (\suffix -> needle == take (length needle) suffix) (suffixes haystack)+  where+    suffixes xs =+      xs : case xs of+        [] -> []+        (_ : rest) -> suffixes rest++-- | The pre-dispatch strictness gate, fed by this package's __real__+-- translation functions rather than by hand-built adjustments.+--+-- The generic gate is exhaustively covered in+-- @baikai/test/StrictEvidenceSpec.hs@; what only this package can prove+-- is that its own downgrade sites actually reach the gate.+strictEvidenceTests :: TestTree+strictEvidenceTests =+  testGroup+    "strict evidence refuses this provider's real downgrades"+    [ testCase "a model that does not advertise reasoning is refused" $ do+        let m =+              emptyModel+                & #modelId .~ "claude-no-reasoning"+                & #api .~ AnthropicMessages+                & #reasoning .~ False+            opts = emptyOptions & #thinking .~ Just ThinkingHigh+        expectDowngrade+          (ThinkingDroppedUnsupportedModel ThinkingHigh)+          (describeThinkingFor m opts),+      testCase "A THINKING BUDGET THAT WILL NOT FIT max_tokens IS REFUSED" $ do+        -- The least discoverable downgrade in baikai: a caller lowered+        -- maxTokens and silently lost thinking on a reasoning model.+        let m =+              emptyModel+                & #modelId .~ "claude-reasoning"+                & #api .~ AnthropicMessages+                & #reasoning .~ True+                & #maxOutputTokens .~ 8192+            opts =+              emptyOptions+                & #thinking .~ Just ThinkingMax+                & #maxTokens .~ Just 128+        case describeThinkingFor m opts ^. #adjustments of+          [ThinkingDroppedBudgetExceeded lvl _ _] -> lvl @?= ThinkingMax+          other -> assertFailure ("expected a budget drop, got: " <> show other)+        assertBool+          "the gate must refuse it"+          (not (null (checkEvidenceRequirements (EvidenceRequired EvidenceRequestedOnly) (declaredStrength AnthropicMessages) (describeThinkingFor m opts)))),+      testCase "the claude CLI's minimal collapse is refused" $+        expectDowngrade+          (EffortClamped ThinkingMinimal "low")+          (ClaudeCli.claudeCliThinking (emptyOptions & #thinking .~ Just ThinkingMinimal)),+      testCase "a level this transport expresses exactly is not refused" $ do+        let m =+              emptyModel+                & #modelId .~ "claude-reasoning"+                & #api .~ AnthropicMessages+                & #reasoning .~ True+                & #maxOutputTokens .~ 64000+            opts = emptyOptions & #thinking .~ Just ThinkingMedium+        checkEvidenceRequirements+          (EvidenceRequired EvidenceModelObserved)+          (declaredStrength AnthropicMessages)+          (describeThinkingFor m opts)+          @?= []+    ]+  where+    expectDowngrade expected translation =+      case checkEvidenceRequirements+        (EvidenceRequired EvidenceRequestedOnly)+        (declaredStrength AnthropicMessages)+        translation of+        [ThinkingWouldDowngrade [reported]] -> reported @?= expected+        other -> assertFailure ("expected one downgrade refusal, got: " <> show other)++agentProviderGuardTest :: TestTree+agentProviderGuardTest =+  testCase "the claude renderer refuses a request that names codex" $ do+    let req = agentRunRequest AgentCodex "/work/project" "prompt"+    fmap fst (ClaudeAgent.claudeAgentCommand ClaudeAgent.defaultClaudeAgentConfig req)+      @?= Left (ProviderMismatch AgentClaude AgentCodex)++-- | The launch shape this initiative's first consumer embeds today in+-- @scripts/sync-keiro-dsl.sh@ in the @shinzui/keiro-syntax@ repository,+-- rendered from a provider-neutral request instead of Claude-specific+-- flags written into the script.+agentKeiroFixtureTest :: TestTree+agentKeiroFixtureTest =+  testCase "the sync-keiro-dsl launch shape renders without script-level claude flags" $ do+    let req =+          agentRunRequest AgentClaude "/work/keiro-syntax" "reconcile the Keiro DSL"+            & #extraDirs .~ ["/work/keiro"]+            & #safety+              .~ ( agentSafety AgentEditWorkspace+                     & #allowedTools+                       .~ [ "Read",+                            "Write",+                            "Edit",+                            "Glob",+                            "Grep",+                            "Bash",+                            "Skill",+                            "TodoWrite"+                          ]+                 )+    cmd <- renderedAgentCommand ClaudeAgent.defaultClaudeAgentConfig req+    cmd ^. #executable @?= "claude"+    cmd ^. #arguments+      @?= [ "-p",+            "--no-session-persistence",+            "--permission-mode",+            "acceptEdits",+            "--allowedTools",+            "Read,Write,Edit,Glob,Grep,Bash,Skill,TodoWrite",+            "--add-dir",+            "/work/keiro"+          ]+    cmd ^. #promptTransport @?= PromptOnStdin+    cmd ^. #promptText @?= "reconcile the Keiro DSL"+ batchCommandRenderingTest :: TestTree batchCommandRenderingTest =   testCase "claude -p argv terminates options before a dash-leading prompt" $ do@@ -349,15 +792,6 @@     (const (unsetEnv name >> action))   where     restore = maybe (unsetEnv name) (setEnv name)--assertErrorContract :: [AssistantMessageEvent] -> Assertion-assertErrorContract events = do-  let terminals = filter isTerminal events-  length terminals @?= 1-  case terminals of-    [EventError TerminalPayload {errorInfo = Nothing}] ->-      assertFailure "terminal EventError omitted errorInfo"-    _ -> pure ()  assistantText :: Response -> Text.Text assistantText resp =
+ test/MidStreamSpec.hs view
@@ -0,0 +1,268 @@+-- | What the caller sees when a stream that started healthily stops+-- badly.+--+-- Every case here drives the real provider stream — @translate@, the+-- assembler, the worker's error path — over a body reader that raises+-- from @brRead@ after handing out the chunks it was given. That is+-- exactly what a socket reset, a server closing mid-chunk, and a TLS+-- session torn down after the handshake look like to the transport, and+-- it is the shape the classifier could not see before the shared core+-- rule: @http-client@ wraps the connect phase but not the body read, so+-- these exceptions reach the worker raw.+module MidStreamSpec (tests) where++import Baikai+  ( ApiKeySource (..),+    AssistantContent (..),+    AssistantMessageEvent (..),+    AssistantPayload (..),+    Message (..),+    Options,+    TerminalPayload (..),+    TextContent (..),+    emptyContext,+    emptyModel,+    emptyOptions,+  )+import Baikai.Api (Api (..))+import Baikai.Error (BaikaiError (..), ErrorCategory (..), isRetryable)+import Baikai.Model (Model)+import Baikai.Models.Generated (anthropic_claude_haiku_4_5)+import Baikai.Provider.Claude.Api (claudeMessagesStream)+import Baikai.Provider.Claude.Internal.Stream (SseDriver, claudeMessagesStreamWith)+import Baikai.Provider.Claude.Sse (sseFromResponse)+import Contract (assertErrorContract)+import Control.Concurrent (forkIO, killThread)+import Control.Concurrent.MVar (newEmptyMVar, takeMVar, tryPutMVar)+import Control.Exception (SomeException, bracket, finally, handle, throwIO, toException)+import Control.Lens ((&), (.~), (^.))+import Data.ByteString (ByteString)+import Data.CaseInsensitive qualified as CI+import Data.Generics.Labels ()+import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Vector qualified as Vector+import Foreign.C.Error (Errno (..), eCONNRESET)+import GHC.IO.Exception qualified as IOE+import Network.HTTP.Client qualified as HTTP+import Network.HTTP.Client.Internal qualified as HTTPI+import Network.HTTP.Types.Status (mkStatus)+import Network.HTTP.Types.Version (http11)+import Network.Socket qualified as Socket+import Network.TLS qualified as TLS+import Streamly.Data.Stream qualified as Stream+import System.Timeout qualified as Timeout+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "mid-stream failures (Anthropic Messages)"+    [ testCase "a connection reset after two chunks ends with a retryable EventError carrying the partial text" $ do+        events <- drainFailing contentChunks (toException connectionReset)+        assertErrorContract events+        be <- terminalError events+        category be @?= TransientError+        assertBool "a mid-stream reset is retryable" (isRetryable be)+        assertBool+          ("the drained text survives the failure: " <> show events)+          ("Hel" `Text.isInfixOf` terminalText events),+      testCase "a chunked-encoding EOF classifies as TransientError" $ do+        events <-+          drainFailing+            contentChunks+            (toException (HTTP.HttpExceptionRequest HTTP.defaultRequest HTTP.InvalidChunkHeaders))+        assertErrorContract events+        be <- terminalError events+        category be @?= TransientError+        assertBool "a mid-chunk close is retryable" (isRetryable be),+      -- Raised raw, as it is from brRead: http-client installs no+      -- wrapper around the body reader that would convert it.+      testCase "a TLS termination mid-body classifies as TransientError" $ do+        events <- drainFailing contentChunks (toException (TLS.PostHandshake TLS.Error_EOF))+        assertErrorContract events+        be <- terminalError events+        category be @?= TransientError+        assertBool "a torn-down TLS session is retryable" (isRetryable be),+      testCase "a stalled socket is cut off by timeoutMs as TransientError" $ do+        (events, _) <- withStalledServer $ \port -> drainLive port (Just 200)+        assertErrorContract events+        be <- terminalError events+        category be @?= TransientError+        assertBool "a timed-out call is retryable" (isRetryable be)+        assertBool+          ("the message names the bound that fired: " <> show (be ^. #message))+          ("timeoutMs=200" `Text.isInfixOf` (be ^. #message)),+      testCase "timeoutMs of zero is rejected as InvalidRequest before any connection" $ do+        (events, accepted) <- withStalledServer $ \port -> drainLive port (Just 0)+        assertErrorContract events+        be <- terminalError events+        category be @?= InvalidRequest+        assertBool "a caller-side mistake is not retryable" (not (isRetryable be))+        accepted @?= 0,+      testCase "a negative timeoutMs is rejected as InvalidRequest" $ do+        (events, accepted) <- withStalledServer $ \port -> drainLive port (Just (-1))+        assertErrorContract events+        be <- terminalError events+        category be @?= InvalidRequest+        assertBool "a caller-side mistake is not retryable" (not (isRetryable be))+        accepted @?= 0,+      testCase "a programming error in the body path stays OtherError" $ do+        events <- drainFailing contentChunks (toException (userError "bug in callback"))+        assertErrorContract events+        be <- terminalError events+        category be @?= OtherError+        assertBool "a callback bug is not retryable" (not (isRetryable be))+    ]++-- ============================================================+-- Fixtures+-- ============================================================++-- | A @message_start@, a text block opened at index 0, and one delta of+-- @"Hel"@: the stream is healthy right up to the failure, and one block+-- is still open when it lands.+contentChunks :: [ByteString]+contentChunks =+  [ "data: {\"type\":\"message_start\",\"message\":{\"id\":\"msg_observed\",\"type\":\"message\",",+    "\"role\":\"assistant\",\"content\":[],\"model\":\"claude-haiku-4-5-20990101-server-side\",",+    "\"stop_reason\":null,\"stop_sequence\":null,",+    "\"usage\":{\"input_tokens\":11,\"output_tokens\":0}}}\n\n",+    "data: {\"type\":\"content_block_start\",\"index\":0,\"content_block\":{\"type\":\"text\",\"text\":\"\"}}\n\n",+    "data: {\"type\":\"content_block_delta\",\"index\":0,\"delta\":{\"type\":\"text_delta\",\"text\":\"Hel\"}}\n\n"+  ]++-- | The canonical mid-stream reset: the peer sent RST while the+-- response body was still arriving.+connectionReset :: IOE.IOException+connectionReset =+  IOE.IOError+    { IOE.ioe_handle = Nothing,+      IOE.ioe_type = IOE.ResourceVanished,+      IOE.ioe_location = "Network.Socket.recvBuf",+      IOE.ioe_description = "Connection reset by peer",+      IOE.ioe_errno = Just (case eCONNRESET of Errno n -> n),+      IOE.ioe_filename = Nothing+    }++-- | Drain the provider stream over a body reader that yields @chunks@+-- and then raises @ex@ from the next @brRead@.+drainFailing :: [ByteString] -> SomeException -> IO [AssistantMessageEvent]+drainFailing chunks ex =+  Stream.toList (claudeMessagesStreamWith (failingDriver chunks ex) testModel emptyContext testOptions)++failingDriver :: [ByteString] -> SomeException -> SseDriver+failingDriver chunks ex _call onMetadata onEvent = do+  resp <- mkFailingResponse chunks ex+  sseFromResponse resp onMetadata onEvent++-- | 'EvidenceSpec.mkResponse' with one difference: the exhausted branch+-- of the body reader raises instead of returning the empty string that+-- means end-of-body.+mkFailingResponse :: [ByteString] -> SomeException -> IO (HTTP.Response HTTP.BodyReader)+mkFailingResponse chunks ex = do+  ref <- newIORef chunks+  let bodyReader = do+        remaining <- readIORef ref+        case remaining of+          [] -> throwIO ex+          (x : xs) -> writeIORef ref xs >> pure x+  pure+    HTTPI.Response+      { HTTPI.responseStatus = mkStatus 200 "OK",+        HTTPI.responseVersion = http11,+        HTTPI.responseHeaders = [(CI.mk "content-type", "text/event-stream")],+        HTTPI.responseBody = bodyReader,+        HTTPI.responseCookieJar = HTTP.createCookieJar [],+        HTTPI.responseClose' = HTTPI.ResponseClose (pure ()),+        HTTPI.responseOriginalRequest = HTTP.defaultRequest,+        HTTPI.responseEarlyHints = []+      }++testModel :: Model+testModel =+  anthropic_claude_haiku_4_5+    & #api .~ AnthropicMessages+    & #baseUrl .~ "https://api.anthropic.com"++-- | A literal key so no environment variable is consulted.+testOptions :: Options+testOptions = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "test-key")++-- ============================================================+-- Assertions+-- ============================================================++terminalError :: [AssistantMessageEvent] -> IO BaikaiError+terminalError events = case reverse events of+  (EventError TerminalPayload {errorInfo = Just be} : _) -> pure be+  other -> assertFailure ("expected a terminal EventError carrying errorInfo, got: " <> show (take 1 other))++-- | The text the terminal message carries. This is where the drained+-- partial text has to survive: the assembler closes the blocks that+-- were open when the failure landed.+terminalText :: [AssistantMessageEvent] -> Text+terminalText events = case reverse events of+  (EventError TerminalPayload {message = AssistantMessage AssistantPayload {content = blocks}} : _) ->+    Text.concat [t | AssistantText TextContent {text = t} <- Vector.toList blocks]+  _ -> ""++-- ============================================================+-- A socket that never answers+-- ============================================================++-- | A TCP listener on @127.0.0.1@ that accepts one connection and holds+-- it open without ever reading or writing: an HTTP server that has+-- stalled after the connect succeeded.+--+-- Port @0@ asks the kernel for a free port, so the test never collides+-- with anything else on the machine or with a parallel run of itself.+-- The returned count is how many connections were accepted, which is+-- what proves a refused bound opened no socket at all.+withStalledServer :: (Int -> IO a) -> IO (a, Int)+withStalledServer body = bracket open Socket.close $ \listener -> do+  port <- Socket.socketPort listener+  accepted <- newIORef (0 :: Int)+  release <- newEmptyMVar+  acceptor <- forkIO . handle (\(_ :: SomeException) -> pure ()) $ do+    (conn, _) <- Socket.accept listener+    modifyIORef' accepted (+ 1)+    takeMVar release+    Socket.close conn+  result <- body (fromIntegral port) `finally` (tryPutMVar release () >> killThread acceptor)+  count <- readIORef accepted+  pure (result, count)+  where+    open = do+      s <- Socket.socket Socket.AF_INET Socket.Stream Socket.defaultProtocol+      Socket.setSocketOption s Socket.ReuseAddr 1+      Socket.bind s (Socket.SockAddrInet 0 (Socket.tupleToHostAddress (127, 0, 0, 1)))+      Socket.listen s 1+      pure s++-- | Drain the /live/ stream against a local port, under a guard that+-- turns a stuck run into a failure rather than a hung suite.+drainLive :: Int -> Maybe Int -> IO [AssistantMessageEvent]+drainLive port bound = do+  let model = stallModel port+      opts = testOptions & #timeoutMs .~ bound+  result <- Timeout.timeout 10_000_000 (Stream.toList (claudeMessagesStream model emptyContext opts))+  case result of+    Just events -> pure events+    Nothing -> assertFailure "the ten-second guard fired: timeoutMs never did"++-- | A model pointed at the local listener. Built from 'emptyModel' so no+-- catalog base URL can override the port under test.+stallModel :: Int -> Model+stallModel port =+  emptyModel+    & #modelId+      .~ "stall-test"+    & #provider+      .~ "test"+    & #api+      .~ AnthropicMessages+    & #baseUrl+      .~ Text.pack ("http://127.0.0.1:" <> show port)
+ test/PublicSurfaceSpec.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedRecordDot #-}++-- | A downstream consumer's view of @baikai-claude@, compiled.+--+-- Imports only the four public modules — no @.Internal@, no+-- @Baikai.Prelude@, no lens — and builds everything a consumer builds.+-- The compilation is the test: a name that stops being exported, or a+-- record that can no longer be built without its constructor, fails the+-- build here rather than at a consumer.+module PublicSurfaceSpec (tests) where++import Baikai+import Baikai.Agent (AgentCommand (executable), AgentProvider (AgentClaude), agentRunRequest)+import Baikai.Provider.Claude.Agent qualified as Agent+import Baikai.Provider.Claude.Api qualified as Api+import Baikai.Provider.Claude.Cli qualified as Cli+import Baikai.Provider.Claude.Interactive qualified as Interactive+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "public surface (baikai-claude)"+    [ testCase "the provider values carry their API tags" $ do+        Api.claudeMessagesProvider.apiTag @?= AnthropicMessages+        (Cli.claudeCliProvider Cli.defaultClaudeCliConfig).apiTag @?= AnthropicMessagesCli,+      testCase "the interactive launcher renders a command without running one" $+        case Interactive.claudeInteractiveCommand+          Interactive.defaultClaudeInteractiveConfig+          (interactiveLaunchRequest "look around") of+          Left refusal -> assertRefusalIsUnexpected refusal+          Right (executable, _args) -> executable @?= "claude",+      testCase "the unattended renderer renders a command without running one" $+        case Agent.claudeAgentCommand+          Agent.defaultClaudeAgentConfig+          (agentRunRequest AgentClaude "." "summarise") of+          Left refusal -> assertRefusalIsUnexpected refusal+          Right (cmd, _translation) -> cmd.executable @?= "claude"+    ]+  where+    assertRefusalIsUnexpected refusal =+      fail ("expected a rendered command, got a refusal: " <> show refusal)
test/ShapeSpec.hs view
@@ -2,13 +2,16 @@  import Baikai import Baikai.Models.Generated qualified as Models-import Baikai.Provider.Claude.Internal.Request (mapRequest)+import Baikai.Provider.Claude.Internal.Request (describeThinkingFor, mapRequest) import Baikai.Provider.Claude.Shape (streamRequestBody)-import Control.Lens ((&), (.~))+import Baikai.Provider.Claude.Transport qualified as Transport+import Control.Lens ((&), (.~), (^.))+import Control.Monad (forM_) import Data.Aeson (Value (..), (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as AesonKey import Data.Aeson.KeyMap qualified as KeyMap+import Data.Map.Strict qualified as Map import Data.Text qualified as Text import Data.Vector qualified as Vector import Test.Tasty (TestTree, testGroup)@@ -18,7 +21,12 @@ tests =   testGroup     "ShapeSpec"-    [ verbatimToolSchemaTest,+    [ testCase "server-side fallbacks stay absent from the request" $ do+        value <- shapedBody Models.anthropic_claude_opus_5 emptyContext emptyOptions+        lookupPath ["fallbacks"] value @?= Nothing,+      summaryDisplayTest,+      fastSpeedTests,+      verbatimToolSchemaTest,       toolChoiceNoneTest,       toolCacheControlTest,       toolCacheControlCompatGateTest@@ -102,7 +110,7 @@  shapedBody :: Model -> Context -> Options -> IO Value shapedBody model ctx opts = do-  req <- either (assertFailure . Text.unpack) pure (mapRequest model ctx opts)+  (req, _) <- either (assertFailure . Text.unpack) pure (mapRequest model ctx opts)   pure (streamRequestBody (anthropicMessagesCompatFor model) ctx opts req)  objectSchema :: Value@@ -124,3 +132,59 @@     i < Vector.length xs =       lookupPath rest (xs Vector.! i) lookupPath _ _ = Nothing++fastSpeedTests :: TestTree+fastSpeedTests =+  testGroup+    "speed"+    [ testCase "a fast-mode request on claude-opus-5 carries speed and the beta header" $ do+        let m = Models.anthropic_claude_opus_5+            opts = emptyOptions & #speed .~ Just SpeedFast+        value <- shapedBody m emptyContext opts+        lookupPath ["speed"] value @?= Just (String "fast")+        lookup "anthropic-beta" (headers m opts) @?= Just "fast-mode-2026-02-01",+      testCase "a fast-mode request on claude-sonnet-5 omits speed and records the drop" $ do+        let m = Models.anthropic_claude_sonnet_5+            opts = emptyOptions & #speed .~ Just SpeedFast+        value <- shapedBody m emptyContext opts+        lookupPath ["speed"] value @?= Nothing+        lookup "anthropic-beta" (headers m opts) @?= Nothing+        case mapRequest m emptyContext opts of+          Left err -> assertFailure (show err)+          Right (_, translation) -> do+            translation @?= describeThinkingFor m opts+            translation ^. #adjustments @?= [FastModeDroppedUnsupportedModel]+        weakensThinking FastModeDroppedUnsupportedModel @?= False+        Aeson.fromJSON (Aeson.toJSON FastModeDroppedUnsupportedModel) @?= Aeson.Success FastModeDroppedUnsupportedModel,+      testCase "absent and explicit standard speed remain distinct on unsupported models" $ do+        let m = Models.anthropic_claude_sonnet_5+            opts = emptyOptions & #speed .~ Just SpeedStandard+        absent <- shapedBody m emptyContext emptyOptions+        standard <- shapedBody m emptyContext opts+        lookupPath ["speed"] absent @?= Nothing+        lookupPath ["speed"] standard @?= Just (String "standard")+        lookup "anthropic-beta" (headers m opts) @?= Nothing+        describeThinkingFor m opts ^. #adjustments @?= [],+      testCase "caller beta headers override model and automatic fast beta headers" $ do+        let m = Models.anthropic_claude_opus_5 & #headers .~ Map.singleton "anthropic-beta" "model-beta"+            opts = emptyOptions & #speed .~ Just SpeedFast & #headers .~ Map.singleton "Anthropic-Beta" "caller-beta"+        lookup "anthropic-beta" (headers m emptyOptions) @?= Just "model-beta"+        lookup "anthropic-beta" (headers m opts) @?= Just "caller-beta"+    ]+  where+    headers m opts = Transport.requestHeaders "test-key" Nothing (anthropicMessagesCompatFor m) emptyContext m opts++summaryDisplayTest :: TestTree+summaryDisplayTest = testCase "adaptive requests ask for summarized display; budget and absent thinking retain their shapes" $ do+  let opts = emptyOptions & #thinking .~ Just ThinkingLow+  forM_ [Models.anthropic_claude_opus_5, Models.anthropic_claude_opus_4_6, Models.anthropic_claude_fable_5_1, Models.anthropic_claude_opus_5 & #modelId .~ "renamed"] $ \m -> do+    body <- shapedBody m emptyContext opts+    lookupPath ["thinking"] body @?= Just (Aeson.object ["type" .= ("adaptive" :: Text.Text), "display" .= ("summarized" :: Text.Text)])+    describeThinkingFor m opts ^. #displayText @?= Just "summarized"+    absent <- shapedBody m emptyContext emptyOptions+    lookupPath ["thinking"] absent @?= Nothing+    describeThinkingFor m emptyOptions ^. #displayText @?= Nothing+  let budget = Models.anthropic_claude_haiku_4_5+  body <- shapedBody budget emptyContext opts+  lookupPath ["thinking"] body @?= Just (Aeson.object ["type" .= ("enabled" :: Text.Text), "budget_tokens" .= thinkingTokenBudget ThinkingLow])+  describeThinkingFor budget opts ^. #displayText @?= Nothing
test/SseSpec.hs view
@@ -1,18 +1,40 @@ module SseSpec (tests) where -import Baikai.Error (ErrorCategory (..), category, httpStatus, retryAfterSeconds)-import Baikai.Provider.Claude.Sse (sseFromResponse)+import Baikai+import Baikai.Http qualified as Http+import Baikai.Models.Generated (anthropic_claude_fable_5_1, anthropic_claude_haiku_4_5, anthropic_claude_opus_5)+import Baikai.Provider.Claude.Internal.Stream (Assembler, SseDriver, claudeMessagesStreamWith, emptyAssembler, translate)+import Baikai.Provider.Claude.Sse+  ( ResponseMetadata,+    buildRequest,+    claudeSseStreamValueWithHeaders,+    sseFromResponse,+  )+import Baikai.Usage qualified as Usage import Claude.V1.Messages qualified as Messages-import Control.Lens ((^.))+import Contract (assertErrorContract)+import Control.Lens ((&), (.~), (^.))+import Control.Monad (forM_)+import Data.Aeson qualified as Aeson import Data.ByteString (ByteString)+import Data.ByteString qualified as SBS+import Data.ByteString.Char8 qualified as S8+import Data.ByteString.Lazy qualified as LBS import Data.CaseInsensitive qualified as CI import Data.Generics.Labels ()-import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef)+import Data.IORef (IORef, atomicModifyIORef', modifyIORef', newIORef, readIORef, writeIORef)+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.Time.Clock (UTCTime)+import Data.Vector (Vector)+import Data.Vector qualified as Vector import Network.HTTP.Client.Internal qualified as HTTP import Network.HTTP.Types.Status (mkStatus) import Network.HTTP.Types.Version (http11)+import Servant.Client qualified as Client+import Streamly.Data.Stream qualified as Stream import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertFailure, testCase, (@?=))+import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))  tests :: TestTree tests =@@ -20,8 +42,9 @@     "Baikai.Provider.Claude.Sse"     [ testCase "non-2xx response preserves Retry-After and status" $ do         eventsRef <- newIORef []+        metaRef <- newIORef []         resp <- mkResponse 429 [("Retry-After", "7")] ["{\"type\":\"error\",\"error\":{\"type\":\"rate_limit_error\",\"message\":\"slow\"}}"]-        sseFromResponse resp (\ev -> modifyIORef' eventsRef (<> [ev]))+        sseFromResponse resp (\md -> modifyIORef' metaRef (<> [md])) (\ev -> modifyIORef' eventsRef (<> [ev]))         events <- readIORef eventsRef         case events of           [Left e] -> do@@ -29,8 +52,40 @@             retryAfterSeconds e @?= Just 7             httpStatus e @?= Just 429           other -> assertFailure ("expected one classified error, got: " <> show other),+      -- CDN-fronted hosts send a date rather than a count on a 429.+      -- The response's own Date is the reference instant, so the hint+      -- does not inherit this machine's clock skew.+      testCase "HTTP-date Retry-After is converted using the response Date header" $ do+        eventsRef <- newIORef []+        metaRef <- newIORef []+        resp <-+          mkResponse+            429+            [ ("Retry-After", "Wed, 21 Oct 2026 07:28:00 GMT"),+              ("Date", "Wed, 21 Oct 2026 07:27:15 GMT")+            ]+            ["{\"error\":{\"message\":\"slow down\"}}"]+        sseFromResponse resp (\md -> modifyIORef' metaRef (<> [md])) (\ev -> modifyIORef' eventsRef (<> [ev]))+        events <- readIORef eventsRef+        case events of+          [Left e] -> do+            category e @?= RateLimited+            retryAfterSeconds e @?= Just 45+          other -> assertFailure ("expected one classified error, got: " <> show other),+      testCase "HTTP-date Retry-After without a Date header uses the current time" $ do+        eventsRef <- newIORef []+        metaRef <- newIORef []+        resp <- mkResponse 429 [("Retry-After", "Wed, 21 Oct 2099 07:28:00 GMT")] [""]+        sseFromResponse resp (\md -> modifyIORef' metaRef (<> [md])) (\ev -> modifyIORef' eventsRef (<> [ev]))+        events <- readIORef eventsRef+        case events of+          [Left e] -> case retryAfterSeconds e of+            Just n -> assertBool ("a date in 2099 is far in the future, got " <> show n) (n > 0)+            Nothing -> assertFailure "expected a converted Retry-After hint"+          other -> assertFailure ("expected one classified error, got: " <> show other),       testCase "200 response decodes split SSE data frames in order" $ do         eventsRef <- newIORef []+        metaRef <- newIORef []         resp <-           mkResponse             200@@ -40,14 +95,376 @@               "\"usage\":{\"input_tokens\":3,\"output_tokens\":0}}}\r\n\r\n",               "data: {\"type\":\"message_stop\"}\n\n"             ]-        sseFromResponse resp (\ev -> modifyIORef' eventsRef (<> [ev]))+        sseFromResponse resp (\md -> modifyIORef' metaRef (<> [md])) (\ev -> modifyIORef' eventsRef (<> [ev]))         events <- readIORef eventsRef         case events of           [Right Messages.Message_Start {Messages.message = msg}, Right Messages.Message_Stop] ->             msg ^. #id @?= "msg_1"-          other -> assertFailure ("expected message_start then message_stop, got: " <> show other)+          other -> assertFailure ("expected message_start then message_stop, got: " <> show other),+      observationTests,+      requestShapeTests,+      redirectTests     ] +-- | What the transport and the assembler between them can say about+-- what Anthropic reported, as opposed to what was configured.+--+-- The fixture's @model@ deliberately differs from the model the+-- assembler was built with. If they matched, a bug that read the+-- caller's configuration instead of the provider's event would pass+-- these assertions, which is exactly the substitution the 'Observed'+-- type exists to prevent.+observationTests :: TestTree+observationTests =+  testGroup+    "response observation"+    [ testCase "a 200 response yields one metadata value carrying request-id" $ do+        (metas, _) <- replay 200 [("request-id", "req_abc123"), ("x-api-key", "sk-leak")] successBody+        case metas of+          [md] -> do+            md ^. #httpStatus @?= 200+            -- Allow-list, not denylist: the credential-shaped header the+            -- fixture also carries must not be recorded.+            md ^. #headers @?= [("request-id", "req_abc123")]+          other -> assertFailure ("expected exactly one metadata value, got: " <> show other),+      testCase "partial and repeated usage snapshots preserve reported cache categories" $ do+        let start = frameOf "{\"type\":\"message_start\",\"message\":{\"id\":\"msg_usage\",\"type\":\"message\",\"role\":\"assistant\",\"content\":[],\"model\":\"claude-test\",\"stop_reason\":null,\"stop_sequence\":null,\"usage\":{\"input_tokens\":10,\"output_tokens\":0,\"cache_read_input_tokens\":20}}}"+            partial = frameOf "{\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},\"usage\":{\"output_tokens\":100}}"+            final = frameOf "{\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},\"usage\":{\"output_tokens\":100,\"cache_creation_input_tokens\":30}}"+        (_, before) <- replayTranslate [start, partial]+        (before ^. #usage) ^. #availability @?= Just (Usage.UsageAvailability (Set.singleton Usage.CacheWriteUsage) False Set.empty)+        (_, once) <- replayTranslate [start, partial, final]+        (_, twice) <- replayTranslate [start, partial, final, final]+        once ^. #usage @?= twice ^. #usage+        (once ^. #usage) ^. #totalTokens @?= 160+        (once ^. #usage) ^. #availability @?= Just (Usage.UsageAvailability Set.empty False Set.empty)+        let (_, failed) = translate (Left (providerUnavailable "reset")) once testTime+        failed ^. #usage @?= once ^. #usage,+      testCase "the observed model comes from message_start, not the configured model" $ do+        (_, ass) <- replay 200 [("request-id", "req_abc123")] successBody+        ass ^. #observedModel @?= Observed "claude-haiku-4-5-20990101-server-side"+        -- Asserted as a difference rather than against a literal+        -- catalog id, which is generated and moves.+        assertBool+          "the fixture's model must differ from the configured one"+          (ass ^. #observedModel /= Observed (anthropic_claude_haiku_4_5 ^. #modelId))+        ass ^. #responseId @?= Just "msg_observed"+        ass ^. #usageReported @?= True,+      testCase "a failed response still yields metadata, and observes no model" $ do+        (metas, ass) <-+          replay+            429+            [("request-id", "req_failed")]+            ["{\"type\":\"error\",\"error\":{\"type\":\"rate_limit_error\",\"message\":\"slow\"}}"]+        case metas of+          [md] -> do+            md ^. #httpStatus @?= 429+            md ^. #headers @?= [("request-id", "req_failed")]+          other -> assertFailure ("expected exactly one metadata value, got: " <> show other)+        ass ^. #observedModel @?= Unobserved+        ass ^. #usageReported @?= False,+      testCase "a gateway header is captured when Anthropic's own is absent" $ do+        (metas, _) <- replay 200 [("cf-ray", "ray-9"), ("x-request-id", "gw-1")] successBody+        case metas of+          -- Recorded in the order the response listed them; the+          -- adapter's preference order lives in capturedHeaderNames.+          [md] -> md ^. #headers @?= [("cf-ray", "ray-9"), ("x-request-id", "gw-1")]+          other -> assertFailure ("expected exactly one metadata value, got: " <> show other),+      failureStreamTests,+      blockClosingTests+    ]++-- | How blocks close when something goes wrong, and what the transport+-- does with a frame it was not written for.+--+-- The point of the group is that a consumer reading raw events and a+-- consumer reassembling them see the same partial output, and that a+-- frame Anthropic adds later does not end a healthy stream.+blockClosingTests :: TestTree+blockClosingTests =+  testGroup+    "block closing under failure"+    [ testCase "fast terminal pricing follows observed speed, including missing observations" $ do+        forM_ [(Just "fast", 1 / 50, Set.empty), (Just "standard", 1 / 100, Set.empty), (Nothing, 1 / 100, Set.singleton SpeedNotReported)] $ \(observed, expected, reasons) -> do+          let speedJson = maybe "" (\v -> ",\"speed\":\"" <> v <> "\"") observed+              body = [frameOf ("{\"type\":\"message_start\",\"message\":{\"id\":\"msg_fast\",\"type\":\"message\",\"role\":\"assistant\",\"content\":[],\"model\":\"claude-opus-5\",\"stop_reason\":null,\"stop_sequence\":null,\"usage\":{\"input_tokens\":0,\"output_tokens\":0,\"cache_read_input_tokens\":0,\"cache_creation_input_tokens\":1000,\"service_tier\":\"standard\"" <> speedJson <> "}}}"), frameOf "{\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},\"usage\":{\"output_tokens\":0}}", frameOf "{\"type\":\"message_stop\"}"]+          response <- streamingComplete (claudeMessagesStreamWith (replayDriver 200 [] body)) anthropic_claude_opus_5 emptyContext (testOptions & #cacheRetention .~ Just CacheRetentionLong & #speed .~ Just SpeedFast)+          response ^. #message . #usage . #cost . #usd @?= expected+          response ^. #message . #usage . #cost . #basis . #estimateReasons @?= reasons,+      testCase "Fable cache writes use the shaped duration including compatibility downgrades" $ do+        let fable = anthropic_claude_fable_5_1+            downgraded = fable & #compat .~ CompatAnthropicMessages (anthropicMessagesCompatFor fable & #supportsLongCacheRetention .~ False)+            body = [frameOf "{\"type\":\"message_start\",\"message\":{\"id\":\"msg_cost\",\"type\":\"message\",\"role\":\"assistant\",\"content\":[],\"model\":\"claude-fable-5-1\",\"stop_reason\":null,\"stop_sequence\":null,\"usage\":{\"input_tokens\":0,\"output_tokens\":0,\"cache_read_input_tokens\":0,\"cache_creation_input_tokens\":1000,\"service_tier\":\"standard\",\"speed\":\"standard\"}}}", frameOf "{\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},\"usage\":{\"output_tokens\":0}}", frameOf "{\"type\":\"message_stop\"}"]+        forM_ [(fable, CacheRetentionLong, 1 / 50), (fable, CacheRetentionShort, 1 / 80), (downgraded, CacheRetentionLong, 1 / 80)] $ \(m, duration, expected) -> do+          response <- streamingComplete (claudeMessagesStreamWith (replayDriver 200 [] body)) m emptyContext (testOptions & #cacheRetention .~ Just duration)+          response ^. #message . #usage . #cost . #usd @?= expected+          response ^. #message . #usage . #cost . #basis . #estimateReasons @?= Set.empty+          fmap Usage.billingFacts (response ^. #message . #usage . #availability) @?= Just (Set.fromList [Usage.BillingServiceTier "standard", Usage.BillingSpeed "standard"]),+      testCase "a tool call cut off by max_tokens closes with its raw argument text" $ do+        events <- replayStream 200 [] cutOffToolBody+        let calls = [tc | ToolCallEnd ToolCallEndPayload {toolCall = tc} <- events]+        case calls of+          [tc] -> do+            tc ^. #arguments @?= Aeson.String "{\"query\":\"hel"+            assertBool "the call is marked cut off" (isCutOffToolCall tc)+          other -> assertFailure ("expected exactly one ToolCallEnd, got: " <> show (length other))+        case reverse events of+          (EventDone TerminalPayload {reason = r, message = msg} : _) -> do+            r @?= Length+            [tc | AssistantToolCall tc <- Vector.toList (messageBlocks msg)] @?= calls+          other -> assertFailure ("expected a terminal EventDone, got: " <> show (take 1 other)),+      testCase "a refusal stop is ContentFiltered, not an unclassified provider error" $ do+        events <- replayStream 200 [] refusalBody+        assertErrorContract events+        case reverse events of+          (EventError TerminalPayload {errorInfo = Just be} : _) -> do+            -- The content, not the transport, is the problem: its own+            -- category, and not retryable as sent.+            be ^. #category @?= ContentFiltered+            isRetryable be @?= False+          other -> assertFailure ("expected a terminal EventError, got: " <> show (take 1 other)),+      refusalDetailTests,+      testCase "a mid-stream transport error closes open blocks before the terminal" $ do+        -- The failure is injected through 'translate' rather than the+        -- transport, because what is under test is the assembler's+        -- Left path: a classified error arriving with a text block open.+        (openEvents, ass) <- replayTranslate openTextBody+        let (failEvents, _) = translate (Left (providerUnavailable "connection reset mid-stream")) ass testTime+        assertBool+          ("expected a text block to be open, got: " <> show openEvents)+          (not (null [() | TextStart {} <- openEvents]))+        case failEvents of+          [TextEnd BlockEndPayload {contentIndex = 0, content = body}, EventError TerminalPayload {message = msg}] -> do+            body @?= "partial"+            [t | AssistantText (TextContent t) <- Vector.toList (messageBlocks msg)] @?= ["partial"]+          other -> assertFailure ("expected TextEnd then EventError, got: " <> show other),+      testCase "an unknown event type is skipped without ending the stream" $ do+        events <-+          transportEvents+            200+            [ frameOf "{\"type\":\"message_stop\"}",+              frameOf "{\"type\":\"message_checkpoint\",\"checkpoint\":\"abc\"}",+              frameOf "{\"type\":\"ping\"}"+            ]+        assertAllRight events+        length events @?= 2,+      testCase "an unknown delta type is skipped without ending the stream" $ do+        events <-+          transportEvents+            200+            [ frameOf "{\"type\":\"message_stop\"}",+              frameOf "{\"type\":\"content_block_delta\",\"index\":0,\"delta\":{\"type\":\"citations_delta\",\"citation\":{}}}",+              frameOf "{\"type\":\"ping\"}"+            ]+        assertAllRight events+        length events @?= 2,+      testCase "an empty data heartbeat is ignored" $ do+        events <- transportEvents 200 ["data:\n\n", frameOf "{\"type\":\"message_stop\"}"]+        assertAllRight events+        length events @?= 1+    ]++-- | A stream that opens a tool call, streams half its arguments, and is+-- cut off by the output cap.+cutOffToolBody :: [ByteString]+cutOffToolBody =+  [ frameOf+      "{\"type\":\"message_start\",\"message\":{\"id\":\"msg_cutoff\",\"type\":\"message\",\"role\":\"assistant\",\"content\":[],\"model\":\"claude-cutoff\",\"stop_reason\":null,\"stop_sequence\":null,\"usage\":{\"input_tokens\":4,\"output_tokens\":0}}}",+    frameOf+      "{\"type\":\"content_block_start\",\"index\":0,\"content_block\":{\"type\":\"tool_use\",\"id\":\"toolu_1\",\"name\":\"search\",\"input\":{}}}",+    frameOf+      "{\"type\":\"content_block_delta\",\"index\":0,\"delta\":{\"type\":\"input_json_delta\",\"partial_json\":\"{\\\"query\\\":\\\"hel\"}}",+    frameOf "{\"type\":\"content_block_stop\",\"index\":0}",+    frameOf "{\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"max_tokens\",\"stop_sequence\":null},\"usage\":{\"output_tokens\":9}}",+    frameOf "{\"type\":\"message_stop\"}"+  ]++-- | A stream Anthropic ends with @stop_reason: "refusal"@: the model+-- declined to answer. Nothing failed on the wire.+refusalBody :: [ByteString]+refusalBody =+  [ frameOf+      "{\"type\":\"message_start\",\"message\":{\"id\":\"msg_refusal\",\"type\":\"message\",\"role\":\"assistant\",\"content\":[],\"model\":\"claude-refusal\",\"stop_reason\":null,\"stop_sequence\":null,\"usage\":{\"input_tokens\":3,\"output_tokens\":0}}}",+    frameOf "{\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"refusal\",\"stop_sequence\":null},\"usage\":{\"output_tokens\":1}}",+    frameOf "{\"type\":\"message_stop\"}"+  ]++-- | A stream that opens a text block and streams one delta into it,+-- and stops there: the state a mid-stream failure finds.+openTextBody :: [ByteString]+openTextBody =+  [ frameOf+      "{\"type\":\"message_start\",\"message\":{\"id\":\"msg_open\",\"type\":\"message\",\"role\":\"assistant\",\"content\":[],\"model\":\"claude-open\",\"stop_reason\":null,\"stop_sequence\":null,\"usage\":{\"input_tokens\":2,\"output_tokens\":0}}}",+    frameOf "{\"type\":\"content_block_start\",\"index\":0,\"content_block\":{\"type\":\"text\",\"text\":\"\"}}",+    frameOf "{\"type\":\"content_block_delta\",\"index\":0,\"delta\":{\"type\":\"text_delta\",\"text\":\"partial\"}}"+  ]++frameOf :: ByteString -> ByteString+frameOf body = "data: " <> body <> "\n\n"++-- | The raw events the transport produced, with no assembler involved.+transportEvents ::+  Int -> [ByteString] -> IO [Either BaikaiError Messages.MessageStreamEvent]+transportEvents status chunks = do+  eventsRef <- newIORef []+  resp <- mkResponse status [] chunks+  sseFromResponse resp (const (pure ())) (\ev -> modifyIORef' eventsRef (<> [ev]))+  readIORef eventsRef++assertAllRight :: [Either BaikaiError Messages.MessageStreamEvent] -> Assertion+assertAllRight events =+  case [e | Left e <- events] of+    [] -> pure ()+    errs -> assertFailure ("expected no transport errors, got: " <> show errs)++-- | Replay through the real transport and fold the result through the+-- real translator, returning both the events emitted and the assembler+-- state they left behind.+replayTranslate :: [ByteString] -> IO ([AssistantMessageEvent], Assembler)+replayTranslate chunks = do+  raw <- transportEvents 200 chunks+  pure+    ( foldl'+        ( \(acc, a) ev ->+            let (evs, a') = translate ev a testTime in (acc <> evs, a')+        )+        ([], emptyAssembler anthropic_claude_haiku_4_5 testTime)+        raw+    )++messageBlocks :: Message -> Vector AssistantContent+messageBlocks = \case+  AssistantMessage AssistantPayload {content = c} -> c+  _ -> Vector.empty++-- | Every way a Claude stream can fail before Anthropic has said+-- anything about the response.+--+-- The point of the group is one invariant: the protocol's+-- "'EventStart' first, exactly one terminal" holds even when the+-- failure precedes @message_start@, which is the frame that used to+-- carry the start event. Each case drains the whole provider stream+-- through the real transport, so what is asserted is what a consumer+-- would actually see.+failureStreamTests :: TestTree+failureStreamTests =+  testGroup+    "failure streams are protocol-conformant"+    [ testCase "an HTTP 401 before message_start is EventStart then one EventError" $ do+        events <-+          replayStream+            401+            []+            ["{\"type\":\"error\",\"error\":{\"type\":\"authentication_error\",\"message\":\"bad key\"}}"]+        assertErrorContract events+        terminalError events >>= \be -> category be @?= AuthError,+      testCase "an HTTP 429 before message_start keeps EventStart first and Retry-After on the terminal" $ do+        events <-+          replayStream+            429+            [("Retry-After", "7")]+            ["{\"type\":\"error\",\"error\":{\"type\":\"rate_limit_error\",\"message\":\"slow\"}}"]+        assertErrorContract events+        be <- terminalError events+        category be @?= RateLimited+        retryAfterSeconds be @?= Just 7,+      testCase "an in-band error event before message_start is EventStart then one EventError" $ do+        events <-+          replayStream+            200+            []+            ["data: {\"type\":\"error\",\"error\":{\"type\":\"overloaded_error\",\"message\":\"busy\"}}\n\n"]+        assertErrorContract events+        terminalError events >>= \be -> category be @?= TransientError,+      testCase "EOF before message_start is EventStart then one EventError" $ do+        events <- replayStream 200 [] []+        assertErrorContract events+        be <- terminalError events+        be ^. #message @?= "claude stream ended without message_stop",+      testCase "message_start updates the skeleton and emits no second EventStart" $ do+        events <- replayStream 200 [] successBody+        length [() | EventStart {} <- events] @?= 1+        case events of+          -- The pre-seeded start carries no id: Anthropic has not sent+          -- one yet when it is emitted.+          (EventStart StartPayload {responseId = rid} : _) -> rid @?= Nothing+          other -> assertFailure ("expected EventStart first, got: " <> show (take 1 other))+        case reverse events of+          (EventDone TerminalPayload {responseId = rid} : _) -> rid @?= Just "msg_observed"+          other -> assertFailure ("expected a terminal EventDone, got: " <> show (take 1 other))+        resp <- Stream.fold (reassembleResponse testModel) (Stream.fromList events)+        resp ^. #responseId @?= Just "msg_observed"+    ]++-- | Drain a recorded response as the provider stream a consumer sees.+replayStream :: Int -> [(ByteString, ByteString)] -> [ByteString] -> IO [AssistantMessageEvent]+replayStream status headers chunks =+  Stream.toList+    (claudeMessagesStreamWith (replayDriver status headers chunks) testModel emptyContext testOptions)++-- | A transport driver that serves a recorded response instead of+-- opening a socket. The same eleven lines as+-- @EvidenceSpec.replayDriver@; the two suites keep their own so neither+-- can silently change the other's fixtures.+replayDriver :: Int -> [(ByteString, ByteString)] -> [ByteString] -> SseDriver+replayDriver status headers chunks _call onMetadata onEvent = do+  resp <- mkResponse status headers chunks+  sseFromResponse resp onMetadata onEvent++-- | The typed error on a stream's terminal. 'errorInfo' is a 'Maybe';+-- whether a failed stream carries a typed error at all is part of what+-- these cases assert.+terminalError :: [AssistantMessageEvent] -> IO BaikaiError+terminalError events = case reverse events of+  (EventError TerminalPayload {errorInfo = Just be} : _) -> pure be+  other -> assertFailure ("expected a terminal EventError carrying errorInfo, got: " <> show (take 1 other))++testModel :: Model+testModel =+  anthropic_claude_haiku_4_5+    & #api .~ AnthropicMessages+    & #baseUrl .~ "https://api.anthropic.com"++testOptions :: Options+testOptions = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "test-key")++-- | A complete successful stream whose reported model is not any model+-- in the catalog, so it cannot be confused with a configured one.+successBody :: [ByteString]+successBody =+  [ "data: {\"type\":\"message_start\",\"message\":{\"id\":\"msg_observed\",\"type\":\"message\",",+    "\"role\":\"assistant\",\"content\":[],\"model\":\"claude-haiku-4-5-20990101-server-side\",",+    "\"stop_reason\":null,\"stop_sequence\":null,",+    "\"usage\":{\"input_tokens\":11,\"output_tokens\":0}}}\n\n",+    "data: {\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},",+    "\"usage\":{\"output_tokens\":5}}\n\n",+    "data: {\"type\":\"message_stop\"}\n\n"+  ]++-- | Drive a recorded response through the real transport and fold the+-- events it produces through the real translator.+replay ::+  Int -> [(ByteString, ByteString)] -> [ByteString] -> IO ([ResponseMetadata], Assembler)+replay status headers chunks = do+  metaRef <- newIORef []+  eventsRef <- newIORef []+  resp <- mkResponse status headers chunks+  sseFromResponse+    resp+    (\md -> modifyIORef' metaRef (<> [md]))+    (\ev -> modifyIORef' eventsRef (<> [ev]))+  metas <- readIORef metaRef+  events <- readIORef eventsRef+  let ass =+        foldl'+          (\acc ev -> snd (translate ev acc testTime))+          (emptyAssembler anthropic_claude_haiku_4_5 testTime)+          events+  pure (metas, ass)++testTime :: UTCTime+testTime = read "2026-07-03 12:00:00 UTC"+ mkResponse :: Int -> [(ByteString, ByteString)] -> [ByteString] -> IO (HTTP.Response HTTP.BodyReader) mkResponse status headers chunks = do   ref <- newIORef chunks@@ -67,3 +484,164 @@         HTTP.responseOriginalRequest = HTTP.defaultRequest,         HTTP.responseEarlyHints = []       }++-- --------------------------------------------------------------------+-- What goes on the wire+-- --------------------------------------------------------------------++-- | The composed path and the redirect policy, asserted on the pure+-- request rather than by opening a connection.+--+-- The path cases are the base-URL convention: `Model.baseUrl` is the API+-- root, baikai appends `/v1/messages` itself, and a trailing+-- `/v1` is removed rather than doubled — which is why+-- `https://api.deepseek.com/v1`, the spelling every OpenAI SDK teaches,+-- does not request `/v1/v1/...`.+requestShapeTests :: TestTree+requestShapeTests =+  testGroup+    "the request this transport sends"+    [ testCase "one version segment, whatever spelling the base URL used"+        $ forM_+          [ ("https://api.anthropic.com/v1", "/v1/messages"),+            ("https://api.anthropic.com", "/v1/messages"),+            ("https://gateway.test/anthropic", "/anthropic/v1/messages"),+            ("https://gateway.test/anthropic/v1/", "/anthropic/v1/messages")+          ]+        $ \(url, expected) -> case Http.canonicalBaseUrl url of+          Left problem -> assertFailure (Text.unpack (url <> " was refused: " <> problem))+          Right base -> do+            let request = buildRequest base [] (Aeson.object [])+            (url, HTTP.path request) @?= (url, S8.pack expected),+      testCase "the request never follows a redirect" $+        case Http.canonicalBaseUrl "https://h.test" of+          Left problem -> assertFailure (Text.unpack problem)+          Right base -> do+            let request = buildRequest base [] (Aeson.object [])+            HTTP.redirectCount request @?= 0+            HTTP.method request @?= "POST"+    ]++-- --------------------------------------------------------------------+-- A 3xx is an error, not a hop+-- --------------------------------------------------------------------++-- | A 302 is delivered as the terminal error and no second connection is+-- ever opened.+--+-- @http-client@'s default is to follow up to ten redirects with every+-- header intact, so before `redirectCount = 0` this test recorded a+-- second connection — to whatever host the `Location` header named —+-- carrying the caller's bearer token.+--+-- The "server" is an in-process fake built from `managerRawConnection`,+-- which is what lets the case observe /which hosts a connection was+-- opened to/ directly, with no socket and no port.+redirectTests :: TestTree+redirectTests =+  testGroup+    "redirects"+    [ testCase "a 302 is the terminal error and no second host is contacted" $ do+        attemptsRef <- newIORef []+        manager <- fakeRedirectingManager attemptsRef+        case Http.canonicalBaseUrl "http://proxy.test" of+          Left problem -> assertFailure (Text.unpack problem)+          Right base -> do+            let env = Client.mkClientEnv manager base+            eventsRef <- newIORef []+            metaRef <- newIORef []+            claudeSseStreamValueWithHeaders+              env+              [("Authorization", "Bearer sk-test")]+              (Aeson.object [])+              (\md -> modifyIORef' metaRef (<> [md]))+              (\ev -> modifyIORef' eventsRef (<> [ev]))+            attempts <- readIORef attemptsRef+            attempts @?= [("proxy.test", 80)]+            events <- readIORef eventsRef+            case events of+              [Left e] -> httpStatus e @?= Just 302+              other -> assertFailure ("expected one 302 error, got: " <> show other)+    ]++-- | A manager whose every connection answers one 302 pointing at another+-- host, and records the host and port it was opened to.+fakeRedirectingManager :: IORef [(String, Int)] -> IO HTTP.Manager+fakeRedirectingManager attemptsRef =+  HTTP.newManager+    HTTP.defaultManagerSettings+      { HTTP.managerRawConnection = pure open+      }+  where+    open _ host portNumber = do+      modifyIORef' attemptsRef (<> [(host, portNumber)])+      remaining <- newIORef [redirectResponse]+      HTTP.makeConnection+        (atomicModifyIORef' remaining (\chunks -> case chunks of [] -> ([], SBS.empty); (c : cs) -> (cs, c)))+        (\_ -> pure ())+        (pure ())+    redirectResponse =+      S8.pack+        "HTTP/1.1 302 Found\r\nLocation: http://evil.test/steal\r\nContent-Length: 0\r\n\r\n"++refusalDetailTests :: TestTree+refusalDetailTests =+  testGroup+    "refusal details"+    [ testCase "a categorised refusal names its category and explanation" $+        check (Just "cyber") (Just "Provider explanation"),+      testCase "unknown categories survive without an enum update" $+        check (Just "future_category") Nothing,+      testCase "an explanation survives without a category" $+        check Nothing (Just "Provider explanation"),+      testCase "null details preserve the original refusal message" $ do+        events <- replayStream 200 [] (refusalWithDetails Aeson.Null)+        be <- terminalError events+        be ^. #refusalCategory @?= Nothing+        be ^. #message @?= base,+      testCase "absent detail fields preserve the original refusal message" $+        check Nothing Nothing,+      testCase "explicit null category and explanation remain absent" $ do+        events <- replayStream 200 [] (refusalWithDetails (Aeson.object ["type" Aeson..= ("refusal" :: Text.Text), "category" Aeson..= Aeson.Null, "explanation" Aeson..= Aeson.Null]))+        be <- terminalError events+        be ^. #refusalCategory @?= Nothing+        be ^. #message @?= base,+      testCase "non-refusal completion does not turn stray details into an error" $ do+        let body = map (S8.pack . Text.unpack . Text.replace "\"stop_reason\":\"refusal\"" "\"stop_reason\":\"end_turn\"" . Text.pack . S8.unpack) (refusalWithDetails (detail (Just "cyber") Nothing))+        events <- replayStream 200 [] body+        case reverse events of+          EventDone TerminalPayload {errorInfo = Nothing} : _ -> pure ()+          other -> assertFailure (show other),+      testCase "blocking completion preserves the structured refusal" $ do+        response <- streamingComplete (claudeMessagesStreamWith (replayDriver 200 [] (refusalWithDetails (detail (Just "bio") Nothing)))) testModel emptyContext testOptions+        fmap (\be -> be ^. #refusalCategory) (response ^. #errorInfo) @?= Just (Just "bio")+    ]+  where+    base = "Anthropic refused to generate a response (stop_reason=refusal)"+    detail :: Maybe Text.Text -> Maybe Text.Text -> Aeson.Value+    detail c e = Aeson.object (["type" Aeson..= ("refusal" :: Text.Text)] <> maybe [] (\v -> ["category" Aeson..= v]) c <> maybe [] (\v -> ["explanation" Aeson..= v]) e)+    check c e = do+      events <- replayStream 200 [] (refusalWithDetails (detail c e))+      assertErrorContract events+      be <- terminalError events+      be ^. #category @?= ContentFiltered+      isRetryable be @?= False+      be ^. #refusalCategory @?= c+      be ^. #message @?= base <> maybe "" (\v -> " [category=" <> v <> "]") c <> maybe "" (": " <>) e++refusalWithDetails :: Aeson.Value -> [ByteString]+refusalWithDetails details =+  take 1 refusalBody+    <> [ frameOf+           ( LBS.toStrict+               ( Aeson.encode+                   ( Aeson.object+                       [ "type" Aeson..= ("message_delta" :: Text.Text),+                         "delta" Aeson..= Aeson.object ["stop_reason" Aeson..= ("refusal" :: Text.Text), "stop_details" Aeson..= details],+                         "usage" Aeson..= Aeson.object ["output_tokens" Aeson..= (1 :: Int)]+                       ]+                   )+               )+           ),+         frameOf "{\"type\":\"message_stop\"}"+       ]
test/ThinkingSpec.hs view
@@ -4,17 +4,25 @@  import Baikai import Baikai.Models.Generated-import Baikai.Provider.Claude.Api (Assembler, emptyAssembler, translate)-import Baikai.Provider.Claude.Internal.Request (mapRequest)+import Baikai.Provider.Claude.Internal.Request+  ( describeThinkingFor,+    mapRequest,+    normalizeToolCallId,+    uncappedMaxTokensFloor,+  )+import Baikai.Provider.Claude.Internal.Stream (Assembler, emptyAssembler, translate) import Claude.V1.Messages qualified as Messages import Control.Lens ((&), (.~), (^.)) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as BSL+import Data.Char qualified as Char import Data.Generics.Labels () import Data.IntMap.Strict qualified as IntMap+import Data.List qualified as List import Data.Text qualified as Text import Data.Time.Clock (UTCTime) import Data.Vector qualified as Vector+import Numeric.Natural (Natural) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) @@ -22,7 +30,16 @@ tests =   testGroup     "ThinkingSpec"-    [ testGroup "mapRequest max_tokens" (neverExceedsCapTests <> styleTests),+    [ testCase "foreign opaque reasoning cannot enter this endpoint" $ do+        let thought = emptyThinkingContent & #replayState .~ Just (ThinkingReplay OpenAIResponses "gpt-6-astra" (Vector.singleton (Aeson.object [])))+            response = emptyResponse & #message . #content .~ Vector.singleton (AssistantThinking thought)+            ctx = addResponse response emptyContext+        case mapRequest anthropic_claude_fable_5_1 ctx emptyOptions of+          Left _ -> pure ()+          Right _ -> assertFailure "foreign state was silently accepted",+      testGroup "mapRequest max_tokens" (neverExceedsCapTests <> styleTests),+      translationTableTests,+      conditionalDowngradeTests,       adaptiveHigherEffortTests,       maxBudgetTest,       explicitMaxTokensTest,@@ -30,19 +47,39 @@       tooSmallCapDropsThinkingTest,       mergedOutputConfigTest,       explicitCompatOverridesDefaultTest,+      anthropicModelsCoverCatalogTest,+      testGroup "fast-mode catalog facts" [testCase name ((anthropicMessagesCompatFor m ^. #supportsFastMode) @?= fast) | (name, m, _, _, _, fast) <- anthropicModels],+      testGroup "forced-tool catalog facts" [testCase name ((anthropicMessagesCompatFor m ^. #supportsForcedToolChoice) @?= forced) | (name, m, _, _, forced, _) <- anthropicModels],+      samplingTests,+      claude15UsageTests,+      zeroCapFloorTests,+      replaySanitationTests,+      toolIdTests,       streamFidelityTests     ] -anthropicModels :: [(String, Model, AnthropicThinkingStyle)]+-- | Every Anthropic model in the generated catalog, with the three+-- request-shaping facts its compat record states. Written out by hand+-- rather than read off the record, so a catalog refresh that changes a+-- generation's wire shape fails a row here instead of quietly agreeing+-- with itself. The last column is+-- 'Baikai.Compat.supportsForcedToolChoice'.+--+-- @anthropicModelsCoverCatalogTest@ ties the table to @allModels@, so a+-- newly curated model cannot arrive unpinned.+anthropicModels :: [(String, Model, AnthropicThinkingStyle, Bool, Bool, Bool)] anthropicModels =-  [ ("claude-fable-5", anthropic_claude_fable_5, AnthropicThinkingAdaptive),-    ("claude-haiku-4-5", anthropic_claude_haiku_4_5, AnthropicThinkingBudget),-    ("claude-opus-4-5", anthropic_claude_opus_4_5, AnthropicThinkingBudget),-    ("claude-opus-4-6", anthropic_claude_opus_4_6, AnthropicThinkingAdaptive),-    ("claude-opus-4-7", anthropic_claude_opus_4_7, AnthropicThinkingAdaptive),-    ("claude-opus-4-8", anthropic_claude_opus_4_8, AnthropicThinkingAdaptive),-    ("claude-sonnet-4-5", anthropic_claude_sonnet_4_5, AnthropicThinkingBudget),-    ("claude-sonnet-4-6", anthropic_claude_sonnet_4_6, AnthropicThinkingBudget)+  [ ("claude-fable-5", anthropic_claude_fable_5, AnthropicThinkingAdaptive, False, True, False),+    ("claude-fable-5-1", anthropic_claude_fable_5_1, AnthropicThinkingAdaptive, False, False, False),+    ("claude-haiku-4-5", anthropic_claude_haiku_4_5, AnthropicThinkingBudget, True, True, False),+    ("claude-opus-4-5", anthropic_claude_opus_4_5, AnthropicThinkingBudget, True, True, False),+    ("claude-opus-4-6", anthropic_claude_opus_4_6, AnthropicThinkingAdaptive, True, True, False),+    ("claude-opus-4-7", anthropic_claude_opus_4_7, AnthropicThinkingAdaptive, False, True, False),+    ("claude-opus-4-8", anthropic_claude_opus_4_8, AnthropicThinkingAdaptive, False, True, True),+    ("claude-opus-5", anthropic_claude_opus_5, AnthropicThinkingAdaptive, False, True, True),+    ("claude-sonnet-4-5", anthropic_claude_sonnet_4_5, AnthropicThinkingBudget, True, True, False),+    ("claude-sonnet-4-6", anthropic_claude_sonnet_4_6, AnthropicThinkingAdaptive, True, True, False),+    ("claude-sonnet-5", anthropic_claude_sonnet_5, AnthropicThinkingAdaptive, False, True, False)   ]  thinkingLevels :: [(String, ThinkingLevel)]@@ -59,9 +96,9 @@ neverExceedsCapTests =   [ testCase (name <> " " <> levelName <> " stays within catalog cap") $ do       req <- requestFor model (emptyOptions & #thinking .~ Just level)-      Messages.max_tokens req <= model ^. #maxOutputTokens+      req ^. #max_tokens <= model ^. #maxOutputTokens         @?= True-  | (name, model, _) <- anthropicModels,+  | (name, model, _, _, _, _) <- anthropicModels,     (levelName, level) <- thinkingLevels   ] @@ -76,16 +113,120 @@             @?= Just Messages.ThinkingEnabled {Messages.budget_tokens = expectedBudget}           assertBool             "max_tokens leaves visible-output room beyond budget"-            (Messages.max_tokens req > expectedBudget)+            (req ^. #max_tokens > expectedBudget)         AnthropicThinkingAdaptive -> do-          requestThinking req @?= Just Messages.ThinkingAdaptive-          Messages.max_tokens req @?= model ^. #maxOutputTokens-          (Messages.output_config req >>= Messages.effort)+          requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)+          req ^. #max_tokens @?= model ^. #maxOutputTokens+          (req ^. #output_config >>= Messages.effort)             @?= adaptiveEffort level-  | (name, model, style) <- anthropicModels,+  | (name, model, style, _, _, _) <- anthropicModels,     (levelName, level) <- thinkingLevels   ] +-- | Every canonical level against both Anthropic thinking styles, with+-- the exact effort text, exact budget, and exact adjustment list each+-- one produces.+--+-- The expected values are written out rather than computed from the+-- functions under test, so a change to either mapping fails a row here+-- instead of quietly agreeing with itself. A failing row is either a+-- transcription error or a real behaviour change, and the two must be+-- told apart before either side is edited.+translationTable ::+  [(AnthropicThinkingStyle, ThinkingLevel, Maybe Text.Text, Maybe Natural, [ThinkingAdjustment])]+translationTable =+  [ -- A token budget expresses every level exactly: nothing is adjusted.+    (AnthropicThinkingBudget, ThinkingMinimal, Nothing, Just 1024, []),+    (AnthropicThinkingBudget, ThinkingLow, Nothing, Just 2048, []),+    (AnthropicThinkingBudget, ThinkingMedium, Nothing, Just 8192, []),+    (AnthropicThinkingBudget, ThinkingHigh, Nothing, Just 16384, []),+    (AnthropicThinkingBudget, ThinkingXHigh, Nothing, Just 24576, []),+    (AnthropicThinkingBudget, ThinkingMax, Nothing, Just 32768, []),+    -- Anthropic's adaptive vocabulary has no "minimal", so the lowest+    -- level is clamped up to "low" and says so.+    ( AnthropicThinkingAdaptive,+      ThinkingMinimal,+      Just "low",+      Nothing,+      [EffortClamped ThinkingMinimal "low"]+    ),+    (AnthropicThinkingAdaptive, ThinkingLow, Just "low", Nothing, []),+    (AnthropicThinkingAdaptive, ThinkingMedium, Just "medium", Nothing, []),+    -- "high" sends no effort field at all, which on the wire is+    -- indistinguishable from expressing no preference.+    ( AnthropicThinkingAdaptive,+      ThinkingHigh,+      Nothing,+      Nothing,+      [EffortOmitted ThinkingHigh]+    ),+    (AnthropicThinkingAdaptive, ThinkingXHigh, Just "xhigh", Nothing, []),+    (AnthropicThinkingAdaptive, ThinkingMax, Just "max", Nothing, [])+  ]++translationTableTests :: TestTree+translationTableTests =+  testGroup+    "thinking translation table"+    [ testCase (show style <> " " <> Text.unpack (renderThinkingLevel level)) $ do+        t <- translationFor (modelWithStyle style) (emptyOptions & #thinking .~ Just level)+        t ^. #requested @?= Just level+        t ^. #mode @?= expectedMode+        t ^. #effortText @?= expectedEffort+        t ^. #budgetTokens @?= expectedBudget+        t ^. #wireField @?= Just "thinking"+        t ^. #adjustments @?= expectedAdjustments+    | (style, level, expectedEffort, expectedBudget, expectedAdjustments) <- translationTable,+      let expectedMode = case style of+            AnthropicThinkingBudget -> ThinkingModeBudget+            AnthropicThinkingAdaptive -> ThinkingModeAdaptive+    ]++-- | A reasoning model whose thinking style is pinned explicitly, so a+-- row of the table above depends on the style it names rather than on+-- which model generation happens to default to it.+modelWithStyle :: AnthropicThinkingStyle -> Model+modelWithStyle style =+  anthropic_claude_haiku_4_5+    & #compat .~ CompatAnthropicMessages (defaultAnthropicMessagesCompat {thinkingStyle = style})++-- | The two downgrades that depend on the model rather than the level:+-- a model that cannot reason at all, and an output ceiling too small to+-- hold the budget the level asks for. Neither was visible anywhere in+-- baikai's output before this plan.+conditionalDowngradeTests :: TestTree+conditionalDowngradeTests =+  testGroup+    "conditional thinking downgrades"+    [ testCase "a non-reasoning model drops thinking and records why" $ do+        let model = anthropic_claude_haiku_4_5 & #reasoning .~ False+        req <- requestFor model (emptyOptions & #thinking .~ Just ThinkingMedium)+        requestThinking req @?= Nothing+        t <- translationFor model (emptyOptions & #thinking .~ Just ThinkingMedium)+        t ^. #requested @?= Just ThinkingMedium+        t ^. #mode @?= ThinkingModeUnsupported+        t ^. #wireField @?= Nothing+        t ^. #budgetTokens @?= Nothing+        t ^. #adjustments @?= [ThinkingDroppedUnsupportedModel ThinkingMedium],+      testCase "an output ceiling at or below the budget drops thinking and names both numbers" $ do+        -- 1000 is below ThinkingMinimal's 1024-token budget, so the+        -- resolved ceiling collapses onto the cap and the budget can no+        -- longer fit inside it.+        let model = anthropic_claude_haiku_4_5 & #maxOutputTokens .~ 1000+            opts = emptyOptions & #thinking .~ Just ThinkingMinimal+        req <- requestFor model opts+        requestThinking req @?= Nothing+        req ^. #max_tokens @?= 1000+        t <- translationFor model opts+        t ^. #requested @?= Just ThinkingMinimal+        t ^. #mode @?= ThinkingModeUnsupported+        t ^. #wireField @?= Nothing+        t ^. #budgetTokens @?= Nothing+        t ^. #effortText @?= Nothing+        t ^. #adjustments+          @?= [ThinkingDroppedBudgetExceeded ThinkingMinimal 1024 1000]+    ]+ adaptiveHigherEffortTests :: TestTree adaptiveHigherEffortTests =   testGroup@@ -95,8 +236,8 @@           requestFor             anthropic_claude_opus_4_7             (emptyOptions & #thinking .~ Just level)-        requestThinking req @?= Just Messages.ThinkingAdaptive-        (Messages.output_config req >>= Messages.effort) @?= Just expected+        requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)+        (req ^. #output_config >>= Messages.effort) @?= Just expected     | (name, level, expected) <-         [ ("xhigh is preserved", ThinkingXHigh, "xhigh"),           ("max is preserved", ThinkingMax, "max")@@ -114,7 +255,7 @@       @?= Just Messages.ThinkingEnabled {Messages.budget_tokens = 32768}     assertBool       "max_tokens leaves visible-output room beyond the max thinking budget"-      (Messages.max_tokens req > 32768)+      (req ^. #max_tokens > 32768)  explicitMaxTokensTest :: TestTree explicitMaxTokensTest =@@ -127,7 +268,7 @@     req <- requestFor anthropic_claude_haiku_4_5 opts     requestThinking req       @?= Just Messages.ThinkingEnabled {Messages.budget_tokens = budget}-    Messages.max_tokens req @?= anthropic_claude_haiku_4_5 ^. #maxOutputTokens+    req ^. #max_tokens @?= anthropic_claude_haiku_4_5 ^. #maxOutputTokens  handRolledUnclampedTest :: TestTree handRolledUnclampedTest =@@ -145,7 +286,7 @@             & #maxTokens .~ Just 100         expected = 100 + thinkingTokenBudget ThinkingLow     req <- requestFor model opts-    Messages.max_tokens req @?= expected+    req ^. #max_tokens @?= expected  tooSmallCapDropsThinkingTest :: TestTree tooSmallCapDropsThinkingTest =@@ -156,7 +297,7 @@         opts = emptyOptions & #thinking .~ Just ThinkingMinimal     req <- requestFor model opts     requestThinking req @?= Nothing-    Messages.max_tokens req @?= 1000+    req ^. #max_tokens @?= 1000  mergedOutputConfigTest :: TestTree mergedOutputConfigTest =@@ -166,11 +307,11 @@           emptyOptions             & #thinking .~ Just ThinkingMedium             & #responseFormat-              .~ Just (JsonSchema {name = "answer", schema = schema, strict = True})+              .~ Just (JsonSchema (jsonSchemaFormat "answer" schema) {strict = True})         expected = (Messages.jsonSchemaConfig schema) {Messages.effort = Just "medium"}     req <- requestFor anthropic_claude_opus_4_6 opts-    requestThinking req @?= Just Messages.ThinkingAdaptive-    Messages.output_config req @?= Just expected+    requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)+    req ^. #output_config @?= Just expected  explicitCompatOverridesDefaultTest :: TestTree explicitCompatOverridesDefaultTest =@@ -184,13 +325,20 @@             & #compat .~ CompatAnthropicMessages compat         opts = emptyOptions & #thinking .~ Just ThinkingLow     req <- requestFor model opts-    requestThinking req @?= Just Messages.ThinkingAdaptive-    (Messages.output_config req >>= Messages.effort) @?= Just "low"+    requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)+    (req ^. #output_config >>= Messages.effort) @?= Just "low"  requestFor :: Model -> Options -> IO Messages.CreateMessage-requestFor model opts = case mapRequest model emptyContext opts of+requestFor model opts = fst <$> mappedFor model emptyContext opts++translationFor :: Model -> Options -> IO ThinkingTranslation+translationFor model opts = snd <$> mappedFor model emptyContext opts++mappedFor ::+  Model -> Context -> Options -> IO (Messages.CreateMessage, ThinkingTranslation)+mappedFor model ctx opts = case mapRequest model ctx opts of   Left e -> assertFailure ("mapRequest failed: " <> Text.unpack e)-  Right req -> pure req+  Right mapped -> pure mapped  requestThinking :: Messages.CreateMessage -> Maybe Messages.Thinking requestThinking Messages.CreateMessage {Messages.thinking = t} = t@@ -204,6 +352,335 @@   ThinkingXHigh -> Just "xhigh"   ThinkingMax -> Just "max" +-- | The pinned table above must name exactly the catalog's Anthropic+-- ids. Without this, curating a new generation into the catalog adds a+-- model nothing checks, which is how @claude-sonnet-5@ shipped with the+-- wrong thinking shape in the first place.+anthropicModelsCoverCatalogTest :: TestTree+anthropicModelsCoverCatalogTest =+  testCase "anthropicModels covers exactly the catalog's Anthropic ids" $+    List.sort [m ^. #modelId | (_, m, _, _, _, _) <- anthropicModels]+      @?= List.sort [m ^. #modelId | m <- allModels, m ^. #api == AnthropicMessages]++-- | Sampling parameters against the catalog's own record.+--+-- The adaptive-era generations reject @temperature@, @top_p@ and+-- @top_k@ with a 400, so baikai omits them and records the omission+-- rather than sending a request it knows will fail. The generations+-- that accept them get them verbatim, and nothing is recorded.+samplingTests :: TestTree+samplingTests =+  testGroup+    "sampling parameters follow the catalog record"+    ( [ testCase (name <> " " <> verb) $ do+          let opts = emptyOptions & #temperature .~ Just 0.2 & #topP .~ Just 0.9+          req <- requestFor model opts+          t <- translationFor model opts+          if supported+            then do+              Messages.temperature req @?= Just 0.2+              Messages.top_p req @?= Just 0.9+              filter isSamplingAdjustment (t ^. #adjustments) @?= []+            else do+              Messages.temperature req @?= Nothing+              Messages.top_p req @?= Nothing+              filter isSamplingAdjustment (t ^. #adjustments)+                @?= [SamplingDroppedUnsupportedModel ["temperature", "top_p"]]+      | (name, model, _, supported, _, _) <- anthropicModels,+        let verb = if supported then "forwards temperature and top_p" else "drops temperature and top_p and records it"+      ]+        <> [ testCase "sampling is dropped and recorded even when no thinking level is set" $ do+               -- The adjustment list is not only about thinking. A call+               -- that asked for no thinking at all still reports what+               -- happened to its sampling parameters.+               let opts = emptyOptions & #temperature .~ Just 0.2+               req <- requestFor anthropic_claude_sonnet_5 opts+               t <- translationFor anthropic_claude_sonnet_5 opts+               Messages.temperature req @?= Nothing+               t ^. #mode @?= ThinkingModeAbsent+               t ^. #requested @?= Nothing+               t ^. #adjustments @?= [SamplingDroppedUnsupportedModel ["temperature"]],+             testCase "only the parameters the caller actually set are named" $ do+               let opts = emptyOptions & #topP .~ Just 0.9+               t <- translationFor anthropic_claude_sonnet_5 opts+               t ^. #adjustments @?= [SamplingDroppedUnsupportedModel ["top_p"]],+             testCase "seed and penalties are recorded as API-level drops" $ do+               -- These three have no Anthropic Messages field on any+               -- generation, so they are dropped even on a model that+               -- accepts temperature.+               let opts =+                     emptyOptions+                       & #seed .~ Just 7+                       & #presencePenalty .~ Just 0.3+               t <- translationFor anthropic_claude_haiku_4_5 opts+               t ^. #adjustments+                 @?= [SamplingDroppedUnsupportedApi ["seed", "presence_penalty"]],+             testCase "a sampling drop does not refuse a strict call" $+               -- The gate refuses a call whose thinking would be+               -- weakened. A parameter the API never had is not that.+               checkEvidenceRequirements+                 (EvidenceRequired EvidenceRequestedOnly)+                 (declaredStrength AnthropicMessages)+                 (describeThinkingFor anthropic_claude_sonnet_5 (emptyOptions & #temperature .~ Just 0.2))+                 @?= []+           ]+    )++isSamplingAdjustment :: ThinkingAdjustment -> Bool+isSamplingAdjustment = \case+  SamplingDroppedUnsupportedModel {} -> True+  SamplingDroppedUnsupportedApi {} -> True+  _ -> False++-- | A model whose cap is unknown still needs a @max_tokens@.+--+-- Anthropic requires the field and rejects @0@, so a hand-rolled model+-- built from 'emptyModel' used to send @"max_tokens":0@ — and, with+-- thinking set, to have its whole thinking plan discarded because the+-- budget could not fit inside a ceiling of zero.+zeroCapFloorTests :: TestTree+zeroCapFloorTests =+  testGroup+    "a model with an unknown output cap sends the documented floor"+    [ testCase "hand-rolled model with unknown cap sends the 1024 floor" $ do+        req <- requestFor uncappedModel emptyOptions+        req ^. #max_tokens @?= uncappedMaxTokensFloor,+      testCase "the floor leaves room for a thinking budget" $ do+        let opts = emptyOptions & #thinking .~ Just ThinkingLow+        req <- requestFor uncappedModel opts+        t <- translationFor uncappedModel opts+        req ^. #max_tokens @?= uncappedMaxTokensFloor + thinkingTokenBudget ThinkingLow+        requestThinking req+          @?= Just Messages.ThinkingEnabled {Messages.budget_tokens = thinkingTokenBudget ThinkingLow}+        t ^. #adjustments @?= [],+      testCase "an explicit maxTokens of zero is forwarded as written" $ do+        -- The floor stands in for an unknown cap, not for a caller's+        -- own choice. Someone who wrote Just 0 gets 0.+        req <- requestFor uncappedModel (emptyOptions & #maxTokens .~ Just 0)+        req ^. #max_tokens @?= 0+    ]+  where+    uncappedModel =+      emptyModel+        & #modelId .~ "custom-claude"+        & #api .~ AnthropicMessages+        & #reasoning .~ True+        & #maxOutputTokens .~ 0++-- | Anthropic rejects an empty text block and an empty content array.+-- baikai can produce either from its own bookkeeping, so replay strips+-- them before they reach the wire.+replaySanitationTests :: TestTree+replaySanitationTests =+  testGroup+    "replay never sends an empty block or an empty turn"+    [ testCase "an assistant turn of only empty text is dropped entirely" $ do+        msgs <- mappedMessages [assistantBlocks [AssistantText (TextContent "")], user "next"]+        Vector.length msgs @?= 1+        (messageRole <$> (msgs Vector.!? 0)) @?= Just Messages.User,+      testCase "an empty text block beside a real one is dropped, the turn kept" $ do+        msgs <- mappedMessages [assistantBlocks [AssistantText (TextContent ""), AssistantText (TextContent "visible")]]+        Vector.length msgs @?= 1+        case msgs Vector.!? 0 of+          Just m -> Vector.length (messageContent m) @?= 1+          Nothing -> assertFailure "expected one message",+      testCase "an assistant turn of only unsigned thinking is dropped" $ do+        -- Unsigned thinking is already omitted block by block, because+        -- Anthropic rejects a thinking block without its signature.+        -- What is new is that the empty turn left behind goes too.+        msgs <-+          mappedMessages+            [ assistantBlocks+                [AssistantThinking ThinkingContent {thinking = "hmm", signature = Nothing, redacted = False, replayState = Nothing}],+              user "next"+            ]+        Vector.length msgs @?= 1,+      testCase "a tool call keeps its turn even beside empty text" $ do+        msgs <-+          mappedMessages+            [assistantBlocks [AssistantToolCall (ToolCall "toolu_1" "f" (Aeson.object [])), AssistantText (TextContent "")]]+        Vector.length msgs @?= 1+        case msgs Vector.!? 0 of+          Just m -> Vector.length (messageContent m) @?= 1+          Nothing -> assertFailure "expected one message",+      testCase "a user turn with nothing left in it is refused locally" $+        -- The caller's error, not baikai's: refused here with a better+        -- message than the provider's 400, and with the same category.+        case mapRequest anthropic_claude_haiku_4_5 (contextOf [userBlocks [UserText (TextContent "")]]) emptyOptions of+          Left e -> assertBool ("mentions the user turn: " <> Text.unpack e) ("user turn" `Text.isInfixOf` e)+          Right _ -> assertFailure "expected a user turn with no blocks to be refused"+    ]++-- | Tool-call ids are normalised on both sides of the round trip, so+-- the normalisation has to be injective enough that two distinct calls+-- in one turn never collapse onto one id.+toolIdTests :: TestTree+toolIdTests =+  testGroup+    "tool-call ids normalise without colliding"+    [ testCase "an Anthropic-minted id passes through unchanged" $+        normalizeToolCallId "toolu_01ABCdef" @?= "toolu_01ABCdef",+      testCase "an OpenAI-minted id passes through unchanged" $+        normalizeToolCallId "call_abc-123_x" @?= "call_abc-123_x",+      testCase "ids that used to collide no longer do" $ do+        -- Both used to sanitise to "a_b".+        normalizeToolCallId "a.b" /= normalizeToolCallId "a_b" @?= True+        assertValidId (normalizeToolCallId "a.b")+        assertValidId (normalizeToolCallId "a_b"),+      testCase "a long id is truncated to the limit with its hash suffix" $ do+        let long = Text.replicate 70 "x"+            normalised = normalizeToolCallId long+        Text.length normalised @?= 64+        Text.index normalised 51 @?= '_'+        assertValidId normalised,+      testCase "ids differing only past character 64 stay distinct" $+        normalizeToolCallId (Text.replicate 64 "x" <> "a")+          /= normalizeToolCallId (Text.replicate 64 "x" <> "b")+          @?= True,+      testCase "a call and the result answering it normalise to the same id" $ do+        msgs <-+          mappedMessages+            [ assistantBlocks [AssistantToolCall (ToolCall "a.b" "f" (Aeson.object []))],+              toolResult "a.b" "f" "done" False+            ]+        toolUseIds msgs @?= toolResultIds msgs,+      testCase "two tool calls with one id in a turn are refused" $+        case mapRequest+          anthropic_claude_haiku_4_5+          ( contextOf+              [ assistantBlocks+                  [ AssistantToolCall (ToolCall "dup" "f" (Aeson.object [])),+                    AssistantToolCall (ToolCall "dup" "g" (Aeson.object []))+                  ]+              ]+          )+          emptyOptions of+          Left e -> assertBool ("mentions the duplicate: " <> Text.unpack e) ("duplicate" `Text.isInfixOf` e)+          Right _ -> assertFailure "expected duplicate tool_use ids to be refused"+    ]+  where+    assertValidId i = do+      assertBool ("within 64 characters: " <> Text.unpack i) (Text.length i <= 64)+      assertBool ("no character outside the alphabet: " <> Text.unpack i) (Text.all ok i)+    ok c = (Char.isAscii c && Char.isAlphaNum c) || c == '_' || c == '-'+    toolUseIds msgs =+      [i | m <- Vector.toList msgs, Messages.Content_Tool_Use {Messages.id = i} <- Vector.toList (messageContent m)]+    toolResultIds msgs =+      [ i+      | m <- Vector.toList msgs,+        Messages.Content_Tool_Result {Messages.tool_use_id = i} <- Vector.toList (messageContent m)+      ]++-- | An assistant turn carrying exactly these blocks.+assistantBlocks :: [AssistantContent] -> Message+assistantBlocks blocks =+  AssistantMessage+    AssistantPayload+      { content = Vector.fromList blocks,+        usage = zeroUsage,+        stopReason = Stop,+        errorMessage = Nothing,+        timestamp = Just testTime+      }++-- | A user turn carrying exactly these blocks.+userBlocks :: [UserContent] -> Message+userBlocks blocks =+  UserMessage+    UserPayload+      { content = Vector.fromList blocks,+        timestamp = Just testTime+      }++mappedMessages :: [Message] -> IO (Vector.Vector Messages.Message)+mappedMessages msgs =+  requestMessages <$> requestForContext anthropic_claude_haiku_4_5 (contextOf msgs) emptyOptions++messageRole :: Messages.Message -> Messages.Role+messageRole Messages.Message {Messages.role = r} = r++-- | What @claude@ 1.5.0 added to the Messages response and what baikai+-- now reads off it. Each of these was unreadable before the bump:+-- 'Messages.Usage' had no thinking-token breakdown,+-- 'Messages.StreamUsage' carried only @output_tokens@, and+-- 'Messages.StopReason' had no @pause_turn@.+claude15UsageTests :: TestTree+claude15UsageTests =+  testGroup+    "the counts and stop reasons claude 1.5 reports"+    [ testCase "thinking tokens at message_start reach reasoningTokens" $ do+        let (_, ass) =+              runClaudeEvents+                [ messageStartWith+                    (startUsage 10)+                      { Messages.output_tokens_details =+                          Just Messages.OutputTokensDetails {Messages.thinking_tokens = 7}+                      }+                ]+        ass ^. #usage . #reasoningTokens @?= Just 7,+      testCase "no thinking-token breakdown leaves reasoningTokens unset" $ do+        let (_, ass) = runClaudeEvents [messageStart]+        ass ^. #usage . #reasoningTokens @?= Nothing,+      testCase "a message_delta's prompt-side counts replace the message_start figures" $ do+        -- A server-side tool run grows the prompt after message_start,+        -- and the final delta is the only place that says by how much.+        let (_, ass) =+              runClaudeEvents+                [ messageStartWith (startUsage 10),+                  messageDelta+                    (Just Messages.End_Turn)+                    (outputOnlyStreamUsage 12)+                      { Messages.stream_input_tokens = Just 40,+                        Messages.stream_cache_read_input_tokens = Just 5,+                        Messages.stream_cache_creation_input_tokens = Just 3,+                        Messages.stream_output_tokens_details =+                          Just Messages.OutputTokensDetails {Messages.thinking_tokens = 9}+                      }+                ]+            u = ass ^. #usage+        u ^. #inputTokens @?= 40+        u ^. #outputTokens @?= 12+        u ^. #cacheReadTokens @?= 5+        u ^. #cacheWriteTokens @?= 3+        u ^. #reasoningTokens @?= Just 9+        u ^. #totalTokens @?= 60,+      testCase "a message_delta that omits them keeps the message_start figures" $ do+        -- The pre-1.5 wire shape. Absent is not zero.+        let (_, ass) =+              runClaudeEvents+                [ messageStartWith+                    (startUsage 10)+                      { Messages.cache_read_input_tokens = Just 5,+                        Messages.cache_creation_input_tokens = Just 3+                      },+                  messageDelta (Just Messages.End_Turn) (outputOnlyStreamUsage 12)+                ]+            u = ass ^. #usage+        u ^. #inputTokens @?= 10+        u ^. #outputTokens @?= 12+        u ^. #cacheReadTokens @?= 5+        u ^. #cacheWriteTokens @?= 3+        u ^. #totalTokens @?= 30,+      testCase "a paused turn ends the stream as a stop, not an error" $ do+        -- Anthropic suspends the turn for a long-running server-side+        -- tool and expects the message back to continue it. Nothing+        -- failed, so the caller must not be handed an error.+        let (events, ass) =+              runClaudeEvents+                [ messageStart,+                  messageDelta (Just Messages.Pause_Turn) (outputOnlyStreamUsage 12),+                  Messages.Message_Stop+                ]+        ass ^. #stopReason @?= Stop+        case last events of+          EventDone TerminalPayload {reason = r, message = msg} -> do+            r @?= Stop+            case msg of+              AssistantMessage AssistantPayload {errorMessage = err} -> err @?= Nothing+              _ -> assertFailure "terminal message was not an assistant message"+          _ -> assertFailure "a paused turn produced a terminal error"+    ]+ streamFidelityTests :: TestTree streamFidelityTests =   testGroup@@ -214,13 +691,15 @@               ThinkingContent                 { thinking = "because therefore",                   signature = Just "sig-final",-                  redacted = False+                  redacted = False,+                  replayState = Nothing                 }             expectedRedacted =               ThinkingContent                 { thinking = "ENCRYPTED==",                   signature = Nothing,-                  redacted = True+                  redacted = True,+                  replayState = Nothing                 }         thinkingEnds events           @?= [expectedSigned, expectedRedacted]@@ -267,7 +746,8 @@                             ThinkingContent                               { thinking = "draft",                                 signature = Nothing,-                                redacted = False+                                redacted = False,+                                replayState = Nothing                               },                           AssistantText (TextContent "visible")                         ],@@ -342,9 +822,10 @@       { Messages.message_delta =           Messages.MessageDelta             { Messages.stop_reason = Just Messages.End_Turn,-              Messages.stop_sequence = Nothing+              Messages.stop_sequence = Nothing,+              Messages.stop_details = Nothing             },-        Messages.usage = Messages.StreamUsage {Messages.output_tokens = 12}+        Messages.usage = outputOnlyStreamUsage 12       },     Messages.Message_Stop   ]@@ -361,18 +842,82 @@             Messages.model = "claude-haiku-4-5",             Messages.stop_reason = Nothing,             Messages.stop_sequence = Nothing,-            Messages.usage =-              Messages.Usage-                { Messages.input_tokens = 10,-                  Messages.output_tokens = 0,-                  Messages.cache_creation_input_tokens = Nothing,-                  Messages.cache_read_input_tokens = Nothing,-                  Messages.server_tool_use = Nothing-                },+            Messages.stop_details = Nothing,+            Messages.usage = startUsage 10,             Messages.container = Nothing           }     } +-- | A @message_start@ usage reporting the given prompt tokens and+-- nothing else. Refine it by record update rather than respelling ten+-- fields; the ones this provider never reads — @inference_geo@,+-- @service_tier@, @speed@, @iterations@ — stay 'Nothing' so a test says+-- only what it means to say. The prompt count is an argument rather+-- than an update because @input_tokens@ alone does not name one record+-- in @claude@ 1.5.0, and a single-field update on it is ambiguous.+startUsage :: Natural -> Messages.Usage+startUsage inputTokens =+  Messages.Usage+    { Messages.input_tokens = inputTokens,+      Messages.output_tokens = 0,+      Messages.cache_creation_input_tokens = Nothing,+      Messages.cache_read_input_tokens = Nothing,+      Messages.server_tool_use = Nothing,+      Messages.inference_geo = Nothing,+      Messages.output_tokens_details = Nothing,+      Messages.service_tier = Nothing,+      Messages.speed = Nothing,+      Messages.iterations = Nothing+    }++-- | A @message_delta@ usage reporting output tokens and nothing else,+-- which is everything a pre-Claude-5 generation sends. Refine it by+-- record update to model a generation that also repeats the+-- prompt-side counts.+outputOnlyStreamUsage :: Natural -> Messages.StreamUsage+outputOnlyStreamUsage n =+  Messages.StreamUsage+    { Messages.stream_input_tokens = Nothing,+      Messages.output_tokens = n,+      Messages.stream_cache_creation_input_tokens = Nothing,+      Messages.stream_cache_read_input_tokens = Nothing,+      Messages.stream_server_tool_use = Nothing,+      Messages.stream_output_tokens_details = Nothing,+      Messages.stream_iterations = Nothing+    }++-- | A @message_delta@ event carrying a stop reason and a usage.+messageDelta :: Maybe Messages.StopReason -> Messages.StreamUsage -> Messages.MessageStreamEvent+messageDelta reason su =+  Messages.Message_Delta+    { Messages.message_delta =+        Messages.MessageDelta+          { Messages.stop_reason = reason,+            Messages.stop_sequence = Nothing,+            Messages.stop_details = Nothing+          },+      Messages.usage = su+    }++-- | A @message_start@ event whose usage is the caller's.+messageStartWith :: Messages.Usage -> Messages.MessageStreamEvent+messageStartWith u =+  Messages.Message_Start+    { Messages.message =+        Messages.MessageResponse+          { Messages.id = "msg_test",+            Messages.type_ = "message",+            Messages.role = Messages.Assistant,+            Messages.content = Vector.empty,+            Messages.model = "claude-haiku-4-5",+            Messages.stop_reason = Nothing,+            Messages.stop_sequence = Nothing,+            Messages.stop_details = Nothing,+            Messages.usage = u,+            Messages.container = Nothing+          }+    }+ runClaudeEvents :: [Messages.MessageStreamEvent] -> ([AssistantMessageEvent], Assembler) runClaudeEvents =   foldl'@@ -400,9 +945,7 @@     _ -> error "last event was not terminal"  requestForContext :: Model -> Context -> Options -> IO Messages.CreateMessage-requestForContext model ctx opts = case mapRequest model ctx opts of-  Left e -> assertFailure ("mapRequest failed: " <> Text.unpack e)-  Right req -> pure req+requestForContext model ctx opts = fst <$> mappedFor model ctx opts  requestMessages :: Messages.CreateMessage -> Vector.Vector Messages.Message requestMessages Messages.CreateMessage {Messages.messages = msgs} = msgs
test/TransportSpec.hs view
@@ -1,19 +1,24 @@ module TransportSpec (tests) where  import Baikai+import Baikai.Provider.Claude.Api (claudeMessagesStream) import Baikai.Provider.Claude.Transport qualified as Transport import Control.Concurrent (threadDelay) import Control.Exception (bracket, try) import Control.Lens ((&), (.~), (^.))+import Control.Monad (forM_) import Data.CaseInsensitive qualified as CI+import Data.IORef (newIORef, readIORef, writeIORef) import Data.Map.Strict qualified as Map import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Vector qualified as Vector import Network.HTTP.Types.Header (RequestHeaders)+import Servant.Client qualified as Client+import Streamly.Data.Stream qualified as Stream import System.Environment (lookupEnv, setEnv, unsetEnv) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertFailure, testCase, (@?=))+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))  tests :: TestTree tests =@@ -23,12 +28,26 @@       requestHeadersTest,       sessionAffinityTest,       timeoutTest,-      unknownHostKeyTest+      nonPositiveTimeoutTest,+      unknownHostKeyTest,+      unusableBaseUrlTest     ] +-- | One entry per target, and one notion of what a target is.+--+-- Both halves are asserted in a single case because the cache is+-- process-global and this suite runs in parallel: two cases each reading+-- a count and expecting it to move by exactly one would race each other.+--+-- The normalisation half is what makes the count meaningful. The key is+-- the canonical rendering of "Baikai.Url"'s parse rather than the+-- caller's text, so a trailing slash and a capitalised host do not each+-- open their own connection pool to the same host — and the two provider+-- packages, which now share one cache in @Baikai.Http@, cannot disagree+-- about which target a URL names. clientEnvCacheTest :: TestTree clientEnvCacheTest =-  testCase "cached ClientEnv is allocated once for a base URL" $ do+  testCase "the ClientEnv cache allocates once per normalised base URL" $ do     let url = "https://cache-anthropic.test"     before <- Transport.cachedClientEnvCount     _ <- Transport.getClientEnvCached url@@ -37,6 +56,13 @@     afterSecond <- Transport.cachedClientEnvCount     afterFirst @?= before + 1     afterSecond @?= afterFirst+    -- A different spelling of the same target: capitalised host,+    -- trailing slash.+    env <- Transport.getClientEnvCached "https://Cache-Anthropic.test/"+    afterVariant <- Transport.cachedClientEnvCount+    afterVariant @?= afterSecond+    Client.baseUrlHost (Client.baseUrl env) @?= "cache-anthropic.test"+    Client.baseUrlPath (Client.baseUrl env) @?= ""  requestHeadersTest :: TestTree requestHeadersTest =@@ -75,6 +101,23 @@         "timeoutMs=1" `Text.isInfixOf` (be ^. #message) @?= True       Nothing -> assertFailure "expected timeout error" +nonPositiveTimeoutTest :: TestTree+nonPositiveTimeoutTest =+  testCase "runWithTimeout rejects a non-positive bound without running the action" $ do+    -- System.Timeout.timeout returns immediately at zero and runs+    -- unbounded below it, so both spellings used to fail instantly as a+    -- retryable TransientError, which a retry loop re-issues forever for+    -- what is a caller-side mistake.+    forM_ [0, -5] $ \ms -> do+      ran <- newIORef False+      result <- Transport.runWithTimeout (Just ms) (writeIORef ran True)+      case result of+        Just be -> do+          be ^. #category @?= InvalidRequest+          isRetryable be @?= False+        Nothing -> assertFailure ("expected an InvalidRequest for timeoutMs=" <> show ms)+      readIORef ran >>= (@?= False)+ unknownHostKeyTest :: TestTree unknownHostKeyTest =   testCase "unknown hosts do not fall back to ANTHROPIC_API_KEY" $@@ -92,5 +135,51 @@ withEnv name value =   bracket     (lookupEnv name <* setEnv name value)+    (maybe (unsetEnv name) (setEnv name))+    . const++-- | A base URL baikai will not send to is refused before a key is read.+--+-- The order matters as much as the refusal. These cases run with the+-- provider's own key variable *unset*, so an AuthError would prove the+-- check ran too late; an InvalidRequest proves nothing was looked up.+-- The messages also have to say what is wrong without echoing the part+-- of the URL that could be a credential.+unusableBaseUrlTest :: TestTree+unusableBaseUrlTest =+  testCase "an unusable base URL is refused before any key is read"+    $ withoutEnv "ANTHROPIC_AnthropicMessages_KEY"+    $ forM_+      [ ("https://h.test/v1?api-version=2024-01", "query string"),+        ("https://u:pw@h.test", "credentials"),+        ("h.test", "https://"),+        ("https://h.test/v1/messages", "endpoint path")+      ]+    $ \(url, needle) -> do+      let model = emptyModel & #api .~ AnthropicMessages & #baseUrl .~ url+      events <- Stream.toList (claudeMessagesStream model emptyContext emptyOptions)+      case events of+        [EventStart _, EventError payload] -> case payload ^. #errorInfo of+          Nothing -> assertFailure (Text.unpack url <> ": the error carried no errorInfo")+          Just err -> do+            let message = err ^. #message+            (url, err ^. #category) @?= (url, InvalidRequest)+            assertBool+              (Text.unpack (url <> " should name the problem: " <> message))+              (needle `Text.isInfixOf` message)+            assertBool+              (Text.unpack (url <> " must not echo the query: " <> message))+              (not ("api-version=2024-01" `Text.isInfixOf` message))+            assertBool+              (Text.unpack (url <> " must not echo the password: " <> message))+              (not ("pw@" `Text.isInfixOf` message))+        other ->+          assertFailure+            (Text.unpack url <> ": expected [EventStart, EventError], got: " <> show other)++withoutEnv :: String -> IO a -> IO a+withoutEnv name =+  bracket+    (lookupEnv name <* unsetEnv name)     (maybe (unsetEnv name) (setEnv name))     . const