baikai 0.4.1.0 → 0.5.0.0

raw patch · 27 files changed

+6099/−171 lines, 27 filesdep +base16-bytestringdep +cryptohash-sha256dep ~processPVP ok

version bump matches the API change (PVP)

Dependencies added: base16-bytestring, cryptohash-sha256

Dependency ranges changed: process

API changes (from Hackage documentation)

Files

• CHANGELOG.md +672/−0
• baikai.cabal +33/−1
• src/Baikai.hs +4/−0
• src/Baikai/Agent.hs +617/−0
• src/Baikai/Compat.hs +14/−3
• src/Baikai/Cost/Log.hs +6/−2
• src/Baikai/Evidence.hs +1168/−0
• src/Baikai/Evidence/Build.hs +434/−0
• src/Baikai/Options.hs +12/−0
• src/Baikai/Provider/Cli/Internal.hs +571/−19
• src/Baikai/Provider/Registry.hs +83/−6
• src/Baikai/Response.hs +17/−3
• src/Baikai/Stream.hs +127/−16
• src/Baikai/Stream/Event.hs +48/−7
• src/Baikai/Trace.hs +218/−82
• src/Baikai/Trace/Event.hs +103/−11
• src/Baikai/Trace/Sink.hs +28/−0
• test/AgentSpec.hs +255/−0
• test/CliInternalSpec.hs +302/−2
• test/CostSpec.hs +7/−3
• test/ErrorInfoSpec.hs +4/−1
• test/EvidenceSpec.hs +344/−0
• test/HelpersSpec.hs +9/−5
• test/Main.hs +8/−1
• test/StreamSpec.hs +1/−1
• test/StrictEvidenceSpec.hs +436/−0
• test/TraceSpec.hs +578/−8

@@ -7,6 +7,678 @@  ## [Unreleased] +## [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.++- `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.++  **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 two-second timeout so a tool that hangs on+  `--version` cannot wedge a model call. 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

@@ -1,6 +1,6 @@ cabal-version:   3.4 name:            baikai-version:         0.4.1.0+version:         0.5.0.0 synopsis:        Unified Haskell interface for multiple AI providers description:   baikai provides a unified, provider-agnostic Haskell interface for working@@ -25,6 +25,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@@ -37,6 +52,7 @@   hs-source-dirs:  src   exposed-modules:     Baikai+    Baikai.Agent     Baikai.AgentAssets     Baikai.Api     Baikai.Auth@@ -49,6 +65,8 @@     Baikai.Cost.Pricing     Baikai.Embedding     Baikai.Error+    Baikai.Evidence+    Baikai.Evidence.Build     Baikai.Interactive     Baikai.Message     Baikai.Model@@ -70,15 +88,26 @@     Baikai.Trace.Sink     Baikai.Usage +  -- The cabal-generated version module. 'Baikai.Evidence.Build' reads+  -- it so an evidence record can name the build that produced it,+  -- centrally rather than through a literal in each of the five+  -- packages that construct evidence.+  other-modules:   Paths_baikai+  autogen-modules: Paths_baikai   build-depends:     , aeson              ^>=2.2     , base               >=4.20  && <5+    , base16-bytestring  ^>=1.0     , base64-bytestring  ^>=1.2     , bytestring         ^>=0.12     , containers         ^>=0.7+    , cryptohash-sha256  ^>=0.11+    , directory          ^>=1.3+    , filepath           ^>=1.5     , generic-lens       ^>=2.3     , lens               ^>=5.3     , openai             ^>=2.5+    , process            ^>=1.6     , scientific         ^>=0.3     , streamly           >=0.11  && <0.13     , streamly-core      >=0.3   && <0.5@@ -136,6 +165,7 @@   main-is:            Main.hs   other-modules:     AgentAssetsSpec+    AgentSpec     CatalogSpec     CliInternalSpec     ContextSpec@@ -143,6 +173,7 @@     EmbeddingSpec     ErrorInfoSpec     ErrorSpec+    EvidenceSpec     FetchModelsCore     FetchModelsSpec     GenModelsCore@@ -150,6 +181,7 @@     HelpersSpec     InteractiveSpec     StreamSpec+    StrictEvidenceSpec     SurfaceSpec     ThinkingLevelSpec     TraceSpec

@@ -30,6 +30,8 @@     module Baikai.Usage,     module Baikai.Cost,     module Baikai.Error,+    module Baikai.Evidence,+    module Baikai.Evidence.Build,     module Baikai.Interactive,      -- * Per-API compat shims and call-time options@@ -56,6 +58,8 @@ import Baikai.Context import Baikai.Cost import Baikai.Error+import Baikai.Evidence+import Baikai.Evidence.Build import Baikai.Interactive import Baikai.Message import Baikai.Model

@@ -0,0 +1,617 @@+-- | Provider-neutral types for unattended coding-agent runs with+-- local agent CLIs such as Claude Code and Codex.+--+-- An unattended run starts the coding agent with no terminal and no+-- human present, lets it drive its own internal tool loop, allows it+-- to change files inside directories the caller explicitly authorized,+-- and collects a process result. It is neither a completion (the+-- interesting output is the changed working tree, not the text) nor an+-- interactive launch (nobody is watching).+--+-- This module deliberately does not implement process spawning, and it+-- renders no command-line flags. The core package owns the shared+-- vocabulary and the pure policy algebra, while vendor packages own the+-- translation into their CLI's arguments and a separate package owns+-- the process runner.+--+-- This module is not re-exported from "Baikai". Its field accessors+-- deliberately share names with "Baikai.Interactive", so import it+-- directly, qualified if you need both surfaces at once.+module Baikai.Agent+  ( -- * Provider identity+    AgentProvider (..),+    renderAgentProvider,+    parseAgentProvider,++    -- * Capability profile+    AgentCapability (..),+    renderAgentCapability,+    parseAgentCapability,++    -- * Requested safety policy+    AgentSafety (capability, allowedTools, providerArgs),+    agentSafety,++    -- * Output discipline+    AgentOutputMode (..),+    renderAgentOutputMode,+    parseAgentOutputMode,+    AgentCapturedOutput (..),+    capturedBytes,++    -- * The unattended run request+    AgentRunRequest+      ( provider,+        prompt,+        modelId,+        effort,+        workingDir,+        extraDirs,+        safety,+        timeout,+        output,+        outputLimit,+        envPassthrough+      ),+    agentRunRequest,++    -- * The operator policy ceiling+    AgentCeiling (maxCapability, allowProviderArgs, allowedProviders),+    defaultAgentCeiling,+    CeilingViolation (..),+    renderCeilingViolation,+    applyAgentCeiling,++    -- * The rendered command+    AgentPromptTransport (..),+    AgentCommand (..),++    -- * The run result+    AgentRunResult,+    agentRunResult,+    AgentRunOutcome (..),+    agentRunOutcome,++    -- * Failures+    AgentRenderError (..),+    renderAgentRenderError,+    AgentRunFailure (..),+    renderAgentRunFailure,+  )+where++import Baikai.Evidence (ModelCallEvidence)+import Baikai.Prelude+import Baikai.ThinkingLevel (ThinkingLevel)+import Data.ByteString (ByteString)+import Data.Text qualified as Text+import Data.Time.Clock (NominalDiffTime)+import System.Exit (ExitCode)++-- | Local coding-agent tools Baikai can describe without depending on+-- a vendor package. The names match 'Baikai.Interactive.InteractiveProvider'+-- so both surfaces spell the same tool identically.+data AgentProvider+  = AgentClaude+  | AgentCodex+  deriving stock (Eq, Ord, Show, Generic)++renderAgentProvider :: AgentProvider -> Text+renderAgentProvider AgentClaude = "claude"+renderAgentProvider AgentCodex = "codex"++-- | Parse a canonical provider name. Matching is exact and+-- case-sensitive: @\"Claude\"@ is not a provider.+parseAgentProvider :: Text -> Maybe AgentProvider+parseAgentProvider "claude" = Just AgentClaude+parseAgentProvider "codex" = Just AgentCodex+parseAgentProvider _ = Nothing++-- | How much authority an unattended run gets, expressed+-- provider-neutrally. Constructors ascend in authority, and the+-- 'Ord' instance derived from that order is what 'applyAgentCeiling'+-- compares against an operator's permitted maximum — do not reorder+-- them.+--+-- * 'AgentReadOnly': the run may read but must not modify anything.+-- * 'AgentEditWorkspace': the run may modify files inside its working+--   directory and its explicit extra directories, and nowhere else.+-- * 'AgentFullAccess': no sandbox at all. This is why an operator+--   ceiling refuses it by default.+data AgentCapability+  = AgentReadOnly+  | AgentEditWorkspace+  | AgentFullAccess+  deriving stock (Eq, Ord, Show, Generic)++renderAgentCapability :: AgentCapability -> Text+renderAgentCapability AgentReadOnly = "read-only"+renderAgentCapability AgentEditWorkspace = "edit-workspace"+renderAgentCapability AgentFullAccess = "full-access"++-- | Parse a canonical capability name. Matching is exact and+-- case-sensitive.+parseAgentCapability :: Text -> Maybe AgentCapability+parseAgentCapability "read-only" = Just AgentReadOnly+parseAgentCapability "edit-workspace" = Just AgentEditWorkspace+parseAgentCapability "full-access" = Just AgentFullAccess+parseAgentCapability _ = Nothing++-- | The safety policy a job asks for, as opposed to what an operator+-- permits.+data AgentSafety = AgentSafety+  { -- | How much filesystem authority the run requests.+    capability :: !AgentCapability,+    -- | Optional narrowing of the provider's tool set. An empty list+    -- means \"do not restrict tools beyond what the capability+    -- implies\"; a non-empty list is rendered where the provider+    -- supports a tool allow-list.+    allowedTools :: ![Text],+    -- | Raw provider arguments Baikai does not model, passed through+    -- verbatim. This is a privileged channel: arbitrary vendor flags+    -- can widen authority in ways no capability profile can see, so an+    -- operator ceiling gates the channel as a whole. Nothing here+    -- inspects these strings for dangerous flags, and nothing should:+    -- flag spellings change, and a denylist that misses one provides+    -- false confidence rather than a security boundary.+    providerArgs :: ![Text]+  }+  deriving stock (Eq, Show, Generic)++-- | A safety request for the given capability, with no tool narrowing+-- and no raw provider arguments.+agentSafety :: AgentCapability -> AgentSafety+agentSafety cap =+  AgentSafety+    { capability = cap,+      allowedTools = [],+      providerArgs = []+    }++-- | What Baikai does with the child process's output streams.+--+-- * 'InheritOutput': the child writes straight to the parent's own+--   streams and Baikai captures nothing.+-- * 'CaptureOutput': Baikai collects the bytes and the parent sees+--   nothing.+-- * 'TeeOutput': both.+data AgentOutputMode+  = InheritOutput+  | CaptureOutput+  | TeeOutput+  deriving stock (Eq, Ord, Show, Generic)++renderAgentOutputMode :: AgentOutputMode -> Text+renderAgentOutputMode InheritOutput = "inherit"+renderAgentOutputMode CaptureOutput = "capture"+renderAgentOutputMode TeeOutput = "tee"++-- | Parse a canonical output-mode name. Matching is exact and+-- case-sensitive.+parseAgentOutputMode :: Text -> Maybe AgentOutputMode+parseAgentOutputMode "inherit" = Just InheritOutput+parseAgentOutputMode "capture" = Just CaptureOutput+parseAgentOutputMode "tee" = Just TeeOutput+parseAgentOutputMode _ = Nothing++-- | One captured stream of a finished run. The three states are+-- distinct on purpose: under 'InheritOutput' the bytes went to the+-- parent's terminal and none exist to report, which an empty+-- 'ByteString' could not distinguish from a command that legitimately+-- printed nothing.+data AgentCapturedOutput+  = -- | The stream was not captured.+    OutputNotCaptured+  | -- | The stream was captured in full.+    OutputCaptured !ByteString+  | -- | The stream was captured up to the byte limit; more existed.+    OutputTruncated !ByteString+  deriving stock (Eq, Show, Generic)++-- | The captured bytes, if any were captured at all.+capturedBytes :: AgentCapturedOutput -> Maybe ByteString+capturedBytes OutputNotCaptured = Nothing+capturedBytes (OutputCaptured bytes) = Just bytes+capturedBytes (OutputTruncated bytes) = Just bytes++-- | Everything an unattended coding-agent run needs, expressed+-- provider-neutrally. This is the single source of truth for every+-- process-level setting: the working directory, the timeout, the output+-- discipline, the output limit, and the declared environment+-- variables.+data AgentRunRequest = AgentRunRequest+  { -- | Which coding-agent tool to run.+    provider :: !AgentProvider,+    -- | The instruction handed to the coding agent.+    prompt :: !Text,+    -- | Model override, or 'Nothing' to leave the tool's default.+    modelId :: !(Maybe Text),+    -- | Reasoning-effort override, or 'Nothing' to leave the tool's+    -- default.+    effort :: !(Maybe ThinkingLevel),+    -- | The directory the run is rooted in. Required, not optional:+    -- the safety contract is that a run gets no filesystem authority+    -- beyond this directory and 'extraDirs', and that sentence has no+    -- meaning if the root can be absent.+    workingDir :: !FilePath,+    -- | Directories this run may reach beyond 'workingDir'. The+    -- precise authority is provider-dependent: Claude Code's+    -- @--add-dir@ grants tool access, while @codex exec@'s @--add-dir@+    -- grants write access alongside the primary workspace.+    extraDirs :: ![FilePath],+    -- | The safety policy this job asks for.+    safety :: !AgentSafety,+    -- | Wall-clock limit for the whole run, or 'Nothing' for no limit.+    timeout :: !(Maybe NominalDiffTime),+    -- | What to do with the child's output streams.+    output :: !AgentOutputMode,+    -- | Maximum captured bytes per stream, not in total. 'Nothing'+    -- means unbounded.+    outputLimit :: !(Maybe Int),+    -- | Names of environment variables this job declares it requires.+    -- These are names only, never name\/value pairs, so the list+    -- cannot contain a secret by construction. It is not an allow-list+    -- and does not restrict the child's environment: the child+    -- inherits the parent's environment in full, because both coding+    -- agents need @HOME@, @PATH@, and their own credential files to+    -- function. What the list buys is a precondition check — a runner+    -- fails before spawning when a declared variable is unset or+    -- empty, so a misconfigured job produces one clear error instead+    -- of a coding agent that starts and then flails.+    envPassthrough :: ![Text]+  }+  deriving stock (Eq, Show, Generic)++-- | An unattended run of the given provider, rooted in the given+-- working directory, with the given prompt. Everything else defaults+-- to the least-authority, least-surprising value: no model or effort+-- override, no extra directories, read-only capability, no timeout,+-- inherited output, no output limit, and no declared environment+-- variables.+--+-- The capability default is 'AgentReadOnly': a caller who wants to+-- change files must say so. That is independent of an operator+-- ceiling, which says what a caller is /allowed/ to ask for.+agentRunRequest :: AgentProvider -> FilePath -> Text -> AgentRunRequest+agentRunRequest p dir userPrompt =+  AgentRunRequest+    { provider = p,+      prompt = userPrompt,+      modelId = Nothing,+      effort = Nothing,+      workingDir = dir,+      extraDirs = [],+      safety = agentSafety AgentReadOnly,+      timeout = Nothing,+      output = InheritOutput,+      outputLimit = Nothing,+      envPassthrough = []+    }++-- | The limit an operator places on what any job may request.+--+-- A job description can come from a repository the operator did not+-- write, which makes it untrusted input: it could ask for unlimited+-- filesystem access. A ceiling is a separate, operator-owned value+-- that bounds what any job may ask for, and 'applyAgentCeiling' is the+-- pure check.+data AgentCeiling = AgentCeiling+  { -- | The highest capability any job may request.+    maxCapability :: !AgentCapability,+    -- | Whether jobs may pass raw provider arguments at all. The whole+    -- channel is privileged, so it is permitted or refused as a unit+    -- rather than filtered.+    allowProviderArgs :: !Bool,+    -- | The providers jobs may select. An empty list permits __no__+    -- provider; it does not mean \"all providers\".+    allowedProviders :: ![AgentProvider]+  }+  deriving stock (Eq, Show, Generic)++-- | The ceiling in force when an operator has supplied no policy of+-- their own: a job may ask for read-only or edit-workspace authority,+-- may not ask for full access, and may not pass raw provider+-- arguments; both providers are permitted.+--+-- An edit-capable default is the only one under which a job that+-- changes files works on a fresh machine with no out-of-band setup,+-- while the two things that can widen authority without bound —+-- sandbox-bypassing modes and arbitrary vendor flags — stay opt-in at+-- operator scope.+defaultAgentCeiling :: AgentCeiling+defaultAgentCeiling =+  AgentCeiling+    { maxCapability = AgentEditWorkspace,+      allowProviderArgs = False,+      allowedProviders = [AgentClaude, AgentCodex]+    }++-- | One way a request exceeded a ceiling.+data CeilingViolation+  = -- | The requested capability, then the permitted maximum. The+    -- order matters: reversing the pair produces a message that blames+    -- the wrong side.+    CapabilityExceeded !AgentCapability !AgentCapability+  | -- | The raw provider arguments that were requested while the+    -- channel is closed, in the order given.+    --+    -- __Do not render these values.__ This is the one field of a job+    -- description an operator could write a credential into, which is+    -- why the configuration layer classifies it secret; a refusal+    -- message that quoted them would defeat that classification, so+    -- 'renderCeilingViolation' reports how many were requested and not+    -- what they were. The list is retained rather than reduced to a+    -- count because a programmatic caller may legitimately need to+    -- inspect it.+    ProviderArgsForbidden ![Text]+  | -- | The requested provider, then the permitted providers.+    ProviderForbidden !AgentProvider ![AgentProvider]+  deriving stock (Eq, Show, Generic)++-- | One line of plain English naming what was asked for and what is+-- permitted.+renderCeilingViolation :: CeilingViolation -> Text+renderCeilingViolation (CapabilityExceeded requested permitted) =+  "requested capability "+    <> renderAgentCapability requested+    <> " exceeds the permitted maximum "+    <> renderAgentCapability permitted+renderCeilingViolation (ProviderArgsForbidden args) =+  "raw provider arguments are not permitted; "+    <> Text.pack (show (length args))+    <> " requested, and their values are secret and are not shown"+renderCeilingViolation (ProviderForbidden requested permitted) =+  "provider "+    <> renderAgentProvider requested+    <> " is not permitted; permitted providers: "+    <> renderPermittedProviders permitted+  where+    renderPermittedProviders [] = "none"+    renderPermittedProviders ps = Text.intercalate ", " (map renderAgentProvider ps)++-- | Check a request against a ceiling. Returns the request+-- __unchanged__ when it is within the ceiling, and every violation+-- when it is not.+--+-- Two properties are deliberate. The request is never modified to fit+-- the ceiling: a job that asked for more authority than it may have is+-- an error to report, not a request to quietly weaken, because silent+-- clamping is how a job that believes it may edit ends up doing+-- nothing and reporting success. And every violation is collected+-- rather than only the first, so an operator fixing a job description+-- sees all of them in one run.+--+-- This function does not inspect the contents of the requested+-- 'providerArgs'. See that field's documentation for why a denylist of+-- dangerous flags would be false confidence rather than a boundary.+applyAgentCeiling :: AgentCeiling -> AgentRunRequest -> Either [CeilingViolation] AgentRunRequest+applyAgentCeiling limit request+  | null violations = Right request+  | otherwise = Left violations+  where+    requestedProvider = request ^. #provider+    permittedProviders = limit ^. #allowedProviders+    requestedCapability = request ^. #safety . #capability+    permittedCapability = limit ^. #maxCapability+    requestedArgs = request ^. #safety . #providerArgs+    violations =+      concat+        [ [ ProviderForbidden requestedProvider permittedProviders+          | requestedProvider `notElem` permittedProviders+          ],+          [ CapabilityExceeded requestedCapability permittedCapability+          | requestedCapability > permittedCapability+          ],+          [ ProviderArgsForbidden requestedArgs+          | not (null requestedArgs),+            not (limit ^. #allowProviderArgs)+          ]+        ]++-- | How the prompt reaches the child process.+data AgentPromptTransport+  = -- | The prompt is written to the child's standard input and+    -- appears nowhere in the argument vector.+    PromptOnStdin+  | -- | The prompt is already the final element of the argument+    -- vector, protected by the provider's @--@ separator, and the+    -- child gets no standard input at all.+    PromptAsArgument+  deriving stock (Eq, Ord, Show, Generic)++-- | A rendered provider command: the boundary value between a vendor+-- renderer, which produces it, and a process runner, which consumes+-- it. It lives in the core package so that neither side depends on the+-- other.+--+-- Honor 'promptTransport' exactly. @codex exec@ documents that a piped+-- standard input /and/ a positional prompt are both used, with+-- standard input appended as a @\<stdin\>@ block, so emitting both is+-- a silent corruption of the instruction. Making the transport an+-- explicit choice turns that hazard into a type-level distinction+-- rather than a convention.+--+-- This type deliberately carries no working directory. Claude Code has+-- no working-directory flag at all, so for one of the two providers the+-- working directory can only ever be a process-level setting; a runner+-- therefore reads it from 'AgentRunRequest' and takes both values.+-- Duplicating it here was rejected because two copies of a working+-- directory can disagree, and that disagreement would be a sandbox+-- escape rather than a cosmetic bug.+data AgentCommand = AgentCommand+  { -- | The program to run, either a bare name resolved on @PATH@ or+    -- an explicit path.+    executable :: !FilePath,+    -- | The rendered argument vector, excluding the program name.+    arguments :: ![String],+    -- | Where the prompt travels.+    promptTransport :: !AgentPromptTransport,+    -- | The prompt itself, for a runner that must write it to standard+    -- input.+    promptText :: !Text+  }+  deriving stock (Eq, Show, Generic)++-- | The process-level outcome of a finished unattended run. Read it+-- with @generic-lens@ labels, for example @result ^. #exitCode@.+--+-- A non-zero exit code is a normal result and lives here rather than+-- in a failure type: a coding agent that fails its task and exits 1+-- has still run.+data AgentRunResult = AgentRunResult+  { -- | Which coding-agent tool ran.+    provider :: !AgentProvider,+    -- | The child's exit status.+    exitCode :: !ExitCode,+    -- | The child's standard output, per the request's output mode.+    stdout :: !AgentCapturedOutput,+    -- | The child's standard error, per the request's output mode.+    stderr :: !AgentCapturedOutput,+    -- | How long the run took.+    duration :: !NominalDiffTime+  }+  deriving stock (Eq, Show, Generic)++-- | A result with both streams marked 'OutputNotCaptured'.+agentRunResult :: AgentProvider -> ExitCode -> NominalDiffTime -> AgentRunResult+agentRunResult p code elapsed =+  AgentRunResult+    { provider = p,+      exitCode = code,+      stdout = OutputNotCaptured,+      stderr = OutputNotCaptured,+      duration = elapsed+    }++-- | Everything one finished unattended run produced: what happened, and+-- the evidence the runner built for it.+--+-- The two are siblings rather than the evidence living inside+-- 'AgentRunResult', because the run that most needs a record is one that+-- did not produce a result. A run killed by its own timeout started, ran,+-- consumed tokens, and possibly changed the working tree, and it reports+-- @Left ('RunTimedOut' …)@ — so evidence hanging off the @Right@ would be+-- unreachable in exactly the case an operator most wants it.+--+-- 'evidence' is 'Nothing' in two situations that must not be confused.+-- The caller asked for none, which is the default and costs nothing. Or+-- nothing ever started — a missing working directory, an unset declared+-- environment variable, an executable that could not be spawned — and+-- there is no run to describe.+data AgentRunOutcome = AgentRunOutcome+  { outcome :: !(Either AgentRunFailure AgentRunResult),+    evidence :: !(Maybe ModelCallEvidence)+  }+  deriving stock (Eq, Show, Generic)++-- | An outcome carrying no evidence, for the paths where none was asked+-- for or none exists.+agentRunOutcome :: Either AgentRunFailure AgentRunResult -> AgentRunOutcome+agentRunOutcome result = AgentRunOutcome {outcome = result, evidence = Nothing}++-- | A refusal raised before any process is created: the requested+-- policy cannot be expressed honestly for the chosen provider, so the+-- run must not start.+--+-- Every constructor that reports an inexpressible policy carries a+-- human-readable explanation, because a refusal that does not say+-- /why/ is a dead end rather than an error an operator can act on.+data AgentRenderError+  = -- | The provider, the capability it cannot express, and why.+    UnsupportedCapability !AgentProvider !AgentCapability !Text+  | -- | The provider cannot honor a tool allow-list, and why.+    UnsupportedToolRestriction !AgentProvider !Text+  | -- | The general case: this provider cannot honor the requested+    -- safety policy, and why. It carries no capability, so it also+    -- serves surfaces whose safety vocabulary has no capability+    -- profile — notably the interactive launchers, which share this+    -- refusal type rather than growing a parallel one.+    SafetyNotExpressible !AgentProvider !Text+  | -- | The provider the renderer implements, then the provider the+    -- request named. Each vendor renderer is a separate function in a+    -- separate package, so nothing in the type system stops a caller+    -- from handing a Codex request to the Claude renderer; without+    -- this constructor the renderer's only options would be to+    -- silently render the wrong provider's flags or to throw. The+    -- order matters: reversing the pair names the wrong culprit.+    ProviderMismatch !AgentProvider !AgentProvider+  | -- | The request exceeded the operator's policy ceiling.+    CeilingRejected ![CeilingViolation]+  deriving stock (Eq, Show, Generic)++renderAgentRenderError :: AgentRenderError -> Text+renderAgentRenderError (UnsupportedCapability p cap why) =+  renderAgentProvider p+    <> " cannot express the requested capability "+    <> renderAgentCapability cap+    <> ": "+    <> why+renderAgentRenderError (UnsupportedToolRestriction p why) =+  renderAgentProvider p+    <> " cannot express the requested tool restriction: "+    <> why+renderAgentRenderError (SafetyNotExpressible p why) =+  renderAgentProvider p+    <> " cannot honor the requested safety policy: "+    <> why+renderAgentRenderError (ProviderMismatch renderer requested) =+  "the "+    <> renderAgentProvider renderer+    <> " renderer cannot render a request for provider "+    <> renderAgentProvider requested+renderAgentRenderError (CeilingRejected violations) =+  "the request exceeds the permitted policy ceiling: "+    <> Text.intercalate "; " (map renderCeilingViolation violations)++-- | A failure raised while spawning the child process or waiting for+-- it.+--+-- There is deliberately no constructor for \"the process exited+-- non-zero\". That is a normal outcome and lives in 'AgentRunResult':+-- a coding agent that fails its task and exits 1 has still run.+data AgentRunFailure+  = -- | The executable that could not be started, and the operating+    -- system's message. The pair is what distinguishes \"the tool is+    -- not installed\" from \"the tool is installed but the working+    -- directory does not exist\".+    SpawnFailed !FilePath !Text+  | -- | The run exceeded this limit and was terminated.+    RunTimedOut !NominalDiffTime+  | -- | Every variable named in the request's 'envPassthrough' that is+    -- unset or empty, checked as a group so an operator sees all of+    -- them at once.+    MissingEnvironment ![Text]+  | -- | The working directory does not exist or is not a directory.+    WorkingDirMissing !FilePath+  | -- | The run produced output the caller could not interpret.+    OutputMalformed !Text+  | -- | The caller required evidence this configuration cannot produce,+    -- so nothing was started. Carries one rendered explanation per+    -- reason, from+    -- 'Baikai.Evidence.Build.renderEvidenceRefusal'.+    --+    -- Structural rather than predictive: it fires when the requirement+    -- is /impossible/ here, never when it merely might not be met. A run+    -- that could have reported what the caller needed and did not says+    -- so in its own record's @strength@; refusing it after the fact+    -- would destroy a report of work that actually happened.+    EvidenceRefused ![Text]+  deriving stock (Eq, Show, Generic)++renderAgentRunFailure :: AgentRunFailure -> Text+renderAgentRunFailure (SpawnFailed path message) =+  "could not start " <> Text.pack path <> ": " <> message+renderAgentRunFailure (RunTimedOut limit) =+  "the run exceeded its timeout of " <> Text.pack (show limit)+renderAgentRunFailure (MissingEnvironment names) =+  "required environment variables are unset or empty: "+    <> Text.intercalate ", " names+renderAgentRunFailure (WorkingDirMissing path) =+  "the working directory does not exist or is not a directory: "+    <> Text.pack path+renderAgentRunFailure (OutputMalformed why) =+  "the run produced malformed output: " <> why+renderAgentRunFailure (EvidenceRefused reasons) =+  "refused before starting, because this run cannot produce the evidence it \+  \required: "+    <> Text.intercalate "; " reasons

@@ -77,7 +77,16 @@ -- shapes land as new constructors. data ThinkingFormat   = -- | OpenAI-native: top-level @reasoning_effort: "minimal" | "low"-    --   | "medium" | "high"@.+    --   | "medium" | "high" | "xhigh" | "max"@.+    --+    --   This shape sends the canonical baikai level verbatim. The other+    --   six route through @Baikai.Provider.OpenAI.Shape.compatibleEffort@,+    --   which clamps @minimal@ to @low@ and both @xhigh@ and @max@ to+    --   @high@ — a lowest-common-denominator vocabulary for hosts that+    --   do not accept the full one. The exclusion is deliberate and+    --   guarded by @nativeHigherEffortTests@ in+    --   @baikai-openai/test/ShapeSpec.hs@: clamping here would silently+    --   weaken every high-effort request against a current OpenAI model.     ThinkingFormatOpenAI   | -- | OpenRouter: nested @reasoning: { effort: "..." }@.     ThinkingFormatOpenRouter@@ -91,8 +100,10 @@     ThinkingFormatZai   | -- | Qwen chat-template: top-level @enable_thinking: true@.     ThinkingFormatQwen-  | -- | Host does not expose reasoning controls; the option is-    --   silently dropped.+  | -- | Host does not expose reasoning controls, so the option is+    --   dropped from the request. Nothing about the wire says so — the+    --   drop is recorded in the call's evidence as+    --   @thinking_dropped_unsupported_host@ rather than left invisible.     ThinkingFormatNone   deriving stock (Eq, Show, Generic)   deriving anyclass (FromJSON, ToJSON)

@@ -173,7 +173,6 @@   now <- liftIO getCurrentTime   let u :: Usage       u = (resp ^. #message) ^. #usage-      meaningfulCost = (Usage.cost u) ^. #usd > 0       entry =         CallLogEntry           { timestamp = now,@@ -183,7 +182,12 @@             outputTokens = positive (Usage.outputTokens u),             cachedInputTokens = positive (Usage.cacheReadTokens u),             reasoningTokens = Usage.reasoningTokens u,-            usd = if meaningfulCost then Just (usdAsScientific (Usage.cost u)) else Nothing,+            -- A zero cost is reported as zero. The other entry-building+            -- site ('Baikai.Trace.runRequestWithRegistry') used to+            -- suppress it too; leaving one of the two behind would make+            -- the same record type mean different things depending on+            -- which entry point produced it.+            usd = Just (usdAsScientific (Usage.cost u)),             latencyMs = resp ^. #latencyMs,             promptSummary = summarizeContext ctx           }

@@ -0,0 +1,1168 @@+{-# LANGUAGE LambdaCase #-}++-- | Verifiable evidence about one completed model call.+--+-- A trace event answers "what did this call cost?". This module+-- answers a different and harder question: "what actually crossed the+-- boundary between this process and the provider, and how much of that+-- can be corroborated?".+--+-- Three things are kept strictly apart and are never collapsed into+-- one another:+--+-- * what the caller __requested__ — the model id and the+--   'Baikai.ThinkingLevel.ThinkingLevel' they asked for;+--+-- * what Baikai __translated__ that into for one specific provider —+--   the effort word, token budget, and wire field actually sent, plus+--   every clamp, collapse, or drop applied on the way, recorded in+--   'ThinkingTranslation';+--+-- * what the provider was __observed__ to report back — recorded in+--   'Observed', where a field the provider stayed silent about is+--   'Unobserved' and is never backfilled from the request.+--+-- Nothing in this module reaches a provider or performs a call. It is+-- the vocabulary the provider adapters populate.+module Baikai.Evidence+  ( -- * Schema identity+    evidenceSchemaVersion,++    -- * The evidence record+    ModelCallEvidence (..),+    baseEvidence,++    -- * Observation+    Observed (..),+    observedValue,++    -- * Reasoning-effort translation+    ThinkingTranslation (..),+    ThinkingMode (..),+    ThinkingAdjustment (..),+    noThinkingRequested,++    -- * Endpoint and transport+    EndpointIdentity (..),+    TransportKind (..),++    -- * Outcome and strength+    CallStatus (..),+    EvidenceStrength (..),+    renderEvidenceStrength,+    declaredStrength,++    -- * The caller's request+    EvidenceRequest (..),+    EvidenceStrictness (..),+    evidenceRequest,++    -- * Canonical encoding and digests+    canonicalEncode,+    commitmentDigest,+    configurationDigest,+    configurationProjection,++    -- * Identifiers+    newCallId,+  )+where++import Baikai.Api (Api (..))+import Baikai.Error (BaikaiError)+import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel)+import Baikai.Usage (Usage)+import Control.Exception (SomeException, try)+import Crypto.Hash.SHA256 qualified as SHA256+import Data.Aeson+  ( FromJSON (parseJSON),+    Options (fieldLabelModifier, omitNothingFields),+    ToJSON (toJSON),+    Value (Array, Bool, Null, Number, Object, String),+    camelTo2,+    defaultOptions,+    genericParseJSON,+    genericToJSON,+    object,+    withText,+    (.:),+    (.:?),+    (.=),+  )+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KeyMap+import Data.Aeson.Types (typeMismatch)+import Data.Bits (Bits, shiftL, shiftR, (.&.), (.|.))+import Data.ByteString (ByteString)+import Data.ByteString qualified as ByteString+import Data.ByteString.Base16 qualified as Base16+import Data.ByteString.Builder (Builder)+import Data.ByteString.Builder qualified as Builder+import Data.ByteString.Lazy qualified as LazyByteString+import Data.Char (ord)+import Data.IORef (IORef, atomicModifyIORef', newIORef)+import Data.List (intersperse)+import Data.Scientific (FPFormat (Fixed), Scientific)+import Data.Scientific qualified as Scientific+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as TextEncoding+import Data.Time (UTCTime, diffUTCTime)+import Data.Time.Clock.POSIX (getPOSIXTime)+import Data.Vector qualified as Vector+import Data.Word (Word64)+import GHC.Generics (Generic)+import Numeric.Natural (Natural)+import System.IO (IOMode (ReadMode), withBinaryFile)+import System.IO.Unsafe (unsafePerformIO)++-- ============================================================+-- Observation+-- ============================================================++-- | A value the provider either did or did not report back.+--+-- This is deliberately not 'Maybe'. A 'Maybe' invites+-- @fromMaybe requested observed@, which is precisely the error this+-- type exists to prevent: a field the provider never reported must+-- never be filled in from what was requested. There is intentionally+-- no function here that supplies a default, no 'Monoid' instance, and+-- no @fromObserved@.+data Observed a+  = -- | The provider reported this value.+    Observed !a+  | -- | The provider did not report this value, or the transport+    -- cannot carry it. This is a positive statement about the+    -- provider's silence, not a missing field.+    Unobserved+  deriving stock (Eq, Show, Generic, Functor)++-- | @Observed x@ encodes as @{"observed": x}@ and 'Unobserved' as the+-- bare JSON string @"unobserved"@. Downstream consumers pattern-match+-- on that literal, so the shape is part of the schema and must not be+-- replaced with a generically derived encoding.+instance (ToJSON a) => ToJSON (Observed a) where+  toJSON = \case+    Observed a -> object ["observed" .= a]+    Unobserved -> String "unobserved"++instance (FromJSON a) => FromJSON (Observed a) where+  parseJSON = \case+    String "unobserved" -> pure Unobserved+    Object o -> Observed <$> o .: "observed"+    v -> typeMismatch "Observed" v++-- | Branch on whether the provider reported a value.+--+-- Use this to /report/ what was observed, never to /supply a default/+-- for it: @fromMaybe requestedModel (observedValue observedModel)@+-- defeats the entire purpose of this type and produces a record that+-- claims the provider corroborated something it never mentioned.+observedValue :: Observed a -> Maybe a+observedValue = \case+  Observed a -> Just a+  Unobserved -> Nothing++-- ============================================================+-- Reasoning-effort translation+-- ============================================================++-- | Which shape a provider's thinking configuration took on the wire.+--+-- Encodes as a lowercase string: @budget@, @adaptive@, @flag@,+-- @toggle@, @unsupported@, @absent@.+data ThinkingMode+  = -- | The provider took an explicit token budget.+    ThinkingModeBudget+  | -- | The provider chose its own depth, steered by an effort word.+    ThinkingModeAdaptive+  | -- | The preference travelled as a command-line flag.+    ThinkingModeFlag+  | -- | The provider accepted a bare on/off toggle with no depth.+    ThinkingModeToggle+  | -- | The caller requested a level and this transport cannot express+    -- any part of it.+    ThinkingModeUnsupported+  | -- | The caller requested no level at all.+    ThinkingModeAbsent+  deriving stock (Eq, Show, Generic)++renderThinkingMode :: ThinkingMode -> Text+renderThinkingMode = \case+  ThinkingModeBudget -> "budget"+  ThinkingModeAdaptive -> "adaptive"+  ThinkingModeFlag -> "flag"+  ThinkingModeToggle -> "toggle"+  ThinkingModeUnsupported -> "unsupported"+  ThinkingModeAbsent -> "absent"++parseThinkingMode :: Text -> Maybe ThinkingMode+parseThinkingMode = \case+  "budget" -> Just ThinkingModeBudget+  "adaptive" -> Just ThinkingModeAdaptive+  "flag" -> Just ThinkingModeFlag+  "toggle" -> Just ThinkingModeToggle+  "unsupported" -> Just ThinkingModeUnsupported+  "absent" -> Just ThinkingModeAbsent+  _ -> Nothing++instance ToJSON ThinkingMode where+  toJSON = String . renderThinkingMode++instance FromJSON ThinkingMode where+  parseJSON =+    withText "ThinkingMode" $ \t ->+      maybe (fail ("unknown thinking mode: " <> show t)) pure (parseThinkingMode t)++-- | One thing that happened to the caller's reasoning-effort request+-- between the canonical 'ThinkingLevel' and the wire.+--+-- This is the type that makes an otherwise silent downgrade visible.+-- Every constructor corresponds to a real site in this repository+-- where a request is weakened, dropped, or made indistinguishable from+-- the provider's own default.+--+-- Levels are carried as 'ThinkingLevel' rather than text so that+-- strict evidence mode can compare them; they render through+-- 'Baikai.ThinkingLevel.renderThinkingLevel' in JSON.+data ThinkingAdjustment+  = -- | The requested level was replaced by a weaker one the transport+    -- accepts. Carries the requested level and the wire text sent.+    EffortClamped !ThinkingLevel !Text+  | -- | The transport expresses no depth, so the level only turned+    -- thinking on. Carries the requested level.+    EffortCollapsedToToggle !ThinkingLevel+  | -- | The transport sends no effort field for this level, so the+    -- request is indistinguishable on the wire from the provider's own+    -- default. Carries the requested level.+    EffortOmitted !ThinkingLevel+  | -- | The chosen model does not advertise reasoning support, so the+    -- thinking configuration was dropped entirely.+    ThinkingDroppedUnsupportedModel !ThinkingLevel+  | -- | The host exposes no reasoning controls at all, so the+    -- configuration was dropped.+    ThinkingDroppedUnsupportedHost !ThinkingLevel+  | -- | A computed thinking budget was discarded because it did not+    -- fit inside the resolved output-token ceiling. Carries the+    -- requested level, the budget that was computed, and the ceiling.+    ThinkingDroppedBudgetExceeded !ThinkingLevel !Natural !Natural+  deriving stock (Eq, Show, Generic)++-- | Adjustments encode as a tagged object whose @kind@ names the+-- constructor in snake_case and whose @requested@ field carries the+-- canonical level name.+instance ToJSON ThinkingAdjustment where+  toJSON = \case+    EffortClamped lvl wire ->+      tagged "effort_clamped" lvl ["wire" .= wire]+    EffortCollapsedToToggle lvl ->+      tagged "effort_collapsed_to_toggle" lvl []+    EffortOmitted lvl ->+      tagged "effort_omitted" lvl []+    ThinkingDroppedUnsupportedModel lvl ->+      tagged "thinking_dropped_unsupported_model" lvl []+    ThinkingDroppedUnsupportedHost lvl ->+      tagged "thinking_dropped_unsupported_host" lvl []+    ThinkingDroppedBudgetExceeded lvl budget maxOut ->+      tagged+        "thinking_dropped_budget_exceeded"+        lvl+        ["budget_tokens" .= budget, "max_tokens" .= maxOut]+    where+      tagged kind lvl extra =+        object+          ( ["kind" .= (kind :: Text), "requested" .= renderThinkingLevel lvl]+              <> extra+          )++instance FromJSON ThinkingAdjustment where+  parseJSON = \case+    Object o -> do+      kind <- o .: "kind"+      lvl <- o .: "requested" >>= parseThinkingLevelText+      case kind :: Text of+        "effort_clamped" -> EffortClamped lvl <$> o .: "wire"+        "effort_collapsed_to_toggle" -> pure (EffortCollapsedToToggle lvl)+        "effort_omitted" -> pure (EffortOmitted lvl)+        "thinking_dropped_unsupported_model" ->+          pure (ThinkingDroppedUnsupportedModel lvl)+        "thinking_dropped_unsupported_host" ->+          pure (ThinkingDroppedUnsupportedHost lvl)+        "thinking_dropped_budget_exceeded" ->+          ThinkingDroppedBudgetExceeded lvl <$> o .: "budget_tokens" <*> o .: "max_tokens"+        other -> fail ("unknown thinking adjustment: " <> show other)+    v -> typeMismatch "ThinkingAdjustment" v++-- | Parse a canonical level name as produced by+-- 'Baikai.ThinkingLevel.renderThinkingLevel'. The evidence schema+-- spells levels with those names rather than with the constructor+-- names that 'ThinkingLevel'\'s own derived instance uses, because a+-- reader of an evidence record should see the same vocabulary the+-- provider documentation uses.+parseThinkingLevelText :: (MonadFail m) => Text -> m ThinkingLevel+parseThinkingLevelText = \case+  "minimal" -> pure ThinkingMinimal+  "low" -> pure ThinkingLow+  "medium" -> pure ThinkingMedium+  "high" -> pure ThinkingHigh+  "xhigh" -> pure ThinkingXHigh+  "max" -> pure ThinkingMax+  other -> fail ("unknown thinking level: " <> show other)++-- | What a canonical 'ThinkingLevel' actually became on the wire for+-- one specific provider.+--+-- The provider adapter that built the request owns this value. No+-- downstream layer — trace sink, exporter, or reporting tool — may+-- re-derive it: doing so would mean reimplementing every provider's+-- translation and compatibility lookup, and would silently diverge the+-- first time a translation changed.+data ThinkingTranslation = ThinkingTranslation+  { -- | The level the caller asked for, if any.+    requested :: !(Maybe ThinkingLevel),+    mode :: !ThinkingMode,+    -- | The exact effort text placed on the wire, when the transport+    -- uses one.+    effortText :: !(Maybe Text),+    -- | The exact token budget placed on the wire, when the transport+    -- uses one.+    budgetTokens :: !(Maybe Natural),+    -- | The provider-specific field name the configuration travelled+    -- in, for example @"thinking"@, @"reasoning_effort"@, or+    -- @"--effort"@. 'Nothing' when nothing was sent.+    wireField :: !(Maybe Text),+    -- | Everything that happened to the request between the canonical+    -- level and the wire, in the order it was applied. Empty means the+    -- request was expressed exactly.+    adjustments :: ![ThinkingAdjustment]+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON ThinkingTranslation where+  toJSON t =+    object+      [ "requested" .= fmap renderThinkingLevel (requested t),+        "mode" .= mode t,+        "effort_text" .= effortText t,+        "budget_tokens" .= budgetTokens t,+        "wire_field" .= wireField t,+        "adjustments" .= adjustments t+      ]++instance FromJSON ThinkingTranslation where+  parseJSON = \case+    Object o -> do+      rawLevel <- o .:? "requested"+      lvl <- traverse parseThinkingLevelText rawLevel+      ThinkingTranslation lvl+        <$> o .: "mode"+        <*> o .:? "effort_text"+        <*> o .:? "budget_tokens"+        <*> o .:? "wire_field"+        <*> o .: "adjustments"+    v -> typeMismatch "ThinkingTranslation" v++-- | The translation for a call where the caller set no level at all.+-- Distinct from a call that asked for a level the transport could not+-- express, which is 'ThinkingModeUnsupported' with a non-empty+-- 'adjustments' list.+noThinkingRequested :: ThinkingTranslation+noThinkingRequested =+  ThinkingTranslation+    { requested = Nothing,+      mode = ThinkingModeAbsent,+      effortText = Nothing,+      budgetTokens = Nothing,+      wireField = Nothing,+      adjustments = []+    }++-- ============================================================+-- Endpoint and transport+-- ============================================================++-- | How the call physically reached the provider. The three kinds+-- differ fundamentally in how much they can corroborate: an HTTP call+-- can carry provider response headers, a subprocess can only report+-- what the executable chose to print, and an unattended agent run+-- reports only what its own result envelope contains.+--+-- Encodes as @http_api@, @subprocess@, or @agent_run@.+data TransportKind+  = TransportHttpApi+  | TransportSubprocess+  | TransportAgentRun+  deriving stock (Eq, Show, Generic)++renderTransportKind :: TransportKind -> Text+renderTransportKind = \case+  TransportHttpApi -> "http_api"+  TransportSubprocess -> "subprocess"+  TransportAgentRun -> "agent_run"++instance ToJSON TransportKind where+  toJSON = String . renderTransportKind++instance FromJSON TransportKind where+  parseJSON = withText "TransportKind" $ \case+    "http_api" -> pure TransportHttpApi+    "subprocess" -> pure TransportSubprocess+    "agent_run" -> pure TransportAgentRun+    other -> fail ("unknown transport kind: " <> show other)++-- | Where the call went, recorded without recording a credential.+data EndpointIdentity = EndpointIdentity+  { -- | The provider name as Baikai knows it, e.g. @"anthropic"@.+    provider :: !Text,+    -- | The wire protocol tag, rendered from 'Baikai.Api.Api'.+    api :: !Text,+    transport :: !TransportKind,+    -- | Scheme, host, port, and path with every query parameter and+    -- userinfo component removed. A query string can carry an API key+    -- on some gateways, so it is dropped wholesale rather than+    -- filtered field by field.+    endpoint :: !(Maybe Text),+    -- | The version of the @baikai@ package that produced this record.+    baikaiVersion :: !Text,+    -- | The provider implementation's own version, when it has one:+    -- the vendor package version for an API provider, or the+    -- executable's reported version for a subprocess.+    implementationVersion :: !(Maybe Text)+  }+  deriving stock (Eq, Show, Generic)++-- | Field names render in snake_case, matching 'Baikai.Usage.Usage'+-- and 'Baikai.Error.BaikaiError', which are embedded verbatim in an+-- evidence record.+--+-- @omitNothingFields@ is 'False' and stated explicitly rather than+-- left to the default, because it is load-bearing here: an evidence+-- record must render an absent field as @null@ rather than dropping+-- it, so that a reader can tell "Baikai recorded nothing here" apart+-- from "this record predates the field". This is the opposite of the+-- choice @Baikai.Trace.Event@ makes for trace events, where dropping+-- absent fields keeps log lines small. The difference is deliberate;+-- do not harmonise them.+evidenceJsonOptions :: Options+evidenceJsonOptions =+  defaultOptions+    { fieldLabelModifier = camelTo2 '_',+      omitNothingFields = False+    }++instance ToJSON EndpointIdentity where+  toJSON = genericToJSON evidenceJsonOptions++instance FromJSON EndpointIdentity where+  parseJSON = genericParseJSON evidenceJsonOptions++-- ============================================================+-- Outcome and strength+-- ============================================================++-- | The terminal outcome of a call. Encodes as @succeeded@, @failed@,+-- or @aborted@.+data CallStatus+  = CallSucceeded+  | CallFailed+  | -- | The consumer stopped reading before the provider finished.+    CallAborted+  deriving stock (Eq, Show, Generic)++renderCallStatus :: CallStatus -> Text+renderCallStatus = \case+  CallSucceeded -> "succeeded"+  CallFailed -> "failed"+  CallAborted -> "aborted"++instance ToJSON CallStatus where+  toJSON = String . renderCallStatus++instance FromJSON CallStatus where+  parseJSON = withText "CallStatus" $ \case+    "succeeded" -> pure CallSucceeded+    "failed" -> pure CallFailed+    "aborted" -> pure CallAborted+    other -> fail ("unknown call status: " <> show other)++-- | How much a given evidence record actually proves.+--+-- The constructors ascend, and the derived 'Ord' instance is what+-- strict evidence mode compares against a caller's stated requirement.+-- __Do not reorder them.__+--+-- Encodes as @requested_only@, @correlated@, @model_observed@, or+-- @fully_observed@.+data EvidenceStrength+  = -- | Baikai recorded what it requested and what it translated. The+    -- provider reported nothing back that corroborates it. A+    -- successful process exit does not raise a record to a higher+    -- strength.+    EvidenceRequestedOnly+  | -- | The provider returned a correlation identifier, so this call+    -- can be located in the provider's own records, but it did not+    -- report the model or the effort it used.+    EvidenceCorrelated+  | -- | The provider reported the model it ran, in addition to a+    -- correlation identifier.+    EvidenceModelObserved+  | -- | The provider reported both the model and its effective+    -- thinking configuration.+    EvidenceFullyObserved+  deriving stock (Eq, Ord, Show, Generic)++-- | The canonical name a strength encodes as, also used in the refusal+-- messages strict mode produces.+renderEvidenceStrength :: EvidenceStrength -> Text+renderEvidenceStrength = \case+  EvidenceRequestedOnly -> "requested_only"+  EvidenceCorrelated -> "correlated"+  EvidenceModelObserved -> "model_observed"+  EvidenceFullyObserved -> "fully_observed"++instance ToJSON EvidenceStrength where+  toJSON = String . renderEvidenceStrength++instance FromJSON EvidenceStrength where+  parseJSON = withText "EvidenceStrength" $ \case+    "requested_only" -> pure EvidenceRequestedOnly+    "correlated" -> pure EvidenceCorrelated+    "model_observed" -> pure EvidenceModelObserved+    "fully_observed" -> pure EvidenceFullyObserved+    other -> fail ("unknown evidence strength: " <> show other)++-- | The highest strength a transport can reach when everything goes+-- well.+--+-- This is a static property of the transport, not a claim about any+-- particular call: a transport that declares 'EvidenceModelObserved'+-- still produces 'EvidenceRequestedOnly' for a call that failed before+-- the provider said anything. Strict evidence mode compares a caller's+-- requirement against this /before/ dispatch, which is the only point at+-- which refusing is still cheap.+--+-- __Declaring more than a transport can deliver is the one way to make+-- strict mode lie__, so every value below is justified by a test that+-- actually drives that transport to it. If you raise a declaration, add+-- the test first.+--+-- The values, and what proved them:+--+-- * 'AnthropicMessages' and 'OpenAIChatCompletions' reach+--   'EvidenceModelObserved'. Both echo the model they ran and both carry+--   a correlation header. Neither echoes the thinking configuration it+--   applied, so 'EvidenceFullyObserved' is unreachable on either — a+--   reasoning-token count corroborates output volume and says nothing+--   about which effort setting was in force. No transport in this+--   repository currently declares 'EvidenceFullyObserved'.+--+-- * 'AnthropicMessagesCli' reaches 'EvidenceModelObserved'. The @claude@+--   CLI names the model that consumed tokens in its result event's+--   @modelUsage@ map, alongside a session identifier.+--+-- * 'OpenAICompletionsCli' reaches only 'EvidenceCorrelated'.+--   @codex exec --json@ names a thread identifier but no model anywhere+--   in its event stream, and the model baikai passed on the command line+--   is the request rather than an observation.+--+-- * 'Custom' declares 'EvidenceRequestedOnly'. Baikai knows nothing+--   about a caller-supplied transport and must not assume on its behalf.+declaredStrength :: Api -> EvidenceStrength+declaredStrength = \case+  AnthropicMessages -> EvidenceModelObserved+  OpenAIChatCompletions -> EvidenceModelObserved+  AnthropicMessagesCli -> EvidenceModelObserved+  OpenAICompletionsCli -> EvidenceCorrelated+  Custom _ -> EvidenceRequestedOnly++-- ============================================================+-- The caller's request+-- ============================================================++-- | Whether a caller merely wants evidence or requires it.+data EvidenceStrictness+  = -- | Record whatever this transport can supply. Never fails a call+    -- for evidence reasons. This is the behaviour every existing+    -- caller gets.+    EvidenceBestEffort+  | -- | Refuse, before dispatch, to run this call on a transport that+    -- cannot reach the required strength or that would weaken the+    -- requested thinking level.+    EvidenceRequired !EvidenceStrength+  deriving stock (Eq, Show, Generic)++-- | Encoded by hand rather than derived, because a generically derived+-- sum encoding for a constructor carrying a payload would put the+-- strength somewhere a reader has to guess at:+-- @{"mode":"best_effort"}@ and+-- @{"mode":"required","strength":"model_observed"}@.+instance ToJSON EvidenceStrictness where+  toJSON = \case+    EvidenceBestEffort -> object ["mode" .= ("best_effort" :: Text)]+    EvidenceRequired s ->+      object ["mode" .= ("required" :: Text), "strength" .= s]++instance FromJSON EvidenceStrictness where+  parseJSON = \case+    Object o -> do+      m <- o .: "mode"+      case m :: Text of+        "best_effort" -> pure EvidenceBestEffort+        "required" -> EvidenceRequired <$> o .: "strength"+        other -> fail ("unknown evidence strictness: " <> show other)+    v -> typeMismatch "EvidenceStrictness" v++-- | A caller's per-call request for evidence, set through+-- @Baikai.Options.evidence@. A call whose evidence field is 'Nothing'+-- behaves exactly as it did before this vocabulary existed: no digest+-- is computed, no call identifier is generated for evidence purposes,+-- and no evidence is emitted.+data EvidenceRequest = EvidenceRequest+  { -- | The caller's identifier for the logical unit of work this call+    -- belongs to. Baikai treats it as opaque text and never parses it.+    runId :: !Text,+    strictness :: !EvidenceStrictness,+    -- | Which attempt this is, when the caller is retrying. One-based.+    -- Baikai has no retry or fallback loop of its own, so this is+    -- provenance the caller supplies, not something Baikai observes.+    attempt :: !Natural,+    -- | The call id of the attempt this one supersedes, when the+    -- caller is retrying or falling back.+    supersedes :: !(Maybe Text)+  }+  deriving stock (Eq, Show, Generic)++instance ToJSON EvidenceRequest where+  toJSON = genericToJSON evidenceJsonOptions++instance FromJSON EvidenceRequest where+  parseJSON = genericParseJSON evidenceJsonOptions++-- | Request best-effort evidence for a call belonging to the given+-- run: attempt one, superseding nothing.+evidenceRequest :: Text -> EvidenceRequest+evidenceRequest rid =+  EvidenceRequest+    { runId = rid,+      strictness = EvidenceBestEffort,+      attempt = 1,+      supersedes = Nothing+    }++-- ============================================================+-- The evidence record+-- ============================================================++-- | The schema identifier for 'ModelCallEvidence'. Consumers pin+-- against this string.+--+-- Bump the minor component when a field is added in a way that leaves+-- existing readers working; bump the major component when a field is+-- removed, changes meaning, or when 'canonicalEncode' changes, since+-- that invalidates every previously recorded digest.+evidenceSchemaVersion :: Text+evidenceSchemaVersion = "baikai.model-call-evidence/1.0"++-- | Everything Baikai can say about one completed provider call.+--+-- The field order is the story the record tells: who ran it, where it+-- went, what was asked, what came back, how it went, and what it costs+-- to believe.+data ModelCallEvidence = ModelCallEvidence+  { -- Identity -------------------------------------------------------++    -- | Always 'evidenceSchemaVersion' for records this build produces.+    schemaVersion :: !Text,+    -- | The caller's identifier for the logical unit of work.+    runId :: !Text,+    -- | This call's globally unique identifier, from 'newCallId'.+    callId :: !Text,+    -- | Which attempt this is, one-based, as supplied by the caller.+    attempt :: !Natural,+    -- | The 'callId' of the attempt this one supersedes, as supplied+    -- by the caller. Baikai has no retry loop and never fills this in+    -- itself.+    supersedes :: !(Maybe Text),+    -- Where it went --------------------------------------------------+    endpoint :: !EndpointIdentity,+    -- What was requested ---------------------------------------------++    -- | The model identifier the caller configured. This is what was+    -- /asked for/; see 'observedModel' for what the provider said it+    -- ran.+    requestedModel :: !Text,+    -- | What the caller's reasoning-effort preference became on the+    -- wire, including every downgrade applied on the way.+    thinking :: !ThinkingTranslation,+    -- What came back -------------------------------------------------++    -- | The model identifier the provider reported running.+    -- 'Unobserved' when the provider did not echo one or the transport+    -- cannot carry it. Never backfilled from 'requestedModel'.+    observedModel :: !(Observed Text),+    -- | The provider's own description of the thinking configuration+    -- it applied, when it reports one.+    --+    -- Reasoning-token counts do /not/ belong here. They live in+    -- 'usage', and they are corroborating evidence about output+    -- volume, not a statement of which effort setting was applied.+    observedThinking :: !(Observed Text),+    -- | The provider's identifier for this response.+    responseId :: !(Observed Text),+    -- | The provider's request-correlation identifier, typically from+    -- a response header, used to locate this call in the provider's+    -- own records.+    providerRequestId :: !(Observed Text),+    -- | The identifier Baikai put on the outgoing request, when it+    -- sent one. Unlike the two fields above this is something Baikai+    -- knows by construction rather than observes, so it is 'Maybe' and+    -- not 'Observed'.+    clientRequestId :: !(Maybe Text),+    -- How it went ----------------------------------------------------+    startedAt :: !UTCTime,+    endedAt :: !UTCTime,+    latencyMs :: !Int,+    status :: !CallStatus,+    -- | 'Nothing' exactly when 'status' is 'CallSucceeded'.+    errorInfo :: !(Maybe BaikaiError),+    -- | The token accounting the provider reported.+    --+    -- This is 'Observed' rather than a bare 'Baikai.Usage.Usage'+    -- because the existing code substitutes+    -- 'Baikai.Usage.zeroUsage' when a provider reports nothing. In a+    -- cost log that substitution is harmless; in evidence it is a+    -- false statement that the call consumed no tokens.+    usage :: !(Observed Usage),+    -- What it proves -------------------------------------------------++    -- | This record's honest self-assessment. Derived from which+    -- observed fields the transport actually filled in.+    strength :: !EvidenceStrength,+    -- | 'commitmentDigest' of the request envelope.+    requestCommitment :: !Text,+    -- | 'configurationDigest' of the request envelope.+    requestConfiguration :: !Text,+    -- | 'commitmentDigest' of the response envelope. 'Unobserved' when+    -- the call failed before any response body arrived: recording an+    -- empty-string digest there would be a fabrication.+    responseCommitment :: !(Observed Text)+  }+  deriving stock (Eq, Show, Generic)++-- | Evidence is emitted as JSON and consumed out of process. There is+-- deliberately no 'FromJSON' instance: 'Baikai.Usage.Usage' embeds a+-- 'Baikai.Cost.Cost', whose exact 'Rational' amounts are encoded+-- through an approximating 'Data.Scientific.Scientific', so a decoder+-- could not round-trip a record faithfully and would be claiming a+-- fidelity it does not have. Read an emitted record as a plain+-- 'Data.Aeson.Value' and match on 'evidenceSchemaVersion'.+instance ToJSON ModelCallEvidence where+  toJSON = genericToJSON evidenceJsonOptions++-- | The evidence any transport can always produce: identity, endpoint,+-- requested model, thinking translation, timing, status, and the two+-- request digests.+--+-- Every observed field starts 'Unobserved', 'errorInfo' starts+-- 'Nothing', and 'strength' starts at 'EvidenceRequestedOnly'. A+-- transport that learns more overwrites those fields and raises the+-- strength. Construct through this rather than with the record+-- constructor, so that a field added in a later release cannot be left+-- uninitialised at a call site.+baseEvidence ::+  EvidenceRequest ->+  -- | Call id, from 'newCallId'.+  Text ->+  EndpointIdentity ->+  -- | Requested model id.+  Text ->+  ThinkingTranslation ->+  -- | Started at.+  UTCTime ->+  -- | Ended at.+  UTCTime ->+  CallStatus ->+  -- | Request commitment digest.+  Text ->+  -- | Request configuration digest.+  Text ->+  ModelCallEvidence+baseEvidence+  EvidenceRequest {runId = rid, attempt = att, supersedes = prev}+  cid+  ep+  reqModel+  translation+  started+  ended+  st+  commitment+  configuration =+    ModelCallEvidence+      { schemaVersion = evidenceSchemaVersion,+        runId = rid,+        callId = cid,+        attempt = att,+        supersedes = prev,+        endpoint = ep,+        requestedModel = reqModel,+        thinking = translation,+        observedModel = Unobserved,+        observedThinking = Unobserved,+        responseId = Unobserved,+        providerRequestId = Unobserved,+        clientRequestId = Nothing,+        startedAt = started,+        endedAt = ended,+        latencyMs = millisBetween started ended,+        status = st,+        errorInfo = Nothing,+        usage = Unobserved,+        strength = EvidenceRequestedOnly,+        requestCommitment = commitment,+        requestConfiguration = configuration,+        responseCommitment = Unobserved+      }++-- | Whole milliseconds between two instants, rounded. Matches the+-- latency arithmetic @Baikai.Trace@ already uses for @CallFinished@ so+-- the two records agree on the same call.+millisBetween :: UTCTime -> UTCTime -> Int+millisBetween a b = round (realToFrac (diffUTCTime b a) * (1000 :: Double))++-- ============================================================+-- Canonical encoding+-- ============================================================++-- | Encode a JSON value to bytes such that two equal values always+-- produce byte-identical output.+--+-- The rules, which a later maintainer must preserve:+--+-- * Object keys are emitted in ascending order by their UTF-8 byte+--   sequence, recursively. Aeson's @Object@ is a @KeyMap@ whose+--   iteration order is unspecified and in practice depends on+--   insertion history, so the order is imposed here rather than+--   inherited.+--+-- * Array order is preserved, because array order is semantically+--   meaningful.+--+-- * There is no insignificant whitespace: no space after a colon or a+--   comma, and no trailing newline.+--+-- * Strings are UTF-8 with the minimal escaping JSON requires:+--   @\\"@, @\\\\@, the five short control escapes, and @\\u@ followed+--   by four /lowercase/ hexadecimal digits for any other character+--   below @U+0020@. Nothing else is escaped. The escaper is written+--   out here rather than borrowed from aeson so that an aeson upgrade+--   cannot silently change a digest.+--+-- * Numbers are normalised before rendering, so @1@, @1.0@, @1.00@,+--   and @1e0@ all produce the bytes @1@. An integral value renders as+--   a plain integer with no decimal point and no exponent; anything+--   else renders fixed-point with no exponent.+--+-- Changing any of these rules invalidates every digest recorded by an+-- earlier build. Treat such a change as a major bump of+-- 'evidenceSchemaVersion', not as a bug fix.+canonicalEncode :: Value -> ByteString+canonicalEncode =+  LazyByteString.toStrict . Builder.toLazyByteString . buildCanonical++buildCanonical :: Value -> Builder+buildCanonical = \case+  Null -> Builder.byteString "null"+  Bool True -> Builder.byteString "true"+  Bool False -> Builder.byteString "false"+  Number n -> buildNumber n+  String t -> buildString t+  Array xs ->+    Builder.char7 '['+      <> mconcat (intersperse (Builder.char7 ',') (map buildCanonical (Vector.toList xs)))+      <> Builder.char7 ']'+  Object o ->+    Builder.char7 '{'+      <> mconcat (intersperse (Builder.char7 ',') (map member (KeyMap.toAscList o)))+      <> Builder.char7 '}'+  where+    member (k, v) = buildString (Key.toText k) <> Builder.char7 ':' <> buildCanonical v++-- | Render a number with exactly one spelling per mathematical value.+-- 'Scientific.normalize' strips trailing zeros from the coefficient+-- first, without which @1.1@ and @1.100@ — which aeson parses into+-- different 'Scientific' values — would encode to different bytes.+buildNumber :: Scientific -> Builder+buildNumber raw+  | Scientific.isInteger n = Builder.integerDec (truncate n)+  | otherwise = Builder.string7 (Scientific.formatScientific Fixed Nothing n)+  where+    n = Scientific.normalize raw++buildString :: Text -> Builder+buildString t =+  Builder.char7 '"' <> Text.foldr (\c acc -> escapeChar c <> acc) mempty t <> Builder.char7 '"'++escapeChar :: Char -> Builder+escapeChar = \case+  '"' -> Builder.byteString "\\\""+  '\\' -> Builder.byteString "\\\\"+  '\n' -> Builder.byteString "\\n"+  '\r' -> Builder.byteString "\\r"+  '\t' -> Builder.byteString "\\t"+  '\b' -> Builder.byteString "\\b"+  '\f' -> Builder.byteString "\\f"+  c+    | c < '\x20' -> Builder.byteString "\\u" <> hex4 (ord c)+    | otherwise -> Builder.charUtf8 c++hex4 :: Int -> Builder+hex4 n = mconcat [Builder.char7 (hexDigit (n `shiftR` s)) | s <- [12, 8, 4, 0]]++-- | The low nibble of a value as a lowercase hexadecimal character.+hexDigit :: (Integral a, Bits a) => a -> Char+hexDigit v = "0123456789abcdef" !! fromIntegral (v .&. 0xF)++-- | SHA-256 of the canonical encoding, rendered as 64 lowercase+-- hexadecimal characters and prefixed with the algorithm so the string+-- is self-describing: @"sha256:1b4f0e98…"@.+--+-- @Base16.encode@ emits lowercase ASCII, so decoding it as Latin-1 is+-- total and gives the same characters.+digestOf :: Value -> Text+digestOf v =+  "sha256:"+    <> TextEncoding.decodeLatin1 (Base16.encode (SHA256.hash (canonicalEncode v)))++-- ============================================================+-- The two digests+-- ============================================================++-- | A commitment to the exact request body Baikai sent, prompt content+-- included.+--+-- The digest reveals nothing on its own: publishing it does not+-- disclose the prompt. Anyone who independently holds the request can+-- recompute this value and confirm that a given evidence record+-- describes that request — which is what makes it possible to bind a+-- recorded call to a reviewed artifact.+--+-- Nothing is redacted here, because credentials travel in HTTP headers+-- and command-line environments, never in a request body, and headers+-- are not part of this function's input.+commitmentDigest :: Value -> Text+commitmentDigest = digestOf++-- | A digest over the request's configuration only, with all content+-- removed by 'configurationProjection'.+--+-- Two calls that ask the same model the same way about different+-- subjects produce the same value here. That is the point: this digest+-- is safe to compare across runs that legitimately differ in content.+-- It proves /how/ a call was configured and deliberately proves+-- nothing about /what/ was asked, so it must never be presented as+-- binding a run to any particular input. Use 'commitmentDigest' for+-- that.+configurationDigest :: Value -> Text+configurationDigest = digestOf . configurationProjection++-- | Reduce a request envelope to the configuration it expresses,+-- discarding everything that carries content.+--+-- This is an explicit __allow-list__, never a denylist, and the+-- distinction is not stylistic. A denylist over request bodies from+-- the Anthropic Messages API and seven different OpenAI-compatible+-- hosts will miss a field the first time any one of them adds one, and+-- the failure mode is prompt content leaking into a digest that+-- callers were told is content-free. An allow-list fails the other+-- way: a genuinely new configuration field is silently omitted from+-- the digest until someone adds it here, which loses fidelity rather+-- than leaking.+--+-- Keys outside the list are dropped entirely. Three keys are kept but+-- replaced with structural summaries: @messages@ becomes one object+-- per message carrying its role, its block count, and the total+-- character length of every string inside it; @system@ becomes just+-- that character count; @tools@ becomes each tool's name and nothing+-- else, so descriptions and JSON schemas do not survive.+--+-- A top-level value that is not an object has no named fields for the+-- allow-list to admit, so it projects to 'Null' rather than passing+-- through.+configurationProjection :: Value -> Value+configurationProjection = \case+  Object o -> Object (KeyMap.fromList (concatMap keep (KeyMap.toAscList o)))+  _ -> Null+  where+    keep (k, v) = case Key.toText k of+      "messages" -> [(k, summariseMessages v)]+      "system" -> [(k, charSummary v)]+      "tools" -> [(k, summariseTools v)]+      name+        | name `Set.member` configurationKeys -> [(k, v)]+        | otherwise -> []++-- | The request fields that describe how a call is configured rather+-- than what it says. Covers the Anthropic Messages API and the+-- OpenAI-compatible Chat Completions shapes this repository builds.+configurationKeys :: Set Text+configurationKeys =+  Set.fromList+    [ "cache_control",+      "enable_thinking",+      "frequency_penalty",+      "max_completion_tokens",+      "max_tokens",+      "model",+      "output_config",+      "presence_penalty",+      "reasoning",+      "reasoning_effort",+      "response_format",+      "seed",+      "stop_sequences",+      "stream",+      "temperature",+      "thinking",+      "tool_choice",+      "top_p"+    ]++summariseMessages :: Value -> Value+summariseMessages = \case+  Array xs -> Array (fmap summariseMessage xs)+  _ -> Null++summariseMessage :: Value -> Value+summariseMessage = \case+  Object m ->+    object+      [ "role" .= roleOf (KeyMap.lookup "role" m),+        "blocks" .= blockCount (KeyMap.lookup "content" m),+        "chars" .= maybe 0 totalStringChars (KeyMap.lookup "content" m)+      ]+  _ -> Null+  where+    roleOf = \case+      Just (String r) -> String r+      _ -> Null+    blockCount :: Maybe Value -> Int+    blockCount = \case+      Just (Array a) -> Vector.length a+      Just Null -> 0+      Nothing -> 0+      Just _ -> 1++-- | Total characters across every JSON string anywhere inside a value.+-- Recursive on purpose: a content block's text can sit at any depth,+-- and a count is a structural fact that reveals nothing about what was+-- written.+totalStringChars :: Value -> Int+totalStringChars = \case+  String t -> Text.length t+  Array xs -> sum (fmap totalStringChars xs)+  Object o -> sum (fmap totalStringChars (KeyMap.elems o))+  _ -> 0++charSummary :: Value -> Value+charSummary v = object ["chars" .= totalStringChars v]++-- | A tool reduces to its name. The name is configuration — which+-- capabilities the call offered — while the description and input+-- schema are author-written content. Both wire shapes are handled: the+-- Anthropic form with @name@ at the top level, and the OpenAI form+-- that nests it under @function@.+summariseTools :: Value -> Value+summariseTools = \case+  Array xs -> Array (fmap summariseTool xs)+  _ -> Null++summariseTool :: Value -> Value+summariseTool = \case+  Object t -> object ["name" .= nameOf t]+  _ -> Null+  where+    nameOf t = case KeyMap.lookup "name" t of+      Just n@(String _) -> n+      _ -> case KeyMap.lookup "function" t of+        Just (Object f) -> case KeyMap.lookup "name" f of+          Just n@(String _) -> n+          _ -> Null+        _ -> Null++-- ============================================================+-- Identifiers+-- ============================================================++-- | A globally unique call identifier: 32 lowercase hexadecimal+-- characters carrying 128 bits, laid out as 48 bits of Unix time in+-- milliseconds, then 48 bits of a per-process random seed drawn once+-- at first use, then a 32-bit process-local counter.+--+-- The time prefix comes first so that identifiers sort+-- chronologically. The seed is what distinguishes two processes; the+-- counter is what distinguishes two calls within one. The counter+-- wrapping after 2^32 calls is harmless, because the millisecond+-- prefix will have moved on long before.+--+-- This replaces the previous generator, which combined the process+-- start /second/ with a process-local counter and therefore produced+-- identical identifier sequences in two processes started within the+-- same second. For ordinary tracing that was a minor collision hazard;+-- for evidence that another system correlates into a run, it was a+-- correctness defect.+--+-- Generating an identifier costs one atomic counter increment and one+-- clock read, and performs no syscall for randomness. That matters+-- because this function sits on the trace path for every call whether+-- or not the caller asked for evidence, and a per-call read from the+-- system random source would charge people who never asked for one.+--+-- These identifiers are __not secrets__. They are not capabilities,+-- they are not unguessable, and they must not be used as one. Their+-- only job is to correlate records.+newCallId :: IO Text+newCallId = do+  n <- atomicModifyIORef' callIdCounter (\k -> (k + 1, k))+  now <- getPOSIXTime+  let millis = floor (now * 1000) :: Word64+      seed = callIdSeed .&. 0xFFFFFFFFFFFF+      high = ((millis .&. 0xFFFFFFFFFFFF) `shiftL` 16) .|. (seed `shiftR` 32)+      low = ((seed .&. 0xFFFFFFFF) `shiftL` 32) .|. (n .&. 0xFFFFFFFF)+  pure (hex16 high <> hex16 low)++hex16 :: Word64 -> Text+hex16 w = Text.pack [hexDigit (w `shiftR` s) | s <- [60, 56 .. 0]]++callIdCounter :: IORef Word64+callIdCounter = unsafePerformIO (newIORef 0)+{-# NOINLINE callIdCounter #-}++-- | Sixty-four bits drawn once from @\/dev\/urandom@, of which+-- 'newCallId' uses the low forty-eight.+--+-- Read with 'hGet' rather than @ByteString.readFile@: @readFile@ asks+-- for the file's size, gets zero for a character device, and then+-- reads until end of file — which @\/dev\/urandom@ never reaches.+--+-- If the read fails for any reason, the seed falls back to the current+-- time in nanoseconds. That is weaker — two processes starting within+-- the same nanosecond would share a seed — but it is still far+-- stronger than the per-second base this generator replaced, and it+-- keeps a failure to open a device file from taking down a library+-- that only wanted to name a call.+callIdSeed :: Word64+callIdSeed = unsafePerformIO $ do+  drawn <-+    try (withBinaryFile "/dev/urandom" ReadMode (\h -> ByteString.hGet h 8)) ::+      IO (Either SomeException ByteString)+  case drawn of+    Right bytes+      | ByteString.length bytes == 8 ->+          pure (ByteString.foldl' (\acc b -> (acc `shiftL` 8) .|. fromIntegral b) 0 bytes)+    _ -> do+      now <- getPOSIXTime+      pure (floor (now * 1000000000))+{-# NOINLINE callIdSeed #-}

@@ -0,0 +1,434 @@+{-# LANGUAGE LambdaCase #-}++-- | Building a 'ModelCallEvidence' from what every transport already+-- knows.+--+-- "Baikai.Evidence" is the vocabulary and is deliberately free of any+-- dependency on 'Model' or 'Options'. This module is the bridge: it+-- reads the caller's request out of 'Options', the endpoint out of+-- 'Model', and produces the record a provider adapter attaches to its+-- terminal stream event.+--+-- Four adapters call 'minimalEvidence' and a fifth path (dispatch that+-- found no registered provider) calls it too. Putting the construction+-- here rather than in each adapter keeps them from drifting, and — more+-- importantly — puts the caller's opt-out gate somewhere an adapter+-- cannot forget it.+module Baikai.Evidence.Build+  ( minimalEvidence,+    prepareEvidence,+    endpointIdentity,+    sanitizeEndpoint,+    dispatchEnvelope,+    transportForModel,+    baikaiPackageVersion,++    -- * Trace-sink failure policy+    onSinkFailure,+    sinkFailureIsFatal,+    sinkFailureError,++    -- * The pre-dispatch strictness gate+    EvidenceRefusal (..),+    renderEvidenceRefusal,+    checkEvidenceRequirements,+    refusalError,+  )+where++import Baikai.Api (Api (..), renderApi)+import Baikai.Error (BaikaiError, invalidRequest, providerError)+import Baikai.Evidence+  ( CallStatus,+    EndpointIdentity (..),+    EvidenceStrength,+    EvidenceStrictness (..),+    ModelCallEvidence (..),+    ThinkingAdjustment (..),+    ThinkingTranslation (..),+    TransportKind (..),+    baseEvidence,+    commitmentDigest,+    configurationDigest,+    declaredStrength,+    newCallId,+    renderEvidenceStrength,+  )+import Baikai.Model (Model)+import Baikai.Options (Options)+import Baikai.Prelude+import Baikai.ThinkingLevel (renderThinkingLevel)+import Control.Exception (SomeException, displayException)+import Data.Aeson qualified as Aeson+import Data.Maybe (fromMaybe)+import Data.Text qualified as Text+import Data.Time (UTCTime)+import Data.Version (showVersion)+import Paths_baikai qualified as Paths+import System.IO (hPutStrLn, stderr)++-- | The version of the @baikai@ package that produced an evidence+-- record, read from the cabal-generated @Paths_baikai@ module.+--+-- Read once, centrally, rather than hardcoded per adapter. Five+-- packages construct evidence, and a literal in each of them becomes a+-- lie the first time one is missed during a release.+baikaiPackageVersion :: Text+baikaiPackageVersion = Text.pack (showVersion Paths.version)++-- | Build the evidence every transport can produce without observing+-- anything: identity from the caller's+-- 'Baikai.Evidence.EvidenceRequest', endpoint from the 'Model', the+-- requested model id, the supplied translation, the timings, the+-- status, and the two request digests. Every observed field is+-- 'Baikai.Evidence.Unobserved' and the strength is+-- 'Baikai.Evidence.EvidenceRequestedOnly'.+--+-- Returns 'Nothing' when the caller set no @evidence@ field in+-- 'Options'. That is the opt-out path and it must stay genuinely free:+-- no digest is computed, no call identifier is generated, and the+-- @envelope@ argument is never forced. The gate lives here rather than+-- at each adapter's call site so that an adapter cannot forget it and a+-- transport added later inherits it.+--+-- A transport that learns more overwrites the observed fields and+-- raises the strength; it must never overwrite a requested field with+-- an observed one or the reverse.+minimalEvidence ::+  Model ->+  Options ->+  TransportKind ->+  ThinkingTranslation ->+  -- | The request envelope, used for the two digests. API providers+  -- pass the JSON body they are about to send; subprocess providers+  -- pass their argument vector rendered as a JSON array.+  --+  -- __Deliberately lazy, and deliberately without the bang every other+  -- field in this package carries.__ On the opt-out path this thunk is+  -- discarded unforced, so an adapter may pass an expression that costs+  -- something to evaluate without charging callers who opted out. The+  -- missing strictness annotation is load-bearing; a test in+  -- @baikai/test/TraceSpec.hs@ passes an envelope that throws when+  -- forced and asserts an opted-out call still succeeds, so adding a+  -- bang here fails the build rather than silently costing every caller+  -- two SHA-256 passes over every prompt.+  Aeson.Value ->+  -- | Started at.+  UTCTime ->+  -- | Ended at.+  UTCTime ->+  CallStatus ->+  -- | The normalized error, which must be 'Just' exactly when the+  -- status is not 'CallSucceeded'. 'ModelCallEvidence' keeps the status+  -- and the error as separate fields because that is the shape the JSON+  -- schema needs, and their correlation is stated in the record's own+  -- documentation rather than enforced by the type.+  Maybe BaikaiError ->+  IO (Maybe ModelCallEvidence)+minimalEvidence m opts transport translation envelope started ended st err = do+  mk <- prepareEvidence m opts transport translation envelope started+  pure (fmap (\finish -> finish ended st err) mk)++-- | 'minimalEvidence' for a transport that learns its terminal+-- timestamp and status later than it learns everything else.+--+-- A streaming adapter has the request envelope in hand before the first+-- byte comes back and the outcome only at the last, and the parts of+-- its translator that see the terminal event are usually pure. This+-- does the 'IO' half once — the opt-out check and the call identifier —+-- and hands back a function the adapter applies at the terminal.+--+-- 'Nothing' is the opt-out path and carries the same guarantees+-- 'minimalEvidence' documents: no identifier is generated and the+-- envelope is never forced. Do not reach for this when the outcome is+-- already known; 'minimalEvidence' says the same thing with less+-- ceremony.+prepareEvidence ::+  Model ->+  Options ->+  TransportKind ->+  ThinkingTranslation ->+  -- | The request envelope. Lazy, for the reason 'minimalEvidence'+  -- documents at length.+  Aeson.Value ->+  -- | Started at.+  UTCTime ->+  IO (Maybe (UTCTime -> CallStatus -> Maybe BaikaiError -> ModelCallEvidence))+prepareEvidence m opts transport translation envelope started =+  case opts ^. #evidence of+    Nothing -> pure Nothing+    Just req -> do+      cid <- newCallId+      let ep = endpointIdentity m transport+          commitment = commitmentDigest envelope+          configuration = configurationDigest envelope+      pure $+        Just $ \ended st err ->+          ( baseEvidence+              req+              cid+              ep+              (m ^. #modelId)+              translation+              started+              ended+              st+              commitment+              configuration+          )+            { errorInfo = err+            }++-- | Where a call went, without recording a credential.+--+-- 'implementationVersion' is left 'Nothing' here. An API provider knows+-- its vendor package version and a subprocess provider can probe its+-- executable, but neither fact is available to the core, and inventing+-- one would be worse than admitting the gap.+endpointIdentity :: Model -> TransportKind -> EndpointIdentity+endpointIdentity m transport =+  EndpointIdentity+    { provider = m ^. #provider,+      api = renderApi (m ^. #api),+      transport = transport,+      endpoint = sanitizeEndpoint (m ^. #baseUrl),+      baikaiVersion = baikaiPackageVersion,+      implementationVersion = Nothing+    }++-- | Reduce a base URL to scheme, host, port, and path.+--+-- The query string is dropped __wholesale__ rather than filtered field+-- by field, because some gateways carry an API key in a query+-- parameter and an allow-list of safe parameter names would be wrong+-- the first time a host invented one. Any @userinfo@ component+-- (@https:\/\/user:secret\@host\/@) is dropped for the same reason. A+-- fragment cannot carry a credential to a server but is dropped too,+-- since it is never part of what was requested.+--+-- An empty base URL yields 'Nothing' rather than an empty string, so a+-- reader can tell "baikai recorded no endpoint" from "the endpoint was+-- the empty string".+sanitizeEndpoint :: Text -> Maybe Text+sanitizeEndpoint raw+  | Text.null trimmed = Nothing+  | Text.null cleaned = Nothing+  | otherwise = Just cleaned+  where+    trimmed = Text.strip raw+    withoutFragment = Text.takeWhile (/= '#') trimmed+    withoutQuery = Text.takeWhile (/= '?') withoutFragment+    cleaned = dropUserInfo withoutQuery++-- | Drop a @user:password\@@ prefix from the authority component,+-- keeping the scheme. Splits on the last @\@@ before the first @\/@ of+-- the path so that an @\@@ later in the path is not mistaken for+-- userinfo.+dropUserInfo :: Text -> Text+dropUserInfo url =+  let (scheme, rest) = case Text.breakOn "://" url of+        (s, r) | not (Text.null r) -> (s <> "://", Text.drop 3 r)+        _ -> ("", url)+      (authority, path) = Text.break (== '/') rest+   in case Text.breakOnEnd "@" authority of+        (before, after) | not (Text.null before) -> scheme <> after <> path+        _ -> scheme <> authority <> path++-- | The request envelope for the paths where __no provider adapter ran+-- to completion__, and therefore no wire request body exists for this+-- process to digest.+--+-- There are three such paths: dispatch that found no registered handler+-- (@Baikai.Stream.streamRequestWith@ and+-- @Baikai.Provider.Registry.completeRequestWith@), a synchronous+-- handler that threw before returning a response+-- (@Baikai.Stream.liftCompleteToStream@), and a consumer that abandoned+-- the event stream before the terminal event+-- (@Baikai.Trace@'s finalizer).+--+-- What this commits to is baikai's own dispatch parameters, not a+-- provider request body. That distinction matters and the failure mode+-- is deliberately the safe one: a verifier who independently holds the+-- prompt recomputes a different value and concludes the record does not+-- describe their request, which is a false negative. The unsafe+-- direction — a digest that appears to bind a run to an artifact it+-- never saw — cannot arise. On the no-handler paths there is no+-- reduction at all, because no wire body ever existed.+--+-- Both keys are in the configuration allow-list+-- 'Baikai.Evidence.configurationProjection' recognises, so the+-- configuration digest over this envelope is meaningful rather than+-- degenerate.+dispatchEnvelope :: Model -> Options -> Aeson.Value+dispatchEnvelope m opts =+  Aeson.object+    [ "model" Aeson..= (m ^. #modelId),+      "max_tokens" Aeson..= fromMaybe (m ^. #maxOutputTokens) (opts ^. #maxTokens)+    ]++-- | The transport a model's 'Api' tag implies.+--+-- Only for the adapter-less paths above, where no implementation is+-- available to state its own transport. A real adapter passes the kind+-- it knows it used rather than calling this.+transportForModel :: Model -> TransportKind+transportForModel m = case m ^. #api of+  AnthropicMessagesCli -> TransportSubprocess+  OpenAICompletionsCli -> TransportSubprocess+  _ -> TransportHttpApi++-- ============================================================+-- The pre-dispatch strictness gate+-- ============================================================++-- | Why a strict call was refused before anything was sent.+data EvidenceRefusal+  = -- | The transport's declared maximum is below what the caller+    -- required. Carries the required strength, then the declared one.+    StrengthUnreachable !EvidenceStrength !EvidenceStrength+  | -- | The request would reach the wire expressing less than the caller+    -- asked for. Carries every adjustment that would apply.+    ThinkingWouldDowngrade ![ThinkingAdjustment]+  deriving stock (Eq, Show, Generic)++-- | An explanation an operator can act on. Every refusal names both the+-- thing that was required and the thing that is actually available,+-- because a refusal that says only "no" is a dead end.+renderEvidenceRefusal :: EvidenceRefusal -> Text+renderEvidenceRefusal = \case+  StrengthUnreachable needed declared ->+    "this transport can reach at most "+      <> renderEvidenceStrength declared+      <> " evidence, and the call required "+      <> renderEvidenceStrength needed+  ThinkingWouldDowngrade adjustments ->+    "the reasoning-effort request would not reach the provider as asked: "+      <> Text.intercalate "; " (map describeAdjustment adjustments)++-- | One downgrade, in words. These are the six places baikai weakens a+-- thinking request, and the whole point of strict mode is that a caller+-- can refuse each of them by name rather than discovering it in a trace+-- afterwards.+describeAdjustment :: ThinkingAdjustment -> Text+describeAdjustment = \case+  EffortClamped lvl wire ->+    renderThinkingLevel lvl <> " would be sent as " <> wire+  EffortCollapsedToToggle lvl ->+    renderThinkingLevel lvl+      <> " would become a bare on/off toggle, so this host cannot tell it from any other level"+  EffortOmitted lvl ->+    renderThinkingLevel lvl+      <> " would send no effort field at all, so the request is indistinguishable on the wire \+         \from the provider's own default"+  ThinkingDroppedUnsupportedModel lvl ->+    renderThinkingLevel lvl+      <> " would be dropped entirely, because this model does not advertise reasoning support"+  ThinkingDroppedUnsupportedHost lvl ->+    renderThinkingLevel lvl+      <> " would be dropped entirely, because this host exposes no reasoning controls"+  ThinkingDroppedBudgetExceeded lvl budget maxOut ->+    renderThinkingLevel lvl+      <> " would be dropped entirely, because its "+      <> Text.pack (show budget)+      <> "-token budget does not fit inside the resolved output ceiling of "+      <> Text.pack (show maxOut)++-- | The pre-dispatch gate: every reason this call must not proceed, or+-- an empty list when it may.+--+-- Every reason rather than the first, matching what+-- 'Baikai.Agent.applyAgentCeiling' already does for policy violations+-- and for the same reason: an operator fixing a configuration should see+-- all of it in one run rather than one thing per attempt.+--+-- __The translation argument is deliberately lazy and deliberately+-- carries no bang.__ Under 'EvidenceBestEffort' — which is every caller+-- who has not opted into strictness — this returns @[]@ without touching+-- it, so a provider's translation function is never run for them. That+-- matters because computing a translation means a host-compatibility+-- lookup and a model-capability check on every dispatch, for a feature+-- only strict callers use. A test in @baikai/test/StrictEvidenceSpec.hs@+-- passes a translation that throws when forced and asserts a best-effort+-- call still succeeds, so adding a bang here fails the build rather than+-- silently costing every caller.+--+-- The downgrade rule needs one judgement stated, because it is not+-- obvious. A caller who requested no level at all is never downgraded —+-- there is nothing to weaken, and 'Baikai.Evidence.noThinkingRequested'+-- carries no adjustments, so this falls out. But /every/ non-empty+-- adjustment list refuses, including+-- 'Baikai.Evidence.EffortOmitted', which is the subtlest: that request+-- is not weaker in effect, it is merely indistinguishable on the wire+-- from the provider's default. A caller who demanded strict evidence and+-- receives a request they cannot later prove asked for @high@ has not+-- got what they demanded.+checkEvidenceRequirements ::+  EvidenceStrictness -> Api -> ThinkingTranslation -> [EvidenceRefusal]+checkEvidenceRequirements EvidenceBestEffort _ _ = []+checkEvidenceRequirements (EvidenceRequired needed) api translation =+  [StrengthUnreachable needed declared | declared < needed]+    <> [ThinkingWouldDowngrade downgrades | not (null downgrades)]+  where+    declared = declaredStrength api+    downgrades = adjustments translation++-- | Turn a non-empty refusal list into the error the call fails with.+--+-- 'invalidRequest' rather than a provider error, because nothing reached+-- a provider: the call is refused on the caller's own terms, and a+-- retry-classifying consumer must not treat it as transient.+refusalError :: [EvidenceRefusal] -> BaikaiError+refusalError refusals =+  invalidRequest+    ( "strict evidence refused this call before dispatch: "+        <> Text.intercalate "; " (map renderEvidenceRefusal refusals)+    )++-- | Report a trace-sink failure on stderr.+--+-- Always, under either strictness. A strict caller /additionally/ has+-- their call failed — see 'sinkFailureIsFatal' — but they should still+-- see the operator-facing line, because the two audiences are different:+-- the message is for whoever is watching the process, and the failed+-- call is for the program.+onSinkFailure :: EvidenceStrictness -> SomeException -> IO ()+onSinkFailure _ e =+  hPutStrLn+    stderr+    ( "baikai: trace sink failed; trace events for this call were dropped: "+        <> displayException e+    )++-- | Whether a trace-sink failure must fail the call.+--+-- Under 'EvidenceBestEffort' it must not: reporting once on stderr and+-- letting the call succeed is baikai's long-standing behaviour and is+-- what every caller who has not opted into evidence gets.+--+-- Under 'EvidenceRequired' it must. A strict caller asked for a record+-- of this call and the record did not survive; the call succeeding+-- anyway would hand them an answer they cannot account for, and they+-- would have no way to notice. __Evidence that can vanish without the+-- caller noticing is not evidence__, which is the whole reason the mode+-- exists. This is the one place in baikai where a call that reached the+-- provider and came back is nevertheless reported as failed, and it is+-- deliberate.+sinkFailureIsFatal :: EvidenceStrictness -> Bool+sinkFailureIsFatal = \case+  EvidenceBestEffort -> False+  EvidenceRequired _ -> True++-- | The error a strict call fails with when its trace sink failed.+--+-- 'invalidRequest' would be wrong — nothing about the request was+-- invalid — and no provider category fits either, because the provider+-- did its job. It is baikai's own machinery that failed the caller, so+-- it is a plain provider-side error naming the sink and carrying the+-- sink's own message.+sinkFailureError :: SomeException -> BaikaiError+sinkFailureError e =+  providerError+    ( "the trace sink failed and this call required evidence, so its record was \+      \not written: "+        <> Text.pack (displayException e)+    )

@@ -32,6 +32,14 @@ -- for the mappings). EP-2 (shikumi) adds @responseFormat@, the -- provider-agnostic structured-output preference — see -- 'Baikai.ResponseFormat'.+--+-- 'evidence' is the per-call request for verifiable model-call+-- evidence — see 'Baikai.Evidence.EvidenceRequest'. It carries the+-- caller's run identifier and how strictly they need the evidence.+-- A call whose 'evidence' is 'Nothing', which is every call that does+-- not opt in, behaves exactly as it did before the field existed: no+-- digest is computed, no evidence is emitted, and the trace output is+-- unchanged. module Baikai.Options   ( Options,     maxTokens,@@ -44,6 +52,7 @@     cacheRetention,     thinking,     responseFormat,+    evidence,     topP,     stopSequences,     seed,@@ -56,6 +65,7 @@  import Baikai.Auth (ApiKeySource) import Baikai.CacheRetention (CacheRetention)+import Baikai.Evidence (EvidenceRequest) import Baikai.ResponseFormat (ResponseFormat) import Baikai.ThinkingLevel (ThinkingLevel) import Baikai.Tool (ToolChoice)@@ -78,6 +88,7 @@     cacheRetention :: !(Maybe CacheRetention),     thinking :: !(Maybe ThinkingLevel),     responseFormat :: !(Maybe ResponseFormat),+    evidence :: !(Maybe EvidenceRequest),     topP :: !(Maybe Double),     stopSequences :: !(Maybe (Vector Text)),     seed :: !(Maybe Integer),@@ -100,6 +111,7 @@       cacheRetention = Nothing,       thinking = Nothing,       responseFormat = Nothing,+      evidence = Nothing,       topP = Nothing,       stopSequences = Nothing,       seed = Nothing,

@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ -- | Internal helpers shared by the CLI providers in @baikai-claude@ -- and @baikai-openai@. --@@ -11,8 +13,23 @@     wrapSystemPrompt,     maybeApply,     decodeUtf8Lenient,+    trySync,++    -- * What a coding-agent CLI reported about its own run     extractAgentMessage,+    CodexRunReport (..),     parseCodexJsonlStream,+    ClaudeCliReport (..),+    decodeClaudeCliResult,++    -- * What baikai knows about the process it launched+    ExecutableIdentity (..),+    executableIdentity,++    -- * Evidence envelopes and strength+    argvEnvelope,+    cliResponseEnvelope,+    subprocessStrength,   ) where @@ -23,21 +40,41 @@     UserContent (..),   ) import Baikai.Context (Context)+import Baikai.Cost (Cost (..), zeroCost, zeroCostBreakdown)+import Baikai.Error (BaikaiError, decodeError)+import Baikai.Evidence (EvidenceStrength (..), Observed (..)) import Baikai.Message   ( AssistantPayload (..),     Message (..),     ToolResultPayload (..),     UserPayload (..),   )-import Control.Lens ((^.))-import Data.Aeson (Value)+import Baikai.StopReason (StopReason (..))+import Baikai.Usage (Usage (..))+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.Key (Key)+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap (KeyMap) import Data.Aeson.KeyMap qualified as KeyMap-import Data.Aeson.Types (parseMaybe, (.:?))+import Data.Aeson.Types (parseEither, parseMaybe, (.:), (.:?)) import Data.ByteString (ByteString) import Data.ByteString qualified as BS-import Data.Function ((&)) import Data.Generics.Labels ()+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, listToMaybe)+import Data.Scientific qualified as Scientific import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text@@ -45,10 +82,18 @@ import Data.Vector (Vector) import Data.Vector qualified as Vector import Data.Word (Word8)+import GHC.Generics (Generic)+import Numeric.Natural (Natural) import Streamly.Data.Fold qualified as Fold import Streamly.Data.Stream (Stream) import Streamly.Data.Stream qualified as Stream import Streamly.Data.Unfold qualified as Unfold+import System.Directory qualified as Directory+import System.Exit (ExitCode (..))+import System.FilePath (isPathSeparator)+import System.IO.Unsafe (unsafePerformIO)+import System.Process qualified as Process+import System.Timeout (timeout)  -- | Flatten a 'Context'\'s messages into a single prompt string -- suitable for a one-shot CLI invocation.@@ -125,6 +170,119 @@ decodeUtf8Lenient :: ByteString -> Text decodeUtf8Lenient = Text.decodeUtf8With Text.lenientDecode +-- | 'Control.Exception.try' that catches synchronous failures and lets+-- an asynchronous one through.+--+-- A subprocess provider turns a failed launch into an error-shaped+-- 'Baikai.Response.Response' rather than an exception, so it has to+-- catch broadly; swallowing a cancellation or a timeout while doing so+-- would make the caller's own control flow unreliable.+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)++-- ============================================================+-- Codex event-stream parsing+-- ============================================================++-- | What a @codex exec --json@ run reported about itself, beyond the+-- assistant text.+--+-- Every field but 'message' is optional because the tool's event schema+-- has changed across codex versions and a missing field is a genuine+-- absence rather than a parse failure. A field that is 'Nothing' here+-- must be recorded as 'Baikai.Evidence.Unobserved' downstream and must+-- never be filled in from the request.+data CodexRunReport = CodexRunReport+  { -- | The concatenated text of every @agent_message@ event.+    message :: !Text,+    -- | Codex's own handle for the conversation, from the+    -- thread-start event.+    threadId :: !(Maybe Text),+    -- | The model codex named alongside its token accounting. See+    -- 'codexTurn' for why it is only ever read from such an event.+    reportedModel :: !(Maybe Text),+    -- | The token counts codex reported, normalized into baikai's+    -- disjoint 'Usage' convention.+    usage :: !(Maybe Usage)+  }+  deriving stock (Eq, Show, Generic)++-- | The accumulator 'parseCodexJsonlStream' folds events into.+--+-- Separate from 'CodexRunReport' only because the message text arrives+-- in pieces and is kept reversed until the fold finishes.+data CodexAccumulator = CodexAccumulator+  { messages :: ![Text],+    threadId :: !(Maybe Text),+    reportedModel :: !(Maybe Text),+    usage :: !(Maybe Usage)+  }+  deriving stock (Generic)++emptyCodexAccumulator :: CodexAccumulator+emptyCodexAccumulator =+  CodexAccumulator+    { messages = [],+      threadId = Nothing,+      reportedModel = Nothing,+      usage = Nothing+    }++-- | Consume a stream of stdout bytes from @codex exec --json@, split on+-- newlines, decode each line as JSON, and fold the events into what the+-- run reported about itself.+--+-- A line that is not valid JSON is skipped rather than failing the run:+-- codex writes progress chatter to stderr, but a future version writing+-- a non-JSON line to stdout must not turn a completed model call into a+-- decode error.+parseCodexJsonlStream :: Stream IO ByteString -> IO CodexRunReport+parseCodexJsonlStream chunks = do+  let bytes :: Stream IO Word8+      bytes = Stream.unfoldEach Unfold.fromList (fmap BS.unpack chunks)+      lineFold = Fold.takeEndBy_ (== newlineByte) (Fold.foldl' BS.snoc BS.empty)+  acc <-+    Stream.foldMany lineFold bytes+      & Stream.mapMaybe Aeson.decodeStrict+      & Stream.fold (Fold.foldl' absorbCodexEvent emptyCodexAccumulator)+  pure+    CodexRunReport+      { message = Text.concat (reverse (acc ^. #messages)),+        threadId = acc ^. #threadId,+        reportedModel = acc ^. #reportedModel,+        usage = acc ^. #usage+      }++-- | Fold one decoded codex event into the accumulator.+--+-- The identifier keeps the __first__ value it sees, because the+-- thread-start event names the conversation and nothing later should+-- rename it. The token accounting keeps the __last__, because codex+-- emits one accounting event per turn and the final one is the one that+-- describes the completed run; summing them would double-count a+-- cumulative counter.+absorbCodexEvent :: CodexAccumulator -> Value -> CodexAccumulator+absorbCodexEvent acc v =+  withTurn+    ( acc+        & #messages %~ maybe id (:) (extractAgentMessage v)+        & #threadId %~ (<|> extractThreadId v)+    )+  where+    withTurn a = case codexTurn v of+      Nothing -> a+      Just (reported, counted) ->+        a+          & #usage .~ Just counted+          & #reportedModel .~ reported+ -- | Best-effort extractor for the assistant text inside a single -- Codex @--json@ event. See the original implementation's -- documentation for the schema variants accepted.@@ -163,21 +321,415 @@         Just (Aeson.String t) -> pure t         _ -> fail "no payload" --- | Consume a stream of stdout bytes from @codex exec --json@,--- split on newlines, decode each line as JSON, filter to--- @agent_message@ events, and return the concatenation of their--- payloads.-parseCodexJsonlStream :: Stream IO ByteString -> IO Text-parseCodexJsonlStream chunks = do-  let bytes :: Stream IO Word8-      bytes = Stream.unfoldEach Unfold.fromList (fmap BS.unpack chunks)-      lineFold = Fold.takeEndBy_ (== newlineByte) (Fold.foldl' BS.snoc BS.empty)-  msgs <--    Stream.foldMany lineFold bytes-      & Stream.mapMaybe Aeson.decodeStrict-      & Stream.mapMaybe extractAgentMessage-      & Stream.fold Fold.toList-  pure (Text.concat msgs)+-- | Apply a lookup to a codex event object, then to its nested @item@+-- and @msg@ objects, taking the first hit.+--+-- Codex has spelled its events all three ways across versions, which is+-- why 'extractAgentMessage' already tolerates each one. Every extractor+-- below inherits the same tolerance from here rather than repeating it.+inCodexEvent :: (KeyMap Value -> Maybe a) -> Value -> Maybe a+inCodexEvent f = \case+  Object o -> f o <|> nested o "item" <|> nested o "msg"+  _ -> Nothing+  where+    nested o k = case KeyMap.lookup k o of+      Just (Object io) -> f io+      _ -> Nothing +-- | Codex's own identifier for the conversation this run belongs to.+--+-- @codex-cli 0.146.0@ spells it @thread_id@ on a @thread.started@+-- event; older versions spelled the same thing @session_id@ and+-- @conversation_id@, and all three are accepted because a recorded+-- fixture from any of them must still parse.+extractThreadId :: Value -> Maybe Text+extractThreadId = inCodexEvent (firstString ["thread_id", "session_id", "conversation_id"])++-- | The token accounting from one codex event, and the model named on+-- that same event.+--+-- The model is deliberately read __only__ from an event that also+-- carries token counts. An event naming a model beside its token+-- accounting is saying which model consumed them, which is an+-- observation; an event naming a model anywhere else could just as+-- easily be echoing the @--model@ flag baikai passed in, and recording+-- a request echo as an observation is precisely the conflation this+-- record exists to prevent. At @codex-cli 0.146.0@ no event names a+-- model at all, so this yields 'Nothing' today and will pick one up+-- only if codex starts reporting one where it belongs.+codexTurn :: Value -> Maybe (Maybe Text, Usage)+codexTurn = inCodexEvent $ \o -> case KeyMap.lookup "usage" o of+  Just (Object u)+    | any (`KeyMap.member` u) codexUsageKeys ->+        Just (firstString ["model"] o, codexUsage u)+  _ -> Nothing++codexUsageKeys :: [Key]+codexUsageKeys =+  [ "input_tokens",+    "cached_input_tokens",+    "cache_write_input_tokens",+    "output_tokens",+    "reasoning_output_tokens"+  ]++-- | Normalize codex's usage block into baikai's disjoint convention.+--+-- Codex reports OpenAI-style inclusive prompt counts: @input_tokens@+-- contains @cached_input_tokens@, which is why codex's own display+-- arithmetic subtracts one from the other to show non-cached input. The+-- subtraction is clamped at zero because 'Natural' subtraction throws+-- on underflow.+--+-- @cache_write_input_tokens@ is carried through unmodified rather than+-- also subtracted. It is not part of the inclusive prompt total in any+-- codex version this repository has observed, and undercounting input+-- would be the worse of the two errors: it silently shrinks a call that+-- actually consumed the tokens.+codexUsage :: KeyMap Value -> Usage+codexUsage u =+  let prompt = natField u "input_tokens"+      cached = natField u "cached_input_tokens"+      written = natField u "cache_write_input_tokens"+      out = natField u "output_tokens"+      nonCached = if cached >= prompt then 0 else prompt - cached+   in Usage+        { inputTokens = nonCached,+          outputTokens = out,+          cacheReadTokens = cached,+          cacheWriteTokens = written,+          reasoningTokens = natFieldMaybe u "reasoning_output_tokens",+          totalTokens = nonCached + out + cached + written,+          cost = zeroCost+        }+ newlineByte :: Word8 newlineByte = 0x0a++-- ============================================================+-- Claude CLI result parsing+-- ============================================================++-- | What a @claude -p --output-format json@ run reported about itself.+--+-- The Haskell field is 'isError' where the tool's JSON field is+-- @is_error@: the record follows Haskell naming and the parser does the+-- mapping. 'reportedModel' and 'usage' are optional because the tool's+-- result schema varies by version, and an absent field must degrade to+-- 'Baikai.Evidence.Unobserved' rather than fail the decode.+data ClaudeCliReport = ClaudeCliReport+  { -- | The assistant's answer, or the error text when 'isError'.+    result :: !Text,+    isError :: !Bool,+    -- | The tool's own handle for the conversation.+    sessionId :: !(Maybe Text),+    -- | The model the tool reported as having consumed tokens. See+    -- 'soleModelUsageKey'.+    reportedModel :: !(Maybe Text),+    -- | The token counts and reported cost, when the tool included a+    -- usage block.+    usage :: !(Maybe Usage)+  }+  deriving stock (Eq, Show, Generic)++-- | Decode @claude -p --output-format json@ stdout.+--+-- The tool emits either a bare result object or — as it does at version+-- 2.1.222 — an array of events from which the one whose @type@ is+-- @result@ is the terminal record. Both shapes are accepted because+-- both have shipped.+decodeClaudeCliResult :: ByteString -> Either BaikaiError ClaudeCliReport+decodeClaudeCliResult bs = case Aeson.eitherDecodeStrict bs of+  Left err -> Left (decodeError (Text.pack err))+  Right (Array events) -> case findResultEvent events of+    Nothing -> Left (decodeError "claude -p: no result event in stdout array")+    Just ev -> parseResultEvent ev+  Right v@(Object _) -> parseResultEvent v+  Right _ -> Left (decodeError "claude -p: expected JSON object or array")++findResultEvent :: Vector Value -> Maybe Value+findResultEvent = Vector.find isResult+  where+    isResult (Object o) = case KeyMap.lookup "type" o of+      Just (String "result") -> True+      _ -> False+    isResult _ = False++parseResultEvent :: Value -> Either BaikaiError ClaudeCliReport+parseResultEvent v = case parseEither parser v of+  Left err -> Left (decodeError (Text.pack err))+  Right r -> Right r+  where+    parser = Aeson.withObject "claude-cli-result" $ \o -> do+      body <- o .: "result"+      failed <- o .: "is_error"+      session <- o .:? "session_id"+      pure+        ClaudeCliReport+          { result = body,+            isError = failed,+            sessionId = session,+            reportedModel = KeyMap.lookup "modelUsage" o >>= soleModelUsageKey,+            usage = claudeUsage o+          }++-- | The model @claude@ reported as having consumed tokens.+--+-- Read from the keys of the result event's @modelUsage@ map, which+-- names every model that actually billed tokens on this run — and+-- names it as the tool spells it, including a context-window variant+-- marker such as @[1m]@, because truncating that to the canonical name+-- would discard a real distinction between two things baikai can+-- request separately.+--+-- Exactly one key is an unambiguous statement of which model ran.+-- Several keys means several models did, and 'Baikai.Evidence' has one+-- 'Baikai.Evidence.observedModel' slot; picking one of them arbitrarily+-- would be a fabrication of specificity, so nothing is recorded.+soleModelUsageKey :: Value -> Maybe Text+soleModelUsageKey = \case+  Object mu -> case KeyMap.keys mu of+    [k] -> Just (Key.toText k)+    _ -> Nothing+  _ -> Nothing++-- | The token counts and reported cost from a @claude@ result event.+--+-- The tool reports Anthropic's already-disjoint prompt classes —+-- @input_tokens@ excludes both cache counters — so nothing is+-- subtracted here, unlike 'codexUsage'.+--+-- @total_cost_usd@ becomes 'Baikai.Cost.Cost'\'s @usd@ with an empty+-- per-class breakdown, because the tool reports one total and no+-- breakdown. Reporting the tool's own figure is the same correction as+-- reporting its own token counts: a hardcoded zero says the call was+-- free, which is a claim the tool never made.+claudeUsage :: KeyMap Value -> Maybe Usage+claudeUsage o = case KeyMap.lookup "usage" o of+  Just (Object u)+    | any (`KeyMap.member` u) claudeUsageKeys ->+        let i = natField u "input_tokens"+            out = natField u "output_tokens"+            cr = natField u "cache_read_input_tokens"+            cw = natField u "cache_creation_input_tokens"+         in Just+              Usage+                { inputTokens = i,+                  outputTokens = out,+                  cacheReadTokens = cr,+                  cacheWriteTokens = cw,+                  reasoningTokens = Nothing,+                  totalTokens = i + out + cr + cw,+                  cost = reportedCost+                }+  _ -> Nothing+  where+    reportedCost = case KeyMap.lookup "total_cost_usd" o of+      Just (Number n) | n > 0 -> Cost {usd = toRational n, breakdown = zeroCostBreakdown}+      _ -> zeroCost++claudeUsageKeys :: [Key]+claudeUsageKeys =+  [ "input_tokens",+    "output_tokens",+    "cache_read_input_tokens",+    "cache_creation_input_tokens"+  ]++-- ============================================================+-- Shared JSON field readers+-- ============================================================++-- | The first of the named keys whose value is a non-empty JSON string.+firstString :: [Key] -> KeyMap Value -> Maybe Text+firstString keys o =+  listToMaybe+    [t | k <- keys, Just (String t) <- [KeyMap.lookup k o], not (Text.null t)]++-- | A non-negative whole number from a JSON field, or zero.+--+-- A missing, negative, fractional, or absurdly large value reads as+-- zero rather than throwing: a token counter is describing a completed+-- model call, and no shape of counter is worth failing that call over.+natField :: KeyMap Value -> Key -> Natural+natField o k = fromMaybe 0 (natFieldMaybe o k)++-- | 'natField', but distinguishing an absent field from a reported+-- zero. 'Baikai.Usage.Usage'\'s @reasoningTokens@ needs the+-- distinction; its other counters do not.+natFieldMaybe :: KeyMap Value -> Key -> Maybe Natural+natFieldMaybe o k = case KeyMap.lookup k o of+  Just (Number n) -> case Scientific.toBoundedInteger n :: Maybe Int of+    Just i | i >= 0 -> Just (fromIntegral i)+    _ -> Nothing+  _ -> Nothing++-- ============================================================+-- Executable identity+-- ============================================================++-- | Identity of the executable a subprocess provider ran.+data ExecutableIdentity = ExecutableIdentity+  { -- | The name or path as configured.+    configured :: !Text,+    -- | The absolute path it resolved to on @PATH@, when resolution+    --   succeeded.+    resolvedPath :: !(Maybe Text),+    -- | What the tool prints for @--version@, trimmed to its first+    --   non-blank line. 'Nothing' when the probe failed or the tool has+    --   no such flag; a failed probe is recorded as absent rather than+    --   failing the call, because the call itself may well have+    --   succeeded and the absence is itself accurate evidence.+    version :: !(Maybe Text)+  }+  deriving stock (Eq, Show, Generic)++-- | Resolve and probe an executable, caching the result for the+-- lifetime of the process, keyed by the configured name.+--+-- Probing runs the tool once with @--version@. A version string is+-- stable for the lifetime of a baikai process in every realistic+-- deployment, and spawning an extra subprocess per model call would+-- roughly double the process cost of the cheapest possible call — so+-- the answer is cached, keyed by the configured name so a caller who+-- configures two different executables gets two correct answers.+--+-- Call this only from inside the evidence branch. A caller who never+-- asked for evidence must not pay for a process whose only purpose is+-- to describe a tool they were about to run anyway.+--+-- The probe is bounded by 'versionProbeMicros': a tool that hangs on+-- @--version@ must never be able to wedge a model call.+executableIdentity :: FilePath -> IO ExecutableIdentity+executableIdentity exe = do+  cached <- Map.lookup exe <$> readIORef executableIdentityCache+  case cached of+    Just identity -> pure identity+    Nothing -> do+      identity <- probeExecutable exe+      -- Insert only if still absent: two threads racing on the same+      -- executable must agree on one answer, and the first one written+      -- is as good as the second.+      atomicModifyIORef'+        executableIdentityCache+        (\m -> (Map.insertWith (\_ old -> old) exe identity m, ()))+      pure identity++probeExecutable :: FilePath -> IO ExecutableIdentity+probeExecutable exe = do+  resolved <- resolveExecutable exe+  probed <- maybe (pure Nothing) probeVersion resolved+  pure+    ExecutableIdentity+      { configured = Text.pack exe,+        resolvedPath = Text.pack <$> resolved,+        version = probed+      }++-- | Where a configured executable name actually points.+--+-- A name containing a path separator is a path and is checked+-- directly; a bare name is looked up on @PATH@. Doing the split here+-- rather than relying on 'Directory.findExecutable' to handle both+-- keeps the behaviour the same across @directory@ versions, which have+-- not always agreed on what a path-shaped argument means.+resolveExecutable :: FilePath -> IO (Maybe FilePath)+resolveExecutable exe+  | any isPathSeparator exe = do+      here <- Directory.doesFileExist exe+      if here then Just <$> Directory.makeAbsolute exe else pure Nothing+  | otherwise = Directory.findExecutable exe++probeVersion :: FilePath -> IO (Maybe Text)+probeVersion path = do+  outcome <- trySync (timeout versionProbeMicros (Process.readProcessWithExitCode path ["--version"] ""))+  pure $ case outcome of+    Right (Just (ExitSuccess, out, _)) -> firstNonBlankLine (Text.pack out)+    _ -> Nothing++-- | Five seconds.+--+-- The bound exists to stop a tool that /never/ answers from wedging a+-- model call, so any finite value solves the problem it is there for.+-- What a tighter bound buys is nothing; what it costs is a version+-- recorded as absent because the machine was busy when the probe ran.+-- Five seconds is paid at most once per executable per process, and+-- only on the pathological path.+versionProbeMicros :: Int+versionProbeMicros = 5000000++firstNonBlankLine :: Text -> Maybe Text+firstNonBlankLine = listToMaybe . filter (not . Text.null) . map Text.strip . Text.lines++-- | Resolved executable identities, keyed by the configured name.+--+-- The @unsafePerformIO@-plus-@NOINLINE@ idiom is the one+-- "Baikai.Provider.Registry" already uses for its global registry, so+-- the shape of a process-wide cache is the same wherever it appears in+-- this package.+executableIdentityCache :: IORef (Map FilePath ExecutableIdentity)+executableIdentityCache = unsafePerformIO (newIORef Map.empty)+{-# NOINLINE executableIdentityCache #-}++-- ============================================================+-- Evidence envelopes and strength+-- ============================================================++-- | The request envelope a subprocess provider hands to+-- 'Baikai.Evidence.Build.minimalEvidence': the rendered argument+-- vector, executable first, as a JSON array of strings.+--+-- This is the subprocess analogue of an API provider's request body,+-- and it is genuinely what crossed the boundary — there is no other+-- description of a process launch.+--+-- Both CLI providers place the prompt inside this vector, so+-- 'Baikai.Evidence.commitmentDigest' over it legitimately commits to+-- the prompt. 'Baikai.Evidence.configurationDigest' does not: its+-- projection admits named fields from an object and a JSON array has+-- none, so an argv envelope projects to @null@ and the configuration+-- digest reveals nothing about the command line at all. That is the+-- allow-list failing in the safe direction, which is what it is for.+argvEnvelope :: FilePath -> [String] -> Value+argvEnvelope exe args =+  Aeson.toJSON (map Text.pack (exe : args))++-- | What a subprocess call's response commitment digest commits to: the+-- assistant content, the stop reason, and the reported usage.+--+-- Spelled with the same three keys, in the same shapes, as the+-- Anthropic and OpenAI-compatible API transports build by hand in+-- @Baikai.Provider.Claude.Api@ and @Baikai.Provider.OpenAI.Api@. That+-- agreement is what lets a verifier holding a response recompute the+-- digest without first having to know which transport served it, so it+-- must not be allowed to drift.+--+-- A CLI provider produces exactly one text block and always stops with+-- 'Stop', which is why those two are fixed here rather than passed in.+cliResponseEnvelope :: Text -> Usage -> Value+cliResponseEnvelope body used =+  Aeson.object+    [ "content" .= Vector.singleton (AssistantText (TextContent body)),+      "stop_reason" .= Stop,+      "usage" .= used+    ]++-- | How much a subprocess call's evidence proves.+--+-- 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, what+-- effort was applied, or whether the request reached the intended+-- provider at all — so a successful exit never raises the strength, and+-- the exit status is deliberately not an argument to this function.+-- Only a value the tool itself reported can raise it.+subprocessStrength ::+  -- | The session or thread identifier the tool reported.+  Observed Text ->+  -- | The model the tool reported, if it reports one at all.+  Observed Text ->+  EvidenceStrength+subprocessStrength sessionIdentifier reported =+  case (reported, sessionIdentifier) of+    (Observed _, Observed _) -> EvidenceModelObserved+    (_, Observed _) -> EvidenceCorrelated+    _ -> EvidenceRequestedOnly

@@ -22,6 +22,7 @@     registerApiProvider,     assertRegistered,     lookupApiProviderWith,+    evidenceRefusals,     lookupApiProvider,     completeRequestWith,     completeRequest,@@ -35,10 +36,14 @@ import Baikai.Content (AssistantContent (..), ToolCall) import Baikai.Context (Context, appendToolResult, contextOf) import Baikai.Error (providerUnavailable)+import Baikai.Evidence (ThinkingTranslation, noThinkingRequested)+import Baikai.Evidence qualified as Evidence+import Baikai.Evidence.Build qualified as Build import Baikai.Message (AssistantPayload (..), ToolResult, toolResultErrorText, user) import Baikai.Model (Model) import Baikai.Model qualified as Model import Baikai.Options (Options, emptyOptions)+import Baikai.Options qualified as Options import Baikai.Response (Response (..), errorResponse, flattenAssistantBlocks, flattenAssistantText, responseError) import Baikai.StopReason (StopReason (..)) import Baikai.Stream.Event (AssistantMessageEvent)@@ -61,7 +66,21 @@ data ApiProvider = ApiProvider   { apiTag :: !Api,     stream :: !(Model -> Context -> Options -> Stream IO AssistantMessageEvent),-    complete :: !(Model -> Context -> Options -> IO Response)+    complete :: !(Model -> Context -> Options -> IO Response),+    -- | Describe, without sending anything, what this provider would do+    -- with the caller's reasoning-effort request.+    --+    -- Used only by the pre-dispatch strictness gate, which has to be+    -- able to refuse /before/ any request is built — so it cannot wait+    -- for the translation a provider returns alongside its mapped+    -- request. Implement it by calling the same function that builds+    -- that translation, never by writing a second one: two descriptions+    -- of one mapping diverge the first time either changes, and the+    -- divergence is silent.+    --+    -- Never called for a caller who set no @evidence@ request or who+    -- asked for best-effort evidence, which is every existing caller.+    describeThinking :: !(Model -> Options -> ThinkingTranslation)   }  -- | A mutable provider registry handle. Each handle owns its own handler map,@@ -136,15 +155,73 @@ completeRequestWith reg m ctx opts = do   mProvider <- lookupApiProviderWith reg (Model.api m)   case mProvider of-    Just p -> complete p m ctx opts+    Just p -> case evidenceRefusals p m opts of+      [] -> complete p m ctx opts+      refusals -> refusedResponse m opts (describeThinking p m opts) refusals     Nothing -> do       now <- getCurrentTime-      pure $-        errorResponse+      -- "No provider was registered" is a fact about the call, so a+      -- caller who asked for evidence gets a record of it. Nothing was+      -- sent, so the digests are over 'Build.dispatchEnvelope'.+      let detail = "No provider registered for API: " <> renderApi (Model.api m)+          err = providerUnavailable detail+      ev <-+        Build.minimalEvidence           m+          opts+          (Build.transportForModel m)+          noThinkingRequested+          (Build.dispatchEnvelope m opts)           now-          0-          (providerUnavailable ("No provider registered for API: " <> renderApi (Model.api m)))+          now+          Evidence.CallFailed+          (Just err)+      let resp = errorResponse m now 0 err+      pure resp {evidence = ev}++-- | Every reason strict evidence mode must refuse this call before it+-- is dispatched, or an empty list.+--+-- Short-circuits on the caller's own request twice over. A caller who+-- set no @evidence@ request pays one 'Maybe' test and never reaches the+-- gate; a caller who asked for best-effort evidence reaches it and the+-- gate returns @[]@ without forcing the translation, so+-- 'describeThinking' is not run for them either. Between them that is+-- every caller who existed before strict mode.+evidenceRefusals :: ApiProvider -> Model -> Options -> [Build.EvidenceRefusal]+evidenceRefusals p m opts = case Options.evidence opts of+  Nothing -> []+  Just req ->+    Build.checkEvidenceRequirements+      (Evidence.strictness req)+      (Model.api m)+      (describeThinking p m opts)++-- | The error-shaped response a refused call returns.+--+-- The evidence it carries records the very translation that caused the+-- refusal, rather than 'Evidence.noThinkingRequested': a caller told+-- their request would be downgraded should be able to read exactly which+-- downgrade in the record, not just in the message. Nothing was sent, so+-- the digests are over 'Build.dispatchEnvelope'.+refusedResponse ::+  Model -> Options -> Evidence.ThinkingTranslation -> [Build.EvidenceRefusal] -> IO Response+refusedResponse m opts translation refusals = do+  now <- getCurrentTime+  let err = Build.refusalError refusals+  ev <-+    Build.minimalEvidence+      m+      opts+      (Build.transportForModel m)+      translation+      (Build.dispatchEnvelope m opts)+      now+      now+      Evidence.CallFailed+      (Just err)+  let resp = errorResponse m now 0 err+  pure resp {evidence = ev}  -- | Dispatch a synchronous request through the process-global registry. completeRequest :: Model -> Context -> Options -> IO Response

@@ -26,6 +26,7 @@ import Baikai.Content (AssistantContent (..), TextContent (..)) import Baikai.Error (BaikaiError, providerError) import Baikai.Error qualified as Error+import Baikai.Evidence (ModelCallEvidence) import Baikai.Message (AssistantPayload (..), Message (..)) import Baikai.Model (Model, emptyModel) import Baikai.Model qualified as Model@@ -52,7 +53,18 @@     -- error-shaped responses and 'Nothing' on success. Use     -- 'responseError' for the normalized failure view; it synthesizes     -- an 'OtherError' if a nonconforming provider omits this field.-    errorInfo :: !(Maybe BaikaiError)+    errorInfo :: !(Maybe BaikaiError),+    -- | The evidence the provider adapter built for this call, when the+    -- caller asked for evidence and the provider builds it.+    --+    -- This is a convenience for synchronous callers. A caller who needs+    -- evidence should prefer reading it from their+    -- 'Baikai.Trace.Sink.TraceSink': the trace path emits exactly one+    -- record per call under every way a call can end, whereas this+    -- field is 'Nothing' on every path that never assembles a full+    -- response — a consumer that abandoned the stream early, or a+    -- dispatch that failed before any provider ran.+    evidence :: !(Maybe ModelCallEvidence)   }   deriving stock (Eq, Show, Generic) @@ -75,7 +87,8 @@       provider = "",       responseId = Nothing,       latencyMs = 0,-      errorInfo = Nothing+      errorInfo = Nothing,+      evidence = Nothing     }  -- | Wrap the response payload as a conversation 'AssistantMessage'.@@ -124,7 +137,8 @@       provider = Model.provider m,       responseId = Nothing,       latencyMs = latency,-      errorInfo = Just err+      errorInfo = Just err,+      evidence = Nothing     }  {-# DEPRECATED _Response "Use emptyResponse instead." #-}

@@ -36,6 +36,9 @@ import Baikai.Content qualified as Content import Baikai.Context (Context) import Baikai.Error (BaikaiError, providerError, providerUnavailable)+import Baikai.Evidence (ModelCallEvidence, noThinkingRequested)+import Baikai.Evidence qualified as Evidence+import Baikai.Evidence.Build qualified as Build import Baikai.Message (AssistantPayload (..), Message (AssistantMessage)) import Baikai.Message qualified as Msg import Baikai.Model (Model)@@ -43,6 +46,7 @@ import Baikai.Provider.Registry   ( ApiProvider (..),     ProviderRegistry,+    evidenceRefusals,     globalProviderRegistry,     lookupApiProviderWith,   )@@ -101,8 +105,11 @@   Stream.concatEffect $ do     mProvider <- lookupApiProviderWith reg (m ^. #api)     case mProvider of-      Just p -> pure (stream p m ctx opts)-      Nothing -> Stream.fromList <$> noProviderEvents m+      Nothing -> Stream.fromList <$> noProviderEvents m opts+      Just p -> case evidenceRefusals p m opts of+        [] -> pure (stream p m ctx opts)+        refusals ->+          Stream.fromList <$> refusedEvents m opts (describeThinking p m opts) refusals  -- | Stream a request through the process-global registry, invoking the -- callback once per event, then return the same reassembled 'Response'@@ -195,6 +202,9 @@   { reason :: !StopReason,     message :: !Message,     errorInfo :: !(Maybe BaikaiError),+    -- | The evidence the provider adapter attached to its terminal+    -- event, copied onto the assembled 'Response' by 'finalizeState'.+    evidence :: !(Maybe ModelCallEvidence),     failed :: !Bool   }   deriving stock (Show, Generic)@@ -244,15 +254,29 @@     s       & #blocks %~ IntMap.insert i (AssistantToolCall tc)       & #toolArgsBuf %~ IntMap.delete i-  EventDone TerminalPayload {reason = r, message = msg, responseId = rid} ->+  EventDone TerminalPayload {reason = r, message = msg, responseId = rid, evidence = ev} ->     s       & #terminal-        .~ Just TerminalSeen {reason = r, message = msg, errorInfo = Nothing, failed = False}+        .~ Just+          TerminalSeen+            { reason = r,+              message = msg,+              errorInfo = Nothing,+              evidence = ev,+              failed = False+            }       & #responseId %~ (\old -> rid <|> old)-  EventError TerminalPayload {reason = r, message = msg, responseId = rid, errorInfo = ei} ->+  EventError TerminalPayload {reason = r, message = msg, responseId = rid, errorInfo = ei, evidence = ev} ->     s       & #terminal-        .~ Just TerminalSeen {reason = r, message = msg, errorInfo = ei, failed = True}+        .~ Just+          TerminalSeen+            { reason = r,+              message = msg,+              errorInfo = ei,+              evidence = ev,+              failed = True+            }       & #responseId %~ (\old -> rid <|> old)  finalizeState :: ReassemblyState -> IO Response@@ -266,6 +290,7 @@           Just TerminalSeen {reason = r, message = msg, errorInfo = ei, failed = failed'} ->             (msg, r, ei, failed', True)           Nothing -> (synthesizeTerminal now assembled, Stop, Nothing, False, False)+      terminalEvidence = s ^. #terminal >>= \TerminalSeen {evidence = ev} -> ev       terminalContent = messageContent terminalMsg       normalizedError = case (terminalReason, terminalError) of         (ErrorReason, Nothing) -> Just (providerError (messageErrorText terminalMsg))@@ -287,7 +312,8 @@         provider = m ^. #provider,         responseId = s ^. #responseId,         latencyMs = latency,-        errorInfo = normalizedError+        errorInfo = normalizedError,+        evidence = terminalEvidence       }  -- | Project the event-assembled content in 'contentIndex' order,@@ -422,7 +448,7 @@     er <- trySync (f m ctx opts)     case er of       Right resp -> pure (Stream.fromList (eventsFor startTs resp))-      Left e -> Stream.fromList <$> errorEvents e+      Left e -> Stream.fromList <$> errorEvents m opts startTs e  -- | 'try' for synchronous exceptions only. Anything delivered -- asynchronously (wrapped in 'Control.Exception.SomeAsyncException' by@@ -465,9 +491,14 @@           ]       reason = payload ^. #stopReason       rid = resp ^. #responseId+      -- Carry the wrapped response's evidence onto the synthetic+      -- terminal event. Without this the two subprocess providers,+      -- which reach the stream surface only through this function,+      -- would build evidence and then drop it on the floor.+      ev = resp ^. #evidence       terminalEvent = case responseError resp of-        Just be -> EventError (errorTerminal rid reason msg be)-        Nothing -> EventDone (doneTerminal rid reason msg)+        Just be -> EventError (errorTerminal ev rid reason msg be)+        Nothing -> EventDone (doneTerminal ev rid reason msg)    in [EventStart StartPayload {partial = skeleton, responseId = rid}]         <> blockEvents         <> [terminalEvent]@@ -492,8 +523,15 @@           ToolCallEnd ToolCallEndPayload {contentIndex = i, toolCall = tc}         ] -errorEvents :: Control.Exception.SomeException -> IO [AssistantMessageEvent]-errorEvents e = do+-- | The synthetic error stream for a @complete@ handler that threw+-- instead of returning an error-shaped 'Response'.+--+-- The handler may well have sent a request before it threw, but it+-- never returned one for this layer to digest, so the digests are over+-- 'Build.dispatchEnvelope' — see its documentation.+errorEvents ::+  Model -> Options -> UTCTime -> Control.Exception.SomeException -> IO [AssistantMessageEvent]+errorEvents m opts startTs e = do   now <- getCurrentTime   -- When a @complete@ handler threw a typed 'BaikaiError' (the CLI,   -- 'Baikai.Auth', and registry paths do), preserve it structurally so a@@ -513,16 +551,78 @@               Msg.timestamp = Just now             }       err = maybe (providerError errText) id mErr+  ev <-+    Build.minimalEvidence+      m+      opts+      (Build.transportForModel m)+      noThinkingRequested+      (Build.dispatchEnvelope m opts)+      startTs+      now+      Evidence.CallFailed+      (Just err)   pure     [ EventStart StartPayload {partial = msg, responseId = Nothing},-      EventError (errorTerminal Nothing ErrorReason msg err)+      EventError (errorTerminal ev Nothing ErrorReason msg err)     ]  -- | The synthetic error stream used when no provider is registered for -- the model's API tag.-noProviderEvents :: Model -> IO [AssistantMessageEvent]-noProviderEvents m = do+--+-- This carries evidence when the caller asked for it. "No provider was+-- registered" is a fact about the call, and a run record that silently+-- omits it is worse than one that records the failure. There is no wire+-- request body to digest here because nothing was ever sent, so the+-- digests are over 'Build.dispatchEnvelope'.+-- | The one-event error stream a strict call refused before dispatch+-- returns.+--+-- Shaped exactly like 'noProviderEvents', because from a consumer's+-- point of view both are the same thing: a call that produced a terminal+-- error without a provider ever running. The evidence carries the very+-- translation that caused the refusal rather than+-- 'noThinkingRequested', so a caller told their request would be+-- downgraded can read which downgrade in the record and not only in the+-- message.+refusedEvents ::+  Model ->+  Options ->+  Evidence.ThinkingTranslation ->+  [Build.EvidenceRefusal] ->+  IO [AssistantMessageEvent]+refusedEvents m opts translation refusals = do   now <- getCurrentTime+  let be = Build.refusalError refusals+      detail = be ^. #message+      msg =+        AssistantMessage+          AssistantPayload+            { Msg.content = Vector.empty,+              Msg.usage = zeroUsage,+              Msg.stopReason = ErrorReason,+              Msg.errorMessage = Just detail,+              Msg.timestamp = Just now+            }+  ev <-+    Build.minimalEvidence+      m+      opts+      (Build.transportForModel m)+      translation+      (Build.dispatchEnvelope m opts)+      now+      now+      Evidence.CallFailed+      (Just be)+  pure+    [ EventStart StartPayload {partial = msg, responseId = Nothing},+      EventError (errorTerminal ev Nothing ErrorReason msg be)+    ]++noProviderEvents :: Model -> Options -> IO [AssistantMessageEvent]+noProviderEvents m opts = do+  now <- getCurrentTime   let detail = "No provider registered for API: " <> renderApi (m ^. #api)       be = providerUnavailable detail       msg =@@ -534,7 +634,18 @@               Msg.errorMessage = Just detail,               Msg.timestamp = Just now             }+  ev <-+    Build.minimalEvidence+      m+      opts+      (Build.transportForModel m)+      noThinkingRequested+      (Build.dispatchEnvelope m opts)+      now+      now+      Evidence.CallFailed+      (Just be)   pure     [ EventStart StartPayload {partial = msg, responseId = Nothing},-      EventError (errorTerminal Nothing ErrorReason msg be)+      EventError (errorTerminal ev Nothing ErrorReason msg be)     ]

@@ -44,6 +44,7 @@  import Baikai.Content (ThinkingContent, ToolCall) import Baikai.Error (BaikaiError)+import Baikai.Evidence (ModelCallEvidence) import Baikai.Message (Message) import Baikai.StopReason (StopReason) import Data.Aeson (ToJSON)@@ -180,7 +181,20 @@     -- | Structured error detail. Always 'Nothing' on 'EventDone' and     -- always 'Just' on 'EventError'; use 'errorTerminal' to enforce the     -- error-side invariant at construction sites.-    errorInfo :: !(Maybe BaikaiError)+    errorInfo :: !(Maybe BaikaiError),+    -- | The evidence the provider adapter built for this call, when the+    -- adapter produced any. This is the channel a provider uses to+    -- report what it actually put on the wire back to+    -- "Baikai.Trace", which otherwise only sees the caller's own+    -- 'Baikai.Model.Model' and 'Baikai.Options.Options'.+    --+    -- 'Nothing' means one of two things and a consumer must not try to+    -- tell them apart: the caller set no+    -- 'Baikai.Options.evidence' request, or this provider has not been+    -- taught to build evidence. Both are distinct from evidence whose+    -- observed fields are 'Baikai.Evidence.Unobserved', which is a+    -- positive statement that the provider reported nothing back.+    evidence :: !(Maybe ModelCallEvidence)   }   deriving stock (Eq, Show, Generic)   deriving anyclass (ToJSON)@@ -188,16 +202,43 @@ -- | Build a success terminal payload ('errorInfo' is always 'Nothing'). -- Prefer this over the raw 'TerminalPayload' constructor so a new field -- can never be left uninitialised at a construction site.-doneTerminal :: Maybe Text -> StopReason -> Message -> TerminalPayload-doneTerminal rid r m =-  TerminalPayload {reason = r, message = m, responseId = rid, errorInfo = Nothing}+--+-- The evidence comes first because it is the argument most likely to be+-- supplied from a @let@-bound value at the call site; pass 'Nothing'+-- from a provider that does not build evidence.+doneTerminal ::+  Maybe ModelCallEvidence -> Maybe Text -> StopReason -> Message -> TerminalPayload+doneTerminal ev rid r m =+  TerminalPayload+    { reason = r,+      message = m,+      responseId = rid,+      errorInfo = Nothing,+      evidence = ev+    }  -- | Build an error terminal payload carrying structured error detail. -- Prefer this over the raw 'TerminalPayload' constructor so an -- 'EventError' cannot be constructed without 'errorInfo'.-errorTerminal :: Maybe Text -> StopReason -> Message -> BaikaiError -> TerminalPayload-errorTerminal rid r m e =-  TerminalPayload {reason = r, message = m, responseId = rid, errorInfo = Just e}+--+-- A failed call still carries evidence when the caller asked for it: a+-- call that failed is a fact about the call, and a run record that+-- omits it is worse than one that records the failure.+errorTerminal ::+  Maybe ModelCallEvidence ->+  Maybe Text ->+  StopReason ->+  Message ->+  BaikaiError ->+  TerminalPayload+errorTerminal ev rid r m e =+  TerminalPayload+    { reason = r,+      message = m,+      responseId = rid,+      errorInfo = Just e,+      evidence = ev+    }  -- | 'True' when the event terminates the stream — exactly one -- 'EventDone' or 'EventError' is emitted per call.

@@ -43,19 +43,32 @@  import Baikai.Context (Context) import Baikai.Cost (usdAsScientific)-import Baikai.Cost qualified as Cost import Baikai.Cost.Log   ( CallLogEntry (..),     CallLogHandle,     appendEntry,     summarizeContext,   )+import Baikai.Error (BaikaiError, providerError)+-- 'Baikai.Evidence.CallStatus' has a @CallFailed@ constructor and so+-- does 'Baikai.Trace.Event.TraceEvent'. They mean different things and+-- both belong in this module, so the status constructors stay behind+-- the @Evidence.@ qualifier.+import Baikai.Evidence+  ( EvidenceStrictness (..),+    ModelCallEvidence,+    newCallId,+    noThinkingRequested,+  )+import Baikai.Evidence qualified as Evidence+import Baikai.Evidence.Build qualified as Build import Baikai.Message (AssistantPayload (..), Message (..)) import Baikai.Model (Model) import Baikai.Options (Options) import Baikai.Prelude import Baikai.Provider.Registry (ProviderRegistry, globalProviderRegistry) import Baikai.Response (Response)+import Baikai.StopReason (StopReason (ErrorReason)) import Baikai.Stream (reassembleResponse, streamRequestWith) import Baikai.Stream.Event (AssistantMessageEvent (..), TerminalPayload (..)) import Baikai.Trace.Event (TraceEvent (..))@@ -65,22 +78,15 @@ import Control.Concurrent (forkIO) import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)-import Control.Exception (SomeException, displayException, try)-import Control.Monad (forM_, unless)+import Control.Exception (SomeException, try)+import Control.Monad (forM_, unless, void) import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)-import Data.Bits (unsafeShiftL, (.&.), (.|.)) import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef) import Data.Maybe (fromMaybe)-import Data.Text qualified as Text import Data.Time (UTCTime, diffUTCTime, getCurrentTime)-import Data.Time.Clock.POSIX (getPOSIXTime)-import Data.Word (Word64) import Foreign.StablePtr (StablePtr, freeStablePtr, newStablePtr)-import Numeric (showHex) import Streamly.Data.Stream (Stream) import Streamly.Data.Stream qualified as Stream-import System.IO (hPutStrLn, stderr)-import System.IO.Unsafe (unsafePerformIO)  -- ============================================================ -- Stream-shaped trace bridge@@ -133,7 +139,7 @@           Left e -> writeIORef (state ^. #sinkError) (Just e)           Right () -> pure ()         putMVar d ()-    eid <- newEventId+    eid <- newCallId     start <- getCurrentTime     writeChan c $       Just@@ -147,8 +153,12 @@           }     pure $       Stream.finallyIO-        (finalizeTrace state eid start m)-        (Stream.mapM (traceEvent state eid start m) (streamRequestWith reg m ctx opts))+        -- The cleanup path cannot change a call's outcome — the stream+        -- is already over — so a fatal sink failure discovered here has+        -- nowhere to go but the stderr line 'reportSinkError' already+        -- wrote. The terminal event below is where it can still matter.+        (void (finalizeTrace state eid start m opts))+        (Stream.mapM (traceEvent state eid start m opts) (streamRequestWith reg m ctx opts))  -- | Synchronous trace wrapper. Drains 'withTraceStream' into a -- 'Response' through 'reassembleResponse'.@@ -211,56 +221,147 @@   writeIORef root (Just sp)   pure state -finalizeTrace :: TraceState -> Text -> UTCTime -> Model -> IO ()-finalizeTrace s eid start m = do+-- | Close the trace for a call and report whether its sink failure must+-- fail the call.+--+-- 'Nothing' is the ordinary outcome, including a best-effort call whose+-- sink threw: that is reported on stderr and the call succeeds, which is+-- baikai's long-standing behaviour. 'Just' happens only for a caller who+-- required evidence and did not get it.+--+-- Runs at most once per call — the second caller sees 'closed' already+-- set and returns 'Nothing' — which is why the terminal event calls it+-- before the 'Stream.finallyIO' cleanup does. The terminal is where the+-- answer can still change the call's outcome; by cleanup time the+-- stream is over.+finalizeTrace ::+  TraceState -> Text -> UTCTime -> Model -> Options -> IO (Maybe BaikaiError)+finalizeTrace s eid start m opts = do   alreadyClosed <-     atomicModifyIORef' (s ^. #closed) (\b -> (True, b))-  unless alreadyClosed $ do-    sent <- readIORef (s ^. #terminalSent)-    unless sent $ do-      now <- getCurrentTime-      writeChan (s ^. #chan) $-        Just-          CallFailed-            { eventId = eid,-              timestamp = now,-              provider = m ^. #provider,-              model = m ^. #modelId,-              latencyMs = millisBetween start now,-              errorMessage = "aborted: stream consumer stopped before the terminal event"-            }-    writeChan (s ^. #chan) Nothing-    takeMVar (s ^. #done)-    reportSinkError s-    releaseStableRoot s+  if alreadyClosed+    then pure Nothing+    else do+      sent <- readIORef (s ^. #terminalSent)+      unless sent $ do+        now <- getCurrentTime+        let abortText = "aborted: stream consumer stopped before the terminal event"+            aborted =+              CallFailed+                { eventId = eid,+                  timestamp = now,+                  provider = m ^. #provider,+                  model = m ^. #modelId,+                  latencyMs = millisBetween start now,+                  errorMessage = abortText+                }+        -- The consumer stopped before the terminal event, so no adapter+        -- ever handed evidence back and this layer has to build it. The+        -- status is 'CallAborted' rather than 'CallFailed': an abort is+        -- the consumer's doing, and reporting it as a provider failure+        -- would misattribute it. The digests are over+        -- 'Build.dispatchEnvelope' — see its documentation for what that+        -- does and does not commit to.+        mev <-+          Build.minimalEvidence+            m+            opts+            (Build.transportForModel m)+            noThinkingRequested+            (Build.dispatchEnvelope m opts)+            start+            now+            Evidence.CallAborted+            -- 'errorInfo' is 'Just' whenever the status is not+            -- 'CallSucceeded', so an abort needs one. Its category is+            -- 'OtherError' rather than any provider-failure category,+            -- because nothing about the provider went wrong: the consumer+            -- stopped reading. The message says exactly that.+            (Just (providerError abortText))+        pushEvidence s eid now m mev+        writeChan (s ^. #chan) (Just aborted)+      writeChan (s ^. #chan) Nothing+      takeMVar (s ^. #done)+      fatal <- reportSinkError s opts+      releaseStableRoot s+      pure fatal +-- | Push the 'CallEvidence' event for a call, when there is one.+--+-- An absent evidence value means one of two things and this layer must+-- not try to tell them apart: the caller opted out, or a provider has+-- not been taught to build evidence. In both cases the correct+-- behaviour is identical — push nothing. Synthesising a record from+-- what this layer knows would reintroduce exactly the cost the opt-out+-- gate exists to remove on the first path, and would attribute a record+-- to a transport that did not make it on the second.+--+-- The event's 'eventId' is the /trace/ identifier, the same one on this+-- call's @call_started@ and terminal lines, so all four kinds join. The+-- evidence's own @callId@ is a separate identifier in a separate+-- namespace and travels inside @data.evidence@; this event is what ties+-- the two together.+pushEvidence ::+  TraceState -> Text -> UTCTime -> Model -> Maybe ModelCallEvidence -> IO ()+pushEvidence s eid now m mev =+  forM_ mev $ \ev ->+    writeChan (s ^. #chan) $+      Just+        CallEvidence+          { eventId = eid,+            timestamp = now,+            provider = m ^. #provider,+            model = m ^. #modelId,+            evidence = ev+          }+ releaseStableRoot :: TraceState -> IO () releaseStableRoot s = do   msp <- atomicModifyIORef' (s ^. #stableRoot) (\sp -> (Nothing, sp))   forM_ msp freeStablePtr -reportSinkError :: TraceState -> IO ()-reportSinkError s = do+-- | Report a sink failure on stderr, and say whether it must also fail+-- the call.+--+-- The strictness comes from the caller's evidence request; a caller who+-- asked for no evidence is 'EvidenceBestEffort'. Both audiences are+-- served: the stderr line is for whoever is watching the process, and+-- the returned error is for the program.+reportSinkError :: TraceState -> Options -> IO (Maybe BaikaiError)+reportSinkError s opts = do   merr <- readIORef (s ^. #sinkError)-  forM_ merr $ \e ->-    hPutStrLn-      stderr-      ("baikai: trace sink failed; trace events for this call were dropped: " <> displayException e)+  case merr of+    Nothing -> pure Nothing+    Just e -> do+      Build.onSinkFailure strictness e+      pure+        ( if Build.sinkFailureIsFatal strictness+            then Just (Build.sinkFailureError e)+            else Nothing+        )+  where+    strictness = strictnessOf opts +-- | The strictness a call was dispatched under. A call with no evidence+-- request is best-effort.+strictnessOf :: Options -> EvidenceStrictness+strictnessOf opts =+  maybe EvidenceBestEffort (^. #strictness) (opts ^. #evidence)+ traceEvent ::   TraceState ->   Text ->   UTCTime ->   Model ->+  Options ->   AssistantMessageEvent ->   IO AssistantMessageEvent-traceEvent state eid start m ev = do+traceEvent state eid start m opts ev = do   case ev of-    EventDone TerminalPayload {message = msg} -> do+    EventDone TerminalPayload {message = msg, evidence = mev} -> do       now <- getCurrentTime       let latency = millisBetween start now           mu = assistantUsageFromMsg msg-          meaningfulCost = maybe False (\u -> usdRat (Usage.cost u) > 0) mu           finished =             CallFinished               { eventId = eid,@@ -270,15 +371,38 @@                 latencyMs = latency,                 inputTokens = fmap Usage.inputTokens mu,                 outputTokens = fmap Usage.outputTokens mu,-                usd =-                  if meaningfulCost-                    then fmap (usdAsScientific . Usage.cost) mu-                    else Nothing+                -- Every count here is 'Just' exactly when the terminal+                -- message carried a 'Usage' at all. A zero is reported+                -- as zero, for the same reason the cost below is: an+                -- absent field must mean "baikai has no usage for this+                -- call", never "the count happened to be zero".+                cachedInputTokens = fmap Usage.cacheReadTokens mu,+                cacheWriteTokens = fmap Usage.cacheWriteTokens mu,+                reasoningTokens = mu >>= Usage.reasoningTokens,+                totalTokens = fmap Usage.totalTokens mu,+                -- Report the computed cost whether or not it is zero. It+                -- used to be suppressed at zero, which made a genuinely+                -- free call indistinguishable from a call whose cost+                -- baikai could not compute — and the subscription-based+                -- CLI providers always compute zero, so that was the+                -- common case rather than a corner.+                usd = fmap (usdAsScientific . Usage.cost) mu               }+      -- Evidence goes out *before* the terminal, so a sink that keys+      -- per-call state off the started/terminal pair still has the+      -- call's state open when it arrives. The OpenTelemetry sink ends+      -- and removes its span on the terminal, so the other order left+      -- its evidence branch unreachable from a live stream.+      pushEvidence state eid now m mev       writeChan (state ^. #chan) (Just finished)       writeIORef (state ^. #terminalSent) True-      finalizeTrace state eid start m-    EventError TerminalPayload {message = msg} -> do+      fatal <- finalizeTrace state eid start m opts+      -- A strict caller whose record did not survive gets a failed call+      -- rather than an answer they cannot account for. This is the only+      -- place in baikai where a call that reached the provider and came+      -- back is nevertheless reported as failed.+      pure (maybe ev (failTerminal ev) fatal)+    EventError TerminalPayload {message = msg, evidence = mev} -> do       now <- getCurrentTime       let latency = millisBetween start now           errMsg = case msg of@@ -293,12 +417,40 @@                 latencyMs = latency,                 errorMessage = errMsg               }+      pushEvidence state eid now m mev       writeChan (state ^. #chan) (Just failed)       writeIORef (state ^. #terminalSent) True-      finalizeTrace state eid start m-    _ -> pure ()-  pure ev+      -- Already an error: a sink failure on top changes nothing the+      -- caller can act on, and overwriting the provider's own error with+      -- baikai's would lose the more useful of the two.+      _ <- finalizeTrace state eid start m opts+      pure ev+    _ -> pure ev +-- | Rewrite a successful terminal into a failed one carrying baikai's+-- own error, preserving everything else about it — including the+-- evidence, which is exactly what a caller investigating this failure+-- wants to read.+failTerminal :: AssistantMessageEvent -> BaikaiError -> AssistantMessageEvent+failTerminal ev be = case ev of+  EventDone p ->+    EventError+      ( p+          & #reason+          .~ ErrorReason+          & #errorInfo+          .~ Just be+          & #message+          %~ markFailed+      )+  other -> other+  where+    markFailed = \case+      AssistantMessage p ->+        AssistantMessage+          (p & #stopReason .~ ErrorReason & #errorMessage .~ Just (be ^. #message))+      other -> other+ -- ============================================================ -- Cost-log convenience wrapper -- ============================================================@@ -331,7 +483,6 @@   resp <- withTraceWith reg sink m ctx opts   now <- liftIO getCurrentTime   let mu = assistantUsage resp-      meaningfulCost = maybe False (\u -> usdRat (Usage.cost u) > 0) mu       entry =         CallLogEntry           { timestamp = now,@@ -341,10 +492,11 @@             outputTokens = mu >>= positiveNat . Usage.outputTokens,             cachedInputTokens = mu >>= positiveNat . Usage.cacheReadTokens,             reasoningTokens = mu >>= Usage.reasoningTokens,-            usd =-              if meaningfulCost-                then fmap (usdAsScientific . Usage.cost) mu-                else Nothing,+            -- Report a zero cost as zero. Suppressing it made "this+            -- call was free" indistinguishable from "baikai could not+            -- price this call", and the CLI providers always price at+            -- zero.+            usd = fmap (usdAsScientific . Usage.cost) mu,             latencyMs = resp ^. #latencyMs,             promptSummary = summarizeContext ctx           }@@ -364,9 +516,6 @@   AssistantMessage AssistantPayload {usage = u} -> Just u   _ -> Nothing -usdRat :: Cost.Cost -> Rational-usdRat = Cost.usd- positiveNat :: Natural -> Maybe Natural positiveNat 0 = Nothing positiveNat n = Just n@@ -381,27 +530,14 @@ -- Event id -- ============================================================ --- | Generate a 16-character lowercase hexadecimal event id. The high--- 32 bits are derived from process-start POSIX seconds and the low--- 32 bits are a process-local counter, so ids are unique within a--- process for 2^32 calls.+-- | Generate an identifier for one traced call.+--+-- Delegates to 'newCallId'. The previous implementation combined the+-- process-start POSIX /second/ with a process-local counter and+-- produced 16 hexadecimal characters, which meant two processes+-- started within the same second emitted identical identifier+-- sequences. 'newCallId' produces 32 characters and is unique across+-- processes. newEventId :: IO Text-newEventId = do-  n <- atomicModifyIORef' eventCounter (\k -> (k + 1, k))-  let raw :: Word64-      raw =-        (fromIntegral eventBase .&. 0xFFFFFFFF) `unsafeShiftL` 32-          .|. (fromIntegral n .&. 0xFFFFFFFF)-      hex = showHex raw ""-      padded = replicate (16 - length hex) '0' <> hex-  pure (Text.pack padded)--eventCounter :: IORef Word-eventCounter = unsafePerformIO (newIORef 0)-{-# NOINLINE eventCounter #-}--eventBase :: Word-eventBase = unsafePerformIO $ do-  t <- getPOSIXTime-  pure (fromIntegral (floor t :: Integer))-{-# NOINLINE eventBase #-}+newEventId = newCallId+{-# DEPRECATED newEventId "Use Baikai.Evidence.newCallId; newEventId's ids were only unique within one process." #-}

@@ -1,27 +1,32 @@+{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-partial-fields #-}  -- | The 'TraceEvent' sum and its JSON encoding. ----- A trace event is one of three discriminated cases: 'CallStarted' fires+-- A trace event is one of four discriminated cases: 'CallStarted' fires -- when a provider call begins, 'CallFinished' when it returns a response,--- and 'CallFailed' when it throws. The 'sumEncoding' tag field is @kind@,--- so a JSON-Lines stream of these can be filtered with--- @jq 'select(.kind == "call_finished")'@.+-- 'CallFailed' when it throws, and 'CallEvidence' carries the full+-- 'ModelCallEvidence' record for callers who asked for one. The+-- 'sumEncoding' tag field is @kind@, so a JSON-Lines stream of these can+-- be filtered with @jq 'select(.kind == "call_finished")'@. module Baikai.Trace.Event   ( TraceEvent (..),     traceEventOptions,   ) where +import Baikai.Evidence (ModelCallEvidence) import Data.Aeson   ( FromJSON (parseJSON),     Options (..),     SumEncoding (..),     ToJSON (..),     defaultOptions,-    genericParseJSON,     genericToEncoding,     genericToJSON,+    withObject,+    (.:),+    (.:?),   ) import Data.Char (toLower) import Data.Scientific (Scientific)@@ -33,10 +38,17 @@ -- | One observable event from a provider call. -- -- Every event carries an 'eventId' that correlates the @started@ event--- with its matching @finished@ or @failed@ event within a single process--- run. Token counts and dollar cost are 'Maybe' because subscription-based+-- with its matching @finished@, @failed@, or @evidence@ event within a+-- single process run. Token counts are 'Maybe' because subscription-based -- providers (the CLIs) do not report them; 'omitNothingFields' keeps the -- absent fields out of the rendered JSON.+--+-- 'usd' is deliberately /not/ 'Maybe'-shaped as an "unknown" marker: it+-- was until this release, and a computed cost of zero was suppressed, so+-- a genuinely free call and a call whose cost baikai could not compute+-- looked identical in a trace. The field is still 'Maybe' because a+-- non-assistant terminal has no usage at all, but a zero cost now+-- renders as @0@. data TraceEvent   = CallStarted       { eventId :: !Text,@@ -54,6 +66,14 @@         latencyMs :: !Int,         inputTokens :: !(Maybe Natural),         outputTokens :: !(Maybe Natural),+        -- | Cache-read, cache-write, reasoning, and total token counts.+        -- 'Baikai.Cost.Log.CallLogEntry' has always kept the first and+        -- the third; a trace that dropped them was strictly less+        -- faithful than the cost log built from the same 'Usage' value.+        cachedInputTokens :: !(Maybe Natural),+        cacheWriteTokens :: !(Maybe Natural),+        reasoningTokens :: !(Maybe Natural),+        totalTokens :: !(Maybe Natural),         usd :: !(Maybe Scientific)       }   | CallFailed@@ -64,13 +84,37 @@         latencyMs :: !Int,         errorMessage :: !Text       }+  | -- | The complete evidence record for one terminal provider call.+    --+    -- Emitted exactly once per call, immediately after the matching+    -- 'CallFinished' or 'CallFailed', and only when the caller set+    -- 'Baikai.Options.evidence' and the provider built a record. A+    -- consumer that wants only evidence can filter on this kind alone,+    -- and a consumer written before this constructor existed is+    -- unaffected as long as its pattern match is not exhaustive over+    -- the sum.+    CallEvidence+      { eventId :: !Text,+        timestamp :: !UTCTime,+        provider :: !Text,+        model :: !Text,+        evidence :: !ModelCallEvidence+      }   deriving stock (Eq, Show, Generic) --- | Aeson options shared by 'ToJSON' and 'FromJSON' instances.+-- | Aeson options used by the 'ToJSON' instance, and the shape the+-- hand-written 'FromJSON' instance parses. ----- * Sum encoding: @{"kind":"<tag>","data":{...}}@.+-- * Sum encoding: a @kind@ discriminator alongside the constructor's+--   own fields. Every constructor here has named fields, and aeson's+--   'TaggedObject' merges those into the tagged object rather than+--   nesting them, so a line reads+--   @{"kind":"call_finished","eventId":…,"latencyMs":…}@ and not+--   @{"kind":…,"data":{…}}@. The @contentsFieldName@ below would only+--   take effect for a positional constructor, of which there are none.+--   Filter with @jq 'select(.kind == "call_finished") | .latencyMs'@. -- * Constructor tags: snake-case (@call_started@, @call_finished@,---   @call_failed@).+--   @call_failed@, @call_evidence@). -- * Field labels: kept as-is (camelCase). -- * Nothing fields are dropped from the encoded JSON. traceEventOptions :: Options@@ -91,5 +135,53 @@   toJSON = genericToJSON traceEventOptions   toEncoding = genericToEncoding traceEventOptions +-- | Written out rather than derived, and it decodes only the three+-- non-evidence cases.+--+-- 'ModelCallEvidence' deliberately has no 'FromJSON' instance: it embeds+-- a 'Baikai.Cost.Cost' whose exact 'Rational' amounts encode through an+-- approximating 'Data.Scientific.Scientific', so a decoder would return+-- a different value than was encoded. Rather than manufacture that+-- fidelity, a @call_evidence@ line fails to parse with a message saying+-- to read it as a plain 'Data.Aeson.Value'. That is the honest+-- behaviour, and it is what a consumer wants anyway — the JSON, not a+-- Haskell mirror of it, is the contract other systems pin against. instance FromJSON TraceEvent where-  parseJSON = genericParseJSON traceEventOptions+  parseJSON = withObject "TraceEvent" $ \d -> do+    kind <- d .: "kind"+    case kind :: Text of+      "call_started" ->+        CallStarted+          <$> d .: "eventId"+          <*> d .: "timestamp"+          <*> d .: "provider"+          <*> d .: "model"+          <*> d .: "maxTokens"+          <*> d .: "promptSummary"+      "call_finished" ->+        CallFinished+          <$> d .: "eventId"+          <*> d .: "timestamp"+          <*> d .: "provider"+          <*> d .: "model"+          <*> d .: "latencyMs"+          <*> d .:? "inputTokens"+          <*> d .:? "outputTokens"+          <*> d .:? "cachedInputTokens"+          <*> d .:? "cacheWriteTokens"+          <*> d .:? "reasoningTokens"+          <*> d .:? "totalTokens"+          <*> d .:? "usd"+      "call_failed" ->+        CallFailed+          <$> d .: "eventId"+          <*> d .: "timestamp"+          <*> d .: "provider"+          <*> d .: "model"+          <*> d .: "latencyMs"+          <*> d .: "errorMessage"+      "call_evidence" ->+        fail+          "TraceEvent: a call_evidence line carries a ModelCallEvidence, \+          \which has no faithful decoder; read it as a Data.Aeson.Value"+      other -> fail ("TraceEvent: unknown kind " <> show other)

@@ -17,6 +17,7 @@   ) where +import Baikai.Evidence qualified as Evidence import Baikai.Trace.Event (TraceEvent (..)) import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as BSL@@ -94,7 +95,34 @@         tshow latencyMs <> "ms:",         errorMessage       ]+  -- One line, and deliberately not the whole record. A human-readable+  -- sink is for watching calls go by; an evidence record is several+  -- hundred bytes of structured detail meant to be read out of+  -- 'fileSink' output by a machine. What belongs on a terminal is the+  -- fact that evidence exists, which run and call it names, and how+  -- much it proves.+  CallEvidence {timestamp, provider, model, evidence} ->+    Text.unwords+      [ "[" <> fmtTime timestamp <> "]",+        provider,+        model,+        "EVIDENCE",+        evidenceSummary evidence+      ]   where     tshow :: (Show a) => a -> Text     tshow x = Text.pack (show x)     fmtTime t = Text.pack (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" t)++-- | Read through a record pattern rather than bare selectors:+-- 'Evidence.ModelCallEvidence' and 'Evidence.EvidenceRequest' both+-- carry @runId@, so under @DuplicateRecordFields@ a bare+-- @Evidence.runId ev@ is an ambiguous occurrence.+evidenceSummary :: Evidence.ModelCallEvidence -> Text+evidenceSummary+  Evidence.ModelCallEvidence {Evidence.runId, Evidence.callId, Evidence.strength} =+    Text.unwords+      [ "run=" <> runId,+        "call=" <> callId,+        "strength=" <> Text.pack (show strength)+      ]

@@ -0,0 +1,255 @@+module AgentSpec (tests) where++import Baikai.Agent+import Baikai.Prelude+import Data.Text qualified as Text+import System.Exit (ExitCode (..))+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Baikai.Agent"+    [ requestDefaultTest,+      canonicalRenderingTest,+      ceilingAcceptanceTest,+      ceilingRefusalTest,+      multipleViolationTest,+      emptyAllowedProvidersTest,+      providerArgsCeilingTest,+      violationRenderingTest,+      capturedOutputTest,+      failureRenderingTest,+      resultConstructorTest+    ]++-- | A request built by the smart constructor must default every+-- optional field to the least-authority value. Asserting all of them+-- means a later plan adding a field has to decide its default+-- consciously rather than inherit an accident.+requestDefaultTest :: TestTree+requestDefaultTest =+  testCase "agentRunRequest defaults to read-only, inherited output, and no limits" $ do+    let req = agentRunRequest AgentClaude "/tmp/work" "do the thing"+    req ^. #provider @?= AgentClaude+    req ^. #prompt @?= "do the thing"+    req ^. #workingDir @?= "/tmp/work"+    req ^. #modelId @?= Nothing+    req ^. #effort @?= Nothing+    req ^. #extraDirs @?= []+    req ^. #safety . #capability @?= AgentReadOnly+    req ^. #safety . #allowedTools @?= []+    req ^. #safety . #providerArgs @?= []+    req ^. #timeout @?= Nothing+    req ^. #output @?= InheritOutput+    req ^. #outputLimit @?= Nothing+    req ^. #envPassthrough @?= []++canonicalRenderingTest :: TestTree+canonicalRenderingTest =+  testCase "provider, capability, and output-mode names round-trip exactly" $ do+    renderAgentProvider AgentClaude @?= "claude"+    renderAgentProvider AgentCodex @?= "codex"+    parseAgentProvider "claude" @?= Just AgentClaude+    parseAgentProvider "codex" @?= Just AgentCodex+    parseAgentProvider "Claude" @?= Nothing+    parseAgentProvider "" @?= Nothing++    renderAgentCapability AgentReadOnly @?= "read-only"+    renderAgentCapability AgentEditWorkspace @?= "edit-workspace"+    renderAgentCapability AgentFullAccess @?= "full-access"+    parseAgentCapability "read-only" @?= Just AgentReadOnly+    parseAgentCapability "edit-workspace" @?= Just AgentEditWorkspace+    parseAgentCapability "full-access" @?= Just AgentFullAccess+    parseAgentCapability "Read-Only" @?= Nothing+    parseAgentCapability "readonly" @?= Nothing++    renderAgentOutputMode InheritOutput @?= "inherit"+    renderAgentOutputMode CaptureOutput @?= "capture"+    renderAgentOutputMode TeeOutput @?= "tee"+    parseAgentOutputMode "inherit" @?= Just InheritOutput+    parseAgentOutputMode "capture" @?= Just CaptureOutput+    parseAgentOutputMode "tee" @?= Just TeeOutput+    parseAgentOutputMode "Tee" @?= Nothing++-- | Accepting a request must return it byte-identical. The equality+-- assertion against the original value is what proves no clamping+-- happened.+ceilingAcceptanceTest :: TestTree+ceilingAcceptanceTest =+  testCase "the default ceiling accepts read-only and edit-workspace unchanged" $ do+    let readOnly = agentRunRequest AgentClaude "/tmp/work" "look around"+        editing = readOnly & #safety .~ agentSafety AgentEditWorkspace+    applyAgentCeiling defaultAgentCeiling readOnly @?= Right readOnly+    applyAgentCeiling defaultAgentCeiling editing @?= Right editing++ceilingRefusalTest :: TestTree+ceilingRefusalTest =+  testCase "the ceiling refuses with the exact violation for each closed channel" $ do+    let base = agentRunRequest AgentClaude "/tmp/work" "rewrite everything"+        greedy = base & #safety .~ agentSafety AgentFullAccess+        rawArgs =+          base+            & #safety+            . #providerArgs+            .~ ["--dangerously-skip-permissions", "--verbose"]+        claudeOnly = defaultAgentCeiling & #allowedProviders .~ [AgentClaude]+        codexRequest = agentRunRequest AgentCodex "/tmp/work" "rewrite everything"+    applyAgentCeiling defaultAgentCeiling greedy+      @?= Left [CapabilityExceeded AgentFullAccess AgentEditWorkspace]+    applyAgentCeiling defaultAgentCeiling rawArgs+      @?= Left+        [ProviderArgsForbidden ["--dangerously-skip-permissions", "--verbose"]]+    applyAgentCeiling claudeOnly codexRequest+      @?= Left [ProviderForbidden AgentCodex [AgentClaude]]++-- | Every violation is reported, not just the first one, so an+-- operator fixing a job description sees all of them in one run.+multipleViolationTest :: TestTree+multipleViolationTest =+  testCase "a request that breaks three rules reports all three violations" $ do+    let restrictive =+          defaultAgentCeiling+            & #maxCapability+            .~ AgentReadOnly+            & #allowProviderArgs+            .~ False+            & #allowedProviders+            .~ [AgentClaude]+        req =+          agentRunRequest AgentCodex "/tmp/work" "rewrite everything"+            & #safety+            .~ ( agentSafety AgentFullAccess+                   & #providerArgs+                   .~ ["--dangerously-bypass-approvals-and-sandbox"]+               )+    applyAgentCeiling restrictive req+      @?= Left+        [ ProviderForbidden AgentCodex [AgentClaude],+          CapabilityExceeded AgentFullAccess AgentReadOnly,+          ProviderArgsForbidden ["--dangerously-bypass-approvals-and-sandbox"]+        ]++-- | An empty permitted-provider list means no provider is permitted.+-- The opposite reading would be a security hole, so it is pinned.+emptyAllowedProvidersTest :: TestTree+emptyAllowedProvidersTest =+  testCase "an empty allowedProviders list permits no provider" $ do+    let closed = defaultAgentCeiling & #allowedProviders .~ []+        claudeRequest = agentRunRequest AgentClaude "/tmp/work" "hello"+        codexRequest = agentRunRequest AgentCodex "/tmp/work" "hello"+    applyAgentCeiling closed claudeRequest+      @?= Left [ProviderForbidden AgentClaude []]+    applyAgentCeiling closed codexRequest+      @?= Left [ProviderForbidden AgentCodex []]++providerArgsCeilingTest :: TestTree+providerArgsCeilingTest =+  testCase "raw provider arguments pass only when the operator opens the channel" $ do+    let req =+          agentRunRequest AgentClaude "/tmp/work" "hello"+            & #safety+            . #providerArgs+            .~ ["--some-vendor-flag"]+        permissive = defaultAgentCeiling & #allowProviderArgs .~ True+    applyAgentCeiling defaultAgentCeiling req+      @?= Left [ProviderArgsForbidden ["--some-vendor-flag"]]+    applyAgentCeiling permissive req @?= Right req++-- | Pin that both the requested and the permitted value appear, not+-- the exact sentence, so wording can improve without breaking tests.+violationRenderingTest :: TestTree+violationRenderingTest =+  testCase "violation text names both the requested and the permitted value" $ do+    let message = renderCeilingViolation (CapabilityExceeded AgentFullAccess AgentEditWorkspace)+    assertBool+      ("expected the requested capability in: " <> Text.unpack message)+      ("full-access" `Text.isInfixOf` message)+    assertBool+      ("expected the permitted maximum in: " <> Text.unpack message)+      ("edit-workspace" `Text.isInfixOf` message)+    -- Raw provider arguments are the one part of a job description an+    -- operator could write a credential into, so the refusal says how+    -- many were requested and never what they were. Asserting the+    -- absence is the point: a "helpful" edit that quoted them would+    -- defeat the secret classification the configuration layer applies.+    let argsMessage =+          renderCeilingViolation (ProviderArgsForbidden ["--api-key", "sk-not-a-real-key"])+    assertBool+      ("expected the count in: " <> Text.unpack argsMessage)+      ("2" `Text.isInfixOf` argsMessage)+    assertBool+      ("expected no argument value in: " <> Text.unpack argsMessage)+      (not ("sk-not-a-real-key" `Text.isInfixOf` argsMessage))+    let providerMessage = renderCeilingViolation (ProviderForbidden AgentCodex [AgentClaude])+    assertBool+      ("expected both providers in: " <> Text.unpack providerMessage)+      ("codex" `Text.isInfixOf` providerMessage && "claude" `Text.isInfixOf` providerMessage)++capturedOutputTest :: TestTree+capturedOutputTest =+  testCase "capturedBytes distinguishes uncaptured output from empty output" $ do+    capturedBytes OutputNotCaptured @?= Nothing+    capturedBytes (OutputCaptured "all of it") @?= Just "all of it"+    capturedBytes (OutputTruncated "the first part") @?= Just "the first part"+    capturedBytes (OutputCaptured "") @?= Just ""++failureRenderingTest :: TestTree+failureRenderingTest =+  testCase "every render error and run failure produces actionable text" $ do+    let renderErrors =+          [ UnsupportedCapability AgentCodex AgentFullAccess "the sandbox cannot be disabled here",+            UnsupportedToolRestriction AgentCodex "codex exec has no tool allow-list flag",+            SafetyNotExpressible AgentClaude "claude has no sandbox mode",+            ProviderMismatch AgentClaude AgentCodex,+            CeilingRejected [CapabilityExceeded AgentFullAccess AgentReadOnly]+          ]+        runFailures =+          [ SpawnFailed "/usr/local/bin/claude" "no such file or directory",+            RunTimedOut 90,+            MissingEnvironment ["KEIRO_PATH", "ANTHROPIC_API_KEY"],+            WorkingDirMissing "/tmp/gone",+            OutputMalformed "expected JSON, got a banner"+          ]+    mapM_+      ( \e ->+          assertBool+            ("expected non-empty text for " <> show e)+            (not (Text.null (renderAgentRenderError e)))+      )+      renderErrors+    mapM_+      ( \f ->+          assertBool+            ("expected non-empty text for " <> show f)+            (not (Text.null (renderAgentRunFailure f)))+      )+      runFailures++    let mismatch = renderAgentRenderError (ProviderMismatch AgentClaude AgentCodex)+    assertBool+      ("expected both providers in: " <> Text.unpack mismatch)+      ("claude" `Text.isInfixOf` mismatch && "codex" `Text.isInfixOf` mismatch)++    let unsupported =+          renderAgentRenderError+            (UnsupportedCapability AgentCodex AgentFullAccess "the sandbox cannot be disabled here")+    assertBool+      ("expected the supplied explanation in: " <> Text.unpack unsupported)+      ("the sandbox cannot be disabled here" `Text.isInfixOf` unsupported)++    let missing = renderAgentRunFailure (MissingEnvironment ["KEIRO_PATH", "ANTHROPIC_API_KEY"])+    assertBool+      ("expected every missing variable in: " <> Text.unpack missing)+      ("KEIRO_PATH" `Text.isInfixOf` missing && "ANTHROPIC_API_KEY" `Text.isInfixOf` missing)++resultConstructorTest :: TestTree+resultConstructorTest =+  testCase "agentRunResult records the process outcome and captures nothing" $ do+    let result = agentRunResult AgentCodex (ExitFailure 3) 1.5+    result ^. #provider @?= AgentCodex+    result ^. #exitCode @?= ExitFailure 3+    result ^. #duration @?= 1.5+    result ^. #stdout @?= OutputNotCaptured+    result ^. #stderr @?= OutputNotCaptured

@@ -1,16 +1,50 @@+-- | Tests for the helpers the two subprocess providers share.+--+-- The two parser fixtures under @test/fixtures@ are trimmed recordings+-- of real output from @claude 2.1.222@ and @codex-cli 0.146.0@,+-- captured by running each tool once against a trivial prompt. They+-- keep the exact field spellings and nesting those versions emit;+-- identifiers are scrubbed and the local configuration the @claude@+-- init event carries is dropped, because none of it is what the parsers+-- read. module CliInternalSpec (tests) where  import Baikai import Baikai.Provider.Cli.Internal-import Control.Lens ((&), (.~))+import Control.Lens ((&), (.~), (^.))+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as BS8+import Data.Generics.Labels ()+import Data.List (isInfixOf)+import Data.Text qualified as Text import Data.Vector qualified as Vector+import Streamly.Data.Stream qualified as Stream+import System.Directory (doesFileExist, getPermissions, setOwnerExecutable, setPermissions)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))  tests :: TestTree tests =   testGroup     "CLI internal helpers"+    [ promptTests,+      codexParserTests,+      claudeParserTests,+      executableIdentityTests,+      evidenceHelperTests+    ]++-- ============================================================+-- Prompt rendering+-- ============================================================++promptTests :: TestTree+promptTests =+  testGroup+    "prompt rendering"     [ testCase "renderPrompt returns a single user text message verbatim" $ do         let ctx = emptyContext & #messages .~ Vector.singleton (user "hello")         renderPrompt ctx @?= "hello",@@ -29,4 +63,270 @@       testCase "wrapSystemPrompt prefixes nonblank system instructions" $         wrapSystemPrompt (Just "Be terse.") "hi"           @?= "System instructions:\nBe terse.\n\nUser request:\nhi"+    ]++-- ============================================================+-- The codex event stream+-- ============================================================++parseCodex :: [ByteString] -> IO CodexRunReport+parseCodex = parseCodexJsonlStream . Stream.fromList++codexParserTests :: TestTree+codexParserTests =+  testGroup+    "codex exec --json event stream"+    [ testCase "a recorded run yields its text, thread id, and token counts" $ do+        recorded <- BS.readFile "test/fixtures/codex-events.jsonl"+        report <- parseCodex [recorded]+        report ^. #message @?= "ok"+        report ^. #threadId @?= Just "019fd471-4a48-7c83-be67-6b7c49646e43"+        case report ^. #usage of+          Nothing -> assertFailure "the turn.completed event reports usage"+          Just u -> do+            -- codex reports OpenAI-style inclusive prompt counts, so+            -- the cached tokens come out of inputTokens: 16071 - 6912.+            u ^. #inputTokens @?= 9159+            u ^. #cacheReadTokens @?= 6912+            u ^. #cacheWriteTokens @?= 0+            u ^. #outputTokens @?= 5+            u ^. #reasoningTokens @?= Just 0+            u ^. #totalTokens @?= 9159 + 5 + 6912,+      -- codex-cli 0.146.0 names no model anywhere in its event stream.+      -- Recording the model baikai passed on the command line would be+      -- reporting the request as an observation.+      testCase "a recorded run reports no model, rather than the requested one" $ do+        recorded <- BS.readFile "test/fixtures/codex-events.jsonl"+        report <- parseCodex [recorded]+        report ^. #reportedModel @?= Nothing,+      testCase "a model is read only from an event that also counts tokens" $ do+        withModel <-+          parseCodex+            [ "{\"type\":\"turn.started\",\"model\":\"gpt-5.6-configured\"}\n\+              \{\"type\":\"turn.completed\",\"model\":\"gpt-5.6-ran\",\+              \\"usage\":{\"input_tokens\":10,\"output_tokens\":2}}\n"+            ]+        withModel ^. #reportedModel @?= Just "gpt-5.6-ran",+      testCase "a stream with no thread and no usage reports absence, not zeroes" $ do+        report <-+          parseCodex+            ["{\"type\":\"item.completed\",\"item\":{\"type\":\"agent_message\",\"text\":\"hi\"}}\n"]+        report ^. #message @?= "hi"+        report ^. #threadId @?= Nothing+        report ^. #usage @?= Nothing,+      testCase "a non-JSON line is skipped rather than failing the run" $ do+        report <-+          parseCodex+            [ "not json at all\n\+              \{\"type\":\"thread.started\",\"thread_id\":\"t-1\"}\n\+              \{\"type\":\"item.completed\",\"item\":{\"type\":\"agent_message\",\"text\":\"hi\"}}\n"+            ]+        report ^. #message @?= "hi"+        report ^. #threadId @?= Just "t-1",+      testCase "the older msg-nested and flat event schemas still parse" $ do+        nested <-+          parseCodex+            [ "{\"msg\":{\"type\":\"session.created\",\"session_id\":\"s-1\"}}\n\+              \{\"msg\":{\"type\":\"agent_message\",\"message\":\"nested\"}}\n"+            ]+        nested ^. #message @?= "nested"+        nested ^. #threadId @?= Just "s-1"+        flat <- parseCodex ["{\"type\":\"agent_message\",\"message\":\"flat\"}\n"]+        flat ^. #message @?= "flat",+      testCase "the first identifier wins and the last token count wins" $ do+        report <-+          parseCodex+            [ "{\"type\":\"thread.started\",\"thread_id\":\"first\"}\n\+              \{\"type\":\"turn.completed\",\"usage\":{\"input_tokens\":1,\"output_tokens\":1}}\n\+              \{\"type\":\"thread.started\",\"thread_id\":\"second\"}\n\+              \{\"type\":\"turn.completed\",\"usage\":{\"input_tokens\":50,\"output_tokens\":7}}\n"+            ]+        report ^. #threadId @?= Just "first"+        fmap (^. #outputTokens) (report ^. #usage) @?= Just 7,+      testCase "a cached count larger than the prompt total clamps at zero" $ do+        report <-+          parseCodex+            [ "{\"type\":\"turn.completed\",\+              \\"usage\":{\"input_tokens\":5,\"cached_input_tokens\":9,\"output_tokens\":1}}\n"+            ]+        fmap (^. #inputTokens) (report ^. #usage) @?= Just 0+    ]++-- ============================================================+-- The claude result document+-- ============================================================++claudeParserTests :: TestTree+claudeParserTests =+  testGroup+    "claude -p --output-format json result"+    [ testCase "a recorded run yields its text, session id, model, usage, and cost" $ do+        recorded <- BS.readFile "test/fixtures/claude-cli-result.json"+        case decodeClaudeCliResult recorded of+          Left err -> assertFailure ("expected the recording to decode: " <> show err)+          Right r -> do+            r ^. #result @?= "ok"+            r ^. #isError @?= False+            r ^. #sessionId @?= Just "01890000-0000-4000-8000-000000000001"+            -- The context-window variant marker is kept: baikai can+            -- request the 1m variant separately, so truncating it to+            -- the canonical name would discard a real distinction.+            r ^. #reportedModel @?= Just "claude-opus-5[1m]"+            case r ^. #usage of+              Nothing -> assertFailure "the result event reports usage"+              Just u -> do+                -- Anthropic's prompt classes are already disjoint, so+                -- nothing is subtracted here.+                u ^. #inputTokens @?= 2+                u ^. #outputTokens @?= 6+                u ^. #cacheReadTokens @?= 15185+                u ^. #cacheWriteTokens @?= 7455+                u ^. #totalTokens @?= 2 + 6 + 15185 + 7455+                -- The tool's total_cost_usd, carried exactly. Written+                -- as a ratio rather than @toRational (0.0823025 ::+                -- Double)@ because that would be the binary-float+                -- approximation, and the whole reason 'Cost' holds a+                -- 'Rational' is that it does not have to be.+                (u ^. #cost) ^. #usd @?= 823025 / 10000000,+      testCase "the older bare-object shape still decodes" $+        case decodeClaudeCliResult "{\"result\":\"pong\",\"is_error\":false}" of+          Left err -> assertFailure ("expected a bare object to decode: " <> show err)+          Right r -> do+            r ^. #result @?= "pong"+            r ^. #sessionId @?= Nothing+            r ^. #reportedModel @?= Nothing+            r ^. #usage @?= Nothing,+      testCase "an error-shaped result keeps its session id" $+        case decodeClaudeCliResult+          "{\"type\":\"result\",\"result\":\"boom\",\"is_error\":true,\"session_id\":\"s-9\"}" of+          Left err -> assertFailure ("expected an error result to decode: " <> show err)+          Right r -> do+            r ^. #isError @?= True+            r ^. #sessionId @?= Just "s-9",+      -- Several models means several models ran, and evidence has one+      -- observedModel slot. Picking one would fabricate specificity.+      testCase "two modelUsage keys report no model rather than one of them" $+        case decodeClaudeCliResult+          "{\"result\":\"ok\",\"is_error\":false,\+          \\"modelUsage\":{\"claude-opus-5\":{},\"claude-haiku-4-5\":{}}}" of+          Left err -> assertFailure ("expected the document to decode: " <> show err)+          Right r -> r ^. #reportedModel @?= Nothing,+      testCase "a result event is found inside an array of events" $+        case decodeClaudeCliResult+          "[{\"type\":\"system\"},{\"type\":\"result\",\"result\":\"found\",\"is_error\":false}]" of+          Left err -> assertFailure ("expected the array to decode: " <> show err)+          Right r -> r ^. #result @?= "found",+      testCase "an array with no result event is a decode error" $+        case decodeClaudeCliResult "[{\"type\":\"system\"}]" of+          Left _ -> pure ()+          Right r -> assertFailure ("expected a decode error, got: " <> show r),+      testCase "malformed stdout is a decode error rather than an exception" $+        case decodeClaudeCliResult "not json" of+          Left _ -> pure ()+          Right r -> assertFailure ("expected a decode error, got: " <> show r)+    ]++-- ============================================================+-- Executable identity+-- ============================================================++-- | Write a shell script into a directory and make it executable.+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++executableIdentityTests :: TestTree+executableIdentityTests =+  testGroup+    "executable identity"+    [ testCase "a resolvable tool reports its path and its --version line" $+        withSystemTempDirectory "baikai-cli-identity" $ \dir -> do+          exe <- writeFakeExecutable dir "faketool" "#!/bin/sh\necho 'faketool 9.9.9'\n"+          identity <- executableIdentity exe+          identity ^. #configured @?= Text.pack exe+          identity ^. #resolvedPath @?= Just (Text.pack exe)+          identity ^. #version @?= Just "faketool 9.9.9",+      testCase "a missing tool records absence rather than failing" $+        withSystemTempDirectory "baikai-cli-identity" $ \dir -> do+          let absent = dir </> "not-installed"+          identity <- executableIdentity absent+          identity ^. #configured @?= Text.pack absent+          identity ^. #resolvedPath @?= Nothing+          identity ^. #version @?= Nothing,+      testCase "a tool with no --version flag records absence rather than failing" $+        withSystemTempDirectory "baikai-cli-identity" $ \dir -> do+          exe <- writeFakeExecutable dir "grumpy" "#!/bin/sh\necho 'unknown flag' >&2\nexit 2\n"+          identity <- executableIdentity exe+          identity ^. #resolvedPath @?= Just (Text.pack exe)+          identity ^. #version @?= Nothing,+      -- The whole reason for the cache: a version probe spawns a+      -- process, and paying that per model call would roughly double+      -- the process cost of the cheapest possible call.+      --+      -- The assertion that carries the weight is that the second call+      -- left the ledger untouched. Asserting "exactly one line" instead+      -- would also fail when the first probe was killed by its own+      -- timeout on a loaded machine, which says nothing about caching.+      testCase "the version is probed once per executable, not once per call" $+        withSystemTempDirectory "baikai-cli-identity" $ \dir -> do+          let ledger = dir </> "probes"+              probeCount = length . lines <$> readFileIfPresent ledger+          exe <-+            writeFakeExecutable+              dir+              "counted"+              ("#!/bin/sh\necho x >> '" <> ledger <> "'\necho 'counted 1.0'\n")+          first <- executableIdentity exe+          afterFirst <- probeCount+          second <- executableIdentity exe+          afterSecond <- probeCount+          second @?= first+          afterSecond @?= afterFirst+          assertBool+            ("the first call must probe at most once, saw " <> show afterFirst)+            (afterFirst <= 1)+    ]++readFileIfPresent :: FilePath -> IO String+readFileIfPresent path = do+  here <- doesFileExist path+  if here then readFile path else pure ""++-- ============================================================+-- Evidence helpers+-- ============================================================++evidenceHelperTests :: TestTree+evidenceHelperTests =+  testGroup+    "evidence helpers"+    [ testCase "strength rises only with what the tool reported" $ do+        subprocessStrength (Observed "s-1") (Observed "m-1") @?= EvidenceModelObserved+        subprocessStrength (Observed "s-1") Unobserved @?= EvidenceCorrelated+        subprocessStrength Unobserved Unobserved @?= EvidenceRequestedOnly+        -- A model without a correlation identifier cannot be located in+        -- the vendor's records, so it does not reach 'correlated'.+        subprocessStrength Unobserved (Observed "m-1") @?= EvidenceRequestedOnly,+      -- The API transports spell their response envelope with these+      -- three keys by hand. A verifier holding a response must be able+      -- to recompute the digest without knowing which transport served+      -- it, so the subprocess spelling has to agree.+      testCase "the response envelope spells the same three keys the API transports do" $ do+        let encoded = BS8.unpack (canonicalEncode (cliResponseEnvelope "pong" zeroUsage))+        mapM_+          (\k -> assertBool (k <> " must appear in the envelope") (k `isInfixOf` encoded))+          ["\"content\"", "\"stop_reason\"", "\"usage\""]+        assertBool+          "the assistant text must be committed to"+          ("pong" `isInfixOf` encoded),+      testCase "an argv envelope commits to the prompt and its projection keeps nothing" $ do+        let argv = argvEnvelope "claude" ["-p", "--effort", "low", "--", "PROMPT-BODY-MARKER"]+        assertBool+          "the commitment input must contain the prompt"+          ("PROMPT-BODY-MARKER" `isInfixOf` BS8.unpack (canonicalEncode argv))+        BS8.unpack (canonicalEncode (configurationProjection argv)) @?= "null"     ]

@@ -12,6 +12,7 @@     withCallLog,   ) import Baikai.Cost.Pricing (attachCost, computeCost)+import Baikai.Evidence (noThinkingRequested) import Baikai.Message (AssistantPayload (..), user) import Baikai.Model (Model (..), ModelCost (..), emptyModel) import Baikai.Options (Options, emptyOptions)@@ -142,7 +143,8 @@           provider = "claude-api",           responseId = Nothing,           latencyMs = 100,-          errorInfo = Nothing+          errorInfo = Nothing,+          evidence = Nothing         }  -- Register a handler under a private API tag that returns a canned@@ -167,7 +169,8 @@           provider = "canned",           responseId = Nothing,           latencyMs = 7,-          errorInfo = Nothing+          errorInfo = Nothing,+          evidence = Nothing         }  registerCanned :: Response -> IO ()@@ -177,7 +180,8 @@         ApiProvider           { apiTag = cannedApi,             stream = liftCompleteToStream handler,-            complete = handler+            complete = handler,+            describeThinking = \_ _ -> noThinkingRequested           }  cannedModel :: Model

@@ -37,6 +37,7 @@       term =         errorTerminal           Nothing+          Nothing           ErrorReason           (AssistantMessage payload)           (rateLimited (Just 5) "rate limited, slow down")@@ -53,7 +54,8 @@     ApiProvider       { apiTag = errApi,         stream = errStream,-        complete = streamingComplete errStream+        complete = streamingComplete errStream,+        describeThinking = \_ _ -> noThinkingRequested       }  tests :: TestTree@@ -92,6 +94,7 @@                 .~ Just "legacy unclassified failure"             terminal =               doneTerminal+                Nothing                 Nothing                 ErrorReason                 (AssistantMessage payload)

@@ -0,0 +1,344 @@+-- | Tests for "Baikai.Evidence": that the canonical encoding really is+-- canonical, that the two digests differ in exactly the way they are+-- documented to, and that the configuration projection lets no content+-- through.+module EvidenceSpec (tests) where++import Baikai.Evidence+import Baikai.Provider.Cli.Internal qualified as Internal+import Control.Concurrent (threadDelay)+import Control.Monad (replicateM)+import Data.Aeson (Value (Number, Object, String), object, (.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap qualified as KeyMap+import Data.ByteString.Char8 qualified as BS8+import Data.Set qualified as Set+import Data.Text qualified as Text+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Evidence"+    [ canonicalTests,+      digestTests,+      redactionTests,+      observedTests,+      callIdTests+    ]++-- ============================================================+-- Canonical encoding+-- ============================================================++-- | The same logical object built by inserting keys in two different+-- orders. Built by folding inserts over two differently ordered lists+-- rather than with 'object', because aeson's 'KeyMap' may or may not+-- preserve insertion order depending on its size and build flags, and+-- the test must be meaningful either way.+canonicalTests :: TestTree+canonicalTests =+  testGroup+    "canonical encoding"+    [ testCase "is stable across map insertion order" $ do+        let values = map (Number . fromIntegral) [1 :: Int ..]+            keys = ["zulu", "alpha", "mike", "bravo", "yankee", "charlie"]+            pairs = zip keys values+            forwards = fromPairs pairs+            backwards = fromPairs (reverse pairs)+        canonicalEncode forwards @?= canonicalEncode backwards+        commitmentDigest forwards @?= commitmentDigest backwards,+      testCase "sorts keys ascending and emits no whitespace" $ do+        let v = fromPairs [("b", Number 2), ("a", Number 1)]+        canonicalEncode v @?= BS8.pack "{\"a\":1,\"b\":2}",+      testCase "nested objects are sorted too" $ do+        let inner = fromPairs [("z", Number 1), ("y", Number 2)]+            v = fromPairs [("outer", inner)]+        canonicalEncode v @?= BS8.pack "{\"outer\":{\"y\":2,\"z\":1}}",+      testCase "array order is preserved" $+        canonicalEncode (Aeson.toJSON [3 :: Int, 1, 2])+          @?= BS8.pack "[3,1,2]",+      testCase "normalises integral and fractional number spellings" $ do+        -- Every spelling on the left is the same mathematical value as+        -- the one it is compared against; aeson parses them into+        -- different Scientific values.+        encodeJson "1" @?= "1"+        encodeJson "1.0" @?= "1"+        encodeJson "1.00" @?= "1"+        encodeJson "1e0" @?= "1"+        encodeJson "1e2" @?= "100"+        encodeJson "0.1" @?= "0.1"+        encodeJson "1e-1" @?= "0.1"+        encodeJson "1.100" @?= "1.1"+        encodeJson "-0.50" @?= "-0.5",+      testCase "escapes only what JSON requires" $ do+        canonicalEncode (String "a\"b\\c") @?= BS8.pack "\"a\\\"b\\\\c\""+        canonicalEncode (String "line\nbreak") @?= BS8.pack "\"line\\nbreak\""+        canonicalEncode (String "bell\a") @?= BS8.pack "\"bell\\u0007\""+        -- Non-ASCII travels as UTF-8, not as a \u escape.+        canonicalEncode (String "\28450\23383")+          @?= BS8.pack "\"\230\188\162\229\173\151\""+    ]+  where+    encodeJson :: String -> String+    encodeJson src = case Aeson.decodeStrict (BS8.pack src) of+      Just (v :: Value) -> BS8.unpack (canonicalEncode v)+      Nothing -> "<unparsed: " <> src <> ">"++-- | Build an object by folding inserts in the given order, so that a+-- caller can control insertion history. 'Data.Aeson.object' would not+-- do: the point of the ordering test is that two different insertion+-- histories still encode identically.+fromPairs :: [(Text.Text, Value)] -> Value+fromPairs = Object . foldl' step KeyMap.empty+  where+    step acc (k, v) = KeyMap.insert (Key.fromText k) v acc++-- ============================================================+-- The two digests+-- ============================================================++digestTests :: TestTree+digestTests =+  testGroup+    "digests"+    [ testCase "a digest is sha256: plus 64 lowercase hex characters" $ do+        env <- loadFixture+        let d = commitmentDigest env+        assertBool ("expected a sha256: prefix, got " <> Text.unpack d) $+          "sha256:" `Text.isPrefixOf` d+        Text.length (Text.drop 7 d) @?= 64+        assertBool+          ("digest must be lowercase hex: " <> Text.unpack d)+          (Text.all (`elem` ("0123456789abcdef" :: String)) (Text.drop 7 d)),+      -- The golden values below pin the canonicalisation rule. If one+      -- of these fails and the fixture has not changed, the encoding+      -- changed, and every digest recorded by an earlier build has+      -- become unverifiable. That is a major bump of+      -- evidenceSchemaVersion, not a value to paste over.+      testCase "the request commitment matches the golden value" $ do+        env <- loadFixture+        commitmentDigest env+          @?= "sha256:ee1baf81dad750bb61bbcd6a737b8266c206a4288403510be5e10cace20b5798",+      testCase "the configuration digest matches the golden value" $ do+        env <- loadFixture+        configurationDigest env+          @?= "sha256:858f0d5ec35ba6f8bac39140c6523785abcbf4e8007c770c1ba2e13f0e72d6b5",+      testCase "the configuration digest ignores content, the commitment does not" $ do+        let ask subject =+              object+                [ "model" .= ("m" :: Text.Text),+                  "messages"+                    .= [ object+                           [ "role" .= ("user" :: Text.Text),+                             "content" .= (subject :: Text.Text)+                           ]+                       ]+                ]+            -- Same length on purpose: the projection keeps a character+            -- count, so differing lengths would change the digest for+            -- a reason unrelated to content.+            q1 = ask "hello"+            q2 = ask "world"+        configurationDigest q1 @?= configurationDigest q2+        assertBool+          "the commitment digest must distinguish different content"+          (commitmentDigest q1 /= commitmentDigest q2),+      testCase "the configuration digest still separates different configurations" $ do+        let withModel m = object ["model" .= (m :: Text.Text)]+        assertBool+          "different models must produce different configuration digests"+          (configurationDigest (withModel "a") /= configurationDigest (withModel "b")),+      testCase "a non-object envelope projects to null" $+        configurationProjection (String "not an envelope") @?= Aeson.Null+    ]++-- ============================================================+-- Redaction+-- ============================================================++-- | The four markers below are the API key, the prompt body, the+-- reasoning text, and a tool-call argument payload planted in the+-- fixture. The assertion is on the encoded bytes rather than on the+-- projected structure, because the claim being tested is that none of+-- them survives into the output no matter how it got there.+redactionTests :: TestTree+redactionTests =+  testGroup+    "redaction"+    [ testCase "the configuration projection drops all content" $ do+        env <- loadFixture+        let encoded = BS8.unpack (canonicalEncode (configurationProjection env))+        mapM_+          ( \marker ->+              assertBool+                (marker <> " survived into the configuration projection: " <> encoded)+                (not (marker `isInfix` encoded))+          )+          [ "sk-baikai-fixture-secret-key",+            "PROMPT-BODY-MARKER",+            "SYSTEM-PROMPT-BODY-MARKER",+            "REASONING-TEXT-MARKER",+            "TOOL-PAYLOAD-MARKER",+            "Fetch a quarterly report by identifier."+          ],+      testCase "the projection keeps the configuration it is supposed to" $ do+        env <- loadFixture+        let encoded = BS8.unpack (canonicalEncode (configurationProjection env))+        mapM_+          ( \kept ->+              assertBool+                (kept <> " should have been kept, but was not: " <> encoded)+                (kept `isInfix` encoded)+          )+          [ "claude-opus-4-6",+            "budget_tokens",+            "max_tokens",+            "temperature",+            -- A tool's name is configuration; its description is not.+            "fetch_report"+          ],+      testCase "the commitment digest does see the content" $ do+        env <- loadFixture+        let encoded = BS8.unpack (canonicalEncode env)+        assertBool+          "the commitment input must contain the prompt body"+          ("PROMPT-BODY-MARKER" `isInfix` encoded),+      -- The subprocess providers pass their rendered argument vector as+      -- the request envelope, and both of them place the prompt inside+      -- it. The commitment digest therefore covers the prompt, which is+      -- correct; the configuration projection must not.+      --+      -- It does not, for a structural reason worth stating: the+      -- projection admits named fields from an object, and a JSON array+      -- has none, so an argv envelope projects to @null@ wholesale. That+      -- is the allow-list failing in the safe direction.+      testCase "an argv envelope's configuration projection keeps nothing" $ do+        let argv = Internal.argvEnvelope "codex" ["exec", "--model", "gpt-5.6", "--", "PROMPT-BODY-MARKER"]+            projected = BS8.unpack (canonicalEncode (configurationProjection argv))+            committed = BS8.unpack (canonicalEncode argv)+        projected @?= "null"+        assertBool+          "the commitment input must contain the argv prompt"+          ("PROMPT-BODY-MARKER" `isInfix` committed)+        assertBool+          "the configuration projection must not contain the argv prompt"+          (not ("PROMPT-BODY-MARKER" `isInfix` projected))+    ]+  where+    isInfix needle haystack =+      Text.isInfixOf (Text.pack needle) (Text.pack haystack)++-- ============================================================+-- Observed+-- ============================================================++observedTests :: TestTree+observedTests =+  testGroup+    "observed"+    [ testCase "encodes Unobserved as the string \"unobserved\"" $+        Aeson.toJSON (Unobserved :: Observed Text.Text) @?= String "unobserved",+      testCase "encodes an observed value under an observed key" $+        Aeson.toJSON (Observed ("claude-opus-4-6" :: Text.Text))+          @?= object ["observed" .= ("claude-opus-4-6" :: Text.Text)],+      testCase "round-trips through JSON in both directions" $ do+        roundTrip (Observed ("m" :: Text.Text))+        roundTrip (Unobserved :: Observed Text.Text),+      testCase "observedValue reports absence rather than defaulting" $ do+        observedValue (Observed ("m" :: Text.Text)) @?= Just "m"+        observedValue (Unobserved :: Observed Text.Text) @?= Nothing,+      -- Strict evidence mode compares a record's strength against the+      -- caller's requirement with (>=), so this ordering is load-bearing+      -- rather than cosmetic.+      testCase "evidence strength ascends in the order strict mode compares" $ do+        let ascending =+              [ EvidenceRequestedOnly,+                EvidenceCorrelated,+                EvidenceModelObserved,+                EvidenceFullyObserved+              ]+        assertBool+          "EvidenceStrength constructors must ascend as declared"+          (and (zipWith (<) ascending (drop 1 ascending))),+      testCase "noThinkingRequested records absence, not an unsupported level" $ do+        requested noThinkingRequested @?= Nothing+        mode noThinkingRequested @?= ThinkingModeAbsent+        adjustments noThinkingRequested @?= [],+      -- Destructured rather than accessed by selector: 'runId',+      -- 'attempt', and 'supersedes' name a field on both+      -- 'EvidenceRequest' and 'ModelCallEvidence', and under+      -- DuplicateRecordFields a bare selector is ambiguous. Library+      -- code reaches these through the generic-lens labels+      -- (@r ^. #runId@) that the rest of this codebase uses.+      testCase "evidenceRequest defaults to best effort, attempt one" $+        case evidenceRequest "run-42" of+          EvidenceRequest+            { runId = rid,+              strictness = strict,+              attempt = att,+              supersedes = prev+            } -> do+              rid @?= "run-42"+              strict @?= EvidenceBestEffort+              att @?= 1+              prev @?= Nothing+    ]+  where+    roundTrip :: Observed Text.Text -> IO ()+    roundTrip v = case Aeson.fromJSON (Aeson.toJSON v) of+      Aeson.Success v' -> v' @?= v+      Aeson.Error e -> assertFailure ("round trip failed: " <> e)++-- ============================================================+-- Identifiers+-- ============================================================++callIdTests :: TestTree+callIdTests =+  testGroup+    "call ids"+    [ -- Generated in a tight loop, so most of these share a+      -- millisecond. If the counter were dropped from the layout, this+      -- would collapse to a handful of distinct values.+      testCase "70000 ids generated back to back are all distinct" $ do+        ids <- replicateM 70000 newCallId+        length (nub' ids) @?= 70000,+      testCase "an id is 32 lowercase hex characters" $ do+        cid <- newCallId+        Text.length cid @?= 32+        assertBool+          ("expected lowercase hex, got " <> Text.unpack cid)+          (Text.all (`elem` ("0123456789abcdef" :: String)) cid),+      -- The millisecond prefix occupies the high bits, so ids minted+      -- later never sort before ids minted earlier.+      testCase "ids sort chronologically" $ do+        earlier <- newCallId+        threadDelay 2000+        later <- newCallId+        assertBool+          (Text.unpack earlier <> " should sort before " <> Text.unpack later)+          (earlier < later)+    ]+  where+    nub' = Set.toList . Set.fromList++-- ============================================================+-- Fixture loading+-- ============================================================++fixturePath :: FilePath+fixturePath = "test/fixtures/evidence-request.json"++-- | The recorded request envelope both golden tests hash. It carries+-- an API key in a header-shaped field, a prompt body, reasoning text,+-- and a tool-call argument payload, so one fixture serves the digest+-- tests and the redaction tests.+loadFixture :: IO Value+loadFixture = do+  raw <- Aeson.eitherDecodeFileStrict' fixturePath+  case raw of+    Left err -> assertFailure ("could not read " <> fixturePath <> ": " <> err)+    Right v -> pure v

@@ -180,7 +180,8 @@     ApiProvider       { apiTag = helpersApi,         complete = scriptedComplete responsesRef callsRef,-        stream = \_ _ _ -> Stream.fromList events+        stream = \_ _ _ -> Stream.fromList events,+        describeThinking = \_ _ -> noThinkingRequested       }   pure Scripted {scriptRegistry = reg, scriptCallRef = callsRef} @@ -206,7 +207,8 @@     ApiProvider       { apiTag,         complete = \model _ctx _opts -> pure (stampModel model resp),-        stream = \_ _ _ -> Stream.fromList []+        stream = \_ _ _ -> Stream.fromList [],+        describeThinking = \_ _ -> noThinkingRequested       }  oneShotProvider :: Api -> Text -> ApiProvider@@ -214,7 +216,8 @@   ApiProvider     { apiTag,       complete = \model _ctx _opts -> pure (stampModel model (textResponse body)),-      stream = \_ _ _ -> Stream.fromList []+      stream = \_ _ _ -> Stream.fromList [],+      describeThinking = \_ _ -> noThinkingRequested     }  errorProvider :: Api -> BaikaiError -> ApiProvider@@ -222,7 +225,8 @@   ApiProvider     { apiTag,       complete = \model _ctx _opts -> pure (errorResponse model epoch 0 err),-      stream = \_ _ _ -> Stream.fromList []+      stream = \_ _ _ -> Stream.fromList [],+      describeThinking = \_ _ -> noThinkingRequested     }  stampModel :: Model -> Response -> Response@@ -321,7 +325,7 @@         TextStart IndexPayload {contentIndex = 0},         TextDelta DeltaPayload {contentIndex = 0, delta = body},         TextEnd BlockEndPayload {contentIndex = 0, content = body},-        EventDone (doneTerminal (Just rid) Stop msg)+        EventDone (doneTerminal Nothing (Just rid) Stop msg)       ]  withUnsetEnv :: String -> IO a -> IO a

@@ -1,6 +1,7 @@ module Main (main) where  import AgentAssetsSpec qualified+import AgentSpec qualified import Baikai import Baikai.Models.Generated import Baikai.Prelude@@ -16,12 +17,14 @@ import EmbeddingSpec qualified import ErrorInfoSpec qualified import ErrorSpec qualified+import EvidenceSpec qualified import FetchModelsSpec qualified import GenModelsSpec qualified import HelpersSpec qualified import InteractiveSpec qualified import StreamSpec qualified import Streamly.Data.Stream qualified as Stream+import StrictEvidenceSpec qualified import SurfaceSpec qualified import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertBool, testCase, (@?=))@@ -78,7 +81,8 @@    in ApiProvider         { apiTag = testApi,           stream = liftCompleteToStream handler,-          complete = handler+          complete = handler,+          describeThinking = \_ _ -> noThinkingRequested         }  main :: IO ()@@ -89,6 +93,7 @@       "baikai"       [ tests,         AgentAssetsSpec.tests,+        AgentSpec.tests,         CatalogSpec.tests,         CliInternalSpec.tests,         ContextSpec.tests,@@ -96,11 +101,13 @@         EmbeddingSpec.tests,         ErrorInfoSpec.tests,         ErrorSpec.tests,+        EvidenceSpec.tests,         FetchModelsSpec.tests,         GenModelsSpec.tests,         HelpersSpec.tests,         InteractiveSpec.tests,         StreamSpec.tests,+        StrictEvidenceSpec.tests,         SurfaceSpec.tests,         ThinkingLevelSpec.tests,         TraceSpec.tests,

@@ -71,7 +71,7 @@  doneEvent :: Maybe Text -> [AssistantContent] -> AssistantMessageEvent doneEvent rid blocks =-  EventDone (doneTerminal rid Stop (assistantMessage blocks))+  EventDone (doneTerminal Nothing rid Stop (assistantMessage blocks))  signedThinking :: ThinkingContent signedThinking =

@@ -0,0 +1,436 @@+-- | The pre-dispatch strictness gate.+--+-- Strict evidence mode is the only place in baikai that refuses to make+-- a call the caller asked for, so these cases split cleanly in two. The+-- first half proves it refuses what it must: every place baikai weakens+-- a reasoning request, and every transport that cannot reach a demanded+-- strength. The second half proves it refuses nothing else — which is+-- the harder guarantee, because it is the one every existing caller+-- depends on without knowing the feature exists.+module StrictEvidenceSpec (tests) where++import Baikai+import Control.Exception (evaluate, try)+import Control.Exception qualified as Exception+import Control.Lens ((&), (.~), (^.))+import Data.Generics.Labels ()+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Vector qualified as Vector+import Streamly.Data.Stream qualified as Stream+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "StrictEvidenceSpec: pre-dispatch strict evidence"+    [ declaredStrengthTests,+      strengthGateTests,+      downgradeGateTests,+      bestEffortIsNeverRefusedTests,+      lazinessTests,+      dispatchTests+    ]++-- ============================================================+-- Declared strength+-- ============================================================++declaredStrengthTests :: TestTree+declaredStrengthTests =+  testGroup+    -- Each of these is separately proved reachable by a test that drives+    -- that transport to it: the Anthropic and OpenAI-compatible API+    -- cases live in each vendor package's EvidenceSpec, and the two CLI+    -- cases in its CliEvidenceSpec. This group pins the declarations+    -- themselves so a change to one is a change someone had to mean.+    "declared strength"+    [ testCase "the two API transports declare model_observed" $ do+        declaredStrength AnthropicMessages @?= EvidenceModelObserved+        declaredStrength OpenAIChatCompletions @?= EvidenceModelObserved,+      testCase "the claude CLI declares model_observed, the codex CLI correlated" $ do+        -- Not symmetry: claude names the model that consumed tokens in+        -- its result event, and codex-cli 0.146.0 names no model+        -- anywhere in its event stream.+        declaredStrength AnthropicMessagesCli @?= EvidenceModelObserved+        declaredStrength OpenAICompletionsCli @?= EvidenceCorrelated,+      testCase "a custom transport declares requested_only" $+        -- Baikai knows nothing about a caller-supplied transport and+        -- must not assume on its behalf.+        declaredStrength (Custom "someone-elses-gateway") @?= EvidenceRequestedOnly,+      testCase "NO TRANSPORT DECLARES fully_observed" $+        -- Reaching it would need a provider that echoes the thinking+        -- configuration it applied, and none of them does. A+        -- reasoning-token count corroborates output volume and says+        -- nothing about which effort setting was in force.+        assertBool+          "fully_observed must stay unreachable until a provider echoes its thinking config"+          ( all+              ((< EvidenceFullyObserved) . declaredStrength)+              [ AnthropicMessages,+                OpenAIChatCompletions,+                AnthropicMessagesCli,+                OpenAICompletionsCli,+                Custom "x"+              ]+          )+    ]++-- ============================================================+-- The strength half of the gate+-- ============================================================++strengthGateTests :: TestTree+strengthGateTests =+  testGroup+    "a transport that cannot reach the required strength is refused"+    [ testCase "a custom transport cannot supply model_observed" $+        case checkEvidenceRequirements+          (EvidenceRequired EvidenceModelObserved)+          (Custom "someone-elses-gateway")+          noThinkingRequested of+          [StrengthUnreachable needed declared] -> do+            needed @?= EvidenceModelObserved+            declared @?= EvidenceRequestedOnly+          other -> assertFailure ("expected one StrengthUnreachable, got: " <> show other),+      testCase "the codex CLI cannot supply model_observed, because it names no model" $+        case checkEvidenceRequirements+          (EvidenceRequired EvidenceModelObserved)+          OpenAICompletionsCli+          noThinkingRequested of+          [StrengthUnreachable _ declared] -> declared @?= EvidenceCorrelated+          other -> assertFailure ("expected one StrengthUnreachable, got: " <> show other),+      testCase "the codex CLI can supply correlated" $+        checkEvidenceRequirements+          (EvidenceRequired EvidenceCorrelated)+          OpenAICompletionsCli+          noThinkingRequested+          @?= [],+      testCase "an exactly-met requirement is not a refusal" $+        -- The comparison is >=, not >. A transport that declares exactly+        -- what was asked for satisfies it.+        checkEvidenceRequirements+          (EvidenceRequired EvidenceModelObserved)+          AnthropicMessages+          noThinkingRequested+          @?= [],+      testCase "both halves of the gate report together, not one per attempt" $+        -- An operator fixing a configuration should see all of it in one+        -- run, which is what Baikai.Agent.applyAgentCeiling already does+        -- for policy violations.+        length+          ( checkEvidenceRequirements+              (EvidenceRequired EvidenceModelObserved)+              (Custom "gateway")+              (downgradedBy (EffortClamped ThinkingMax "high"))+          )+          @?= 2+    ]++-- ============================================================+-- The downgrade half: one named case per site+-- ============================================================++-- | A translation carrying one adjustment, standing in for what a+-- provider's own translation function would produce at that site. The+-- provider-side proof that each site really produces its adjustment+-- lives in that provider's own test suite; this file proves the gate+-- refuses each one.+downgradedBy :: ThinkingAdjustment -> ThinkingTranslation+downgradedBy adjustment =+  noThinkingRequested+    & #requested .~ Just ThinkingMax+    & #adjustments .~ [adjustment]++-- | Assert the gate refuses this translation and names the adjustment.+refusesDowngrade :: String -> ThinkingAdjustment -> Text -> TestTree+refusesDowngrade name adjustment expectedPhrase =+  testCase name $+    case checkEvidenceRequirements+      (EvidenceRequired EvidenceRequestedOnly)+      AnthropicMessages+      (downgradedBy adjustment) of+      [ThinkingWouldDowngrade [reported]] -> do+        reported @?= adjustment+        let message = renderEvidenceRefusal (ThinkingWouldDowngrade [adjustment])+        assertBool+          ("the refusal must explain itself, got: " <> Text.unpack message)+          (expectedPhrase `Text.isInfixOf` message)+      other -> assertFailure ("expected one ThinkingWouldDowngrade, got: " <> show other)++downgradeGateTests :: TestTree+downgradeGateTests =+  testGroup+    -- Six separate named cases rather than one parameterised test: when+    -- one breaks later, its name should say which site regressed.+    --+    -- The requirement used throughout is EvidenceRequestedOnly, the+    -- weakest there is, so each case proves the downgrade alone refuses+    -- rather than the strength check doing the work.+    "every site where baikai weakens a thinking request refuses a strict call"+    [ refusesDowngrade+        "compatibleEffort clamps a level to a weaker word"+        (EffortClamped ThinkingMax "high")+        "would be sent as high",+      refusesDowngrade+        "a Z.ai or Qwen host collapses every level to a bare toggle"+        (EffortCollapsedToToggle ThinkingMax)+        "bare on/off toggle",+      refusesDowngrade+        "an adaptive high sends no effort field at all"+        (EffortOmitted ThinkingHigh)+        "indistinguishable on the wire",+      refusesDowngrade+        "a model that does not advertise reasoning drops the whole configuration"+        (ThinkingDroppedUnsupportedModel ThinkingMax)+        "does not advertise reasoning support",+      refusesDowngrade+        "a host with no reasoning controls drops the whole configuration"+        (ThinkingDroppedUnsupportedHost ThinkingMax)+        "exposes no reasoning controls",+      refusesDowngrade+        "a thinking budget that will not fit the output ceiling is discarded"+        (ThinkingDroppedBudgetExceeded ThinkingMax 32000 8192)+        "does not fit inside the resolved output ceiling",+      testCase "several downgrades on one call are reported together" $+        case checkEvidenceRequirements+          (EvidenceRequired EvidenceRequestedOnly)+          AnthropicMessages+          ( noThinkingRequested+              & #requested .~ Just ThinkingMax+              & #adjustments+                .~ [EffortClamped ThinkingMax "high", EffortOmitted ThinkingMax]+          ) of+          [ThinkingWouldDowngrade reported] -> length reported @?= 2+          other -> assertFailure ("expected one ThinkingWouldDowngrade, got: " <> show other),+      testCase "REQUESTING NO LEVEL IS NOT A DOWNGRADE" $+        -- The judgement that is not obvious. A caller who asked for+        -- nothing has had nothing weakened, so a strict call that names+        -- no thinking level must still run.+        checkEvidenceRequirements+          (EvidenceRequired EvidenceModelObserved)+          AnthropicMessages+          noThinkingRequested+          @?= [],+      testCase "a level expressed exactly is not a downgrade" $+        -- The native OpenAI shape sends every canonical level verbatim+        -- and codex accepts all six. Refusing those would reject the+        -- configurations that honour the caller in full.+        checkEvidenceRequirements+          (EvidenceRequired EvidenceModelObserved)+          OpenAIChatCompletions+          ( noThinkingRequested+              & #requested .~ Just ThinkingXHigh+              & #mode .~ ThinkingModeAdaptive+              & #effortText .~ Just "xhigh"+          )+          @?= []+    ]++-- ============================================================+-- The guarantee every existing caller depends on+-- ============================================================++bestEffortIsNeverRefusedTests :: TestTree+bestEffortIsNeverRefusedTests =+  testGroup+    -- Exhaustive rather than representative on purpose. This is the+    -- "no existing caller is affected" promise, and a promise proved by+    -- a sample is a promise about the sample.+    "a best-effort caller is never refused, on any transport at any level"+    [ testCase (Text.unpack (renderApi api) <> " / " <> label) $+        checkEvidenceRequirements EvidenceBestEffort api translation @?= []+    | api <-+        [ AnthropicMessages,+          OpenAIChatCompletions,+          AnthropicMessagesCli,+          OpenAICompletionsCli,+          Custom "someone-elses-gateway"+        ],+      (label, translation) <-+        ("no level requested", noThinkingRequested)+          : [ ( Text.unpack (renderThinkingLevel lvl) <> " / " <> adjustmentName adjustment,+                downgradedBy adjustment+              )+            | lvl <-+                [ ThinkingMinimal,+                  ThinkingLow,+                  ThinkingMedium,+                  ThinkingHigh,+                  ThinkingXHigh,+                  ThinkingMax+                ],+              adjustment <-+                [ EffortClamped lvl "low",+                  EffortCollapsedToToggle lvl,+                  EffortOmitted lvl,+                  ThinkingDroppedUnsupportedModel lvl,+                  ThinkingDroppedUnsupportedHost lvl,+                  ThinkingDroppedBudgetExceeded lvl 32000 8192+                ]+            ]+    ]++-- | A short name for one adjustment, so each case in the exhaustive+-- group above is separately identifiable when it fails.+adjustmentName :: ThinkingAdjustment -> String+adjustmentName = \case+  EffortClamped {} -> "clamped"+  EffortCollapsedToToggle {} -> "collapsed"+  EffortOmitted {} -> "omitted"+  ThinkingDroppedUnsupportedModel {} -> "dropped-model"+  ThinkingDroppedUnsupportedHost {} -> "dropped-host"+  ThinkingDroppedBudgetExceeded {} -> "dropped-budget"++-- ============================================================+-- The gate does no work on the default path+-- ============================================================++lazinessTests :: TestTree+lazinessTests =+  testGroup+    -- Computing a translation means a host-compatibility lookup and a+    -- model-capability check. Doing that on every dispatch, for a+    -- feature only strict callers use, would put the cost of strict mode+    -- on the people who declined it.+    "the gate never computes a translation it does not need"+    [ testCase "A BEST-EFFORT CALL NEVER FORCES THE TRANSLATION" $ do+        outcome <-+          try (evaluate (length (checkEvidenceRequirements EvidenceBestEffort AnthropicMessages explodes)))+        case outcome :: Either Exception.SomeException Int of+          Right n -> n @?= 0+          Left e -> assertFailure ("the translation was forced: " <> show e),+      testCase "a strict call does force it, so the test above means something" $ do+        outcome <-+          try+            ( evaluate+                ( length+                    ( checkEvidenceRequirements+                        (EvidenceRequired EvidenceRequestedOnly)+                        AnthropicMessages+                        explodes+                    )+                )+            )+        case outcome :: Either Exception.SomeException Int of+          Right n -> assertFailure ("expected the translation to be forced, got " <> show n)+          Left _ -> pure ()+    ]+  where+    explodes = error "the strictness gate forced a translation it should not have"++-- ============================================================+-- End to end through both dispatch points+-- ============================================================++dispatchTests :: TestTree+dispatchTests =+  testGroup+    "dispatch refuses before the provider runs"+    [ testCase "THE REFUSAL ARRIVES WITHOUT THE PROVIDER BEING CALLED" $ do+        -- The economic point of a pre-dispatch gate: a caller who cannot+        -- get the evidence they require wants to know before paying.+        -- The provider here throws if it is reached at all, so a+        -- returned error-shaped response is proof it was not.+        reg <- newProviderRegistry+        registerApiProviderWith reg explodingProvider+        resp <- completeRequestWith reg customModel testContext (strictly EvidenceModelObserved)+        case responseError resp of+          Nothing -> assertFailure "expected a refusal"+          Just err -> do+            err ^. #category @?= InvalidRequest+            assertBool+              ("the message names both strengths: " <> Text.unpack (err ^. #message))+              ( "model_observed" `Text.isInfixOf` (err ^. #message)+                  && "requested_only" `Text.isInfixOf` (err ^. #message)+              ),+      testCase "the streaming path refuses identically" $ do+        reg <- newProviderRegistry+        registerApiProviderWith reg explodingProvider+        events <-+          Stream.toList+            (streamRequestWith reg customModel testContext (strictly EvidenceModelObserved))+        case events of+          [EventStart _, EventError p] -> (p ^. #errorInfo) /= Nothing @?= True+          other -> assertFailure ("expected a start and one terminal error, got: " <> show other),+      testCase "a refused call still records the evidence explaining itself" $ do+        -- A caller told their call was refused should be able to read+        -- which requirement failed out of the record, not only out of+        -- the message.+        reg <- newProviderRegistry+        registerApiProviderWith reg explodingProvider+        resp <- completeRequestWith reg customModel testContext (strictly EvidenceModelObserved)+        case resp ^. #evidence of+          Nothing -> assertFailure "a strict caller opted into evidence and must get a record"+          Just ev -> do+            ev ^. #status @?= CallFailed+            ev ^. #strength @?= EvidenceRequestedOnly,+      testCase "a best-effort caller reaches the provider unchanged" $ do+        -- Same registry, same model, same everything but the strictness.+        reg <- newProviderRegistry+        registerApiProviderWith reg countingProvider+        resp <- completeRequestWith reg customModel testContext bestEffortOptions+        responseError resp @?= Nothing+        flattenAssistantText (flattenAssistantBlocks resp) @?= "the provider ran",+      testCase "a caller who asked for no evidence reaches the provider unchanged" $ do+        reg <- newProviderRegistry+        registerApiProviderWith reg countingProvider+        resp <- completeRequestWith reg customModel testContext emptyOptions+        responseError resp @?= Nothing+        flattenAssistantText (flattenAssistantBlocks resp) @?= "the provider ran"+    ]++-- ============================================================+-- Fixtures+-- ============================================================++customApi :: Api+customApi = Custom "someone-elses-gateway"++customModel :: Model+customModel =+  emptyModel+    & #modelId .~ "gateway-model"+    & #api .~ customApi+    & #provider .~ "someone-else"++testContext :: Context+testContext = emptyContext & #messages .~ Vector.singleton (user "ping")++strictly :: EvidenceStrength -> Options+strictly needed =+  emptyOptions+    & #evidence .~ Just (evidenceRequest "run-57" & #strictness .~ EvidenceRequired needed)++bestEffortOptions :: Options+bestEffortOptions = emptyOptions & #evidence .~ Just (evidenceRequest "run-57")++-- | A provider that fails loudly if it is reached. Used to prove the+-- gate refuses /before/ dispatch rather than annotating afterwards.+explodingProvider :: ApiProvider+explodingProvider =+  ApiProvider+    { apiTag = customApi,+      stream = \_ _ _ -> error "the provider was dispatched despite a strict refusal",+      complete = \_ _ _ -> error "the provider was dispatched despite a strict refusal",+      describeThinking = \_ _ -> noThinkingRequested+    }++-- | The same shape, but it answers.+countingProvider :: ApiProvider+countingProvider =+  ApiProvider+    { apiTag = customApi,+      stream = liftCompleteToStream handler,+      complete = handler,+      describeThinking = \_ _ -> noThinkingRequested+    }+  where+    handler m _ _ =+      pure+        ( emptyResponse+            & #model .~ m+            & #message . #content+              .~ Vector.singleton (AssistantText (TextContent "the provider ran"))+        )

@@ -1,27 +1,50 @@+-- This module deliberately exercises 'newEventId', which is deprecated+-- in favour of 'Baikai.Evidence.newCallId'. The alias is still part of+-- the public surface, so it keeps a test; suppressing the warning here+-- is narrower than dropping the coverage.+{-# OPTIONS_GHC -Wno-deprecations #-}+ module TraceSpec (tests) where  import Baikai.Api (Api (..)) import Baikai.Content (AssistantContent (..), TextContent (..)) import Baikai.Context (Context (..), emptyContext) import Baikai.Error (BaikaiError, providerError)+import Baikai.Evidence+  ( ModelCallEvidence,+    TransportKind (..),+    evidenceRequest,+    noThinkingRequested,+  )+import Baikai.Evidence qualified as Ev+import Baikai.Evidence.Build qualified as Build import Baikai.Message (AssistantPayload (..), user) import Baikai.Model (Model (..), emptyModel) import Baikai.Options (Options, emptyOptions) import Baikai.Prelude import Baikai.Provider (ApiProvider (..), registerApiProvider)-import Baikai.Response (Response (..))+import Baikai.Response (Response (..), responseError) import Baikai.StopReason (StopReason (..)) import Baikai.Stream (liftCompleteToStream)+import Baikai.Stream.Event (AssistantMessageEvent (..)) import Baikai.Trace (newEventId, withTrace, withTraceStream) import Baikai.Trace.Event (TraceEvent (..)) import Baikai.Trace.Sink (TraceSink (..), silent)-import Baikai.Usage (zeroUsage)+import Baikai.Usage (Usage, zeroUsage) import Control.Concurrent (threadDelay) import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVarIO) import Control.Exception (throwIO) import Control.Monad (replicateM)+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.Lazy.Char8 qualified as BL8 import Data.Set qualified as Set import Data.Text qualified as Text+import Data.Text.Encoding qualified as TextEncoding+import Data.Text.IO qualified as Text.IO+import Data.Time (UTCTime, getCurrentTime) import Data.Vector qualified as V import Streamly.Data.Fold qualified as Fold import Streamly.Data.Stream qualified as Stream@@ -39,7 +62,10 @@       memoryFailTest,       throwingSinkTest,       eventIdUniquenessTest,-      earlyAbortTest+      earlyAbortTest,+      fidelityTest,+      evidenceTests,+      encodingTests     ]  -- | Each test uses its own private 'Api' tag so tasty's parallel@@ -79,7 +105,8 @@       provider = "stub.trace",       responseId = Nothing,       latencyMs = 0,-      errorInfo = Nothing+      errorInfo = Nothing,+      evidence = Nothing     }  registerOk :: Api -> IO ()@@ -89,7 +116,8 @@         ApiProvider           { apiTag = a,             stream = liftCompleteToStream handler,-            complete = handler+            complete = handler,+            describeThinking = \_ _ -> noThinkingRequested           }  registerFail :: Api -> BaikaiError -> IO ()@@ -99,7 +127,8 @@         ApiProvider           { apiTag = a,             stream = liftCompleteToStream handler,-            complete = handler+            complete = handler,+            describeThinking = \_ _ -> noThinkingRequested           }  memorySink :: IO (TVar [TraceEvent], TraceSink)@@ -186,12 +215,19 @@         let AssistantPayload {stopReason = sr} = resp ^. #message         sr @?= Stop +-- | The length assertion here used to read+-- @assertBool "every id is 16 chars" (all ((== 16) . Text.length) ids)@.+-- It now reads 32, because 'newEventId' delegates to+-- 'Baikai.Evidence.newCallId', which carries 128 bits rather than 64.+-- The widening is the point of the replacement: the old generator+-- packed a process-start /second/ into its high half and so repeated+-- itself across processes started in the same second. eventIdUniquenessTest :: TestTree eventIdUniquenessTest =-  testCase "newEventId yields 70000 distinct 16-char ids" $ do+  testCase "newEventId yields 70000 distinct 32-char ids" $ do     ids <- replicateM 70000 newEventId     Set.size (Set.fromList ids) @?= 70000-    assertBool "every id is 16 chars" (all ((== 16) . Text.length) ids)+    assertBool "every id is 32 chars" (all ((== 32) . Text.length) ids)  earlyAbortTest :: TestTree earlyAbortTest =@@ -225,3 +261,537 @@       if length evs >= n         then pure (reverse evs)         else threadDelay 50000 >> go (k - 1)++-- ============================================================+-- Usage and cost fidelity+-- ============================================================++-- | Usage with every disjoint token class populated, so a trace event+-- that drops one is visible rather than merely zero.+richUsage :: Usage+richUsage =+  zeroUsage+    & #inputTokens+    .~ 11+    & #outputTokens+    .~ 7+    & #cacheReadTokens+    .~ 5+    & #cacheWriteTokens+    .~ 3+    & #reasoningTokens+    .~ Just 4+    & #totalTokens+    .~ 26++registerWithUsage :: Api -> Usage -> IO ()+registerWithUsage a u =+  let resp = stubResponse a & #message . #usage .~ u+      handler _m _ctx _opts = pure resp+   in registerApiProvider+        ApiProvider+          { apiTag = a,+            stream = liftCompleteToStream handler,+            complete = handler,+            describeThinking = \_ _ -> noThinkingRequested+          }++fidelityTest :: TestTree+fidelityTest =+  testGroup+    "CallFinished fidelity"+    [ testCase "carries the full disjoint token breakdown" $ do+        let a = Custom "baikai-trace-usage-fidelity"+        registerWithUsage a richUsage+        (ref, sink) <- memorySink+        _ <- withTrace sink (stubModel a) stubContext stubOptions+        events <- reverse <$> readTVarIO ref+        -- Read through record patterns, not '#field' labels:+        -- generic-lens only resolves a label present on every+        -- constructor of the sum, and these five are on 'CallFinished'+        -- alone.+        case [f | f@CallFinished {} <- events] of+          [ CallFinished+              { inputTokens,+                outputTokens,+                cachedInputTokens,+                cacheWriteTokens,+                reasoningTokens,+                totalTokens+              }+            ] -> do+              inputTokens @?= Just 11+              outputTokens @?= Just 7+              cachedInputTokens @?= Just 5+              cacheWriteTokens @?= Just 3+              reasoningTokens @?= Just 4+              totalTokens @?= Just 26+          other -> assertFailure ("expected one CallFinished, got: " <> show other),+      -- A zero cost used to be suppressed, which made "this call was+      -- free" indistinguishable from "baikai could not price this+      -- call". The CLI providers always price at zero, so that was the+      -- common case rather than a corner.+      testCase "reports a zero cost as zero rather than omitting it" $ do+        let a = Custom "baikai-trace-zero-cost"+        registerOk a+        (ref, sink) <- memorySink+        _ <- withTrace sink (stubModel a) stubContext stubOptions+        events <- reverse <$> readTVarIO ref+        case [f | f@CallFinished {} <- events] of+          [f@CallFinished {usd}] -> do+            usd @?= Just 0+            assertBool+              "usd must be present in the encoded JSON, not dropped by omitNothingFields"+              (KeyMap.member "usd" (asObject (Aeson.toJSON f)))+          other -> assertFailure ("expected one CallFinished, got: " <> show other)+    ]++-- ============================================================+-- Evidence emission+-- ============================================================++-- | The same options every other test in this module uses, plus an+-- evidence request. A call that emits no evidence cannot prove an+-- exactly-once guarantee about evidence, so every emission case below+-- opts in.+evidenceOptions :: Options+evidenceOptions = stubOptions & #evidence .~ Just (evidenceRequest "run-52")++-- | A fixture provider that builds evidence the way a real adapter+-- does: it hands 'Build.minimalEvidence' the envelope it would have+-- sent and attaches the result to its 'Response', which+-- 'liftCompleteToStream' then carries onto the terminal event.+--+-- 'registerOk' deliberately does not, because most of this module's+-- tests are about the trace path rather than the evidence path, and a+-- provider that builds no evidence is the honest model of one that has+-- not been taught to.+registerOkWithEvidence :: Api -> IO ()+registerOkWithEvidence a =+  let handler m _ctx opts = do+        now <- getCurrentTime+        ev <-+          Build.minimalEvidence+            m+            opts+            TransportHttpApi+            noThinkingRequested+            (Aeson.object ["model" Aeson..= (m ^. #modelId :: Text)])+            now+            now+            Ev.CallSucceeded+            Nothing+        pure (stubResponse a & #evidence .~ ev)+   in registerApiProvider+        ApiProvider+          { apiTag = a,+            stream = liftCompleteToStream handler,+            complete = handler,+            describeThinking = \_ _ -> noThinkingRequested+          }++evidencesIn :: [TraceEvent] -> [ModelCallEvidence]+evidencesIn events = [ev | CallEvidence {evidence = ev} <- events]++asObject :: Value -> Aeson.Object+asObject = \case+  Object o -> o+  _ -> KeyMap.empty++-- | Read one field out of an encoded evidence record.+--+-- Deliberately through the JSON rather than through a Haskell record+-- pattern: the encoded form is the contract other systems pin against,+-- and it is the thing that must not drift. It also spells fields in+-- snake_case, which a Haskell mirror would silently paper over.+evidenceField :: Text -> ModelCallEvidence -> Maybe Value+evidenceField k ev = KeyMap.lookup (Key.fromText k) (asObject (Aeson.toJSON ev))++evidenceTests :: TestTree+evidenceTests =+  testGroup+    "model-call evidence"+    [ successEvidenceTest,+      failureEvidenceTest,+      abortEvidenceTest,+      noProviderEvidenceTest,+      sinkFailureEvidenceTest,+      strictSinkFailureTest,+      strictSinkFailureIsStillOneTerminalTest,+      optOutSilentTest,+      optOutGoldenTest,+      envelopeNotForcedTest+    ]++-- | Assert the shape every record this plan produces must have: the+-- channel works, and nothing was backfilled from the request.+assertMinimalShape :: ModelCallEvidence -> IO ()+assertMinimalShape ev = do+  evidenceField "schema_version" ev @?= Just (String Ev.evidenceSchemaVersion)+  evidenceField "run_id" ev @?= Just (String "run-52")+  evidenceField "requested_model" ev @?= Just (String "stub-1")+  evidenceField "strength" ev @?= Just (String "requested_only")+  evidenceField "observed_model" ev @?= Just (String "unobserved")+  evidenceField "response_id" ev @?= Just (String "unobserved")+  evidenceField "provider_request_id" ev @?= Just (String "unobserved")+  assertDigest "request_commitment" ev+  assertDigest "request_configuration" ev+  where+    assertDigest k e = case evidenceField k e of+      Just (String d) ->+        assertBool+          (Text.unpack k <> " must be a sha256 digest, got: " <> show d)+          ("sha256:" `Text.isPrefixOf` d && Text.length d == 71)+      other -> assertFailure (Text.unpack k <> " missing or not a string: " <> show other)++-- | Exactly one evidence record per call, joined to the rest of the+-- call's lines by the trace @eventId@.+exactlyOneEvidence :: [TraceEvent] -> IO ModelCallEvidence+exactlyOneEvidence events = case evidencesIn events of+  [ev] -> do+    let ids = Set.fromList [e ^. #eventId :: Text | e <- events]+    Set.size ids @?= 1+    assertMinimalShape ev+    pure ev+  other ->+    assertFailure+      ("expected exactly one CallEvidence, got " <> show (length other) <> ": " <> show events)++successEvidenceTest :: TestTree+successEvidenceTest =+  testCase "a successful call emits one evidence record with status succeeded" $ do+    let a = Custom "baikai-evidence-success"+    registerOkWithEvidence a+    (ref, sink) <- memorySink+    _ <- withTrace sink (stubModel a) stubContext evidenceOptions+    events <- reverse <$> readTVarIO ref+    ev <- exactlyOneEvidence events+    evidenceField "status" ev @?= Just (String "succeeded")+    evidenceField "error_info" ev @?= Just Null+    -- Purely additive: the pre-existing contract is untouched.+    length [e | e@CallStarted {} <- events] @?= 1+    length [e | e@CallFinished {} <- events] @?= 1+    length [e | e@CallFailed {} <- events] @?= 0++failureEvidenceTest :: TestTree+failureEvidenceTest =+  testCase "a failed call emits one evidence record with status failed" $ do+    let a = Custom "baikai-evidence-failure"+    registerFail a (providerError "stub-failure")+    (ref, sink) <- memorySink+    _ <- withTrace sink (stubModel a) stubContext evidenceOptions+    events <- reverse <$> readTVarIO ref+    ev <- exactlyOneEvidence events+    evidenceField "status" ev @?= Just (String "failed")+    case evidenceField "error_info" ev of+      Just (Object o) ->+        assertBool+          ("expected error_info to mention stub-failure, got: " <> show o)+          (maybe False (Text.isInfixOf "stub-failure" . renderString) (KeyMap.lookup "message" o))+      other -> assertFailure ("expected a populated error_info, got: " <> show other)+    length [e | e@CallStarted {} <- events] @?= 1+    length [e | e@CallFailed {} <- events] @?= 1+  where+    renderString = \case+      String t -> t+      v -> Text.pack (show v)++abortEvidenceTest :: TestTree+abortEvidenceTest =+  testCase "an abandoned stream emits one evidence record with status aborted" $ do+    let a = Custom "baikai-evidence-abort"+    registerOk a+    (ref, sink) <- memorySink+    emitted <-+      Stream.toList+        (Stream.take 1 (withTraceStream sink (stubModel a) stubContext evidenceOptions))+    length emitted @?= 1+    events <- awaitEvents ref 3+    ev <- exactlyOneEvidence events+    -- 'aborted', not 'failed'. The consumer stopped reading; reporting+    -- that as a provider failure would misattribute it.+    evidenceField "status" ev @?= Just (String "aborted")++noProviderEvidenceTest :: TestTree+noProviderEvidenceTest =+  testCase "an unregistered provider emits one evidence record with status failed" $ do+    let a = Custom "baikai-evidence-no-provider"+    (ref, sink) <- memorySink+    _ <- withTrace sink (stubModel a) stubContext evidenceOptions+    events <- reverse <$> readTVarIO ref+    ev <- exactlyOneEvidence events+    evidenceField "status" ev @?= Just (String "failed")++sinkFailureEvidenceTest :: TestTree+sinkFailureEvidenceTest =+  testCase "a throwing sink does not fail an opted-in best-effort call" $ do+    let a = Custom "baikai-evidence-throwing-sink"+    registerOk a+    result <-+      timeout 5000000 (withTrace throwingSink (stubModel a) stubContext evidenceOptions)+    case result of+      Nothing -> assertFailure "withTrace hung on a throwing sink"+      Just resp -> do+        -- Unchanged, and it is the guarantee every existing caller+        -- depends on: the exception does not propagate and the call+        -- succeeds. Only a strict caller gets the opposite; see+        -- 'strictSinkFailureTest' below.+        let AssistantPayload {stopReason = sr} = resp ^. #message+        sr @?= Stop++-- | The one place in baikai where a call that reached the provider and+-- came back is nevertheless reported as failed.+strictSinkFailureTest :: TestTree+strictSinkFailureTest =+  testCase "A STRICT CALL WHOSE SINK THREW FAILS, RATHER THAN SUCCEEDING SILENTLY" $ do+    -- A strict caller asked for a record of this call and the record did+    -- not survive. Handing them the answer anyway would give them+    -- something they cannot account for, with no way to notice: evidence+    -- that can vanish without the caller noticing is not evidence.+    let a = Custom "baikai-evidence-strict-throwing-sink"+    registerOk a+    result <-+      timeout 5000000 (withTrace throwingSink (stubModel a) stubContext strictOptions)+    case result of+      Nothing -> assertFailure "withTrace hung on a throwing sink"+      Just resp -> do+        let AssistantPayload {stopReason = sr} = resp ^. #message+        sr @?= ErrorReason+        case responseError resp of+          Nothing -> assertFailure "expected the sink failure to reach the response"+          Just be ->+            assertBool+              ("the error names the sink: " <> Text.unpack (be ^. #message))+              ("trace sink failed" `Text.isInfixOf` (be ^. #message))++-- | The exactly-once guarantee still holds when the terminal is+-- rewritten.+strictSinkFailureIsStillOneTerminalTest :: TestTree+strictSinkFailureIsStillOneTerminalTest =+  testCase "a rewritten terminal is still exactly one terminal event" $ do+    let a = Custom "baikai-evidence-strict-sink-terminal"+    -- The evidence-building fixture, so the "survives the rewrite"+    -- assertion below has something to survive.+    registerOkWithEvidence a+    events <-+      Stream.toList (withTraceStream throwingSink (stubModel a) stubContext strictOptions)+    length [e | e@(EventDone _) <- events] @?= 0+    length [e | e@(EventError _) <- events] @?= 1+    -- The evidence the provider built survives the rewrite. It is+    -- exactly what a caller investigating this failure wants to read.+    case [p | EventError p <- events] of+      [p] -> assertBool "the evidence survives" (p ^. #evidence /= Nothing)+      other -> assertFailure ("expected one terminal, got: " <> show (length other))++strictOptions :: Options+strictOptions =+  stubOptions+    & #evidence+    .~ Just+      ( evidenceRequest "run-57"+          & #strictness+          .~ Ev.EvidenceRequired Ev.EvidenceRequestedOnly+      )++-- | The criterion that protects every existing user of this library.+optOutSilentTest :: TestTree+optOutSilentTest =+  testCase "a call with no evidence request emits no evidence and traces identically" $ do+    let a = Custom "baikai-evidence-opt-out"+    registerOkWithEvidence a+    (outRef, outSink) <- memorySink+    _ <- withTrace outSink (stubModel a) stubContext stubOptions+    optedOut <- reverse <$> readTVarIO outRef+    (inRef, inSink) <- memorySink+    _ <- withTrace inSink (stubModel a) stubContext evidenceOptions+    optedIn <- reverse <$> readTVarIO inRef+    evidencesIn optedOut @?= []+    length (evidencesIn optedIn) @?= 1+    -- Asking for evidence adds an event and changes nothing else.+    map redact optedOut @?= map redact [e | e <- optedIn, notEvidence e]+  where+    notEvidence = \case+      CallEvidence {} -> False+      _ -> True++-- | Encode an event the way a sink does, then blank the fields that+-- legitimately differ between two runs of the same call.+--+-- Deliberately textual rather than a rewrite of the decoded+-- 'Aeson.Value': 'Aeson.toJSON' produces a 'KeyMap' whose re-encoding+-- sorts keys, and field /order/ is part of what an existing consumer+-- sees. Comparing sorted objects would hide exactly the drift this is+-- here to catch.+--+-- The three redacted values are a hex identifier, an ISO-8601+-- timestamp, and an integer; none can contain a @,@ or @}@, so scanning+-- to the next one is a safe way to find the end of the value.+redact :: TraceEvent -> Text+redact =+  redactField "latencyMs" "0"+    . redactField "timestamp" "\"<ts>\""+    . redactField "eventId" "\"<id>\""+    . TextEncoding.decodeUtf8+    . BL8.toStrict+    . Aeson.encode++redactField :: Text -> Text -> Text -> Text+redactField key replacement line+  | Text.null rest = line+  | otherwise = before <> needle <> replacement <> Text.dropWhile isValueChar after+  where+    needle = "\"" <> key <> "\":"+    (before, rest) = Text.breakOn needle line+    after = Text.drop (Text.length needle) rest+    isValueChar c = c /= ',' && c /= '}'++-- | The golden fixture is the encoded event sequence an opted-out call+-- produces, recorded against+-- @baikai\/test\/fixtures\/trace-opt-out.jsonl@.+--+-- Its content was checked against the pre-plan code rather than+-- asserted from memory: the same fixture provider was run at commit+-- @0acbad8@ (the last commit before this plan touched the trace path)+-- and the two @call_started@ lines match exactly, while @call_finished@+-- differs only by the four token fields and the @usd@ field this plan+-- deliberately added. Nothing else moved, and no @call_evidence@ line+-- appears.+--+-- If this test fails, an opted-out caller's trace output changed. That+-- is a breaking change for every existing user of this library and+-- needs a changelog entry, not a new fixture pasted over the old one.+optOutGoldenTest :: TestTree+optOutGoldenTest =+  testCase "an opted-out call's trace bytes match the golden fixture" $ do+    let a = Custom "baikai-evidence-golden"+    registerOk a+    (ref, sink) <- memorySink+    _ <- withTrace sink (stubModel a) stubContext stubOptions+    events <- reverse <$> readTVarIO ref+    expected <- Text.lines <$> Text.IO.readFile "test/fixtures/trace-opt-out.jsonl"+    map redact events @?= filter (not . Text.null) expected++-- | An opted-out call must do no work, not merely produce no output.+--+-- The fixture provider hands 'Build.minimalEvidence' an envelope that+-- throws when forced. If someone later adds a strictness annotation to+-- that parameter, or moves the opt-out check below the digest+-- computation, this test fails and says why.+envelopeNotForcedTest :: TestTree+envelopeNotForcedTest =+  testCase "an opted-out call never forces the request envelope" $ do+    let a = Custom "baikai-evidence-lazy-envelope"+        handler m _ctx opts = do+          now <- getCurrentTime+          ev <-+            Build.minimalEvidence+              m+              opts+              TransportHttpApi+              noThinkingRequested+              (error "envelope forced on the opt-out path")+              now+              now+              Ev.CallSucceeded+              Nothing+          pure (stubResponse a & #evidence .~ ev)+    registerApiProvider+      ApiProvider+        { apiTag = a,+          stream = liftCompleteToStream handler,+          complete = handler,+          describeThinking = \_ _ -> noThinkingRequested+        }+    (ref, sink) <- memorySink+    _ <- withTrace sink (stubModel a) stubContext stubOptions+    events <- reverse <$> readTVarIO ref+    evidencesIn events @?= []++-- ============================================================+-- Wire encoding+-- ============================================================++-- | 'FromJSON' is hand-written and therefore can drift from the derived+-- 'ToJSON' without the compiler noticing. It already did once during+-- this plan: the decoder read a nested @data@ object, which aeson's+-- 'TaggedObject' does not produce for a record constructor, so it could+-- not have parsed a single line this package emits.+encodingTests :: TestTree+encodingTests =+  testGroup+    "TraceEvent JSON"+    [ testCase "the three decodable kinds round-trip" $+        mapM_ roundTrip [sampleStarted, sampleFinished, sampleFailed],+      -- A trace line carries its fields alongside the discriminator,+      -- not nested under one. Consumers filter on this shape.+      testCase "fields sit alongside the kind discriminator" $ do+        let o = asObject (Aeson.toJSON sampleFinished)+        KeyMap.lookup "kind" o @?= Just (String "call_finished")+        KeyMap.lookup "latencyMs" o @?= Just (Number 12)+        assertBool "no data wrapper" (not (KeyMap.member "data" o)),+      -- Not a limitation to route around: 'ModelCallEvidence' embeds a+      -- cost whose exact Rational cannot survive the Scientific it+      -- encodes through, so a decoder would return a different value+      -- than was encoded. Failing loudly beats claiming a fidelity the+      -- type does not have.+      testCase "a call_evidence line refuses to decode, with an explanation" $ do+        let a = Custom "baikai-evidence-decode"+        registerOkWithEvidence a+        (ref, sink) <- memorySink+        _ <- withTrace sink (stubModel a) stubContext evidenceOptions+        events <- reverse <$> readTVarIO ref+        case [e | e@CallEvidence {} <- events] of+          [e] -> case Aeson.eitherDecode (Aeson.encode e) :: Either String TraceEvent of+            Right decoded -> assertFailure ("expected a decode failure, got: " <> show decoded)+            Left err ->+              assertBool+                ("expected the message to point at Data.Aeson.Value, got: " <> err)+                ("Data.Aeson.Value" `Text.isInfixOf` Text.pack err)+          other -> assertFailure ("expected one CallEvidence, got: " <> show other)+    ]+  where+    roundTrip e = case Aeson.eitherDecode (Aeson.encode e) of+      Right decoded -> decoded @?= e+      Left err -> assertFailure ("failed to decode " <> show e <> ": " <> err)++fixedTime :: UTCTime+fixedTime = read "2026-05-14 00:00:00 UTC"++sampleStarted :: TraceEvent+sampleStarted =+  CallStarted+    { eventId = "abc",+      timestamp = fixedTime,+      provider = "stub.trace",+      model = "stub-1",+      maxTokens = 16,+      promptSummary = "hello"+    }++sampleFinished :: TraceEvent+sampleFinished =+  CallFinished+    { eventId = "abc",+      timestamp = fixedTime,+      provider = "stub.trace",+      model = "stub-1",+      latencyMs = 12,+      inputTokens = Just 11,+      outputTokens = Just 7,+      cachedInputTokens = Just 5,+      cacheWriteTokens = Just 3,+      reasoningTokens = Just 4,+      totalTokens = Just 26,+      usd = Just 0+    }++sampleFailed :: TraceEvent+sampleFailed =+  CallFailed+    { eventId = "abc",+      timestamp = fixedTime,+      provider = "stub.trace",+      model = "stub-1",+      latencyMs = 12,+      errorMessage = "boom"+    }