baikai-openai 0.5.0.0 → 0.6.0.0
raw patch · 23 files changed
+5747/−1732 lines, 23 filesdep +networkdep +scientificdep +tlsdep ~baikaiPVP ok
version bump matches the API change (PVP)
Dependencies added: network, scientific, tls
Dependency ranges changed: baikai
API changes (from Hackage documentation)
- Baikai.Provider.OpenAI.Api: Assembler :: !Model -> !UTCTime -> !Maybe Int -> !Text -> !Bool -> !Maybe Int -> !Text -> !TagScanState -> !IntMap Int -> !Map Text Int -> !Maybe Int -> !IntMap (Text, Text) -> !IntMap Text -> !IntMap AssistantContent -> !Int -> !Usage -> !StopReason -> !Bool -> !Maybe BaikaiError -> !Maybe Text -> !Observed Text -> !Observed Text -> !Maybe Text -> !Maybe Int -> !Bool -> Assembler
- Baikai.Provider.OpenAI.Api: RawChunk :: !Maybe Text -> !Maybe Text -> !Maybe Text -> ![RawToolDelta] -> !Maybe RawUsage -> !Maybe Text -> !Maybe Text -> RawChunk
- Baikai.Provider.OpenAI.Api: RawToolDelta :: !Maybe Int -> !Maybe Text -> !Maybe Text -> !Maybe Text -> RawToolDelta
- Baikai.Provider.OpenAI.Api: RawUsage :: !Natural -> !Natural -> !Natural -> !Maybe Natural -> RawUsage
- Baikai.Provider.OpenAI.Api: TagScanState :: !TagMode -> !Text -> TagScanState
- Baikai.Provider.OpenAI.Api: [args] :: RawToolDelta -> !Maybe Text
- Baikai.Provider.OpenAI.Api: [cacheReadTokens] :: RawUsage -> !Natural
- Baikai.Provider.OpenAI.Api: [closed] :: Assembler -> !IntMap AssistantContent
- Baikai.Provider.OpenAI.Api: [contentDelta] :: RawChunk -> !Maybe Text
- Baikai.Provider.OpenAI.Api: [finishNote] :: Assembler -> !Maybe Text
- Baikai.Provider.OpenAI.Api: [finishReason] :: RawChunk -> !Maybe Text
- Baikai.Provider.OpenAI.Api: [finishSeen] :: Assembler -> !Bool
- Baikai.Provider.OpenAI.Api: [httpStatus] :: Assembler -> !Maybe Int
- Baikai.Provider.OpenAI.Api: [id_] :: RawToolDelta -> !Maybe Text
- Baikai.Provider.OpenAI.Api: [index] :: RawToolDelta -> !Maybe Int
- Baikai.Provider.OpenAI.Api: [inputTokens] :: RawUsage -> !Natural
- Baikai.Provider.OpenAI.Api: [lastToolIdx] :: Assembler -> !Maybe Int
- Baikai.Provider.OpenAI.Api: [model] :: Assembler -> !Model
- Baikai.Provider.OpenAI.Api: [name] :: RawToolDelta -> !Maybe Text
- Baikai.Provider.OpenAI.Api: [nextContentIndex] :: Assembler -> !Int
- Baikai.Provider.OpenAI.Api: [observedModel] :: Assembler -> !Observed Text
- Baikai.Provider.OpenAI.Api: [outputTokens] :: RawUsage -> !Natural
- Baikai.Provider.OpenAI.Api: [pendingError] :: Assembler -> !Maybe BaikaiError
- Baikai.Provider.OpenAI.Api: [providerRequestId] :: Assembler -> !Observed Text
- Baikai.Provider.OpenAI.Api: [reasoningAccum] :: Assembler -> !Text
- Baikai.Provider.OpenAI.Api: [reasoningDelta] :: RawChunk -> !Maybe Text
- Baikai.Provider.OpenAI.Api: [reasoningOpen] :: Assembler -> !Maybe Int
- Baikai.Provider.OpenAI.Api: [reasoningTokens] :: RawUsage -> !Maybe Natural
- Baikai.Provider.OpenAI.Api: [responseId] :: Assembler -> !Maybe Text
- Baikai.Provider.OpenAI.Api: [start] :: Assembler -> !UTCTime
- Baikai.Provider.OpenAI.Api: [stopReason] :: Assembler -> !StopReason
- Baikai.Provider.OpenAI.Api: [tagMode] :: TagScanState -> !TagMode
- Baikai.Provider.OpenAI.Api: [tagPending] :: TagScanState -> !Text
- Baikai.Provider.OpenAI.Api: [tagScanState] :: Assembler -> !TagScanState
- Baikai.Provider.OpenAI.Api: [textAccum] :: Assembler -> !Text
- Baikai.Provider.OpenAI.Api: [textEverOpened] :: Assembler -> !Bool
- Baikai.Provider.OpenAI.Api: [textOpen] :: Assembler -> !Maybe Int
- Baikai.Provider.OpenAI.Api: [toolArgs] :: Assembler -> !IntMap Text
- Baikai.Provider.OpenAI.Api: [toolDeltas] :: RawChunk -> ![RawToolDelta]
- Baikai.Provider.OpenAI.Api: [toolIdMap] :: Assembler -> !Map Text Int
- Baikai.Provider.OpenAI.Api: [toolIndexMap] :: Assembler -> !IntMap Int
- Baikai.Provider.OpenAI.Api: [toolMeta] :: Assembler -> !IntMap (Text, Text)
- Baikai.Provider.OpenAI.Api: [usageReported] :: Assembler -> !Bool
- Baikai.Provider.OpenAI.Api: [usage] :: Assembler -> !Usage
- Baikai.Provider.OpenAI.Api: _TagScanState :: TagScanState
- Baikai.Provider.OpenAI.Api: closeOpenStream :: UTCTime -> Maybe BaikaiError -> Assembler -> ([AssistantMessageEvent], Assembler)
- Baikai.Provider.OpenAI.Api: data Assembler
- Baikai.Provider.OpenAI.Api: data RawChunk
- Baikai.Provider.OpenAI.Api: data RawToolDelta
- Baikai.Provider.OpenAI.Api: data RawUsage
- Baikai.Provider.OpenAI.Api: data TagScanState
- Baikai.Provider.OpenAI.Api: emptyAssembler :: Model -> UTCTime -> Assembler
- Baikai.Provider.OpenAI.Api: instance GHC.Classes.Eq Baikai.Provider.OpenAI.Api.TagMode
- Baikai.Provider.OpenAI.Api: instance GHC.Classes.Eq Baikai.Provider.OpenAI.Api.TagScanState
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Api.Assembler
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Api.OpenAICall
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Api.ProducerState
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Api.RawChunk
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Api.RawToolDelta
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Api.RawUsage
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Api.TagMode
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Api.TagScanState
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Api.RawChunk
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Api.RawToolDelta
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Api.RawUsage
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Api.TagMode
- Baikai.Provider.OpenAI.Api: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Api.TagScanState
- Baikai.Provider.OpenAI.Api: openaiChatStreamWith :: SseDriver -> Model -> Context -> Options -> Stream IO AssistantMessageEvent
- Baikai.Provider.OpenAI.Api: openaiStrength :: Observed Text -> Observed Text -> EvidenceStrength
- Baikai.Provider.OpenAI.Api: parseChunk :: Value -> Either String RawChunk
- Baikai.Provider.OpenAI.Api: parseUsage :: Object -> Maybe RawUsage
- Baikai.Provider.OpenAI.Api: rawUsageToUsage :: RawUsage -> Usage
- Baikai.Provider.OpenAI.Api: registerWithRegistry :: ProviderRegistry -> IO ()
- Baikai.Provider.OpenAI.Api: scanThinkTags :: TagScanState -> Text -> (TagScanState, [Either Text Text])
- Baikai.Provider.OpenAI.Api: translate :: Either BaikaiError RawChunk -> Assembler -> UTCTime -> ([AssistantMessageEvent], Assembler)
- Baikai.Provider.OpenAI.Api: type SseDriver = ClientEnv -> RequestHeaders -> Value -> ResponseMetadata -> IO () -> Either BaikaiError Value -> IO () -> IO ()
- Baikai.Provider.OpenAI.Cli: registerWith :: CodexCliConfig -> IO ()
- Baikai.Provider.OpenAI.Cli: registerWithRegistry :: ProviderRegistry -> IO ()
- Baikai.Provider.OpenAI.Cli: registerWithRegistryAndConfig :: ProviderRegistry -> CodexCliConfig -> IO ()
- Baikai.Provider.OpenAI.Internal.ErrorClass: classifyErrorText :: Text -> Maybe BaikaiError
- Baikai.Provider.OpenAI.Internal.ErrorClass: responseToError :: ResponseF ByteString -> BaikaiError
+ Baikai.Provider.OpenAI.Internal.ErrorClass: classifyErrorFrame :: Value -> Maybe BaikaiError
+ Baikai.Provider.OpenAI.Internal.Stream: Assembler :: !Model -> !UTCTime -> !Maybe Int -> !Text -> !Bool -> !Maybe Int -> !Text -> !TagScanState -> !IntMap Int -> !Map Text Int -> !Maybe Int -> !IntMap (Text, Text) -> !IntMap Text -> !IntMap AssistantContent -> !Int -> !Usage -> !StopReason -> !Bool -> !Maybe BaikaiError -> !Maybe Text -> !Observed Text -> !Observed Text -> !Maybe Text -> !Maybe Int -> !Bool -> Assembler
+ Baikai.Provider.OpenAI.Internal.Stream: RawChunk :: !Maybe Text -> !Maybe Text -> !Maybe Text -> ![RawToolDelta] -> !Maybe RawUsage -> !Maybe Text -> !Maybe Text -> RawChunk
+ Baikai.Provider.OpenAI.Internal.Stream: RawToolDelta :: !Maybe Int -> !Maybe Text -> !Maybe Text -> !Maybe Text -> RawToolDelta
+ Baikai.Provider.OpenAI.Internal.Stream: RawUsage :: !Natural -> !Natural -> !Natural -> !Maybe Natural -> RawUsage
+ Baikai.Provider.OpenAI.Internal.Stream: TagScanState :: !TagMode -> !Text -> TagScanState
+ Baikai.Provider.OpenAI.Internal.Stream: [args] :: RawToolDelta -> !Maybe Text
+ Baikai.Provider.OpenAI.Internal.Stream: [cacheReadTokens] :: RawUsage -> !Natural
+ Baikai.Provider.OpenAI.Internal.Stream: [closed] :: Assembler -> !IntMap AssistantContent
+ Baikai.Provider.OpenAI.Internal.Stream: [contentDelta] :: RawChunk -> !Maybe Text
+ Baikai.Provider.OpenAI.Internal.Stream: [finishNote] :: Assembler -> !Maybe Text
+ Baikai.Provider.OpenAI.Internal.Stream: [finishReason] :: RawChunk -> !Maybe Text
+ Baikai.Provider.OpenAI.Internal.Stream: [finishSeen] :: Assembler -> !Bool
+ Baikai.Provider.OpenAI.Internal.Stream: [httpStatus] :: Assembler -> !Maybe Int
+ Baikai.Provider.OpenAI.Internal.Stream: [id_] :: RawToolDelta -> !Maybe Text
+ Baikai.Provider.OpenAI.Internal.Stream: [index] :: RawToolDelta -> !Maybe Int
+ Baikai.Provider.OpenAI.Internal.Stream: [inputTokens] :: RawUsage -> !Natural
+ Baikai.Provider.OpenAI.Internal.Stream: [lastToolIdx] :: Assembler -> !Maybe Int
+ Baikai.Provider.OpenAI.Internal.Stream: [model] :: Assembler -> !Model
+ Baikai.Provider.OpenAI.Internal.Stream: [name] :: RawToolDelta -> !Maybe Text
+ Baikai.Provider.OpenAI.Internal.Stream: [nextContentIndex] :: Assembler -> !Int
+ Baikai.Provider.OpenAI.Internal.Stream: [observedModel] :: Assembler -> !Observed Text
+ Baikai.Provider.OpenAI.Internal.Stream: [outputTokens] :: RawUsage -> !Natural
+ Baikai.Provider.OpenAI.Internal.Stream: [pendingError] :: Assembler -> !Maybe BaikaiError
+ Baikai.Provider.OpenAI.Internal.Stream: [providerRequestId] :: Assembler -> !Observed Text
+ Baikai.Provider.OpenAI.Internal.Stream: [reasoningAccum] :: Assembler -> !Text
+ Baikai.Provider.OpenAI.Internal.Stream: [reasoningDelta] :: RawChunk -> !Maybe Text
+ Baikai.Provider.OpenAI.Internal.Stream: [reasoningOpen] :: Assembler -> !Maybe Int
+ Baikai.Provider.OpenAI.Internal.Stream: [reasoningTokens] :: RawUsage -> !Maybe Natural
+ Baikai.Provider.OpenAI.Internal.Stream: [responseId] :: Assembler -> !Maybe Text
+ Baikai.Provider.OpenAI.Internal.Stream: [start] :: Assembler -> !UTCTime
+ Baikai.Provider.OpenAI.Internal.Stream: [stopReason] :: Assembler -> !StopReason
+ Baikai.Provider.OpenAI.Internal.Stream: [tagMode] :: TagScanState -> !TagMode
+ Baikai.Provider.OpenAI.Internal.Stream: [tagPending] :: TagScanState -> !Text
+ Baikai.Provider.OpenAI.Internal.Stream: [tagScanState] :: Assembler -> !TagScanState
+ Baikai.Provider.OpenAI.Internal.Stream: [textAccum] :: Assembler -> !Text
+ Baikai.Provider.OpenAI.Internal.Stream: [textEverOpened] :: Assembler -> !Bool
+ Baikai.Provider.OpenAI.Internal.Stream: [textOpen] :: Assembler -> !Maybe Int
+ Baikai.Provider.OpenAI.Internal.Stream: [toolArgs] :: Assembler -> !IntMap Text
+ Baikai.Provider.OpenAI.Internal.Stream: [toolDeltas] :: RawChunk -> ![RawToolDelta]
+ Baikai.Provider.OpenAI.Internal.Stream: [toolIdMap] :: Assembler -> !Map Text Int
+ Baikai.Provider.OpenAI.Internal.Stream: [toolIndexMap] :: Assembler -> !IntMap Int
+ Baikai.Provider.OpenAI.Internal.Stream: [toolMeta] :: Assembler -> !IntMap (Text, Text)
+ Baikai.Provider.OpenAI.Internal.Stream: [usageReported] :: Assembler -> !Bool
+ Baikai.Provider.OpenAI.Internal.Stream: [usage] :: Assembler -> !Usage
+ Baikai.Provider.OpenAI.Internal.Stream: closeOpenStream :: UTCTime -> Maybe BaikaiError -> Assembler -> ([AssistantMessageEvent], Assembler)
+ Baikai.Provider.OpenAI.Internal.Stream: data Assembler
+ Baikai.Provider.OpenAI.Internal.Stream: data RawChunk
+ Baikai.Provider.OpenAI.Internal.Stream: data RawToolDelta
+ Baikai.Provider.OpenAI.Internal.Stream: data RawUsage
+ Baikai.Provider.OpenAI.Internal.Stream: data TagScanState
+ Baikai.Provider.OpenAI.Internal.Stream: emptyAssembler :: Model -> UTCTime -> Assembler
+ Baikai.Provider.OpenAI.Internal.Stream: emptyTagScanState :: TagScanState
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Classes.Eq Baikai.Provider.OpenAI.Internal.Stream.TagMode
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Classes.Eq Baikai.Provider.OpenAI.Internal.Stream.TagScanState
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Internal.Stream.Assembler
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Internal.Stream.OpenAICall
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Internal.Stream.ProducerState
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Internal.Stream.RawChunk
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Internal.Stream.RawToolDelta
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Internal.Stream.RawUsage
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Internal.Stream.TagMode
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Generics.Generic Baikai.Provider.OpenAI.Internal.Stream.TagScanState
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Internal.Stream.RawChunk
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Internal.Stream.RawToolDelta
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Internal.Stream.RawUsage
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Internal.Stream.TagMode
+ Baikai.Provider.OpenAI.Internal.Stream: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Internal.Stream.TagScanState
+ Baikai.Provider.OpenAI.Internal.Stream: liveSseDriver :: SseDriver
+ Baikai.Provider.OpenAI.Internal.Stream: openaiChatStreamWith :: SseDriver -> Model -> Context -> Options -> Stream IO AssistantMessageEvent
+ Baikai.Provider.OpenAI.Internal.Stream: parseChunk :: Value -> Either String RawChunk
+ Baikai.Provider.OpenAI.Internal.Stream: parseFrame :: Value -> Either String (Either BaikaiError RawChunk)
+ Baikai.Provider.OpenAI.Internal.Stream: parseUsage :: Object -> Maybe RawUsage
+ Baikai.Provider.OpenAI.Internal.Stream: rawUsageToUsage :: RawUsage -> Usage
+ Baikai.Provider.OpenAI.Internal.Stream: scanThinkTags :: TagScanState -> Text -> (TagScanState, [Either Text Text])
+ Baikai.Provider.OpenAI.Internal.Stream: translate :: Either BaikaiError RawChunk -> Assembler -> UTCTime -> ([AssistantMessageEvent], Assembler)
+ Baikai.Provider.OpenAI.Internal.Stream: type SseDriver = ClientEnv -> RequestHeaders -> Value -> ResponseMetadata -> IO () -> Either BaikaiError Value -> IO () -> IO ()
+ Baikai.Provider.OpenAI.Sse: buildRequest :: BaseUrl -> RequestHeaders -> Value -> Request
- Baikai.Provider.OpenAI.Shape: describeThinkingShape :: OpenAICompletionsCompat -> Options -> ThinkingTranslation
+ Baikai.Provider.OpenAI.Shape: describeThinkingShape :: OpenAICompletionsCompat -> Bool -> Options -> ThinkingTranslation
- Baikai.Provider.OpenAI.Shape: injectThinkingShape :: OpenAICompletionsCompat -> Options -> Value -> (Value, ThinkingTranslation)
+ Baikai.Provider.OpenAI.Shape: injectThinkingShape :: OpenAICompletionsCompat -> Bool -> Options -> Value -> (Value, ThinkingTranslation)
- Baikai.Provider.OpenAI.Shape: shapeRequestBody :: OpenAICompletionsCompat -> Options -> Value -> (Value, ThinkingTranslation)
+ Baikai.Provider.OpenAI.Shape: shapeRequestBody :: OpenAICompletionsCompat -> Bool -> Options -> Value -> (Value, ThinkingTranslation)
- Baikai.Provider.OpenAI.Shape: streamRequestBody :: OpenAICompletionsCompat -> Options -> CreateChatCompletion -> (Value, ThinkingTranslation)
+ Baikai.Provider.OpenAI.Shape: streamRequestBody :: OpenAICompletionsCompat -> Bool -> Options -> CreateChatCompletion -> (Value, ThinkingTranslation)
Files
- CHANGELOG.md +2287/−0
- baikai-openai.cabal +26/−14
- src/Baikai/Provider/OpenAI/Agent.hs +25/−6
- src/Baikai/Provider/OpenAI/Api.hs +89/−1326
- src/Baikai/Provider/OpenAI/Cli.hs +17/−42
- src/Baikai/Provider/OpenAI/Interactive.hs +42/−3
- src/Baikai/Provider/OpenAI/Internal/ErrorClass.hs +128/−109
- src/Baikai/Provider/OpenAI/Internal/Request.hs +36/−16
- src/Baikai/Provider/OpenAI/Internal/Stream.hs +1350/−0
- src/Baikai/Provider/OpenAI/Shape.hs +54/−11
- src/Baikai/Provider/OpenAI/Sse.hs +70/−28
- src/Baikai/Provider/OpenAI/Transport.hs +39/−41
- test/Contract.hs +45/−0
- test/ErrorClassSpec.hs +105/−56
- test/EvidenceSpec.hs +133/−8
- test/LifecycleSpec.hs +204/−0
- test/Main.hs +116/−24
- test/MidStreamSpec.hs +311/−0
- test/PublicSurfaceSpec.hs +43/−0
- test/ReasoningSpec.hs +112/−22
- test/ShapeSpec.hs +73/−11
- test/SseSpec.hs +350/−12
- test/TransportSpec.hs +92/−3
+ CHANGELOG.md view
@@ -0,0 +1,2287 @@+# Changelog++All notable changes to baikai are recorded here.++The format follows [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and+this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).++## [Unreleased]++## [baikai 0.6.0.0] - 2026-08-28++### Added++- `baikai`: `Baikai.ThinkingLevel.parseThinkingLevel :: Text -> Maybe+ ThinkingLevel` and `Baikai.Evidence.parseEvidenceStrength :: Text -> Maybe+ EvidenceStrength`, each beside its renderer. Three hand-copied tables — the+ evidence schema's level parser, `baikai-agent`'s KDL `effort` decoder, and its+ `--require-evidence` parser — now read them instead, so a level or strength+ added later cannot be added in one place and missed in three. (REV-2 G.6.)++- `baikai`: `Baikai.Agent.AgentRunResult` exports its selectors (`provider`,+ `exitCode`, `stdout`, `stderr`, `duration`). It exported neither them nor its+ constructor, so a consumer without generic-lens could not read a run's exit+ code at all. (REV-2 G.6.)++- `baikai`: `Baikai.Api.normaliseApi :: Api -> Api`, which collapses a `Custom`+ tag that spells a built-in API onto that constructor. The registry applies it+ to the key it stores and to the tag it is asked for, so a handler registered+ under `Custom "anthropic-messages"` answers a model tagged `AnthropicMessages`+ and the reverse; the two used to be separate entries and dispatch depended on+ which spelling the model happened to carry. Derived `Eq`/`Ord` on `Api` are+ deliberately unchanged: altering them would silently rearrange every+ `Map Api` a consumer holds. (REV-2 G.4.)++- `baikai`: `Baikai.Header`, a new module exporting `HeaderName` with+ `headerName` and `renderHeaderName`. See the `headers` retype under Changed.++- `baikai`: `Baikai.Error.ErrorCategory` gains `ContentFiltered` (wire tag+ `content_filtered`, never retryable) with the smart constructor+ `contentFiltered`. OpenAI's `finish_reason: "content_filter"` and Anthropic's+ `refusal` stop now carry it. Both used to be `OtherError`, so the only way to+ tell a filtered response from any other non-retryable failure was to match on+ the message text. __Breaking__ for a consumer whose `case` over+ `ErrorCategory` is exhaustive without a wildcard. (REV-1 1.7 residual.)++- `baikai` (breaking to construct, not to read): every record that can still+ grow a field is now built from an exported base value and refined by record+ update, and its constructor is no longer exported —+ `Baikai.Provider.Registry.ApiProvider` (`apiProvider` /`apiProviderWith`),+ `Baikai.Evidence.ModelCallEvidence` (`baseEvidence`),+ `Baikai.Evidence.EvidenceRequest` (`evidenceRequest`), `Baikai.Tool.Tool`+ (`mkTool`, with `emptyTool` kept for fixtures),+ `Baikai.Embedding.EmbeddingModel` (`emptyEmbeddingModel`),+ `Baikai.Cost.Log.CallLogConfig` (`callLogConfig`),+ `baikai-trace-otel`'s `OtelSinkOptions` (`defaultOtelSinkOptions`), and+ `baikai-agent`'s `AgentCliOptions` (`agentCliOptions`), `AgentCliRun`+ (`agentCliRun`), `AgentJob` (`agentJob`) and `AgentConfigPaths`+ (`emptyAgentConfigPaths`). Selectors, record update, `OverloadedRecordDot`+ reads and generic-lens labels all keep working; only construction from the+ constructor stops. Adding `describeThinking` to `ApiProvider` in 0.5.0.0 broke+ every third-party registration site, and `strengthCeiling` would have broken+ them again; from this release such an addition is a minor bump. (REV-2 G.1.)++- `baikai`: `Baikai.Provider.apiProvider`, which builds an `ApiProvider` from an+ `Api` tag and a streaming producer, deriving `complete` with+ `streamingComplete`; and `Baikai.Provider.Registry.apiProviderWith`, which+ takes the completer explicitly. Both default `describeThinking` to+ "nothing requested, nothing translated" and `strengthCeiling` to+ `EvidenceRequestedOnly`, matching `declaredStrength (Custom _)`.++- `baikai`: `Baikai.Tool.mkTool` — a tool from its name, description and JSON+ Schema. A tool built from `emptyTool` and sent unchanged reaches the wire with+ `input_schema: null`; `mkTool` has no such shape.++- `baikai`: `Baikai.Agent.AgentOutputFormat` (`TextFormat`, `JsonFormat`) with+ `renderAgentOutputFormat` and `parseAgentOutputFormat`, and+ `AgentRunRequest.outputFormat`, defaulting to `TextFormat`. `baikai-claude`+ renders `--output-format json` and `baikai-openai` renders `--json`, both+ right after the effort flags; `baikai-agent` reads it from+ `jobs.<name>.output-format`. This is the one setting an evidence record needs+ in order to observe a run's session, model and usage, and asking for it used+ to require the `provider-args` channel that an operator ceiling closes by+ default — an operator should not have to open a privileged channel to get a+ record. (REV-2 F.14.)++- `baikai`: `Baikai.Agent.AgentCeiling` gains three fields and the module gains+ the vocabulary they need. `allowedTools :: [Text]` names tool grants the+ operator permits beyond the ones `toolGrantsImpliedBy` (also new) says a+ capability implies on its own; `maxTimeout :: Maybe NominalDiffTime` and+ `maxOutputLimit :: Maybe Int` bound what any job may request, the second+ defaulting to the new `defaultMaxOutputLimit` (67108864, sixty-four+ mebibytes). `Baikai.Agent.ceilingViolations` is `applyAgentCeiling`'s violation+ list on its own, so a caller can concatenate it with violations of its own.+ (REV-2 F.3.)++- `baikai`: `Baikai.Content.toolArgumentsFromText` and+ `Baikai.Content.isCutOffToolCall`. The first is the single rule that turns a+ tool call's accumulated argument text into its `arguments` value — empty text+ is an empty object, non-empty text that does not decode is kept verbatim as a+ `String` — and both provider assemblers and core's stream-recovery path now+ use it, so the second means the same thing at every layer.++- `baikai`: new exposed module `Baikai.Provider.Internal.StreamWorker` — the+ bounded hand-off both HTTP providers now use between their SSE worker thread+ and the consumer draining the stream. `FrameQueue` is a 64-slot `TBQueue` plus+ a closed flag; `forkFrameWorker` closes the queue however the body ends, and+ `withFrameWorker` runs the consumer under `Stream.bracketIO` so the worker is+ killed when the stream stops. The module is exposed like+ `Baikai.Provider.Cli.Internal`, outside the PVP promise. See+ [docs/adr/0010](docs/adr/0010-a-stream-consumer-that-stops-owns-cancelling-the-producer.md).++- `baikai`: every Anthropic model in the generated catalog now carries an+ explicit `CompatAnthropicMessages` record stating the two request-shaping+ facts of its generation: `AnthropicMessagesCompat.thinkingStyle` (which+ extended-thinking wire shape it accepts) and the new+ `AnthropicMessagesCompat.supportsSamplingParameters` (whether it accepts+ `temperature`, `top_p` and `top_k`). Both are sourced from+ `baikai/data/models/anthropic.json`, which the fetcher writes from its+ curated `anthropicInclude` table, and `baikai-gen-models` now refuses an+ `anthropic-messages` entry that reaches it without a `compat` block rather+ than falling back to host auto-detection, which cannot know a generation.+ This is what fixes `claude-sonnet-5`, whose thinking requests were shaped by+ a prefix table that did not know the id. See+ [docs/adr/0009](docs/adr/0009-provider-capability-facts-live-in-the-generated-catalog-record.md).++- `baikai`: two new `Baikai.Evidence.ThinkingAdjustment` constructors,+ `SamplingDroppedUnsupportedModel` and `SamplingDroppedUnsupportedApi`, encoding as+ `{"kind":"sampling_dropped_unsupported_model","fields":["temperature","top_p"]}` and+ `{"kind":"sampling_dropped_unsupported_api","fields":["seed"]}`. They record sampling+ parameters removed because the model generation rejects them, or because the API has no+ such field on any generation. Both carry a `fields` array and no `requested` level, so+ they can appear on a call whose thinking mode is `absent`.++- `baikai`: `Baikai.Evidence.weakensThinking`, which says whether an adjustment weakens the+ thinking the caller asked for. Strict evidence mode filters through it, so a dropped+ sampling parameter is recorded without refusing the call — the documented contract is+ refusing a call that would weaken the requested *thinking level*.++- `baikai`: new exposed module `Baikai.Url` — the one place baikai turns a URL+ into a host name. `parseUrl` yields a `UrlParts` record with the scheme, host,+ port and path, plus flags saying whether userinfo, a query string or a+ fragment were present; it never holds their text, so the value cannot carry a+ secret into a log line. Alongside it: `urlHost`, `hostMatchesSuffix` (moved+ from `Baikai.Compat`, which now re-exports both), `renderEndpoint`,+ `stripApiVersion`, and `baseUrlProblem`, which says why a URL is unusable as a+ `Model.baseUrl` and what to do instead. See+ [docs/adr/0008](docs/adr/0008-one-url-host-parser-and-every-consumer-uses-it.md).++- `baikai`: new exposed module `Baikai.Provider.Transport.Classify` — the one+ rule every HTTP provider uses to classify a transport failure, exporting+ `classifyTransportException` plus the per-type functions it composes. The rule+ is *where* the failure happened, not what type it is: anything that breaks or+ ends the connection after the request went out is `TransientError`, anything+ that says the request or the configuration is wrong is not retryable, and a+ programming error stays `OtherError`. It understands all three shapes+ `http-client` can deliver — an `HttpException` of any constructor, a raw socket+ `IOException`, and a raw or wrapped `TLSException` — because the manager wraps+ the connect phase but not the body reader. Core gains direct `build-depends` on+ `http-types` and `tls`, both already in its install plan. Written for+ third-party `Custom` providers built on `http-client` as much as for baikai's+ own two. See+ [docs/adr/0011](docs/adr/0011-core-owns-transport-failure-classification.md).++- `baikai`: `Baikai.Error.parseHttpDate` and `Baikai.Error.retryAfterSecondsAt`.+ The first parses an HTTP-date in the IMF-fixdate form servers must send plus+ the two obsolete forms a recipient must accept; the second converts a+ `Retry-After` header in either of its forms to seconds against a reference+ instant, clamping a date already in the past to `0`.+ `parseRetryAfterSeconds` keeps its integer-only contract, now a deliberate+ division of labour rather than a limitation.++- `baikai`: new exposed module `Baikai.Http` — `canonicalBaseUrl`,+ `getClientEnvCached` and `cachedClientEnvCount`, the process-global+ `ClientEnv` cache that both HTTP provider packages now share instead of each+ keeping its own. Core gains direct `build-depends` on `servant-client`,+ `http-client` and `http-client-tls`, which were already in its install plan+ through the `openai` SDK.++- `baikai`: `Baikai.Evidence.ThinkingModeNotTranslated`, encoded as+ `"not_translated"`, and `Baikai.Evidence.untranslatedThinking`; and+ `Baikai.Evidence.Build.requestedTranslation`. A path where no adapter ran to+ translate the caller's level now records the level and says the translation is+ unknown, instead of saying nothing was asked. (REV-2 D.2.)++- `baikai`: `Baikai.Evidence.Build.missingEvidenceError`,+ `Baikai.Evidence.Build.strictnessOf` (moved here from `Baikai.Trace`, where it+ was private), `Baikai.Stream.requireEvidenceOnTerminal` and+ `Baikai.Provider.Registry.requireEvidenceOnResponse`. (REV-2 D.3.)++- `baikai`: `Baikai.Evidence.usageEnvelope`, and+ `Baikai.Evidence.Build.endpointIdentityAt`, `prepareEvidenceAt` and+ `minimalEvidenceAt`, which take the base URL the adapter actually resolved.+ The three unsuffixed functions remain and pass the model's own field.+ (REV-2 D.8, D.11.)++- `baikai`: `Baikai.Evidence.deriveStrength`, the single rule that turns an+ observed model, a provider request id and a response id into an+ `EvidenceStrength`. (REV-2 D.10.)++### Changed++- `baikai`: catalog refresh. `claude-opus-5` joins the curated Anthropic include+ set (adaptive thinking, sampling parameters rejected — the facts+ `docs/plans/60-make-anthropic-thinking-style-and-sampling-support-catalog-driven.md`+ said whoever curated it in would have to state), and the `gpt-5.6` family+ picks up its price cut: `gpt-5.6` and `gpt-5.6-sol` to $4.00/$20.00,+ `gpt-5.6-terra` to $2.00/$12.00, `gpt-5.6-luna` to $0.20/$1.20 per Mtok, cache+ rates in step. `Baikai.Models.Generated` gains `anthropic_claude_opus_5` and+ now carries 36 enabled models. No OpenAI id was added: the `gpt-5.6` family is+ still the newest one models.dev reports that speaks+ `openai-chat-completions`.++- `baikai` (breaking): `ResponseFormat`'s `JsonSchema` carries a+ `JsonSchemaFormat` record — `name`, `schema`, `strict`, exported+ selector-only with the base `jsonSchemaFormat name schema` — instead of+ holding the three fields directly. As fields of a sum they were partial+ selectors: `name f` on a `JsonObject` crashed at runtime rather than failing to+ typecheck, which contradicted the module's own documentation.+ `-Wno-partial-fields` is dropped from the module. The JSON encoding is+ deliberately unchanged (`{"tag":"JsonSchema","name":…,"schema":…,"strict":…}`)+ and is now pinned by a test, because `Options` derives `ToJSON` through it and+ at least one consumer keys a cache on the result. (REV-2 G.2.)++- `baikai`: `Baikai.Context.appendToolResult` returns its input context+ unchanged, and runs no dispatcher, when the response is error-shaped. A failed+ call has no assistant turn worth replaying and no tool calls to answer;+ appending its empty message put a turn into the transcript the model never+ took. `runToolLoop` has always stopped on such a response — the documented+ direct round trip in `docs/user/tools.md` reaches `appendToolResult` instead,+ and now behaves the same way. Its Haddock also stops claiming multi-call+ concurrency lives in the dispatcher: the calls are traversed in order.+ (REV-2 G.7.)++- Release metadata (REV-2 G.8): every publishable package now declares+ `tested-with: GHC ==9.12.4` and ships its `CHANGELOG.md` (a symlink to the+ root one, as `baikai` already did) via `extra-doc-files`, so Hackage shows a+ changelog and a tested compiler for all seven. `baikai-claude` and+ `baikai-openai` describe what they actually contain — four surfaces each, not+ "wraps package X" — and `baikai-trace-otel`'s `streamly-core` bound is+ `>=0.3 && <0.5`, matching every other package in the workspace rather than+ excluding the 0.4 series the others accept.++- `baikai` (breaking): `Options.headers` and `Model.headers` are keyed on+ `Baikai.Header.HeaderName` — a newtype over a case-insensitive `CI Text` that+ keeps the original spelling — instead of `Text`. A header name is+ case-insensitive on the wire, so a `Map Text Text` holding both+ `Authorization` and `authorization` sent whichever the assembling fold reached+ last; the map now holds one entry per header and the last write wins, as a+ caller writing two spellings would expect. `HeaderName` has an `IsString`+ instance, so `Map.singleton "x-test" "1"` and `#headers` updates keep+ compiling; the spelling given is what goes out on the wire and into JSON.+ (REV-2 G.5.)++- `baikai` (breaking): `Options.stopSequences` is `[Text]`, where empty means+ "send nothing", instead of `Maybe (Vector Text)` — `Nothing` and `Just []`+ were indistinguishable on the wire and only one of them could be right. Plan+ 43's rule is lists for caller-side configuration and `Vector` for+ provider-bound sequences; this was the one field breaking it. `Options.seed`+ is `Maybe Int` rather than `Maybe Integer`: a seed is a machine integer at+ every provider that accepts one, and it now sits beside+ `timeoutMs :: Maybe Int`. (REV-2 G.5, R14.)++- `baikai` (breaking): `StopReason.Aborted` is removed. Nothing produced it —+ timeouts are `ErrorReason`/`TransientError`, and a consumer abort is recorded+ as evidence `CallAborted` — while `responseError`, `eventsFor` and+ `runToolLoop` all treated it as a *success*, so a value that reached any of+ them would have been silently mishandled. Since 0.6.0.0 a stream consumer that+ stops cancels the producer, so no consumer is left to receive such a terminal+ either. (REV-2 B.6.)++- `baikai`: dispatching a model whose `api` is still `emptyModel`'s+ `Custom ""` says so — `No provider registered for API: <blank Custom tag —+ emptyModel.api was never set>` — where the message used to end after the+ colon. `emptyModel`'s Haddock says the same thing. (REV-2 G.4.)++- `baikai`: `withTrace` and `withTraceStream` wait at most one second for the+ trace sink after writing the shutdown sentinel. On expiry the worker is+ abandoned — not killed, which would abort the sink's fold mid-step and lose+ its end-of-stream action — the call proceeds, and one stderr line reports+ `the trace sink did not confirm delivery within 1000 ms; its worker was+ abandoned, and events already queued may still be delivered later`. A sink+ that blocked forever used to hold the call forever and swallow the first+ attempt to cancel it. A caller under `EvidenceRequired` whose sink did not+ confirm delivery gets a failed call, through the same path a throwing sink+ takes; `Baikai.Evidence.Build.sinkFailureError` now says "its record was not+ confirmed written" rather than "not written", which is the honest claim for+ an abandoned worker whose events are still queued. The synthetic terminal a+ consumer's abort produces is delivered from a garbage-collection hook and is+ not guaranteed before process exit; that was always true and is now stated in+ `docs/user/model-call-evidence.md`, `docs/capabilities/call-tracing.md` and+ the `Baikai.Trace` module documentation, with the pattern for callers who need+ the record. See+ [docs/adr/0015](docs/adr/0015-trace-cleanup-is-bounded-and-abort-cleanup-is-gc-eventual.md).+ (REV-2 D.5, Theme 7.3.)++- `baikai`: `Baikai.Trace.Sink.multiSink` runs each member on its own drain+ thread behind its own unbounded channel, instead of folding `Fold.tee` across+ the list. `Fold.tee` runs one member then the other and lets either's+ exception escape, so a single throwing member stopped delivery to every+ sibling for the rest of the call and skipped their end-of-stream actions — an+ OpenTelemetry span paired with an unwritable file sink was opened and never+ ended, and nothing was exported. The step never blocks; the final action sends+ every member the sentinel, waits for every member, and reports one aggregate+ failure naming each failed member by zero-based index+ (`1 of 2 member sinks failed: member 0: …`). (REV-2 D.6.)++- `baikai`: `AgentSafety.allowedTools` is documented as the __grant__ it is.+ On Claude Code it renders `--allowedTools`, whose help reads "list of tool+ names to allow": it pre-approves tools the permission mode would otherwise+ raise a request for, and in an unattended run a request nobody answers is+ denied. The old Haddock called it "optional narrowing of the provider's tool+ set", which was the opposite, and `applyAgentCeiling` never looked at it. It+ is now bounded: a grant passes when the maximum capability implies it+ (`read-only` implies `Read`, `Glob`, `Grep`, `NotebookRead`, `TodoWrite`;+ `edit-workspace` adds `Edit`, `MultiEdit`, `Write`, `NotebookEdit`;+ `full-access` implies every grant) or when the operator named it in+ `policy.allowed-tools`. Matching is exact, so `Bash(git *)` is not `Bash`.+ A repository job that grants itself `Bash` under `edit-workspace` — which+ passed unexamined before — is now refused with exit 77 before any process is+ created. (REV-2 F.3.)++- `baikai` (breaking): `Baikai.Agent.CeilingViolation` gains five constructors:+ `ToolGrantForbidden`, `TimeoutExceeded`, `OutputLimitExceeded`,+ `RepositoryScopeForbidden` and `WorkingDirOutsideRepository`. A `case` over+ the type that was exhaustive is no longer.++- `baikai` (behaviour): the default ceiling has a finite `maxOutputLimit`, so+ `applyAgentCeiling defaultAgentCeiling` now refuses a request whose+ `outputLimit` is `Nothing` — capture without bound is exactly what the+ maximum exists to refuse. Jobs resolved through `baikai-agent` are unaffected:+ that layer's own default supplies a finite limit, and only an explicit+ `output-limit "unlimited"` reaches the ceiling as `Nothing`.++- `baikai`: a tool call cut off by the output cap is no longer executed.+ `runToolLoop` stops with the response and its tool calls intact when any call+ is cut off, and `appendToolResult` appends a `ToolResultMessage` with+ `isError = True` explaining why instead of calling the dispatcher. Previously+ both assemblers replaced truncated arguments with `{}` and a tool loop+ happily ran the call with no arguments at all. (REV-2 B.2.)++- `baikai`: `Baikai.Model.anthropicMessagesCompatFor` no longer overlays a+ thinking style guessed from the model id onto a model whose `compat` is+ `CompatNone`. `CompatNone` now means host auto-detection alone — the budget+ thinking shape, sampling parameters supported. Every catalog model carries an+ explicit record, so this changes nothing for them; a **hand-rolled** model+ naming an adaptive-era id (`claude-sonnet-5`, `claude-opus-4-7`,+ `claude-opus-4-8`, `claude-fable-5`) must now carry+ `CompatAnthropicMessages (defaultAnthropicMessagesCompat {thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False})`+ or start from the catalog value.++- `baikai`: `Baikai.Evidence.evidenceSchemaVersion` is now+ `baikai.model-call-evidence/1.1`. A minor bump: the two sampling adjustment kinds are a+ compatible addition, and no previously recorded digest changes.++- `baikai`: HTTP 413 classifies as `ContextOverflow` rather than `OtherError`,+ from the status alone and whatever the body says. 413 *is* the size-limit+ status and the caller's remedy — shrink the input — is the same either way;+ making the category depend on body wording would recreate for 413 the+ inconsistency this release fixes for connection resets. (REV-2 A.7.)++- `baikai`, `baikai-claude`, `baikai-openai`: an HTTP-date `Retry-After` is+ converted to seconds instead of ignored. Both transports use the response's own+ `Date` header as the reference instant, falling back to the local clock, so a+ CDN-fronted `429` — the common case for a date-valued `Retry-After` — now+ carries a hint rather than leaving the caller to guess. (REV-2 A.9.)++- `baikai`: **breaking.** `Baikai.Embedding.EmbeddingModel.apiKey` is now+ `Maybe ApiKeySource` rather than `ApiKeySource`. `Nothing` means the+ conventional environment variable for the model's host, from+ `defaultApiKeyEnvForBaseUrl` — the same table the chat providers use — and a+ host that table does not know refuses with an `AuthError` naming+ `EmbeddingModel.apiKey`. Migration: `apiKey = source` becomes+ `apiKey = Just source`. `EmbeddingModel` also derives `Eq` and `Generic`, so+ the `#field .~ value` idiom works on it as it does on every other record.+ (REV-2 E.3.)++- `baikai`: **breaking.** `AgentRunFailure`'s `RunTimedOut` constructor now+ carries a new record `AgentTimedOut` — the configured `limit` plus the+ `stdout` and `stderr` a timed-out run drained before its process group was+ killed — instead of a bare `NominalDiffTime`. A caller matching+ `RunTimedOut limit` becomes `RunTimedOut timedOut` and reads `timedOut ^.+ #limit`; `renderAgentRunFailure` is unchanged in what it says. The bytes were+ always there, drained from the moment the child was spawned, and were simply+ dropped on the timeout path — which is the run an operator most wants an+ account of, because the tool started, may have consumed tokens, and may+ already have changed the working tree.++- `baikai`: under `EvidenceRequired`, a successful terminal that carries no+ evidence record fails the call with `missingEvidenceError` rather than+ returning a silent success with zero `call_evidence` lines. Strict mode+ guaranteed that a record which was built and then lost fails the call; it did+ not guarantee that one was built. The rule is applied at both dispatch points,+ so `completeRequest` with no sink gets the same guarantee as a streaming call;+ a failed call keeps the provider's own error, and best effort is unchanged.+ See `docs/adr/0014-strict-evidence-means-a-record-exists.md`. (REV-2 D.3.)++- `baikai`: a caller's thinking level is recorded on every evidence path — the+ consumer abort, an unregistered provider, a `complete` handler that threw, and+ each provider's `immediateError`. The abort path asks the registered adapter's+ own `describeThinking`; the others record `not_translated`. All four used to+ record the caller's request as `absent`, which+ `docs/adr/0002-requested-translated-observed-are-never-collapsed.md` forbids.+ (REV-2 D.2.)++- **`baikai.model-call-evidence/2.0`.** Two digests cover different bytes, so a+ verifier must now select its rules by `schema_version`. `response_commitment`+ covers the provider-reported token counts and never baikai's computed cost:+ the cost comes from the caller's catalog rates rather than from the response,+ so the digest used to change whenever a price was edited and a verifier+ holding only the response could not recompute it. `request_configuration`+ summarises `output_config` and `response_format` as it already summarised+ `tools`, because a structured-output JSON schema carries author-written+ `description` strings and is content wherever it appears — the same schema was+ stripped from `tools[].input_schema` and survived verbatim through the other+ two keys. `thinking.mode` may also now be `"not_translated"`, which is a+ compatible addition. (REV-2 D.7, D.11.)++- **Breaking.** `baikai`: `Baikai.Provider.Registry.ApiProvider` gains a fifth+ field, `strengthCeiling :: EvidenceStrength`, and+ `Baikai.Evidence.Build.checkEvidenceRequirements` takes that ceiling where it+ took an `Api`. The gate compared against `declaredStrength`, a table keyed by+ the API tag, which necessarily answered `EvidenceRequestedOnly` for every+ `Custom` transport — so a gateway that genuinely observes a model could never+ satisfy a strict caller who required that it did. Only a provider knows what+ its evidence reaches. `EvidenceRequestedOnly` reproduces the old behaviour for+ any custom provider; the four built-in providers fill the field from+ `declaredStrength`, which is unchanged in value and still used by the+ unattended-agent surface. (REV-2 D.10, G.1.)++- `baikai`, `baikai-claude`, `baikai-openai`: one strength derivation replaces+ three. An observed **response id** now counts as correlation alongside a+ captured request-id header, so a host that names its model and its response id+ on every chunk but sends no header reaches `model_observed` instead of+ `requested_only` — which had put it *below* a host that sent only a header and+ named nothing. `anthropicStrength` and `openaiStrength` are removed;+ `Baikai.Provider.Cli.Internal.subprocessStrength` keeps its signature and+ delegates. (REV-2 D.10.)++### Removed++- `baikai` **0.6.0.0** (breaking): the sixteen `_Type` base-value aliases deprecated in+ 0.3.0.0 — `_Options`, `_Context`, `_Model`, `_ModelCost`, `_Response`,+ `_Usage`, `_Cost`, `_CostBreakdown`, `_Tool`, `_TextContent`,+ `_ThinkingContent`, `_ToolCall`, `_ImageContent`, `_EmbeddingModel`,+ `_InteractiveLaunchRequest` and `_InteractiveLaunchResult`. Each has an+ `empty…` or `zero…` replacement of the same value, named in the pragma that+ has been on it since 0.3.0.0. The 0.3.0.0 entry said they remained "for this+ release"; 0.4.0.0 and 0.5.0.0 shipped without removing them because no entry+ named a version.+ `docs/adr/0016-deprecated-names-are-removed-at-the-next-major.md` now fixes+ the rule: a name deprecated in `A.B.0.0` is removed in `A.(B+1).0.0`, and+ every pragma says so. (REV-2 G.3.)++- `baikai` **0.6.0.0** (breaking): `Baikai.Trace.newEventId`. It has delegated to+ `Baikai.Evidence.newCallId` since 0.5.0.0; call that. (REV-2 G.3.)++- `baikai` **0.6.0.0** (breaking): `Baikai.Compat.defaultAnthropicThinkingStyle`, deprecated+ earlier in this cycle. Nothing in baikai consults it — the thinking style of a+ first-party Anthropic model is a field of its generated catalog record+ (`Baikai.Models.Generated`); start from that value, or set+ `CompatAnthropicMessages` explicitly.++- `baikai` (breaking): `AgentRunRequest.envPassthrough` is renamed `envRequires`.+ The field is a list of variables the job declares it requires, checked as a+ precondition; it has never passed anything through, and the KDL key has said+ `env-requires` since the setting existed.++- `baikai` (breaking): `AgentRunFailure.OutputMalformed`, and with it+ `baikai-agent`'s exit code 70 and its `internalExitCode` export. Nothing ever+ constructed the constructor, and giving it a producer would have been wrong:+ the runner treats the tool's output as best-effort observation and its+ deliverable is the changed working tree, so a run that edited files correctly+ and then printed an unparseable final line would have been reported as a+ failure with its exit code and output discarded. A record's `strength` and+ `unobserved` fields already say when output could not be read. (REV-2 F.13.)++### Fixed++- `baikai`: the terminal event and its evidence record are pushed to the trace+ sink exactly once under asynchronous exceptions. The terminal path pushed the+ evidence record, pushed the terminal event and only then set the+ already-sent flag; an exception delivered between the last two made the+ stream finaliser read the flag as unset and push a second `CallEvidence` and+ an `aborted` `CallFailed` after the real `CallFinished`, so a sink saw two+ records and two contradictory terminals for one call. All three writes now+ run inside one `uninterruptibleMask_` with the flag first. (REV-2 D.4.)++- `baikai`: `Baikai.Cost.Log.closeCallLog` is idempotent. The first caller+ claims the handle and waits for the worker; a second returns at once instead+ of blocking forever on an `MVar` the worker had already emptied — a shape+ `withCallLog` makes easy to reach, since its bracket closes a handle the body+ may also have closed. An `appendEntry` after the close enqueues nothing.++- `baikai`: `reassembleResponse` is total under duplicated, late and+ timestamp-less input. The first `EventStart` wins the skeleton and+ `responseId` merges with `<|>`, so a later `Nothing` cannot erase an id an+ earlier event supplied; events after the first terminal are ignored, so a+ producer that keeps talking cannot rewrite the answer; and `latencyMs` falls+ back to the reassembler's own wall clock when neither the skeleton nor the+ terminal carries a provider timestamp, instead of reporting a zero that reads+ as "instant". (REV-2 B.7.)++- `baikai`: an `EmbeddingModel` pointed at a non-OpenAI host no longer sends+ `OPENAI_API_KEY` to it. The default key source was that variable whatever the+ base URL said, so pointing the client at DeepSeek handed DeepSeek an OpenAI+ credential. It now resolves per host, and refuses an unknown one. New+ `resolveEmbeddingKey` and `embeddingClientEnv` expose both decisions without+ making a request. (REV-2 E.3.)++- `baikai`: `Baikai.Embedding.embed` no longer allocates a TLS manager per call.+ It used the `openai` SDK's own `getClientEnv`, which builds a fresh manager+ every time; it now takes one from `Baikai.Http`'s process-global cache, the+ same one the chat providers use, so an embedding call and a chat call to one+ host share a connection pool.++- `baikai`: **a credential in a header is no longer printed.** `Options.headers`+ and `Model.headers` went through derived `Show` and `ToJSON` instances that+ rendered every value verbatim — while `Baikai.Options`' own documentation+ invites callers to put a gateway's `Authorization` header there and the+ getting-started guide tells them to `print resp`, which renders the embedded+ `Model`. Both types now have hand-written instances that render exactly what+ the derived ones did, except that the value of a header whose name looks+ credential-carrying (`authorization`, `api-key`, `apikey`, `token`, `secret`,+ `cookie`, `password`, or any name ending in `-key`, case-insensitively) prints+ as `<redacted>`. `Baikai.Auth` exports the three pieces — `redactedMarker`,+ `isCredentialHeader`, `redactHeaderValues` — so a caller can apply the same+ rule to its own logging. Only the rendering changes: the field is untouched,+ `Eq` is untouched, and the header is still sent as written. A JSON round trip+ of a `Model` is deliberately lossy, since a serialised `Model` is exactly the+ thing that should not carry a key. (REV-2 E.2.)++- `baikai`: an API-key environment variable set to the empty string, or to+ nothing but whitespace, now counts as **unset**. `ApiKeyEnv` fails with an+ `AuthError` naming the variable and saying it is not set or is empty;+ `ApiKeyEnvChain` skips it and continues, and reports every name when none+ yields a key. Previously an empty variable resolved to an empty key, which+ short-circuited a chain and produced `Authorization: Bearer ` and a provider+ 401 that said nothing about the cause. A key with real content is still passed+ through untrimmed. (REV-2 E.6.)++- `baikai`: **the host parse no longer lets a base URL choose which key baikai+ sends.** `urlHost` took the text after the *last* `@` anywhere in a URL, so+ `https://proxy.example.com/v1?u=@api.openai.com` named the host+ `api.openai.com`: `defaultApiKeyEnvForBaseUrl` resolved `OPENAI_API_KEY`,+ `autoDetectOpenAICompletions` returned OpenAI's own compatibility record, and+ the bearer token went to `proxy.example.com`. Anyone who could set `baseUrl` —+ a `Model` decoded from JSON, a proxy override — could pick which provider's+ credential to be handed. The same defect broke the benign direction:+ `https://api.openai.com/v1/@x` named the host `x` and resolved no key at all.+ The authority now ends at the first `/`, `?` or `#`, and userinfo is only ever+ the last `@` inside it. (REV-2 A.1 / E.1.)++- `baikai`: `Baikai.Evidence.Build.sanitizeEndpoint` was a second, separately+ written parser that bounded the authority at the first `/` only, so a URL with+ a query and no path recorded the wrong host. It is now `renderEndpoint <$>+ parseUrl`, which also means a recorded endpoint has a lower-cased scheme and+ host; the path keeps its case and trailing slash.++- `baikai`: `parseCodexJsonlStream` assembles lines in **linear time**. It+ previously unpacked every chunk into a stream of bytes and appended them one+ at a time with `BS.snoc`, copying the whole accumulator per byte — quadratic+ in line length, so one codex event carrying a two-million-character message+ cost on the order of a trillion byte moves and in practice never finished.+ Lines are now cut out of each chunk with `BS.elemIndex` and `BS.splitAt`, and+ the pieces of a line that spans a chunk boundary are joined once. Behaviour is+ unchanged: a non-JSON line is still skipped, and a last line without a+ trailing newline is still parsed.++- `baikai`: a Codex custom agent's instructions body renders as a TOML+ **literal** multi-line string (`'''`), which interprets nothing, instead of a+ basic one (`"""`), which interprets backslash escapes. As a basic string an+ instruction as ordinary as "match `\d+`" made Codex refuse to load the file;+ `tomllib` rejects the old output with `Unescaped '\' in a string`. A body a+ literal string cannot hold — one containing three apostrophes, a bare carriage+ return, or a control character other than tab and newline — falls back to a+ fully escaped basic string. `tomlString`, which renders `name` and+ `description`, now escapes every control character as TOML 1.0 requires+ instead of only the five it happened to name.++- Documentation: `baikai`'s Haddock no longer describes behaviour the code left+ behind. The trace event's token counts are `Maybe` because a non-assistant+ terminal has no usage, not because the CLI providers report nothing — since+ 0.5.0.0 both carry what the tool reported. `EventStart`'s `partial` is a+ message skeleton with empty content, zero usage and no stop reason; the api,+ provider and model id live on the `Response`. A lifted stream's `EventStart`+ carries the final usage and stop reason already filled in, because the+ response is complete before the stream begins. `Baikai.CacheRetention` no+ longer mentions an OpenAI Responses 24-hour bucket no code emits. System+ prompts are documented as living on `Context.systemPrompt` rather than on a+ `Baikai.Request` module that no longer exists, `emptyModel`'s `compat` is+ described as auto-detection rather than a placeholder, tool dispatch says+ calls run one at a time in order, and every reference to a plan number is+ gone. (REV-2 H.4.)++## [baikai-claude 0.6.0.0] - 2026-08-28++### Added++- `baikai-claude`: `Baikai.Provider.Claude.Internal.Request` exports `planRequest`,+ `SamplingPlan`, `uncappedMaxTokensFloor` and `normalizeToolCallId` as test seams.+ `planThinking` and `describeThinkingFor` are now projections of `planRequest`, so the+ strict gate, the request builder and the evidence record read one answer.++### Changed++- `baikai-claude`, `baikai-openai` (breaking): each provider's streaming+ machinery moved from `Baikai.Provider.<P>.Api` to+ `Baikai.Provider.<P>.Internal.Stream` — the `SseDriver` seam, `liveSseDriver`,+ `<p>StreamWith`, `Assembler`, `emptyAssembler`, `translate`, and on the OpenAI+ side `RawChunk`, `RawToolDelta`, `parseChunk`, `parseFrame`, `TagScanState`,+ `scanThinkTags`, `closeOpenStream`, `RawUsage`, `parseUsage` and+ `rawUsageToUsage`. `Api` now exports exactly `register`, the provider value+ and the live stream function. The `.Internal` module is exposed for the test+ suites and sibling packages and, like every `.Internal` module, may change in+ any release without a major bump — so changing the assembler stops being a+ documented break. `Shape`, `Sse` and `Transport` keep their names and gain the+ same no-guarantees header. `_TagScanState` is renamed `emptyTagScanState`.+ (REV-2 G.1.)++- `baikai-claude`, `baikai-openai`: a consumer that stops reading now stops the+ provider. Both packages fork their SSE worker under `Stream.bracketIO` and+ hand frames through the bounded `FrameQueue` above instead of an unbounded+ `Chan`. A consumer that cancels — `Ctrl-C`, `System.Timeout.timeout`,+ `cancel` — releases the HTTP connection immediately; a consumer that abandons+ the stream (`Stream.take 3`) stops the socket read within 64 further frames+ and releases the connection at the next major garbage collection. Previously+ the worker read the entire generation into memory for a consumer that would+ never look at it, and the provider billed all of it. The three cleanup+ strengths are stated in+ [docs/adr/0010](docs/adr/0010-a-stream-consumer-that-stops-owns-cancelling-the-producer.md)+ and in caller terms in `docs/user/streaming.md`.++- `baikai-claude`: `anthropic_claude_sonnet_4_6` now sends the adaptive+ thinking shape rather than `budget_tokens`. The budget shape is deprecated+ for that generation; baikai sends the shape Anthropic documents as current.++- `baikai-claude`, `baikai-openai`: **behaviour change.** `Options.timeoutMs` of+ `Just n` with `n <= 0` is refused as `InvalidRequest` before the action runs, so+ no connection is opened. `System.Timeout.timeout` returns immediately at zero+ and runs unbounded below it, and the previous `max 0` clamp made both spellings+ fail instantly as a *retryable* `TransientError` — a classification a caller's+ retry loop re-issues forever for what is a configuration mistake. `Nothing`+ remains the only spelling of "no bound". (REV-2 A.10.)++- `baikai-claude`, `baikai-openai`: an evidence record's `endpoint` names the+ host the call actually went to. Both adapters substitute a vendor default for+ an empty `Model.baseUrl` inside `prepareCall`, so a call with a perfectly+ definite destination recorded `endpoint: null`. Where no adapter ran, `null`+ remains the truthful answer. (REV-2 D.8.)++- `baikai-claude`: the `claude` dependency moves from `^>=1.4` to `^>=1.5`.+ 1.5.0 adds a `Pause_Turn` constructor to `Claude.V1.Messages.StopReason`, and+ `mapStopReason` matches that type with no wildcard under+ `-Werror=incomplete-patterns`, so the bump forced a decision. A paused turn+ maps to `Stop`: Anthropic suspends the turn mid-flight for a long-running+ server-side tool and expects the caller to send the message back to continue+ it, so nothing failed, and `Baikai.StopReason` has no constructor that says+ "resume me". Widening that public sum is a breaking change for every consumer+ who matches on it exhaustively, and it is not this bump's to make. The general+ rule is+ [ADR 0018](docs/adr/0018-a-provider-stop-reason-with-no-baikai-equivalent-maps-to-the-nearest-truthful-one.md):+ a provider stop reason with no baikai equivalent maps to the constructor that+ is truthful about whether the call failed, and the sum widens only when baikai+ would behave differently for it.++- `baikai-claude`: `Messages.StreamUsage` lost its `Generic` instance in `claude`+ 1.5.0, so the `message_delta` usage is read through `OverloadedRecordDot`+ rather than a generic-lens label. `Messages.max_tokens` and+ `Messages.output_config` became ambiguous selectors — `Messages.Fallback`+ carries both names — so the provider's tests read them through `^. #max_tokens`+ and `^. #output_config` instead.++### Removed++- `baikai-claude`, `baikai-openai` **0.6.0.0** (breaking): the eight registration shims —+ `registerWith`, `registerWithRegistry` and `registerWithRegistryAndConfig` in+ both `Cli` modules, and `registerWithRegistry` in both `Api` modules. Register+ the exported provider value instead:+ `registerApiProvider (claudeCliProvider cfg)`,+ `registerApiProviderWith reg (codexCliProvider cfg)`,+ `registerApiProviderWith reg claudeMessagesProvider`. The batch-mode note that+ had accumulated on `registerWith` — why `complete` stays on the direct path+ rather than going through `streamingComplete` — moves to the provider value it+ describes. (REV-2 G.3.)++- `baikai-claude`, `baikai-openai`: `responseToError` and `classifyErrorText`+ (and its private `classifySdkHttpText` half) from both+ `.Internal.ErrorClass` modules. Neither package runs a `servant-client` client+ on the chat path any more, so the `ClientError` branch was unreachable, and the+ text classifiers parsed a string shape the local SSE transports stopped+ producing in July. The phrase table `classifyErrorText` held survives as the+ message fallback inside `classifyErrorFrame`, pinned through the entry point the+ runtime actually uses. Both modules are documented as outside the PVP-stable+ surface, so this is not a major bump; version bumps are recorded once, later.++- **Breaking.** `baikai-claude`: `Baikai.Provider.Claude.Api.anthropicStrength`+ and `baikai-openai`: `Baikai.Provider.OpenAI.Api.openaiStrength`, both replaced+ by `Baikai.Evidence.deriveStrength`.++### Fixed++- `baikai-claude`, `baikai-openai`: a failure that lands while the response body+ is streaming is classified as the transient failure it is. A connection reset,+ a server closing the socket mid-chunk, a body shorter than its declared length+ and a TLS session torn down after the handshake all now terminate the stream+ with `TransientError` and `isRetryable = True`, carrying whatever text had+ already been drained. Every one of them used to be `OtherError` with+ `isRetryable = False`, while the identical failure at connect time was+ transient — because `http-client` wraps the connect phase with the manager's+ exception wrapper and the body reader with nothing that converts a socket+ `IOException` or a `TLSException`, so those reached the worker raw and missed+ the `HttpException` branch entirely. (REV-2 A.2.)++- `baikai-claude`, `baikai-openai`: a transport failure mid-stream now closes+ the blocks that were open when it arrived, on both providers, so a consumer+ reading raw events and a consumer reassembling them see the same partial+ output. Both providers built their terminal from the closed blocks alone and+ silently dropped open text, thinking and tool arguments. On the Claude side+ this covers `translate (Left …)`, the in-band `error` frame, and the+ unexpected end of stream. (REV-2 B.3.)++- `baikai-claude`: an SSE frame whose event `type` — or whose+ `content_block_delta` `delta.type` — the SDK has no constructor for is now+ skipped instead of ending the stream with a decode error. The SDK decodes both+ with no unknown-tag fallback, so a new frame type from Anthropic used to be a+ terminal fault. A frame of a *known* type that still fails to decode remains+ one. `Baikai.Provider.Claude.Sse` exports the new `decodeFrame`. (REV-2 B.5.)++- `baikai-claude`, `baikai-openai`: an empty `data:` heartbeat is ignored, and+ on the OpenAI side `[DONE]` is compared after trailing whitespace is trimmed,+ so `data: [DONE] ` and `data: [DONE]\r` end the stream rather than failing to+ decode. (REV-2 A.8.)++- `baikai-claude`: every failing stream now begins with `EventStart`. The+ producer pre-seeds the start event before the first wire read, exactly as the+ OpenAI producer already did, and `message_start` updates the assembler without+ emitting a second one. Previously a 401, a rate limit, an in-band `error`+ frame or an EOF arriving before `message_start` produced a lone `EventError`,+ breaking the protocol `Baikai.Stream.Event` documents. `StartPayload.responseId`+ is consequently `Nothing` on both HTTP providers; the provider's message id+ rides `TerminalPayload.responseId`, which `reassembleResponse` already prefers.+ (REV-2 A.4, REV-1 Theme 1.1.)++- `baikai-claude`, `baikai-openai`: an asynchronous exception delivered to the+ stream worker can no longer strand its consumer. End-of-frames is a flag set+ by the worker fork's own `finally` rather than a sentinel value pushed onto+ the channel, so a worker that dies without running its normal exit path still+ ends the stream in an `EventError`. Previously the consumer blocked until the+ runtime's deadlock detector noticed.++- `baikai-smoke`: two keyed cases against `claude-sonnet-5` — one asking for+ thinking (which is a 400 before this release) and one setting `temperature` — plus+ `deepseek-chat` and `openrouter/openai/gpt-4o-mini` in `apiCases`, so the tool and+ structured-output smokes run against a compatible host that is not OpenAI.+ `CompatSmoke` now asserts DeepSeek honoured the output cap rather than only that it+ answered, and `CacheSmoke` asserts the cached token classes cost something.++- `baikai-claude`: a thinking request on `claude-sonnet-5` no longer 400s. It sends+ `"thinking":{"type":"adaptive"}` and no `budget_tokens`, because the shape is read off+ the model's catalog record rather than guessed from its id. (REV-2 C.1.)++- `baikai-claude`: `temperature` and `top_p` are no longer sent to a model generation that+ rejects them with a 400. They are omitted and the omission is recorded as+ `sampling_dropped_unsupported_model` in the call's evidence. `seed`, `frequencyPenalty`+ and `presencePenalty`, which the Anthropic Messages API has no field for on any+ generation, are recorded as `sampling_dropped_unsupported_api`. (REV-2 C.1, C.5.)++- `baikai-claude`: a model whose `maxOutputTokens` is `0` no longer sends+ `"max_tokens":0`, which Anthropic rejects — and, with thinking set, no longer had its+ whole thinking plan discarded for not fitting inside a ceiling of zero. It sends+ `uncappedMaxTokensFloor` (1024, the SDK's own default) instead. An explicit+ `maxTokens = Just 0` is still forwarded as written. (REV-2 C.2.)++- `baikai-claude`: replay no longer sends an empty text block or an empty `content` array,+ both of which Anthropic rejects. An empty text block is dropped; an assistant turn left+ with nothing is dropped whole (it is baikai's own artifact — a block that closed with no+ deltas, or only unsigned thinking, which replay already omits); a user turn left with+ nothing is refused locally with a message naming the turn. (REV-2 C.3.)++- `baikai-claude`: tool-call ids that differ only in characters the alphabet forbids, or+ only past character 64, no longer normalise onto the same id and misroute a tool result.+ A conforming id passes through unchanged — every id Anthropic and OpenAI actually mint+ does — and any other is truncated to 51 characters and suffixed with twelve hex+ characters of its SHA-256. Two `tool_use` blocks in one turn that still collide are+ refused rather than sent. (REV-2 C.7.)++- Documentation: `baikai-claude`'s and `baikai-openai`'s Haddock point at the+ functions that exist. `Baikai.Compat` named+ `Baikai.Provider.OpenAI.Api.mkOpenAIResponseFormat`,+ `…Api.applyThinkingFormat` and `…Api.translateTextLikeDelta`; the first two+ moved to `…Internal.Request` and the third is+ `…Internal.Stream.scanThinkTags`. `ThinkingFormat`'s note said the six+ non-native shapes all clamp through `compatibleEffort`; three do, Z.ai and+ Qwen send a bare toggle, and `ThinkingFormatNone` drops the control.+ `immediateError` carried two `-- |` headers where one was intended.+ (REV-2 H.4.)++- `baikai-claude`: an Anthropic call reports its thinking tokens. `Usage.reasoningTokens`+ was hard-coded to `Nothing` on this provider because `claude` 1.4.0's+ `Messages.Usage` had no breakdown to read; 1.5.0 adds+ `output_tokens_details.thinking_tokens`, and both `message_start` and+ `message_delta` now fill the field from it. `reasoningTokens` is an+ informational subset of `outputTokens`, so no total and no cost moves.++- `baikai-claude`: the prompt-side token counts survive a server-side tool run.+ The final `message_delta` used to contribute only `output_tokens`, and+ `inputTokens`, `cacheReadTokens` and `cacheWriteTokens` kept whatever+ `message_start` had reported — which is wrong for a call whose prompt grew+ mid-stream. `claude` 1.5.0 exposes those three on `Messages.StreamUsage`, and+ each is now taken when present. An absent field still keeps the+ `message_start` figure rather than zeroing it, so a model that sends only+ `output_tokens` is accounted for exactly as before.++## [baikai-openai 0.6.0.0] - 2026-08-28++### Added++- `baikai-openai`: `Baikai.Provider.OpenAI.Internal.ErrorClass.classifyErrorFrame`+ and `Baikai.Provider.OpenAI.Api.parseFrame`, which sort a decoded SSE payload+ into a classified in-band error or a completion chunk.++### Changed++- `baikai-openai`: **breaking.** `Baikai.Provider.OpenAI.Shape`'s+ `injectThinkingShape`, `describeThinkingShape`, `shapeRequestBody` and+ `streamRequestBody` take a `Bool` after the compat record — whether the model+ advertises reasoning support (`Model.reasoning`). A level on a `reasoning = False`+ model now sends no `reasoning_effort`, `reasoning`, `thinking` or `enable_thinking`+ key on any host, and records `thinking_dropped_unsupported_model` instead. The model+ check runs before the host-format check. This is what stops `gpt-4o-mini` plus a+ level from 400ing. (REV-2 C.4.)++### Fixed++- `baikai-openai`: an in-band `{"error": …}` frame on a `2xx` stream terminates+ the call with the frame's own classification, status and message. Compatible+ hosts (OpenRouter, DeepSeek, Together) report an upstream failure they only+ learned about after committing to a `200` this way, and `parseChunk` never+ looked at `error`. The pre-fix behaviour was worse than a bad category:+ OpenRouter's frame carries `choices[0].finish_reason = "error"`, which mapped+ to `Stop`, so the call ended as `EventDone` with `errorInfo = Nothing` — a+ consumer switching on the terminal saw a *completed* call. A frame with no+ `choices` beside the error ended as+ `OtherError "openai stream ended without finish_reason"`. (REV-2 A.3.)++- `baikai-openai`: reasoning that arrives after visible text closes the open+ text block before opening the thinking block, so at most one of the two is+ open at a time, every `_End` precedes the next `_Start`, and no `contentIndex`+ is revisited after a later one. (REV-2 B.4.)++- `baikai-openai`, `baikai-claude`: **a provider POST no longer follows+ redirects.** `http-client`'s default is to follow up to ten with every header+ intact, so a 3xx would have re-sent the bearer token (or `x-api-key`) to+ whatever host the `Location` header named. `redirectCount` is now zero and the+ 3xx is delivered as the one in-band terminal error carrying its status. Each+ transport's request builder is exported as `buildRequest`, so the method, the+ composed path and the redirect policy are assertable without a connection.+ (REV-2 A.5 / E.4.)++- `baikai-openai`, `baikai-claude`, `baikai`: **the base-URL convention is+ stated and enforced.** `Model.baseUrl` and `EmbeddingModel.baseUrl` are the+ API *root* — the host, or the prefix a host mounts the API under — because+ baikai appends `/v1/chat/completions`, `/v1/messages` or `/v1/embeddings`+ itself. A trailing `/v1` is accepted and removed rather than doubled, so+ `https://api.deepseek.com/v1` now requests `/v1/chat/completions` instead of+ `/v1/v1/chat/completions`. A base URL with no scheme, a scheme other than+ `http`/`https`, credentials, a query string, a fragment, or a path that is+ already an endpoint is refused as an `InvalidRequest` naming the problem —+ and refused *before* a key is read, so an unusable base URL never causes a+ credential to be looked up. The message renders the URL without its userinfo+ or query, so it is safe to log. `docs/user/models-and-providers.md` gains a+ **Base URLs** section stating all of it. (REV-2 A.6.)++- `baikai-openai`, `baikai-claude`: the `ClientEnv` cache was duplicated in each+ package and keyed on the raw base-URL text, so `https://h` and `https://h/`+ were two TLS managers and two connection pools to one host. There is now one+ cache, in `Baikai.Http`, keyed on the canonical rendering of the parsed base+ URL. `Transport.getClientEnvCached` and `Transport.cachedClientEnvCount` are+ re-exports of the core functions and keep their signatures.++- `baikai-openai`: the Codex interactive launcher now **refuses the two approval+ policies the installed CLI rejects**. `codex --help` at `codex-cli 0.149.1`+ lists exactly `on-request` and `never` for `--ask-for-approval`;+ `CodexApprovalUntrusted` and `CodexApprovalOnFailure` are older spellings the+ CLI answers with `error: invalid value 'untrusted' for+ '--ask-for-approval'`. Rendering them made a launch return `Right` carrying a+ non-zero exit code — a session that ran and failed — instead of the `Left+ SafetyNotExpressible` this module promises for a policy that cannot be+ honoured. They are refused before any process is created, and refused rather+ than quietly mapped onto `on-request`, because substituting a different+ approval policy would change what the caller asked for. The constructors and+ their spellings are unchanged, so code that matches on `CodexApprovalPolicy`+ keeps compiling.++## [baikai-trace-otel 0.4.0.0] - 2026-08-28++### Added++- `baikai-trace-otel`: `OtelSinkOptions` derives `Generic`, so `#spanName`+ resolves on it. No `Eq` or `Show`: `OpenTelemetry.Context.Context` has neither,+ and an instance that ignored `parentContext` would be a lie. (REV-2 G.6.)++- `baikai-trace-otel`: `OtelSinkOptions.parentContext :: Maybe Context`, default+ `Nothing`. When set, every span the sink opens becomes a child of the span in+ that context instead of a root, so a call can be nested under the caller's own+ request span. It is a value fixed when the sink is built rather than an action+ run per call, because the fold runs on baikai's trace worker thread where the+ caller's thread-local context is invisible: capture the context on your own+ thread (`ctx <- getContext`, or `Context.insertSpan mySpan Context.empty`) and+ build the sink for that request. __Breaking for positional construction__ of+ `OtelSinkOptions`; the documented path is a record update on+ `defaultOtelSinkOptions`. (REV-2 D.9.)++### Changed++- `baikai-trace-otel`: the `baikai.evidence.strength` span attribute is rendered+ by `Baikai.Evidence.renderEvidenceStrength`, the function the JSON encoding+ uses, instead of a second spelling local to the sink that could drift from it.++- `baikai-trace-otel`: `gen_ai.response.model` is set only by the evidence+ branch, from the model the provider reported. The terminal branch set it from+ the *requested* id, and since evidence is pushed before the terminal and+ `addAttributes` replaces a key, that both labelled a request as an observation+ on every call without evidence and overwrote the genuinely observed value on+ every call with one. (REV-2 D.1.)++## [baikai-effectful 0.4.0.0] - 2026-08-28++### Changed++- `baikai-effectful` (breaking): the version is a **major** bump although this+ package's own exports are unchanged. Its `baikai` bound moves to `^>=0.6.0`,+ and the `Baikai` effect's three operations are typed in `Model`, `Context`,+ `Options` and `Response` — every one of which baikai 0.6.0.0 changes+ breakingly. A consumer therefore meets a break through this package even+ though nothing in it was renamed, so the number says so rather than making+ `0.3.0.4` look like a safe upgrade.++- `baikai-effectful`: no longer depends on `streamly`. Both stanzas listed it+ while every module imports only `Streamly.Data.Fold` and+ `Streamly.Data.Stream`, which are `streamly-core`. (REV-2 minor.)++## [baikai-kit 0.2.0.0] - 2026-08-28++### Added++- `baikai-kit`: `Baikai.Kit.Error` with the closed `KitError` sum, its+ `Exception` instance and `renderKitError`; `Baikai.Kit.Path.safeSourcePath`,+ which resolves an untrusted relative source below the kit checkout and refuses+ a symbolic link in any component or a canonical path outside the checkout;+ `Baikai.Kit.Manifest.itemSources`/`ItemSources`, the one pure derivation of an+ item's source list, and `supportedManifestVersions`;+ `Baikai.Kit.Sidecar.hashEntries`; `Baikai.Kit.Repo.KitRepo`/`RepoRefresh`;+ `Baikai.Kit.Install.installFrom`, `renderAvailable` and `UpdateReport`;+ `Baikai.Kit.Status.StatusReport`, `UpstreamAvailability` and the now-pure+ `renderStatusTable`; `Baikai.Kit.Command.runKitCommand`. `KitState` gains+ `KitUpstreamRefused`, rendered `refused`. (REV-2 E.5, F.10, F.11.)++- `baikai-kit`: `Baikai.Kit.Install.OverwritePolicy` (`KeepLocalEdits`,+ `OverwriteLocalEdits`), `reinstallPresent` (the network-free half of+ `updateKit`), and `PlannedWrite`/`WriteContent`/`executePlan`/`executePlanWith`+ as a test seam. `SidecarMeta` gains `installedFiles` and `installedHash`,+ which record what this tool wrote for one provider and the hash of exactly+ those bytes; `newSidecarMeta` takes both. `kit update` gains `--force`.+ (REV-2 F.12, Theme 8.2.)++### Changed++- **Breaking.** `baikai-kit`: every library function returns+ `Either KitError a` and prints nothing; only+ `Baikai.Kit.Command.runKit` prints `Error: …` and exits 1. `loadManifest`,+ `loadManifestMaybe`, `installItem`, `listAvailable`, `uninstallItem`,+ `updateKit` and `ensureKitRepo` change shape accordingly, `computeKitHash`+ takes the kit root, a base and relative file names, `kitStatus` returns a+ `StatusReport` instead of printing, and `KitUpdate`'s report is rendered by+ the caller. See `docs/adr/0013-library-code-never-calls-exitfailure.md`. A+ consumer that only calls `runKit` and `kitCommandParser` needs no change; one+ that calls the library directly binds `Right`. (REV-2 F.11.)++- `baikai-kit`: a kit is plain files. Install, the content hash and `kit status`+ resolve every listed source through `safeSourcePath`, so a kit repository that+ commits a symbolic link can no longer have a file read through it and copied+ into a provider directory. `kit status` shows such an item as `refused`.+ (REV-2 E.5 = F.10.)++- `baikai-kit`: a manifest whose `version` is not 1 or 2 is refused with+ `KitManifestVersionUnsupported` instead of being decoded and installed.+ (REV-2 F.12.)++- `baikai-kit`: an agent that lists several `files` installs all of them. The+ first becomes the provider's agent file as before, and each remaining file+ goes into a resource directory named after the agent beside it+ (`<agents dir>/<name>/<file>`), which uninstall removes with the agent. Only+ the first file used to be installed. (REV-2 F.12.)++- `baikai-kit`: `kit update` skips an item whose installed files no longer hash+ to what its sidecar recorded, printing the `--force` invocation that would+ overwrite them; `kit update --force` reinstalls anyway. Sidecars written+ before this release carry no such hash and are updated without the check.+ (REV-2 Theme 8.2.)++### Removed++- **Breaking.** `baikai-kit`: `Baikai.Kit.Path.safeUnder` (exported and unused),+ `Baikai.Kit.Manifest.agentSources` (replaced by `itemSources`) and+ `Baikai.Kit.Install.uninstallOutcomes` (absorbed by `uninstallItem`, which now+ returns the outcomes for the caller to render). The internal `requireSafe` and+ `Baikai.Kit.Status.resolveCacheOrEmpty` are gone with the exits they wrapped.++### Fixed++- `baikai-kit`: `kit status` with no cache and no network prints+ `No kit items installed.` and exits 0. It used to exit 1: the guard around+ `ensureKitRepo` caught `IOException`, which is not what `exitFailure` throws.+ (REV-2 F.11.)++- `baikai-kit`: `Baikai.Kit.Status.upstreamHash` joined the manifest `path`+ without validating it, a second unsanitised join that grew after the July+ hardening pass validated the first. Both now go through `itemSources` and+ `safeSourcePath`. (REV-2 Theme 8.1.)++- `baikai-kit`: an install that fails while renaming files into place now+ restores what was there before, or names the paths it could not restore.+ Phase two was a bare loop of renames, so a failure part-way left earlier+ renames in place while the message said "no changes were made". Temporary+ files are also created with `openTempFile`, so two concurrent installs of one+ item no longer clobber each other's staging file, and a destination that is a+ directory is refused before anything is written. (REV-2 F.12.)++- `baikai-kit`: `Baikai.Kit.Install.stripYamlFrontmatter` normalises line+ endings to LF on every branch. Input without frontmatter, and input whose+ frontmatter is never closed, used to keep their `\r` characters and leak them+ into the Codex agent TOML. (REV-2 Theme 8.7.)++- `baikai-kit`: an `IOException` raised while reinstalling during `kit update`+ is returned as `KitWriteFailed` instead of escaping as an uncaught exception.+ (REV-2 Theme 8.4.)++## [baikai-agent 0.2.0.0] - 2026-08-28++### Added++- `baikai-agent`: three operator-only `policy` keys — `policy.allowed-tools`,+ `policy.max-timeout` (a duration or `"unlimited"`) and+ `policy.max-output-limit` (a byte count or `"unlimited"`) — each defaulting+ from `defaultAgentCeiling`, and all six ceiling fields now printed by+ `agent show` and carried in its `--json` object.++- `baikai-agent`: `Baikai.Agent.Config.repositoryScopeViolations`, which reads+ the resolution report to say which values the untrusted repository file was+ not allowed to supply at all. `Baikai.Agent.Cli` concatenates its answer with+ the pure ceiling's, so an operator sees one refusal naming every problem.++### Changed++- `baikai-agent` (breaking): `AgentConfigScope`'s constructors are+ `AgentUserScope` and `AgentRepositoryScope`. `UserScope` collided with+ `baikai-kit`'s `KitScope` constructor of the same name, the one clash between+ two baikai-family packages. (REV-2 G.5.)++- `baikai-agent` (breaking): a relative `working-dir` resolves against the+ repository root rather than the process's own directory, so `working-dir "."`+ means the checkout whichever file declared it. Resolving against the process+ directory made `"."` mean two places when two documents defined one job, since+ which one it was depended on which layer won. An absolute path is unchanged.+ (REV-2 F.14.)++- `baikai-agent` (breaking): every `--json` output is now built with `aeson`+ rather than a hand-rolled writer, and `agent show --json` always emits one+ object with the same seven keys — `job`, `outcome` (`shown`, `refused` or+ `failed`), `exitCode`, `message`, `configuration`, `ceiling`, `command` —+ with `null` for the parts that do not apply. Previously a refusal emitted a+ different shape from a success and a document that would not parse emitted a+ bare resolution report or nothing at all, so a reader had to know which+ failure mode it was looking at before it could find the exit code. `run --json`+ keeps its `outcome` values and `list --json` is unchanged. (REV-2 F.14.)++- `baikai-agent` (breaking): `--run-id` or `--require-evidence` without either+ `--evidence-file` or `--json` is now a usage error (64) naming both fixes.+ Before, the record was built — a `--version` probe of the tool and two digests+ — and then dropped. Under `--json` the record now travels in the envelope as+ `evidence`, encoded by the same `ToJSON` `--evidence-file` writes.++- `baikai-agent`: `agent show` and `agent run` no longer print another job's+ unknown-key warnings, or the operator file's `policy` keys. The declaration+ describes one job and the ceiling is a separate declaration, so `settei` warns+ about both; neither is a mistake and a document with four jobs printed three+ jobs' worth of noise on every run. A misspelled key inside the selected job+ still warns, and a `policy` node in the *repository* document earns exactly one+ notice saying it has no effect. `Baikai.Agent.Config` exports the two filters,+ `relevantWarnings` and `repositoryPolicyNotice`. (REV-2 F.13.)++- `baikai-agent`: an evidence record's `endpoint` resolves a relative executable+ against the job's working directory before probing it, because that is what+ the child execs. A job whose `executable` is `./bin/agent` previously reported+ a path resolved against the parent's own directory, which does not exist.+ `Baikai.Agent.Run` exports `executableForEvidence`. (REV-2 F.13.)++- `baikai-agent`: a failed run's `error_info.message` keeps the last+ `errorInfoStderrTailBytes` (4096) bytes of standard error, prefixed with how+ many earlier bytes were dropped, instead of the whole captured stream — which+ the output limit allows to reach four mebibytes by default. `Baikai.Agent.Run`+ exports the constant. (REV-2 F.13.)++- `baikai-agent`: `--evidence-file` stages through a uniquely named temporary+ file created with `O_EXCL` beside the destination, instead of the destination+ plus `.partial`. A symbolic link planted at the old, guessable name was+ followed, which let an unattended run overwrite a file of the planter's+ choosing. (REV-2 F.13.)++- `baikai-agent` (breaking): an operator configuration file that lies inside the+ repository root is refused with exit 78, naming the file and the root, and no+ ceiling is established. The source list already refused the repository+ *document*; this closes the shape where the repository supplies the *operator*+ document, which both `--user-config .baikai/policy.kdl` and+ `XDG_CONFIG_HOME=$PWD/.baikai` produce. `--user-config`, `XDG_CONFIG_HOME` and+ `HOME` remain the operator's own inputs: the ceiling is exactly as trustworthy+ as the process environment that selects it, and the guide now says so.+ (REV-2 F.4.)++- `baikai-agent` (breaking): an unrecognised key under the operator file's+ `policy` node is an error rather than a warning, naming the file and every+ such key. Everywhere else a forward-compatible file should not stop an older+ binary; under `policy` a misspelling would silently leave the default ceiling+ in force, which for the one node whose purpose is limiting authority is+ indefensible. Two `AgentConfigError` constructors are added,+ `CeilingFileInsideRepository` and `UnknownPolicySetting`.++- `baikai-agent` (breaking): `AgentConfigPaths` gains `repositoryRoot`, the+ directory the process runs in. `--config PATH` chooses which file supplies+ repository-scope settings and does not move the root, because the root is what+ confines a repository-supplied `working-dir`.++- `baikai-agent` (breaking): a repository configuration file may no longer set+ `executable` or a non-empty `extra-dirs`, and its `working-dir` must resolve —+ after following symbolic links — inside the repository root. Each is refused+ with exit 77 naming the setting, or naming both directories. The operator's+ own file and `--set` may still set all three. `executable` turns configuration+ into code execution with the operator's environment and the prompt on standard+ input; `extra-dirs` inside the root adds nothing the working directory does not+ already give, so the only ones a checkout would ask for are outside it.+ (REV-2 F.3.)++### Removed++- `baikai-agent` (breaking): the `BAIKAI_AGENT_EXECUTABLE` environment binding.+ An environment variable is inherited by every child process and is easy to set+ by accident, and naming the program to run is the widest widening there is.+ An operator whose installation is not on `PATH` writes `executable` in their+ own configuration file or passes `--set`.++### Fixed++- `baikai-agent`: a timed-out run now **escalates to `SIGKILL`**. The runner+ interrupts the child's whole process group, then terminates it, then kills it,+ each of the first two stages bounded by the grace period and ended early once+ the leader has been reaped and no member of the group is left. Previously the+ last resort was `terminateProcess` followed by an *unbounded* wait, so a+ coding agent that ignored `SIGTERM` — or a grandchild holding the output pipe+ — hung the run for as long as it chose to live, with the deadline already+ past. Polling the group rather than waiting on the leader alone is also what+ gives a grandchild the same grace the agent gets.++- `baikai-agent`: a timed-out run **reports the output it drained**. `baikai+ agent run` prints it under the same stream discipline a finished run gets, so+ `response=$(baikai agent run job)` under `capture` receives the partial answer+ with `$?` set to 75, and `--json`'s failure envelope carries the same+ `stdout`, `stdoutTruncated`, `stderr` and `stderrTruncated` fields. A drain+ interrupted because something outside the process group still held the pipe+ open keeps its bytes too, reported as truncated.++- `baikai-agent`: the `baikai` command writes its output as **UTF-8 bytes**+ rather than through the locale encoding. Where an unattended run actually+ happens — cron, a systemd unit, a container — the environment says `LANG=C`,+ and on a platform whose locale encoding follows it a single accented character+ in the agent's answer made the write throw after the run had already finished:+ exit 1, answer lost. This mirrors what the prompt read and the prompt write+ have always done.++- `baikai-agent`: the `baikai` executable now links the **threaded runtime**+ (`ghc-options: -threaded` on the `executable baikai` stanza). Without it a+ blocking operating-system call — the `waitpid` inside+ `System.Process.waitForProcess` — stopped every Haskell thread in the+ installed binary, so a job's configured `timeout` could never fire and a+ coding agent that wrote more than one pipe buffer deadlocked against the+ runner's drain threads. Both defects existed only in the shipped executable:+ the test suite was already compiled `-threaded`, so every runner test passed+ under a runtime the binary did not have.++ The suite now proves the runtime the binary ships with rather than its own.+ `baikai-agent/test/BinaryTests.hs` spawns the built executable — cabal builds+ it first and puts it on the suite's `PATH` through+ `build-tool-depends: baikai-agent:baikai` — asserts that `baikai +RTS --info`+ reports `rts_thr`, and runs `baikai agent run` against a stub agent that+ outlives its deadline, requiring exit 75 within seconds and the whole process+ group gone. See+ [docs/adr/0006](docs/adr/0006-a-process-spawning-executable-ships-on-the-threaded-runtime.md).++## [baikai 0.5.0.0] - 2026-08-05++### Added++- `baikai`: new exposed module `Baikai.Agent`, the provider-neutral vocabulary+ for an **unattended coding-agent run** — a run with no terminal and no human,+ which owns its own tool loop, may change files inside directories the caller+ authorized, and returns a process result rather than a `Response`. It defines+ `AgentRunRequest` (with a required `workingDir`), `AgentRunResult`, the+ `AgentCapability` profile (`read-only`, `edit-workspace`, `full-access`),+ `AgentSafety`, the `AgentOutputMode` and `AgentCapturedOutput` output+ discipline, the `AgentCommand` renderer/runner boundary with an explicit+ prompt transport, and the `AgentRenderError` / `AgentRunFailure` taxonomies.++- `baikai`: the operator policy ceiling — `AgentCeiling`,+ `defaultAgentCeiling`, `CeilingViolation`, and the pure `applyAgentCeiling`.+ It returns a request unchanged when it is within the ceiling and reports+ every violation when it is not; it never clamps an over-broad request to the+ permitted value. The default ceiling permits read-only and edit-workspace+ authority and refuses full access and raw provider arguments.++ `Baikai.Agent` itself is vocabulary and pure policy algebra only: it spawns no+ process and renders no command-line flags. Those live in the vendor packages+ and in `baikai-agent`, below. The module is deliberately not re-exported from+ the umbrella `Baikai` module, because its field accessors share names with+ `Baikai.Interactive`, so `import Baikai` continues to compile unchanged.++- `baikai`: new exposed module `Baikai.Evidence`, the vocabulary for+ **verifiable model-call evidence** — a record of what actually crossed the+ boundary to a provider, as opposed to what the process was configured to ask+ for. It defines `ModelCallEvidence` and the `evidenceSchemaVersion` string+ consumers pin against, `Observed` (a deliberate non-`Maybe` for a value the+ provider either did or did not report, with no function that supplies a+ default), `ThinkingTranslation` with its `ThinkingMode` and+ `ThinkingAdjustment` enumerations describing what a requested+ reasoning-effort level actually became on the wire and every clamp, collapse,+ or drop applied on the way, `EndpointIdentity` and `TransportKind`,+ `CallStatus`, and the ascending `EvidenceStrength` scale.++ It also provides the canonical hashing core: `canonicalEncode` gives a JSON+ value exactly one byte representation (object keys sorted, no insignificant+ whitespace, numbers normalised so `1`, `1.0`, `1.00`, and `1e0` all encode as+ `1`, and a hand-written string escaper so an aeson upgrade cannot silently+ invalidate a recorded digest); `commitmentDigest` hashes a full request+ envelope, and `configurationDigest` hashes an allow-list projection+ (`configurationProjection`) that keeps configuration and replaces content with+ structural summaries, so two calls that ask the same model the same way about+ different subjects agree. The two digests are separate on purpose: the first+ binds a record to a particular request, the second is safe to compare across+ runs that legitimately differ in content.++ Nothing constructs a `ModelCallEvidence` from a real call yet, and no existing+ behaviour changed. New dependencies: `cryptohash-sha256` and+ `base16-bytestring`, both single-purpose packages chosen over a full+ cryptographic framework.++- `baikai`: `Options` gains an `evidence` field carrying an optional+ `EvidenceRequest` — the caller's run identifier, retry provenance, and how+ strictly they need evidence. A call whose `evidence` is `Nothing`, which is+ every call that does not opt in, behaves exactly as it did before: no digest+ is computed and no evidence is emitted.++- (Entry added 2026-08-27; the behaviour shipped in 0.5.0.0.) `baikai`: **strict+ evidence mode**. `EvidenceStrictness` is `EvidenceBestEffort` or+ `EvidenceRequired !EvidenceStrength`, and a caller who asks for the second+ gets a call that **refuses to start** — before any request is built or any+ connection opened — when the configuration cannot reach the strength asked+ for: `Baikai.Evidence.Build.checkEvidenceRequirements` compares the+ requirement against what the provider can deliver and against the thinking+ translation, and `completeRequest` / `streamRequest` return an error-shaped+ response or a terminal `EventError` instead of dispatching. The gate is+ pre-dispatch by design; that is the only point at which refusing is still+ free.++- (Entry added 2026-08-27; the behaviour shipped in 0.5.0.0.) `baikai`:+ **sink-failure semantics under strict mode**. `Baikai.Evidence.Build`+ exports `onSinkFailure`, `sinkFailureIsFatal` and `sinkFailureError`: a trace+ sink that throws fails an `EvidenceRequired` caller's call, because a record+ the sink did not confirm written is not a record, while a best-effort caller's+ call succeeds with the failure reported on stderr.++- (Entry added 2026-08-27; the behaviour shipped in 0.5.0.0.) **Breaking.**+ `baikai`: `Baikai.Provider.Registry.ApiProvider` gained a fourth field,+ `describeThinking :: Model -> Options -> ThinkingTranslation`, which the+ pre-dispatch strictness gate calls to learn what a provider would do with the+ caller's reasoning-effort request without sending anything. Every third-party+ provider constructed with the `ApiProvider` constructor stopped compiling.+ This was not recorded at the time; it is the defect that made 0.6.0.0 hide the+ constructor behind `apiProvider` so that the next field addition is a minor+ release.++- `baikai`: model-call evidence is now **produced and emitted**. A caller who+ sets `Options.evidence` gets exactly one `call_evidence` line per call from+ their trace sink, under every way a call can end: success, provider failure, a+ consumer that abandons the stream (status `aborted`, not `failed` — an abort+ is the consumer's doing and reporting it as a provider failure would+ misattribute it), and dispatch that found no registered handler.++ New exposed module `Baikai.Evidence.Build` bridges the vocabulary to the+ `Model` and `Options` records: `minimalEvidence` and `prepareEvidence` build a+ record, `dispatchEnvelope` supplies the request envelope for the paths where+ no adapter ran, `sanitizeEndpoint` reduces a base URL to scheme/host/port/path+ with the query string and any userinfo dropped wholesale, and `onSinkFailure`+ is the hook a future release replaces to make a strict caller's call fail when+ the trace sink does.++ Every record this release produces has `strength` `requested_only` and every+ provider-observed field set to `"unobserved"`. That is not a placeholder: it+ is a truthful record for a transport that has not yet been taught to observe+ anything. Later releases teach each transport to observe more.++ (Correction added 2026-08-27: the two paragraphs above describe the release+ inaccurately and are kept as shipped rather than rewritten. `onSinkFailure`+ did not await a future release — it shipped in 0.5.0.0 together with+ `sinkFailureIsFatal` and `sinkFailureError`, which already fail a strict+ caller's call when the sink throws. And not every 0.5.0.0 record has `strength`+ `requested_only`: the provider entries below describe what each transport+ reports, and the HTTP adapters reach `correlated` and `model_observed`.)++ **A caller who does not opt in pays nothing.** With `Options.evidence` absent+ no digest is computed, no call identifier is generated, no evidence event is+ emitted, and the request envelope is never even forced — the gate lives inside+ the shared builder rather than at each adapter's call site, and the envelope+ parameter is deliberately lazy. Both facts are guarded by tests.++- `baikai`: `TraceEvent` gains a `CallEvidence` constructor, encoded as+ `{"kind":"call_evidence", …}`. A consumer whose pattern match over `TraceEvent`+ is exhaustive must add a branch; one with a wildcard is unaffected. Filter for+ it with `jq 'select(.kind == "call_evidence") | .evidence'`. Note that a trace+ line carries its fields alongside the `kind` discriminator rather than nested+ under a `data` key, and that the evidence record inside spells its own fields+ in snake_case — the two encodings differ deliberately, because an evidence+ record must render an absent field as explicit `null` while a trace line drops+ it to stay small.++- `baikai`: `Baikai.Provider.Cli.Internal` — the module the two subprocess+ providers share — gains the vocabulary for reading what a coding-agent CLI+ reported about its own run. `CodexRunReport` and the new+ `parseCodexJsonlStream :: Stream IO ByteString -> IO CodexRunReport` fold the+ `codex exec --json` event stream into its assistant text, its thread+ identifier, and its token counts, instead of concatenating agent-message text+ and discarding everything else. `ClaudeCliReport` and+ `decodeClaudeCliResult` do the same for `claude -p --output-format json`.+ Every field but the message text is optional, because both tools' event+ schemas have changed across versions and an absent field is a genuine absence+ rather than a parse failure. **Breaking** for anyone calling+ `parseCodexJsonlStream` directly: its result type is no longer `Text`. This is+ an internal module and is documented as outside the PVP guarantee.++- `baikai`: `Baikai.Provider.Cli.Internal` also gains `ExecutableIdentity` and+ `executableIdentity`, which resolve a configured executable name to an+ absolute path and read the tool's own `--version` line. The probe is cached+ per resolved name for the lifetime of the process, because spawning it per+ model call would roughly double the process cost of the cheapest possible+ call, and it is bounded by a five-second timeout so a tool that hangs on+ `--version` cannot wedge a model call. (Corrected 2026-08-27: the entry said+ two seconds; `versionProbeMicros` has always been five.) A probe that fails records the version+ as absent rather than failing the call. It is only ever called from inside+ the evidence branch: a caller who asked for no evidence must not pay for a+ process whose only purpose is to describe a tool they were about to run+ anyway.++- `baikai`: `subprocessStrength` and `cliResponseEnvelope`, also in+ `Baikai.Provider.Cli.Internal`. The former derives a subprocess call's+ evidence strength from what the tool reported and **nothing else** — the exit+ status is deliberately not one of its arguments. The latter spells the+ response-commitment envelope with the same three keys, in the same shapes, as+ the two API transports build by hand, so a verifier holding a response can+ recompute the digest without first knowing which transport served it.++- `baikai`: `Baikai.Agent` gains `AgentRunOutcome` and `agentRunOutcome`. It+ pairs what an unattended run did — the existing+ `Either AgentRunFailure AgentRunResult` — with the evidence the runner built+ for it. The evidence is a sibling of the outcome rather than a field on+ `AgentRunResult` because the run that most needs a record is one that did not+ produce a result: a run killed by its own timeout reports+ `Left (RunTimedOut …)`, so a record hanging off the `Right` would be+ unreachable exactly there.++### Fixed++- `baikai`: a `call_evidence` event is now emitted **before** its call's+ terminal `call_finished` or `call_failed`, rather than after. The+ OpenTelemetry sink ends and removes a call's span on the terminal, so under+ the old order its evidence-attribute branch was unreachable from any real+ call and every backend saw a span with no evidence on it — nothing failed,+ the attributes were simply never there. No consumer can have depended on the+ old order, because no consumer has ever seen a `call_evidence` line.++- `baikai`: the `ThinkingFormatOpenAI` Haddock in `Baikai.Compat` listed the+ native `reasoning_effort` vocabulary as `minimal | low | medium | high`, which+ predates `xhigh` and `max`. It now lists all six and states that this shape+ alone sends the canonical baikai level verbatim while the other six clamp+ through `compatibleEffort`. No behaviour changed: the native path's exclusion+ from that clamp is deliberate and is guarded by two named tests in+ `baikai-openai/test/ShapeSpec.hs`. A reader who consulted the comment to+ decide whether `xhigh` was safe to use against OpenAI has until now been told+ something untrue.++### Changed++- **Breaking:** `baikai`: `TerminalPayload` gains an `evidence` field and the two+ terminal smart constructors take it as their new first argument:+ `doneTerminal :: Maybe ModelCallEvidence -> Maybe Text -> StopReason -> Message -> TerminalPayload`+ and `errorTerminal` likewise. `Response` gains the same field. A custom+ provider implementation must pass `Nothing` (or a record it builds through+ `Baikai.Evidence.Build`); a custom `Response` built with the record+ constructor must add `evidence = Nothing`. Code that only pattern-matches on+ these types is unaffected.++- **Breaking:** `baikai`: `CallFinished` gains `cachedInputTokens`,+ `cacheWriteTokens`, `reasoningTokens`, and `totalTokens`. The trace path used+ to drop counts that `Baikai.Cost.Log.CallLogEntry` kept from the same `Usage`+ value, which made the cost log strictly more faithful than the trace.++- **Breaking:** `baikai`: a computed cost of **zero is now reported as zero**+ rather than suppressed, in `CallFinished` and at all three `CallLogEntry`+ construction sites. Previously `usd` was omitted whenever the cost came out at+ zero, so "this call was free" and "baikai could not price this call" were+ indistinguishable — and the subscription-based CLI providers always price at+ zero, so that was the common case rather than a corner. **A cost dashboard+ that treated an absent `usd` as "unpriced" will now count those calls as+ costing zero.** That is the correct reading, but it changes what such a+ dashboard shows.++- **Breaking:** `baikai`: `FromJSON TraceEvent` is written out by hand instead of+ derived. The three pre-existing kinds decode exactly as before; a+ `call_evidence` line fails to parse with a message saying to read it as a+ plain `Data.Aeson.Value`. `ModelCallEvidence` has no `FromJSON` on purpose —+ it embeds a `Cost` whose exact `Rational` amounts encode through an+ approximating `Scientific`, so a decoder would return a different value than+ was encoded — and manufacturing that fidelity would be the precise failure+ this vocabulary exists to eliminate.++- `baikai`: `Baikai.Trace.Sink.renderHuman` renders a `CallEvidence` event as a+ single `EVIDENCE run=… call=… strength=…` line rather than the whole record. A+ human-readable sink is for watching calls go by; the full record is meant to+ be read out of `fileSink` output by a machine.++- `baikai`: call identifiers on the trace path are now globally unique.+ `Baikai.Evidence.newCallId` produces 32 lowercase hexadecimal characters+ carrying 128 bits — 48 bits of Unix time in milliseconds, 48 bits of a+ per-process random seed drawn once from `/dev/urandom`, and a 32-bit counter.+ The previous generator combined the process-start *second* with a+ process-local counter into 16 characters, so two processes started within the+ same second emitted identical identifier sequences; its own documentation+ claimed only per-process uniqueness. Identifiers still sort chronologically+ and are still not secrets.++ `Baikai.Trace.newEventId` keeps its name and signature, delegates to+ `newCallId`, and is now deprecated. Anything that pinned the 16-character+ width — a log parser, a fixture, a column type — must widen to 32.++- `baikai`: `renderCeilingViolation` no longer prints the raw provider arguments+ a `ProviderArgsForbidden` violation carries. It reports how many were+ requested and states that their values are not shown. Raw provider arguments+ are the one part of a job description that can hold a credential — the+ configuration layer classifies the setting secret for that reason — and a+ refusal message that quoted them defeated the classification. The constructor+ keeps its `[Text]` payload so a programmatic caller can still inspect it.++## [baikai-claude 0.5.0.0] - 2026-08-05++### Added++- `baikai-claude`: new exposed module `Baikai.Provider.Claude.Agent` with+ `ClaudeAgentConfig`, `defaultClaudeAgentConfig`, and `claudeAgentCommand`, a+ pure renderer from an unattended `AgentRunRequest` to the `claude` argument+ vector. It maps the capability profile onto `--permission-mode`+ (`plan` / `acceptEdits` / `bypassPermissions`), joins a tool allow-list into+ one `--allowedTools` argument, repeats `--add-dir` per extra directory, always+ emits `-p`, and emits `--no-session-persistence` unless `persistSession` is+ set. The prompt travels on standard input and appears nowhere in the argument+ vector. A request naming a different provider is refused with+ `ProviderMismatch`. Nothing is spawned.++- `baikai-claude`: the Anthropic Messages provider now fills in the evidence+ record it previously left blank. It records the model **Anthropic reported+ running** (read from the `message_start` event, which the adapter already+ decoded for the response id and then discarded), Anthropic's `request-id`+ correlation header, the response id, the token counts Anthropic actually+ reported, and a commitment digest over the assembled response. A field the+ provider did not report stays `"unobserved"` and is never backfilled from the+ request — in particular, a stream that fails before `message_start` reports no+ observed model at all. `strength` is `model_observed` when both the model and a+ correlation identifier arrived, `correlated` when only the identifier did, and+ `requested_only` otherwise; a 2xx status never raises it, because a 200 means+ the request was accepted, not that any particular model ran.+ `fully_observed` is unreachable on this transport, since Anthropic does not+ echo the thinking configuration it applied.++- `baikai-claude`: an evidence record's `thinking` field now describes what the+ caller's reasoning-effort preference actually became on the wire, including+ three downgrades that were previously invisible everywhere in baikai's output:+ asking for thinking on a model that does not advertise `reasoning`+ (`thinking_dropped_unsupported_model`); asking for a level whose token budget+ does not fit under the resolved output-token ceiling+ (`thinking_dropped_budget_exceeded`, carrying both colliding numbers), which is+ reachable by lowering `maxTokens` alone; and asking for `high` on an+ adaptive-thinking model, which sends no effort field and so is+ wire-indistinguishable from taking Anthropic's default depth+ (`effort_omitted`). `minimal` on an adaptive model reports `effort_clamped`,+ because Anthropic's adaptive vocabulary has no `minimal`.++- `baikai-claude`: new exports from `Baikai.Provider.Claude.Sse` —+ `ResponseMetadata` and `capturedHeaderNames` — and from+ `Baikai.Provider.Claude.Api` — `claudeMessagesStreamWith`, `SseDriver`, and+ `anthropicStrength`. Response-header capture is an **allow-list**+ (`request-id`, `x-request-id`, `cf-ray`, in that preference order), not a+ denylist, so a header a future gateway adds is not recorded by default.++- `baikai-claude` and `baikai-openai`: both subprocess providers now fill in the+ evidence record they previously left blank, and both export the translation+ function that describes it — `claudeCliThinking` and `codexCliThinking`. They+ record the session or thread identifier the tool reported, the token counts it+ reported, the model it named when it names one, the resolved executable path+ in place of an endpoint URL, the tool's own `--version` string as the+ implementation version (for this transport the tool *is* the implementation),+ a request commitment over the rendered argument vector, and a response+ commitment over the assembled answer.++ **A zero exit status never raises the strength.** A coding-agent CLI that+ exits zero has demonstrated that it ran and did not crash; it has not stated+ which model served the request. Subprocess calls almost always exit zero, so+ encoding that as corroboration would make the weakest evidence in the system+ look like the strongest. `strength` is `model_observed` only when the tool+ named both an identifier and a model, `correlated` when it named only an+ identifier, and `requested_only` otherwise.++ The two transports differ in how far they can get. `claude` names the model+ that consumed tokens in its result event's `modelUsage` map, complete with a+ context-window variant marker such as `[1m]`, so a Claude CLI run can reach+ `model_observed`. `codex-cli 0.146.0` names no model anywhere in its event+ stream, so **no** Codex CLI run can exceed `correlated` — backfilling the+ `--model` flag baikai passed would report the request as an observation.++- `baikai-claude`: an evidence record's `thinking` field now describes what a+ reasoning-effort request became on the `claude` command line: mode `flag`,+ wire field `--effort`, and an `effort_clamped` adjustment recording the+ `minimal` → `low` collapse, because the tool's `--effort` flag has no+ `minimal`. A caller asking for `minimal` and a caller asking for `low` produce+ byte-identical argument vectors — and therefore identical request commitment+ digests — so the translation is the only place that difference survives.++- **Breaking:** `baikai-claude` and `baikai-openai`: `claudeAgentCommand` and+ `codexAgentCommand` return `(AgentCommand, ThinkingTranslation)` rather than+ `AgentCommand`. The runner deliberately imports no vendor renderer, so it+ cannot derive the translation and has to be handed it. A caller that only+ wants the command writes `fmap fst`. Both modules also export the translation+ function alone — `claudeAgentThinking` and `codexAgentThinking` — for asking+ what a level would become without rendering anything.++### Fixed++- **Loud:** `baikai-claude` and `baikai-openai`: both subprocess providers+ hardcoded `usage = zeroUsage` on every call, so a cost dashboard saw every+ `claude -p` and `codex exec` call as consuming no tokens and costing nothing.+ Both tools report their own token counts and baikai now carries them through,+ normalized into the disjoint `Usage` convention: `claude`'s counts are+ Anthropic-shaped and already disjoint, while `codex` reports OpenAI-style+ inclusive prompt counts, so its cached tokens are subtracted out of+ `inputTokens`. `claude` additionally reports a `total_cost_usd`, which now+ populates `Usage.cost` exactly rather than being reported as zero.++ **A dashboard that read these calls as free will now see real tokens and, for+ `claude`, a real cost.** That is the correction, not a regression — but it+ changes what existing reports show, and totals over historical data will not+ match totals over new data.++- `baikai-claude`: `Response.responseId` was always `Nothing` on the `claude -p`+ transport even though `ClaudeCliResult` decoded the tool's `session_id` one+ screen earlier and then dropped it. It now carries that identifier, on both+ the successful and the failed terminal. `baikai-openai`: the same for+ `codex exec`, whose thread identifier was filtered out of the event stream+ along with everything that was not an `agent_message`. These are the handles+ each vendor's support tooling looks a run up by.++### Changed++- **Breaking:** `baikai-claude`: `Baikai.Provider.Claude.Sse`'s four streaming+ entry points — `claudeSseStream`, `claudeSseStreamValue`,+ `claudeSseStreamValueWithHeaders`, and `sseFromResponse` — take a new+ `ResponseMetadata -> IO ()` callback immediately before the existing per-event+ callback. It fires exactly once, before the first event, on both the success+ and the non-2xx path. Pass `(\_ -> pure ())` to keep the previous behaviour.+ The callback is separate rather than a widening of the per-event one because+ the per-event callback runs once per SSE frame and response-level data does not+ belong on that path.++- **Breaking:** `baikai-claude`: `Baikai.Provider.Claude.Internal.Request`'s+ `mapRequest` now returns+ `Either Text (Messages.CreateMessage, ThinkingTranslation)` and+ `computeThinking` returns `(ThinkingPlan, ThinkingTranslation)`. Take `fst` to+ keep the previous value. This module is exposed for provider tests and+ debugging and its header states it is not covered by PVP compatibility+ guarantees, but the change is recorded here because that is not a licence to+ break a consumer silently.++- **Breaking:** `baikai-claude`: `claudeInteractiveCommand` now returns+ `Either AgentRenderError (FilePath, [String])` and `launchClaudeInteractive`+ returns `IO (Either AgentRenderError InteractiveLaunchResult)`. A request+ whose `safety` is a `CodexSandbox` policy — which Claude Code cannot express+ — is refused with `SafetyNotExpressible AgentClaude`, naming the rejected+ sandbox mode and approval policy and suggesting `ClaudeAllowedTools` or+ `DefaultSafety`. Previously the policy was silently discarded and an+ **unrestricted** Claude session was started and reported as a success. A+ `Left` means no process was started; a `Right` with a non-zero exit code+ means the session ran and exited non-zero. `DefaultSafety` and an empty+ `ClaudeAllowedTools` list still render no safety flag and are never refused,+ and no previously rendered argument vector changed. Callers must handle the+ refusal branch.++## [baikai-openai 0.5.0.0] - 2026-08-05++### Added++- `baikai-openai`: new exposed module `Baikai.Provider.OpenAI.Agent` with+ `CodexAgentConfig`, `defaultCodexAgentConfig`, and `codexAgentCommand`, the+ same renderer for `codex exec`. It maps the capability profile onto+ `--sandbox` (`read-only` / `workspace-write` / `danger-full-access`), emits+ `--cd` for the working root, and defaults `--skip-git-repo-check` and+ `--ephemeral` on. A request carrying a tool allow-list is **refused** with+ `UnsupportedToolRestriction`, because `codex exec` has no such flag and running+ it with unrestricted tools would grant more authority than the caller asked+ for. Nothing is spawned.++- `baikai-openai`: an evidence record's `thinking` field now describes what the+ caller's reasoning-effort preference became on the wire for the specific host+ the call went to, across **all seven** OpenAI-compatible wire shapes. The+ OpenAI-native shape sends the canonical level verbatim and records no+ adjustment, because it expresses every level exactly. The four shapes that+ carry an effort word for a non-native host record `effort_clamped` whenever+ the word differs from the canonical name — `minimal` becomes `low`, and both+ `xhigh` and `max` become `high`. Z.ai and Qwen accept a bare+ `enable_thinking: true` with no depth, so **every** level records+ `effort_collapsed_to_toggle`: a caller asking for `max` and a caller asking+ for `low` produce byte-identical requests there, and only the evidence record+ can tell them apart. A host with no reasoning controls records+ `thinking_dropped_unsupported_host` where the option previously vanished with+ no trace. A forty-two-row table test pins the translation and the shaped+ request body for every shape at every level.++- `baikai-openai`: the Chat Completions provider now fills in the evidence record+ it previously left blank. It records the model **the host reported running**+ (read from the first streamed chunk carrying a top-level `model` field and+ never overwritten by a later one), the host's `x-request-id` correlation+ header, the response id, the token counts the host actually reported, and a+ commitment digest over the assembled response. A field the host did not report+ stays `"unobserved"` and is never backfilled from the request — in particular,+ a call that fails before any chunk arrives reports no observed model at all.+ `strength` is `model_observed` when both the model and a correlation+ identifier arrived, `correlated` when only the identifier did, and+ `requested_only` otherwise; a 2xx status never raises it, because a 200 means+ the request was accepted, not that any particular model ran.+ `fully_observed` is unreachable on this transport, since no host in this+ ecosystem echoes the reasoning configuration it applied.++- `baikai-openai`: new exports from `Baikai.Provider.OpenAI.Sse` —+ `ResponseMetadata` and `capturedHeaderNames` — and from+ `Baikai.Provider.OpenAI.Api` — `openaiChatStreamWith` and `SseDriver`.+ Response-header capture is an **allow-list** (`x-request-id`, `request-id`,+ `x-amzn-requestid`, `x-ms-request-id`, `cf-ray`, in that preference order),+ not a denylist, so a header a future gateway adds is not recorded by default.+ The list is longer than the Anthropic one because this transport speaks to an+ open-ended set of hosts and the gateways commonly in front of them.++- `baikai-openai`: the same field for `codex exec`: mode `flag`, wire field+ `model_reasoning_effort`, and **no** adjustments at any level. Codex is the+ only transport in baikai that expresses all six canonical levels exactly, and+ a test asserts each one reaches the command line verbatim.++### Fixed++- `baikai-openai`: `Response.responseId` was always `Nothing` on the Chat+ Completions transport, although every compatible host sends a top-level `id`+ on every streamed chunk. It now carries the identifier the host reported, on+ both the successful and the failed terminal.++### Changed++- **Breaking:** `baikai-openai`: `Baikai.Provider.OpenAI.Sse`'s four streaming+ entry points — `openaiSseStream`, `openaiSseStreamValue`,+ `openaiSseStreamValueWithHeaders`, and `sseFromResponse` — take a new+ `ResponseMetadata -> IO ()` callback immediately before the existing per-chunk+ callback. It fires exactly once, before the first chunk, on both the success+ and the non-2xx path — a failed call's correlation identifier is if anything+ more valuable than a successful one's. Pass `(\_ -> pure ())` to keep the+ previous behaviour. The callback is separate rather than a widening of the+ per-chunk one because that one runs once per SSE frame and response-level data+ does not belong on that path.++- **Breaking:** `baikai-openai`: `Baikai.Provider.OpenAI.Api`'s `RawChunk` gains+ `model` and `responseId` fields, both `Maybe Text`. Code that pattern-matches+ on `RawChunk` is unaffected; code that constructs one with record syntax must+ add them.++- **Breaking:** `baikai-openai`: `Baikai.Provider.OpenAI.Shape`'s+ `shapeRequestBody`, `streamRequestBody`, and `injectThinkingShape` now return+ `(Aeson.Value, ThinkingTranslation)` instead of a bare body. Take `fst` to+ keep the previous value. The description has to travel out of the shaping step+ because nothing downstream can recompute it: it depends on the host's+ `ThinkingFormat`, which only the compat lookup knows. **No request body+ changed** — every one of the seven shapes puts exactly the same bytes on the+ wire as before.++- **Breaking:** `baikai-openai`: `codexInteractiveCommand` now returns+ `Either AgentRenderError (FilePath, [String])` and `launchCodexInteractive`+ returns `IO (Either AgentRenderError InteractiveLaunchResult)`. A request+ whose `safety` is a non-empty `ClaudeAllowedTools` list — which `codex` has+ no flag for — is refused with `SafetyNotExpressible AgentCodex`, quoting the+ rejected tools and suggesting `CodexSandbox` or `DefaultSafety`. Previously+ the allow-list was silently discarded and Codex was started with its default+ sandbox. The same `Left`/`Right` reading applies, `DefaultSafety` and an+ empty allow-list are never refused, and no previously rendered argument+ vector changed. Callers must handle the refusal branch.++ Both changes make the interactive surface honor the same contract as the new+ unattended surface: a safety policy the chosen provider cannot express fails+ visibly instead of silently becoming a weaker policy. Downstream consumers+ must adapt before upgrading; the known one is `shinzui/seihou`, whose+ `Seihou.CLI.AgentLaunchExec` module builds interactive launch requests.++## [baikai-trace-otel 0.3.0.3] - 2026-08-05++### Added++- `baikai-trace-otel`: the sink attaches an evidence record's salient fields to+ the open span as flat attributes (`baikai.evidence.run_id`,+ `baikai.evidence.call_id`, `baikai.evidence.strength`, the two digests, and+ `gen_ai.response.model` only when the provider actually reported one) rather+ than serialising the record into one blob. A `CallEvidence` event neither+ opens nor closes a span.++### Changed++- `baikai-trace-otel`: widened its `baikai` bound to admit `0.5`. No API change.++## [baikai-effectful 0.3.0.3] - 2026-08-05++### Changed++- Widened its `baikai` bound to admit `0.5`. No API change; the package's+ own surface is untouched.++## [baikai-kit 0.1.0.4] - 2026-08-05++### Changed++- Widened its `baikai` bound to admit `0.5`. No API change; the package's+ own surface is untouched.++## [baikai-agent 0.1.0.0] - 2026-08-05++### Added++- `baikai-agent`: **new package** (`0.1.0.0`) holding the unattended+ coding-agent runner. `Baikai.Agent.Run.runAgentCommand` takes an+ `AgentRunRequest` and an already-rendered `AgentCommand` and spawns the tool+ with no terminal and no human present. It delivers the prompt on standard+ input and closes the handle, drains standard output and standard error+ concurrently so a chatty agent cannot deadlock on a full pipe, retains at most+ `outputLimit` bytes per stream while reading and discarding the excess, and+ honors the three output disciplines. Preconditions run before any spawn: a+ missing working directory is `WorkingDirMissing` and unset or empty declared+ variables are `MissingEnvironment`, listing all of them at once. On timeout+ the child's whole process group is interrupted, given a grace period, and then+ terminated, so the agent's own child processes go with it; the failure reports+ the configured limit. A non-zero exit code is a successful run carrying that+ code, not a failure. The runner consumes an already-rendered `AgentCommand`+ and never imports a vendor renderer, so it is exercised entirely with+ hand-written argument vectors. Its POSIX-signal escalation is conditional on a+ non-Windows build.++- `baikai-agent`: new exposed module `Baikai.Agent.Config`, the layered+ configuration layer. `resolveAgentJob` resolves one named job across five+ layers — built-in defaults, the operator file, the repository file, the+ environment, then command-line overrides, later layers winning — and returns+ the resolved `AgentJob` together with a report attributing every value to the+ file, line, and column it came from. `agentJobRequest` converts a job into an+ `AgentRunRequest`, taking the prompt at call time. `listAgentJobs` enumerates+ configured job names, sorted, each attributed to the highest-precedence scope+ defining it. `defaultAgentConfigPaths` locates+ `$XDG_CONFIG_HOME/baikai/agents.kdl` (or `$HOME/.config/baikai/agents.kdl`)+ and `./.baikai/agents.kdl`, with no upward search through parent directories.++ The **policy ceiling** is loaded by a separate function, `loadAgentCeiling`,+ against a separate source list containing the operator file and nothing else:+ no repository file, environment variable, or command-line override can raise+ it. `applyCeilingToJob` refuses an over-broad request with `CeilingRejected`+ rather than clamping it. With no operator file the ceiling is+ `defaultAgentCeiling`. `safety.provider-args` is classified secret and renders+ as `<redacted>` in any report or structured error.++ New dependencies: `settei`, `settei-env`, `settei-kdl`, and+ `settei-optparse-applicative` (all `^>=0.2`, published on Hackage at+ `0.2.0.0`), plus `containers` and `filepath`. `settei-formats` is deliberately+ excluded, because it bundles Dhall loading and repository configuration is+ untrusted input here.++- `baikai-agent`: the **`baikai` executable**, with the `agent run`,+ `agent show`, and `agent list` commands, and the `Baikai.Agent.Cli` module+ that implements them. A shell script now invokes one stable command, supplies+ a prompt on standard input, and selects Claude Code or Codex entirely through+ configuration.++ `agent run` resolves the named job, caps it against the operator ceiling,+ renders it through the vendor renderer for its provider, and spawns it. The+ agent's own exit code passes through unchanged; Baikai's own failures use 64+ and above following the `sysexits` convention — 64 for a usage error or an+ empty prompt, 69 when the executable could not be started, 70 for malformed+ output, 75 for a timeout, 77 for a policy refusal, and 78 for a configuration+ problem. The prompt comes from `--prompt-stdin`, `--prompt-file`, or+ `--prompt`, which are mutually exclusive, and is decoded as UTF-8 explicitly+ rather than through the handle's locale encoding.++ `agent show` performs the whole pipeline except spawning and prints each+ resolved value with the file, line, and column it came from, the policy+ ceiling in force and where it was read, and the exact argument vector that+ would be spawned — with `<redacted>` in place of any raw provider argument. A+ job whose policy is refused prints its configuration first and then the+ refusal. `agent list` enumerates configured jobs and the scope each came from.++ Every Baikai diagnostic goes to standard error. The agent's own output follows+ the job's output mode, so `response=$(baikai agent run job)` yields the+ agent's answer alone for a capturing job. `--set KEY=VALUE` overrides one+ setting of the selected job through `settei`'s own command-line source, so an+ override is attributed with the same fidelity as a file. `--json` emits+ exactly one JSON object per command.++ New dependencies for `baikai-agent`: `baikai-claude`, `baikai-openai`, and+ `optparse-applicative`. The provider packages are needed only so that+ `renderJobCommand`, the single provider dispatch point in the codebase, can+ reach both renderers. This is the first dependency in the workspace from+ `baikai-agent` onto the provider packages, so `baikai-agent` now publishes+ after all three of `baikai`, `baikai-claude`, and `baikai-openai`.++ The user guide `docs/user/unattended-agent-runs.md` documents the whole+ surface: the three commands with their flags, exit codes, and stream+ discipline; the KDL job format and layer precedence; the operator ceiling and+ redaction; the capability mapping tables for both tools; and a before-and-after+ migration of a script that embeds provider flags today.+ `docs/user/cli-providers.md` and `docs/user/interactive-launches.md` link to+ it, and the capability mapping tables moved there from the latter.++- `baikai-agent`: **an unattended coding-agent run now produces model-call+ evidence.** This surface previously had no observability of any kind: no trace+ sink, no `Response`, no usage, no identifiers. An operator could show that a+ process started, exited, and took some time; they could not show which model+ ran, which reasoning effort was applied, or which agent session the run+ corresponds to in the vendor's records.++ A record carries the run and call identifiers, the resolved executable and its+ own reported version, digests over the request, the requested model and what+ the reasoning-effort request became on the command line, whatever the tool+ reported about itself, the outcome, and an honest strength.++ **A zero exit status never raises the strength.** On this surface that rule+ matters more than anywhere else, because almost every unattended run exits+ zero. A coding agent that exits zero has demonstrated that it ran, not which+ model served it.++ Two things gate what a record can prove, and neither is the default. The job+ must **capture** output — under `inherit` the agent's bytes went to the+ operator's terminal and baikai never held them — and the tool must be+ configured to print a structured format, which means `--output-format json`+ for `claude` or `--json` for `codex exec` through the job's `provider-args`.+ Without both, the tool's session identifier, model, and token counts are+ genuinely unavailable and the record says `"unobserved"` rather than inferring+ anything. A timed-out run records `aborted`; a run that never started records+ nothing at all.++- **Breaking:** `baikai-agent`: `Baikai.Agent.Run.runAgentCommand` takes two new+ leading arguments and returns the new outcome type:+ `Maybe EvidenceRequest -> ThinkingTranslation -> AgentRunRequest -> AgentCommand -> IO AgentRunOutcome`.+ A caller who wants the previous behaviour passes `Nothing` and+ `Baikai.Evidence.noThinkingRequested` and reads the `outcome` field; that path+ is byte-for-byte what it was, and costs what it cost — no digest is computed,+ no call identifier is generated, and the tool is not invoked a second time to+ read its version.++- `baikai-agent`: `baikai agent run` gains `--evidence-file PATH` and+ `--run-id TEXT`. Supplying neither leaves the run on the pre-existing path at+ the pre-existing cost; supplying either turns recording on, with the job's own+ name standing in as the run identifier when only a destination is given. The+ file is written atomically — a staging file beside the destination, then a+ rename — so a reader polling the path never sees a half-written object, and it+ is never appended to. A failed write is reported on standard error and never+ changes the exit code, because the agent's own status is what a calling script+ branches on. `docs/user/unattended-agent-runs.md` documents both options and,+ more importantly, what the record does and does not prove.++- `baikai-agent`: `baikai agent run` gains `--require-evidence STRENGTH`, taking+ `requested_only`, `correlated`, `model_observed`, or `fully_observed` — the+ same words a record's `strength` field spells, so what one record showed can+ be passed back as the next run's requirement. A job whose configuration cannot+ produce evidence of at least that strength is refused before anything is+ spawned, exiting 77 — the code a ceiling violation and an inexpressible safety+ policy already use, so a script branching on 77 needs no new case.++## [baikai-claude 0.4.0.1] - 2026-07-30++### Fixed++- Widened the `crypton` bound from `^>=1.0` to `>=1.0 && <1.2` so consumers can+ build `baikai-claude` alongside packages that require `crypton` 1.1.x (for+ example `pg-migrate-1.1.0.0`), which previously had no solvable build plan.+ The only `crypton` use is `Crypto.Hash` (`Digest`, `SHA256`) in+ `Baikai.Provider.Claude.Transport`, whose API is identical across the 1.0/1.1+ boundary. No API change.++## [baikai 0.4.1.0] - 2026-07-20++### Changed++- Version bump only; no library API or code changes. Released so the umbrella+ release tag `baikai-0.4.1.0` names a fresh core version alongside the breaking+ `baikai-claude` / `baikai-openai` 0.4.0.0 releases, matching the tag+ convention downstream consumers pin against.++## [baikai-claude 0.4.0.0] - 2026-07-20++### Changed++- **Breaking:** `claudeCliCommand` now takes the `Options` record and forwards+ `Options.thinking` to batch `claude -p` as `--effort <level>` (`minimal`+ collapses to `low`, matching the interactive launcher and the claude CLI's+ lack of a `minimal` value). `thinking = Nothing` emits no effort flag, keeping+ existing argv byte-for-byte. The added parameter is a PVP-major signature+ change.++## [baikai-openai 0.4.0.0] - 2026-07-20++### Changed++- **Breaking:** `codexCliCommand` now takes the `Options` record and forwards+ `Options.thinking` to `codex exec` as `-c model_reasoning_effort=<level>` for+ all six effort levels. `thinking = Nothing` emits no override, keeping+ existing argv byte-for-byte. The added parameter is a PVP-major signature+ change.++## [baikai 0.4.0.0] - 2026-07-20++### Added++- Added `ThinkingXHigh` and `ThinkingMax` to the exported `ThinkingLevel`+ vocabulary and added a defaulted `InteractiveLaunchRequest.effort` field.+ Extending the closed sum type is a PVP-major API change for downstream+ exhaustive matches.++## [baikai-claude 0.3.0.2] - 2026-07-20++### Added++- Added `--effort` rendering to interactive Claude Code launches and preserved+ `xhigh` / `max` on native adaptive Anthropic API requests, with larger fixed+ budgets for manual-thinking models.++### Changed++- Bumped the internal `baikai` dependency bound to `^>=0.4.0` for the+ baikai 0.4.0.0 release.++## [baikai-openai 0.3.0.2] - 2026-07-20++### Added++- Added `model_reasoning_effort` overrides to interactive Codex launches and+ preserved `xhigh` / `max` in native OpenAI request JSON; non-native+ OpenAI-compatible request shapes continue to clamp them to `high`.++### Changed++- Bumped the internal `baikai` dependency bound to `^>=0.4.0` for the+ baikai 0.4.0.0 release.++## [baikai-trace-otel 0.3.0.2] - 2026-07-20++### Changed++- Bumped the internal `baikai` dependency bound to `^>=0.4.0` for the+ baikai 0.4.0.0 release. No API changes.++## [baikai-effectful 0.3.0.2] - 2026-07-20++### Changed++- Bumped the internal `baikai` dependency bound to `^>=0.4.0` for the+ baikai 0.4.0.0 release. No API changes.++## [baikai-kit 0.1.0.3] - 2026-07-20++### Changed++- Bumped the internal `baikai` dependency bound to `^>=0.4.0` for the+ baikai 0.4.0.0 release. No API changes.++## [baikai 0.3.1.0] - 2026-07-15++### Added++- Added `claude-sonnet-5` to the Anthropic model catalog (1M context window,+ 128k max output, `tool_call` + reasoning).+- Added the `gpt-5.6` family — `gpt-5.6`, `gpt-5.6-luna`, `gpt-5.6-sol`, and+ `gpt-5.6-terra` — to the OpenAI model catalog (chat-completions with+ `tool_call` support).++### Changed++- Corrected `claude-sonnet-4-5` context window to 1M tokens and+ `claude-sonnet-4-6` max output to 128k tokens in the catalog.+- Added PVP-compliant upper bounds to all previously-unbounded library and+ executable dependencies.++## [baikai-claude 0.3.0.1] - 2026-07-15++### Changed++- Added PVP-compliant upper bounds to all previously-unbounded library and+ executable dependencies.++## [baikai-openai 0.3.0.1] - 2026-07-15++### Changed++- Added PVP-compliant upper bounds to all previously-unbounded library and+ executable dependencies.++## [baikai-trace-otel 0.3.0.1] - 2026-07-15++### Changed++- Added PVP-compliant upper bounds to all previously-unbounded library and+ executable dependencies.++## [baikai-effectful 0.3.0.1] - 2026-07-15++### Changed++- Added PVP-compliant upper bounds to all previously-unbounded library and+ executable dependencies.++## [baikai-kit 0.1.0.2] - 2026-07-15++### Changed++- Added PVP-compliant upper bounds to all previously-unbounded library and+ executable dependencies.++## [baikai 0.3.0.0] - 2026-07-03++### Added++- Added the documented record-update bases `emptyOptions`, `emptyContext`,+ `emptyModel`, `emptyResponse`, `emptyTool`, `emptyTextContent`,+ `emptyThinkingContent`, `emptyToolCall`, `emptyImageContent`,+ `emptyEmbeddingModel`, plus zero-valued bases `zeroUsage`, `zeroCost`,+ `zeroCostBreakdown`, and `zeroModelCost`.+- Added `firstEmbedding`, a total accessor for OpenAI-compatible embedding+ responses.+- Added `responseError`, `errorResponse`, `httpError`, and+ `parseRetryAfterSeconds` for the in-band error contract.++### Changed++- **Breaking:** Constructors for evolvable records are no longer exported:+ `Options`, `Context`, `Model`, `OpenAICompletionsCompat`,+ `AnthropicMessagesCompat`, and `InteractiveLaunchRequest` are built from+ exported base values plus record updates.+- **Breaking:** The `_X` base values are deprecated in favor of the new+ `empty*` and `zero*` names; the aliases remain for this release.+- **Breaking:** Removed `unModel`; use `mkModel` or `emptyModel` record+ updates.+- **Breaking:** Renamed `InteractiveLaunchRequest.model` to `modelId`.+- **Breaking:** `Response.latencyMs` and trace event `latencyMs` fields are+ now `Int`.+- **Breaking:** `completeRequest` / `completeRequestWith` no longer throw+ `BaikaiError` for unregistered API tags; they return an error-shaped+ `Response`.+- **Breaking:** CLI providers now report subprocess/decode/provider failures+ in-band as error-shaped `Response`s.+- **Breaking:** `errorTerminal` now requires a `BaikaiError`, enforcing+ structured error details for `EventError` construction sites.+- Documented that `Baikai.Prelude` is a convenience module outside the PVP+ stability contract and that `.Internal` modules have no compatibility+ guarantees.++### Fixed++- Empty embedding `data` arrays now produce a typed `decodeError` instead of+ crashing on an empty vector.+- The model-fetch JSON renderer now delegates string escaping to aeson.+- The model generator now fails on sanitized Haskell identifier collisions+ instead of rendering duplicate bindings.+- Live HTTP status, `Retry-After`, and network-failure classification now+ works on both API providers.+- `content_filter` / Anthropic refusals terminate as classified `EventError`+ terminals, and `liftCompleteToStream` preserves error-shaped responses.++## [baikai-claude 0.3.0.0] - 2026-07-03++### Changed++- **Breaking:** `Baikai.Provider.Claude.ErrorClass` moved to+ `Baikai.Provider.Claude.Internal.ErrorClass`.+- **Breaking:** `mapRequest` and pure request-shaping helpers moved from+ `Baikai.Provider.Claude.Api` to+ `Baikai.Provider.Claude.Internal.Request`.+- **Breaking:** `ClaudeCliConfig` and `ClaudeInteractiveConfig` constructors+ are no longer exported; start from their default config values and update+ fields.+- **Breaking:** CLI and interactive `extraArgs` fields are now `[Text]`.++## [baikai-openai 0.3.0.0] - 2026-07-03++### Changed++- **Breaking:** `Baikai.Provider.OpenAI.ErrorClass` moved to+ `Baikai.Provider.OpenAI.Internal.ErrorClass`.+- **Breaking:** `mapRequest` and pure request-shaping helpers moved from+ `Baikai.Provider.OpenAI.Api` to+ `Baikai.Provider.OpenAI.Internal.Request`.+- **Breaking:** `CodexCliConfig` and `CodexInteractiveConfig` constructors are+ no longer exported; start from their default config values and update fields.+- **Breaking:** CLI and interactive `extraArgs` fields are now `[Text]`.++## [baikai-trace-otel 0.3.0.0] - 2026-07-03++### Changed++- Updated the `baikai` dependency bound to `^>=0.3.0`.+- Adjusted to the core trace event `latencyMs :: Int` type.++## [baikai-effectful 0.3.0.0] - 2026-07-03++### Changed++- Updated the `baikai` dependency bound to `^>=0.3.0`.++## [baikai-kit 0.1.0.1] - 2026-07-03++### Changed++- Updated the `baikai` dependency bound to `^>=0.3.0`.++## [baikai 0.2.0.0] - 2026-06-21++### Added++- `Usage`, `Cost`, and `CostBreakdown` now have `Semigroup`/`Monoid`+ instances that add field-by-field, plus `sumUsage :: Foldable f => f+ Usage -> Usage`, so callers can total per-call usage and cost.+ `reasoningTokens` combines as presence-wins (`Nothing` only when both+ operands are `Nothing`).+- A categorised error model: `BaikaiError` is now a record carrying an+ `ErrorCategory` (`AuthError`, `RateLimited`, `ContextOverflow`,+ `InvalidRequest`, `TransientError`, `DecodeFailure`, `ProcessFailure`,+ `ProviderUnavailable`, `OtherError`), an optional HTTP `httpStatus`, a+ `retryAfterSeconds` hint, and a subprocess `exitCode`. New smart+ constructors (`providerError`, `invalidRequest`, `decodeError`,+ `processError`, `rateLimited`, `authError`, `providerUnavailable`),+ the `isRetryable` predicate, and the pure `classifyHttpStatus` /+ `classifyHttpStatusWithBody` helpers let callers implement retry+ policy without parsing error text. `ErrorCategory` and `BaikaiError`+ serialize to JSON.+- `Response` and the streaming `EventError`'s `TerminalPayload` now+ carry `errorInfo :: Maybe BaikaiError`, so a failed `completeRequest`+ (or a drained stream) exposes the structured category/retry hint+ in-band. `Baikai.Stream.Event` gains `doneTerminal` / `errorTerminal`+ constructors.++### Changed++- **Breaking:** `BaikaiError`'s four flat constructors+ (`ProviderError`, `RequestInvalid`, `DecodeError`, `ProcessError`)+ were replaced by the record above. Migrate by lowercasing to the+ smart constructors — `ProviderError "x"` becomes `providerError "x"`,+ `ProcessError n "x"` becomes `processError n "x"`, etc.+- **Breaking:** `Baikai.Stream.Event.TerminalPayload` and+ `Baikai.Response.Response` gained an `errorInfo` field; build+ `TerminalPayload` via `doneTerminal` / `errorTerminal`.++### Fixed++- Restored JSON decoding for `BaikaiError` values with omitted optional+ metadata fields.++## [baikai-claude 0.2.0.0] - 2026-06-21++### Added++- The Anthropic API and `claude -p` CLI providers now classify failures+ into the typed `BaikaiError` categories: HTTP errors (via the caught+ `servant-client` `ClientError`) map status/`Retry-After`/body onto+ `AuthError` / `RateLimited` / `ContextOverflow` / `InvalidRequest` /+ `TransientError`, and mid-stream Anthropic `error` events are+ classified by their error type. The result is surfaced on+ `Response.errorInfo`.++## [baikai-openai 0.2.0.0] - 2026-06-21++### Added++- The OpenAI/OpenAI-compatible API and `codex exec` CLI providers now+ classify failures into the typed `BaikaiError` categories the same way+ as `baikai-claude` (HTTP `ClientError` for status-based errors,+ streamed error text for mid-stream errors), surfaced on+ `Response.errorInfo`.++## [baikai-trace-otel 0.2.0.0] - 2026-06-21++### Changed++- Updated the `baikai` dependency bound to `^>=0.2.0` for compatibility with+ the `baikai 0.2.0.0` breaking API release.++## [baikai-effectful 0.2.0.0] - 2026-06-21++### Changed++- Updated the `baikai` dependency bound to `^>=0.2.0` for compatibility with+ the `baikai 0.2.0.0` breaking API release.++## [baikai 0.1.1.0] - 2026-06-12++### Added++- Added provider-agnostic `ResponseFormat` support on `Options`, including+ plain JSON-object mode and named JSON-schema mode.+- Added `Baikai.Embedding`, an OpenAI `/v1/embeddings` client for text+ embeddings.++## [baikai-claude 0.1.1.0] - 2026-06-12++### Added++- Mapped baikai `ResponseFormat` options onto Anthropic `output_config` for+ Claude API requests.+- Exported `mapRequest` for request-mapping tests and downstream inspection.++## [baikai-openai 0.1.1.0] - 2026-06-12++### Added++- Mapped baikai `ResponseFormat` options onto OpenAI Chat Completions+ `response_format`.+- Exported `mapRequest` for request-mapping tests and downstream inspection.++## [baikai-effectful 0.1.0.0] - 2026-06-12++### Added++- Initial release: effectful binding for baikai with the `Baikai` dynamic+ effect, `complete`, `streamCollect`, `streamEach`, and registry-backed+ interpreters.++## [baikai 0.1.0.0] - 2026-06-04++### Added++- Initial release: unified Haskell interface for working with multiple AI+ providers. Core modules including `Baikai`, `Baikai.Prelude`, `Baikai.Api`,+ `Baikai.Provider`, `Baikai.Provider.Registry`, `Baikai.Response`,+ `Baikai.Stream`, `Baikai.Tool`, `Baikai.Trace`, and the cost/usage modules.+- Depends on released `streamly` (`>=0.11 && <0.13`) and `streamly-core`+ (`>=0.3 && <0.5`) from Hackage, so all dependencies resolve from Hackage.++## [baikai-claude 0.1.0.0] - 2026-06-04++### Added++- Initial release: Anthropic Claude providers for the baikai abstraction,+ wrapping the `claude` package for both the Anthropic API and the `claude -p`+ CLI (`Baikai.Provider.Claude.Api`, `.Cli`, `.Interactive`).++## [baikai-openai 0.1.0.0] - 2026-06-04++### Added++- Initial release: OpenAI providers for the baikai abstraction, wrapping the+ `openai` package for OpenAI's Chat Completions API+ (`Baikai.Provider.OpenAI.Api`, `.Cli`, `.Interactive`).++## [baikai-trace-otel 0.1.0.0] - 2026-06-04++### Added++- Initial release: OpenTelemetry `TraceSink` adapter for baikai+ (`Baikai.Trace.Sink.OpenTelemetry`), emitting one OTel span per provider call+ with GenAI semantic-convention attributes plus baikai cost and latency.
baikai-openai.cabal view
@@ -1,17 +1,21 @@-cabal-version: 3.4-name: baikai-openai-version: 0.5.0.0-synopsis: OpenAI providers for the baikai abstraction+cabal-version: 3.4+name: baikai-openai+version: 0.6.0.0+synopsis: OpenAI providers for the baikai abstraction description:- Wraps the openai Haskell package as a Baikai Provider for OpenAI's Chat Completions API.+ OpenAI-compatible backends for baikai: Chat Completions over SSE against OpenAI and+ any host that emulates it, the codex exec batch provider, a launcher for interactive+ Codex sessions, and the renderer for unattended codex runs driven by baikai-agent. -category: AI-license: BSD-3-Clause-license-file: LICENSE-author: Nadeem Bitar-maintainer: nadeem@gmail.com-copyright: (c) 2026 Nadeem Bitar-build-type: Simple+category: AI+license: BSD-3-Clause+license-file: LICENSE+author: Nadeem Bitar+maintainer: nadeem@gmail.com+copyright: (c) 2026 Nadeem Bitar+build-type: Simple+tested-with: GHC ==9.12.4+extra-doc-files: CHANGELOG.md common common-options ghc-options:@@ -52,6 +56,7 @@ Baikai.Provider.OpenAI.Interactive Baikai.Provider.OpenAI.Internal.ErrorClass Baikai.Provider.OpenAI.Internal.Request+ Baikai.Provider.OpenAI.Internal.Stream Baikai.Provider.OpenAI.Shape Baikai.Provider.OpenAI.Sse Baikai.Provider.OpenAI.Transport@@ -60,7 +65,7 @@ autogen-modules: Paths_baikai_openai build-depends: , aeson ^>=2.2- , baikai ^>=0.5.0+ , baikai ^>=0.6.0 , base >=4.20 && <5 , base64-bytestring ^>=1.2 , bytestring ^>=0.12@@ -73,6 +78,7 @@ , lens ^>=5.3 , openai ^>=2.5 , process ^>=1.6+ , scientific ^>=0.3 , servant-client ^>=0.20 , streamly >=0.11 && <0.13 , streamly-core >=0.3 && <0.5@@ -87,8 +93,12 @@ main-is: Main.hs other-modules: CliEvidenceSpec+ Contract ErrorClassSpec EvidenceSpec+ LifecycleSpec+ MidStreamSpec+ PublicSurfaceSpec ReasoningSpec ShapeSpec SseSpec@@ -96,7 +106,7 @@ build-depends: , aeson- , baikai ^>=0.5.0+ , baikai ^>=0.6.0 , baikai-openai , base >=4.20 && <5 , bytestring@@ -108,6 +118,7 @@ , http-client , http-types , lens ^>=5.3+ , network , openai , servant-client , stm@@ -117,4 +128,5 @@ , temporary , text ^>=2.1 , time+ , tls , vector
src/Baikai/Provider/OpenAI/Agent.hs view
@@ -25,6 +25,7 @@ import Baikai.Agent ( AgentCapability (..), AgentCommand (..),+ AgentOutputFormat (..), AgentPromptTransport (..), AgentProvider (..), AgentRenderError (..),@@ -100,6 +101,7 @@ ["exec"] <> modelArgs req <> effortArgs req+ <> outputFormatArgs req <> sandbox <> ["--cd", req ^. #workingDir] <> extraDirArgs req@@ -149,12 +151,16 @@ AgentEditWorkspace -> Right ["--sandbox", "workspace-write"] AgentFullAccess -> Right ["--sandbox", "danger-full-access"] --- | @codex exec@ has no tool allow-list flag, so a request that--- restricts tools is refused rather than run with unrestricted tools. A--- caller who narrows the tool set and gets a run with every tool--- available has been given more authority than they asked for, which is--- the silent downgrade this surface exists to prevent. The message names--- the alternative so the error is actionable.+-- | @codex exec@ has no tool allow-list flag, so a request that names+-- tool grants is refused rather than run without them. A caller who+-- granted a tool set and gets a run that ignores the list has been given+-- something other than what they asked for, which is the silent+-- substitution this surface exists to prevent. The message names the+-- alternative so the error is actionable.+--+-- The operator's ceiling runs first, so a job that both grants a tool+-- the operator forbids /and/ selects Codex hears about the policy+-- problem — the one the operator can fix — rather than this one. toolRestrictionGuard :: AgentRunRequest -> Either AgentRenderError () toolRestrictionGuard req = case req ^. #safety . #allowedTools of [] -> Right ()@@ -166,6 +172,19 @@ \sandbox mode, or pass an explicit provider argument if your operator \ \policy permits raw arguments" )++-- | Ask @codex exec@ for machine-readable output.+--+-- @codex exec --json@ prints its events to standard output as JSONL,+-- which is the shape+-- 'Baikai.Provider.Cli.Internal.parseCodexJsonlStream' already parses;+-- without it the tool prints a transcript meant for a person and an+-- evidence record can observe nothing. There is no @text@ flag to+-- render, because that is the default.+outputFormatArgs :: AgentRunRequest -> [String]+outputFormatArgs req = case req ^. #outputFormat of+ TextFormat -> []+ JsonFormat -> ["--json"] -- | A blank model value must not produce @--model ""@. modelArgs :: AgentRunRequest -> [String]
src/Baikai/Provider/OpenAI/Api.hs view
@@ -1,1326 +1,89 @@-{-# LANGUAGE LambdaCase #-}---- | Provider wrapping the @openai@ package's Chat Completions API.------ Call 'register' once (typically from @main@) to install the--- 'Baikai.Api.OpenAIChatCompletions' handler into the baikai--- provider registry. After registration, any 'Baikai.Model.Model'--- whose 'Baikai.Api.api' tag is 'OpenAIChatCompletions' dispatches--- through this handler.------ The handler resolves 'Baikai.Options.apiKey' when present, falling--- back to the host-specific env var from--- 'Baikai.Auth.defaultApiKeyEnvForBaseUrl'. Unknown hosts require an--- explicit key source.------ EP-3 promotes streaming to the primary entry point. The handler--- exposes a 'streamly' 'Stream' of 'AssistantMessageEvent' values--- bridged from a local SSE transport. Requests start as the SDK's--- typed 'OpenAI.V1.Chat.Completions.CreateChatCompletion' value, then--- 'Baikai.Provider.OpenAI.Shape.streamRequestBody' rewrites the raw--- JSON body for OpenAI-compatible host quirks before--- 'Baikai.Provider.OpenAI.Sse.openaiSseStreamValueWithHeaders' sends--- it with cached transport settings and caller headers. Streaming--- responses are parsed from raw 'Aeson.Value' chunks so partial--- tool-call deltas may omit fields such as @id@ and @function.name@.------ The synchronous 'complete' field is derived via--- 'streamingComplete', so callers that drain the stream get the--- same fully-assembled 'Response' they had before.-module Baikai.Provider.OpenAI.Api- ( register,- registerWithRegistry,- openaiChatProvider,- openaiChatStream,- openaiChatStreamWith,- SseDriver,- openaiStrength,- RawChunk (..),- RawToolDelta (..),- parseChunk,- TagScanState (..),- _TagScanState,- scanThinkTags,- Assembler (..),- emptyAssembler,- translate,- closeOpenStream,-- -- * Usage mapping-- -- Exposed for tests; may move behind an .Internal namespace in a later plan.- RawUsage (..),- parseUsage,- rawUsageToUsage,- )-where--import Baikai.Api (Api (..))-import Baikai.Compat (OpenAICompletionsCompat (requiresThinkingAsText))-import Baikai.Content qualified as Content-import Baikai.Context (Context (..))-import Baikai.Cost (zeroCost)-import Baikai.Cost.Pricing qualified as Pricing-import Baikai.Error (BaikaiError, invalidRequest, providerError)-import Baikai.Evidence qualified as Ev-import Baikai.Evidence.Build qualified as Build-import Baikai.Message qualified as Msg-import Baikai.Model (Model, openaiCompletionsCompatFor)-import Baikai.Options (Options (..))-import Baikai.Provider.OpenAI.Internal.ErrorClass (classifyException)-import Baikai.Provider.OpenAI.Internal.Request (mapRequest)-import Baikai.Provider.OpenAI.Shape (describeThinkingShape, streamRequestBody)-import Baikai.Provider.OpenAI.Sse (ResponseMetadata, capturedHeaderNames, openaiSseStreamValueWithHeaders)-import Baikai.Provider.OpenAI.Transport qualified as Transport-import Baikai.Provider.Registry- ( ApiProvider (..),- ProviderRegistry,- registerApiProvider,- registerApiProviderWith,- )-import Baikai.StopReason qualified as Stop-import Baikai.Stream (streamingComplete)-import Baikai.Stream.Event- ( AssistantMessageEvent (..),- BlockEndPayload (..),- DeltaPayload (..),- IndexPayload (..),- StartPayload (..),- ThinkingEndPayload (..),- ToolCallEndPayload (..),- doneTerminal,- errorTerminal,- )-import Baikai.Usage qualified as Usage-import Control.Applicative ((<|>))-import Control.Concurrent (forkIO)-import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)-import Control.Exception (SomeAsyncException (..), SomeException, fromException, throwIO, try)-import Control.Lens ((%~), (&), (.~), (^.))-import Data.Aeson (Value (..), (.:?))-import Data.Aeson qualified as Aeson-import Data.Aeson.Key qualified as AesonKey-import Data.Aeson.KeyMap qualified as KeyMap-import Data.Aeson.Types qualified as Aeson-import Data.CaseInsensitive qualified as CI-import Data.Generics.Labels ()-import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Data.IntMap.Strict (IntMap)-import Data.IntMap.Strict qualified as IntMap-import Data.Map.Strict (Map)-import Data.Map.Strict qualified as Map-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import Data.Text qualified as Text-import Data.Text.Encoding qualified as Text-import Data.Time.Clock (UTCTime, getCurrentTime)-import Data.Vector (Vector)-import Data.Vector qualified as Vector-import Data.Version (showVersion)-import GHC.Generics (Generic)-import Network.HTTP.Types.Header (RequestHeaders)-import Numeric.Natural (Natural)-import Paths_baikai_openai qualified as Paths-import Servant.Client qualified as Client-import Streamly.Data.Stream (Stream)-import Streamly.Data.Stream qualified as Stream---- | Install the OpenAI Chat Completions handler into the registry.-register :: IO ()-register = registerApiProvider openaiChatProvider---- | First-class OpenAI Chat Completions provider value. Use with--- 'registerApiProviderWith' or 'newProviderRegistryFrom' for explicit--- registries.-openaiChatProvider :: ApiProvider-openaiChatProvider =- ApiProvider- { apiTag = OpenAIChatCompletions,- stream = openaiChatStream,- complete = streamingComplete openaiChatStream,- -- Runs the real shaping function and keeps only its description,- -- so the gate's answer and the wire's behaviour cannot disagree.- describeThinking = \m opts ->- describeThinkingShape (openaiCompletionsCompatFor m) opts- }---- | Install the OpenAI Chat Completions handler into an explicit registry.-registerWithRegistry :: ProviderRegistry -> IO ()-registerWithRegistry reg =- registerApiProviderWith- reg- openaiChatProvider-{-# DEPRECATED registerWithRegistry "use registerApiProviderWith reg openaiChatProvider" #-}---- | Streaming producer for the OpenAI Chat Completions API.------ Forks one worker thread per call that drives--- 'OpenAI.createChatCompletionStream' (the raw 'Aeson.Value'--- variant, not the typed one — see module docs for why). The--- worker pushes raw chunk values onto a 'Chan' terminated by--- 'Nothing'; the consumer translates each chunk into zero or more--- baikai 'AssistantMessageEvent' values and terminates with exactly--- one 'EventDone' or 'EventError'.-openaiChatStream ::- Model -> Context -> Options -> Stream IO AssistantMessageEvent-openaiChatStream = openaiChatStreamWith liveSseDriver---- | How a call physically reaches the host.------ The arguments are exactly those of--- 'Baikai.Provider.OpenAI.Sse.openaiSseStreamValueWithHeaders', which is--- what 'liveSseDriver' is. A test passes a driver that replays a--- recorded response through the same--- 'Baikai.Provider.OpenAI.Sse.sseFromResponse' the live one uses, so the--- request shaping, header allow-list, status classification, and chunk--- decoding under test are all the real implementations and only the--- socket is missing.------ The request body arrives as an argument rather than inside a per-call--- record, so a test driver can capture exactly what went out without--- this module exporting the record that also holds the resolved API key.-type SseDriver =- Client.ClientEnv ->- RequestHeaders ->- Aeson.Value ->- (ResponseMetadata -> IO ()) ->- (Either BaikaiError Aeson.Value -> IO ()) ->- IO ()--liveSseDriver :: SseDriver-liveSseDriver = openaiSseStreamValueWithHeaders---- | 'openaiChatStream' over an explicit transport driver.-openaiChatStreamWith ::- SseDriver -> Model -> Context -> Options -> Stream IO AssistantMessageEvent-openaiChatStreamWith driver m ctx opts =- Stream.concatEffect $ do- setupResult <- trySync (prepareCall m ctx opts)- let setup = either (Left . exceptionToError) id setupResult- case setup of- Left err -> Stream.fromList <$> immediateError m opts err- Right call -> do- ch <- newChan :: IO (Chan (Maybe (Either BaikaiError RawChunk)))- tref <- newIORef False- mref <- newIORef Nothing- _ <- forkIO (worker driver call mref ch)- startTime <- getCurrentTime- -- The request body is the envelope the two digests commit to:- -- it is exactly the JSON this call is about to put on the wire.- -- Credentials are not in it -- they travel in the headers built- -- separately by 'Transport.requestHeaders'.- mkEvidence <-- Build.prepareEvidence- m- opts- Ev.TransportHttpApi- (call ^. #thinking)- (call ^. #requestBody)- startTime- let initialState =- ProducerState- { chan = ch,- pending = [EventStart StartPayload {partial = skeletonStart m startTime, responseId = Nothing}],- assembler = emptyAssembler m startTime,- finished = False,- terminalRef = tref,- metadataRef = mref,- evidence = mkEvidence- }- pure (Stream.unfoldrM step initialState)--skeletonStart :: Model -> UTCTime -> Msg.Message-skeletonStart _m start =- Msg.AssistantMessage- Msg.AssistantPayload- { Msg.content = Vector.empty,- Msg.usage = Usage.zeroUsage,- Msg.stopReason = Stop.Stop,- Msg.errorMessage = Nothing,- Msg.timestamp = Just start- }---- | Per-call prepared values.-data OpenAICall = OpenAICall- { clientEnv :: !Client.ClientEnv,- requestHeaders :: !RequestHeaders,- timeoutMs :: !(Maybe Int),- requestBody :: !Aeson.Value,- -- | What the caller's reasoning-effort preference became on this- -- request, as 'streamRequestBody' described it. Carried from here- -- rather than recomputed at the terminal: only the shaping step- -- knows which of the seven host wire shapes was used.- thinking :: !Ev.ThinkingTranslation- }- deriving stock (Generic)--prepareCall :: Model -> Context -> Options -> IO (Either BaikaiError OpenAICall)-prepareCall m ctx opts = case mapRequest m ctx opts of- Left e -> pure (Left (invalidRequest e))- Right req -> do- let url = case m ^. #baseUrl of- "" -> "https://api.openai.com"- u -> u- key <- Transport.resolveKey url opts- env <- Transport.getClientEnvCached url- let compat = openaiCompletionsCompatFor m- (body, translation) = streamRequestBody compat opts req- headers = Transport.requestHeaders key m opts- pure- ( Right- OpenAICall- { clientEnv = env,- requestHeaders = headers,- timeoutMs = opts ^. #timeoutMs,- requestBody = body,- thinking = translation- }- )---- | A loose summary of one streamed chunk. The raw 'Aeson.Value' is--- pre-parsed into the fields we care about; unknown fields are--- ignored. Missing fields are 'Nothing' (we tolerate partial--- tool-call deltas).-data RawChunk = RawChunk- { contentDelta :: !(Maybe Text),- reasoningDelta :: !(Maybe Text),- finishReason :: !(Maybe Text),- toolDeltas :: ![RawToolDelta],- usage :: !(Maybe RawUsage),- -- | The model the host says produced this chunk, from the chunk's- -- top-level @model@ field. 'Nothing' means the host did not report- -- one — never that it reported the configured model.- model :: !(Maybe Text),- -- | The host's identifier for this response, from the chunk's- -- top-level @id@ field.- responseId :: !(Maybe Text)- }- deriving stock (Show, Generic)--data RawToolDelta = RawToolDelta- { index :: !(Maybe Int),- id_ :: !(Maybe Text),- name :: !(Maybe Text),- args :: !(Maybe Text)- }- deriving stock (Show, Generic)--data RawUsage = RawUsage- { inputTokens :: !Natural,- outputTokens :: !Natural,- cacheReadTokens :: !Natural,- reasoningTokens :: !(Maybe Natural)- }- deriving stock (Show, Generic)--worker ::- SseDriver ->- OpenAICall ->- IORef (Maybe ResponseMetadata) ->- Chan (Maybe (Either BaikaiError RawChunk)) ->- IO ()-worker driver call metaRef ch = do- r <-- trySync- $ Transport.runWithTimeout (call ^. #timeoutMs)- $ driver- (call ^. #clientEnv)- (call ^. #requestHeaders)- (call ^. #requestBody)- (writeIORef metaRef . Just)- $ \case- Left be -> writeChan ch (Just (Left be))- Right val -> case parseChunk val of- Left err -> writeChan ch (Just (Left (providerError (Text.pack err))))- Right chunk -> writeChan ch (Just (Right chunk))- case r of- Right Nothing -> pure ()- Right (Just be) -> writeChan ch (Just (Left be))- Left e -> writeChan ch (Just (Left (exceptionToError e)))- writeChan ch Nothing---- | Aeson parser tolerant of partial tool-call fields.-parseChunk :: Value -> Either String RawChunk-parseChunk = Aeson.parseEither $ Aeson.withObject "ChatCompletionChunk" $ \o -> do- choices <- o .:? "choices"- let firstChoice :: Maybe Aeson.Object- firstChoice = case choices of- Just (Aeson.Array a)- | Vector.length a > 0 ->- case Vector.head a of- Aeson.Object obj -> Just obj- _ -> Nothing- _ -> Nothing- (contentDelta, reasoningDelta, finishR, toolDeltas) <- case firstChoice of- Nothing -> pure (Nothing, Nothing, Nothing, [])- Just ch -> do- finish <- ch .:? "finish_reason"- delta <- ch .:? "delta"- case delta of- Nothing -> parseMessageObject ch finish- Just (Aeson.Object dObj) -> do- cd <- dObj .:? "content"- let rd = reasoningText dObj- tc <- dObj .:? "tool_calls"- let tds = parseToolCallDeltas tc- pure (cd, rd, finish, tds)- _ -> parseMessageObject ch finish- usageM <- o .:? "usage"- let ru = case usageM of- Just (Aeson.Object uObj) -> parseUsage uObj- _ -> Nothing- pure- RawChunk- { contentDelta = contentDelta,- reasoningDelta = reasoningDelta,- finishReason = finishR,- toolDeltas = toolDeltas,- usage = ru,- -- Read as a lookup yielding 'Maybe' rather than a required- -- field: chunks are decoded as raw JSON precisely because- -- compatible hosts vary, and a host that omits either of these- -- has reported nothing, which is not a decode failure.- model = lookupText "model" o,- responseId = lookupText "id" o- }--parseMessageObject ::- Aeson.Object ->- Maybe Text ->- Aeson.Parser (Maybe Text, Maybe Text, Maybe Text, [RawToolDelta])-parseMessageObject ch finish = do- msg <- ch .:? "message"- case msg of- Just (Aeson.Object mObj) -> do- cd <- mObj .:? "content"- pure (cd, reasoningText mObj, finish, [])- _ -> pure (Nothing, Nothing, finish, [])--reasoningText :: Aeson.Object -> Maybe Text-reasoningText obj =- lookupText "reasoning_content" obj <|> lookupText "reasoning" obj--parseToolCallDeltas :: Maybe Value -> [RawToolDelta]-parseToolCallDeltas = \case- Just (Aeson.Array v) -> Vector.toList (Vector.mapMaybe oneDelta v)- _ -> []- where- oneDelta :: Value -> Maybe RawToolDelta- oneDelta = \case- Aeson.Object o ->- let funcObj :: Maybe Aeson.Object- funcObj = case lookupField "function" o of- Just (Aeson.Object f) -> Just f- _ -> Nothing- getName = funcObj >>= lookupText "name"- getArgs = funcObj >>= lookupText "arguments"- in Just- RawToolDelta- { index = fromInt <$> lookupField "index" o,- id_ = lookupText "id" o,- name = getName,- args = getArgs- }- _ -> Nothing--parseUsage :: Aeson.Object -> Maybe RawUsage-parseUsage o =- case Aeson.parseEither pUsage o of- Right u -> Just u- Left _ -> Nothing- where- pUsage obj = do- i <- obj .:? "prompt_tokens"- out <- obj .:? "completion_tokens"- ptd <- obj .:? "prompt_tokens_details"- ctd <- obj .:? "completion_tokens_details"- let cached = case ptd of- Just (Aeson.Object p) -> case lookupField "cached_tokens" p of- Just (Aeson.Number n) -> truncate n- _ -> 0 :: Natural- _ -> 0- reasoning = case ctd of- Just (Aeson.Object c) -> case lookupField "reasoning_tokens" c of- Just (Aeson.Number n) -> Just (truncate n)- _ -> Nothing- _ -> Nothing- pure- RawUsage- { inputTokens = fromMaybe 0 i,- outputTokens = fromMaybe 0 out,- cacheReadTokens = cached,- reasoningTokens = reasoning- }--lookupField :: Text -> Aeson.Object -> Maybe Value-lookupField k = KeyMap.lookup (AesonKey.fromText k)---- Pull a Text-valued field out of an Aeson object; tolerates--- absent or non-Text values by returning 'Nothing'.-lookupText :: Text -> Aeson.Object -> Maybe Text-lookupText k o = case lookupField k o of- Just (Aeson.String t) -> Just t- _ -> Nothing--fromInt :: Value -> Int-fromInt = \case- Aeson.Number n -> truncate n- _ -> 0---- ============================================================--- Streamly state machine--- ============================================================--data ProducerState = ProducerState- { chan :: !(Chan (Maybe (Either BaikaiError RawChunk))),- pending :: ![AssistantMessageEvent],- assembler :: !Assembler,- finished :: !Bool,- terminalRef :: !(IORef Bool),- -- | Where the worker leaves the response-level metadata it captured- -- before the first chunk. Read on this side rather than pushed- -- through 'chan' so the channel keeps carrying exactly one kind of- -- thing; 'absorbMetadata' folds it into the assembler.- metadataRef :: !(IORef (Maybe ResponseMetadata)),- -- | Everything about this call's evidence that was knowable before- -- the first byte came back, waiting on the terminal timestamp and- -- outcome. 'Nothing' when the caller did not ask for evidence.- -- 'sealTerminal' applies it.- evidence ::- !(Maybe (UTCTime -> Ev.CallStatus -> Maybe BaikaiError -> Ev.ModelCallEvidence))- }- deriving stock (Generic)--step :: ProducerState -> IO (Maybe (AssistantMessageEvent, ProducerState))-step s- | (e : rest) <- s ^. #pending = do- sealed <- sealTerminal s e- pure- ( Just- ( sealed,- s- & #pending .~ rest- & #finished .~ (s ^. #finished || terminal sealed)- )- )- | s ^. #finished = pure Nothing- | otherwise = do- mRaw <- readChan (s ^. #chan)- -- After the read, because the worker writes the metadata before it- -- writes anything onto the channel: taking it here means every- -- path out of this branch — including the one where the channel- -- closed without ever producing a chunk — sees it.- ass0 <- absorbMetadata (s ^. #metadataRef) (s ^. #assembler)- let s' = s & #assembler .~ ass0- case mRaw of- Nothing -> do- alreadyTerminal <- readIORef (s' ^. #terminalRef)- if alreadyTerminal- then pure Nothing- else do- now <- getCurrentTime- let (events, ass') = closeOpenStream now Nothing ass0- case events of- [] -> pure Nothing- (e : rest) -> do- sealed <- sealTerminal (s' & #assembler .~ ass') e- pure- ( Just- ( sealed,- s'- & #pending .~ rest- & #assembler .~ ass'- & #finished .~ True- )- )- Just raw -> do- now <- getCurrentTime- let (events, ass') = translate raw ass0 now- case events of- [] -> step (s' & #assembler .~ ass')- (e : rest) -> do- sealed <- sealTerminal (s' & #assembler .~ ass') e- pure- ( Just- ( sealed,- s'- & #pending .~ rest- & #assembler .~ ass'- & #finished .~ (s' ^. #finished || terminal sealed)- )- )---- | Fold whatever response-level metadata the worker has captured into--- the assembler.------ Idempotent: applying it again overwrites the same fields with the same--- values, which is what lets 'step' call it on every pass rather than--- tracking whether it has run.-absorbMetadata :: IORef (Maybe ResponseMetadata) -> Assembler -> IO Assembler-absorbMetadata ref ass = do- meta <- readIORef ref- pure $ case meta of- Nothing -> ass- Just md ->- ass- & #httpStatus .~ Just (md ^. #httpStatus)- & #providerRequestId .~ correlationId md---- | The host's correlation identifier for this response, or a gateway's--- if the host's own is absent.------ The preference order is--- 'Baikai.Provider.OpenAI.Sse.capturedHeaderNames' itself, so the--- allow-list and the preference cannot disagree. Nothing is invented: a--- response carrying none of those headers leaves this 'Ev.Unobserved'.-correlationId :: ResponseMetadata -> Ev.Observed Text-correlationId md =- case [v | n <- capturedHeaderNames, Just v <- [lookup (headerName n) (md ^. #headers)]] of- (v : _) -> Ev.Observed v- [] -> Ev.Unobserved- where- headerName = Text.decodeUtf8 . CI.foldedCase---- | Mark the stream terminated and attach the call's evidence to the--- terminal event.------ Every event this producer yields goes through here, so the three--- sites that can produce a terminal -- a translated upstream chunk, a--- queued event drained from 'pending', and the channel-close path ----- all seal identically. Doing it here rather than inside 'translate'--- keeps that function pure; evidence construction needs 'IO' for the--- call identifier.------ A non-terminal event passes through unchanged, and so does a terminal--- on a call whose caller asked for no evidence.-sealTerminal :: ProducerState -> AssistantMessageEvent -> IO AssistantMessageEvent-sealTerminal s ev- | not (terminal ev) = pure ev- | otherwise = do- writeIORef (s ^. #terminalRef) True- case s ^. #evidence of- Nothing -> pure ev- Just finish -> do- now <- getCurrentTime- let st = statusOf ev- record = observeOpenAI st (s ^. #assembler) (finish now st (errorOf ev))- pure (withEvidence record ev)- where- statusOf = \case- EventDone {} -> Ev.CallSucceeded- _ -> Ev.CallFailed- -- The terminal payload already carries the normalized error, and- -- 'errorTerminal' guarantees it is 'Just' on every 'EventError'.- errorOf = \case- EventError p -> p ^. #errorInfo- _ -> Nothing- -- Set through the generic-lens label rather than a record update:- -- 'Baikai.Options.Options' also has an @evidence@ field, so under- -- @DuplicateRecordFields@ a bare @p {evidence = ...}@ has no unique- -- constructor to resolve to.- withEvidence record = \case- EventDone p -> EventDone (p & #evidence .~ Just record)- EventError p -> EventError (p & #evidence .~ Just record)- other -> other---- | Replace the observed fields of a prepared evidence record with what--- this call actually saw, and derive the strength from that.------ Only ever reached on a call whose caller asked for evidence, which is--- what makes it safe to compute the response commitment here: that--- digest hashes the model's entire output and is the most expensive--- thing this provider adds. The observations it reads were gathered--- unconditionally, because each costs a lookup and each improves the--- 'Baikai.Response.Response' for every caller.------ Nothing here consults the request. An observation the host did not--- make stays 'Ev.Unobserved'.-observeOpenAI ::- Ev.CallStatus -> Assembler -> Ev.ModelCallEvidence -> Ev.ModelCallEvidence-observeOpenAI st ass ev =- ev- & #endpoint . #implementationVersion .~ Just openaiPackageVersion- & #observedModel .~ (ass ^. #observedModel)- & #providerRequestId .~ (ass ^. #providerRequestId)- & #responseId .~ maybe Ev.Unobserved Ev.Observed (ass ^. #responseId)- & #usage .~ observedUsage ass- & #responseCommitment .~ responseCommitment st ass- & #strength .~ openaiStrength (ass ^. #observedModel) (ass ^. #providerRequestId)---- | How much an OpenAI-compatible evidence record proves, derived only--- from what was actually observed.------ No host in this ecosystem echoes the reasoning configuration it--- applied, so 'Ev.EvidenceFullyObserved' is unreachable on this--- transport. Reasoning-token counts in the usage block corroborate--- output volume; they are not a statement of which effort setting was in--- force and must not raise the strength.------ A successful HTTP status deliberately does not raise it either. A 200--- means the request was accepted, not that any particular model ran.-openaiStrength :: Ev.Observed Text -> Ev.Observed Text -> Ev.EvidenceStrength-openaiStrength observedModel providerRequestId =- case (observedModel, providerRequestId) of- (Ev.Observed _, Ev.Observed _) -> Ev.EvidenceModelObserved- (_, Ev.Observed _) -> Ev.EvidenceCorrelated- _ -> Ev.EvidenceRequestedOnly---- | The token accounting, but only if the host actually reported it.------ The assembler initialises 'usage' to zeroes, so reporting it--- unconditionally would tell a reader the host said this call consumed--- nothing — which for a call that failed before any usage arrived is a--- fabrication, and exactly what 'Ev.Observed' exists to stop.-observedUsage :: Assembler -> Ev.Observed Usage.Usage-observedUsage ass- | ass ^. #usageReported = Ev.Observed (finalUsage ass)- | otherwise = Ev.Unobserved---- | A commitment to what came back, on a call that produced a response.------ Left 'Ev.Unobserved' otherwise: a digest of an empty envelope is a--- real-looking value standing for a response that never arrived.-responseCommitment :: Ev.CallStatus -> Assembler -> Ev.Observed Text-responseCommitment Ev.CallSucceeded ass =- Ev.Observed (Ev.commitmentDigest (responseEnvelope ass))-responseCommitment _ _ = Ev.Unobserved---- | What that digest commits to: the assembled content blocks in order,--- the stop reason, and the reported usage.------ Deliberately the assembled response rather than the raw SSE bytes. Two--- identical responses split into different chunks must produce the same--- digest, and the chunk boundaries are a transport detail no verifier--- holding the response could reproduce. The key names match the--- Anthropic adapter's envelope so a consumer reading both does not have--- to learn two spellings.-responseEnvelope :: Assembler -> Value-responseEnvelope ass =- Aeson.object- [ "content" Aeson..= blocksInOrder ass,- "stop_reason" Aeson..= (ass ^. #stopReason),- "usage" Aeson..= finalUsage ass- ]---- | The version of this package, for the evidence record's endpoint--- identity. Read from the cabal-generated module rather than written as--- a literal, which becomes a lie the first time a release misses it.-openaiPackageVersion :: Text-openaiPackageVersion = Text.pack (showVersion Paths.version)--terminal :: AssistantMessageEvent -> Bool-terminal = \case- EventDone {} -> True- EventError {} -> True- _ -> False---- ============================================================--- Translation--- ============================================================--data TagMode- = TagVisible- | TagReasoning- deriving stock (Eq, Show, Generic)---- | Incremental scanner state for hosts that stream reasoning in--- assistant text using @<think>@ or @<thinking>@ tags.-data TagScanState = TagScanState- { tagMode :: !TagMode,- tagPending :: !Text- }- deriving stock (Eq, Show, Generic)--_TagScanState :: TagScanState-_TagScanState =- TagScanState- { tagMode = TagVisible,- tagPending = Text.empty- }---- | Split one text delta into reasoning fragments ('Left') and--- visible text fragments ('Right'), preserving partial tag prefixes--- across chunk boundaries.-scanThinkTags :: TagScanState -> Text -> (TagScanState, [Either Text Text])-scanThinkTags st input =- let (mode', pending', parts) = go (tagMode st) (tagPending st <> input) []- in (TagScanState {tagMode = mode', tagPending = pending'}, parts)- where- go mode txt acc =- case findTag mode txt of- Just (before, after, nextMode) ->- go nextMode after (appendPart mode before acc)- Nothing ->- let (emitNow, pending) = splitPending mode txt- in (mode, pending, appendPart mode emitNow acc)-- appendPart _ "" acc = acc- appendPart TagVisible t acc = acc <> [Right t]- appendPart TagReasoning t acc = acc <> [Left t]--findTag :: TagMode -> Text -> Maybe (Text, Text, TagMode)-findTag mode txt =- case earliest markers of- Nothing -> Nothing- Just (idx, marker) ->- Just- ( Text.take idx txt,- Text.drop (idx + Text.length marker) txt,- nextMode- )- where- (markers, nextMode) = case mode of- TagVisible -> (openingTags, TagReasoning)- TagReasoning -> (closingTags, TagVisible)- earliest =- foldr- ( \marker best ->- case Text.breakOn marker txt of- (_, "") -> best- (before, _) ->- let candidate = (Text.length before, marker)- in case best of- Nothing -> Just candidate- Just (oldIdx, _) | Text.length before < oldIdx -> Just candidate- _ -> best- )- Nothing--splitPending :: TagMode -> Text -> (Text, Text)-splitPending mode txt =- let suffix = longestTagPrefix (case mode of TagVisible -> openingTags; TagReasoning -> closingTags) txt- in (Text.dropEnd (Text.length suffix) txt, suffix)--longestTagPrefix :: [Text] -> Text -> Text-longestTagPrefix markers txt =- foldr longer Text.empty candidates- where- candidates =- [ suffix- | n <- [1 .. Text.length txt],- let suffix = Text.takeEnd n txt,- any (suffix `Text.isPrefixOf`) markers- ]- longer a b- | Text.length a > Text.length b = a- | otherwise = b--openingTags :: [Text]-openingTags = ["<think>", "<thinking>"]--closingTags :: [Text]-closingTags = ["</think>", "</thinking>"]---- | Translation state across one streaming call.-data Assembler = Assembler- { model :: !Model,- start :: !UTCTime,- -- | 'Just i' when a text block at baikai contentIndex @i@ is- -- currently open; 'Nothing' when no text block is open.- textOpen :: !(Maybe Int),- textAccum :: !Text,- textEverOpened :: !Bool,- reasoningOpen :: !(Maybe Int),- reasoningAccum :: !Text,- tagScanState :: !TagScanState,- -- | Maps OpenAI's per-call tool-call index to baikai's- -- 'contentIndex'.- toolIndexMap :: !(IntMap Int),- toolIdMap :: !(Map Text Int),- lastToolIdx :: !(Maybe Int),- -- | baikai contentIndex → (id, name).- toolMeta :: !(IntMap (Text, Text)),- -- | baikai contentIndex → accumulated arguments JSON.- toolArgs :: !(IntMap Text),- closed :: !(IntMap Content.AssistantContent),- nextContentIndex :: !Int,- usage :: !Usage.Usage,- stopReason :: !Stop.StopReason,- -- | 'True' once a chunk carrying @finish_reason@ has been- -- observed. The terminal 'EventDone' fires on channel close so- -- the post-@finish_reason@ usage chunk (when @include_usage@ is- -- enabled) has a chance to land.- finishSeen :: !Bool,- pendingError :: !(Maybe BaikaiError),- finishNote :: !(Maybe Text),- -- The five fields below are what this call /observed/, as distinct- -- from what it requested. They live here because this record is the- -- only state that survives from the first chunk to the last, and- -- because an observation that never arrived must stay- -- 'Ev.Unobserved' rather than falling back to the caller's- -- configuration.-- -- | The host's own correlation identifier for this call, from the- -- response headers.- providerRequestId :: !(Ev.Observed Text),- -- | The model identifier the host reported running, from the first- -- chunk that carried one. Never the configured model.- observedModel :: !(Ev.Observed Text),- -- | The host's identifier for this response, from the first chunk- -- that carried one.- responseId :: !(Maybe Text),- -- | The response's HTTP status. Recorded because the transport has- -- it; 'Baikai.Evidence.ModelCallEvidence' has no field for it, and- -- inventing one belongs to the vocabulary's plan, not to this- -- module.- httpStatus :: !(Maybe Int),- -- | Whether the host actually reported token counts, as opposed to- -- 'usage' still holding the zeroes it was initialised with. Without- -- this a failed call would claim the host reported consuming- -- nothing.- usageReported :: !Bool- }- deriving stock (Generic)--emptyAssembler :: Model -> UTCTime -> Assembler-emptyAssembler m s =- Assembler- { model = m,- start = s,- textOpen = Nothing,- textAccum = Text.empty,- textEverOpened = False,- reasoningOpen = Nothing,- reasoningAccum = Text.empty,- tagScanState = _TagScanState,- toolIndexMap = IntMap.empty,- toolIdMap = Map.empty,- lastToolIdx = Nothing,- toolMeta = IntMap.empty,- toolArgs = IntMap.empty,- closed = IntMap.empty,- nextContentIndex = 0,- usage = Usage.zeroUsage,- stopReason = Stop.Stop,- finishSeen = False,- pendingError = Nothing,- finishNote = Nothing,- providerRequestId = Ev.Unobserved,- observedModel = Ev.Unobserved,- responseId = Nothing,- httpStatus = Nothing,- usageReported = False- }--translate ::- Either BaikaiError RawChunk ->- Assembler ->- UTCTime ->- ([AssistantMessageEvent], Assembler)-translate chunk ass now- | Left be <- chunk =- let msg = finalMessage ass now (Just (be ^. #message)) Stop.ErrorReason- in ([EventError (errorTerminal Nothing (ass ^. #responseId) Stop.ErrorReason msg be)], ass)- | Right raw <- chunk =- let -- 0. Record what the host said about itself.- ass0 = observeChunk raw ass- -- 1. Apply field-based reasoning delta.- (reasoningEvents, ass1) = applyReasoningDelta (raw ^. #reasoningDelta) ass0- -- 2. Apply content delta (open text block if needed).- (textEvents, ass2) = applyContentDelta (raw ^. #contentDelta) ass1- -- 3. Apply tool-call deltas.- (toolEvents, ass3) = applyToolDeltas (raw ^. #toolDeltas) ass2- -- 4. Apply usage chunk if present.- ass4 = applyUsage (raw ^. #usage) ass3- -- 5. If finish_reason is set, close any open text/tool- -- blocks and stash the reason. EventDone is deferred- -- to channel close so the post-finish_reason usage- -- chunk has a chance to land.- (closeEvents, ass5) = case raw ^. #finishReason of- Just fr -> closeOnFinish fr ass4- Nothing -> ([], ass4)- in (reasoningEvents <> textEvents <> toolEvents <> closeEvents, ass5)---- | Record what the host reported about itself on this chunk.------ Both values come from the /first/ chunk that carries them and are--- never overwritten. Compatible hosts repeat both fields on every chunk--- and they are expected to agree; a host where they disagree is a--- genuine discovery worth recording rather than something to resolve--- silently by last-write-wins.------ A missing field means the host reported nothing, so the observation--- stays 'Ev.Unobserved'. The configured model is never substituted —--- that is the specific mistake 'Ev.Observed' exists to prevent.-observeChunk :: RawChunk -> Assembler -> Assembler-observeChunk raw ass =- ass- & #observedModel .~ firstObserved (ass ^. #observedModel) (raw ^. #model)- & #responseId .~ ((ass ^. #responseId) <|> (raw ^. #responseId))--firstObserved :: Ev.Observed a -> Maybe a -> Ev.Observed a-firstObserved (Ev.Observed a) _ = Ev.Observed a-firstObserved Ev.Unobserved m = maybe Ev.Unobserved Ev.Observed m--applyReasoningDelta ::- Maybe Text -> Assembler -> ([AssistantMessageEvent], Assembler)-applyReasoningDelta Nothing ass = ([], ass)-applyReasoningDelta (Just "") ass = ([], ass)-applyReasoningDelta (Just d) ass =- case ass ^. #reasoningOpen of- Just i ->- ( [ThinkingDelta DeltaPayload {contentIndex = i, delta = d}],- ass & #reasoningAccum %~ (<> d)- )- Nothing ->- let i = ass ^. #nextContentIndex- in ( [ThinkingStart IndexPayload {contentIndex = i}, ThinkingDelta DeltaPayload {contentIndex = i, delta = d}],- ass- & #reasoningOpen .~ Just i- & #reasoningAccum .~ d- & #nextContentIndex .~ (i + 1)- )--applyContentDelta ::- Maybe Text -> Assembler -> ([AssistantMessageEvent], Assembler)-applyContentDelta Nothing ass = ([], ass)-applyContentDelta (Just "") ass = ([], ass)-applyContentDelta (Just d) ass =- if requiresThinkingAsText (openaiCompletionsCompatFor (ass ^. #model))- then- let (tagState', parts) = scanThinkTags (ass ^. #tagScanState) d- (events, ass') = foldl' applyTaggedPart ([], ass & #tagScanState .~ tagState') parts- in (events, ass')- else applyVisibleTextDelta d ass--applyTaggedPart ::- ([AssistantMessageEvent], Assembler) ->- Either Text Text ->- ([AssistantMessageEvent], Assembler)-applyTaggedPart (acc, ass) = \case- Left reasoning ->- let (events, ass') = applyReasoningDelta (Just reasoning) ass- in (acc <> events, ass')- Right visible ->- let (events, ass') = applyVisibleTextDelta visible ass- in (acc <> events, ass')--applyVisibleTextDelta ::- Text -> Assembler -> ([AssistantMessageEvent], Assembler)-applyVisibleTextDelta "" ass = ([], ass)-applyVisibleTextDelta d ass =- case ass ^. #textOpen of- Just i ->- let (reasoningEvents, ass1) = closeOpenReasoning ass- in ( reasoningEvents <> [TextDelta DeltaPayload {contentIndex = i, delta = d}],- ass1 & #textAccum %~ (<> d)- )- Nothing ->- let (reasoningEvents, ass1) = closeOpenReasoning ass- i = ass1 ^. #nextContentIndex- in ( reasoningEvents <> [TextStart IndexPayload {contentIndex = i}, TextDelta DeltaPayload {contentIndex = i, delta = d}],- ass1- & #textOpen .~ Just i- & #textAccum .~ d- & #textEverOpened .~ True- & #nextContentIndex .~ (i + 1)- )--applyToolDeltas ::- [RawToolDelta] -> Assembler -> ([AssistantMessageEvent], Assembler)-applyToolDeltas [] ass = ([], ass)-applyToolDeltas deltas ass =- let (reasoningEvents, ass0) = closeOpenReasoning ass- (toolEvents, ass') = foldl' apply ([], ass0) deltas- in (reasoningEvents <> toolEvents, ass')- where- apply (acc, a) d =- let (events, a') = applyOneToolDelta d a- in (acc <> events, a')--applyOneToolDelta ::- RawToolDelta -> Assembler -> ([AssistantMessageEvent], Assembler)-applyOneToolDelta d ass =- let mOpenaiIdx = d ^. #index- mToolId = d ^. #id_- byIndex = mOpenaiIdx >>= \idx -> IntMap.lookup idx (ass ^. #toolIndexMap)- byId = mToolId >>= \tid -> Map.lookup tid (ass ^. #toolIdMap)- byLast =- case (mOpenaiIdx, mToolId) of- (Nothing, Nothing) -> ass ^. #lastToolIdx- _ -> Nothing- (baikaiIdx, ass1, opened) = case byIndex <|> byId <|> byLast of- Just i ->- ( i,- ass- & #toolIdMap %~ maybe id (`Map.insert` i) mToolId- & #lastToolIdx .~ Just i,- False- )- Nothing ->- let i = ass ^. #nextContentIndex- ass' =- ass- & #toolIndexMap %~ maybe id (`IntMap.insert` i) mOpenaiIdx- & #toolIdMap %~ maybe id (`Map.insert` i) mToolId- & #lastToolIdx .~ Just i- & #toolMeta %~ IntMap.insert i ("", "")- & #toolArgs %~ IntMap.insert i Text.empty- & #nextContentIndex .~ (i + 1)- in (i, ass', True)- -- Update metadata (id/name first delta only).- ass2 =- ass1- & #toolMeta- %~ IntMap.adjust- ( \(existingId, existingName) ->- ( maybe existingId (\x -> if Text.null existingId then x else existingId) (d ^. #id_),- maybe existingName (\x -> if Text.null existingName then x else existingName) (d ^. #name)- )- )- baikaiIdx- -- Append args if present.- argsDelta = fromMaybe "" (d ^. #args)- ass3 = ass2 & #toolArgs %~ IntMap.adjust (<> argsDelta) baikaiIdx- events0 = if opened then [ToolCallStart IndexPayload {contentIndex = baikaiIdx}] else []- events1 =- if Text.null argsDelta- then events0- else events0 <> [ToolCallDelta DeltaPayload {contentIndex = baikaiIdx, delta = argsDelta}]- in (events1, ass3)---- | Normalize OpenAI's inclusive usage counters into baikai's--- disjoint 'Usage.Usage' convention. OpenAI's @prompt_tokens@--- includes @prompt_tokens_details.cached_tokens@, so the cached count--- is subtracted out of 'Usage.inputTokens'. The subtraction is clamped--- at zero because 'Natural' subtraction throws on underflow and because--- OpenAI-compatible hosts can report inconsistent counters.--- 'Usage.totalTokens' is recomputed from the normalized parts;--- 'Usage.reasoningTokens' is a subset of 'Usage.outputTokens' and is--- not added to the total. OpenAI does not bill cache writes, so--- 'Usage.cacheWriteTokens' is always zero.-rawUsageToUsage :: RawUsage -> Usage.Usage-rawUsageToUsage u =- let prompt = u ^. #inputTokens- cached = u ^. #cacheReadTokens- out = u ^. #outputTokens- nonCached = if cached >= prompt then 0 else prompt - cached- in Usage.Usage- { Usage.inputTokens = nonCached,- Usage.outputTokens = out,- Usage.cacheReadTokens = cached,- Usage.cacheWriteTokens = 0,- Usage.reasoningTokens = u ^. #reasoningTokens,- Usage.totalTokens = nonCached + out + cached,- Usage.cost = zeroCost- }--applyUsage :: Maybe RawUsage -> Assembler -> Assembler-applyUsage Nothing ass = ass-applyUsage (Just u) ass =- ass- & #usage .~ rawUsageToUsage u- -- A host that sent a usage block reported its counts, even if every- -- one of them is zero. That is what distinguishes a reported zero- -- from silence in the evidence record.- & #usageReported .~ True---- | Close all open content blocks and stash the resolved stop--- reason; defer 'EventDone' to channel close.-closeOnFinish ::- Text -> Assembler -> ([AssistantMessageEvent], Assembler)-closeOnFinish finishReason ass =- let (tagEvents, ass0) = flushTagScanPending ass- (closeReasoning, ass1) = closeOpenReasoning ass0- (closeText, ass2) = closeOpenText ass1- (closeTools, ass3) = closeOpenTools ass2- (reason, note) = mapFinishReason finishReason- pending =- if reason == Stop.ErrorReason- then Just (providerError ("provider stopped the response: finish_reason=" <> finishReason))- else Nothing- ass4 =- ass3- & #stopReason .~ reason- & #finishSeen .~ True- & #pendingError .~ pending- & #finishNote .~ note- in (tagEvents <> closeReasoning <> closeText <> closeTools, ass4)--flushTagScanPending :: Assembler -> ([AssistantMessageEvent], Assembler)-flushTagScanPending ass =- let st = ass ^. #tagScanState- pending = tagPending st- ass0 = ass & #tagScanState .~ st {tagPending = Text.empty}- in case (tagMode st, pending) of- (_, "") -> ([], ass0)- (TagVisible, t) -> applyVisibleTextDelta t ass0- (TagReasoning, t) -> applyReasoningDelta (Just t) ass0--closeOpenReasoning :: Assembler -> ([AssistantMessageEvent], Assembler)-closeOpenReasoning ass = case ass ^. #reasoningOpen of- Nothing -> ([], ass)- Just i ->- let body = ass ^. #reasoningAccum- thinkingContent =- Content.ThinkingContent- { Content.thinking = body,- Content.signature = Nothing,- Content.redacted = False- }- block = Content.AssistantThinking thinkingContent- in ( [ThinkingEnd ThinkingEndPayload {contentIndex = i, content = thinkingContent}],- ass- & #reasoningOpen .~ Nothing- & #reasoningAccum .~ Text.empty- & #closed %~ IntMap.insert i block- )---- | Close the open text block, if any, by emitting a 'TextEnd' and--- storing the assembled content in 'closed'.-closeOpenText :: Assembler -> ([AssistantMessageEvent], Assembler)-closeOpenText ass = case ass ^. #textOpen of- Nothing -> ([], ass)- Just i ->- let body = ass ^. #textAccum- block = Content.AssistantText (Content.TextContent body)- in ( [TextEnd BlockEndPayload {contentIndex = i, content = body}],- ass- & #textOpen .~ Nothing- & #textAccum .~ Text.empty- & #closed %~ IntMap.insert i block- )---- | Close every open tool call by emitting 'ToolCallEnd' (with the--- fully parsed 'ToolCall') in index order.-closeOpenTools :: Assembler -> ([AssistantMessageEvent], Assembler)-closeOpenTools ass =- let openTools = IntMap.toAscList (ass ^. #toolArgs)- (events, ass') = foldl' closeOne ([], ass) openTools- in (events, ass')- where- closeOne (acc, a) (i, argsText) =- let (tid, tn) = fromMaybe ("", "") (IntMap.lookup i (a ^. #toolMeta))- decoded :: Value- decoded = case Aeson.eitherDecodeStrict (Text.encodeUtf8 argsText) of- Right v -> v- Left _ -> Aeson.Object mempty- tc =- Content.ToolCall- { Content.id_ = tid,- Content.name = tn,- Content.arguments = decoded- }- block = Content.AssistantToolCall tc- in ( acc <> [ToolCallEnd ToolCallEndPayload {contentIndex = i, toolCall = tc}],- a- & #closed %~ IntMap.insert i block- & #toolArgs %~ IntMap.delete i- & #toolMeta %~ IntMap.delete i- & #toolIdMap %~ (if Text.null tid then id else Map.delete tid)- & #lastToolIdx .~ Nothing- )--closeOpenStream ::- UTCTime -> Maybe BaikaiError -> Assembler -> ([AssistantMessageEvent], Assembler)-closeOpenStream now mErr ass- | ass ^. #finishSeen =- -- Channel closed cleanly after finish_reason.- let reason = ass ^. #stopReason- terminalErr =- (ass ^. #pendingError)- <|> if reason == Stop.ErrorReason- then Just (providerError "provider stopped the response with an error finish_reason")- else Nothing- msg = finalMessage ass now (fmap (^. #message) terminalErr) reason- terminalEvent = case terminalErr of- Just be -> EventError (errorTerminal Nothing (ass ^. #responseId) reason msg be)- Nothing -> EventDone (doneTerminal Nothing (ass ^. #responseId) reason msg)- in ([terminalEvent], ass)- | otherwise =- -- Channel closed without a finish_reason. Force-close any- -- still-open blocks and emit EventError. When the worker stored a- -- classified HTTP error ('Just be'), surface it structurally;- -- otherwise report the unexpected end of stream.- let (tagEvents, ass0) = flushTagScanPending ass- (closeReasoning, ass1) = closeOpenReasoning ass0- (closeText, ass2) = closeOpenText ass1- (closeTools, ass3) = closeOpenTools ass2- reason = Stop.ErrorReason- errText = case mErr of- Just be -> be ^. #message- Nothing -> "openai stream ended without finish_reason"- msg = finalMessage ass3 now (Just errText) reason- errInfo = fromMaybe (providerError errText) mErr- errEv = EventError (errorTerminal Nothing (ass3 ^. #responseId) reason msg errInfo)- in (tagEvents <> closeReasoning <> closeText <> closeTools <> [errEv], ass3)---- | The accumulated token counts with this model's price applied.------ Shared by the assistant message and the evidence record so the two--- cannot report different numbers for the same call.-finalUsage :: Assembler -> Usage.Usage-finalUsage ass =- let usageBare = ass ^. #usage- in usageBare & #cost .~ Pricing.computeCost (ass ^. #model) usageBare--finalMessage ::- Assembler -> UTCTime -> Maybe Text -> Stop.StopReason -> Msg.Message-finalMessage ass now errMsg sr =- let blocks = blocksInOrder ass- in Msg.AssistantMessage- Msg.AssistantPayload- { Msg.content = blocks,- Msg.usage = finalUsage ass,- Msg.stopReason = sr,- Msg.errorMessage = errMsg <|> (ass ^. #finishNote),- Msg.timestamp = Just now- }--blocksInOrder :: Assembler -> Vector Content.AssistantContent-blocksInOrder ass = Vector.fromList (IntMap.elems (ass ^. #closed))---- | Immediate error stream emitted when the request itself could not--- be built (e.g. message mapping failed).--- Nothing was sent, so there is no wire body to digest and the evidence--- commits to 'Build.dispatchEnvelope' instead -- see its documentation.-immediateError :: Model -> Options -> BaikaiError -> IO [AssistantMessageEvent]-immediateError m opts err = do- now <- getCurrentTime- let errText = err ^. #message- let msg =- Msg.AssistantMessage- Msg.AssistantPayload- { Msg.content = Vector.empty,- Msg.usage = Usage.zeroUsage,- Msg.stopReason = Stop.ErrorReason,- Msg.errorMessage = Just errText,- Msg.timestamp = Just now- }- ev <-- Build.minimalEvidence- m- opts- Ev.TransportHttpApi- Ev.noThinkingRequested- (Build.dispatchEnvelope m opts)- now- now- Ev.CallFailed- (Just err)- pure- [ EventStart StartPayload {partial = msg, responseId = Nothing},- EventError (errorTerminal ev Nothing Stop.ErrorReason msg err)- ]--mapFinishReason :: Text -> (Stop.StopReason, Maybe Text)-mapFinishReason r = case r of- "stop" -> (Stop.Stop, Nothing)- "length" -> (Stop.Length, Nothing)- "tool_calls" -> (Stop.ToolUse, Nothing)- "function_call" -> (Stop.ToolUse, Nothing)- "content_filter" -> (Stop.ErrorReason, Nothing)- _ -> (Stop.Stop, Just ("unrecognized finish_reason: " <> r))--trySync :: IO a -> IO (Either SomeException a)-trySync action = do- r <- try action- case r of- Left e- | Just (SomeAsyncException _) <- (fromException e :: Maybe SomeAsyncException) ->- throwIO e- | otherwise -> pure (Left e)- Right a -> pure (Right a)--exceptionToError :: SomeException -> BaikaiError-exceptionToError e = fromMaybe (classifyException e) (fromException e)+-- | Provider wrapping the @openai@ package's Chat Completions API.+--+-- Call 'register' once (typically from @main@) to install the+-- 'Baikai.Api.OpenAIChatCompletions' handler into the baikai+-- provider registry. After registration, any 'Baikai.Model.Model'+-- whose 'Baikai.Api.api' tag is 'OpenAIChatCompletions' dispatches+-- through this handler.+--+-- The handler resolves 'Baikai.Options.apiKey' when present, falling+-- back to the host-specific env var from+-- 'Baikai.Auth.defaultApiKeyEnvForBaseUrl'. Unknown hosts require an+-- explicit key source.+--+-- Streaming is the primary entry point. The handler exposes a+-- 'streamly' 'Stream' of 'AssistantMessageEvent' values bridged from a+-- local SSE transport. The synchronous @complete@ field is derived via+-- 'Baikai.Stream.streamingComplete', so callers that drain the stream+-- get the same fully-assembled 'Baikai.Response.Response'.+--+-- The machinery behind these three names — the transport driver seam,+-- the chunk decoders, the reasoning-tag scanner, the assembler and the+-- usage mapping — lives in "Baikai.Provider.OpenAI.Internal.Stream",+-- which carries no stability guarantees.+module Baikai.Provider.OpenAI.Api+ ( register,+ openaiChatProvider,+ openaiChatStream,+ )+where++import Baikai.Api (Api (..))+import Baikai.Context (Context)+import Baikai.Evidence qualified as Ev+import Baikai.Model (Model, openaiCompletionsCompatFor)+import Baikai.Options (Options)+import Baikai.Provider (ApiProvider, apiProvider)+import Baikai.Provider.OpenAI.Internal.Stream (liveSseDriver, openaiChatStreamWith)+import Baikai.Provider.OpenAI.Shape (describeThinkingShape)+import Baikai.Provider.Registry (registerApiProvider)+import Baikai.Stream.Event (AssistantMessageEvent)+import Control.Lens ((&), (.~), (^.))+import Data.Generics.Labels ()+import Streamly.Data.Stream (Stream)++-- | Install the OpenAI Chat Completions handler into the registry.+register :: IO ()+register = registerApiProvider openaiChatProvider++-- | First-class OpenAI Chat Completions provider value. Use with+-- 'Baikai.Provider.registerApiProviderWith' or+-- 'Baikai.Provider.newProviderRegistryFrom' for explicit registries.+openaiChatProvider :: ApiProvider+openaiChatProvider =+ apiProvider OpenAIChatCompletions openaiChatStream+ -- Runs the real shaping function and keeps only its description, so+ -- the gate's answer and the wire's behaviour cannot disagree.+ & #describeThinking+ .~ ( \m opts ->+ describeThinkingShape (openaiCompletionsCompatFor m) (m ^. #reasoning) opts+ )+ & #strengthCeiling .~ Ev.declaredStrength OpenAIChatCompletions++-- | Streaming producer for the OpenAI Chat Completions API.+--+-- Forks one worker thread per call that drives the local+-- OpenAI-compatible SSE transport, pushing classified errors and decoded+-- chunk values onto a bounded+-- 'Baikai.Provider.Internal.StreamWorker.FrameQueue'. The consumer+-- translates each chunk into zero or more baikai+-- 'AssistantMessageEvent' values, beginning with exactly one+-- 'Baikai.Stream.Event.EventStart' and terminating with exactly one+-- 'Baikai.Stream.Event.EventDone' or 'Baikai.Stream.Event.EventError'.+--+-- The queue is bounded at+-- 'Baikai.Provider.Internal.StreamWorker.frameQueueCapacity' frames, so+-- a consumer that stops pulling stops the socket read after at most that+-- many further frames rather than letting the worker drain a whole+-- generation nobody will read.+--+-- The worker runs under a bracket, so the connection comes back+-- immediately when the stream ends normally or when an exception reaches+-- the draining thread (@Ctrl-C@, 'System.Timeout.timeout', @cancel@),+-- and at the next major garbage collection when a consumer simply+-- abandons the stream. "Baikai.Provider.Internal.StreamWorker" documents+-- why those three strengths differ and how a caller stops+-- deterministically.+openaiChatStream ::+ Model -> Context -> Options -> Stream IO AssistantMessageEvent+openaiChatStream = openaiChatStreamWith liveSseDriver
src/Baikai/Provider/OpenAI/Cli.hs view
@@ -3,7 +3,8 @@ -- -- Call 'register' once (typically from @main@) to install the -- 'Baikai.Api.OpenAICompletionsCli' handler with default config.--- 'registerWith' accepts a caller-supplied 'CodexCliConfig'.+-- Register @codexCliProvider cfg@ to supply a caller-supplied+-- 'CodexCliConfig'. -- -- The 'Response' this provider returns carries whatever the tool -- reported about its own run: the token counts from the event stream's@@ -30,9 +31,6 @@ defaultCodexCliConfig, codexCliProvider, register,- registerWith,- registerWithRegistry,- registerWithRegistryAndConfig, ) where @@ -48,9 +46,8 @@ import Baikai.Provider.Cli.Internal qualified as Internal import Baikai.Provider.Registry ( ApiProvider (..),- ProviderRegistry,+ apiProviderWith, registerApiProvider,- registerApiProviderWith, ) import Baikai.Response qualified as Resp import Baikai.StopReason (StopReason (..))@@ -100,45 +97,23 @@ register = registerApiProvider (codexCliProvider defaultCodexCliConfig) -- | First-class Codex CLI provider value for a caller-supplied config.-codexCliProvider :: CodexCliConfig -> ApiProvider-codexCliProvider cfg =- ApiProvider- { apiTag = OpenAICompletionsCli,- stream = liftCompleteToStream (runCodexCli cfg),- complete = runCodexCli cfg,- -- The model plays no part: this transport's only reasoning- -- control is a command-line flag derived from Options alone.- describeThinking = \_ opts -> codexCliThinking opts- }---- | Install the Codex CLI handler with a caller-supplied config. ----- The Codex binary runs in batch mode. 'stream' wraps the batch+-- The Codex binary runs in batch mode. @stream@ wraps the batch -- output in a synthetic one-shot event stream -- (@EventStart, TextStart 0, TextDelta 0 body, TextEnd 0, EventDone@)--- emitted after the subprocess exits. 'complete' stays on the--- direct batch path so it preserves 'Response.latencyMs' rather than--- recomputing it from synthetic event timestamps. EP-3's Decision--- Log records the deviation from "complete = streamingComplete .--- stream".-registerWith :: CodexCliConfig -> IO ()-registerWith cfg = registerApiProvider (codexCliProvider cfg)-{-# DEPRECATED registerWith "use registerApiProvider (codexCliProvider cfg)" #-}---- | Install the Codex CLI handler with 'defaultCodexCliConfig' into an explicit--- registry.-registerWithRegistry :: ProviderRegistry -> IO ()-registerWithRegistry reg = registerWithRegistryAndConfig reg defaultCodexCliConfig-{-# DEPRECATED registerWithRegistry "use registerApiProviderWith reg (codexCliProvider defaultCodexCliConfig)" #-}---- | Install the Codex CLI handler with a caller-supplied config into an--- explicit registry.-registerWithRegistryAndConfig :: ProviderRegistry -> CodexCliConfig -> IO ()-registerWithRegistryAndConfig reg cfg =- registerApiProviderWith- reg- (codexCliProvider cfg)-{-# DEPRECATED registerWithRegistryAndConfig "use registerApiProviderWith reg (codexCliProvider cfg)" #-}+-- emitted after the subprocess exits. @complete@ stays on the+-- direct batch path so it preserves 'Baikai.Response.latencyMs' rather+-- than recomputing it from synthetic event timestamps.+codexCliProvider :: CodexCliConfig -> ApiProvider+codexCliProvider cfg =+ apiProviderWith+ OpenAICompletionsCli+ (liftCompleteToStream (runCodexCli cfg))+ (runCodexCli cfg)+ -- The model plays no part: this transport's only reasoning+ -- control is a command-line flag derived from Options alone.+ & #describeThinking .~ (\_ opts -> codexCliThinking opts)+ & #strengthCeiling .~ Ev.declaredStrength OpenAICompletionsCli modelArgs :: Model -> [String] modelArgs m = case Text.strip (m ^. #modelId) of
src/Baikai/Provider/OpenAI/Interactive.hs view
@@ -9,7 +9,11 @@ -- A safety policy Codex cannot express is refused before launch rather -- than dropped: both the pure command builder and the launcher return -- 'Either' 'AgentRenderError', and a 'Left' means no process was--- started.+-- started. Two things are refused: a tool allow-list, which Codex has no+-- flag for at all, and an approval policy the installed @codex@+-- generation does not accept — 'CodexApprovalUntrusted' and+-- 'CodexApprovalOnFailure', which are older spellings current releases+-- reject. module Baikai.Provider.OpenAI.Interactive ( CodexInteractiveConfig, executable,@@ -23,7 +27,7 @@ import Baikai.Agent (AgentProvider (..), AgentRenderError (..)) import Baikai.Interactive- ( CodexApprovalPolicy,+ ( CodexApprovalPolicy (..), CodexSandboxMode, InteractiveLaunchRequest, InteractiveLaunchResult,@@ -137,7 +141,19 @@ safetyArgs :: InteractiveLaunchRequest -> Either AgentRenderError [String] safetyArgs req = case req ^. #safety of DefaultSafety -> Right []- CodexSandbox sandbox approval -> Right (codexSafetyArgs sandbox approval)+ CodexSandbox sandbox approval+ | approvalAccepted approval -> Right (codexSafetyArgs sandbox approval)+ | otherwise ->+ Left+ ( SafetyNotExpressible+ AgentCodex+ ( "the installed codex CLI accepts only on-request and never for \+ \--ask-for-approval (codex 0.149.1); it rejects "+ <> renderCodexApprovalPolicy approval+ <> ", so the session was not started; use CodexApprovalOnRequest or \+ \CodexApprovalNever"+ )+ ) -- An empty allow-list restricts nothing, so there is nothing Codex -- fails to honor. Only a non-empty list is a restriction Codex -- cannot express. The asymmetry with the next case is deliberate.@@ -152,6 +168,29 @@ \default" ) )++-- | Whether the installed @codex@ generation accepts this approval+-- policy.+--+-- @codex --help@ at @codex-cli 0.149.1@ (verified 2026-08-27) lists+-- exactly two possible values for @--ask-for-approval@, @on-request@ and+-- @never@. @untrusted@ and @on-failure@ are older spellings the CLI+-- rejects with a usage error, which would surface as a @Right@ carrying+-- a non-zero exit code — a session that ran and failed — rather than as+-- the refusal this module promises.+--+-- Refused rather than quietly mapped onto @on-request@: silently+-- substituting a different approval policy would change the very thing+-- the caller asked for, which is the failure this module exists to+-- prevent. Which values the installed tool accepts is the vendor+-- adapter's knowledge, which is why the check lives here and not in the+-- core vocabulary.+approvalAccepted :: CodexApprovalPolicy -> Bool+approvalAccepted = \case+ CodexApprovalOnRequest -> True+ CodexApprovalNever -> True+ CodexApprovalUntrusted -> False+ CodexApprovalOnFailure -> False codexSafetyArgs :: CodexSandboxMode -> CodexApprovalPolicy -> [String] codexSafetyArgs sandbox approval =
src/Baikai/Provider/OpenAI/Internal/ErrorClass.hs view
@@ -4,14 +4,18 @@ -- not part of baikai's PVP-stable application surface. Names, types, -- and semantics here may change in minor releases. ----- 'classifyException' handles an exception thrown by the--- @servant-client@ HTTP layer; 'classifyErrorText' handles an error--- that arrives mid-stream as a plain text message.+-- Two entry points cover the two ways a failure reaches the provider.+-- 'classifyException' handles any exception the worker catches from the+-- transport — @http-client@, TLS and socket failures, all delegated to+-- "Baikai.Provider.Transport.Classify" so both providers classify them+-- identically. 'classifyErrorFrame' handles an in-band error frame: a+-- decoded SSE payload on a @2xx@ stream that reports a failure instead+-- of a completion chunk, which is how OpenRouter, DeepSeek and Together+-- report an upstream failure they only learned about after committing+-- to a @200@. module Baikai.Provider.OpenAI.Internal.ErrorClass ( classifyException,- classifyErrorText,- -- | Exposed for testing the HTTP-status mapping without a live call.- responseToError,+ classifyErrorFrame, ) where @@ -19,122 +23,137 @@ ( BaikaiError (..), ErrorCategory (..), bodyIndicatesOverflow,- decodeError,- httpError,- invalidRequest,- parseRetryAfterSeconds,+ classifyHttpStatusWithBody, providerError, )-import Control.Exception (SomeException, displayException, fromException)-import Data.ByteString (ByteString)-import Data.ByteString.Lazy qualified as LBS-import Data.CaseInsensitive qualified as CI-import Data.Foldable (toList)-import Data.Sequence (Seq)+import Baikai.Provider.Transport.Classify (classifyTransportException)+import Control.Applicative ((<|>))+import Control.Exception (SomeException, displayException)+import Data.Aeson (Value (..))+import Data.Aeson.Key qualified as Key+import Data.Aeson.KeyMap (KeyMap)+import Data.Aeson.KeyMap qualified as KeyMap+import Data.Maybe (fromMaybe)+import Data.Scientific (Scientific, toBoundedInteger) import Data.Text (Text) import Data.Text qualified as Text-import Data.Text.Encoding qualified as Text-import Data.Text.Encoding.Error qualified as Text-import Network.HTTP.Client qualified as HTTP-import Network.HTTP.Types.Status (statusCode)-import Servant.Client (ClientError, ResponseF (..))-import Servant.Client qualified as Servant-import Text.Read (readMaybe) --- | Convert any exception caught from the OpenAI SDK into a categorised--- 'BaikaiError'. Recognises @servant-client@ 'ClientError' and raw--- @http-client@ 'HttpException'; anything else degrades to a generic--- provider error carrying the displayed exception text.+-- | Convert any exception caught while driving the OpenAI-compatible+-- transport into a categorised 'BaikaiError'.+--+-- Recognised transport failures — every @http-client@ 'HttpException'+-- constructor, a raw socket 'IOException' from the body read, and a raw+-- or wrapped TLS exception — are classified by the shared core rule.+-- Anything else is not a transport failure at all (a programming error+-- in a callback, say) and degrades to a generic provider error carrying+-- the displayed exception text, so it is never reported as retryable. classifyException :: SomeException -> BaikaiError-classifyException ex- | Just clientErr <- fromException ex = fromClientError clientErr- | Just httpEx <- fromException ex = fromHttpException httpEx- | otherwise = providerError (Text.pack (displayException ex))+classifyException ex =+ fromMaybe+ (providerError (Text.pack (displayException ex)))+ (classifyTransportException ex) -fromClientError :: ClientError -> BaikaiError-fromClientError clientErr = case clientErr of- Servant.FailureResponse _req resp -> responseToError resp- Servant.DecodeFailure detail _ -> decodeError detail- Servant.UnsupportedContentType _ _ -> decodeError "unsupported content type in OpenAI response"- Servant.InvalidContentTypeHeader _ -> decodeError "invalid content-type header in OpenAI response"- Servant.ConnectionError exc ->- (providerError ("connection error: " <> Text.pack (displayException exc)))- { category = TransientError- }+-- | Classify an in-band error frame: a decoded SSE payload on a @2xx@+-- stream whose JSON reports a failure instead of a completion chunk.+--+-- Returns 'Nothing' for anything without an @error@ key, so an ordinary+-- chunk passes through untouched. Detection keys on @error@ alone and+-- not on the absence of @choices@, because OpenRouter sends both: its+-- mid-stream failure frame carries the error object /and/ a @choices@+-- array whose element has @finish_reason: "error"@.+--+-- Precedence inside the frame, most specific first: a numeric @code@ or+-- @status@ of 400 or more is the upstream HTTP status and is classified+-- as one (and recorded in 'httpStatus'); else a string @code@, then a+-- string @type@, is looked up in the vocabulary the compatible hosts+-- share; else the message text is phrase-sniffed; else 'OtherError'. The+-- message always becomes the error's 'message'.+classifyErrorFrame :: Value -> Maybe BaikaiError+classifyErrorFrame (Object o) = do+ errVal <- KeyMap.lookup "error" o+ inner <- case errVal of+ Object e -> Just e+ -- Some hosts send a bare string where the object is documented.+ String s -> Just (KeyMap.singleton "message" (String s))+ _ -> Nothing+ let msg =+ fromMaybe+ "provider sent an error frame without a message"+ (nonEmpty =<< stringField "message" inner)+ status = numberField "code" inner <|> numberField "status" inner+ byName =+ (stringField "code" inner >>= codeToCategory msg)+ <|> (stringField "type" inner >>= codeToCategory msg)+ cat = case status of+ Just n | n >= 400 -> classifyHttpStatusWithBody n Nothing msg+ _ -> fromMaybe (categoryFromMessage msg) byName+ Just (providerError msg) {category = cat, httpStatus = status}+classifyErrorFrame _ = Nothing -responseToError :: ResponseF LBS.ByteString -> BaikaiError-responseToError resp = httpError status retryAfter body- where- status = statusCode (responseStatusCode resp)- body = decodeLenient (LBS.toStrict (responseBody resp))- retryAfter = parseRetryAfter (responseHeaders resp)+nonEmpty :: Text -> Maybe Text+nonEmpty t = if Text.null (Text.strip t) then Nothing else Just t -parseRetryAfter :: Seq (CI.CI ByteString, ByteString) -> Maybe Int-parseRetryAfter headers = do- raw <- lookup (CI.mk "Retry-After") (toList headers)- parseRetryAfterSeconds (decodeLenient raw)+stringField :: Text -> KeyMap Value -> Maybe Text+stringField k o = case KeyMap.lookup (Key.fromText k) o of+ Just (String t) -> Just t+ _ -> Nothing -fromHttpException :: HTTP.HttpException -> BaikaiError-fromHttpException = \case- HTTP.InvalidUrlException url reason ->- invalidRequest (Text.pack (url <> ": " <> reason))- HTTP.HttpExceptionRequest _ content -> fromHttpExceptionContent content+-- | An integral JSON number only: a @code@ of @"429"@ as a string is a+-- code name, not a status, and is handled by 'codeToCategory'.+numberField :: Text -> KeyMap Value -> Maybe Int+numberField k o = case KeyMap.lookup (Key.fromText k) o of+ Just (Number n) -> toBoundedInteger (n :: Scientific)+ _ -> Nothing -fromHttpExceptionContent :: HTTP.HttpExceptionContent -> BaikaiError-fromHttpExceptionContent = \case- HTTP.StatusCodeException resp body ->- httpError- (statusCode (HTTP.responseStatus resp))- (parseRetryAfterHttp (HTTP.responseHeaders resp))- (decodeLenient body)- HTTP.ConnectionFailure e -> transient (Text.pack (displayException e))- HTTP.ConnectionTimeout -> transient "connection timeout"- HTTP.ResponseTimeout -> transient "response timeout"- HTTP.ConnectionClosed -> transient "connection closed"- HTTP.NoResponseDataReceived -> transient "no response data received"- HTTP.IncompleteHeaders -> transient "incomplete response headers"- other -> providerError (Text.pack (show other))+-- | The @code@ and @type@ vocabulary the OpenAI-compatible hosts share.+-- The message is threaded through only for the overflow special case,+-- where the category depends on what the request actually hit.+codeToCategory :: Text -> Text -> Maybe ErrorCategory+codeToCategory msg raw = case Text.toLower (Text.strip raw) of+ "rate_limit_error" -> Just RateLimited+ "rate_limit_exceeded" -> Just RateLimited+ "tokens" -> Just RateLimited+ "requests" -> Just RateLimited+ "too_many_requests" -> Just RateLimited+ "authentication_error" -> Just AuthError+ "permission_error" -> Just AuthError+ "invalid_api_key" -> Just AuthError+ "insufficient_quota" -> Just AuthError+ "billing_not_active" -> Just AuthError+ "account_deactivated" -> Just AuthError+ "context_length_exceeded" -> Just ContextOverflow+ "request_too_large" -> Just ContextOverflow+ "server_error" -> Just TransientError+ "overloaded_error" -> Just TransientError+ "engine_overloaded" -> Just TransientError+ "service_unavailable" -> Just TransientError+ "timeout" -> Just TransientError+ "upstream_error" -> Just TransientError+ "provider_error" -> Just TransientError+ "invalid_request_error" -> Just (overflowOr InvalidRequest)+ "model_not_found" -> Just (overflowOr InvalidRequest)+ "invalid_value" -> Just (overflowOr InvalidRequest)+ "unsupported_value" -> Just (overflowOr InvalidRequest)+ "missing_required_parameter" -> Just (overflowOr InvalidRequest)+ _ -> Nothing where- transient t = (providerError ("connection error: " <> t)) {category = TransientError}--parseRetryAfterHttp :: [(CI.CI ByteString, ByteString)] -> Maybe Int-parseRetryAfterHttp headers = do- raw <- lookup (CI.mk "Retry-After") headers- parseRetryAfterSeconds (decodeLenient raw)--decodeLenient :: ByteString -> Text-decodeLenient = Text.decodeUtf8With Text.lenientDecode+ overflowOr fallback+ | bodyIndicatesOverflow msg = ContextOverflow+ | otherwise = fallback --- | Best-effort classification of an OpenAI streamed error message,--- which arrives as plain text without an HTTP status. Returns 'Nothing'--- for empty text (the caller keeps the raw message and 'errorInfo'--- stays absent).-classifyErrorText :: Text -> Maybe BaikaiError-classifyErrorText t- | Just e <- classifySdkHttpText t = Just e- | Text.null (Text.strip t) = Nothing- | otherwise = Just (providerError t) {category = cat}+-- | The last resort: what the message text says, when the frame named no+-- code or type this classifier knows.+categoryFromMessage :: Text -> ErrorCategory+categoryFromMessage t+ | bodyIndicatesOverflow t = ContextOverflow+ | has "rate limit" || has "rate_limit" = RateLimited+ | has "overloaded" || has "server_error" || has "service unavailable" = TransientError+ | has "insufficient_quota"+ || has "invalid api key"+ || has "incorrect api key"+ || has "invalid_api_key" =+ AuthError+ | otherwise = OtherError where lower = Text.toLower t has needle = needle `Text.isInfixOf` lower- cat- | bodyIndicatesOverflow t = ContextOverflow- | has "rate limit" || has "rate_limit" = RateLimited- | has "overloaded" || has "server_error" || has "service unavailable" = TransientError- | has "insufficient_quota"- || has "invalid api key"- || has "incorrect api key"- || has "invalid_api_key" =- AuthError- | otherwise = OtherError--classifySdkHttpText :: Text -> Maybe BaikaiError-classifySdkHttpText raw = do- rest <- Text.stripPrefix "HTTP error " raw- let (codeText, afterCode) = Text.breakOn " " rest- code <- readMaybe (Text.unpack codeText)- let body = case Text.breakOn ": " afterCode of- (_, sepBody)- | not (Text.null sepBody) -> Text.drop 2 sepBody- _ -> ""- pure (httpError code Nothing body)
src/Baikai/Provider/OpenAI/Internal/Request.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedRecordDot #-} -- | Internal request mapping for the OpenAI Chat Completions provider. --@@ -18,7 +19,7 @@ import Baikai.Message qualified as Msg import Baikai.Model (Model, openaiCompletionsCompatFor) import Baikai.Options (Options (..))-import Baikai.ResponseFormat (ResponseFormat (..))+import Baikai.ResponseFormat (JsonSchemaFormat (..), ResponseFormat (..)) import Baikai.ThinkingLevel (ThinkingLevel (..)) import Baikai.Tool qualified as Tool import Control.Lens ((^.))@@ -39,7 +40,7 @@ import OpenAI.V1.ToolCall qualified as ToolCall -- ============================================================--- Request mapping (preserved from EP-2 with minor refactoring)+-- Request mapping: Context and Options onto the SDK's request record. -- ============================================================ mapRequest ::@@ -63,8 +64,14 @@ then Nothing else Just (Vector.map (mkOpenAITool compat) (ctx ^. #tools)) toolChoiceField = fmap mkOpenAIToolChoice (opts ^. #toolChoice)+ -- The model's capability is consulted before the host's wire+ -- shape, and for the same reason Shape.injectThinkingShape does+ -- it in that order: a host may speak a good reasoning dialect+ -- while the model selected on it cannot reason at all. reasoningEffortField =- applyThinkingFormat compat (opts ^. #thinking)+ if m ^. #reasoning+ then applyThinkingFormat compat (opts ^. #thinking)+ else Nothing responseFormatField = fmap (mkOpenAIResponseFormat compat) (opts ^. #responseFormat) pure@@ -74,8 +81,8 @@ Chat.max_completion_tokens = maxTokensField, Chat.temperature = opts ^. #temperature, Chat.top_p = opts ^. #topP,- Chat.stop = opts ^. #stopSequences,- Chat.seed = opts ^. #seed,+ Chat.stop = nonEmptyStops (opts ^. #stopSequences),+ Chat.seed = fmap fromIntegral (opts ^. #seed), Chat.frequency_penalty = opts ^. #frequencyPenalty, Chat.presence_penalty = opts ^. #presencePenalty, Chat.tools = toolsField,@@ -84,20 +91,27 @@ Chat.response_format = responseFormatField } +-- | The wire wants an absent field for "no stop sequences", and+-- 'Baikai.Options.stopSequences' says that with an empty list — the one+-- representation, where @Nothing@ and @Just []@ used to be two.+nonEmptyStops :: [Text] -> Maybe (Vector.Vector Text)+nonEmptyStops [] = Nothing+nonEmptyStops xs = Just (Vector.fromList xs)+ -- | Map a baikai 'ResponseFormat' onto the upstream OpenAI -- 'RF.ResponseFormat'. 'JsonObject' becomes plain-JSON mode; -- 'JsonSchema' becomes a named, optionally-strict schema. The -- schema 'Value' is forwarded verbatim. mkOpenAIResponseFormat :: OpenAICompletionsCompat -> ResponseFormat -> RF.ResponseFormat mkOpenAIResponseFormat _ JsonObject = RF.JSON_Object-mkOpenAIResponseFormat compat JsonSchema {name = n, schema = s, strict = st} =+mkOpenAIResponseFormat compat (JsonSchema f) = RF.JSON_Schema { RF.json_schema = RF.JSONSchema { RF.description = Nothing,- RF.name = n,- RF.schema = Just s,- RF.strict = if supportsStrictMode compat then Just st else Nothing+ RF.name = f.name,+ RF.schema = Just f.schema,+ RF.strict = if supportsStrictMode compat then Just f.strict else Nothing } } @@ -108,10 +122,17 @@ -- the SDK does not support natively. -- -- The non-OpenAI thinking formats (DeepSeek, OpenRouter, Together,--- Z.ai, Qwen) require additional top-level JSON keys the upstream--- @openai@ Haskell SDK does not expose. They are silently dropped on--- this revision; see the EP-5 Decision Log for the rationale and--- pointers to the workaround when one is needed.+-- Z.ai, Qwen) need top-level JSON keys the upstream @openai@ Haskell+-- SDK does not expose, so this function returns 'Nothing' for them.+-- They are __not__ dropped: 'Baikai.Provider.OpenAI.Shape.injectThinkingShape'+-- injects each host's own keys into the serialized body afterwards,+-- and it is the function that records what the level became. Nothing+-- here needs to, which is why this one returns a bare 'Maybe'.+--+-- The caller gates this on 'Baikai.Model.reasoning': a level on a model+-- that does not advertise reasoning support is dropped and recorded by+-- 'Baikai.Provider.OpenAI.Shape.injectThinkingShape', which sees the+-- same flag. applyThinkingFormat :: OpenAICompletionsCompat -> Maybe ThinkingLevel ->@@ -140,9 +161,8 @@ -- The default ('defaultOpenAICompletionsCompat') leaves strict -- unset, which OpenAI treats as the default-permissive behaviour; -- callers that want @strict: true@ on every tool can flip the field--- on their compat record (a future enhancement; currently we pass--- 'Nothing' even when 'supportsStrictMode' is 'True', matching the--- pre-EP-5 behaviour).+-- on their compat record (a future enhancement; this function passes+-- 'Nothing' even when 'supportsStrictMode' is 'True'). mkOpenAITool :: OpenAICompletionsCompat -> Tool.Tool -> OpenAITool.Tool mkOpenAITool _compat t = OpenAITool.Tool_Function
+ src/Baikai/Provider/OpenAI/Internal/Stream.hs view
@@ -0,0 +1,1350 @@+{-# LANGUAGE LambdaCase #-}++-- | __Internal module — no stability guarantees.__ This module is+-- exposed so baikai's own test suites and sibling packages can reach+-- it, but it is not part of the public API: its contents may change+-- in /any/ release without a PVP major bump. Do not import it from+-- application code.+--+-- The OpenAI Chat Completions streaming machinery: the SSE driver seam,+-- the raw chunk decoders, the reasoning-tag scanner, the event assembler+-- and the usage mapping. The public entry points built on it live in+-- "Baikai.Provider.OpenAI.Api".+--+-- Requests start as the SDK's typed+-- 'OpenAI.V1.Chat.Completions.CreateChatCompletion' value, then+-- 'Baikai.Provider.OpenAI.Shape.streamRequestBody' rewrites the raw JSON+-- body for OpenAI-compatible host quirks before+-- 'Baikai.Provider.OpenAI.Sse.openaiSseStreamValueWithHeaders' sends it+-- with cached transport settings and caller headers. Streaming responses+-- are parsed from raw 'Aeson.Value' chunks so partial tool-call deltas+-- may omit fields such as @id@ and @function.name@.+module Baikai.Provider.OpenAI.Internal.Stream+ ( openaiChatStreamWith,+ SseDriver,+ liveSseDriver,+ RawChunk (..),+ RawToolDelta (..),+ parseChunk,+ parseFrame,+ TagScanState (..),+ emptyTagScanState,+ scanThinkTags,+ Assembler (..),+ emptyAssembler,+ translate,+ closeOpenStream,++ -- * Usage mapping+ RawUsage (..),+ parseUsage,+ rawUsageToUsage,+ )+where++import Baikai.Compat (OpenAICompletionsCompat (requiresThinkingAsText))+import Baikai.Content qualified as Content+import Baikai.Context (Context (..))+import Baikai.Cost (zeroCost)+import Baikai.Cost.Pricing qualified as Pricing+import Baikai.Error (BaikaiError, contentFiltered, invalidRequest, providerError)+import Baikai.Evidence qualified as Ev+import Baikai.Evidence.Build qualified as Build+import Baikai.Message qualified as Msg+import Baikai.Model (Model, openaiCompletionsCompatFor)+import Baikai.Options (Options (..))+import Baikai.Provider.Internal.StreamWorker+ ( FrameQueue,+ newFrameQueue,+ pullFrame,+ pushFrame,+ withFrameWorker,+ )+import Baikai.Provider.OpenAI.Internal.ErrorClass (classifyErrorFrame, classifyException)+import Baikai.Provider.OpenAI.Internal.Request (mapRequest)+import Baikai.Provider.OpenAI.Shape (describeThinkingShape, streamRequestBody)+import Baikai.Provider.OpenAI.Sse (ResponseMetadata, capturedHeaderNames, openaiSseStreamValueWithHeaders)+import Baikai.Provider.OpenAI.Transport qualified as Transport+import Baikai.StopReason qualified as Stop+import Baikai.Stream.Event+ ( AssistantMessageEvent (..),+ BlockEndPayload (..),+ DeltaPayload (..),+ IndexPayload (..),+ StartPayload (..),+ ThinkingEndPayload (..),+ ToolCallEndPayload (..),+ doneTerminal,+ errorTerminal,+ )+import Baikai.Url qualified as Url+import Baikai.Usage qualified as Usage+import 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 qualified as AesonKey+import Data.Aeson.KeyMap qualified as KeyMap+import Data.Aeson.Types qualified as Aeson+import Data.CaseInsensitive qualified as CI+import Data.Generics.Labels ()+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.IntMap.Strict (IntMap)+import Data.IntMap.Strict qualified as IntMap+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Time.Clock (UTCTime, getCurrentTime)+import Data.Vector (Vector)+import Data.Vector qualified as Vector+import Data.Version (showVersion)+import GHC.Generics (Generic)+import Network.HTTP.Types.Header (RequestHeaders)+import Numeric.Natural (Natural)+import Paths_baikai_openai qualified as Paths+import Servant.Client qualified as Client+import Streamly.Data.Stream (Stream)+import Streamly.Data.Stream qualified as Stream++-- | How a call physically reaches the host.+--+-- The arguments are exactly those of+-- 'Baikai.Provider.OpenAI.Sse.openaiSseStreamValueWithHeaders', which is+-- what 'liveSseDriver' is. A test passes a driver that replays a+-- recorded response through the same+-- 'Baikai.Provider.OpenAI.Sse.sseFromResponse' the live one uses, so the+-- request shaping, header allow-list, status classification, and chunk+-- decoding under test are all the real implementations and only the+-- socket is missing.+--+-- The request body arrives as an argument rather than inside a per-call+-- record, so a test driver can capture exactly what went out without+-- this module exporting the record that also holds the resolved API key.+type SseDriver =+ Client.ClientEnv ->+ RequestHeaders ->+ Aeson.Value ->+ (ResponseMetadata -> IO ()) ->+ (Either BaikaiError Aeson.Value -> IO ()) ->+ IO ()++-- | The production driver: a real HTTPS request through the cached+-- transport settings.+liveSseDriver :: SseDriver+liveSseDriver = openaiSseStreamValueWithHeaders++-- | 'Baikai.Provider.OpenAI.Api.openaiChatStream' over an explicit+-- transport driver.+openaiChatStreamWith ::+ SseDriver -> Model -> Context -> Options -> Stream IO AssistantMessageEvent+openaiChatStreamWith driver m ctx opts =+ Stream.concatEffect $ do+ setupResult <- trySync (prepareCall m ctx opts)+ let setup = either (Left . exceptionToError) id setupResult+ case setup of+ Left err -> Stream.fromList <$> immediateError m opts err+ Right call -> do+ q <- newFrameQueue :: IO (FrameQueue (Either BaikaiError RawChunk))+ tref <- newIORef False+ mref <- newIORef Nothing+ startTime <- getCurrentTime+ -- The request body is the envelope the two digests commit to:+ -- it is exactly the JSON this call is about to put on the wire.+ -- Credentials are not in it -- they travel in the headers built+ -- separately by 'Transport.requestHeaders'.+ mkEvidence <-+ Build.prepareEvidenceAt+ (call ^. #baseUrl)+ m+ opts+ Ev.TransportHttpApi+ (call ^. #thinking)+ (call ^. #requestBody)+ startTime+ let initialState =+ ProducerState+ { chan = q,+ pending = [EventStart StartPayload {partial = skeletonStart m startTime, responseId = Nothing}],+ assembler = emptyAssembler m startTime,+ finished = False,+ terminalRef = tref,+ metadataRef = mref,+ evidence = mkEvidence+ }+ pure (withFrameWorker q (worker driver call mref q) (Stream.unfoldrM step initialState))++skeletonStart :: Model -> UTCTime -> Msg.Message+skeletonStart _m start =+ Msg.AssistantMessage+ Msg.AssistantPayload+ { Msg.content = Vector.empty,+ Msg.usage = Usage.zeroUsage,+ Msg.stopReason = Stop.Stop,+ Msg.errorMessage = Nothing,+ Msg.timestamp = Just start+ }++-- | Per-call prepared values.+data OpenAICall = OpenAICall+ { clientEnv :: !Client.ClientEnv,+ requestHeaders :: !RequestHeaders,+ timeoutMs :: !(Maybe Int),+ requestBody :: !Aeson.Value,+ -- | The base URL this call actually resolved to, which is the+ -- vendor default when the model carries none. Carried so the+ -- evidence endpoint names the host the call went to; the model's+ -- own field can be @""@ for a call with a perfectly definite+ -- destination.+ baseUrl :: !Text,+ -- | What the caller's reasoning-effort preference became on this+ -- request, as 'streamRequestBody' described it. Carried from here+ -- rather than recomputed at the terminal: only the shaping step+ -- knows which of the seven host wire shapes was used.+ thinking :: !Ev.ThinkingTranslation+ }+ deriving stock (Generic)++-- | The host this call goes to: the model's base URL, or OpenAI's when+-- it carries none.+resolvedBaseUrl :: Model -> Text+resolvedBaseUrl m = case m ^. #baseUrl of+ "" -> "https://api.openai.com"+ u -> u++prepareCall :: Model -> Context -> Options -> IO (Either BaikaiError OpenAICall)+prepareCall m ctx opts = case mapRequest m ctx opts of+ Left e -> pure (Left (invalidRequest e))+ Right req -> do+ let url = resolvedBaseUrl m+ -- Checked before the key is resolved, so a base URL baikai will not+ -- send to never causes a credential to be read out of the+ -- environment. The message names the problem and what to write+ -- instead; it renders the URL without its userinfo or query, so an+ -- error reaching a log cannot carry a key someone put in either.+ case Url.baseUrlProblem url of+ Just problem ->+ pure (Left (invalidRequest ("Model.baseUrl is not usable: " <> problem)))+ Nothing -> do+ key <- Transport.resolveKey url opts+ env <- Transport.getClientEnvCached url+ let compat = openaiCompletionsCompatFor m+ (body, translation) = streamRequestBody compat (m ^. #reasoning) opts req+ headers = Transport.requestHeaders key m opts+ pure+ ( Right+ OpenAICall+ { clientEnv = env,+ requestHeaders = headers,+ timeoutMs = opts ^. #timeoutMs,+ requestBody = body,+ baseUrl = url,+ thinking = translation+ }+ )++-- | A loose summary of one streamed chunk. The raw 'Aeson.Value' is+-- pre-parsed into the fields we care about; unknown fields are+-- ignored. Missing fields are 'Nothing' (we tolerate partial+-- tool-call deltas).+data RawChunk = RawChunk+ { contentDelta :: !(Maybe Text),+ reasoningDelta :: !(Maybe Text),+ finishReason :: !(Maybe Text),+ toolDeltas :: ![RawToolDelta],+ usage :: !(Maybe RawUsage),+ -- | The model the host says produced this chunk, from the chunk's+ -- top-level @model@ field. 'Nothing' means the host did not report+ -- one — never that it reported the configured model.+ model :: !(Maybe Text),+ -- | The host's identifier for this response, from the chunk's+ -- top-level @id@ field.+ responseId :: !(Maybe Text)+ }+ deriving stock (Show, Generic)++data RawToolDelta = RawToolDelta+ { index :: !(Maybe Int),+ id_ :: !(Maybe Text),+ name :: !(Maybe Text),+ args :: !(Maybe Text)+ }+ deriving stock (Show, Generic)++data RawUsage = RawUsage+ { inputTokens :: !Natural,+ outputTokens :: !Natural,+ cacheReadTokens :: !Natural,+ reasoningTokens :: !(Maybe Natural)+ }+ deriving stock (Show, Generic)++-- | Worker body: drive the transport, forwarding decoded chunks onto the+-- frame queue. Any synchronous exception is converted into a classified+-- error frame so the consumer side can translate it through the normal+-- path.+--+-- Nothing here signals end-of-frames: that is the queue's closed flag,+-- set by 'Baikai.Provider.Internal.StreamWorker.forkFrameWorker''s+-- @finally@ however this body ends. A sentinel push would block on a+-- full queue, which is exactly the state a stopped consumer leaves+-- behind.+worker ::+ SseDriver ->+ OpenAICall ->+ IORef (Maybe ResponseMetadata) ->+ FrameQueue (Either BaikaiError RawChunk) ->+ IO ()+worker driver call metaRef q = do+ r <-+ trySync+ $ Transport.runWithTimeout (call ^. #timeoutMs)+ $ driver+ (call ^. #clientEnv)+ (call ^. #requestHeaders)+ (call ^. #requestBody)+ (writeIORef metaRef . Just)+ $ \case+ Left be -> pushFrame q (Left be)+ Right val -> case parseFrame val of+ Left err -> pushFrame q (Left (providerError (Text.pack err)))+ Right frame -> pushFrame q frame+ case r of+ Right Nothing -> pure ()+ Right (Just be) -> pushFrame q (Left be)+ Left e -> pushFrame q (Left (exceptionToError e))++-- | Sort one decoded SSE frame into what it is: a classified in-band+-- error, or a completion chunk.+--+-- Compatible hosts report an upstream failure on a @2xx@ stream as a+-- frame carrying an @error@ object, with or without a @choices@ array+-- beside it. Such a frame ends the call with the failure's own+-- classification and message instead of being parsed as an empty chunk,+-- dropped, and reported at stream end as+-- @openai stream ended without finish_reason@.+--+-- The classified error travels back through the same+-- @Either BaikaiError RawChunk@ channel element a non-2xx uses, so the+-- assembler's 'Left' path — including its block closing — applies+-- unchanged.+parseFrame :: Value -> Either String (Either BaikaiError RawChunk)+parseFrame v = case classifyErrorFrame v of+ Just be -> Right (Left be)+ Nothing -> Right <$> parseChunk v++-- | Aeson parser tolerant of partial tool-call fields.+parseChunk :: Value -> Either String RawChunk+parseChunk = Aeson.parseEither $ Aeson.withObject "ChatCompletionChunk" $ \o -> do+ choices <- o .:? "choices"+ let firstChoice :: Maybe Aeson.Object+ firstChoice = case choices of+ Just (Aeson.Array a)+ | Vector.length a > 0 ->+ case Vector.head a of+ Aeson.Object obj -> Just obj+ _ -> Nothing+ _ -> Nothing+ (contentDelta, reasoningDelta, finishR, toolDeltas) <- case firstChoice of+ Nothing -> pure (Nothing, Nothing, Nothing, [])+ Just ch -> do+ finish <- ch .:? "finish_reason"+ delta <- ch .:? "delta"+ case delta of+ Nothing -> parseMessageObject ch finish+ Just (Aeson.Object dObj) -> do+ cd <- dObj .:? "content"+ let rd = reasoningText dObj+ tc <- dObj .:? "tool_calls"+ let tds = parseToolCallDeltas tc+ pure (cd, rd, finish, tds)+ _ -> parseMessageObject ch finish+ usageM <- o .:? "usage"+ let ru = case usageM of+ Just (Aeson.Object uObj) -> parseUsage uObj+ _ -> Nothing+ pure+ RawChunk+ { contentDelta = contentDelta,+ reasoningDelta = reasoningDelta,+ finishReason = finishR,+ toolDeltas = toolDeltas,+ usage = ru,+ -- Read as a lookup yielding 'Maybe' rather than a required+ -- field: chunks are decoded as raw JSON precisely because+ -- compatible hosts vary, and a host that omits either of these+ -- has reported nothing, which is not a decode failure.+ model = lookupText "model" o,+ responseId = lookupText "id" o+ }++parseMessageObject ::+ Aeson.Object ->+ Maybe Text ->+ Aeson.Parser (Maybe Text, Maybe Text, Maybe Text, [RawToolDelta])+parseMessageObject ch finish = do+ msg <- ch .:? "message"+ case msg of+ Just (Aeson.Object mObj) -> do+ cd <- mObj .:? "content"+ pure (cd, reasoningText mObj, finish, [])+ _ -> pure (Nothing, Nothing, finish, [])++reasoningText :: Aeson.Object -> Maybe Text+reasoningText obj =+ lookupText "reasoning_content" obj <|> lookupText "reasoning" obj++parseToolCallDeltas :: Maybe Value -> [RawToolDelta]+parseToolCallDeltas = \case+ Just (Aeson.Array v) -> Vector.toList (Vector.mapMaybe oneDelta v)+ _ -> []+ where+ oneDelta :: Value -> Maybe RawToolDelta+ oneDelta = \case+ Aeson.Object o ->+ let funcObj :: Maybe Aeson.Object+ funcObj = case lookupField "function" o of+ Just (Aeson.Object f) -> Just f+ _ -> Nothing+ getName = funcObj >>= lookupText "name"+ getArgs = funcObj >>= lookupText "arguments"+ in Just+ RawToolDelta+ { index = fromInt <$> lookupField "index" o,+ id_ = lookupText "id" o,+ name = getName,+ args = getArgs+ }+ _ -> Nothing++parseUsage :: Aeson.Object -> Maybe RawUsage+parseUsage o =+ case Aeson.parseEither pUsage o of+ Right u -> Just u+ Left _ -> Nothing+ where+ pUsage obj = do+ i <- obj .:? "prompt_tokens"+ out <- obj .:? "completion_tokens"+ ptd <- obj .:? "prompt_tokens_details"+ ctd <- obj .:? "completion_tokens_details"+ let cached = case ptd of+ Just (Aeson.Object p) -> case lookupField "cached_tokens" p of+ Just (Aeson.Number n) -> truncate n+ _ -> 0 :: Natural+ _ -> 0+ reasoning = case ctd of+ Just (Aeson.Object c) -> case lookupField "reasoning_tokens" c of+ Just (Aeson.Number n) -> Just (truncate n)+ _ -> Nothing+ _ -> Nothing+ pure+ RawUsage+ { inputTokens = fromMaybe 0 i,+ outputTokens = fromMaybe 0 out,+ cacheReadTokens = cached,+ reasoningTokens = reasoning+ }++lookupField :: Text -> Aeson.Object -> Maybe Value+lookupField k = KeyMap.lookup (AesonKey.fromText k)++-- Pull a Text-valued field out of an Aeson object; tolerates+-- absent or non-Text values by returning 'Nothing'.+lookupText :: Text -> Aeson.Object -> Maybe Text+lookupText k o = case lookupField k o of+ Just (Aeson.String t) -> Just t+ _ -> Nothing++fromInt :: Value -> Int+fromInt = \case+ Aeson.Number n -> truncate n+ _ -> 0++-- ============================================================+-- Streamly state machine+-- ============================================================++data ProducerState = ProducerState+ { chan :: !(FrameQueue (Either BaikaiError RawChunk)),+ pending :: ![AssistantMessageEvent],+ assembler :: !Assembler,+ finished :: !Bool,+ terminalRef :: !(IORef Bool),+ -- | Where the worker leaves the response-level metadata it captured+ -- before the first chunk. Read on this side rather than pushed+ -- through 'chan' so the channel keeps carrying exactly one kind of+ -- thing; 'absorbMetadata' folds it into the assembler.+ metadataRef :: !(IORef (Maybe ResponseMetadata)),+ -- | Everything about this call's evidence that was knowable before+ -- the first byte came back, waiting on the terminal timestamp and+ -- outcome. 'Nothing' when the caller did not ask for evidence.+ -- 'sealTerminal' applies it.+ evidence ::+ !(Maybe (UTCTime -> Ev.CallStatus -> Maybe BaikaiError -> Ev.ModelCallEvidence))+ }+ deriving stock (Generic)++step :: ProducerState -> IO (Maybe (AssistantMessageEvent, ProducerState))+step s+ | (e : rest) <- s ^. #pending = do+ sealed <- sealTerminal s e+ pure+ ( Just+ ( sealed,+ s+ & #pending .~ rest+ & #finished .~ (s ^. #finished || terminal sealed)+ )+ )+ | s ^. #finished = pure Nothing+ | otherwise = do+ mRaw <- pullFrame (s ^. #chan)+ -- After the read, because the worker writes the metadata before it+ -- writes anything onto the channel: taking it here means every+ -- path out of this branch — including the one where the channel+ -- closed without ever producing a chunk — sees it.+ ass0 <- absorbMetadata (s ^. #metadataRef) (s ^. #assembler)+ let s' = s & #assembler .~ ass0+ case mRaw of+ Nothing -> do+ alreadyTerminal <- readIORef (s' ^. #terminalRef)+ if alreadyTerminal+ then pure Nothing+ else do+ now <- getCurrentTime+ let (events, ass') = closeOpenStream now Nothing ass0+ case events of+ [] -> pure Nothing+ (e : rest) -> do+ sealed <- sealTerminal (s' & #assembler .~ ass') e+ pure+ ( Just+ ( sealed,+ s'+ & #pending .~ rest+ & #assembler .~ ass'+ & #finished .~ True+ )+ )+ Just raw -> do+ now <- getCurrentTime+ let (events, ass') = translate raw ass0 now+ case events of+ [] -> step (s' & #assembler .~ ass')+ (e : rest) -> do+ sealed <- sealTerminal (s' & #assembler .~ ass') e+ pure+ ( Just+ ( sealed,+ s'+ & #pending .~ rest+ & #assembler .~ ass'+ & #finished .~ (s' ^. #finished || terminal sealed)+ )+ )++-- | Fold whatever response-level metadata the worker has captured into+-- the assembler.+--+-- Idempotent: applying it again overwrites the same fields with the same+-- values, which is what lets 'step' call it on every pass rather than+-- tracking whether it has run.+absorbMetadata :: IORef (Maybe ResponseMetadata) -> Assembler -> IO Assembler+absorbMetadata ref ass = do+ meta <- readIORef ref+ pure $ case meta of+ Nothing -> ass+ Just md ->+ ass+ & #httpStatus .~ Just (md ^. #httpStatus)+ & #providerRequestId .~ correlationId md++-- | The host's correlation identifier for this response, or a gateway's+-- if the host's own is absent.+--+-- The preference order is+-- 'Baikai.Provider.OpenAI.Sse.capturedHeaderNames' itself, so the+-- allow-list and the preference cannot disagree. Nothing is invented: a+-- response carrying none of those headers leaves this 'Ev.Unobserved'.+correlationId :: ResponseMetadata -> Ev.Observed Text+correlationId md =+ case [v | n <- capturedHeaderNames, Just v <- [lookup (headerName n) (md ^. #headers)]] of+ (v : _) -> Ev.Observed v+ [] -> Ev.Unobserved+ where+ headerName = Text.decodeUtf8 . CI.foldedCase++-- | Mark the stream terminated and attach the call's evidence to the+-- terminal event.+--+-- Every event this producer yields goes through here, so the three+-- sites that can produce a terminal -- a translated upstream chunk, a+-- queued event drained from 'pending', and the channel-close path --+-- all seal identically. Doing it here rather than inside 'translate'+-- keeps that function pure; evidence construction needs 'IO' for the+-- call identifier.+--+-- A non-terminal event passes through unchanged, and so does a terminal+-- on a call whose caller asked for no evidence.+sealTerminal :: ProducerState -> AssistantMessageEvent -> IO AssistantMessageEvent+sealTerminal s ev+ | not (terminal ev) = pure ev+ | otherwise = do+ writeIORef (s ^. #terminalRef) True+ case s ^. #evidence of+ Nothing -> pure ev+ Just finish -> do+ now <- getCurrentTime+ let st = statusOf ev+ record = observeOpenAI st (s ^. #assembler) (finish now st (errorOf ev))+ pure (withEvidence record ev)+ where+ statusOf = \case+ EventDone {} -> Ev.CallSucceeded+ _ -> Ev.CallFailed+ -- The terminal payload already carries the normalized error, and+ -- 'errorTerminal' guarantees it is 'Just' on every 'EventError'.+ errorOf = \case+ EventError p -> p ^. #errorInfo+ _ -> Nothing+ -- Set through the generic-lens label rather than a record update:+ -- 'Baikai.Options.Options' also has an @evidence@ field, so under+ -- @DuplicateRecordFields@ a bare @p {evidence = ...}@ has no unique+ -- constructor to resolve to.+ withEvidence record = \case+ EventDone p -> EventDone (p & #evidence .~ Just record)+ EventError p -> EventError (p & #evidence .~ Just record)+ other -> other++-- | Replace the observed fields of a prepared evidence record with what+-- this call actually saw, and derive the strength from that.+--+-- Only ever reached on a call whose caller asked for evidence, which is+-- what makes it safe to compute the response commitment here: that+-- digest hashes the model's entire output and is the most expensive+-- thing this provider adds. The observations it reads were gathered+-- unconditionally, because each costs a lookup and each improves the+-- 'Baikai.Response.Response' for every caller.+--+-- Nothing here consults the request. An observation the host did not+-- make stays 'Ev.Unobserved'.+observeOpenAI ::+ Ev.CallStatus -> Assembler -> Ev.ModelCallEvidence -> Ev.ModelCallEvidence+observeOpenAI st ass ev =+ ev+ & #endpoint . #implementationVersion .~ Just openaiPackageVersion+ & #observedModel .~ (ass ^. #observedModel)+ & #providerRequestId .~ (ass ^. #providerRequestId)+ & #responseId .~ maybe Ev.Unobserved Ev.Observed (ass ^. #responseId)+ & #usage .~ observedUsage ass+ & #responseCommitment .~ responseCommitment st ass+ & #strength+ .~ Ev.deriveStrength+ (ass ^. #observedModel)+ (ass ^. #providerRequestId)+ (maybe Ev.Unobserved Ev.Observed (ass ^. #responseId))++-- | The token accounting, but only if the host actually reported it.+--+-- The assembler initialises 'usage' to zeroes, so reporting it+-- unconditionally would tell a reader the host said this call consumed+-- nothing — which for a call that failed before any usage arrived is a+-- fabrication, and exactly what 'Ev.Observed' exists to stop.+observedUsage :: Assembler -> Ev.Observed Usage.Usage+observedUsage ass+ | ass ^. #usageReported = Ev.Observed (finalUsage ass)+ | otherwise = Ev.Unobserved++-- | A commitment to what came back, on a call that produced a response.+--+-- Left 'Ev.Unobserved' otherwise: a digest of an empty envelope is a+-- real-looking value standing for a response that never arrived.+responseCommitment :: Ev.CallStatus -> Assembler -> Ev.Observed Text+responseCommitment Ev.CallSucceeded ass =+ Ev.Observed (Ev.commitmentDigest (responseEnvelope ass))+responseCommitment _ _ = Ev.Unobserved++-- | What that digest commits to: the assembled content blocks in order,+-- the stop reason, and the reported usage.+--+-- Deliberately the assembled response rather than the raw SSE bytes. Two+-- identical responses split into different chunks must produce the same+-- digest, and the chunk boundaries are a transport detail no verifier+-- holding the response could reproduce. The key names match the+-- Anthropic adapter's envelope so a consumer reading both does not have+-- to learn two spellings.+responseEnvelope :: Assembler -> Value+responseEnvelope ass =+ Aeson.object+ [ "content" Aeson..= blocksInOrder ass,+ "stop_reason" Aeson..= (ass ^. #stopReason),+ -- Token counts only: 'Ev.usageEnvelope' omits the cost, which+ -- baikai computes from the caller's catalog rather than reads off+ -- the response, and which a verifier therefore cannot reproduce.+ "usage" Aeson..= Ev.usageEnvelope (finalUsage ass)+ ]++-- | The version of this package, for the evidence record's endpoint+-- identity. Read from the cabal-generated module rather than written as+-- a literal, which becomes a lie the first time a release misses it.+openaiPackageVersion :: Text+openaiPackageVersion = Text.pack (showVersion Paths.version)++terminal :: AssistantMessageEvent -> Bool+terminal = \case+ EventDone {} -> True+ EventError {} -> True+ _ -> False++-- ============================================================+-- Translation+-- ============================================================++data TagMode+ = TagVisible+ | TagReasoning+ deriving stock (Eq, Show, Generic)++-- | Incremental scanner state for hosts that stream reasoning in+-- assistant text using @<think>@ or @<thinking>@ tags.+data TagScanState = TagScanState+ { tagMode :: !TagMode,+ tagPending :: !Text+ }+ deriving stock (Eq, Show, Generic)++-- | The scanner's starting state: nothing buffered, nothing hidden.+emptyTagScanState :: TagScanState+emptyTagScanState =+ TagScanState+ { tagMode = TagVisible,+ tagPending = Text.empty+ }++-- | Split one text delta into reasoning fragments ('Left') and+-- visible text fragments ('Right'), preserving partial tag prefixes+-- across chunk boundaries.+scanThinkTags :: TagScanState -> Text -> (TagScanState, [Either Text Text])+scanThinkTags st input =+ let (mode', pending', parts) = go (tagMode st) (tagPending st <> input) []+ in (TagScanState {tagMode = mode', tagPending = pending'}, parts)+ where+ go mode txt acc =+ case findTag mode txt of+ Just (before, after, nextMode) ->+ go nextMode after (appendPart mode before acc)+ Nothing ->+ let (emitNow, pending) = splitPending mode txt+ in (mode, pending, appendPart mode emitNow acc)++ appendPart _ "" acc = acc+ appendPart TagVisible t acc = acc <> [Right t]+ appendPart TagReasoning t acc = acc <> [Left t]++findTag :: TagMode -> Text -> Maybe (Text, Text, TagMode)+findTag mode txt =+ case earliest markers of+ Nothing -> Nothing+ Just (idx, marker) ->+ Just+ ( Text.take idx txt,+ Text.drop (idx + Text.length marker) txt,+ nextMode+ )+ where+ (markers, nextMode) = case mode of+ TagVisible -> (openingTags, TagReasoning)+ TagReasoning -> (closingTags, TagVisible)+ earliest =+ foldr+ ( \marker best ->+ case Text.breakOn marker txt of+ (_, "") -> best+ (before, _) ->+ let candidate = (Text.length before, marker)+ in case best of+ Nothing -> Just candidate+ Just (oldIdx, _) | Text.length before < oldIdx -> Just candidate+ _ -> best+ )+ Nothing++splitPending :: TagMode -> Text -> (Text, Text)+splitPending mode txt =+ let suffix = longestTagPrefix (case mode of TagVisible -> openingTags; TagReasoning -> closingTags) txt+ in (Text.dropEnd (Text.length suffix) txt, suffix)++longestTagPrefix :: [Text] -> Text -> Text+longestTagPrefix markers txt =+ foldr longer Text.empty candidates+ where+ candidates =+ [ suffix+ | n <- [1 .. Text.length txt],+ let suffix = Text.takeEnd n txt,+ any (suffix `Text.isPrefixOf`) markers+ ]+ longer a b+ | Text.length a > Text.length b = a+ | otherwise = b++openingTags :: [Text]+openingTags = ["<think>", "<thinking>"]++closingTags :: [Text]+closingTags = ["</think>", "</thinking>"]++-- | Translation state across one streaming call.+data Assembler = Assembler+ { model :: !Model,+ start :: !UTCTime,+ -- | 'Just i' when a text block at baikai contentIndex @i@ is+ -- currently open; 'Nothing' when no text block is open.+ textOpen :: !(Maybe Int),+ textAccum :: !Text,+ textEverOpened :: !Bool,+ reasoningOpen :: !(Maybe Int),+ reasoningAccum :: !Text,+ tagScanState :: !TagScanState,+ -- | Maps OpenAI's per-call tool-call index to baikai's+ -- 'contentIndex'.+ toolIndexMap :: !(IntMap Int),+ toolIdMap :: !(Map Text Int),+ lastToolIdx :: !(Maybe Int),+ -- | baikai contentIndex → (id, name).+ toolMeta :: !(IntMap (Text, Text)),+ -- | baikai contentIndex → accumulated arguments JSON.+ toolArgs :: !(IntMap Text),+ closed :: !(IntMap Content.AssistantContent),+ -- | The next @contentIndex@ to hand out. Every block open takes it+ -- and bumps it, and no index is ever reused: text and thinking+ -- close each other before opening, so a stream that alternates+ -- between them produces 0, 1, 2, … in the order the host sent them,+ -- which is the order reassembly rebuilds the message in.+ nextContentIndex :: !Int,+ usage :: !Usage.Usage,+ stopReason :: !Stop.StopReason,+ -- | 'True' once a chunk carrying @finish_reason@ has been+ -- observed. The terminal 'EventDone' fires on channel close so+ -- the post-@finish_reason@ usage chunk (when @include_usage@ is+ -- enabled) has a chance to land.+ finishSeen :: !Bool,+ pendingError :: !(Maybe BaikaiError),+ finishNote :: !(Maybe Text),+ -- The five fields below are what this call /observed/, as distinct+ -- from what it requested. They live here because this record is the+ -- only state that survives from the first chunk to the last, and+ -- because an observation that never arrived must stay+ -- 'Ev.Unobserved' rather than falling back to the caller's+ -- configuration.++ -- | The host's own correlation identifier for this call, from the+ -- response headers.+ providerRequestId :: !(Ev.Observed Text),+ -- | The model identifier the host reported running, from the first+ -- chunk that carried one. Never the configured model.+ observedModel :: !(Ev.Observed Text),+ -- | The host's identifier for this response, from the first chunk+ -- that carried one.+ responseId :: !(Maybe Text),+ -- | The response's HTTP status. Recorded because the transport has+ -- it; 'Baikai.Evidence.ModelCallEvidence' has no field for it, and+ -- inventing one belongs to the vocabulary's plan, not to this+ -- module.+ httpStatus :: !(Maybe Int),+ -- | Whether the host actually reported token counts, as opposed to+ -- 'usage' still holding the zeroes it was initialised with. Without+ -- this a failed call would claim the host reported consuming+ -- nothing.+ usageReported :: !Bool+ }+ deriving stock (Generic)++emptyAssembler :: Model -> UTCTime -> Assembler+emptyAssembler m s =+ Assembler+ { model = m,+ start = s,+ textOpen = Nothing,+ textAccum = Text.empty,+ textEverOpened = False,+ reasoningOpen = Nothing,+ reasoningAccum = Text.empty,+ tagScanState = emptyTagScanState,+ toolIndexMap = IntMap.empty,+ toolIdMap = Map.empty,+ lastToolIdx = Nothing,+ toolMeta = IntMap.empty,+ toolArgs = IntMap.empty,+ closed = IntMap.empty,+ nextContentIndex = 0,+ usage = Usage.zeroUsage,+ stopReason = Stop.Stop,+ finishSeen = False,+ pendingError = Nothing,+ finishNote = Nothing,+ providerRequestId = Ev.Unobserved,+ observedModel = Ev.Unobserved,+ responseId = Nothing,+ httpStatus = Nothing,+ usageReported = False+ }++translate ::+ Either BaikaiError RawChunk ->+ Assembler ->+ UTCTime ->+ ([AssistantMessageEvent], Assembler)+translate chunk ass now+ -- A transport failure mid-stream goes through the same closer as a+ -- clean channel close, so text, reasoning and tool arguments that were+ -- open when it arrived are closed before the terminal. Building the+ -- terminal from 'blocksInOrder' alone -- which is what this branch used+ -- to do -- silently dropped them from both the events and the message.+ | Left be <- chunk = closeOpenStream now (Just be) ass+ | Right raw <- chunk =+ let -- 0. Record what the host said about itself.+ ass0 = observeChunk raw ass+ -- 1. Apply field-based reasoning delta.+ (reasoningEvents, ass1) = applyReasoningDelta (raw ^. #reasoningDelta) ass0+ -- 2. Apply content delta (open text block if needed).+ (textEvents, ass2) = applyContentDelta (raw ^. #contentDelta) ass1+ -- 3. Apply tool-call deltas.+ (toolEvents, ass3) = applyToolDeltas (raw ^. #toolDeltas) ass2+ -- 4. Apply usage chunk if present.+ ass4 = applyUsage (raw ^. #usage) ass3+ -- 5. If finish_reason is set, close any open text/tool+ -- blocks and stash the reason. EventDone is deferred+ -- to channel close so the post-finish_reason usage+ -- chunk has a chance to land.+ (closeEvents, ass5) = case raw ^. #finishReason of+ Just fr -> closeOnFinish fr ass4+ Nothing -> ([], ass4)+ in (reasoningEvents <> textEvents <> toolEvents <> closeEvents, ass5)++-- | Record what the host reported about itself on this chunk.+--+-- Both values come from the /first/ chunk that carries them and are+-- never overwritten. Compatible hosts repeat both fields on every chunk+-- and they are expected to agree; a host where they disagree is a+-- genuine discovery worth recording rather than something to resolve+-- silently by last-write-wins.+--+-- A missing field means the host reported nothing, so the observation+-- stays 'Ev.Unobserved'. The configured model is never substituted —+-- that is the specific mistake 'Ev.Observed' exists to prevent.+observeChunk :: RawChunk -> Assembler -> Assembler+observeChunk raw ass =+ ass+ & #observedModel .~ firstObserved (ass ^. #observedModel) (raw ^. #model)+ & #responseId .~ ((ass ^. #responseId) <|> (raw ^. #responseId))++firstObserved :: Ev.Observed a -> Maybe a -> Ev.Observed a+firstObserved (Ev.Observed a) _ = Ev.Observed a+firstObserved Ev.Unobserved m = maybe Ev.Unobserved Ev.Observed m++applyReasoningDelta ::+ Maybe Text -> Assembler -> ([AssistantMessageEvent], Assembler)+applyReasoningDelta Nothing ass = ([], ass)+applyReasoningDelta (Just "") ass = ([], ass)+applyReasoningDelta (Just d) ass =+ case ass ^. #reasoningOpen of+ Just i ->+ ( [ThinkingDelta DeltaPayload {contentIndex = i, delta = d}],+ ass & #reasoningAccum %~ (<> d)+ )+ -- Opening a thinking block closes an open text block first, so at+ -- most one of the two is open at a time and every _End precedes the+ -- next _Start. 'applyVisibleTextDelta' already closes reasoning+ -- symmetrically. Tool-call blocks are deliberately not closed here:+ -- hosts emit @content@ and @tool_calls@ in one chunk, and closing a+ -- tool call early would split a block the host meant as one.+ Nothing ->+ let (textEvents, ass0) = closeOpenText ass+ i = ass0 ^. #nextContentIndex+ in ( textEvents+ <> [ ThinkingStart IndexPayload {contentIndex = i},+ ThinkingDelta DeltaPayload {contentIndex = i, delta = d}+ ],+ ass0+ & #reasoningOpen .~ Just i+ & #reasoningAccum .~ d+ & #nextContentIndex .~ (i + 1)+ )++applyContentDelta ::+ Maybe Text -> Assembler -> ([AssistantMessageEvent], Assembler)+applyContentDelta Nothing ass = ([], ass)+applyContentDelta (Just "") ass = ([], ass)+applyContentDelta (Just d) ass =+ if requiresThinkingAsText (openaiCompletionsCompatFor (ass ^. #model))+ then+ let (tagState', parts) = scanThinkTags (ass ^. #tagScanState) d+ (events, ass') = foldl' applyTaggedPart ([], ass & #tagScanState .~ tagState') parts+ in (events, ass')+ else applyVisibleTextDelta d ass++applyTaggedPart ::+ ([AssistantMessageEvent], Assembler) ->+ Either Text Text ->+ ([AssistantMessageEvent], Assembler)+applyTaggedPart (acc, ass) = \case+ Left reasoning ->+ let (events, ass') = applyReasoningDelta (Just reasoning) ass+ in (acc <> events, ass')+ Right visible ->+ let (events, ass') = applyVisibleTextDelta visible ass+ in (acc <> events, ass')++applyVisibleTextDelta ::+ Text -> Assembler -> ([AssistantMessageEvent], Assembler)+applyVisibleTextDelta "" ass = ([], ass)+applyVisibleTextDelta d ass =+ case ass ^. #textOpen of+ Just i ->+ let (reasoningEvents, ass1) = closeOpenReasoning ass+ in ( reasoningEvents <> [TextDelta DeltaPayload {contentIndex = i, delta = d}],+ ass1 & #textAccum %~ (<> d)+ )+ Nothing ->+ let (reasoningEvents, ass1) = closeOpenReasoning ass+ i = ass1 ^. #nextContentIndex+ in ( reasoningEvents <> [TextStart IndexPayload {contentIndex = i}, TextDelta DeltaPayload {contentIndex = i, delta = d}],+ ass1+ & #textOpen .~ Just i+ & #textAccum .~ d+ & #textEverOpened .~ True+ & #nextContentIndex .~ (i + 1)+ )++applyToolDeltas ::+ [RawToolDelta] -> Assembler -> ([AssistantMessageEvent], Assembler)+applyToolDeltas [] ass = ([], ass)+applyToolDeltas deltas ass =+ let (reasoningEvents, ass0) = closeOpenReasoning ass+ (toolEvents, ass') = foldl' apply ([], ass0) deltas+ in (reasoningEvents <> toolEvents, ass')+ where+ apply (acc, a) d =+ let (events, a') = applyOneToolDelta d a+ in (acc <> events, a')++applyOneToolDelta ::+ RawToolDelta -> Assembler -> ([AssistantMessageEvent], Assembler)+applyOneToolDelta d ass =+ let mOpenaiIdx = d ^. #index+ mToolId = d ^. #id_+ byIndex = mOpenaiIdx >>= \idx -> IntMap.lookup idx (ass ^. #toolIndexMap)+ byId = mToolId >>= \tid -> Map.lookup tid (ass ^. #toolIdMap)+ byLast =+ case (mOpenaiIdx, mToolId) of+ (Nothing, Nothing) -> ass ^. #lastToolIdx+ _ -> Nothing+ (baikaiIdx, ass1, opened) = case byIndex <|> byId <|> byLast of+ Just i ->+ ( i,+ ass+ & #toolIdMap %~ maybe id (`Map.insert` i) mToolId+ & #lastToolIdx .~ Just i,+ False+ )+ Nothing ->+ let i = ass ^. #nextContentIndex+ ass' =+ ass+ & #toolIndexMap %~ maybe id (`IntMap.insert` i) mOpenaiIdx+ & #toolIdMap %~ maybe id (`Map.insert` i) mToolId+ & #lastToolIdx .~ Just i+ & #toolMeta %~ IntMap.insert i ("", "")+ & #toolArgs %~ IntMap.insert i Text.empty+ & #nextContentIndex .~ (i + 1)+ in (i, ass', True)+ -- Update metadata (id/name first delta only).+ ass2 =+ ass1+ & #toolMeta+ %~ IntMap.adjust+ ( \(existingId, existingName) ->+ ( maybe existingId (\x -> if Text.null existingId then x else existingId) (d ^. #id_),+ maybe existingName (\x -> if Text.null existingName then x else existingName) (d ^. #name)+ )+ )+ baikaiIdx+ -- Append args if present.+ argsDelta = fromMaybe "" (d ^. #args)+ ass3 = ass2 & #toolArgs %~ IntMap.adjust (<> argsDelta) baikaiIdx+ events0 = if opened then [ToolCallStart IndexPayload {contentIndex = baikaiIdx}] else []+ events1 =+ if Text.null argsDelta+ then events0+ else events0 <> [ToolCallDelta DeltaPayload {contentIndex = baikaiIdx, delta = argsDelta}]+ in (events1, ass3)++-- | Normalize OpenAI's inclusive usage counters into baikai's+-- disjoint 'Usage.Usage' convention. OpenAI's @prompt_tokens@+-- includes @prompt_tokens_details.cached_tokens@, so the cached count+-- is subtracted out of 'Usage.inputTokens'. The subtraction is clamped+-- at zero because 'Natural' subtraction throws on underflow and because+-- OpenAI-compatible hosts can report inconsistent counters.+-- 'Usage.totalTokens' is recomputed from the normalized parts;+-- 'Usage.reasoningTokens' is a subset of 'Usage.outputTokens' and is+-- not added to the total. OpenAI does not bill cache writes, so+-- 'Usage.cacheWriteTokens' is always zero.+rawUsageToUsage :: RawUsage -> Usage.Usage+rawUsageToUsage u =+ let prompt = u ^. #inputTokens+ cached = u ^. #cacheReadTokens+ out = u ^. #outputTokens+ nonCached = if cached >= prompt then 0 else prompt - cached+ in Usage.Usage+ { Usage.inputTokens = nonCached,+ Usage.outputTokens = out,+ Usage.cacheReadTokens = cached,+ Usage.cacheWriteTokens = 0,+ Usage.reasoningTokens = u ^. #reasoningTokens,+ Usage.totalTokens = nonCached + out + cached,+ Usage.cost = zeroCost+ }++applyUsage :: Maybe RawUsage -> Assembler -> Assembler+applyUsage Nothing ass = ass+applyUsage (Just u) ass =+ ass+ & #usage .~ rawUsageToUsage u+ -- A host that sent a usage block reported its counts, even if every+ -- one of them is zero. That is what distinguishes a reported zero+ -- from silence in the evidence record.+ & #usageReported .~ True++-- | Close all open content blocks and stash the resolved stop+-- reason; defer 'EventDone' to channel close.+closeOnFinish ::+ Text -> Assembler -> ([AssistantMessageEvent], Assembler)+closeOnFinish finishReason ass =+ let (tagEvents, ass0) = flushTagScanPending ass+ (closeReasoning, ass1) = closeOpenReasoning ass0+ (closeText, ass2) = closeOpenText ass1+ (closeTools, ass3) = closeOpenTools ass2+ (reason, note) = mapFinishReason finishReason+ pending =+ if reason == Stop.ErrorReason+ then+ Just+ ( -- A filter is its own category: the content is the+ -- problem, so a caller can branch on it without matching+ -- on the message text.+ (if finishReason == "content_filter" then contentFiltered else providerError)+ ("provider stopped the response: finish_reason=" <> finishReason)+ )+ else Nothing+ ass4 =+ ass3+ & #stopReason .~ reason+ & #finishSeen .~ True+ & #pendingError .~ pending+ & #finishNote .~ note+ in (tagEvents <> closeReasoning <> closeText <> closeTools, ass4)++flushTagScanPending :: Assembler -> ([AssistantMessageEvent], Assembler)+flushTagScanPending ass =+ let st = ass ^. #tagScanState+ pending = tagPending st+ ass0 = ass & #tagScanState .~ st {tagPending = Text.empty}+ in case (tagMode st, pending) of+ (_, "") -> ([], ass0)+ (TagVisible, t) -> applyVisibleTextDelta t ass0+ (TagReasoning, t) -> applyReasoningDelta (Just t) ass0++closeOpenReasoning :: Assembler -> ([AssistantMessageEvent], Assembler)+closeOpenReasoning ass = case ass ^. #reasoningOpen of+ Nothing -> ([], ass)+ Just i ->+ let body = ass ^. #reasoningAccum+ thinkingContent =+ Content.ThinkingContent+ { Content.thinking = body,+ Content.signature = Nothing,+ Content.redacted = False+ }+ block = Content.AssistantThinking thinkingContent+ in ( [ThinkingEnd ThinkingEndPayload {contentIndex = i, content = thinkingContent}],+ ass+ & #reasoningOpen .~ Nothing+ & #reasoningAccum .~ Text.empty+ & #closed %~ IntMap.insert i block+ )++-- | Close the open text block, if any, by emitting a 'TextEnd' and+-- storing the assembled content in 'closed'.+closeOpenText :: Assembler -> ([AssistantMessageEvent], Assembler)+closeOpenText ass = case ass ^. #textOpen of+ Nothing -> ([], ass)+ Just i ->+ let body = ass ^. #textAccum+ block = Content.AssistantText (Content.TextContent body)+ in ( [TextEnd BlockEndPayload {contentIndex = i, content = body}],+ ass+ & #textOpen .~ Nothing+ & #textAccum .~ Text.empty+ & #closed %~ IntMap.insert i block+ )++-- | Close every open tool call by emitting 'ToolCallEnd' (with the+-- fully parsed 'ToolCall') in index order.+closeOpenTools :: Assembler -> ([AssistantMessageEvent], Assembler)+closeOpenTools ass =+ let openTools = IntMap.toAscList (ass ^. #toolArgs)+ (events, ass') = foldl' closeOne ([], ass) openTools+ in (events, ass')+ where+ closeOne (acc, a) (i, argsText) =+ let (tid, tn) = fromMaybe ("", "") (IntMap.lookup i (a ^. #toolMeta))+ -- One rule, shared with the Claude assembler and with core's+ -- stream recovery: text that does not decode is kept verbatim+ -- as a String, marking the call cut off, rather than replaced+ -- by an empty object a tool loop would execute.+ decoded :: Value+ decoded = Content.toolArgumentsFromText argsText+ tc =+ Content.ToolCall+ { Content.id_ = tid,+ Content.name = tn,+ Content.arguments = decoded+ }+ block = Content.AssistantToolCall tc+ in ( acc <> [ToolCallEnd ToolCallEndPayload {contentIndex = i, toolCall = tc}],+ a+ & #closed %~ IntMap.insert i block+ & #toolArgs %~ IntMap.delete i+ & #toolMeta %~ IntMap.delete i+ & #toolIdMap %~ (if Text.null tid then id else Map.delete tid)+ & #lastToolIdx .~ Nothing+ )++closeOpenStream ::+ UTCTime -> Maybe BaikaiError -> Assembler -> ([AssistantMessageEvent], Assembler)+closeOpenStream now mErr ass+ | ass ^. #finishSeen =+ -- The frames ended after finish_reason: either cleanly (the+ -- channel-close call site, which passes 'Nothing') or with a+ -- classified transport failure that arrived afterwards. The+ -- caller's error wins, because a stream that failed after+ -- finish_reason still failed.+ let reason = ass ^. #stopReason+ terminalErr =+ mErr+ <|> (ass ^. #pendingError)+ <|> if reason == Stop.ErrorReason+ then Just (providerError "provider stopped the response with an error finish_reason")+ else Nothing+ msg = finalMessage ass now (fmap (^. #message) terminalErr) reason+ terminalEvent = case terminalErr of+ Just be -> EventError (errorTerminal Nothing (ass ^. #responseId) reason msg be)+ Nothing -> EventDone (doneTerminal Nothing (ass ^. #responseId) reason msg)+ in ([terminalEvent], ass)+ | otherwise =+ -- Channel closed without a finish_reason. Force-close any+ -- still-open blocks and emit EventError. When the worker stored a+ -- classified HTTP error ('Just be'), surface it structurally;+ -- otherwise report the unexpected end of stream.+ let (tagEvents, ass0) = flushTagScanPending ass+ (closeReasoning, ass1) = closeOpenReasoning ass0+ (closeText, ass2) = closeOpenText ass1+ (closeTools, ass3) = closeOpenTools ass2+ reason = Stop.ErrorReason+ errText = case mErr of+ Just be -> be ^. #message+ Nothing -> "openai stream ended without finish_reason"+ msg = finalMessage ass3 now (Just errText) reason+ errInfo = fromMaybe (providerError errText) mErr+ errEv = EventError (errorTerminal Nothing (ass3 ^. #responseId) reason msg errInfo)+ in (tagEvents <> closeReasoning <> closeText <> closeTools <> [errEv], ass3)++-- | The accumulated token counts with this model's price applied.+--+-- Shared by the assistant message and the evidence record so the two+-- cannot report different numbers for the same call.+finalUsage :: Assembler -> Usage.Usage+finalUsage ass =+ let usageBare = ass ^. #usage+ in usageBare & #cost .~ Pricing.computeCost (ass ^. #model) usageBare++finalMessage ::+ Assembler -> UTCTime -> Maybe Text -> Stop.StopReason -> Msg.Message+finalMessage ass now errMsg sr =+ let blocks = blocksInOrder ass+ in Msg.AssistantMessage+ Msg.AssistantPayload+ { Msg.content = blocks,+ Msg.usage = finalUsage ass,+ Msg.stopReason = sr,+ Msg.errorMessage = errMsg <|> (ass ^. #finishNote),+ Msg.timestamp = Just now+ }++blocksInOrder :: Assembler -> Vector Content.AssistantContent+blocksInOrder ass = Vector.fromList (IntMap.elems (ass ^. #closed))++-- | Immediate error stream emitted when the request itself could not+-- be built (e.g. message mapping failed).+-- Nothing was sent, so there is no wire body to digest and the evidence+-- commits to 'Build.dispatchEnvelope' instead -- see its documentation.+immediateError :: Model -> Options -> BaikaiError -> IO [AssistantMessageEvent]+immediateError m opts err = do+ now <- getCurrentTime+ let errText = err ^. #message+ let msg =+ Msg.AssistantMessage+ Msg.AssistantPayload+ { Msg.content = Vector.empty,+ Msg.usage = Usage.zeroUsage,+ Msg.stopReason = Stop.ErrorReason,+ Msg.errorMessage = Just errText,+ Msg.timestamp = Just now+ }+ ev <-+ Build.minimalEvidenceAt+ (resolvedBaseUrl m)+ m+ opts+ Ev.TransportHttpApi+ -- The adapter's own describer, not 'Ev.noThinkingRequested': the+ -- caller's level is a fact about the call even when the request+ -- was never built, and this is the expression the provider's own+ -- 'describeThinking' field uses.+ (describeThinkingShape (openaiCompletionsCompatFor m) (m ^. #reasoning) opts)+ (Build.dispatchEnvelope m opts)+ now+ now+ Ev.CallFailed+ (Just err)+ pure+ [ EventStart StartPayload {partial = msg, responseId = Nothing},+ EventError (errorTerminal ev Nothing Stop.ErrorReason msg err)+ ]++mapFinishReason :: Text -> (Stop.StopReason, Maybe Text)+mapFinishReason r = case r of+ "stop" -> (Stop.Stop, Nothing)+ "length" -> (Stop.Length, Nothing)+ "tool_calls" -> (Stop.ToolUse, Nothing)+ "function_call" -> (Stop.ToolUse, Nothing)+ "content_filter" -> (Stop.ErrorReason, Nothing)+ _ -> (Stop.Stop, Just ("unrecognized finish_reason: " <> r))++trySync :: IO a -> IO (Either SomeException a)+trySync action = do+ r <- try action+ case r of+ Left e+ | Just (SomeAsyncException _) <- (fromException e :: Maybe SomeAsyncException) ->+ throwIO e+ | otherwise -> pure (Left e)+ Right a -> pure (Right a)++exceptionToError :: SomeException -> BaikaiError+exceptionToError e = fromMaybe (classifyException e) (fromException e)
src/Baikai/Provider/OpenAI/Shape.hs view
@@ -1,6 +1,11 @@ {-# LANGUAGE LambdaCase #-} --- | Pure request-body shaping for OpenAI-compatible Chat Completions hosts.+-- | __Exposed with no stability guarantees.__ This module is exposed so+-- the test suites can drive the transport without a socket, and so+-- sibling packages can reuse its pieces; it is not part of the public+-- API and may change in /any/ release without a PVP major bump.+--+-- Pure request-body shaping for OpenAI-compatible Chat Completions hosts. module Baikai.Provider.OpenAI.Shape ( shapeRequestBody, streamRequestBody,@@ -53,21 +58,29 @@ -- knows. Written as an explicit pipeline rather than the point-free -- composition it used to be, so the description has somewhere to escape -- to.+-- The 'Bool' after the compat record is whether the chosen model+-- advertises reasoning support ('Baikai.Model.reasoning'); see+-- 'injectThinkingShape'. shapeRequestBody ::- OpenAICompletionsCompat -> Options -> Aeson.Value -> (Aeson.Value, ThinkingTranslation)-shapeRequestBody compat opts body =+ OpenAICompletionsCompat ->+ Bool ->+ Options ->+ Aeson.Value ->+ (Aeson.Value, ThinkingTranslation)+shapeRequestBody compat modelReasons opts body = let renamed = renameMaxTokens compat body stripped = dropUnsupportedStrict compat renamed- (thought, translation) = injectThinkingShape compat opts stripped+ (thought, translation) = injectThinkingShape compat modelReasons opts stripped in (injectCacheControl compat opts thought, translation) streamRequestBody :: OpenAICompletionsCompat ->+ Bool -> Options -> Chat.CreateChatCompletion -> (Aeson.Value, ThinkingTranslation)-streamRequestBody compat opts req =- shapeRequestBody compat opts (Aeson.toJSON req')+streamRequestBody compat modelReasons opts req =+ shapeRequestBody compat modelReasons opts (Aeson.toJSON req') where req' = req@@ -118,11 +131,39 @@ -- in @baikai-openai/test/ShapeSpec.hs@; 'compatibleEffort' is scoped by -- its own documentation to the non-native shapes and must not be -- applied here.+--+-- The 'Bool' is whether the chosen model advertises reasoning support+-- ('Baikai.Model.reasoning'). It is consulted /before/ the host's+-- 'ThinkingFormat', because the two questions are different and the+-- model's answer is the stronger one: a host may speak a perfectly good+-- reasoning dialect while the model selected on it cannot reason at all.+-- @gpt-4o-mini@ on OpenAI's own host is exactly that, and a level on it+-- used to put @reasoning_effort@ on the wire and take a 400 for it. The+-- level is now dropped and recorded as+-- 'ThinkingDroppedUnsupportedModel', which is what+-- @docs\/user\/model-call-evidence.md@ has always promised baikai-wide+-- and what the Anthropic adapter has always done. injectThinkingShape ::- OpenAICompletionsCompat -> Options -> Aeson.Value -> (Aeson.Value, ThinkingTranslation)-injectThinkingShape compat opts body =+ OpenAICompletionsCompat ->+ Bool ->+ Options ->+ Aeson.Value ->+ (Aeson.Value, ThinkingTranslation)+injectThinkingShape compat modelReasons opts body = case thinking opts of Nothing -> (body, noThinkingRequested)+ Just lvl+ | not modelReasons ->+ ( body,+ ThinkingTranslation+ { requested = Just lvl,+ mode = ThinkingModeUnsupported,+ effortText = Nothing,+ budgetTokens = Nothing,+ wireField = Nothing,+ adjustments = [ThinkingDroppedUnsupportedModel lvl]+ }+ ) Just lvl -> case thinkingFormat compat of ThinkingFormatOpenAI -> let e = renderThinkingLevel lvl@@ -183,9 +224,11 @@ -- first time either changes, and the divergence is silent; there is no -- cheaper way to be sure this agrees with the wire than to ask the -- function that writes the wire.-describeThinkingShape :: OpenAICompletionsCompat -> Options -> ThinkingTranslation-describeThinkingShape compat opts =- snd (injectThinkingShape compat opts (Aeson.object []))+-- | What 'injectThinkingShape' would record, without building a body.+-- The 'Bool' is 'Baikai.Model.reasoning', as there.+describeThinkingShape :: OpenAICompletionsCompat -> Bool -> Options -> ThinkingTranslation+describeThinkingShape compat modelReasons opts =+ snd (injectThinkingShape compat modelReasons opts (Aeson.object [])) effortTranslation :: ThinkingLevel -> Text -> Text -> ThinkingTranslation effortTranslation lvl wire field =
src/Baikai/Provider/OpenAI/Sse.hs view
@@ -1,28 +1,37 @@ {-# LANGUAGE LambdaCase #-} --- | Local SSE transport for OpenAI Chat Completions streams.+-- | __Exposed with no stability guarantees.__ This module is exposed so+-- the test suites can drive the transport without a socket, and so+-- sibling packages can reuse its pieces; it is not part of the public+-- API and may change in /any/ release without a PVP major bump.+--+-- Local SSE transport for OpenAI Chat Completions streams. module Baikai.Provider.OpenAI.Sse ( openaiSseStream, openaiSseStreamValue, openaiSseStreamValueWithHeaders, sseFromResponse,+ buildRequest, ResponseMetadata (..), capturedHeaderNames, ) where -import Baikai.Error (BaikaiError, decodeError, httpError, parseRetryAfterSeconds)+import Baikai.Error (BaikaiError, decodeError, httpError, parseHttpDate, retryAfterSecondsAt) import Control.Monad (foldM, when) import Data.Aeson qualified as Aeson import Data.ByteString qualified as SBS import Data.ByteString.Char8 qualified as S8 import Data.CaseInsensitive (CI) import Data.CaseInsensitive qualified as CI+import Data.Char (isSpace) import Data.IORef qualified as IORef+import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Text.Encoding.Error qualified as Text+import Data.Time.Clock (getCurrentTime) import GHC.Generics (Generic) import Network.HTTP.Client qualified as HTTP import Network.HTTP.Types.Header (RequestHeaders)@@ -120,25 +129,45 @@ (Either BaikaiError Aeson.Value -> IO ()) -> IO () openaiSseStreamValueWithHeaders env requestHeaders requestBody onMetadata onEvent = do- let base = Client.baseUrl env- secure = case Client.baseUrlScheme base of- Client.Http -> False- Client.Https -> True- request =- HTTP.defaultRequest- { HTTP.secure = secure,- HTTP.host = S8.pack (Client.baseUrlHost base),- HTTP.port = Client.baseUrlPort base,- HTTP.method = "POST",- HTTP.path = S8.pack (normalizePath (Client.baseUrlPath base) <> "/v1/chat/completions"),- HTTP.requestHeaders = requestHeaders,- HTTP.requestBody = HTTP.RequestBodyLBS (Aeson.encode requestBody),- -- EP-8 wires Options.timeoutMs through this local transport.- HTTP.responseTimeout = HTTP.responseTimeoutNone- }- HTTP.withResponse request (Client.manager env) $ \response ->+ HTTP.withResponse (buildRequest (Client.baseUrl env) requestHeaders requestBody) (Client.manager env) $ \response -> sseFromResponse response onMetadata onEvent +-- | The exact request this transport sends.+--+-- Pure and exported so that what goes on the wire — the method, the+-- composed path, and the redirect policy — is assertable without opening+-- a connection.+--+-- The path is the base URL's path plus @/v1/chat/completions@. The base URL+-- reaching here has already been through+-- 'Baikai.Http.canonicalBaseUrl', which strips a trailing @\/v1@+-- segment, so a caller who writes the base URL the way every OpenAI SDK+-- teaches it — @https:\/\/api.deepseek.com\/v1@ — gets one @\/v1@ here+-- rather than two.+buildRequest :: Client.BaseUrl -> RequestHeaders -> Aeson.Value -> HTTP.Request+buildRequest base requestHeaders requestBody =+ HTTP.defaultRequest+ { HTTP.secure = case Client.baseUrlScheme base of+ Client.Http -> False+ Client.Https -> True,+ HTTP.host = S8.pack (Client.baseUrlHost base),+ HTTP.port = Client.baseUrlPort base,+ HTTP.method = "POST",+ HTTP.path = S8.pack (normalizePath (Client.baseUrlPath base) <> "/v1/chat/completions"),+ HTTP.requestHeaders = requestHeaders,+ HTTP.requestBody = HTTP.RequestBodyLBS (Aeson.encode requestBody),+ -- This POST has no legitimate redirect, and http-client's default+ -- is to follow up to ten of them with every header intact — which+ -- would re-send the credential to whatever host a Location names.+ -- At zero the 3xx comes back untouched and 'sseFromResponse'+ -- delivers it as the one in-band terminal error, carrying its+ -- status.+ HTTP.redirectCount = 0,+ -- No per-response bound here: Options.timeoutMs is enforced around+ -- the whole call by Transport.runWithTimeout.+ HTTP.responseTimeout = HTTP.responseTimeoutNone+ }+ -- | Consume an @http-client@ response as an OpenAI-compatible SSE -- stream. --@@ -157,10 +186,15 @@ if not (Status.statusIsSuccessful st) then do bodyChunks <- HTTP.brConsume (HTTP.responseBody response)+ now <- getCurrentTime let bodyText = decodeLenient (SBS.concat bodyChunks)- retryAfter =- parseRetryAfterSeconds . decodeLenient- =<< lookup (CI.mk "Retry-After") (HTTP.responseHeaders response)+ headerText name = decodeLenient <$> lookup (CI.mk name) (HTTP.responseHeaders response)+ -- The server's own Date is the reference instant for an+ -- HTTP-date Retry-After, which CDN-fronted hosts send on a+ -- 429; the local clock is the fallback. Using the response's+ -- clock keeps this machine's skew out of the hint.+ reference = fromMaybe now (parseHttpDate =<< headerText "Date")+ retryAfter = retryAfterSecondsAt reference =<< headerText "Retry-After" onEvent (Left (httpError (Status.statusCode st) retryAfter bodyText)) else do lineBufRef <- IORef.newIORef SBS.empty@@ -170,12 +204,20 @@ case es of [] -> pure False _ -> do- let payload = S8.concat es- if payload == "[DONE]"- then pure True- else case Aeson.eitherDecodeStrict payload of- Left err -> onEvent (Left (decodeError (Text.pack err))) >> pure False- Right val -> onEvent (Right val) >> pure False+ -- Trailing whitespace is trimmed before the comparison:+ -- hosts send @data: [DONE] @ and @data: [DONE]\r@, and+ -- an exact match against those turned the end of a+ -- healthy stream into a decode error. An empty payload+ -- is a heartbeat, not a frame.+ let payload = S8.dropWhileEnd isSpace (S8.concat es)+ if SBS.null payload+ then pure False+ else+ if payload == "[DONE]"+ then pure True+ else case Aeson.eitherDecodeStrict payload of+ Left err -> onEvent (Left (decodeError (Text.pack err))) >> pure False+ Right val -> onEvent (Right val) >> pure False handleLine line = let l = stripCR line
src/Baikai/Provider/OpenAI/Transport.hs view
@@ -1,3 +1,10 @@+-- | __Exposed with no stability guarantees.__ This module is exposed so+-- the test suites can drive the transport without a socket, and so+-- sibling packages can reuse its pieces; it is not part of the public+-- API and may change in /any/ release without a PVP major bump.+--+-- Transport settings, header assembly and key resolution for+-- OpenAI-compatible Chat Completions hosts. module Baikai.Provider.OpenAI.Transport ( getClientEnvCached, cachedClientEnvCount,@@ -8,10 +15,11 @@ where import Baikai.Auth qualified as Auth-import Baikai.Error (BaikaiError (..), ErrorCategory (..), authError)+import Baikai.Error (BaikaiError (..), ErrorCategory (..), authError, invalidRequest)+import Baikai.Header (HeaderName, renderHeaderName)+import Baikai.Http (cachedClientEnvCount, getClientEnvCached) import Baikai.Model (Model (..)) import Baikai.Options (Options (..))-import Control.Concurrent.MVar (MVar, modifyMVar, newMVar) import Control.Exception (throwIO) import Control.Lens ((^.)) import Data.CaseInsensitive qualified as CI@@ -20,26 +28,9 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text-import Network.HTTP.Client qualified as HTTP-import Network.HTTP.Client.TLS qualified as TLS import Network.HTTP.Types.Header (RequestHeaders)-import Servant.Client qualified as Client-import System.IO.Unsafe (unsafePerformIO) import System.Timeout qualified as Timeout -getClientEnvCached :: Text -> IO Client.ClientEnv-getClientEnvCached baseUrl =- modifyMVar clientEnvCache $ \cache ->- case Map.lookup baseUrl cache of- Just env -> pure (cache, env)- Nothing -> do- env <- newClientEnv baseUrl- pure (Map.insert baseUrl env cache, env)--cachedClientEnvCount :: IO Int-cachedClientEnvCount =- modifyMVar clientEnvCache $ \cache -> pure (cache, Map.size cache)- requestHeaders :: Text -> Model -> Options -> RequestHeaders requestHeaders apiKey m opts = applyHeaderOverrides@@ -59,13 +50,30 @@ authError $ "no default API key env is known for " <> baseUrl <> "; set Options.apiKey explicitly" +-- | Run the transport action under 'Baikai.Options.timeoutMs'.+--+-- 'Nothing' is no bound. A non-positive bound is a caller error and is+-- refused as 'InvalidRequest' /without running the action/, so no+-- connection is opened: 'System.Timeout.timeout' returns immediately at+-- zero and runs unbounded below it, and both spellings used to fail as+-- a retryable 'TransientError' — a classification a retry loop will+-- re-issue forever for a configuration mistake. runWithTimeout :: Maybe Int -> IO () -> IO (Maybe BaikaiError) runWithTimeout Nothing action = action >> pure Nothing-runWithTimeout (Just ms) action = do- result <- Timeout.timeout (max 0 ms * 1000) action- pure $ case result of- Just () -> Nothing- Nothing -> Just (timeoutError ms)+runWithTimeout (Just ms) action+ | ms <= 0 =+ pure . Just . invalidRequest $+ "Options.timeoutMs must be positive, got "+ <> Text.pack (show ms)+ <> "; use Nothing for no bound"+ -- ms * 1000 would wrap negative, and a negative interval is silently+ -- "no bound". A bound this large is one in practice.+ | ms > maxBound `div` 1000 = action >> pure Nothing+ | otherwise = do+ result <- Timeout.timeout (ms * 1000) action+ pure $ case result of+ Just () -> Nothing+ Nothing -> Just (timeoutError ms) timeoutError :: Int -> BaikaiError timeoutError ms =@@ -77,28 +85,18 @@ exitCode = Nothing } -newClientEnv :: Text -> IO Client.ClientEnv-newClientEnv baseUrl = do- parsed <- Client.parseBaseUrl (Text.unpack baseUrl)- manager <-- TLS.newTlsManagerWith- TLS.tlsManagerSettings- { HTTP.managerResponseTimeout = HTTP.responseTimeoutNone- }- pure (Client.mkClientEnv manager parsed)-+-- | Apply caller overrides over the provider's own headers.+--+-- The key type already carries the case-insensitivity rule, so the+-- overrides cannot contain two spellings of one name and the fold only+-- has to replace what the provider set. applyHeaderOverrides :: RequestHeaders ->- [(Text, Text)] ->+ [(HeaderName, Text)] -> RequestHeaders applyHeaderOverrides = foldl addHeader where addHeader headers (name, value) =- let nameBytes = Text.encodeUtf8 name- ciName = CI.mk nameBytes+ let ciName = CI.mk (Text.encodeUtf8 (renderHeaderName name)) in (ciName, Text.encodeUtf8 value) : filter ((/= ciName) . fst) headers--{-# NOINLINE clientEnvCache #-}-clientEnvCache :: MVar (Map.Map Text Client.ClientEnv)-clientEnvCache = unsafePerformIO (newMVar Map.empty)
+ test/Contract.hs view
@@ -0,0 +1,45 @@+-- | The stream protocol, as an assertion.+--+-- Lives in its own module rather than in @Main@ because three suites+-- need it — the end-to-end cases in @Main@, the failure-stream cases in+-- @SseSpec@, and the evidence cases in @EvidenceSpec@ — and a protocol+-- asserted three slightly different ways is not asserted at all.+module Contract (assertErrorContract, assertOneErrorTerminal) where++import Baikai.Stream.Event+ ( AssistantMessageEvent (..),+ StartPayload (..),+ TerminalPayload (..),+ isTerminal,+ )+import Test.Tasty.HUnit (Assertion, assertFailure, (@?=))++-- | The whole documented protocol for a failing stream: exactly one+-- 'EventStart', first; exactly one terminal; and that terminal an+-- 'EventError' carrying structured 'errorInfo'.+--+-- Use this on anything that drains a provider stream. A fragment folded+-- straight through @translate@ never carried a start event, so it gets+-- 'assertOneErrorTerminal' instead.+assertErrorContract :: [AssistantMessageEvent] -> Assertion+assertErrorContract events = do+ case events of+ EventStart StartPayload {} : _ -> pure ()+ other -> assertFailure ("stream must begin with EventStart, got: " <> show (take 1 other))+ length [() | EventStart {} <- events] @?= 1+ assertOneErrorTerminal events+ case reverse events of+ (EventError TerminalPayload {} : _) -> pure ()+ other -> assertFailure ("stream must end with EventError, got: " <> show (take 1 other))++-- | The terminal half of 'assertErrorContract', for translator-level+-- fragments that never carried a start event.+assertOneErrorTerminal :: [AssistantMessageEvent] -> Assertion+assertOneErrorTerminal events = do+ let terminals = filter isTerminal events+ length terminals @?= 1+ case terminals of+ [EventError TerminalPayload {errorInfo = Nothing}] ->+ assertFailure "terminal EventError omitted errorInfo"+ [EventError TerminalPayload {errorInfo = Just _}] -> pure ()+ other -> assertFailure ("expected exactly one terminal EventError, got: " <> show other)
test/ErrorClassSpec.hs view
@@ -2,20 +2,17 @@ import Baikai.Error (BaikaiError (..), ErrorCategory (..), isRetryable) import Baikai.Provider.OpenAI.Internal.ErrorClass- ( classifyErrorText,+ ( classifyErrorFrame, classifyException,- responseToError, ) import Control.Exception (toException)-import Data.ByteString (ByteString)+import Data.Aeson (Value)+import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as LBS-import Data.CaseInsensitive qualified as CI-import Data.Sequence qualified as Seq import Data.Text qualified as Text+import Foreign.C.Error (Errno (..), eCONNRESET)+import GHC.IO.Exception qualified as IOE import Network.HTTP.Client qualified as HTTP-import Network.HTTP.Types.Status (mkStatus)-import Network.HTTP.Types.Version (http11)-import Servant.Client (ResponseF (..)) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, testCase, (@?=)) @@ -23,56 +20,41 @@ tests = testGroup "Baikai.Provider.OpenAI.Internal.ErrorClass"- [ httpStatusTests,- sdkTextTests,+ [ errorFrameTests, streamedErrorTests, fallbackTests ] -mkResp :: Int -> [(ByteString, ByteString)] -> LBS.ByteString -> ResponseF LBS.ByteString-mkResp status hdrs body =- Response- { responseStatusCode = mkStatus status "",- responseHeaders = Seq.fromList [(CI.mk n, v) | (n, v) <- hdrs],- responseHttpVersion = http11,- responseBody = body- }--httpStatusTests :: TestTree-httpStatusTests =- testGroup- "responseToError (HTTP status)"- [ testCase "429 + Retry-After -> RateLimited with hint" $ do- let e = responseToError (mkResp 429 [("Retry-After", "12")] "slow down")- category e @?= RateLimited- httpStatus e @?= Just 429- retryAfterSeconds e @?= Just 12,- testCase "401 -> AuthError" $- category (responseToError (mkResp 401 [] "bad key")) @?= AuthError,- testCase "400 with overflow body -> ContextOverflow" $- category (responseToError (mkResp 400 [] "maximum context length is 8192 tokens"))- @?= ContextOverflow,- testCase "400 ordinary -> InvalidRequest" $- category (responseToError (mkResp 400 [] "unknown parameter")) @?= InvalidRequest,- testCase "500 -> TransientError" $- category (responseToError (mkResp 500 [] "")) @?= TransientError- ]-+-- | The phrase table, pinned through the entry point the runtime uses.+--+-- These four phrases used to be fed to a bare-'Text' classifier that no+-- production path called. They still classify the same way, but now as+-- the @message@ of a frame the transport can actually deliver. streamedErrorTests :: TestTree streamedErrorTests = testGroup- "classifyErrorText (mid-stream error text)"+ "classifyErrorFrame (message phrase fallback)" [ testCase "rate limit text -> RateLimited" $- fmap category (classifyErrorText "Rate limit reached for requests") @?= Just RateLimited,+ fmap category (classifyErrorFrame (frameWithMessage "Rate limit reached for requests"))+ @?= Just RateLimited, testCase "context length text -> ContextOverflow" $- fmap category (classifyErrorText "This model's maximum context length is 4096 tokens")+ fmap+ category+ (classifyErrorFrame (frameWithMessage "This model's maximum context length is 4096 tokens")) @?= Just ContextOverflow, testCase "invalid api key text -> AuthError" $- fmap category (classifyErrorText "Incorrect API key provided") @?= Just AuthError,+ fmap category (classifyErrorFrame (frameWithMessage "Incorrect API key provided"))+ @?= Just AuthError, testCase "unknown text -> OtherError" $- fmap category (classifyErrorText "something odd happened") @?= Just OtherError,- testCase "blank text -> Nothing" $- classifyErrorText " " @?= Nothing+ fmap category (classifyErrorFrame (frameWithMessage "something odd happened"))+ @?= Just OtherError,+ -- A blank message is still a frame: the error key is what makes it+ -- one, and dropping it would put the call back on the "stream+ -- ended without finish_reason" path this milestone exists to fix.+ testCase "a frame whose message is blank still classifies" $ do+ let parsed = classifyErrorFrame (frameWithMessage " ")+ fmap category parsed @?= Just OtherError+ fmap message parsed @?= Just "provider sent an error frame without a message" ] fallbackTests :: TestTree@@ -97,24 +79,91 @@ HTTP.ResponseTimeout category e @?= TransientError assertBool "response timeout is retryable" (isRetryable e),- testCase "non-ClientError exception -> OtherError, text preserved" $ do+ -- The delegation itself, through the provider's entry point: a+ -- reset raised from the body read reaches the worker as a raw+ -- IOException, which no HttpException branch would have matched.+ testCase "a body-read reset is transient through classifyException" $ do+ let e =+ classifyException . toException $+ IOE.IOError+ { IOE.ioe_handle = Nothing,+ IOE.ioe_type = IOE.ResourceVanished,+ IOE.ioe_location = "Network.Socket.recvBuf",+ IOE.ioe_description = "Connection reset by peer",+ IOE.ioe_errno = Just (case eCONNRESET of Errno n -> n),+ IOE.ioe_filename = Nothing+ }+ category e @?= TransientError+ assertBool "a mid-stream reset is retryable" (isRetryable e),+ testCase "non-transport exception -> OtherError, text preserved" $ do let e = classifyException (toException (userError "weird failure")) category e @?= OtherError assertBool "message keeps the original text" $ "weird failure" `Text.isInfixOf` message e ] -sdkTextTests :: TestTree-sdkTextTests =+-- | The frames a compatible host actually sends on a 2xx stream.+errorFrameTests :: TestTree+errorFrameTests = testGroup- "classifyErrorText (SDK HTTP text)"- [ testCase "429 SDK text -> RateLimited with status" $ do+ "classifyErrorFrame (in-band error frames)"+ [ -- OpenRouter forwards the upstream HTTP status as a *number* in+ -- `code`, and sends a `choices` array beside the error, so+ -- detection cannot key on the absence of `choices`.+ testCase "an OpenRouter upstream 502 frame is TransientError with httpStatus 502" $ do let parsed =- classifyErrorText- "HTTP error 429 Too Many Requests: {\"error\":{\"message\":\"Rate limit reached...\",\"type\":\"tokens\"}}"+ classifyErrorFrame . decode $+ "{\"error\":{\"message\":\"Provider returned error\",\"code\":502,\+ \\"metadata\":{\"provider_name\":\"x\"}},\+ \\"choices\":[{\"index\":0,\"finish_reason\":\"error\",\"delta\":{}}]}"+ fmap category parsed @?= Just TransientError+ fmap httpStatus parsed @?= Just (Just 502)+ fmap message parsed @?= Just "Provider returned error"+ fmap isRetryable parsed @?= Just True,+ testCase "an OpenAI insufficient_quota frame is AuthError and not retryable" $ do+ let parsed =+ classifyErrorFrame . decode $+ "{\"error\":{\"message\":\"You exceeded your current quota\",\+ \\"type\":\"insufficient_quota\",\"code\":\"insufficient_quota\"}}"+ fmap category parsed @?= Just AuthError+ fmap isRetryable parsed @?= Just False,+ testCase "a rate_limit_exceeded code is RateLimited" $+ fmap+ category+ ( classifyErrorFrame . decode $+ "{\"error\":{\"message\":\"slow down\",\"code\":\"rate_limit_exceeded\"}}"+ )+ @?= Just RateLimited,+ testCase "a context_length_exceeded code is ContextOverflow" $+ fmap+ category+ ( classifyErrorFrame . decode $+ "{\"error\":{\"message\":\"too big\",\"code\":\"context_length_exceeded\"}}"+ )+ @?= Just ContextOverflow,+ testCase "an upstream 429 status wins over the message text" $ do+ let parsed =+ classifyErrorFrame . decode $+ "{\"error\":{\"message\":\"something odd\",\"status\":429}}" fmap category parsed @?= Just RateLimited fmap httpStatus parsed @?= Just (Just 429),- testCase "401 SDK text -> AuthError" $- fmap category (classifyErrorText "HTTP error 401 Unauthorized: {\"error\":{\"message\":\"bad key\"}}")- @?= Just AuthError+ testCase "a string-valued error is a frame" $ do+ let parsed = classifyErrorFrame (decode "{\"error\":\"Rate limit reached\"}")+ fmap category parsed @?= Just RateLimited+ fmap message parsed @?= Just "Rate limit reached",+ testCase "a chunk without an error key is not a frame" $+ classifyErrorFrame (decode "{\"choices\":[]}") @?= Nothing,+ testCase "a non-object payload is not a frame" $+ classifyErrorFrame (decode "[1,2,3]") @?= Nothing ]++-- | The minimal frame: an error object carrying only a message.+frameWithMessage :: Text.Text -> Value+frameWithMessage msg = Aeson.object ["error" Aeson..= Aeson.object ["message" Aeson..= msg]]++-- | Fixtures are written as the JSON the host sends, so what is under+-- test is the shape on the wire rather than a hand-built 'Value'.+decode :: LBS.ByteString -> Value+decode raw = case Aeson.eitherDecode raw of+ Right v -> v+ Left err -> error ("fixture is not valid JSON: " <> err)
test/EvidenceSpec.hs view
@@ -16,12 +16,13 @@ import Baikai import Baikai.Models.Generated (openai_gpt_4o_mini)-import Baikai.Provider.OpenAI.Api (SseDriver, openaiChatStreamWith)+import Baikai.Provider.OpenAI.Internal.Stream (SseDriver, openaiChatStreamWith) import Baikai.Provider.OpenAI.Shape (describeThinkingShape) import Baikai.Provider.OpenAI.Sse (sseFromResponse) import Baikai.Trace (withTraceStreamWith) import Baikai.Trace.Event (TraceEvent (..)) import Baikai.Trace.Sink (TraceSink (..))+import Contract (assertErrorContract) import Control.Concurrent.STM (TVar, atomically, modifyTVar', newTVarIO, readTVarIO) import Control.Lens ((&), (.~), (^.)) import Data.Aeson (Value (..))@@ -53,6 +54,10 @@ [ successEvidenceTest, rateLimitEvidenceTest, toggleHostIndistinguishabilityTest,+ nonReasoningModelEvidenceTest,+ immediateErrorRecordsThinkingTest,+ defaultHostEndpointTest,+ responseIdCountsAsCorrelationTest, optOutTest ] @@ -146,6 +151,15 @@ field "usage" ev @?= Just (String "unobserved") field "strength" ev @?= Just (String "correlated") + -- The same replay as a stream: an HTTP failure that arrives before+ -- the first chunk still begins with 'EventStart'.+ assertErrorContract+ =<< replayStreamEvents+ 429+ [("x-request-id", "req_rate_limited"), ("Retry-After", "7")]+ ["{\"error\":{\"message\":\"slow down\",\"type\":\"tokens\"}}"]+ baseOptions+ -- | Two calls a toggle host cannot tell apart, which baikai's record -- can. --@@ -200,6 +214,67 @@ ] _ -> [] +-- | A call refused before the request was built still records the level+-- the caller asked for, described by the adapter's own describer.+--+-- 'Transport.resolveKey' refuses an unknown host rather than reading an+-- environment variable, so 'prepareCall' fails with an AuthError+-- whatever the developer's shell holds, the adapter takes+-- 'immediateError', and the replay driver is never reached.+immediateErrorRecordsThinkingTest :: TestTree+immediateErrorRecordsThinkingTest =+ testCase "a call refused before the request was built still records the requested level" $ do+ bodyRef <- newIORef Null+ let model = testModel & #baseUrl .~ "https://unknown-host.example"+ opts =+ emptyOptions+ & #evidence .~ Just (evidenceRequest "run-54")+ & #thinking .~ Just ThinkingHigh+ ev <-+ oneEvidence+ =<< replayWith bodyRef model 200 successHeaders successBody opts+ field "status" ev @?= Just (String "failed")+ thinkingOf ev "requested" @?= Just (String "high")+ let described =+ describeThinkingShape (openaiCompletionsCompatFor model) (model ^. #reasoning) opts+ expectedMode = case Aeson.toJSON described of+ Object d -> KeyMap.lookup "mode" d+ _ -> Nothing+ thinkingOf ev "mode" @?= expectedMode+ assertBool+ "the mode must not collapse the request into absent"+ (thinkingOf ev "mode" /= Just (String "absent"))++-- | A model carrying no base URL still records the host the call went+-- to. See the Anthropic twin for why.+defaultHostEndpointTest :: TestTree+defaultHostEndpointTest =+ testCase "a call with no base URL records the default host it went to" $ do+ bodyRef <- newIORef Null+ ev <-+ oneEvidence+ =<< replayWith bodyRef (testModel & #baseUrl .~ "") 200 successHeaders successBody baseOptions+ case field "endpoint" ev of+ Just (Object e) -> KeyMap.lookup "endpoint" e @?= Just (String "https://api.openai.com")+ other -> assertFailure ("expected an endpoint identity, got: " <> show other)++-- | A host that names its model and its response id on every chunk but+-- sends no correlation header still reaches @model_observed@.+--+-- This is the shape the three drifted strength functions disagreed+-- about: the API copies looked only at the captured header, so such a+-- host landed at @requested_only@ — below a host that sent only a+-- header and named nothing. A response id locates the call in the+-- provider's own records, which is what correlation means.+responseIdCountsAsCorrelationTest :: TestTree+responseIdCountsAsCorrelationTest =+ testCase "A RESPONSE ID WITH NO HEADER STILL REACHES model_observed" $ do+ ev <- oneEvidence =<< replayEvents 200 [] successBody baseOptions+ field "provider_request_id" ev @?= Just (String "unobserved")+ field "response_id" ev @?= Just (observedJson "chatcmpl-observed")+ field "observed_model" ev @?= Just (observedJson "gpt-4o-mini-20990101-server-side")+ field "strength" ev @?= Just (String "model_observed")+ optOutTest :: TestTree optOutTest = testCase "a call that asked for no evidence emits none" $ do@@ -234,13 +309,12 @@ reg <- newProviderRegistry let driver = replayDriver bodyRef status headers chunks provider =- ApiProvider- { apiTag = OpenAIChatCompletions,- stream = openaiChatStreamWith driver,- complete = streamingComplete (openaiChatStreamWith driver),- describeThinking = \m opts' ->- describeThinkingShape (openaiCompletionsCompatFor m) opts'- }+ apiProviderWith+ OpenAIChatCompletions+ (openaiChatStreamWith driver)+ (streamingComplete (openaiChatStreamWith driver))+ & #describeThinking .~ (\m opts' -> describeThinkingShape (openaiCompletionsCompatFor m) (m ^. #reasoning) opts')+ & #strengthCeiling .~ (declaredStrength OpenAIChatCompletions) registerApiProviderWith reg provider (ref, sink) <- memorySink _ <-@@ -249,6 +323,20 @@ (withTraceStreamWith reg sink model emptyContext opts) reverse <$> readTVarIO ref +-- | The same recorded response, drained as the provider stream itself+-- rather than through the trace path.+--+-- The evidence cases assert what the record says; this asserts that the+-- stream carrying it was protocol-conformant. One replay cannot do both,+-- because 'withTraceStreamWith' hands back trace events, not stream+-- events.+replayStreamEvents ::+ Int -> [(ByteString, ByteString)] -> [ByteString] -> Options -> IO [AssistantMessageEvent]+replayStreamEvents status headers chunks opts = do+ bodyRef <- newIORef Null+ Stream.toList+ (openaiChatStreamWith (replayDriver bodyRef status headers chunks) testModel emptyContext opts)+ -- | A transport driver that serves a recorded response instead of -- opening a socket, and records the request body it was given. --@@ -301,9 +389,16 @@ -- | The same model pinned to a host that accepts a bare thinking -- toggle, which is the shape the indistinguishability case is about.+--+-- @reasoning@ is forced on: 'testModel' is @gpt-4o-mini@, which cannot+-- reason, and a level on such a model is now dropped before the host's+-- shape is consulted. The case is about the /host/ collapsing every+-- level onto one toggle, so it needs a model that reaches the host at+-- all. 'ShapeSpec.nonReasoningModelGateTest' covers the other half. toggleModel :: Model toggleModel = testModel+ & #reasoning .~ True & #compat .~ CompatOpenAICompletions defaultOpenAICompletionsCompat {thinkingFormat = ThinkingFormatZai}@@ -333,6 +428,36 @@ "\"choices\":[],\"usage\":{\"prompt_tokens\":11,\"completion_tokens\":5}}\n\n", "data: [DONE]\n\n" ]++nonReasoningModelEvidenceTest :: TestTree+nonReasoningModelEvidenceTest =+ testCase "a level on a non-reasoning model is dropped and the record says so" $ do+ -- gpt-4o-mini cannot reason. Before this, a level on it put+ -- reasoning_effort on the wire and took a 400; now nothing is sent+ -- and the record names the drop, which is what+ -- docs/user/model-call-evidence.md has always promised baikai-wide.+ bodyRef <- newIORef Null+ events <-+ replayWith+ bodyRef+ testModel+ 200+ successHeaders+ successBody+ (baseOptions & #thinking .~ Just ThinkingMax)+ ev <- oneEvidence events+ body <- readIORef bodyRef+ lookupIn "reasoning_effort" body @?= Nothing+ thinkingOf ev "mode" @?= Just (String "unsupported")+ thinkingOf ev "requested" @?= Just (String "max")+ thinkingOf ev "wire_field" @?= Just Null+ case thinkingOf ev "adjustments" of+ Just (Array adjustments) -> case Vector.toList adjustments of+ [Object a] -> do+ KeyMap.lookup "kind" a @?= Just (String "thinking_dropped_unsupported_model")+ KeyMap.lookup "requested" a @?= Just (String "max")+ other -> assertFailure ("expected exactly one adjustment, got: " <> show other)+ other -> assertFailure ("expected an adjustments array, got: " <> show other) -- ============================================================ -- Assertions on the encoded record
+ test/LifecycleSpec.hs view
@@ -0,0 +1,204 @@+-- | What happens to the worker thread and the HTTP connection when the+-- consumer stops.+--+-- The driver below is the real 'sseFromResponse' over a fake response+-- whose body reader never ends and whose close hook is observable, so a+-- worker killed mid-read provably closes the response exactly as+-- production's @HTTP.withResponse@ bracket would.+--+-- "Baikai.Provider.Internal.StreamWorker" states the three cleanup+-- strengths these four cases pin: bounded read then eventual release on+-- abandonment, immediate release on cancellation, and a worker that+-- cannot strand its consumer however it dies.+module LifecycleSpec (tests) where++import Baikai+import Baikai.Models.Generated (openai_gpt_4o_mini)+import Baikai.Provider.Internal.StreamWorker (frameQueueCapacity)+import Baikai.Provider.OpenAI.Internal.Stream (SseDriver, openaiChatStreamWith)+import Baikai.Provider.OpenAI.Sse (sseFromResponse)+import Control.Concurrent (forkIO, threadDelay, throwTo)+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)+import Control.Exception (AsyncException (ThreadKilled), SomeException, bracket, fromException, throwIO, try)+import Control.Lens ((&), (.~), (^.))+import Data.ByteString (ByteString)+import Data.CaseInsensitive qualified as CI+import Data.Generics.Labels ()+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)+import Network.HTTP.Client.Internal qualified as HTTP+import Network.HTTP.Types.Status (mkStatus)+import Network.HTTP.Types.Version (http11)+import Streamly.Data.Stream qualified as Stream+import System.Mem (performMajorGC)+import System.Timeout (timeout)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "Baikai.Provider.OpenAI lifecycle"+ [ boundedReadTest,+ abandonedReleasesAfterGcTest,+ cancellationReleasesWithoutGcTest,+ workerDeathCannotStrandTest+ ]++-- | The bound alone stops the socket read: no garbage collection and no+-- timer is involved. Before the frame queue the counter grew without+-- limit, because the worker drained an endless body into an unbounded+-- channel.+boundedReadTest :: TestTree+boundedReadTest =+ testCase "a consumer that stops after three events stops the body reader within the queue bound" $ do+ reads' <- newIORef (0 :: Int)+ closedRef <- newIORef False+ events <-+ Stream.toList+ ( Stream.take+ 3+ (openaiChatStreamWith (countingDriver reads' closedRef Nothing) testModel emptyContext testOptions)+ )+ length events @?= 3+ settled <- awaitSettled reads'+ assertBool+ ("body reader should stop within the queue bound, read " <> show settled <> " frames")+ (settled <= fromIntegral frameQueueCapacity + 8)++-- | The eventual guarantee. Nothing runs at the moment a consumer walks+-- away; streamly's finaliser kills the worker at the next major+-- collection, and that is when the connection goes back.+abandonedReleasesAfterGcTest :: TestTree+abandonedReleasesAfterGcTest =+ testCase "an abandoned stream releases its connection after a major GC" $ do+ reads' <- newIORef (0 :: Int)+ closedRef <- newIORef False+ _ <-+ Stream.toList+ ( Stream.take+ 3+ (openaiChatStreamWith (countingDriver reads' closedRef Nothing) testModel emptyContext testOptions)+ )+ released <- pollFor 100 50000 (performMajorGC >> readIORef closedRef)+ assertBool "an abandoned stream's connection is released at a major GC" released++-- | The immediate guarantee. The exception lands while the consumer is+-- inside the stream's step, which is inside the bracket, so streamly+-- runs the release synchronously.+cancellationReleasesWithoutGcTest :: TestTree+cancellationReleasesWithoutGcTest =+ testCase "cancelling the consumer releases the connection without a GC" $ do+ reads' <- newIORef (0 :: Int)+ closedRef <- newIORef False+ gate <- newEmptyMVar+ outcome <- newEmptyMVar+ tid <-+ forkIO $ do+ r <-+ try+ ( Stream.toList+ (openaiChatStreamWith (countingDriver reads' closedRef (Just gate)) testModel emptyContext testOptions)+ )+ putMVar outcome (r :: Either SomeException [AssistantMessageEvent])+ threadDelay 100000+ throwTo tid ThreadKilled+ released <- pollFor 100 10000 (readIORef closedRef)+ assertBool "cancellation releases the connection without a GC" released+ r <- takeMVar outcome+ case r of+ Left e | Just ThreadKilled <- fromException e -> pure ()+ other -> assertFailure ("expected the drained thread to die by ThreadKilled, got: " <> show (fmap length other))++-- | The queue's closed flag is set by the fork's own @finally@, so a+-- worker that dies by asynchronous exception still ends the stream.+-- Before the frame queue the consumer blocked until the runtime's+-- deadlock detector fired.+workerDeathCannotStrandTest :: TestTree+workerDeathCannotStrandTest =+ testCase "an asynchronous exception in the worker still closes the channel" $ do+ let dyingDriver :: SseDriver+ dyingDriver _env _headers _body _onMetadata _onEvent = throwIO ThreadKilled+ got <-+ timeout+ 2000000+ (Stream.toList (openaiChatStreamWith dyingDriver testModel emptyContext testOptions))+ case got of+ Nothing -> assertFailure "a worker killed asynchronously left the consumer blocked"+ Just events -> case reverse events of+ -- 'errorInfo' is a 'Maybe': whether a stream error carries a+ -- typed error at all is itself worth asserting.+ (EventError p : _) ->+ fmap (^. #message) (p ^. #errorInfo) @?= Just "openai stream ended without finish_reason"+ other -> assertFailure ("expected a terminal EventError, got: " <> show (take 1 other))++-- --------------------------------------------------------------------+-- Harness+-- --------------------------------------------------------------------++-- | A driver whose body reader is generated on demand and whose close+-- hook is observable. The bracket is the shape 'HTTP.withResponse' has,+-- so a worker killed mid-read closes the response as production would.+--+-- With a gate, the reader blocks forever from the fourth read on, which+-- is the state a cancelled consumer must be able to interrupt. Without+-- one, the body never ends, which is what makes the queue bound visible.+countingDriver :: IORef Int -> IORef Bool -> Maybe (MVar ()) -> SseDriver+countingDriver reads' closedRef gate _env _headers _body onMetadata onEvent =+ bracket mkFakeResponse HTTP.responseClose $ \resp ->+ sseFromResponse resp onMetadata onEvent+ where+ mkFakeResponse =+ pure+ HTTP.Response+ { HTTP.responseStatus = mkStatus 200 "",+ HTTP.responseVersion = http11,+ HTTP.responseHeaders = [(CI.mk "x-request-id", "req-lifecycle")],+ HTTP.responseBody = bodyReader,+ HTTP.responseCookieJar = HTTP.createCookieJar [],+ HTTP.responseClose' = HTTP.ResponseClose (writeIORef closedRef True),+ HTTP.responseOriginalRequest = HTTP.defaultRequest,+ HTTP.responseEarlyHints = []+ }+ bodyReader = do+ n <- atomicModifyIORef' reads' (\k -> (k + 1, k))+ case gate of+ Just g | n >= 3 -> takeMVar g >> pure ""+ _ -> pure contentFrame++-- | An endless stream of visible-text deltas.+contentFrame :: ByteString+contentFrame =+ "data: {\"id\":\"chatcmpl-lifecycle\",\"model\":\"gpt-lifecycle\","+ <> "\"choices\":[{\"index\":0,\"delta\":{\"content\":\"x\"}}]}\n\n"++-- | Poll the counter until it has not moved for four consecutive reads,+-- then report where it stopped. A counter that never settles fails the+-- caller's bound rather than hanging: the ceiling is generous and+-- finite.+awaitSettled :: IORef Int -> IO Int+awaitSettled ref = go (200 :: Int) (-1) (0 :: Int)+ where+ go 0 _ _ = readIORef ref+ go budget lastSeen stableFor = do+ threadDelay 50000+ n <- readIORef ref+ if n == lastSeen+ then if stableFor >= 3 then pure n else go (budget - 1) n (stableFor + 1)+ else go (budget - 1) n 0++pollFor :: Int -> Int -> IO Bool -> IO Bool+pollFor 0 _ _ = pure False+pollFor n delay act = do+ ok <- act+ if ok+ then pure True+ else threadDelay delay >> pollFor (n - 1) delay act++testModel :: Model+testModel =+ openai_gpt_4o_mini+ & #api .~ OpenAIChatCompletions+ & #baseUrl .~ "https://api.openai.com"++testOptions :: Options+testOptions = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "test-key")
test/Main.hs view
@@ -4,6 +4,7 @@ import Baikai.Agent ( AgentCapability (..), AgentCommand,+ AgentOutputFormat (..), AgentPromptTransport (..), AgentProvider (..), AgentRenderError (..),@@ -15,20 +16,21 @@ import Baikai.Cost qualified as Cost import Baikai.Cost.Pricing (computeCost) import Baikai.Provider.OpenAI.Agent qualified as CodexAgent-import Baikai.Provider.OpenAI.Api+import Baikai.Provider.OpenAI.Api (openaiChatStream)+import Baikai.Provider.OpenAI.Cli qualified as CodexCli+import Baikai.Provider.OpenAI.Interactive+import Baikai.Provider.OpenAI.Internal.Request (mapRequest)+import Baikai.Provider.OpenAI.Internal.Stream ( RawChunk (..), closeOpenStream, emptyAssembler,- openaiChatStream, parseUsage, rawUsageToUsage, translate, )-import Baikai.Provider.OpenAI.Cli qualified as CodexCli-import Baikai.Provider.OpenAI.Interactive-import Baikai.Provider.OpenAI.Internal.Request (mapRequest) import Baikai.Provider.OpenAI.Shape (describeThinkingShape) import CliEvidenceSpec qualified+import Contract (assertErrorContract, assertOneErrorTerminal) import Control.Exception (bracket) import Control.Lens ((&), (.~), (^.)) import Data.Aeson qualified as Aeson@@ -39,8 +41,11 @@ import Data.Vector qualified as Vector import ErrorClassSpec qualified import EvidenceSpec qualified+import LifecycleSpec qualified+import MidStreamSpec qualified import OpenAI.V1.Chat.Completions qualified as Chat import OpenAI.V1.ResponseFormat qualified as RF+import PublicSurfaceSpec qualified import ReasoningSpec qualified import ShapeSpec qualified import SseSpec qualified@@ -50,7 +55,7 @@ import System.FilePath ((</>)) import System.Timeout (timeout) import Test.Tasty (TestTree, defaultMain, testGroup)-import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) import TransportSpec qualified main :: IO ()@@ -61,8 +66,10 @@ [ commandRenderingTest, effortRenderingTests, safetyRefusalTest,+ refusesRejectedApprovalPoliciesTest, safetyStillRendersTest, agentCommandRenderingTest,+ agentOutputFormatTest, agentCapabilityRenderingTests, agentEffortRenderingTests, agentThinkingTranslationTests,@@ -88,6 +95,9 @@ CliEvidenceSpec.tests, ErrorClassSpec.tests, EvidenceSpec.tests,+ LifecycleSpec.tests,+ MidStreamSpec.tests,+ PublicSurfaceSpec.tests, ReasoningSpec.tests, ShapeSpec.tests, SseSpec.tests,@@ -121,7 +131,7 @@ opts = emptyOptions & #responseFormat- .~ Just (JsonSchema {name = "person", schema = personSchema, strict = True})+ .~ Just (JsonSchema (jsonSchemaFormat "person" personSchema) {strict = True}) case mapRequest model ctx opts of Left e -> assertFailure ("mapRequest failed: " <> Text.unpack e) Right req -> case Chat.response_format req of@@ -143,7 +153,7 @@ opts = emptyOptions & #topP .~ Just 0.9- & #stopSequences .~ Just (Vector.fromList ["END", "STOP"])+ & #stopSequences .~ ["END", "STOP"] & #seed .~ Just 7 & #frequencyPenalty .~ Just 0.2 & #presencePenalty .~ Just 0.3@@ -297,6 +307,36 @@ cmd ^. #promptTransport @?= PromptOnStdin cmd ^. #promptText @?= "reconcile the grammar" +-- | @codex exec --json@ prints its events as JSONL, which is the shape+-- the runner already parses; without it the tool prints a transcript+-- meant for a person and an evidence record can observe nothing.+agentOutputFormatTest :: TestTree+agentOutputFormatTest =+ testCase "unattended codex argv asks for structured events, and only when asked" $ do+ let base = agentRunRequest AgentCodex "/work/project" "reconcile the grammar"+ textual <- renderedAgentCommand CodexAgent.defaultCodexAgentConfig base+ textual ^. #arguments+ @?= [ "exec",+ "--sandbox",+ "read-only",+ "--cd",+ "/work/project",+ "--skip-git-repo-check",+ "--ephemeral"+ ]+ structured <-+ renderedAgentCommand CodexAgent.defaultCodexAgentConfig (base & #outputFormat .~ JsonFormat)+ structured ^. #arguments+ @?= [ "exec",+ "--json",+ "--sandbox",+ "read-only",+ "--cd",+ "/work/project",+ "--skip-git-repo-check",+ "--ephemeral"+ ]+ agentCapabilityRenderingTests :: TestTree agentCapabilityRenderingTests = testGroup@@ -529,6 +569,7 @@ (ThinkingDroppedUnsupportedHost ThinkingMax) ( describeThinkingShape (defaultOpenAICompletionsCompat {thinkingFormat = ThinkingFormatNone})+ True (emptyOptions & #thinking .~ Just ThinkingMax) ), testCase "THE NATIVE OPENAI SHAPE IS NOT A DOWNGRADE AND MUST NOT BE REFUSED" $ do@@ -538,12 +579,12 @@ -- baikai serves best. See plan 54's Decision Log. checkEvidenceRequirements (EvidenceRequired EvidenceModelObserved)- OpenAIChatCompletions+ (declaredStrength OpenAIChatCompletions) (shapeFor "https://api.openai.com/v1" ThinkingXHigh) @?= [] checkEvidenceRequirements (EvidenceRequired EvidenceModelObserved)- OpenAIChatCompletions+ (declaredStrength OpenAIChatCompletions) (shapeFor "https://api.openai.com/v1" ThinkingMax) @?= [], testCase "the codex CLI expresses every level, so only its strength refuses" $ do@@ -552,25 +593,30 @@ -- alone. checkEvidenceRequirements (EvidenceRequired EvidenceCorrelated)- OpenAICompletionsCli+ (declaredStrength OpenAICompletionsCli) (CodexCli.codexCliThinking (emptyOptions & #thinking .~ Just ThinkingMax)) @?= [] case checkEvidenceRequirements (EvidenceRequired EvidenceModelObserved)- OpenAICompletionsCli+ (declaredStrength OpenAICompletionsCli) (CodexCli.codexCliThinking (emptyOptions & #thinking .~ Just ThinkingMax)) of [StrengthUnreachable _ declared] -> declared @?= EvidenceCorrelated other -> assertFailure ("expected a strength refusal, got: " <> show other) ] where+ -- reasoning = True throughout: every case in this group is about+ -- what a /host/ shape does to a level. A model that cannot reason+ -- drops the level before the host is consulted at all, which+ -- ShapeSpec.nonReasoningModelGateTest covers separately. shapeFor url lvl = describeThinkingShape (openaiCompletionsCompatFor (emptyModel & #baseUrl .~ url & #api .~ OpenAIChatCompletions))+ True (emptyOptions & #thinking .~ Just lvl) expectDowngrade expected translation = case checkEvidenceRequirements (EvidenceRequired EvidenceRequestedOnly)- OpenAIChatCompletions+ (declaredStrength OpenAIChatCompletions) translation of [ThinkingWouldDowngrade [reported]] -> reported @?= expected other -> assertFailure ("expected one downgrade refusal, got: " <> show other)@@ -637,6 +683,58 @@ assertBool "names the rejected tools" ("Read" `Text.isInfixOf` message) assertBool "suggests an alternative" ("CodexSandbox" `Text.isInfixOf` message) +-- | An approval policy the installed CLI rejects is refused before a+-- process is created.+--+-- @codex --help@ at 0.149.1 lists exactly two possible values for+-- @--ask-for-approval@. Rendering @untrusted@ or @on-failure@ made the+-- CLI exit with a usage error, which reaches a caller as @Right@+-- carrying a non-zero exit code — a session that ran — rather than as+-- the refusal this module promises. The message has to name both the+-- value that was rejected and one that would work, because an operator+-- reading it is choosing a replacement.+refusesRejectedApprovalPoliciesTest :: TestTree+refusesRejectedApprovalPoliciesTest =+ testGroup+ "refuses the approval policies the installed codex CLI rejects"+ ( [ testCase (Text.unpack spelling) $ do+ let req =+ interactiveLaunchRequest "inspect the repo"+ & #safety .~ CodexSandbox CodexReadOnly policy+ case codexInteractiveCommand defaultCodexInteractiveConfig req of+ Right rendered -> assertFailure ("expected refusal, rendered: " <> show rendered)+ Left err -> do+ case err of+ SafetyNotExpressible p _ -> p @?= AgentCodex+ other -> assertFailure ("expected SafetyNotExpressible, got: " <> show other)+ let message = renderAgentRenderError err+ assertBool+ ("names the rejected value: " <> Text.unpack message)+ (spelling `Text.isInfixOf` message)+ assertBool+ ("names a policy that works: " <> Text.unpack message)+ ("CodexApprovalOnRequest" `Text.isInfixOf` message)+ | (spelling, policy) <-+ [ ("untrusted", CodexApprovalUntrusted),+ ("on-failure", CodexApprovalOnFailure)+ ]+ ]+ <> [ testCase "an accepted policy still renders" $ do+ let req =+ interactiveLaunchRequest "inspect"+ & #safety .~ CodexSandbox CodexWorkspaceWrite CodexApprovalOnRequest+ fmap snd (codexInteractiveCommand defaultCodexInteractiveConfig req)+ @?= Right+ [ "--sandbox",+ "workspace-write",+ "--ask-for-approval",+ "on-request",+ "--",+ "inspect"+ ]+ ]+ )+ -- | The fix refuses only what Codex cannot express. A sandbox policy is -- expressible and must still render, and an empty allow-list restricts -- nothing so it renders no safety flag rather than being refused.@@ -881,10 +979,13 @@ (read "2026-06-05 00:00:02 UTC") (events3, _) = closeOpenStream (read "2026-06-05 00:00:03 UTC") Nothing ass2 let terminalEvents = events2 <> events3- assertErrorContract terminalEvents+ assertOneErrorTerminal terminalEvents case last terminalEvents of EventError TerminalPayload {errorInfo = Just be} -> do- be ^. #category @?= OtherError+ -- Its own category, so a caller can branch on a filtered+ -- response without matching on the message text.+ be ^. #category @?= ContentFiltered+ isRetryable be @?= False assertBool "message mentions content_filter" ("content_filter" `Text.isInfixOf` (be ^. #message)) other -> assertFailure ("expected EventError for content_filter, got: " <> show other), testCase "unknown finish_reason is a successful diagnostic" $ do@@ -915,15 +1016,6 @@ (const (unsetEnv name >> action)) where restore = maybe (unsetEnv name) (setEnv name)--assertErrorContract :: [AssistantMessageEvent] -> Assertion-assertErrorContract events = do- let terminals = filter isTerminal events- length terminals @?= 1- case terminals of- [EventError TerminalPayload {errorInfo = Nothing}] ->- assertFailure "terminal EventError omitted errorInfo"- _ -> pure () assistantText :: Response -> Text.Text assistantText resp =
+ test/MidStreamSpec.hs view
@@ -0,0 +1,311 @@+-- | What the caller sees when a stream that started healthily stops+-- badly.+--+-- Every case here drives the real provider stream — @translate@, the+-- assembler, the worker's error path — over a body reader that raises+-- from @brRead@ after handing out the chunks it was given. That is+-- exactly what a socket reset, a server closing mid-chunk, and a TLS+-- session torn down after the handshake look like to the transport, and+-- it is the shape the classifier could not see before the shared core+-- rule: @http-client@ wraps the connect phase but not the body read, so+-- these exceptions reach the worker raw.+module MidStreamSpec (tests) where++import Baikai+ ( ApiKeySource (..),+ AssistantContent (..),+ AssistantMessageEvent (..),+ AssistantPayload (..),+ Message (..),+ Options,+ TerminalPayload (..),+ TextContent (..),+ emptyContext,+ emptyModel,+ emptyOptions,+ )+import Baikai.Api (Api (..))+import Baikai.Error (BaikaiError (..), ErrorCategory (..), isRetryable)+import Baikai.Model (Model)+import Baikai.Models.Generated (openai_gpt_4o_mini)+import Baikai.Provider.OpenAI.Api (openaiChatStream)+import Baikai.Provider.OpenAI.Internal.Stream (SseDriver, openaiChatStreamWith)+import Baikai.Provider.OpenAI.Sse (sseFromResponse)+import Contract (assertErrorContract)+import Control.Concurrent (forkIO, killThread)+import Control.Concurrent.MVar (newEmptyMVar, takeMVar, tryPutMVar)+import Control.Exception (SomeException, bracket, finally, handle, throwIO, toException)+import Control.Lens ((&), (.~), (^.))+import Data.ByteString (ByteString)+import Data.CaseInsensitive qualified as CI+import Data.Generics.Labels ()+import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Vector qualified as Vector+import Foreign.C.Error (Errno (..), eCONNRESET)+import GHC.IO.Exception qualified as IOE+import Network.HTTP.Client qualified as HTTP+import Network.HTTP.Client.Internal qualified as HTTPI+import Network.HTTP.Types.Status (mkStatus)+import Network.HTTP.Types.Version (http11)+import Network.Socket qualified as Socket+import Network.TLS qualified as TLS+import Streamly.Data.Stream qualified as Stream+import System.Timeout qualified as Timeout+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "mid-stream failures (OpenAI-compatible)"+ [ testCase "a connection reset after two chunks ends with a retryable EventError carrying the partial text" $ do+ events <- drainFailing contentChunks (toException connectionReset)+ assertErrorContract events+ be <- terminalError events+ category be @?= TransientError+ assertBool "a mid-stream reset is retryable" (isRetryable be)+ assertBool+ ("the drained text survives the failure: " <> show events)+ ("Hel" `Text.isInfixOf` terminalText events),+ testCase "a chunked-encoding EOF classifies as TransientError" $ do+ events <-+ drainFailing+ contentChunks+ (toException (HTTP.HttpExceptionRequest HTTP.defaultRequest HTTP.InvalidChunkHeaders))+ assertErrorContract events+ be <- terminalError events+ category be @?= TransientError+ assertBool "a mid-chunk close is retryable" (isRetryable be),+ -- Raised raw, as it is from brRead: http-client installs no+ -- wrapper around the body reader that would convert it.+ testCase "a TLS termination mid-body classifies as TransientError" $ do+ events <- drainFailing contentChunks (toException (TLS.PostHandshake TLS.Error_EOF))+ assertErrorContract events+ be <- terminalError events+ category be @?= TransientError+ assertBool "a torn-down TLS session is retryable" (isRetryable be),+ testCase "a stalled socket is cut off by timeoutMs as TransientError" $ do+ (events, _) <- withStalledServer $ \port -> drainLive port (Just 200)+ assertErrorContract events+ be <- terminalError events+ category be @?= TransientError+ assertBool "a timed-out call is retryable" (isRetryable be)+ assertBool+ ("the message names the bound that fired: " <> show (be ^. #message))+ ("timeoutMs=200" `Text.isInfixOf` (be ^. #message)),+ testCase "timeoutMs of zero is rejected as InvalidRequest before any connection" $ do+ (events, accepted) <- withStalledServer $ \port -> drainLive port (Just 0)+ assertErrorContract events+ be <- terminalError events+ category be @?= InvalidRequest+ assertBool "a caller-side mistake is not retryable" (not (isRetryable be))+ accepted @?= 0,+ testCase "a negative timeoutMs is rejected as InvalidRequest" $ do+ (events, accepted) <- withStalledServer $ \port -> drainLive port (Just (-1))+ assertErrorContract events+ be <- terminalError events+ category be @?= InvalidRequest+ assertBool "a caller-side mistake is not retryable" (not (isRetryable be))+ accepted @?= 0,+ testCase "a programming error in the body path stays OtherError" $ do+ events <- drainFailing contentChunks (toException (userError "bug in callback"))+ assertErrorContract events+ be <- terminalError events+ category be @?= OtherError+ assertBool "a callback bug is not retryable" (not (isRetryable be)),+ -- An upstream failure the host only learned about after committing+ -- to a 200. It arrives on a healthy stream and must end the call+ -- with its own classification, not as+ -- OtherError "openai stream ended without finish_reason".+ testCase "an in-band error frame on a 2xx stream terminates with the frame's classification" $ do+ events <-+ drainReplay+ ( take 1 contentChunks+ <> [ "data: {\"error\":{\"message\":\"Provider returned error\",\"code\":502},\+ \\"choices\":[{\"index\":0,\"finish_reason\":\"error\",\"delta\":{}}]}\n\n",+ "data: [DONE]\n\n"+ ]+ )+ assertErrorContract events+ be <- terminalError events+ category be @?= TransientError+ httpStatus be @?= Just 502+ be ^. #message @?= "Provider returned error"+ assertBool "an upstream 502 is retryable" (isRetryable be),+ testCase "an in-band insufficient_quota frame is AuthError and not retryable" $ do+ events <-+ drainReplay+ [ "data: {\"error\":{\"message\":\"You exceeded your current quota\",\+ \\"type\":\"insufficient_quota\",\"code\":\"insufficient_quota\"}}\n\n",+ "data: [DONE]\n\n"+ ]+ assertErrorContract events+ be <- terminalError events+ category be @?= AuthError+ assertBool "an exhausted quota is not retryable" (not (isRetryable be))+ ]++-- ============================================================+-- Fixtures+-- ============================================================++-- | Two ordinary content frames, @"Hel"@ then @"lo"@, with no+-- @finish_reason@: the stream is healthy right up to the failure.+contentChunks :: [ByteString]+contentChunks =+ [ "data: {\"id\":\"chatcmpl-1\",\"model\":\"gpt-4o-mini\",\"choices\":[{\"index\":0,\"delta\":{\"content\":\"Hel\"}}]}\n\n",+ "data: {\"id\":\"chatcmpl-1\",\"model\":\"gpt-4o-mini\",\"choices\":[{\"index\":0,\"delta\":{\"content\":\"lo\"}}]}\n\n"+ ]++-- | The canonical mid-stream reset: the peer sent RST while the+-- response body was still arriving.+connectionReset :: IOE.IOException+connectionReset =+ IOE.IOError+ { IOE.ioe_handle = Nothing,+ IOE.ioe_type = IOE.ResourceVanished,+ IOE.ioe_location = "Network.Socket.recvBuf",+ IOE.ioe_description = "Connection reset by peer",+ IOE.ioe_errno = Just (case eCONNRESET of Errno n -> n),+ IOE.ioe_filename = Nothing+ }++-- | Drain the provider stream over a body reader that yields @chunks@+-- and then raises @ex@ from the next @brRead@.+drainFailing :: [ByteString] -> SomeException -> IO [AssistantMessageEvent]+drainFailing chunks ex =+ Stream.toList (openaiChatStreamWith (failingDriver chunks ex) testModel emptyContext testOptions)++-- | Drain the provider stream over a body reader that ends normally,+-- for the frames that are themselves the failure.+drainReplay :: [ByteString] -> IO [AssistantMessageEvent]+drainReplay chunks =+ Stream.toList (openaiChatStreamWith (replayDriver chunks) testModel emptyContext testOptions)++replayDriver :: [ByteString] -> SseDriver+replayDriver chunks _env _headers _body onMetadata onEvent = do+ resp <- mkReplayResponse chunks+ sseFromResponse resp onMetadata onEvent++failingDriver :: [ByteString] -> SomeException -> SseDriver+failingDriver chunks ex _env _headers _body onMetadata onEvent = do+ resp <- mkFailingResponse chunks ex+ sseFromResponse resp onMetadata onEvent++-- | 'EvidenceSpec.mkResponse' with one difference: the exhausted branch+-- of the body reader raises instead of returning the empty string that+-- means end-of-body.+mkFailingResponse :: [ByteString] -> SomeException -> IO (HTTP.Response HTTP.BodyReader)+mkFailingResponse chunks ex = mkResponseWith chunks (throwIO ex)++-- | The ordinary recorded response: an empty read means end-of-body.+mkReplayResponse :: [ByteString] -> IO (HTTP.Response HTTP.BodyReader)+mkReplayResponse chunks = mkResponseWith chunks (pure "")++mkResponseWith :: [ByteString] -> IO ByteString -> IO (HTTP.Response HTTP.BodyReader)+mkResponseWith chunks onExhausted = do+ ref <- newIORef chunks+ let bodyReader = do+ remaining <- readIORef ref+ case remaining of+ [] -> onExhausted+ (x : xs) -> writeIORef ref xs >> pure x+ pure+ HTTPI.Response+ { HTTPI.responseStatus = mkStatus 200 "OK",+ HTTPI.responseVersion = http11,+ HTTPI.responseHeaders = [(CI.mk "content-type", "text/event-stream")],+ HTTPI.responseBody = bodyReader,+ HTTPI.responseCookieJar = HTTP.createCookieJar [],+ HTTPI.responseClose' = HTTPI.ResponseClose (pure ()),+ HTTPI.responseOriginalRequest = HTTP.defaultRequest,+ HTTPI.responseEarlyHints = []+ }++testModel :: Model+testModel =+ openai_gpt_4o_mini+ & #api .~ OpenAIChatCompletions+ & #baseUrl .~ "https://api.openai.com"++-- | A literal key so no environment variable is consulted.+testOptions :: Options+testOptions = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "test-key")++-- ============================================================+-- Assertions+-- ============================================================++terminalError :: [AssistantMessageEvent] -> IO BaikaiError+terminalError events = case reverse events of+ (EventError TerminalPayload {errorInfo = Just be} : _) -> pure be+ other -> assertFailure ("expected a terminal EventError carrying errorInfo, got: " <> show (take 1 other))++-- | The text the terminal message carries. This is where the drained+-- partial text has to survive: the assembler closes the blocks that+-- were open when the failure landed.+terminalText :: [AssistantMessageEvent] -> Text+terminalText events = case reverse events of+ (EventError TerminalPayload {message = AssistantMessage AssistantPayload {content = blocks}} : _) ->+ Text.concat [t | AssistantText TextContent {text = t} <- Vector.toList blocks]+ _ -> ""++-- ============================================================+-- A socket that never answers+-- ============================================================++-- | A TCP listener on @127.0.0.1@ that accepts one connection and holds+-- it open without ever reading or writing: an HTTP server that has+-- stalled after the connect succeeded.+--+-- Port @0@ asks the kernel for a free port, so the test never collides+-- with anything else on the machine or with a parallel run of itself.+-- The returned count is how many connections were accepted, which is+-- what proves a refused bound opened no socket at all.+withStalledServer :: (Int -> IO a) -> IO (a, Int)+withStalledServer body = bracket open Socket.close $ \listener -> do+ port <- Socket.socketPort listener+ accepted <- newIORef (0 :: Int)+ release <- newEmptyMVar+ acceptor <- forkIO . handle (\(_ :: SomeException) -> pure ()) $ do+ (conn, _) <- Socket.accept listener+ modifyIORef' accepted (+ 1)+ takeMVar release+ Socket.close conn+ result <- body (fromIntegral port) `finally` (tryPutMVar release () >> killThread acceptor)+ count <- readIORef accepted+ pure (result, count)+ where+ open = do+ s <- Socket.socket Socket.AF_INET Socket.Stream Socket.defaultProtocol+ Socket.setSocketOption s Socket.ReuseAddr 1+ Socket.bind s (Socket.SockAddrInet 0 (Socket.tupleToHostAddress (127, 0, 0, 1)))+ Socket.listen s 1+ pure s++-- | Drain the /live/ stream against a local port, under a guard that+-- turns a stuck run into a failure rather than a hung suite.+drainLive :: Int -> Maybe Int -> IO [AssistantMessageEvent]+drainLive port bound = do+ let model = stallModel port+ opts = testOptions & #timeoutMs .~ bound+ result <- Timeout.timeout 10_000_000 (Stream.toList (openaiChatStream model emptyContext opts))+ case result of+ Just events -> pure events+ Nothing -> assertFailure "the ten-second guard fired: timeoutMs never did"++-- | A model pointed at the local listener. Built from 'emptyModel' so no+-- catalog base URL can override the port under test.+stallModel :: Int -> Model+stallModel port =+ emptyModel+ & #modelId+ .~ "stall-test"+ & #provider+ .~ "test"+ & #api+ .~ OpenAIChatCompletions+ & #baseUrl+ .~ Text.pack ("http://127.0.0.1:" <> show port)
+ test/PublicSurfaceSpec.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedRecordDot #-}++-- | A downstream consumer's view of @baikai-openai@, compiled.+--+-- Imports only the four public modules — no @.Internal@, no+-- @Baikai.Prelude@, no lens — and builds everything a consumer builds.+-- The compilation is the test: a name that stops being exported, or a+-- record that can no longer be built without its constructor, fails the+-- build here rather than at a consumer.+module PublicSurfaceSpec (tests) where++import Baikai+import Baikai.Agent (AgentCommand (executable), AgentProvider (AgentCodex), agentRunRequest)+import Baikai.Provider.OpenAI.Agent qualified as Agent+import Baikai.Provider.OpenAI.Api qualified as Api+import Baikai.Provider.OpenAI.Cli qualified as Cli+import Baikai.Provider.OpenAI.Interactive qualified as Interactive+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "public surface (baikai-openai)"+ [ testCase "the provider values carry their API tags" $ do+ Api.openaiChatProvider.apiTag @?= OpenAIChatCompletions+ (Cli.codexCliProvider Cli.defaultCodexCliConfig).apiTag @?= OpenAICompletionsCli,+ testCase "the interactive launcher renders a command without running one" $+ case Interactive.codexInteractiveCommand+ Interactive.defaultCodexInteractiveConfig+ (interactiveLaunchRequest "look around") of+ Left refusal -> assertRefusalIsUnexpected refusal+ Right (executable, _args) -> executable @?= "codex",+ testCase "the unattended renderer renders a command without running one" $+ case Agent.codexAgentCommand+ Agent.defaultCodexAgentConfig+ (agentRunRequest AgentCodex "." "summarise") of+ Left refusal -> assertRefusalIsUnexpected refusal+ Right (cmd, _translation) -> cmd.executable @?= "codex"+ ]+ where+ assertRefusalIsUnexpected refusal =+ fail ("expected a rendered command, got a refusal: " <> show refusal)
test/ReasoningSpec.hs view
@@ -4,22 +4,30 @@ import Baikai import Baikai.Models.Generated-import Baikai.Provider.OpenAI.Api+import Baikai.Provider.OpenAI.Internal.Request (mapRequest)+import Baikai.Provider.OpenAI.Internal.Stream ( RawChunk (..), closeOpenStream, emptyAssembler,+ emptyTagScanState, parseChunk,+ parseFrame, scanThinkTags, translate,- _TagScanState, )-import Baikai.Provider.OpenAI.Internal.Request (mapRequest)+import Baikai.Provider.OpenAI.Sse (sseFromResponse) import Control.Lens ((&), (.~)) import Data.Aeson qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString.Lazy qualified as LBS import Data.Generics.Labels ()+import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef) import Data.Text qualified as Text import Data.Time.Clock (UTCTime) import Data.Vector qualified as Vector+import Network.HTTP.Client.Internal qualified as HTTP+import Network.HTTP.Types.Status (mkStatus)+import Network.HTTP.Types.Version (http11) import OpenAI.V1.Chat.Completions qualified as Chat import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertFailure, testCase, (@?=))@@ -83,22 +91,40 @@ }, AssistantText (TextContent "answer done") ],- testCase "whole message shape yields reasoning then text" $ do- let raw =- Aeson.object- [ "choices"- Aeson..= [ Aeson.object- [ "message"- Aeson..= Aeson.object- [ "reasoning_content" Aeson..= ("because" :: Text.Text),- "content" Aeson..= ("answer" :: Text.Text)- ],- "finish_reason" Aeson..= ("stop" :: Text.Text)- ]- ]- ]- chunk <- either (assertFailure . ("parse failed: " <>)) pure (parseChunk raw)- terminalContent (runChunks deepseek_deepseek_reasoner [chunk])+ testCase "reasoning after visible text closes the text block first" $ do+ -- The other half of the same rule: opening a thinking block+ -- closes an open text block, so at most one of the two is open+ -- at a time and every _End precedes the next _Start. Before+ -- this, reasoning opened at index 1 while text stayed open at+ -- 0, and the later text delta landed back on 0 -- two blocks+ -- open at once and an index revisited after a later one.+ let chunks =+ [ emptyChunk {contentDelta = Just "a"},+ emptyChunk {reasoningDelta = Just "r"},+ emptyChunk {contentDelta = Just "b"},+ emptyChunk {finishReason = Just "stop"}+ ]+ events = runChunks deepseek_deepseek_reasoner chunks+ eventShape events+ @?= [ "TextStart:0",+ "TextDelta:0:a",+ "TextEnd:0:a",+ "ThinkingStart:1",+ "ThinkingDelta:1:r",+ "ThinkingEnd:1:r",+ "TextStart:2",+ "TextDelta:2:b",+ "TextEnd:2:b",+ "EventDone"+ ],+ -- Driven through the transport rather than handed straight to+ -- 'parseChunk', because a `data:` frame is the only way this+ -- object can reach the assembler: a whole-message shape on a+ -- streaming endpoint is what a compatible host sends when it+ -- ignores `stream: true`, and it still arrives framed.+ testCase "a data frame carrying a whole message object yields reasoning then text" $ do+ chunks <- transportChunks [dataFrame wholeMessageObject, "data: [DONE]\n\n"]+ terminalContent (runChunks deepseek_deepseek_reasoner chunks) @?= Vector.fromList [ AssistantThinking ThinkingContent@@ -107,20 +133,84 @@ redacted = False }, AssistantText (TextContent "answer")- ]+ ],+ -- The honest statement of the transport's limitation: an SSE+ -- transport decodes frames, so a bare JSON body with no @data:@+ -- prefix reaches nothing at all. Pretending 'parseMessageObject'+ -- is reachable for such a body would be pretending.+ testCase "a bare JSON body with no data prefix is not decoded" $ do+ chunks <- transportChunks [LBS.toStrict (Aeson.encode wholeMessageObject)]+ length chunks @?= 0 ] +-- | The shape a compatible host sends when it answers a streaming+-- request with a whole message instead of deltas.+wholeMessageObject :: Aeson.Value+wholeMessageObject =+ Aeson.object+ [ "choices"+ Aeson..= [ Aeson.object+ [ "message"+ Aeson..= Aeson.object+ [ "reasoning_content" Aeson..= ("because" :: Text.Text),+ "content" Aeson..= ("answer" :: Text.Text)+ ],+ "finish_reason" Aeson..= ("stop" :: Text.Text)+ ]+ ]+ ]++dataFrame :: Aeson.Value -> ByteString+dataFrame v = "data: " <> LBS.toStrict (Aeson.encode v) <> "\n\n"++-- | Push a recorded 200 body through the real 'sseFromResponse' and the+-- real 'parseFrame', which is the pair the worker runs.+transportChunks :: [ByteString] -> IO [RawChunk]+transportChunks body = do+ eventsRef <- newIORef []+ resp <- mkResponse 200 body+ sseFromResponse resp (const (pure ())) (\ev -> modifyIORef' eventsRef (<> [ev]))+ events <- readIORef eventsRef+ traverse decodeOne [v | Right v <- events]+ where+ decodeOne v = case parseFrame v of+ Right (Right chunk) -> pure chunk+ Right (Left be) -> assertFailure ("expected a chunk, got a classified error: " <> show be)+ Left err -> assertFailure ("parse failed: " <> err)++-- | The same fixture shape both 'SseSpec' and 'EvidenceSpec' keep, so+-- neither suite can silently change another's response.+mkResponse :: Int -> [ByteString] -> IO (HTTP.Response HTTP.BodyReader)+mkResponse status chunks = do+ ref <- newIORef chunks+ let bodyReader = do+ remaining <- readIORef ref+ case remaining of+ [] -> pure ""+ (x : xs) -> writeIORef ref xs >> pure x+ pure+ HTTP.Response+ { HTTP.responseStatus = mkStatus status "",+ HTTP.responseVersion = http11,+ HTTP.responseHeaders = [],+ HTTP.responseBody = bodyReader,+ HTTP.responseCookieJar = HTTP.createCookieJar [],+ HTTP.responseClose' = HTTP.ResponseClose (pure ()),+ HTTP.responseOriginalRequest = HTTP.defaultRequest,+ HTTP.responseEarlyHints = []+ }+ tagScannerTests :: TestTree tagScannerTests = testGroup "scanThinkTags" [ testCase "split tags across deltas" $ do- let (st1, p1) = scanThinkTags _TagScanState "<th"+ let (st1, p1) = scanThinkTags emptyTagScanState "<th" (st2, p2) = scanThinkTags st1 "ink>reasoning</thi" (_st3, p3) = scanThinkTags st2 "nk>answer" p1 <> p2 <> p3 @?= [Left "reasoning", Right "answer"], testCase "literal less-than text passes through" $ do- let (_st, parts) = scanThinkTags _TagScanState "2 < 3"+ let (_st, parts) = scanThinkTags emptyTagScanState "2 < 3" parts @?= [Right "2 < 3"] ]
test/ShapeSpec.hs view
@@ -5,16 +5,16 @@ import Baikai import Baikai.Content qualified as Content import Baikai.Models.Generated qualified as Models-import Baikai.Provider.OpenAI.Api+import Baikai.Provider.OpenAI.Internal.Request (mapRequest)+import Baikai.Provider.OpenAI.Internal.Stream ( RawChunk (..), RawToolDelta (..), closeOpenStream, emptyAssembler, translate, )-import Baikai.Provider.OpenAI.Internal.Request (mapRequest) import Baikai.Provider.OpenAI.Shape (streamRequestBody)-import Control.Lens ((&), (.~))+import Control.Lens ((&), (.~), (^.)) import Data.Aeson (Value (..), (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as AesonKey@@ -39,23 +39,82 @@ strictModeGateTest, usageStreamingGateTest, zeroCapOmissionTest,- indexlessToolDeltaTest+ indexlessToolDeltaTest,+ nonReasoningModelGateTest ] deepseekShapeTest :: TestTree deepseekShapeTest = testCase "DeepSeek request body uses max_tokens and reasoning shape" $ do+ -- deepseek-reasoner rather than deepseek-chat: the point of this+ -- case is DeepSeek's wire shape, and the shape only reaches the+ -- wire for a model whose catalog entry says it can reason.+ -- deepseek-chat cannot, and is now covered by+ -- 'nonReasoningModelGateTest'. Same host, same compat record. value <- shapedBody- Models.deepseek_deepseek_chat+ Models.deepseek_deepseek_reasoner (emptyOptions & #thinking .~ Just ThinkingHigh) emptyContext lookupTop "max_completion_tokens" value @?= Nothing- lookupTop "max_tokens" value @?= Just (Number 8192)+ lookupTop "max_tokens" value+ @?= Just (Number (fromIntegral (Models.deepseek_deepseek_reasoner ^. #maxOutputTokens))) lookupTop "thinking" value @?= Just (Aeson.object ["type" .= ("enabled" :: Text.Text)]) lookupTop "reasoning_effort" value @?= Just (String "high") +-- | A level on a model that does not advertise reasoning support sends+-- no reasoning control at all, on any host, and says so.+--+-- Before this, @gpt-4o-mini@ plus any level put @reasoning_effort@ on+-- the wire and took a 400 for it, and @deepseek-chat@ took DeepSeek's+-- @thinking@ object. The catalog's @reasoning@ flag is the+-- authoritative capability fact, and this is the check the Anthropic+-- adapter has always made.+nonReasoningModelGateTest :: TestTree+nonReasoningModelGateTest =+ testGroup+ "a level on a non-reasoning model is dropped and recorded"+ [ testCase "deepseek-chat sends neither thinking nor reasoning_effort" $ do+ (value, translation) <-+ shapedCall+ Models.deepseek_deepseek_chat+ (emptyOptions & #thinking .~ Just ThinkingHigh)+ emptyContext+ lookupTop "thinking" value @?= Nothing+ lookupTop "reasoning_effort" value @?= Nothing+ translation ^. #mode @?= ThinkingModeUnsupported+ translation ^. #requested @?= Just ThinkingHigh+ translation ^. #wireField @?= Nothing+ translation ^. #adjustments @?= [ThinkingDroppedUnsupportedModel ThinkingHigh],+ testCase "gpt-4o-mini on OpenAI's own host sends no reasoning_effort" $ do+ (value, translation) <-+ shapedCall+ Models.openai_gpt_4o_mini+ (emptyOptions & #thinking .~ Just ThinkingHigh)+ emptyContext+ lookupTop "reasoning_effort" value @?= Nothing+ translation ^. #adjustments @?= [ThinkingDroppedUnsupportedModel ThinkingHigh],+ testCase "the model check precedes the host-format check" $ do+ -- A non-reasoning model on a host whose format is None would+ -- record ThinkingDroppedUnsupportedHost if the checks ran the+ -- other way round. The model's answer is the stronger one.+ (_, translation) <-+ shapedCall+ ( Models.openai_gpt_4o_mini+ & #compat+ .~ CompatOpenAICompletions+ defaultOpenAICompletionsCompat {thinkingFormat = ThinkingFormatNone}+ )+ (emptyOptions & #thinking .~ Just ThinkingHigh)+ emptyContext+ translation ^. #adjustments @?= [ThinkingDroppedUnsupportedModel ThinkingHigh],+ testCase "a non-reasoning model with no level requested records nothing" $ do+ (_, translation) <- shapedCall Models.openai_gpt_4o_mini emptyOptions emptyContext+ translation ^. #mode @?= ThinkingModeAbsent+ translation ^. #adjustments @?= []+ ]+ nativeHigherEffortTests :: TestTree nativeHigherEffortTests = testGroup@@ -76,9 +135,12 @@ compatibleHigherEffortClampTest :: TestTree compatibleHigherEffortClampTest = testCase "OpenAI-compatible higher reasoning effort clamps to high" $ do+ -- The reasoning model on the same host: the point is DeepSeek's+ -- effort vocabulary, which is only reached for a model that can+ -- reason at all. value <- shapedBody- Models.deepseek_deepseek_chat+ Models.deepseek_deepseek_reasoner (emptyOptions & #thinking .~ Just ThinkingMax) emptyContext lookupTop "reasoning_effort" value @?= Just (String "high")@@ -255,7 +317,7 @@ assertEffort Models.openai_gpt_5_6_terra ThinkingXHigh "xhigh" [], testCase "deepseek xhigh clamps to high and records it" $ assertEffort- Models.deepseek_deepseek_chat+ Models.deepseek_deepseek_reasoner ThinkingXHigh "high" [EffortClamped ThinkingXHigh "high"],@@ -263,7 +325,7 @@ assertEffort Models.openai_gpt_5_6_terra ThinkingMax "max" [], testCase "deepseek max clamps to high and records it" $ assertEffort- Models.deepseek_deepseek_chat+ Models.deepseek_deepseek_reasoner ThinkingMax "high" [EffortClamped ThinkingMax "high"]@@ -300,7 +362,7 @@ opts = emptyOptions & #responseFormat- .~ Just (JsonSchema {name = "shape", schema = schema, strict = True})+ .~ Just (JsonSchema (jsonSchemaFormat "shape" schema) {strict = True}) value <- shapedBody Models.deepseek_deepseek_chat opts emptyContext lookupPath ["response_format", "json_schema", "strict"] value @?= Nothing@@ -386,7 +448,7 @@ shapedCall :: Model -> Options -> Context -> IO (Value, ThinkingTranslation) shapedCall model opts ctx = do req <- either (assertFailure . Text.unpack) pure (mapRequest model ctx opts)- pure (streamRequestBody (openaiCompletionsCompatFor model) opts req)+ pure (streamRequestBody (openaiCompletionsCompatFor model) (model ^. #reasoning) opts req) lookupTop :: Text.Text -> Value -> Maybe Value lookupTop field = lookupPath [field]
test/SseSpec.hs view
@@ -1,23 +1,45 @@ module SseSpec (tests) where -import Baikai.Error (BaikaiError, ErrorCategory (..), category, httpStatus, providerError, retryAfterSeconds)-import Baikai.Evidence (Observed (..))+import Baikai+import Baikai.Http qualified as Http import Baikai.Models.Generated (openai_gpt_4o_mini)-import Baikai.Provider.OpenAI.Api (Assembler, RawChunk, emptyAssembler, parseChunk, translate)-import Baikai.Provider.OpenAI.Sse (ResponseMetadata, sseFromResponse)-import Control.Lens ((^.))+import Baikai.Provider.OpenAI.Internal.Stream+ ( Assembler,+ RawChunk (..),+ SseDriver,+ emptyAssembler,+ openaiChatStreamWith,+ parseFrame,+ translate,+ )+import Baikai.Provider.OpenAI.Sse+ ( ResponseMetadata,+ buildRequest,+ openaiSseStreamValueWithHeaders,+ sseFromResponse,+ )+import Contract (assertErrorContract)+import Control.Lens ((&), (.~), (^.))+import Control.Monad (forM_) import Data.Aeson qualified as Aeson import Data.ByteString (ByteString)+import Data.ByteString qualified as SBS+import Data.ByteString.Char8 qualified as S8+import Data.ByteString.Lazy qualified as LBS import Data.CaseInsensitive qualified as CI import Data.Generics.Labels ()-import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef)+import Data.IORef (IORef, atomicModifyIORef', modifyIORef', newIORef, readIORef, writeIORef) import Data.Text qualified as Text import Data.Time.Clock (UTCTime)+import Data.Vector (Vector)+import Data.Vector qualified as Vector import Network.HTTP.Client.Internal qualified as HTTP import Network.HTTP.Types.Status (mkStatus) import Network.HTTP.Types.Version (http11)+import Servant.Client qualified as Client+import Streamly.Data.Stream qualified as Stream import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))+import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=)) tests :: TestTree tests =@@ -35,6 +57,37 @@ retryAfterSeconds e @?= Just 9 httpStatus e @?= Just 429 other -> assertFailure ("expected one classified error, got: " <> show other),+ -- CDN-fronted hosts send a date rather than a count on a 429.+ -- The response's own Date is the reference instant, so the hint+ -- does not inherit this machine's clock skew.+ testCase "HTTP-date Retry-After is converted using the response Date header" $ do+ eventsRef <- newIORef []+ metaRef <- newIORef []+ resp <-+ mkResponse+ 429+ [ ("Retry-After", "Wed, 21 Oct 2026 07:28:00 GMT"),+ ("Date", "Wed, 21 Oct 2026 07:27:15 GMT")+ ]+ ["{\"error\":{\"message\":\"slow down\"}}"]+ sseFromResponse resp (\md -> modifyIORef' metaRef (<> [md])) (\ev -> modifyIORef' eventsRef (<> [ev]))+ events <- readIORef eventsRef+ case events of+ [Left e] -> do+ category e @?= RateLimited+ retryAfterSeconds e @?= Just 45+ other -> assertFailure ("expected one classified error, got: " <> show other),+ testCase "HTTP-date Retry-After without a Date header uses the current time" $ do+ eventsRef <- newIORef []+ metaRef <- newIORef []+ resp <- mkResponse 429 [("Retry-After", "Wed, 21 Oct 2099 07:28:00 GMT")] [""]+ sseFromResponse resp (\md -> modifyIORef' metaRef (<> [md])) (\ev -> modifyIORef' eventsRef (<> [ev]))+ events <- readIORef eventsRef+ case events of+ [Left e] -> case retryAfterSeconds e of+ Just n -> assertBool ("a date in 2099 is far in the future, got " <> show n) (n > 0)+ Nothing -> assertFailure "expected a converted Retry-After hint"+ other -> assertFailure ("expected one classified error, got: " <> show other), testCase "[DONE] terminates without emitting a JSON event" $ do eventsRef <- newIORef [] metaRef <- newIORef []@@ -44,9 +97,183 @@ case events of [Right (Aeson.Object _)] -> pure () other -> assertFailure ("expected one JSON event before [DONE], got: " <> show other),- observationTests+ testCase "an HTTP 401 stream is EventStart then one EventError" $ do+ -- The whole provider stream, not just the transport: what a+ -- consumer sees when the call fails before the first chunk.+ events <- replayStream 401 [] ["{\"error\":{\"message\":\"bad key\",\"type\":\"invalid_request_error\"}}"]+ assertErrorContract events+ case reverse events of+ (EventError TerminalPayload {errorInfo = Just be} : _) -> category be @?= AuthError+ other -> assertFailure ("expected a terminal EventError carrying errorInfo, got: " <> show (take 1 other)),+ observationTests,+ blockClosingTests,+ requestShapeTests,+ redirectTests ] +-- | How blocks close when something goes wrong, and what the transport+-- does with a frame it was not written for.+blockClosingTests :: TestTree+blockClosingTests =+ testGroup+ "block closing under failure"+ [ testCase "[DONE] with trailing whitespace terminates without a decode error" $ do+ -- Hosts send @data: [DONE] @ and @data: [DONE]\r@; an exact+ -- comparison turned the end of a healthy stream into a decode+ -- error terminal.+ events <-+ transportEvents+ 200+ (init successBody <> ["data: [DONE] \n\n"])+ assertAllRight events+ length events @?= 3,+ testCase "an empty data heartbeat is ignored" $ do+ events <- transportEvents 200 ["data:\n\n", "data: {\"choices\":[]}\n\n", "data: [DONE]\n\n"]+ assertAllRight events+ length events @?= 1,+ testCase "a tool call cut off by finish_reason length closes with its raw argument text" $ do+ let chunks =+ [ toolChunk (Just "call_1") (Just "search") (Just "{\"query\":\"hel"),+ "data: {\"choices\":[{\"index\":0,\"delta\":{},\"finish_reason\":\"length\"}]}\n\n"+ ]+ events <- replayStream 200 [] chunks+ let calls = [tc | ToolCallEnd ToolCallEndPayload {toolCall = tc} <- events]+ case calls of+ [tc] -> do+ tc ^. #arguments @?= Aeson.String "{\"query\":\"hel"+ assertBool "the call is marked cut off" (isCutOffToolCall tc)+ other -> assertFailure ("expected exactly one ToolCallEnd, got: " <> show (length other))+ case reverse events of+ (EventDone TerminalPayload {reason = r} : _) -> r @?= Length+ other -> assertFailure ("expected a terminal EventDone, got: " <> show (take 1 other)),+ -- An upstream failure the host only learned about after+ -- committing to a 200. Before 'parseFrame' this frame parsed as an+ -- empty chunk, was dropped, and the call ended as+ -- OtherError "openai stream ended without finish_reason".+ testCase "an in-band error frame on a 2xx stream reaches the assembler as a classified Left" $ do+ events <-+ replayStream+ 200+ []+ [ "data: {\"id\":\"chatcmpl-1\",\"choices\":[{\"index\":0,\"delta\":{\"content\":\"Hel\"}}]}\n\n",+ openRouterErrorFrame,+ "data: [DONE]\n\n"+ ]+ assertErrorContract events+ case reverse events of+ (EventError TerminalPayload {errorInfo = Just be} : _) -> do+ category be @?= TransientError+ httpStatus be @?= Just 502+ be ^. #message @?= "Provider returned error"+ other -> assertFailure ("expected a classified terminal EventError, got: " <> show (take 1 other)),+ testCase "a mid-stream transport error closes open blocks before the terminal" $ do+ -- Injected through 'translate' rather than the transport,+ -- because what is under test is the assembler's Left path: a+ -- classified error arriving with a text block open.+ let (openEvents, ass) =+ translate+ (Right emptyChunk {contentDelta = Just "partial"})+ (emptyAssembler streamTestModel testTime)+ testTime+ (failEvents, _) = translate (Left (providerUnavailable "connection reset mid-stream")) ass testTime+ assertBool+ ("expected a text block to be open, got: " <> show openEvents)+ (not (null [() | TextStart {} <- openEvents]))+ case failEvents of+ [TextEnd BlockEndPayload {contentIndex = 0, content = body}, EventError TerminalPayload {message = msg}] -> do+ body @?= "partial"+ [t | AssistantText (TextContent t) <- Vector.toList (messageBlocks msg)] @?= ["partial"]+ other -> assertFailure ("expected TextEnd then EventError, got: " <> show other)+ ]++toolChunk :: Maybe Text.Text -> Maybe Text.Text -> Maybe Text.Text -> ByteString+toolChunk tid tname targs =+ "data: "+ <> LBS.toStrict+ ( Aeson.encode+ ( Aeson.object+ [ "choices"+ Aeson..= [ Aeson.object+ [ "index" Aeson..= (0 :: Int),+ "delta"+ Aeson..= Aeson.object+ [ "tool_calls"+ Aeson..= [ Aeson.object+ [ "index" Aeson..= (0 :: Int),+ "id" Aeson..= tid,+ "type" Aeson..= ("function" :: Text.Text),+ "function"+ Aeson..= Aeson.object+ ["name" Aeson..= tname, "arguments" Aeson..= targs]+ ]+ ]+ ]+ ]+ ]+ ]+ )+ )+ <> "\n\n"++-- | The raw chunk values the transport produced, with no assembler+-- involved.+transportEvents :: Int -> [ByteString] -> IO [Either BaikaiError Aeson.Value]+transportEvents status chunks = do+ eventsRef <- newIORef []+ resp <- mkResponse status [] chunks+ sseFromResponse resp (const (pure ())) (\ev -> modifyIORef' eventsRef (<> [ev]))+ readIORef eventsRef++assertAllRight :: [Either BaikaiError Aeson.Value] -> Assertion+assertAllRight events =+ case [e | Left e <- events] of+ [] -> pure ()+ errs -> assertFailure ("expected no transport errors, got: " <> show errs)++emptyChunk :: RawChunk+emptyChunk =+ RawChunk+ { contentDelta = Nothing,+ reasoningDelta = Nothing,+ finishReason = Nothing,+ toolDeltas = [],+ usage = Nothing,+ model = Nothing,+ responseId = Nothing+ }++messageBlocks :: Message -> Vector AssistantContent+messageBlocks = \case+ AssistantMessage AssistantPayload {content = c} -> c+ _ -> Vector.empty++-- | Drain a recorded response as the provider stream a consumer sees.+replayStream :: Int -> [(ByteString, ByteString)] -> [ByteString] -> IO [AssistantMessageEvent]+replayStream status headers chunks = do+ bodyRef <- newIORef Aeson.Null+ Stream.toList+ (openaiChatStreamWith (replayDriver bodyRef status headers chunks) streamTestModel emptyContext streamTestOptions)++-- | A transport driver that serves a recorded response instead of+-- opening a socket. The same shape as @EvidenceSpec.replayDriver@; the+-- two suites keep their own so neither can silently change the other's+-- fixtures.+replayDriver ::+ IORef Aeson.Value -> Int -> [(ByteString, ByteString)] -> [ByteString] -> SseDriver+replayDriver bodyRef status headers chunks _env _headers body onMetadata onEvent = do+ writeIORef bodyRef body+ resp <- mkResponse status headers chunks+ sseFromResponse resp onMetadata onEvent++streamTestModel :: Model+streamTestModel =+ openai_gpt_4o_mini+ & #api .~ OpenAIChatCompletions+ & #baseUrl .~ "https://api.openai.com"++streamTestOptions :: Options+streamTestOptions = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "test-key")+ -- | What the transport and the assembler between them can say about -- what the host reported, as opposed to what was configured. --@@ -153,14 +380,23 @@ events pure (metas, ass) --- | Chunks reach the assembler through 'parseChunk', exactly as the--- worker sends them.+-- | OpenRouter's mid-stream failure frame: the upstream status as a+-- number in @code@, and a @choices@ array beside the error, so detection+-- cannot key on the absence of @choices@.+openRouterErrorFrame :: ByteString+openRouterErrorFrame =+ "data: {\"error\":{\"message\":\"Provider returned error\",\"code\":502},\+ \\"choices\":[{\"index\":0,\"finish_reason\":\"error\",\"delta\":{}}]}\n\n"++-- | Frames reach the assembler through 'parseFrame', exactly as the+-- worker sends them — so an in-band error frame is sorted out here, not+-- parsed as an empty chunk. parsed :: Either BaikaiError Aeson.Value -> Either BaikaiError RawChunk parsed = \case Left e -> Left e- Right v -> case parseChunk v of+ Right v -> case parseFrame v of Left err -> Left (providerError (Text.pack err))- Right chunk -> Right chunk+ Right frame -> frame testTime :: UTCTime testTime = read "2026-07-03 12:00:00 UTC"@@ -184,3 +420,105 @@ HTTP.responseOriginalRequest = HTTP.defaultRequest, HTTP.responseEarlyHints = [] }++-- --------------------------------------------------------------------+-- What goes on the wire+-- --------------------------------------------------------------------++-- | The composed path and the redirect policy, asserted on the pure+-- request rather than by opening a connection.+--+-- The path cases are the base-URL convention: `Model.baseUrl` is the API+-- root, baikai appends `/v1/chat/completions` itself, and a trailing+-- `/v1` is removed rather than doubled — which is why+-- `https://api.deepseek.com/v1`, the spelling every OpenAI SDK teaches,+-- does not request `/v1/v1/...`.+requestShapeTests :: TestTree+requestShapeTests =+ testGroup+ "the request this transport sends"+ [ testCase "one version segment, whatever spelling the base URL used"+ $ forM_+ [ ("https://api.deepseek.com/v1", "/v1/chat/completions"),+ ("https://api.deepseek.com", "/v1/chat/completions"),+ ("https://openrouter.ai/api", "/api/v1/chat/completions"),+ ("https://openrouter.ai/api/v1/", "/api/v1/chat/completions"),+ ( "https://dashscope-intl.aliyuncs.com/compatible-mode/v1",+ "/compatible-mode/v1/chat/completions"+ )+ ]+ $ \(url, expected) -> case Http.canonicalBaseUrl url of+ Left problem -> assertFailure (Text.unpack (url <> " was refused: " <> problem))+ Right base -> do+ let request = buildRequest base [] (Aeson.object [])+ (url, HTTP.path request) @?= (url, S8.pack expected),+ testCase "the request never follows a redirect" $+ case Http.canonicalBaseUrl "https://h.test" of+ Left problem -> assertFailure (Text.unpack problem)+ Right base -> do+ let request = buildRequest base [] (Aeson.object [])+ HTTP.redirectCount request @?= 0+ HTTP.method request @?= "POST"+ ]++-- --------------------------------------------------------------------+-- A 3xx is an error, not a hop+-- --------------------------------------------------------------------++-- | A 302 is delivered as the terminal error and no second connection is+-- ever opened.+--+-- @http-client@'s default is to follow up to ten redirects with every+-- header intact, so before `redirectCount = 0` this test recorded a+-- second connection — to whatever host the `Location` header named —+-- carrying the caller's bearer token.+--+-- The "server" is an in-process fake built from `managerRawConnection`,+-- which is what lets the case observe /which hosts a connection was+-- opened to/ directly, with no socket and no port.+redirectTests :: TestTree+redirectTests =+ testGroup+ "redirects"+ [ testCase "a 302 is the terminal error and no second host is contacted" $ do+ attemptsRef <- newIORef []+ manager <- fakeRedirectingManager attemptsRef+ case Http.canonicalBaseUrl "http://proxy.test" of+ Left problem -> assertFailure (Text.unpack problem)+ Right base -> do+ let env = Client.mkClientEnv manager base+ eventsRef <- newIORef []+ metaRef <- newIORef []+ openaiSseStreamValueWithHeaders+ env+ [("Authorization", "Bearer sk-test")]+ (Aeson.object [])+ (\md -> modifyIORef' metaRef (<> [md]))+ (\ev -> modifyIORef' eventsRef (<> [ev]))+ attempts <- readIORef attemptsRef+ attempts @?= [("proxy.test", 80)]+ events <- readIORef eventsRef+ case events of+ [Left e] -> httpStatus e @?= Just 302+ other -> assertFailure ("expected one 302 error, got: " <> show other)+ ]++-- | A manager whose every connection answers one 302 pointing at another+-- host, and records the host and port it was opened to.+fakeRedirectingManager :: IORef [(String, Int)] -> IO HTTP.Manager+fakeRedirectingManager attemptsRef =+ HTTP.newManager+ HTTP.defaultManagerSettings+ { HTTP.managerRawConnection = pure open+ }+ where+ open _ host portNumber = do+ modifyIORef' attemptsRef (<> [(host, portNumber)])+ remaining <- newIORef [redirectResponse]+ HTTP.makeConnection+ (atomicModifyIORef' remaining (\chunks -> case chunks of [] -> ([], SBS.empty); (c : cs) -> (cs, c)))+ (\_ -> pure ())+ (pure ())+ redirectResponse =+ S8.pack+ "HTTP/1.1 302 Found\r\nLocation: http://evil.test/steal\r\nContent-Length: 0\r\n\r\n"
test/TransportSpec.hs view
@@ -1,18 +1,23 @@ module TransportSpec (tests) where import Baikai+import Baikai.Provider.OpenAI.Api (openaiChatStream) import Baikai.Provider.OpenAI.Transport qualified as Transport import Control.Concurrent (threadDelay) import Control.Exception (bracket, try) import Control.Lens ((&), (.~), (^.))+import Control.Monad (forM_) import Data.CaseInsensitive qualified as CI+import Data.IORef (newIORef, readIORef, writeIORef) import Data.Map.Strict qualified as Map import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Network.HTTP.Types.Header (RequestHeaders)+import Servant.Client qualified as Client+import Streamly.Data.Stream qualified as Stream import System.Environment (lookupEnv, setEnv, unsetEnv) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (assertFailure, testCase, (@?=))+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) tests :: TestTree tests =@@ -21,12 +26,26 @@ [ clientEnvCacheTest, requestHeadersTest, timeoutTest,- unknownHostKeyTest+ nonPositiveTimeoutTest,+ unknownHostKeyTest,+ unusableBaseUrlTest ] +-- | One entry per target, and one notion of what a target is.+--+-- Both halves are asserted in a single case because the cache is+-- process-global and this suite runs in parallel: two cases each reading+-- a count and expecting it to move by exactly one would race each other.+--+-- The normalisation half is what makes the count meaningful. The key is+-- the canonical rendering of "Baikai.Url"'s parse rather than the+-- caller's text, so a trailing slash and a capitalised host do not each+-- open their own connection pool to the same host — and the two provider+-- packages, which now share one cache in @Baikai.Http@, cannot disagree+-- about which target a URL names. clientEnvCacheTest :: TestTree clientEnvCacheTest =- testCase "cached ClientEnv is allocated once for a base URL" $ do+ testCase "the ClientEnv cache allocates once per normalised base URL" $ do let url = "https://cache-openai.test" before <- Transport.cachedClientEnvCount _ <- Transport.getClientEnvCached url@@ -35,6 +54,13 @@ afterSecond <- Transport.cachedClientEnvCount afterFirst @?= before + 1 afterSecond @?= afterFirst+ -- A different spelling of the same target: capitalised host,+ -- trailing slash.+ env <- Transport.getClientEnvCached "https://Cache-openai.test/"+ afterVariant <- Transport.cachedClientEnvCount+ afterVariant @?= afterSecond+ Client.baseUrlHost (Client.baseUrl env) @?= "cache-openai.test"+ Client.baseUrlPath (Client.baseUrl env) @?= "" requestHeadersTest :: TestTree requestHeadersTest =@@ -60,6 +86,23 @@ "timeoutMs=1" `Text.isInfixOf` (be ^. #message) @?= True Nothing -> assertFailure "expected timeout error" +nonPositiveTimeoutTest :: TestTree+nonPositiveTimeoutTest =+ testCase "runWithTimeout rejects a non-positive bound without running the action" $ do+ -- System.Timeout.timeout returns immediately at zero and runs+ -- unbounded below it, so both spellings used to fail instantly as a+ -- retryable TransientError, which a retry loop re-issues forever for+ -- what is a caller-side mistake.+ forM_ [0, -5] $ \ms -> do+ ran <- newIORef False+ result <- Transport.runWithTimeout (Just ms) (writeIORef ran True)+ case result of+ Just be -> do+ be ^. #category @?= InvalidRequest+ isRetryable be @?= False+ Nothing -> assertFailure ("expected an InvalidRequest for timeoutMs=" <> show ms)+ readIORef ran >>= (@?= False)+ unknownHostKeyTest :: TestTree unknownHostKeyTest = testCase "unknown hosts do not fall back to OPENAI_API_KEY" $@@ -77,5 +120,51 @@ withEnv name value = bracket (lookupEnv name <* setEnv name value)+ (maybe (unsetEnv name) (setEnv name))+ . const++-- | A base URL baikai will not send to is refused before a key is read.+--+-- The order matters as much as the refusal. These cases run with the+-- provider's own key variable *unset*, so an AuthError would prove the+-- check ran too late; an InvalidRequest proves nothing was looked up.+-- The messages also have to say what is wrong without echoing the part+-- of the URL that could be a credential.+unusableBaseUrlTest :: TestTree+unusableBaseUrlTest =+ testCase "an unusable base URL is refused before any key is read"+ $ withoutEnv "OPENAI_OpenAIChatCompletions_KEY"+ $ forM_+ [ ("https://h.test/v1?api-version=2024-01", "query string"),+ ("https://u:pw@h.test", "credentials"),+ ("h.test", "https://"),+ ("https://h.test/v1/chat/completions", "endpoint path")+ ]+ $ \(url, needle) -> do+ let model = emptyModel & #api .~ OpenAIChatCompletions & #baseUrl .~ url+ events <- Stream.toList (openaiChatStream model emptyContext emptyOptions)+ case events of+ [EventStart _, EventError payload] -> case payload ^. #errorInfo of+ Nothing -> assertFailure (Text.unpack url <> ": the error carried no errorInfo")+ Just err -> do+ let message = err ^. #message+ (url, err ^. #category) @?= (url, InvalidRequest)+ assertBool+ (Text.unpack (url <> " should name the problem: " <> message))+ (needle `Text.isInfixOf` message)+ assertBool+ (Text.unpack (url <> " must not echo the query: " <> message))+ (not ("api-version=2024-01" `Text.isInfixOf` message))+ assertBool+ (Text.unpack (url <> " must not echo the password: " <> message))+ (not ("pw@" `Text.isInfixOf` message))+ other ->+ assertFailure+ (Text.unpack url <> ": expected [EventStart, EventError], got: " <> show other)++withoutEnv :: String -> IO a -> IO a+withoutEnv name =+ bracket+ (lookupEnv name <* unsetEnv name) (maybe (unsetEnv name) (setEnv name)) . const