baikai-openai 0.6.0.0 → 0.7.0.0

raw patch · 28 files changed

+2223/−124 lines, 28 filesdep ~baikaidep ~http-client-tlsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: baikai, http-client-tls

API changes (from Hackage documentation)

Files

• CHANGELOG.md +200/−0
• baikai-openai.cabal +16/−4
• src/Baikai/Provider/OpenAI/Agent.hs +1/−0
• src/Baikai/Provider/OpenAI/Cli.hs +1/−0
• src/Baikai/Provider/OpenAI/Internal/Request.hs +32/−3
• src/Baikai/Provider/OpenAI/Internal/Stream.hs +25/−69
• src/Baikai/Provider/OpenAI/Internal/Usage.hs +55/−0
• src/Baikai/Provider/OpenAI/Responses.hs +35/−0
• src/Baikai/Provider/OpenAI/Responses/Assembler.hs +314/−0
• src/Baikai/Provider/OpenAI/Responses/Request.hs +228/−0
• src/Baikai/Provider/OpenAI/Responses/Stream.hs +214/−0
• src/Baikai/Provider/OpenAI/Shape.hs +37/−8
• src/Baikai/Provider/OpenAI/Sse.hs +34/−4
• src/Baikai/Provider/OpenAI/Transport.hs +2/−1
• test/BillingSpec.hs +91/−0
• test/EndpointModels.hs +20/−0
• test/EvidenceSpec.hs +30/−1
• test/LifecycleSpec.hs +53/−22
• test/Main.hs +16/−3
• test/ReasoningSpec.hs +26/−6
• test/ResponsesAssemblerSpec.hs +153/−0
• test/ResponsesEvidenceSpec.hs +187/−0
• test/ResponsesSpec.hs +158/−0
• test/ResponsesStreamSpec.hs +193/−0
• test/ResponsesTransportSpec.hs +30/−0
• test/ShapeSpec.hs +20/−1
• test/SseSpec.hs +1/−0
• test/TransportSpec.hs +51/−2

@@ -7,6 +7,206 @@  ## [Unreleased] +## [baikai 0.7.0.0] - 2026-09-08++### Added++- `BaikaiError.refusalCategory` preserves an Anthropic refusal's+  provider category. JSON adds `refusal_category`; older errors still decode.+  Evidence schema 2.5 records the addition without changing digest inputs.+  __Breaking__ to construct a `BaikaiError` from its full field list.++- `Speed`, `Options.speed`, catalog-owned fast rates and+  `computeCostAtSpeed`. Anthropic gates fast mode by model capability, adds the+  beta header and records unsupported drops. Terminal pricing uses observed+  speed, including cache duration; unreported speed is an explicit estimate.+  Older `Model` JSON defaults the new fields safely. __Breaking__: public+  records and sum types gain fields and constructors.++- API usage now records observed service tiers, inference speed and server-tool+  use in optional billing facts covered by evidence schema 2.2. Missing service+  information and uncurated products produce explicit standard-rate estimates.+  `computeCostForService` separates requested and observed service, while+  `computeCostAtRates` prices a resolved rate set once for future speed policies.+  Empty billing facts preserve legacy availability JSON; a CLI-reported zero+  cost retains its reported-total source. __Breaking__: the public vocabulary+  and records gain members.++- Failed trace terminals now retain partial response token counts, cost basis,+  usage availability and USD totals. Synthetic aborts leave unreported billing+  absent; legacy failed trace JSON still decodes. __Breaking__: `TraceEvent`'s+  `CallFailed` gains fields. See `baikai-trace-otel 0.4.0.1` for the export.++- Successful trace terminals and call-log records carry optional cost basis and+  usage availability; call logs also carry cache-write counts. Old JSON decodes+  with absent metadata and empty additive-zero bases stay omitted from traces.+  __Breaking__: `CallFinished` and the call-log record gain fields.++- Optional `Usage.availability` and shared inclusive/exclusive billing+  normalization, in the new `Baikai.Usage.Normalize`. OpenAI Chat/Responses and+  Claude preserve missing cache counters as explicit estimation reasons,+  distinguish reported zeroes, and merge cumulative usage without+  double-counting. Schema 2.2 commits provider availability while preserving+  legacy usage digests. __Breaking__: `Usage` gains a field.++- Optional `Model.pricingPolicy`, exact whole-request context tiers,+  and an explicit cache-duration rate resolver. Generated Astra pricing changes+  above 272000 input tokens; Fable exposes its one-hour write price. `Cost.basis`+  preserves calculation sources and estimation reasons when summed. Evidence+  schema 2.2 serializes the local basis without including local pricing metadata+  in provider commitments. __Breaking__: `Model` and `Cost` gain fields.++- Separate `OpenAIResponses` dispatch and compatibility types, and+  optional provider/model-scoped `ThinkingContent.replayState` with opaque+  diagnostic output and backward-compatible JSON decoding. Evidence schema 2.2+  includes replay state and optional billing facts in commitments while preserving+  legacy encodings when those fields are absent. __Breaking__ for a `case` over+  `Api` that is exhaustive without a wildcard.++- `Baikai.Evidence.ThinkingTranslation` gains `displayText` and+  `ThinkingAdjustment` gains `ThinkingSummaryUnavailable`, so a transport can+  record the thinking display setting it asked for and diagnose a successful+  response whose thinking blocks carry no readable summary. `Baikai.Compat`+  gains `supportsForcedToolChoice`; legacy JSON defaults it to True.+  __Breaking__ for an exhaustive `case` over `ThinkingAdjustment`.++- GPT-6 Astra and Claude Fable 5.1 catalog bindings, with verified+  pricing, token limits, and Anthropic thinking/sampling compatibility.++- Repository `update-models` skill for verifying provider releases and refreshing+  the curated JSON and generated Haskell catalog.++### Fixed++- Preserve OpenAI endpoint capability facts through catalog refreshes.++- Chat and Claude reject provider-scoped reasoning replay they cannot encode.++- Widened the `http-client-tls` bound to admit 0.4 (carried forward from the+  tagged but never-published 0.6.0.1).++## [baikai-claude 0.7.0.0] - 2026-09-08++### Changed++- Refusal messages include the reported category and explanation,+  retaining the original message when neither exists. Classification remains+  non-retryable `ContentFiltered`. Server-side fallbacks remain deliberately+  unsupported, as recorded in ADR 0005.++- Adaptive reasoning requests explicitly ask for summarized+  thinking. Evidence schema 2.4 records the display setting and diagnoses+  successful responses whose thinking blocks contain no readable summary.+  Budget and absent-thinking request shapes, signed empty blocks, redacted+  content and multi-turn replay are preserved.++- Fast mode is gated by the generated model capability: it adds the Anthropic+  beta header for a model that advertises it and records an evidence adjustment+  for one that does not.++### Fixed++- Price Fable cache writes using the TTL in the shaped request,+  including compatibility downgrades. Missing write-duration context is explicit+  in the cost basis.++- Reject forced tool choices locally on Fable 5.1, using the+  generated `supportsForcedToolChoice` capability. Automatic tool rounds retain+  signed empty/visible thinking, redacted blocks and prior-message order.++- Widened the `http-client-tls` bound to admit 0.4 (carried forward from the+  tagged but never-published 0.6.0.1).++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`.++## [baikai-openai 0.7.0.0] - 2026-09-08++### Added++- Explicit `Baikai.Provider.OpenAI.Responses` registration and+  stream/complete provider with stateless reasoning replay, function tool turns,+  structured output and bounded worker cleanup, across the new+  `Baikai.Provider.OpenAI.Responses.{Request,Stream,Assembler}` modules. Astra+  now selects this provider through a per-model catalog override; callers must+  register it explicitly. Cache writes, billing availability and context pricing+  are integrated.++- `Baikai.Provider.OpenAI.Internal.Usage`, the shared usage mapping both the+  Chat Completions and Responses transports read.++### Fixed++- Reject tools locally for models whose Chat Completions endpoint+  disallows them, including GPT-6 Astra. Respect generated effort policies and+  sampling restrictions, with matching translation evidence and strict refusal.++- Validate Responses terminals and enforce the stream contracts.++- Widened the `http-client-tls` bound to admit 0.4 (carried forward from the+  tagged but never-published 0.6.0.1).++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`.++## [baikai-trace-otel 0.4.0.1] - 2026-09-08++### Added++- Successful and failed spans export `baikai.cost.basis` and+  `baikai.usage.availability` as canonically encoded JSON. A failed span now+  also carries the input/output token counts and USD total that+  `baikai 0.7.0.0` retains on `CallFailed`, alongside its error status.++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`, and now depends on `aeson ^>=2.2` to encode the+  two new attributes.++## [baikai-effectful 0.4.0.1] - 2026-09-08++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`. No API change.++## [baikai-kit 0.2.0.1] - 2026-09-08++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`. No API change.++## [baikai-agent 0.2.0.1] - 2026-09-08++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`, `baikai-claude ^>=0.7` and+  `baikai-openai ^>=0.7`. No API change.++## [baikai 0.6.0.1] - 2026-08-30++### Fixed++- widened the `http-client-tls` bound to admit 0.4. The 0.4 API retains the+  manager functions this package uses and belongs to the same TLS 2.x / Crypton+  1.1 dependency cohort as baikai 0.6; the old `^>=0.3` cap made baikai 0.6+  impossible to solve in applications that require Crypton 1.1.++## [baikai-claude 0.6.0.1] - 2026-08-30++### Fixed++- widened the `http-client-tls` bound to admit 0.4, allowing applications that+  require Crypton 1.1 to solve the dependency set.++## [baikai-openai 0.6.0.1] - 2026-08-30++### Fixed++- widened the `http-client-tls` bound to admit 0.4, allowing applications that+  require Crypton 1.1 to solve the dependency set.+ ## [baikai 0.6.0.0] - 2026-08-28  ### Added

@@ -1,6 +1,6 @@ cabal-version:   3.4 name:            baikai-openai-version:         0.6.0.0+version:         0.7.0.0 synopsis:        OpenAI providers for the baikai abstraction description:   OpenAI-compatible backends for baikai: Chat Completions over SSE against OpenAI and@@ -57,6 +57,11 @@     Baikai.Provider.OpenAI.Internal.ErrorClass     Baikai.Provider.OpenAI.Internal.Request     Baikai.Provider.OpenAI.Internal.Stream+    Baikai.Provider.OpenAI.Internal.Usage+    Baikai.Provider.OpenAI.Responses+    Baikai.Provider.OpenAI.Responses.Assembler+    Baikai.Provider.OpenAI.Responses.Request+    Baikai.Provider.OpenAI.Responses.Stream     Baikai.Provider.OpenAI.Shape     Baikai.Provider.OpenAI.Sse     Baikai.Provider.OpenAI.Transport@@ -65,7 +70,7 @@   autogen-modules: Paths_baikai_openai   build-depends:     , aeson              ^>=2.2-    , baikai             ^>=0.6.0+    , baikai             ^>=0.7.0     , base               >=4.20   && <5     , base64-bytestring  ^>=1.2     , bytestring         ^>=0.12@@ -73,7 +78,7 @@     , containers         ^>=0.7     , generic-lens       ^>=2.3     , http-client        ^>=0.7-    , http-client-tls    ^>=0.3+    , http-client-tls    >=0.3    && <0.5     , http-types         ^>=0.12     , lens               ^>=5.3     , openai             ^>=2.5@@ -92,21 +97,28 @@   hs-source-dirs: test   main-is:        Main.hs   other-modules:+    BillingSpec     CliEvidenceSpec     Contract+    EndpointModels     ErrorClassSpec     EvidenceSpec     LifecycleSpec     MidStreamSpec     PublicSurfaceSpec     ReasoningSpec+    ResponsesAssemblerSpec+    ResponsesEvidenceSpec+    ResponsesSpec+    ResponsesStreamSpec+    ResponsesTransportSpec     ShapeSpec     SseSpec     TransportSpec    build-depends:     , aeson-    , baikai            ^>=0.6.0+    , baikai            ^>=0.7.0     , baikai-openai     , base              >=4.20   && <5     , bytestring

@@ -138,6 +138,7 @@             effortText = Just wire,             budgetTokens = Nothing,             wireField = Just "model_reasoning_effort",+            displayText = Nothing,             adjustments = [EffortClamped lvl wire | wire /= renderThinkingLevel lvl]           } 

@@ -188,6 +188,7 @@             effortText = Just wire,             budgetTokens = Nothing,             wireField = Just "model_reasoning_effort",+            displayText = Nothing,             adjustments = [Ev.EffortClamped lvl wire | wire /= renderThinkingLevel lvl]           } 

@@ -19,14 +19,17 @@ import Baikai.Message qualified as Msg import Baikai.Model (Model, openaiCompletionsCompatFor) import Baikai.Options (Options (..))+import Baikai.Provider.OpenAI.Shape (resolveSupportedEffort) import Baikai.ResponseFormat (JsonSchemaFormat (..), ResponseFormat (..)) import Baikai.ThinkingLevel (ThinkingLevel (..)) import Baikai.Tool qualified as Tool import Control.Lens ((^.))+import Control.Monad (unless) import Data.Aeson qualified as Aeson import Data.ByteString.Base64 qualified as Base64 import Data.ByteString.Lazy qualified as BSL import Data.Generics.Labels ()+import Data.List (nub, sort) import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as Text@@ -46,6 +49,32 @@ mapRequest ::   Model -> Context -> Options -> Either Text Chat.CreateChatCompletion mapRequest m ctx opts = do+  let capability = openaiCompletionsCompatFor m+      forced = case opts ^. #toolChoice of+        Just Tool.ToolChoiceRequired -> True+        Just (Tool.ToolChoiceSpecific _) -> True+        _ -> False+  unless (capability.supportsToolCalls || (Vector.null (ctx ^. #tools) && not forced)) $+    Left "This model does not support tools on OpenAI Chat Completions; use OpenAI Responses for tool calling"+  case capability.supportedReasoningEfforts of+    Just levels+      | null levels || levels /= sort (nub levels) ->+          Left "supportedReasoningEfforts must be nonempty, unique and ordered"+    _ -> pure ()+  mapM_+    ( \msg -> case msg of+        Msg.AssistantMessage payload ->+          mapM_+            ( \block -> case block of+                Content.AssistantThinking th+                  | Just _ <- Content.replayState th ->+                      Left "This endpoint cannot replay provider-scoped reasoning state; use its originating API and model"+                _ -> pure ()+            )+            (payload ^. #content)+        _ -> pure ()+    )+    (ctx ^. #messages)   body <- traverse mapMessage (Vector.toList (ctx ^. #messages))   let compat = openaiCompletionsCompatFor m       prefix = case ctx ^. #systemPrompt of@@ -79,8 +108,8 @@       { Chat.messages = Vector.fromList (prefix <> body),         Chat.model = OpenAIModels.Model (m ^. #modelId),         Chat.max_completion_tokens = maxTokensField,-        Chat.temperature = opts ^. #temperature,-        Chat.top_p = opts ^. #topP,+        Chat.temperature = if compat.supportsSamplingParameters then opts ^. #temperature else Nothing,+        Chat.top_p = if compat.supportsSamplingParameters then opts ^. #topP else Nothing,         Chat.stop = nonEmptyStops (opts ^. #stopSequences),         Chat.seed = fmap fromIntegral (opts ^. #seed),         Chat.frequency_penalty = opts ^. #frequencyPenalty,@@ -139,7 +168,7 @@   Maybe Chat.ReasoningEffort applyThinkingFormat _ Nothing = Nothing applyThinkingFormat compat (Just lvl) = case thinkingFormat compat of-  ThinkingFormatOpenAI -> Just (toReasoningEffort lvl)+  ThinkingFormatOpenAI -> Just (toReasoningEffort (resolveSupportedEffort compat.supportedReasoningEfforts lvl))   _ -> Nothing  toReasoningEffort :: ThinkingLevel -> Chat.ReasoningEffort

@@ -45,7 +45,6 @@ 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@@ -62,6 +61,7 @@   ) import Baikai.Provider.OpenAI.Internal.ErrorClass (classifyErrorFrame, classifyException) import Baikai.Provider.OpenAI.Internal.Request (mapRequest)+import Baikai.Provider.OpenAI.Internal.Usage qualified as Billing import Baikai.Provider.OpenAI.Shape (describeThinkingShape, streamRequestBody) import Baikai.Provider.OpenAI.Sse (ResponseMetadata, capturedHeaderNames, openaiSseStreamValueWithHeaders) import Baikai.Provider.OpenAI.Transport qualified as Transport@@ -95,6 +95,7 @@ import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe)+import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text@@ -104,7 +105,6 @@ 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)@@ -262,6 +262,7 @@     model :: !(Maybe Text),     -- | The host's identifier for this response, from the chunk's     -- top-level @id@ field.+    serviceTier :: !(Maybe Text),     responseId :: !(Maybe Text)   }   deriving stock (Show, Generic)@@ -274,12 +275,7 @@   }   deriving stock (Show, Generic) -data RawUsage = RawUsage-  { inputTokens :: !Natural,-    outputTokens :: !Natural,-    cacheReadTokens :: !Natural,-    reasoningTokens :: !(Maybe Natural)-  }+newtype RawUsage = RawUsage Aeson.Object   deriving stock (Show, Generic)  -- | Worker body: drive the transport, forwarding decoded chunks onto the@@ -378,6 +374,7 @@         -- compatible hosts vary, and a host that omits either of these         -- has reported nothing, which is not a decode failure.         model = lookupText "model" o,+        serviceTier = lookupText "service_tier" o,         responseId = lookupText "id" o       } @@ -421,33 +418,7 @@       _ -> 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-          }+parseUsage o = RawUsage o <$ Billing.readUsage Billing.ChatUsage (Aeson.Object o)  lookupField :: Text -> Aeson.Object -> Maybe Value lookupField k = KeyMap.lookup (AesonKey.fromText k)@@ -860,6 +831,8 @@     -- 'usage' still holding the zeroes it was initialised with. Without     -- this a failed call would claim the host reported consuming     -- nothing.+    serviceTiers :: !(Set.Set Text),+    usageSnapshot :: !(Maybe Value),     usageReported :: !Bool   }   deriving stock (Generic)@@ -891,6 +864,8 @@       observedModel = Ev.Unobserved,       responseId = Nothing,       httpStatus = Nothing,+      serviceTiers = Set.empty,+      usageSnapshot = Nothing,       usageReported = False     } @@ -940,6 +915,7 @@ observeChunk :: RawChunk -> Assembler -> Assembler observeChunk raw ass =   ass+    & #serviceTiers %~ maybe id Set.insert (raw ^. #serviceTier)     & #observedModel .~ firstObserved (ass ^. #observedModel) (raw ^. #model)     & #responseId .~ ((ass ^. #responseId) <|> (raw ^. #responseId)) @@ -1084,41 +1060,20 @@           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.+-- | Shared Chat/Responses normalization preserves reported writes and marks+-- missing or inconsistent billing categories explicitly. 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-        }+rawUsageToUsage (RawUsage o) = fromMaybe Billing.unreportedUsage (Billing.readUsage Billing.ChatUsage (Aeson.Object o))  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+applyUsage (Just (RawUsage raw)) ass =+  let snapshot = Billing.mergeUsage (ass ^. #usageSnapshot) (Just (Aeson.Object raw))+      normalized = fromMaybe Billing.unreportedUsage (snapshot >>= Billing.readUsage Billing.ChatUsage)+   in ass+        & #usage .~ normalized+        & #usageSnapshot .~ snapshot+        & #usageReported .~ True  -- | Close all open content blocks and stash the resolved stop -- reason; defer 'EventDone' to channel close.@@ -1168,7 +1123,8 @@           Content.ThinkingContent             { Content.thinking = body,               Content.signature = Nothing,-              Content.redacted = False+              Content.redacted = False,+              Content.replayState = Nothing             }         block = Content.AssistantThinking thinkingContent      in ( [ThinkingEnd ThinkingEndPayload {contentIndex = i, content = thinkingContent}],@@ -1270,8 +1226,8 @@ -- 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+  let usageBare = Usage.observeBilling (map Usage.BillingServiceTier (Set.toList (ass ^. #serviceTiers))) (if ass ^. #usageReported then ass ^. #usage else Billing.unreportedUsage)+   in usageBare & #cost .~ Pricing.computeCostForService Nothing Nothing (ass ^. #model) usageBare  finalMessage ::   Assembler -> UTCTime -> Maybe Text -> Stop.StopReason -> Msg.Message

@@ -0,0 +1,55 @@+-- | Shared Chat/Responses usage extraction. Input totals are inclusive of+-- cache reads and writes; missing categories stay explicit after normalization.+-- Wire semantics: https://developers.openai.com/api/docs/guides/prompt-caching+-- Chat's prompt_tokens_details.cache_write_tokens is documented at+-- https://developers.openai.com/api/reference/resources/chat/subresources/completions/methods/create+-- (verified 2026-09-07).+module Baikai.Provider.OpenAI.Internal.Usage (UsageEndpoint (..), readUsage, unreportedUsage, mergeUsage) where++import Baikai.Usage qualified as U+import Baikai.Usage.Normalize qualified as N+import Data.Aeson (Value (..))+import Data.Aeson.Key (Key)+import Data.Aeson.KeyMap qualified as KM+import Data.Maybe (isJust, isNothing)+import Numeric.Natural (Natural)++data UsageEndpoint = ChatUsage | ResponsesUsage++unreportedUsage :: U.Usage+unreportedUsage = N.normalizeUsage N.InclusiveInput (N.ReportedUsage Nothing Nothing Nothing Nothing Nothing)++readUsage :: UsageEndpoint -> Value -> Maybe U.Usage+readUsage endpoint value =+  let (inputKey, outputKey, inputDetails, outputDetails) = case endpoint of+        ChatUsage -> ("prompt_tokens", "completion_tokens", "prompt_tokens_details", "completion_tokens_details")+        ResponsesUsage -> ("input_tokens", "output_tokens", "input_tokens_details", "output_tokens_details")+      input = field inputKey value+      output = field outputKey value+      cached = field inputDetails value >>= field "cached_tokens"+      writes = field inputDetails value >>= field "cache_write_tokens"+      reasoning = field outputDetails value >>= field "reasoning_tokens"+      raw = [input, output, cached, writes, reasoning]+      count v = v >>= natural+      normalized = N.normalizeUsage N.InclusiveInput (N.ReportedUsage (count input) (count output) (count cached) (count writes) (count reasoning))+      malformed = any (\v -> isJust v && isNothing (count v)) raw+      mark facts = facts {U.inconsistent = U.inconsistent facts || malformed}+   in if any isJust raw then Just normalized {U.availability = mark <$> U.availability normalized} else Nothing+  where+    field :: Key -> Value -> Maybe Value+    field key (Object o) = case KM.lookup key o of Just Null -> Nothing; found -> found+    field _ _ = Nothing+    natural :: Value -> Maybe Natural+    natural (Number n) | n >= 0, fromInteger (floor n) == n = Just (fromInteger (floor n))+    natural _ = Nothing++-- | Usage events are cumulative snapshots, never increments. Omitted fields+-- preserve earlier observations; explicit zero replaces the previous value.+mergeUsage :: Maybe Value -> Maybe Value -> Maybe Value+mergeUsage old Nothing = old+mergeUsage Nothing new = new+mergeUsage (Just old) (Just new) = Just (merge new old)+  where+    merge Null previous = previous+    merge (Object newer) (Object previous) = Object (KM.unionWith merge newer previous)+    merge newer _ = newer

@@ -0,0 +1,35 @@+-- | Native OpenAI Responses provider. Register explicitly alongside the+-- Chat Completions provider for a registry supporting both protocols.+module Baikai.Provider.OpenAI.Responses+  ( register,+    openaiResponsesProvider,+    openaiResponsesStream,+  )+where++import Baikai.Api (Api (OpenAIResponses))+import Baikai.Context (Context)+import Baikai.Evidence qualified as Ev+import Baikai.Model (Model)+import Baikai.Options (Options)+import Baikai.Provider (ApiProvider, apiProvider)+import Baikai.Provider.OpenAI.Responses.Request (describeThinking)+import Baikai.Provider.OpenAI.Responses.Stream (liveResponsesDriver, openaiResponsesStreamWith)+import Baikai.Provider.Registry (registerApiProvider)+import Baikai.Stream.Event (AssistantMessageEvent)+import Control.Lens ((&), (.~))+import Data.Generics.Labels ()+import Streamly.Data.Stream (Stream)++register :: IO ()+register = registerApiProvider openaiResponsesProvider++-- | Completion folds the same event stream, as for other API providers.+openaiResponsesProvider :: ApiProvider+openaiResponsesProvider =+  apiProvider OpenAIResponses openaiResponsesStream+    & #describeThinking .~ describeThinking+    & #strengthCeiling .~ Ev.declaredStrength OpenAIResponses++openaiResponsesStream :: Model -> Context -> Options -> Stream IO AssistantMessageEvent+openaiResponsesStream = openaiResponsesStreamWith liveResponsesDriver

@@ -0,0 +1,314 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedRecordDot #-}++-- | Internal Responses item assembly; no stability guarantee. The wire+-- schema is wider than the released SDK's streaming sum (see+-- mori://MercuryTechnologies/openai/packages/openai), so inspect JSON at+-- this boundary and preserve reasoning snapshots without re-encoding.+module Baikai.Provider.OpenAI.Responses.Assembler+  ( Assembler,+    emptyAssembler,+    advance,+    closePartial,+    assembledContent,+    observedResponse,+    terminalReason,+  )+where++import Baikai.Api (Api (OpenAIResponses))+import Baikai.Content qualified as C+import Baikai.Provider.OpenAI.Responses.Request (validateReplayItems)+import Baikai.StopReason (StopReason (..))+import Baikai.Stream.Event qualified as E+import Control.Monad (foldM, unless)+import Data.Aeson (Value (..))+import Data.Aeson.Key (Key)+import Data.Aeson.KeyMap qualified as KM+import Data.IntMap.Strict qualified as IM+import Data.IntSet qualified as IS+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V++-- No Show: items can contain opaque encrypted continuation.+data Item = Item+  { kind :: !Text,+    identity :: !Text,+    callId :: !Text,+    functionName :: !Text,+    parts :: !(IM.IntMap Text),+    endedParts :: !IS.IntSet,+    complete :: !Bool,+    snapshot :: !(Maybe Value)+  }++data Assembler = Assembler+  { scopeModel :: !Text,+    items :: !(IM.IntMap Item),+    cursor :: !Int,+    opened :: !Bool,+    emitted :: !Text,+    assembledContent :: !(V.Vector C.AssistantContent),+    -- | Actual provider response object, including raw usage availability.+    observedResponse :: !(Maybe Value),+    terminalReason :: !(Maybe StopReason)+  }++emptyAssembler :: Text -> Assembler+emptyAssembler m = Assembler m IM.empty 0 False "" V.empty Nothing Nothing++-- | Consume one JSON event. Errors contain only schema diagnostics, never+-- raw response bodies. The caller closes partial blocks and emits the+-- terminal error on Left. Lifecycle terminal events are emitted by the+-- owning stream after attaching usage and evidence.+advance :: Value -> Assembler -> Either Text (Assembler, [E.AssistantMessageEvent])+advance frame a+  | Just _ <- a.terminalReason = Right (a, [])+  | otherwise = do+      typ <- str "type" frame+      case typ of+        "response.created" -> observe frame a+        "response.in_progress" -> observe frame a+        "response.queued" -> observe frame a+        "response.output_item.added" -> do+          n <- index "output_index" frame+          raw <- field "item" frame+          item <- fromSnapshot False raw+          unless (IM.notMember n a.items && n >= a.cursor) (Left "Responses repeated output item")+          unless (freshIdentity item (IM.elems a.items)) (Left "Responses duplicate item or function call ID")+          pump a {items = IM.insert n item a.items}+        "response.output_item.done" -> do+          n <- index "output_index" frame+          raw <- field "item" frame+          updated <- mergeSnapshot n True raw a+          pump updated+        "response.output_text.delta" -> delta "message" "content_index" frame a+        "response.refusal.delta" -> delta "message" "content_index" frame a+        "response.reasoning_summary_text.delta" -> delta "reasoning" "summary_index" frame a+        "response.function_call_arguments.delta" -> delta "function_call" "" frame a+        "response.output_text.done" -> donePart "message" "content_index" "text" frame a+        "response.refusal.done" -> donePart "message" "content_index" "refusal" frame a+        "response.reasoning_summary_text.done" -> donePart "reasoning" "summary_index" "text" frame a+        "response.function_call_arguments.done" -> donePart "function_call" "" "arguments" frame a+        "response.content_part.added" -> partEvent False "message" "content_index" frame a+        "response.content_part.done" -> partEvent True "message" "content_index" frame a+        "response.reasoning_summary_part.added" -> partEvent False "reasoning" "summary_index" frame a+        "response.reasoning_summary_part.done" -> partEvent True "reasoning" "summary_index" frame a+        "response.completed" -> terminal Stop frame a+        "response.incomplete" -> do+          response <- field "response" frame+          details <- field "incomplete_details" response+          reason <- str "reason" details+          unless (reason == "max_output_tokens") (Left "Responses terminated incomplete for a reason other than max_output_tokens")+          terminal Length frame a+        "response.failed" -> Left "Responses response.failed"+        "error" -> Left "Responses error event"+        -- Annotations and reasoning details do not change the public text+        -- or continuation. New output kinds are rejected at item creation.+        _ -> Right (a, [])++observe :: Value -> Assembler -> Either Text (Assembler, [E.AssistantMessageEvent])+observe f a = do+  r <- field "response" f+  pure (a {observedResponse = Just r}, [])++terminal :: StopReason -> Value -> Assembler -> Either Text (Assembler, [E.AssistantMessageEvent])+terminal reason f a = do+  r <- field "response" f+  output <- array "output" r+  mapM_+    ( \raw -> case raw of+        Object o | reason == Stop && KM.lookup "type" o == Just (String "reasoning") -> validateReplayItems (V.singleton raw)+        _ -> pure ()+    )+    output+  updated <- foldM (\s (n, raw) -> mergeSnapshot n True raw s) a (zip [0 ..] (V.toList output))+  unless (IM.size updated.items == V.length output) (Left "Responses terminal output omitted an existing item")+  (drained, events) <- pump updated {observedResponse = Just r}+  unless (drained.cursor == IM.size drained.items) (Left "Responses terminal output has a gap")+  let hasTool = any (\case C.AssistantToolCall _ -> True; _ -> False) drained.assembledContent+      stop = if reason == Stop && hasTool then ToolUse else reason+  pure (drained {terminalReason = Just stop}, events)++fromSnapshot :: Bool -> Value -> Either Text Item+fromSnapshot final raw = do+  k <- str "type" raw+  ident <- nonempty "id" raw+  (call, name, ps) <- case k of+    "message" -> do+      cs <- array "content" raw+      texts <- traverse partText (V.toList cs)+      pure ("", "", IM.fromList (zip [0 ..] texts))+    "reasoning" -> do+      cs <- array "summary" raw+      texts <- traverse partText (V.toList cs)+      pure ("", "", IM.fromList (zip [0 ..] texts))+    "function_call" -> do+      call <- nonempty "call_id" raw+      name <- nonempty "name" raw+      args <- str "arguments" raw+      pure (call, name, IM.singleton 0 args)+    _ -> Left "Responses unsupported output item type"+  pure (Item k ident call name ps (if final then IS.fromList (IM.keys ps) else IS.empty) final (if final then Just raw else Nothing))++freshIdentity :: Item -> [Item] -> Bool+freshIdentity new = all (\old -> old.identity /= new.identity && (new.kind /= "function_call" || old.kind /= "function_call" || old.callId /= new.callId))++mergeSnapshot :: Int -> Bool -> Value -> Assembler -> Either Text Assembler+mergeSnapshot n final raw a = do+  new <- fromSnapshot final raw+  case IM.lookup n a.items of+    Nothing -> do+      unless (n >= a.cursor && freshIdentity new (IM.elems a.items)) (Left "Responses duplicate item or function call ID")+      pure a {items = IM.insert n new a.items}+    Just old -> do+      unless (old.kind == new.kind && old.identity == new.identity && old.callId == new.callId && old.functionName == new.functionName) (Left "Responses item identity changed")+      unless (not old.complete || old.snapshot == Just raw) (Left "Responses completed item changed")+      mapM_ (\(p, t) -> unless (maybe False (T.isPrefixOf t) (IM.lookup p new.parts)) (Left "Responses final snapshot contradicts streamed content")) (IM.toList old.parts)+      pure a {items = IM.insert n new a.items}++partText :: Value -> Either Text Text+partText p = do+  k <- str "type" p+  case k of+    "output_text" -> str "text" p+    "summary_text" -> str "text" p+    "refusal" -> str "refusal" p+    _ -> Left "Responses unsupported output content part"++itemAt :: Text -> Value -> Assembler -> Either Text (Int, Item)+itemAt expected f a = do+  n <- index "output_index" f+  ident <- str "item_id" f+  item <- maybe (Left "Responses delta before output item") Right (IM.lookup n a.items)+  unless (item.kind == expected && item.identity == ident) (Left "Responses delta item identity mismatch")+  pure (n, item)++partIndex :: Key -> Value -> Either Text Int+partIndex "" _ = Right 0+partIndex key f = index key f++delta :: Text -> Key -> Value -> Assembler -> Either Text (Assembler, [E.AssistantMessageEvent])+delta k key f a = do+  (n, item) <- itemAt k f a+  p <- partIndex key f+  txt <- str "delta" f+  unless (not item.complete && not (IS.member p item.endedParts)) (Left "Responses delta after content done")+  let ps = IM.insert p (IM.findWithDefault "" p item.parts <> txt) item.parts+  pump a {items = IM.insert n item {parts = ps} a.items}++donePart :: Text -> Key -> Key -> Value -> Assembler -> Either Text (Assembler, [E.AssistantMessageEvent])+donePart k key txtKey f a = do+  txt <- str txtKey f+  setPart True k key txt f a++partEvent :: Bool -> Text -> Key -> Value -> Assembler -> Either Text (Assembler, [E.AssistantMessageEvent])+partEvent final k key f a = do+  p <- field "part" f+  txt <- partText p+  setPart final k key txt f a++setPart :: Bool -> Text -> Key -> Text -> Value -> Assembler -> Either Text (Assembler, [E.AssistantMessageEvent])+setPart final k key txt f a = do+  (n, item) <- itemAt k f a+  p <- partIndex key f+  let old = IM.findWithDefault "" p item.parts+  unless (old `T.isPrefixOf` txt && (not (item.complete || IS.member p item.endedParts) || old == txt)) (Left "Responses part snapshot contradicts streamed content")+  let updated = item {parts = IM.insert p txt item.parts, endedParts = if final then IS.insert p item.endedParts else item.endedParts}+  pump a {items = IM.insert n updated a.items}++-- Only the contiguous prefix is visible: a later parallel item or content+-- part cannot overtake the one still streaming. One Baikai block per item.+visible :: Item -> Text+visible item = go 0+  where+    go n = case IM.lookup n item.parts of+      Nothing -> ""+      Just txt -> txt <> if item.complete || IS.member n item.endedParts then go (n + 1) else ""++pump :: Assembler -> Either Text (Assembler, [E.AssistantMessageEvent])+pump a = case IM.lookup a.cursor a.items of+  Nothing -> Right (a, [])+  Just item -> do+    let txt = visible item+        n = V.length a.assembledContent+    unless (a.emitted `T.isPrefixOf` txt) (Left "Responses snapshot changed emitted content")+    let suffix = T.drop (T.length a.emitted) txt+        start = if a.opened then [] else [startEvent item.kind n]+        deltas = if T.null suffix then [] else [deltaEvent item.kind n suffix]+        openedState = a {opened = True, emitted = txt}+    if item.complete+      then do+        let content = itemContent a.scopeModel True item+            closed = openedState {cursor = a.cursor + 1, opened = False, emitted = "", assembledContent = V.snoc a.assembledContent content}+        (next, events) <- pump closed+        pure (next, start <> deltas <> [endEvent n content] <> events)+      else pure (openedState, start <> deltas)++-- | Close an interrupted stream, retaining every observed item. An item+-- without output_item.done keeps String arguments even when that prefix+-- happens to be parseable JSON; callers must never execute that prefix.+closePartial :: Assembler -> (Assembler, [E.AssistantMessageEvent])+closePartial a = foldl close (a, []) [(n, i) | (n, i) <- IM.toAscList a.items, n >= a.cursor]+  where+    close (s, events) (outputIndex, item) =+      let n = V.length s.assembledContent+          txt = T.concat (IM.elems item.parts)+          suffix = if s.emitted `T.isPrefixOf` txt then T.drop (T.length s.emitted) txt else ""+          content = itemContent s.scopeModel item.complete item+          starts = if s.opened then [] else [startEvent item.kind n]+          deltas = if T.null suffix then [] else [deltaEvent item.kind n suffix]+       in (s {cursor = outputIndex + 1, opened = False, emitted = "", assembledContent = V.snoc s.assembledContent content}, events <> starts <> deltas <> [endEvent n content])++itemContent :: Text -> Bool -> Item -> C.AssistantContent+itemContent m final item =+  let txt = T.concat (IM.elems item.parts)+   in case item.kind of+        "reasoning" -> C.AssistantThinking (C.ThinkingContent txt Nothing False (fmap (C.ThinkingReplay OpenAIResponses m . V.singleton) item.snapshot))+        "function_call" -> C.AssistantToolCall (C.ToolCall item.callId item.functionName (if final && completedStatus item.snapshot then C.toolArgumentsFromText txt else String txt))+        _ -> C.AssistantText (C.TextContent txt)++completedStatus :: Maybe Value -> Bool+completedStatus (Just (Object o)) = case KM.lookup "status" o of+  Nothing -> True -- output_item.done itself supplies completion.+  Just (String "completed") -> True+  _ -> False+completedStatus _ = False++startEvent :: Text -> Int -> E.AssistantMessageEvent+startEvent "reasoning" n = E.ThinkingStart (E.IndexPayload n)+startEvent "function_call" n = E.ToolCallStart (E.IndexPayload n)+startEvent _ n = E.TextStart (E.IndexPayload n)++deltaEvent :: Text -> Int -> Text -> E.AssistantMessageEvent+deltaEvent "reasoning" n txt = E.ThinkingDelta (E.DeltaPayload n txt)+deltaEvent "function_call" n txt = E.ToolCallDelta (E.DeltaPayload n txt)+deltaEvent _ n txt = E.TextDelta (E.DeltaPayload n txt)++endEvent :: Int -> C.AssistantContent -> E.AssistantMessageEvent+endEvent n (C.AssistantThinking c) = E.ThinkingEnd (E.ThinkingEndPayload n c)+endEvent n (C.AssistantToolCall c) = E.ToolCallEnd (E.ToolCallEndPayload n c)+endEvent n (C.AssistantText c) = E.TextEnd (E.BlockEndPayload n c.text)++field :: Key -> Value -> Either Text Value+field k (Object o) = maybe (Left "Responses missing required event field") Right (KM.lookup k o)+field _ _ = Left "Responses event field must be an object"++str :: Key -> Value -> Either Text Text+str k v = field k v >>= \case String t -> Right t; _ -> Left "Responses event field must be text"++nonempty :: Key -> Value -> Either Text Text+nonempty k v = do+  t <- str k v+  unless (not (T.null t)) (Left "Responses item identity must be nonempty")+  pure t++array :: Key -> Value -> Either Text (V.Vector Value)+array k v = field k v >>= \case Array xs -> Right xs; _ -> Left "Responses event field must be an array"++index :: Key -> Value -> Either Text Int+index k v =+  field k v >>= \case+    Number n | n >= 0, n <= fromIntegral (maxBound :: Int), fromInteger (floor n) == n -> Right (floor n)+    _ -> Left "Responses event index must be a nonnegative integer"

@@ -0,0 +1,228 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedRecordDot #-}++-- | Internal Responses request mapping; no stability guarantee.+-- The released SDK (mori://MercuryTechnologies/openai/packages/openai,+-- 2.5.4) supplies the ordinary request/tool types. Local JSON below covers+-- its missing assistant input role, json_object format, current+-- effort vocabulary, cache options, and lossless opaque replay items.+module Baikai.Provider.OpenAI.Responses.Request+  ( PreparedRequest (..),+    mapRequest,+    describeThinking,+    validateReplay,+    validateReplayItems,+  )+where++import Baikai.Api (Api (..), normaliseApi)+import Baikai.CacheRetention (CacheRetention (..))+import Baikai.Compat (OpenAIResponsesCompat (..))+import Baikai.Content qualified as C+import Baikai.Context (Context (..))+import Baikai.Evidence qualified as E+import Baikai.Message qualified as M+import Baikai.Model (Model, api, maxOutputTokens, modelId, openaiResponsesCompatFor, reasoning)+import Baikai.Options (Options (..))+import Baikai.Provider.OpenAI.Shape (resolveSupportedEffort)+import Baikai.ResponseFormat (JsonSchemaFormat (..), ResponseFormat (..))+import Baikai.ThinkingLevel (renderThinkingLevel)+import Baikai.Tool qualified as T+import Control.Monad (unless)+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KM+import Data.ByteString.Base64 qualified as Base64+import Data.ByteString.Lazy qualified as LBS+import Data.List (nub, sort)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe, isJust)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Vector qualified as V+import GHC.Generics (Generic)+import OpenAI.V1.Models qualified as SDK+import OpenAI.V1.Responses qualified as R++-- | The exact wire body and the description derived while shaping it.+-- No Show instance: a prepared body can contain opaque continuation.+data PreparedRequest = PreparedRequest+  { requestBody :: !Value,+    translation :: !E.ThinkingTranslation+  }+  deriving stock (Eq, Generic)++mapRequest :: Model -> Context -> Options -> Either Text PreparedRequest+mapRequest m ctx opts = do+  unless (normaliseApi m.api == OpenAIResponses) (Left "Responses requires Model.api = OpenAIResponses")+  let compat = openaiResponsesCompatFor m+      unsupported = [name | (name, present) <- [("stopSequences", not (null opts.stopSequences)), ("seed", isJust opts.seed), ("frequencyPenalty", isJust opts.frequencyPenalty), ("presencePenalty", isJust opts.presencePenalty)], present]+  unless (null unsupported) (Left ("Responses cannot encode Options fields: " <> Text.intercalate ", " unsupported))+  case compat.supportedReasoningEfforts of+    Just xs | null xs || xs /= sort (nub xs) -> Left "supportedReasoningEfforts must be nonempty, unique and ordered"+    _ -> pure ()+  metadata <- traverse metadataText opts.metadata+  unless (Map.size metadata <= 16 && all ((<= 64) . Text.length) (Map.keys metadata)) (Left "Responses metadata allows at most 16 keys of at most 64 characters")+  items <- concat <$> traverse (messageItems m) (V.toList ctx.messages)+  let ids = [i | Object item <- items, Just (String i) <- [KM.lookup "id" item]]+  unless (length ids == length (nub ids)) (Left "Responses history contains duplicate item IDs")+  choice <- toolChoiceFields ctx opts+  cache <- cacheFields m opts+  let (reasoning, translation) = thinkingFields m opts+      cap = fromMaybe m.maxOutputTokens opts.maxTokens+      base =+        Aeson.toJSON+          R._CreateResponse+            { R.model = SDK.Model m.modelId,+              R.instructions = ctx.systemPrompt,+              R.store = Just False,+              R.stream = Just True,+              R.include = Just (V.singleton "reasoning.encrypted_content"),+              R.max_output_tokens = if cap == 0 then Nothing else Just cap,+              R.temperature = if compat.supportsSamplingParameters then opts.temperature else Nothing,+              R.top_p = if compat.supportsSamplingParameters then opts.topP else Nothing,+              R.metadata = if Map.null metadata then Nothing else Just metadata,+              R.tools = if V.null ctx.tools then Nothing else Just (V.map sdkTool ctx.tools)+            }+      extras = [("input", Aeson.toJSON items)] <> reasoning <> choice <> cache <> formatFields opts+  case base of+    Object obj -> pure (PreparedRequest (Object (KM.union (KM.fromList extras) obj)) translation)+    _ -> Left "Responses SDK request did not encode as an object"+  where+    metadataText (String t) | Text.length t <= 512 = Right t+    metadataText _ = Left "Responses metadata values must be strings of at most 512 characters"++-- | Both preflight and serialization use this same mapping.+describeThinking :: Model -> Options -> E.ThinkingTranslation+describeThinking m = snd . thinkingFields m++thinkingFields :: Model -> Options -> ([(Aeson.Key, Value)], E.ThinkingTranslation)+thinkingFields m opts = (fields, thought {E.adjustments = thought.adjustments <> sampling})+  where+    compat = openaiResponsesCompatFor m+    (fields, thought) = case opts.thinking of+      Nothing -> ([], E.noThinkingRequested)+      Just lvl | not m.reasoning -> ([], E.ThinkingTranslation (Just lvl) E.ThinkingModeUnsupported Nothing Nothing Nothing Nothing [E.ThinkingDroppedUnsupportedModel lvl])+      Just lvl ->+        let effort = renderThinkingLevel (resolveSupportedEffort compat.supportedReasoningEfforts lvl)+         in ([("reasoning", object ["effort" .= effort])], E.ThinkingTranslation (Just lvl) E.ThinkingModeAdaptive (Just effort) Nothing (Just "reasoning.effort") Nothing [E.EffortClamped lvl effort | effort /= renderThinkingLevel lvl])+    dropped = [name | (name, set) <- [("temperature", isJust opts.temperature), ("top_p", isJust opts.topP)], set]+    sampling = [E.SamplingDroppedUnsupportedModel dropped | not compat.supportsSamplingParameters, not (null dropped)]++sdkTool :: T.Tool -> R.Tool+sdkTool t =+  R.Tool_Function+    { R.name = t.name,+      R.description = Just t.description,+      R.parameters = Just t.parameters,+      R.strict = Just False+    }++toolChoiceFields :: Context -> Options -> Either Text [(Aeson.Key, Value)]+toolChoiceFields ctx opts = case opts.toolChoice of+  Nothing -> pure []+  Just T.ToolChoiceAuto -> pure []+  Just T.ToolChoiceNone -> pure [("tool_choice", String "none")]+  Just T.ToolChoiceRequired+    | V.null ctx.tools -> Left "Responses required tool choice needs at least one declared tool"+    | otherwise -> pure [("tool_choice", String "required")]+  Just (T.ToolChoiceSpecific name)+    | V.any ((== name) . T.name) ctx.tools -> pure [("tool_choice", object ["type" .= ("function" :: Text), "name" .= name])]+    | otherwise -> Left "Responses named tool choice must name a declared tool"++formatFields :: Options -> [(Aeson.Key, Value)]+formatFields opts = case opts.responseFormat of+  Nothing -> []+  Just JsonObject -> [("text", object ["format" .= object ["type" .= ("json_object" :: Text)]])]+  Just (JsonSchema schema) ->+    [ ( "text",+        object+          [ "format"+              .= Aeson.toJSON+                R.TextFormat_JSON_Schema+                  { R.name = schema.name,+                    R.description = Nothing,+                    R.schema = Just schema.schema,+                    R.strict = Just schema.strict+                  }+          ]+      )+    ]++cacheFields :: Model -> Options -> Either Text [(Aeson.Key, Value)]+cacheFields m opts = case opts.cacheRetention of+  Nothing -> pure []+  Just CacheRetentionNone -> pure []+  Just CacheRetentionShort+    | compat.supportsPromptCacheOptions -> pure [("prompt_cache_options", object ["ttl" .= ("30m" :: Text)])]+    | otherwise -> pure [("prompt_cache_retention", String "in_memory")]+  Just CacheRetentionLong+    | compat.supportsPromptCacheOptions || not compat.supportsLongCacheRetention -> Left "This Responses model cannot honor long cache retention"+    | otherwise -> pure [("prompt_cache_retention", String "24h")]+  where+    compat = openaiResponsesCompatFor m++messageItems :: Model -> M.Message -> Either Text [Value]+messageItems m = \case+  M.UserMessage p -> pure [object ["role" .= ("user" :: Text), "content" .= V.map userPart p.content]]+  M.AssistantMessage p -> concat <$> traverse assistantItem (V.toList p.content)+  M.ToolResultMessage p -> do+    parts <- traverse toolResultText p.content+    unless (not (Text.null p.toolCallId)) (Left "Responses tool results need a nonempty call_id")+    let output = (if p.isError then "[error] " else "") <> Text.concat (V.toList parts)+    pure [Aeson.toJSON R.Item_Input_Function_Call_Output {R.id = Nothing, R.call_id = p.toolCallId, R.output = output, R.status = Nothing}]+  where+    assistantItem = \case+      C.AssistantText t -> pure [object ["role" .= ("assistant" :: Text), "content" .= t.text]]+      C.AssistantToolCall tc -> do+        unless (not (Text.null tc.id_) && not (Text.null tc.name)) (Left "Responses tool calls need a nonempty call_id and name")+        unless (not (C.isCutOffToolCall tc)) (Left "Responses cannot replay an incomplete function call")+        pure [Aeson.toJSON R.Item_Input_Function_Call {R.id = Nothing, R.call_id = tc.id_, R.name = tc.name, R.arguments = Text.decodeUtf8 (LBS.toStrict (Aeson.encode tc.arguments)), R.status = Nothing}]+      C.AssistantThinking th -> do+        unless (not th.redacted && th.signature == Nothing) (Left "Responses cannot replay Anthropic thinking signatures or redacted blocks")+        case th.replayState of+          Nothing -> Left "Responses thinking requires its original opaque replay state"+          Just state -> validateReplay m state >> pure (V.toList state.replayItems)++userPart :: C.UserContent -> Value+userPart = \case+  C.UserText t -> Aeson.toJSON (R.Input_Text t.text)+  C.UserImage img ->+    Aeson.toJSON+      R.Input_Image+        { R.image_url = Just ("data:" <> img.mimeType <> ";base64," <> Text.decodeUtf8 (Base64.encode img.imageData)),+          R.file_id = Nothing,+          R.detail = Nothing+        }++toolResultText :: C.ToolResultContent -> Either Text Text+toolResultText = \case+  C.ToolResultText t -> Right t.text+  C.ToolResultImage _ -> Left "Responses adapter cannot encode ToolResultImage yet"++-- | Validate scope and minimum reasoning-item contract without rebuilding+-- the items: preserving original fields and array order is intentional.+validateReplay :: Model -> C.ThinkingReplay -> Either Text ()+validateReplay m state = do+  unless (normaliseApi state.replayApi == OpenAIResponses && state.replayModel == m.modelId) (Left "Reasoning replay belongs to another API or model")+  validateReplayItems state.replayItems++-- | The same wire invariant applies to completed output and next input.+validateReplayItems :: V.Vector Value -> Either Text ()+validateReplayItems items = do+  unless (not (V.null items)) (Left "Reasoning replay must contain at least one item")+  mapM_ item items+  where+    item (Object o)+      | KM.lookup "type" o == Just (String "reasoning"),+        Just (String ident) <- KM.lookup "id" o,+        not (Text.null ident),+        Just (String encrypted) <- KM.lookup "encrypted_content" o,+        not (Text.null encrypted),+        Just (Array summary) <- KM.lookup "summary" o,+        all summaryPart summary =+          pure ()+    item _ = Left "Malformed Responses reasoning replay: expected reasoning type, id, encrypted_content and summary"+    summaryPart (Object o) = KM.lookup "type" o == Just (String "summary_text") && case KM.lookup "text" o of Just (String _) -> True; _ -> False+    summaryPart _ = False

@@ -0,0 +1,214 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedRecordDot #-}++-- | Internal Responses transport integration; no stability guarantee.+module Baikai.Provider.OpenAI.Responses.Stream+  ( openaiResponsesStreamWith,+    liveResponsesDriver,+  )+where++import Baikai.Content qualified as C+import Baikai.Context (Context)+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 M+import Baikai.Model (Model)+import Baikai.Options (Options)+import Baikai.Provider.Internal.StreamWorker+import Baikai.Provider.OpenAI.Internal.ErrorClass (classifyErrorFrame, classifyException)+import Baikai.Provider.OpenAI.Internal.Stream (SseDriver)+import Baikai.Provider.OpenAI.Internal.Usage qualified as Billing+import Baikai.Provider.OpenAI.Responses.Assembler qualified as A+import Baikai.Provider.OpenAI.Responses.Request qualified as R+import Baikai.Provider.OpenAI.Sse (ResponseMetadata, capturedHeaderNames, responsesSseStreamValueWithHeaders)+import Baikai.Provider.OpenAI.Transport qualified as Transport+import Baikai.StopReason (StopReason (..))+import Baikai.Stream.Event qualified as E+import Baikai.Url qualified as Url+import Baikai.Usage qualified as U+import Control.Applicative ((<|>))+import Control.Exception (SomeAsyncException, SomeException, fromException, throwIO, try)+import Control.Lens ((&), (.~), (^.))+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson.Key (Key)+import Data.Aeson.KeyMap qualified as KM+import Data.CaseInsensitive qualified as CI+import Data.Generics.Labels ()+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Time.Clock (UTCTime, getCurrentTime)+import Data.Vector qualified as V+import Data.Version (showVersion)+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++liveResponsesDriver :: SseDriver+liveResponsesDriver = responsesSseStreamValueWithHeaders++openaiResponsesStreamWith :: SseDriver -> Model -> Context -> Options -> Stream IO E.AssistantMessageEvent+openaiResponsesStreamWith driver m ctx opts = Stream.concatEffect $ do+  setup <- trySync $ do+    req <- either (throwIO . invalidRequest) pure (R.mapRequest m ctx opts)+    let url = resolvedUrl m+    case Url.baseUrlProblem url of+      Just problem -> throwIO (invalidRequest ("Model.baseUrl is not usable: " <> problem))+      Nothing -> pure ()+    key <- Transport.resolveKey url opts+    env <- Transport.getClientEnvCached url+    pure (req, env, Transport.requestHeaders key m opts)+  case setup of+    Left ex -> Stream.fromList <$> immediateError m opts (exceptionToError ex)+    Right (req, env, headers) -> do+      q <- newFrameQueue+      meta <- newIORef Nothing+      start <- getCurrentTime+      let endpoint = T.pack (Client.showBaseUrl (Client.baseUrl env)) <> "/v1/responses"+      evidence <- Build.prepareEvidenceAt endpoint m opts Ev.TransportHttpApi req.translation req.requestBody start+      let worker = do+            result <-+              trySync $+                Transport.runWithTimeout (opts ^. #timeoutMs) $+                  driver env headers req.requestBody (writeIORef meta . Just) (pushFrame q)+            case result of+              Left ex -> pushFrame q (Left (exceptionToError ex))+              Right (Just err) -> pushFrame q (Left err)+              Right Nothing -> pure ()+          initial = State q meta m (A.emptyAssembler (m ^. #modelId)) Nothing [E.EventStart (E.StartPayload (message V.empty U.zeroUsage Stop Nothing start) Nothing)] False evidence+      pure (withFrameWorker q worker (Stream.unfoldrM step initial))++data State = State+  { queue :: !(FrameQueue (Either BaikaiError Value)),+    metadata :: !(IORef (Maybe ResponseMetadata)),+    model :: !Model,+    assembler :: !A.Assembler,+    observed :: !(Maybe Value),+    pending :: ![E.AssistantMessageEvent],+    finished :: !Bool,+    evidence :: !(Maybe (UTCTime -> Ev.CallStatus -> Maybe BaikaiError -> Ev.ModelCallEvidence))+  }++step :: State -> IO (Maybe (E.AssistantMessageEvent, State))+step s+  | e : rest <- s.pending = pure (Just (e, s {pending = rest}))+  | s.finished = pure Nothing+  | otherwise = do+      next <- pullFrame s.queue+      case next of+        Nothing -> terminate (Just (providerError "Responses stream ended without a terminal response")) s+        Just (Left err) -> terminate (Just err) s+        Just (Right raw) -> do+          let obs = mergeObservation s.observed (lookupField "response" raw)+              current = s {observed = obs}+          case responseError raw of+            Just err -> terminate (Just err) current+            Nothing -> case A.advance raw s.assembler of+              Left err -> terminate (Just (providerError err)) current+              Right (assembled, events) -> do+                let updated = current {assembler = assembled, pending = events}+                case A.terminalReason assembled of+                  Nothing -> step updated+                  Just _ -> terminate Nothing updated++-- The terminal is conclusive for Responses: releasing the stream also+-- cancels a driver that keeps waiting after response.completed.+terminate :: Maybe BaikaiError -> State -> IO (Maybe (E.AssistantMessageEvent, State))+terminate err s = do+  now <- getCurrentTime+  md <- readIORef s.metadata+  let (assembled, closes) = case err of+        Nothing -> (s.assembler, [])+        Just _ -> A.closePartial s.assembler+      reason = maybe (fromMaybe Stop (A.terminalReason assembled)) (const ErrorReason) err+      usage = responseUsage s.model s.observed+      payload = M.AssistantPayload (A.assembledContent assembled) usage reason (fmap (^. #message) err) (Just now)+      msg = M.AssistantMessage payload+      rid = s.observed >>= textField "id"+      status = maybe Ev.CallSucceeded (const Ev.CallFailed) err+      proof = fmap (\finish -> observe status md s.observed payload (finish now status err)) s.evidence+      terminal = case err of+        Nothing -> E.EventDone (E.doneTerminal proof rid reason msg)+        Just be -> E.EventError (E.errorTerminal proof rid reason msg be)+  step s {assembler = assembled, pending = s.pending <> closes <> [terminal], finished = True}++message :: V.Vector C.AssistantContent -> U.Usage -> StopReason -> Maybe Text -> UTCTime -> M.Message+message content usage reason note now = M.AssistantMessage (M.AssistantPayload content usage reason note (Just now))++resolvedUrl :: Model -> Text+resolvedUrl m = case m ^. #baseUrl of "" -> "https://api.openai.com"; u -> u++immediateError :: Model -> Options -> BaikaiError -> IO [E.AssistantMessageEvent]+immediateError m opts err = do+  now <- getCurrentTime+  let msg = message V.empty U.zeroUsage ErrorReason (Just (err ^. #message)) now+  proof <- Build.minimalEvidenceAt (resolvedUrl m) m opts Ev.TransportHttpApi (R.describeThinking m opts) (Build.dispatchEnvelope m opts) now now Ev.CallFailed (Just err)+  pure [E.EventStart (E.StartPayload msg Nothing), E.EventError (E.errorTerminal proof Nothing ErrorReason msg err)]++responseError :: Value -> Maybe BaikaiError+responseError raw = case textField "type" raw of+  Just "error" -> classifyErrorFrame (object ["error" .= raw]) <|> Just (providerError "Responses error event")+  Just "response.failed" -> (lookupField "response" raw >>= classifyErrorFrame) <|> Just (providerError "Responses response.failed")+  _ -> classifyErrorFrame raw++mergeObservation :: Maybe Value -> Maybe Value -> Maybe Value+mergeObservation old Nothing = old+mergeObservation (Just (Object old)) (Just (Object new)) =+  let merged = KM.union new old+      usage = Billing.mergeUsage (KM.lookup "usage" old) (KM.lookup "usage" new)+   in Just (Object (maybe merged (\u -> KM.insert "usage" u merged) usage))+mergeObservation _ new = new++-- Known counts and their availability travel together into payload and evidence.+responseUsage :: Model -> Maybe Value -> U.Usage+responseUsage m raw =+  let normalized = U.observeBilling [U.BillingServiceTier tier | Just tier <- [raw >>= textField "service_tier"]] (fromMaybe Billing.unreportedUsage (raw >>= lookupField "usage" >>= Billing.readUsage Billing.ResponsesUsage))+   in normalized & #cost .~ Pricing.computeCostForService Nothing Nothing m normalized++observe :: Ev.CallStatus -> Maybe ResponseMetadata -> Maybe Value -> M.AssistantPayload -> Ev.ModelCallEvidence -> Ev.ModelCallEvidence+observe status md raw payload ev =+  let seenModel = maybe Ev.Unobserved Ev.Observed (raw >>= textField "model")+      rid = maybe Ev.Unobserved Ev.Observed (raw >>= textField "id")+      requestId = case md of+        Nothing -> Ev.Unobserved+        Just meta -> case [v | n <- capturedHeaderNames, Just v <- [lookup (T.decodeUtf8 (CI.foldedCase n)) (meta ^. #headers)]] of+          v : _ -> Ev.Observed v+          [] -> Ev.Unobserved+      allCounts = do+        _ <- raw >>= lookupField "usage" >>= Billing.readUsage Billing.ResponsesUsage+        pure (payload ^. #usage)+      commitment =+        if status == Ev.CallSucceeded+          then Ev.Observed (Ev.commitmentDigest (object ["content" .= (payload ^. #content), "stop_reason" .= (payload ^. #stopReason), "usage" .= Ev.usageEnvelope (payload ^. #usage)]))+          else Ev.Unobserved+   in ev+        & #endpoint . #implementationVersion .~ Just (T.pack (showVersion Paths.version))+        & #observedModel .~ seenModel+        & #responseId .~ rid+        & #providerRequestId .~ requestId+        & #usage .~ maybe Ev.Unobserved Ev.Observed allCounts+        & #responseCommitment .~ commitment+        & #strength .~ Ev.deriveStrength seenModel requestId rid++lookupField :: Key -> Value -> Maybe Value+lookupField k (Object o) = KM.lookup k o+lookupField _ _ = Nothing++textField :: Key -> Value -> Maybe Text+textField k v = lookupField k v >>= \case String t | not (T.null t) -> Just t; _ -> Nothing++trySync :: IO a -> IO (Either SomeException a)+trySync action = do+  result <- try action+  case result of+    Left ex | Just _ <- (fromException ex :: Maybe SomeAsyncException) -> throwIO ex+    _ -> pure result++exceptionToError :: SomeException -> BaikaiError+exceptionToError ex = fromMaybe (classifyException ex) (fromException ex)

@@ -13,6 +13,7 @@     dropUnsupportedStrict,     injectThinkingShape,     describeThinkingShape,+    resolveSupportedEffort,     injectCacheControl,   ) where@@ -24,6 +25,7 @@     OpenAICompletionsCompat       ( cacheControlFormat,         maxTokensField,+        supportedReasoningEfforts,         supportsLongCacheRetention,         supportsStrictMode,         supportsUsageInStreaming,@@ -37,13 +39,16 @@     ThinkingTranslation (..),     noThinkingRequested,   )-import Baikai.Options (Options, cacheRetention, thinking)+import Baikai.Options (Options, cacheRetention, temperature, thinking, topP) import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel)+import Control.Lens ((%~), (&), (^.)) import Data.Aeson (Value (..), (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as AesonKey import Data.Aeson.KeyMap (KeyMap) import Data.Aeson.KeyMap qualified as KeyMap+import Data.Generics.Labels ()+import Data.Maybe (isJust) import Data.Text (Text) import Data.Vector (Vector) import Data.Vector qualified as Vector@@ -125,12 +130,10 @@ -- through 'compatibleEffort', the two toggle shapes carry no depth at -- all, and 'ThinkingFormatNone' drops the request entirely. ----- The native shape is the one that records __no__ adjustment, because--- it forwards the canonical level verbatim and therefore expresses all--- six exactly. That is deliberate and guarded by @nativeHigherEffortTests@--- 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 native shape preserves each level unless the model explicitly+-- restricts its accepted vocabulary. Any replacement is described by+-- the same mapping that writes the wire field. Host-specific clamping+-- remains separate from this per-model policy. -- -- The 'Bool' is whether the chosen model advertises reasoning support -- ('Baikai.Model.reasoning'). It is consulted /before/ the host's@@ -150,6 +153,28 @@   Aeson.Value ->   (Aeson.Value, ThinkingTranslation) injectThinkingShape compat modelReasons opts body =+  let (shaped, translation) = injectEffort compat modelReasons opts body+      dropped = [name | (name, present) <- [("temperature", isJust (temperature opts)), ("top_p", isJust (topP opts))], present]+   in if compat ^. #supportsSamplingParameters+        then (shaped, translation)+        else+          ( mapObject (KeyMap.delete "temperature" . KeyMap.delete "top_p") shaped,+            translation & #adjustments %~ (<> [SamplingDroppedUnsupportedModel dropped | not (null dropped)])+          )++-- | Resolve to the nearest accepted level at or above the request, or+-- the greatest accepted level when the request exceeds the policy.+-- Invalid empty policies are rejected by request validation.+resolveSupportedEffort :: Maybe [ThinkingLevel] -> ThinkingLevel -> ThinkingLevel+resolveSupportedEffort Nothing lvl = lvl+resolveSupportedEffort (Just []) lvl = lvl+resolveSupportedEffort (Just levels) lvl =+  case filter (>= lvl) levels of+    first : _ -> first+    [] -> last levels++injectEffort :: OpenAICompletionsCompat -> Bool -> Options -> Aeson.Value -> (Aeson.Value, ThinkingTranslation)+injectEffort compat modelReasons opts body =   case thinking opts of     Nothing -> (body, noThinkingRequested)     Just lvl@@ -161,12 +186,13 @@                 effortText = Nothing,                 budgetTokens = Nothing,                 wireField = Nothing,+                displayText = Nothing,                 adjustments = [ThinkingDroppedUnsupportedModel lvl]               }           )     Just lvl -> case thinkingFormat compat of       ThinkingFormatOpenAI ->-        let e = renderThinkingLevel lvl+        let e = renderThinkingLevel (resolveSupportedEffort (supportedReasoningEfforts compat) lvl)          in ( insertTop "reasoning_effort" (String e) body,               effortTranslation lvl e "reasoning_effort"             )@@ -178,6 +204,7 @@               effortText = Nothing,               budgetTokens = Nothing,               wireField = Nothing,+              displayText = Nothing,               adjustments = [ThinkingDroppedUnsupportedHost lvl]             }         )@@ -238,6 +265,7 @@       effortText = Just wire,       budgetTokens = Nothing,       wireField = Just field,+      displayText = Nothing,       adjustments =         [EffortClamped lvl wire | wire /= renderThinkingLevel lvl]     }@@ -256,6 +284,7 @@       effortText = Nothing,       budgetTokens = Nothing,       wireField = Just "enable_thinking",+      displayText = Nothing,       adjustments = [EffortCollapsedToToggle lvl]     } 

@@ -10,8 +10,10 @@   ( openaiSseStream,     openaiSseStreamValue,     openaiSseStreamValueWithHeaders,+    responsesSseStreamValueWithHeaders,     sseFromResponse,     buildRequest,+    buildResponsesRequest,     ResponseMetadata (..),     capturedHeaderNames,   )@@ -128,8 +130,30 @@   (ResponseMetadata -> IO ()) ->   (Either BaikaiError Aeson.Value -> IO ()) ->   IO ()-openaiSseStreamValueWithHeaders env requestHeaders requestBody onMetadata onEvent = do-  HTTP.withResponse (buildRequest (Client.baseUrl env) requestHeaders requestBody) (Client.manager env) $ \response ->+openaiSseStreamValueWithHeaders = sseStreamWith buildRequest++-- | Native Responses uses the same HTTP ownership and SSE framing, but+-- has a distinct URL and event protocol. The Responses assembler owns+-- interpretation of the JSON frames.+responsesSseStreamValueWithHeaders ::+  Client.ClientEnv ->+  RequestHeaders ->+  Aeson.Value ->+  (ResponseMetadata -> IO ()) ->+  (Either BaikaiError Aeson.Value -> IO ()) ->+  IO ()+responsesSseStreamValueWithHeaders = sseStreamWith buildResponsesRequest++sseStreamWith ::+  (Client.BaseUrl -> RequestHeaders -> Aeson.Value -> HTTP.Request) ->+  Client.ClientEnv ->+  RequestHeaders ->+  Aeson.Value ->+  (ResponseMetadata -> IO ()) ->+  (Either BaikaiError Aeson.Value -> IO ()) ->+  IO ()+sseStreamWith makeRequest env requestHeaders requestBody onMetadata onEvent =+  HTTP.withResponse (makeRequest (Client.baseUrl env) requestHeaders requestBody) (Client.manager env) $ \response ->     sseFromResponse response onMetadata onEvent  -- | The exact request this transport sends.@@ -145,7 +169,13 @@ -- 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 =+buildRequest = buildRequestAt "/v1/chat/completions"++buildResponsesRequest :: Client.BaseUrl -> RequestHeaders -> Aeson.Value -> HTTP.Request+buildResponsesRequest = buildRequestAt "/v1/responses"++buildRequestAt :: String -> Client.BaseUrl -> RequestHeaders -> Aeson.Value -> HTTP.Request+buildRequestAt endpoint base requestHeaders requestBody =   HTTP.defaultRequest     { HTTP.secure = case Client.baseUrlScheme base of         Client.Http -> False@@ -153,7 +183,7 @@       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.path = S8.pack (normalizePath (Client.baseUrlPath base) <> endpoint),       HTTP.requestHeaders = requestHeaders,       HTTP.requestBody = HTTP.RequestBodyLBS (Aeson.encode requestBody),       -- This POST has no legitimate redirect, and http-client's default

@@ -82,7 +82,8 @@       message = "provider stream exceeded timeoutMs=" <> Text.pack (show ms),       httpStatus = Nothing,       retryAfterSeconds = Nothing,-      exitCode = Nothing+      exitCode = Nothing,+      refusalCategory = Nothing     }  -- | Apply caller overrides over the provider's own headers.

@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedRecordDot #-}++module BillingSpec (tests) where++import Baikai qualified as B+import Baikai.Cost qualified as C+import Baikai.Cost.Pricing (computeCost)+import Baikai.Evidence (commitmentDigest, usageEnvelope)+import Baikai.Models.Generated qualified as Models+import Baikai.Provider.OpenAI.Internal.Stream qualified as Chat+import Baikai.Provider.OpenAI.Internal.Usage+import Baikai.Usage qualified as U+import Baikai.Usage.Normalize qualified as N+import Control.Lens ((&), (.~))+import Control.Monad (forM_)+import Data.Aeson (Value, object, (.=))+import Data.Aeson.Key (Key)+import Data.Aeson.Types qualified+import Data.Set qualified as Set+import Data.Text (Text)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Billing normalization"+    [ testCase "Chat observes the reported tier and discloses unsupported pricing" $+        forM_ [("default", Set.empty), ("priority", Set.singleton (C.UnsupportedServiceTier "priority"))] $ \(tier, reasons) -> do+          let frame = object ["service_tier" .= (tier :: Text), "usage" .= wire ChatUsage 1000 ["cached_tokens" .= (0 :: Int), "cache_write_tokens" .= (0 :: Int)], "choices" .= [object ["finish_reason" .= ("stop" :: Text), "delta" .= object []]]]+              driver _ _ _ _ emit = emit (Right frame)+              model = Models.openai_gpt_6_astra & #api .~ B.OpenAIChatCompletions & #compat .~ B.CompatNone+          response <- B.streamingComplete (Chat.openaiChatStreamWith driver) model B.emptyContext (B.emptyOptions & #apiKey .~ Just (B.ApiKeyLiteral "offline"))+          response.message.usage.cost.basis.estimateReasons @?= reasons+          U.billingFacts <$> response.message.usage.availability @?= Just (Set.singleton (U.BillingServiceTier tier)),+      testCase "both endpoints subtract reported reads and writes exactly once" $+        forM_ [ChatUsage, ResponsesUsage] $ \endpoint -> do+          u <- parsed endpoint (wire endpoint 15000 ["cached_tokens" .= (12000 :: Int), "cache_write_tokens" .= (3000 :: Int)])+          (u.inputTokens, u.cacheReadTokens, u.cacheWriteTokens, u.outputTokens, u.totalTokens) @?= (0, 12000, 3000, 100, 15100)+          u.availability @?= Just (U.UsageAvailability Set.empty False Set.empty)+          (computeCost Models.openai_gpt_6_astra u).usd @?= 109 / 2000,+      testCase "missing writes retain counts but make cost an explicit estimate" $ do+        missing <- parsed ResponsesUsage (wire ResponsesUsage 15000 ["cached_tokens" .= (12000 :: Int)])+        zero <- parsed ResponsesUsage (wire ResponsesUsage 15000 ["cached_tokens" .= (12000 :: Int), "cache_write_tokens" .= (0 :: Int)])+        missing.inputTokens @?= 3000+        missing.totalTokens @?= zero.totalTokens+        (computeCost Models.openai_gpt_6_astra missing).basis.estimateReasons @?= Set.singleton C.CacheWriteUsageNotReported+        (computeCost Models.openai_gpt_6_astra zero).basis.estimateReasons @?= Set.empty+        assertBool "provider commitments distinguish omitted and zero counters" (commitmentDigest (usageEnvelope missing) /= commitmentDigest (usageEnvelope zero)),+      testCase "empty usage is unreported but explicit zero is reported" $ do+        readUsage ResponsesUsage (object []) @?= Nothing+        (computeCost Models.openai_gpt_6_astra unreportedUsage).basis.estimateReasons @?= Set.singleton C.UsageNotReported+        zero <- parsed ResponsesUsage (object ["input_tokens" .= (0 :: Int), "output_tokens" .= (0 :: Int), "input_tokens_details" .= object ["cached_tokens" .= (0 :: Int), "cache_write_tokens" .= (0 :: Int)]])+        zero.totalTokens @?= 0+        (computeCost Models.openai_gpt_6_astra zero).basis.estimateReasons @?= Set.empty,+      testCase "partial usage retains its reported categories" $ do+        u <- parsed ChatUsage (object ["completion_tokens" .= (50 :: Int)])+        u.outputTokens @?= 50+        u.availability @?= Just (U.UsageAvailability (Set.fromList [U.InputUsage, U.CacheReadUsage, U.CacheWriteUsage]) False Set.empty),+      testCase "invalid and inconsistent counters are never exact" $+        forM_ [wire ResponsesUsage 100 ["cached_tokens" .= (120 :: Int)], wire ResponsesUsage 100 ["cache_write_tokens" .= (-1 :: Int)], wire ResponsesUsage 100 ["cached_tokens" .= (1.5 :: Double)]] $ \raw -> do+          u <- parsed ResponsesUsage raw+          assertBool "inconsistency survives into calculation basis" (C.InconsistentUsage `Set.member` (computeCost Models.openai_gpt_6_astra u).basis.estimateReasons),+      testCase "exclusive input sums cache categories and reasoning stays a subset" $ do+        let u = N.normalizeUsage N.ExclusiveInput (N.ReportedUsage (Just 10) (Just 100) (Just 20) (Just 30) (Just 80))+        (u.inputTokens, u.totalTokens) @?= (10, 160)+        u.availability @?= Just (U.UsageAvailability Set.empty False Set.empty),+      testCase "cumulative snapshots retain missing fields and never double counts" $ do+        let initial = wire ResponsesUsage 15000 ["cached_tokens" .= (12000 :: Int)]+            final = object ["output_tokens" .= (200 :: Int), "input_tokens_details" .= object ["cache_write_tokens" .= (3000 :: Int)]]+            snapshot = mergeUsage (Just initial) (Just final)+        mergeUsage snapshot (Just final) @?= snapshot+        u <- maybe (assertFailure "missing merged usage") (parsed ResponsesUsage) snapshot+        (u.inputTokens, u.outputTokens, u.cacheReadTokens, u.cacheWriteTokens, u.totalTokens) @?= (0, 200, 12000, 3000, 15200)+        u.availability @?= Just (U.UsageAvailability Set.empty False Set.empty),+      testCase "availability aggregation retains unknown categories and monoid identity" $ do+        a <- parsed ResponsesUsage (wire ResponsesUsage 100 [])+        b <- parsed ResponsesUsage (wire ResponsesUsage 100 ["cached_tokens" .= (120 :: Int)])+        mempty <> a @?= a+        a <> mempty @?= a+        (a <> b) <> a @?= a <> (b <> a)+        U.inconsistent <$> (a <> b).availability @?= Just True+    ]++wire :: UsageEndpoint -> Int -> [Data.Aeson.Types.Pair] -> Value+wire endpoint input details =+  let (i, o, d) = case endpoint of ChatUsage -> ("prompt_tokens", "completion_tokens", "prompt_tokens_details"); ResponsesUsage -> ("input_tokens", "output_tokens", "input_tokens_details")+   in object [(i :: Key) .= input, o .= (100 :: Int), d .= object details]++parsed :: UsageEndpoint -> Value -> IO U.Usage+parsed endpoint raw = maybe (assertFailure "expected usage") pure (readUsage endpoint raw)

@@ -0,0 +1,20 @@+-- | Explicit Chat capability fixture, independent of catalog routing.+module EndpointModels (chatRestrictedModel) where++import Baikai+import Control.Lens ((&), (.~))++chatRestrictedModel :: Model+chatRestrictedModel =+  emptyModel+    & #api .~ OpenAIChatCompletions+    & #provider .~ "openai"+    & #modelId .~ "restricted-chat-model"+    & #reasoning .~ True+    & #compat+      .~ CompatOpenAICompletions+        ( defaultOpenAICompletionsCompat+            & #supportsToolCalls .~ False+            & #supportsSamplingParameters .~ False+            & #supportedReasoningEfforts .~ Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax]+        )

@@ -36,6 +36,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Vector qualified as Vector+import EndpointModels (chatRestrictedModel) import Network.HTTP.Client.Internal qualified as HTTP import Network.HTTP.Types.Status (mkStatus) import Network.HTTP.Types.Version (http11)@@ -51,7 +52,8 @@     -- @--test-options='--pattern Evidence'@ actually selects it. A     -- pattern that matches nothing reports "All 0 tests passed".     "EvidenceSpec: OpenAI-compatible model-call evidence"-    [ successEvidenceTest,+    [ endpointEvidenceTest,+      successEvidenceTest,       rateLimitEvidenceTest,       toggleHostIndistinguishabilityTest,       nonReasoningModelEvidenceTest,@@ -495,3 +497,30 @@   assertBool     (Text.unpack k <> " must be a sha256 digest, got: " <> show d)     ("sha256:" `Text.isPrefixOf` d && Text.length d == 71)++endpointEvidenceTest :: TestTree+endpointEvidenceTest = testCase "Astra text shaping and strict refusal agree with evidence" $ do+  bodyRef <- newIORef Null+  let model = chatRestrictedModel & #modelId .~ "renamed-astra"+      opts =+        baseOptions+          & #thinking .~ Just ThinkingMinimal+          & #temperature .~ Just 0.5+          & #topP .~ Just 0.9+          & #toolChoice .~ Just ToolChoiceAuto+  ev <- oneEvidence =<< replayWith bodyRef model 200 successHeaders successBody opts+  body <- readIORef bodyRef+  lookupIn "reasoning_effort" body @?= Just (String "low")+  lookupIn "temperature" body @?= Nothing+  lookupIn "top_p" body @?= Nothing+  thinkingOf ev "effort_text" @?= Just (String "low")+  let described = describeThinkingShape (openaiCompletionsCompatFor model) True opts+  field "thinking" ev @?= Just (Aeson.toJSON described)+  described ^. #adjustments @?= [EffortClamped ThinkingMinimal "low", SamplingDroppedUnsupportedModel ["temperature", "top_p"]]+  samplingOnly <- oneEvidence =<< replayWith bodyRef model 200 successHeaders successBody (opts & #thinking .~ Nothing)+  thinkingOf samplingOnly "adjustments" @?= Just (Aeson.toJSON [SamplingDroppedUnsupportedModel ["temperature", "top_p"]])+  writeIORef bodyRef Null+  let strict = opts & #evidence .~ Just (evidenceRequest "strict-astra" & #strictness .~ EvidenceRequired EvidenceRequestedOnly)+  refused <- oneEvidence =<< replayWith bodyRef model 200 successHeaders successBody strict+  readIORef bodyRef >>= (@?= Null)+  field "status" refused @?= Just (String "failed")

@@ -13,9 +13,10 @@ module LifecycleSpec (tests) where  import Baikai-import Baikai.Models.Generated (openai_gpt_4o_mini)+import Baikai.Models.Generated (openai_gpt_4o_mini, openai_gpt_6_astra) import Baikai.Provider.Internal.StreamWorker (frameQueueCapacity) import Baikai.Provider.OpenAI.Internal.Stream (SseDriver, openaiChatStreamWith)+import Baikai.Provider.OpenAI.Responses.Stream (openaiResponsesStreamWith) import Baikai.Provider.OpenAI.Sse (sseFromResponse) import Control.Concurrent (forkIO, threadDelay, throwTo) import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)@@ -25,9 +26,11 @@ import Data.CaseInsensitive qualified as CI import Data.Generics.Labels () import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)+import Data.Text (Text) import Network.HTTP.Client.Internal qualified as HTTP import Network.HTTP.Types.Status (mkStatus) import Network.HTTP.Types.Version (http11)+import Streamly.Data.Stream (Stream) import Streamly.Data.Stream qualified as Stream import System.Mem (performMajorGC) import System.Timeout (timeout)@@ -37,19 +40,35 @@ tests :: TestTree tests =   testGroup-    "Baikai.Provider.OpenAI lifecycle"-    [ boundedReadTest,-      abandonedReleasesAfterGcTest,-      cancellationReleasesWithoutGcTest,-      workerDeathCannotStrandTest+    "OpenAI worker lifecycle"+    [ backendTests "Chat lifecycle" chatBackend,+      backendTests "Responses lifecycle" responsesBackend     ] +backendTests :: String -> Backend -> TestTree+backendTests title backend =+  testGroup+    title+    [ boundedReadTest backend,+      abandonedReleasesAfterGcTest backend,+      cancellationReleasesWithoutGcTest backend,+      workerDeathCannotStrandTest backend+    ]++data Backend = Backend+  { streamWith :: SseDriver -> Model -> Context -> Options -> Stream IO AssistantMessageEvent,+    modelFor :: Model,+    initialFrame :: ByteString,+    nextFrame :: ByteString,+    eofMessage :: Text+  }+ -- | 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 =+boundedReadTest :: Backend -> TestTree+boundedReadTest backend =   testCase "a consumer that stops after three events stops the body reader within the queue bound" $ do     reads' <- newIORef (0 :: Int)     closedRef <- newIORef False@@ -57,7 +76,7 @@       Stream.toList         ( Stream.take             3-            (openaiChatStreamWith (countingDriver reads' closedRef Nothing) testModel emptyContext testOptions)+            (streamWith backend (countingDriver backend reads' closedRef Nothing) (modelFor backend) emptyContext testOptions)         )     length events @?= 3     settled <- awaitSettled reads'@@ -68,8 +87,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 =+abandonedReleasesAfterGcTest :: Backend -> TestTree+abandonedReleasesAfterGcTest backend =   testCase "an abandoned stream releases its connection after a major GC" $ do     reads' <- newIORef (0 :: Int)     closedRef <- newIORef False@@ -77,7 +96,7 @@       Stream.toList         ( Stream.take             3-            (openaiChatStreamWith (countingDriver reads' closedRef Nothing) testModel emptyContext testOptions)+            (streamWith backend (countingDriver backend reads' closedRef Nothing) (modelFor backend) emptyContext testOptions)         )     released <- pollFor 100 50000 (performMajorGC >> readIORef closedRef)     assertBool "an abandoned stream's connection is released at a major GC" released@@ -85,8 +104,8 @@ -- | 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 =+cancellationReleasesWithoutGcTest :: Backend -> TestTree+cancellationReleasesWithoutGcTest backend =   testCase "cancelling the consumer releases the connection without a GC" $ do     reads' <- newIORef (0 :: Int)     closedRef <- newIORef False@@ -97,7 +116,7 @@         r <-           try             ( Stream.toList-                (openaiChatStreamWith (countingDriver reads' closedRef (Just gate)) testModel emptyContext testOptions)+                (streamWith backend (countingDriver backend reads' closedRef (Just gate)) (modelFor backend) emptyContext testOptions)             )         putMVar outcome (r :: Either SomeException [AssistantMessageEvent])     threadDelay 100000@@ -113,22 +132,22 @@ -- 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 =+workerDeathCannotStrandTest :: Backend -> TestTree+workerDeathCannotStrandTest backend =   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))+        (Stream.toList (streamWith backend dyingDriver (modelFor backend) 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"+          fmap (^. #message) (p ^. #errorInfo) @?= Just (eofMessage backend)         other -> assertFailure ("expected a terminal EventError, got: " <> show (take 1 other))  -- --------------------------------------------------------------------@@ -142,8 +161,8 @@ -- 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 =+countingDriver :: Backend -> IORef Int -> IORef Bool -> Maybe (MVar ()) -> SseDriver+countingDriver backend reads' closedRef gate _env _headers _body onMetadata onEvent =   bracket mkFakeResponse HTTP.responseClose $ \resp ->     sseFromResponse resp onMetadata onEvent   where@@ -163,7 +182,7 @@       n <- atomicModifyIORef' reads' (\k -> (k + 1, k))       case gate of         Just g | n >= 3 -> takeMVar g >> pure ""-        _ -> pure contentFrame+        _ -> pure (if n == 0 then initialFrame backend else nextFrame backend)  -- | An endless stream of visible-text deltas. contentFrame :: ByteString@@ -202,3 +221,15 @@  testOptions :: Options testOptions = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "test-key")++chatBackend :: Backend+chatBackend = Backend openaiChatStreamWith testModel contentFrame contentFrame "openai stream ended without finish_reason"++responsesBackend :: Backend+responsesBackend =+  Backend+    openaiResponsesStreamWith+    openai_gpt_6_astra+    "data: {\"type\":\"response.output_item.added\",\"output_index\":0,\"item\":{\"type\":\"message\",\"id\":\"msg\",\"content\":[]}}\n\n"+    "data: {\"type\":\"response.output_text.delta\",\"output_index\":0,\"content_index\":0,\"item_id\":\"msg\",\"delta\":\"x\"}\n\n"+    "Responses stream ended without a terminal response"

@@ -29,6 +29,7 @@     translate,   ) import Baikai.Provider.OpenAI.Shape (describeThinkingShape)+import BillingSpec qualified import CliEvidenceSpec qualified import Contract (assertErrorContract, assertOneErrorTerminal) import Control.Exception (bracket)@@ -47,6 +48,11 @@ import OpenAI.V1.ResponseFormat qualified as RF import PublicSurfaceSpec qualified import ReasoningSpec qualified+import ResponsesAssemblerSpec qualified+import ResponsesEvidenceSpec qualified+import ResponsesSpec qualified+import ResponsesStreamSpec qualified+import ResponsesTransportSpec qualified import ShapeSpec qualified import SseSpec qualified import Streamly.Data.Stream qualified as Stream@@ -92,6 +98,7 @@         finishReasonTests,         responseFormatMappingTest,         optionsMappingTest,+        BillingSpec.tests,         CliEvidenceSpec.tests,         ErrorClassSpec.tests,         EvidenceSpec.tests,@@ -99,6 +106,11 @@         MidStreamSpec.tests,         PublicSurfaceSpec.tests,         ReasoningSpec.tests,+        ResponsesAssemblerSpec.tests,+        ResponsesEvidenceSpec.tests,+        ResponsesSpec.tests,+        ResponsesStreamSpec.tests,+        ResponsesTransportSpec.tests,         ShapeSpec.tests,         SseSpec.tests,         TransportSpec.tests@@ -509,6 +521,7 @@                     effortText = Just (renderThinkingLevel level),                     budgetTokens = Nothing,                     wireField = Just "model_reasoning_effort",+                    displayText = Nothing,                     adjustments = []                   }           | level <-@@ -969,12 +982,12 @@     [ testCase "content_filter terminates as EventError" $ do         let (_events1, ass1) =               translate-                (Right RawChunk {contentDelta = Just "partial", reasoningDelta = Nothing, finishReason = Nothing, toolDeltas = [], usage = Nothing, model = Nothing, responseId = Nothing})+                (Right RawChunk {contentDelta = Just "partial", reasoningDelta = Nothing, finishReason = Nothing, toolDeltas = [], usage = Nothing, model = Nothing, serviceTier = Nothing, responseId = Nothing})                 (emptyAssembler openaiTestModel (read "2026-06-05 00:00:00 UTC"))                 (read "2026-06-05 00:00:01 UTC")             (events2, ass2) =               translate-                (Right RawChunk {contentDelta = Nothing, reasoningDelta = Nothing, finishReason = Just "content_filter", toolDeltas = [], usage = Nothing, model = Nothing, responseId = Nothing})+                (Right RawChunk {contentDelta = Nothing, reasoningDelta = Nothing, finishReason = Just "content_filter", toolDeltas = [], usage = Nothing, model = Nothing, serviceTier = Nothing, responseId = Nothing})                 ass1                 (read "2026-06-05 00:00:02 UTC")             (events3, _) = closeOpenStream (read "2026-06-05 00:00:03 UTC") Nothing ass2@@ -991,7 +1004,7 @@       testCase "unknown finish_reason is a successful diagnostic" $ do         let (_events, ass1) =               translate-                (Right RawChunk {contentDelta = Nothing, reasoningDelta = Nothing, finishReason = Just "mystery", toolDeltas = [], usage = Nothing, model = Nothing, responseId = Nothing})+                (Right RawChunk {contentDelta = Nothing, reasoningDelta = Nothing, finishReason = Just "mystery", toolDeltas = [], usage = Nothing, model = Nothing, serviceTier = Nothing, responseId = Nothing})                 (emptyAssembler openaiTestModel (read "2026-06-05 00:00:00 UTC"))                 (read "2026-06-05 00:00:01 UTC")             (terminalEvents, _) = closeOpenStream (read "2026-06-05 00:00:02 UTC") Nothing ass1

@@ -15,8 +15,9 @@     scanThinkTags,     translate,   )+import Baikai.Provider.OpenAI.Shape (describeThinkingShape) import Baikai.Provider.OpenAI.Sse (sseFromResponse)-import Control.Lens ((&), (.~))+import Control.Lens ((&), (.~), (^.)) import Data.Aeson qualified as Aeson import Data.ByteString (ByteString) import Data.ByteString.Lazy qualified as LBS@@ -25,6 +26,7 @@ import Data.Text qualified as Text import Data.Time.Clock (UTCTime) import Data.Vector qualified as Vector+import EndpointModels (chatRestrictedModel) import Network.HTTP.Client.Internal qualified as HTTP import Network.HTTP.Types.Status (mkStatus) import Network.HTTP.Types.Version (http11)@@ -36,7 +38,20 @@ tests =   testGroup     "ReasoningSpec"-    [ parseReasoningTests,+    [ testCase "foreign opaque reasoning cannot enter this endpoint" $ do+        let thought = emptyThinkingContent & #replayState .~ Just (ThinkingReplay OpenAIResponses "gpt-6-astra" (Vector.singleton (Aeson.object [])))+            response = emptyResponse & #message . #content .~ Vector.singleton (AssistantThinking thought)+            ctx = addResponse response emptyContext+        case mapRequest openai_gpt_4o_mini ctx emptyOptions of+          Left _ -> pure ()+          Right _ -> assertFailure "foreign state was silently accepted",+      testCase "minimal maps upward by catalog policy with adjustment evidence" $ do+        let model = chatRestrictedModel & #modelId .~ "renamed-policy-test"+            opts = emptyOptions & #thinking .~ Just ThinkingMinimal+            described = describeThinkingShape (openaiCompletionsCompatFor model) True opts+        described ^. #effortText @?= Just "low"+        described ^. #adjustments @?= [EffortClamped ThinkingMinimal "low"],+      parseReasoningTests,       assemblyTests,       tagScannerTests,       taggedTextCompatTest,@@ -87,7 +102,8 @@                 ThinkingContent                   { thinking = "because therefore",                     signature = Nothing,-                    redacted = False+                    redacted = False,+                    replayState = Nothing                   },               AssistantText (TextContent "answer done")             ],@@ -130,7 +146,8 @@                 ThinkingContent                   { thinking = "because",                     signature = Nothing,-                    redacted = False+                    redacted = False,+                    replayState = Nothing                   },               AssistantText (TextContent "answer")             ],@@ -236,7 +253,8 @@             ThinkingContent               { thinking = "reasoning",                 signature = Nothing,-                redacted = False+                redacted = False,+                replayState = Nothing               },           AssistantText (TextContent "answer")         ]@@ -255,7 +273,8 @@                         ThinkingContent                           { thinking = "internal",                             signature = Nothing,-                            redacted = False+                            redacted = False,+                            replayState = Nothing                           },                       AssistantText (TextContent "visible")                     ],@@ -300,6 +319,7 @@       toolDeltas = [],       usage = Nothing,       model = Nothing,+      serviceTier = Nothing,       responseId = Nothing     } 

@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedRecordDot #-}++module ResponsesAssemblerSpec (tests) where++import Baikai.Content qualified as C+import Baikai.Provider.OpenAI.Responses.Assembler qualified as A+import Baikai.StopReason (StopReason (..))+import Baikai.Stream.Event qualified as E+import Control.Monad (foldM)+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson.Key (Key)+import Data.Text (Text)+import Data.Vector qualified as V+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Responses assembler"+    [ testCase "streams text immediately and reconciles snapshots without duplication" $ do+        (s, events) <- run [added 0 (message ""), textDelta 0 0 "hello"]+        events @?= [E.TextStart (E.IndexPayload 0), E.TextDelta (E.DeltaPayload 0 "hello")]+        (done, rest) <- step (completed [message "hello world"]) s+        rest @?= [E.TextDelta (E.DeltaPayload 0 " world"), E.TextEnd (E.BlockEndPayload 0 "hello world")]+        A.assembledContent done @?= V.singleton (C.AssistantText (C.TextContent "hello world"))+        A.terminalReason done @?= Just Stop+        (_, again) <- step (completed [message "hello world"]) done+        again @?= [],+      testCase "parallel function calls retain call IDs and serialize blocks" $ do+        (s, events) <-+          run+            [ added 0 (call "item_a" "call_a" "" "in_progress"),+              added 1 (call "item_b" "call_b" "" "in_progress"),+              argDelta 1 "item_b" "{\"b\":2}",+              argDelta 0 "item_a" "{\"a\":1}",+              itemDone 1 (call "item_b" "call_b" "{\"b\":2}" "completed"),+              itemDone 0 (call "item_a" "call_a" "{\"a\":1}" "completed"),+              completed [call "item_a" "call_a" "{\"a\":1}" "completed", call "item_b" "call_b" "{\"b\":2}" "completed"]+            ]+        A.terminalReason s @?= Just ToolUse+        A.assembledContent s+          @?= V.fromList+            [C.AssistantToolCall (C.ToolCall "call_a" "lookup" (object ["a" .= (1 :: Int)])), C.AssistantToolCall (C.ToolCall "call_b" "lookup" (object ["b" .= (2 :: Int)]))]+        [n | E.ToolCallStart (E.IndexPayload n) <- events] @?= [0, 1]+        [n | E.ToolCallEnd (E.ToolCallEndPayload n _) <- events] @?= [0, 1]+        assertBool "second block waits for first end" (case drop 2 events of E.ToolCallEnd _ : E.ToolCallStart _ : _ -> True; _ -> False),+      testCase "empty summary retains the entire encrypted reasoning item" $ do+        (s, _) <- run [added 0 reasoningAdded, itemDone 0 reasoning, completed [reasoning]]+        case V.toList (A.assembledContent s) of+          [C.AssistantThinking t] -> do+            t.thinking @?= ""+            fmap (.replayItems) t.replayState @?= Just (V.singleton reasoning)+            fmap (.replayModel) t.replayState @?= Just "configured-model"+          _ -> assertFailure "missing thinking block",+      testCase "later content parts wait for earlier parts and final snapshots fill gaps" $ do+        (s, _) <- run [added 0 (message ""), textDelta 0 1 "second", textDelta 0 0 "first"]+        let final = object ["type" .= ("message" :: Text), "id" .= ("msg" :: Text), "content" .= [part "first", part "second"]]+        (done, events) <- step (completed [final]) s+        events @?= [E.TextDelta (E.DeltaPayload 0 "second"), E.TextEnd (E.BlockEndPayload 0 "firstsecond")]+        A.assembledContent done @?= V.singleton (C.AssistantText (C.TextContent "firstsecond")),+      testCase "interrupted parseable function prefix stays cut off" $ do+        (s, _) <- run [added 0 (call "item_a" "call_a" "" "in_progress"), argDelta 0 "item_a" "{}"]+        let (closed, _) = A.closePartial s+        A.assembledContent closed @?= V.singleton (C.AssistantToolCall (C.ToolCall "call_a" "lookup" (String "{}"))),+      testCase "incomplete response does not turn a truncated call into executable JSON" $ do+        let item = call "item_a" "call_a" "{}" "incomplete"+        (s, _) <- run [frame "response.incomplete" ["response" .= object ["output" .= [item], "incomplete_details" .= object ["reason" .= ("max_output_tokens" :: Text)]]]]+        A.terminalReason s @?= Just Length+        A.assembledContent s @?= V.singleton (C.AssistantToolCall (C.ToolCall "call_a" "lookup" (String "{}"))),+      testCase "contradictory snapshots and wrong item identities fail" $ do+        (s, _) <- run [added 0 (message ""), textDelta 0 0 "prefix"]+        rejects (completed [message "replacement"]) s+        rejects (argDelta 0 "wrong" "secret") s+        rejects (added 1 (message "")) s,+      testCase "part done snapshots and item done snapshots never repeat text" $ do+        let textDone = frame "response.output_text.done" ["output_index" .= (0 :: Int), "item_id" .= ("msg" :: Text), "content_index" .= (0 :: Int), "text" .= ("hello" :: Text)]+        (s, events) <- run [added 0 (message ""), textDelta 0 0 "hel", textDone, textDone, itemDone 0 (message "hello"), completed [message "hello"]]+        [t | E.TextDelta (E.DeltaPayload _ t) <- events] @?= ["hel", "lo"]+        A.terminalReason s @?= Just Stop,+      testCase "reasoning summaries stream while encrypted state stays out of deltas" $ do+        let summary = object ["type" .= ("summary_text" :: Text), "text" .= ("consider" :: Text)]+            raw = object ["type" .= ("reasoning" :: Text), "id" .= ("rs" :: Text), "summary" .= [summary], "encrypted_content" .= ("opaque" :: Text)]+            d = frame "response.reasoning_summary_text.delta" ["output_index" .= (0 :: Int), "item_id" .= ("rs" :: Text), "summary_index" .= (0 :: Int), "delta" .= ("consider" :: Text)]+        (s, events) <- run [added 0 reasoningAdded, d, completed [raw]]+        [t | E.ThinkingDelta (E.DeltaPayload _ t) <- events] @?= ["consider"]+        case V.toList (A.assembledContent s) of+          [C.AssistantThinking t] -> fmap (.replayItems) t.replayState @?= Just (V.singleton raw)+          _ -> assertFailure "missing summary",+      testCase "partial text closes with its observed prefix" $ do+        (s, _) <- run [added 0 (message ""), textDelta 0 0 "partial"]+        let (closed, events) = A.closePartial s+        events @?= [E.TextEnd (E.BlockEndPayload 0 "partial")]+        A.assembledContent closed @?= V.singleton (C.AssistantText (C.TextContent "partial"))+        let (_, repeated) = A.closePartial closed+        repeated @?= [],+      testCase "terminal retains exact observed usage including absent cache-write field" $ do+        let raw = object ["id" .= ("r" :: Text), "model" .= ("observed" :: Text), "output" .= [message "ok"], "usage" .= object ["input_tokens" .= (20 :: Int), "input_tokens_details" .= object ["cached_tokens" .= (10 :: Int)]]]+        (s, _) <- run [frame "response.completed" ["response" .= raw]]+        A.observedResponse s @?= Just raw,+      testCase "duplicate call IDs cannot masquerade as separate tool calls" $ do+        (s, _) <- run [added 0 (call "item_a" "same_call" "" "in_progress")]+        rejects (added 1 (call "item_b" "same_call" "" "in_progress")) s+        rejects (completed [call "item_a" "same_call" "{}" "completed", call "item_b" "same_call" "{}" "completed"]) s,+      testCase "successful reasoning must carry replayable continuation" $ do+        rejects (completed [reasoningAdded]) (A.emptyAssembler "m"),+      testCase "failure and malformed frames remain failures" $ do+        mapM_+          (\f -> rejects f (A.emptyAssembler "m"))+          [frame "response.failed" [], frame "error" [], object [], added (-1) (message ""), completed [object ["type" .= ("web_search_call" :: Text), "id" .= ("w" :: Text)]]]+    ]++run :: [Value] -> IO (A.Assembler, [E.AssistantMessageEvent])+run = foldM (\(s, es) f -> do (next, events) <- step f s; pure (next, es <> events)) (A.emptyAssembler "configured-model", [])++step :: Value -> A.Assembler -> IO (A.Assembler, [E.AssistantMessageEvent])+step f s = either (\e -> assertFailure (show e) >> fail "assembly failed") pure (A.advance f s)++rejects :: Value -> A.Assembler -> IO ()+rejects f s = case A.advance f s of Left _ -> pure (); Right _ -> assertFailure "expected schema rejection"++frame :: Text -> [(Key, Value)] -> Value+frame t fields = object (("type" .= t) : fields)++added :: Int -> Value -> Value+added n item = frame "response.output_item.added" ["output_index" .= n, "item" .= item]++itemDone :: Int -> Value -> Value+itemDone n item = frame "response.output_item.done" ["output_index" .= n, "item" .= item]++completed :: [Value] -> Value+completed items = frame "response.completed" ["response" .= object ["id" .= ("resp" :: Text), "model" .= ("observed-model" :: Text), "output" .= items]]++part :: Text -> Value+part t = object ["type" .= ("output_text" :: Text), "text" .= t]++message :: Text -> Value+message t = object ["type" .= ("message" :: Text), "id" .= ("msg" :: Text), "content" .= [part t]]++textDelta :: Int -> Int -> Text -> Value+textDelta n p t = frame "response.output_text.delta" ["output_index" .= n, "item_id" .= ("msg" :: Text), "content_index" .= p, "delta" .= t]++call :: Text -> Text -> Text -> Text -> Value+call ident callId args status = object ["type" .= ("function_call" :: Text), "id" .= ident, "call_id" .= callId, "name" .= ("lookup" :: Text), "arguments" .= args, "status" .= status]++argDelta :: Int -> Text -> Text -> Value+argDelta n ident t = frame "response.function_call_arguments.delta" ["output_index" .= n, "item_id" .= ident, "delta" .= t]++reasoningAdded :: Value+reasoningAdded = object ["type" .= ("reasoning" :: Text), "id" .= ("rs" :: Text), "summary" .= ([] :: [Value])]++reasoning :: Value+reasoning = object ["type" .= ("reasoning" :: Text), "id" .= ("rs" :: Text), "summary" .= ([] :: [Value]), "encrypted_content" .= ("opaque" :: Text), "future_field" .= object ["keep" .= True]]

@@ -0,0 +1,187 @@+{-# LANGUAGE OverloadedRecordDot #-}++module ResponsesEvidenceSpec (tests) where++import Baikai hiding (describeThinking, model)+import Baikai.Models.Generated (openai_gpt_6_astra)+import Baikai.Provider.OpenAI.Internal.Stream (SseDriver)+import Baikai.Provider.OpenAI.Responses.Request (describeThinking)+import Baikai.Provider.OpenAI.Responses.Stream (openaiResponsesStreamWith)+import Baikai.Provider.OpenAI.Sse (sseFromResponse)+import Baikai.Trace (withTraceStreamWith)+import Baikai.Trace.Event qualified as Trace+import Baikai.Trace.Sink (TraceSink (..))+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Control.Exception (bracket, finally)+import Control.Lens ((&), (.~))+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Vector qualified as V+import Network.HTTP.Client.Internal qualified as HTTP+import Network.HTTP.Types.Status (mkStatus)+import Network.HTTP.Types.Version (http11)+import Streamly.Data.Fold qualified as Fold+import Streamly.Data.Stream qualified as Stream+import System.Timeout (timeout)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Responses strict evidence over SSE bytes"+    [ testCase "strict success observes host facts and commits exact request and replay" $ do+        (response, body) <- replay 200 [wire success] strictOptions+        responseError response @?= Nothing+        ev <- proof response+        ev.observedModel @?= Observed "server-version"+        ev.providerRequestId @?= Observed "req-wire"+        ev.responseId @?= Observed "response-wire"+        ev.requestCommitment @?= commitmentDigest body+        ev.strength @?= EvidenceModelObserved+        ev.usage @?= Unobserved+        case V.toList response.message.content of+          [AssistantThinking t, AssistantText (TextContent "hello")] -> fmap (.replayItems) t.replayState @?= Just (V.singleton reasoningItem)+          _ -> assertFailure "lost reasoning continuation",+      testCase "arbitrary byte fragmentation keeps the same response commitment" $ do+        (whole, _) <- replay 200 [wire success] strictOptions+        (split, _) <- replay 200 (map BS.singleton (BS.unpack (wire success))) strictOptions+        a <- proof whole+        b <- proof split+        a.responseCommitment @?= b.responseCommitment+        split.message.content @?= whole.message.content,+      testCase "minimal effort is refused before transport with strict evidence" $ do+        (response, body) <- replay 200 [wire success] (strictOptions & #thinking .~ Just ThinkingMinimal)+        assertBool "strict adjustment refused" (responseError response /= Nothing)+        body @?= Null+        ev <- proof response+        ev.status @?= CallFailed+        ev.observedModel @?= Unobserved,+      testCase "local request validation still produces a strict evidence record" $ do+        (response, body) <- replay 200 [wire success] (strictOptions & #seed .~ Just 7)+        assertBool "unsupported option refused" (responseError response /= Nothing)+        body @?= Null+        ev <- proof response+        ev.status @?= CallFailed,+      testCase "non-2xx failure uses HTTP classification and captured request ID" $ do+        (response, _) <- replay 429 ["{\"error\":{\"message\":\"slow down\"}}"] strictOptions+        fmap (.category) (responseError response) @?= Just RateLimited+        ev <- proof response+        ev.status @?= CallFailed+        ev.providerRequestId @?= Observed "req-wire"+        ev.observedModel @?= Unobserved+        ev.responseCommitment @?= Unobserved,+      testCase "nested in-band error has one failed evidence record" $ do+        let failure = object ["type" .= ("response.failed" :: Text), "response" .= object ["id" .= ("failed-response" :: Text), "error" .= object ["code" .= ("rate_limit_exceeded" :: Text), "message" .= ("busy" :: Text)]]]+        (response, _) <- replay 200 [wire failure] strictOptions+        fmap (.category) (responseError response) @?= Just RateLimited+        ev <- proof response+        ev.responseId @?= Observed "failed-response"+        ev.status @?= CallFailed,+      testCase "malformed SSE JSON retains the streamed prefix and fails" $ do+        (response, _) <- replay 200 [wire added, wire deltaFrame, "data: {broken}\n\n"] strictOptions+        assertBool "decode failure" (responseError response /= Nothing)+        response.message.content @?= V.singleton (AssistantText (TextContent "partial"))+        ev <- proof response+        ev.status @?= CallFailed,+      testCase "EOF retains prefix without manufacturing a successful response" $ do+        (response, _) <- replay 200 [wire added, wire deltaFrame] strictOptions+        assertBool "EOF failure" (responseError response /= Nothing)+        response.message.content @?= V.singleton (AssistantText (TextContent "partial"))+        ev <- proof response+        ev.responseCommitment @?= Unobserved,+      testCase "observations absent from response remain absent under best effort" $ do+        let silent = object ["type" .= ("response.completed" :: Text), "response" .= object ["output" .= ([] :: [Value])]]+        (response, _) <- replay 200 [wire silent] (strictOptions & #evidence .~ Just (evidenceRequest "silent"))+        ev <- proof response+        ev.observedModel @?= Unobserved+        ev.responseId @?= Unobserved+        ev.usage @?= Unobserved,+      testCase "strict trace cancellation records one abort and releases the worker" $ do+        closed <- newEmptyMVar+        forever <- newEmptyMVar+        captured <- newIORef ([] :: [Trace.TraceEvent])+        recorded <- newEmptyMVar+        let blocked _ _ _ _ emit = (emit (Right added) >> emit (Right deltaFrame) >> takeMVar forever) `finally` putMVar closed ()+            save () e = do+              atomicModifyIORef' captured (\xs -> (e : xs, ()))+              case e of Trace.CallEvidence {} -> putMVar recorded (); _ -> pure ()+            sink = TraceSink (Fold.foldlM' save (pure ()))+        reg <- registryFor blocked+        result <- timeout 100000 (Stream.toList (withTraceStreamWith reg sink openai_gpt_6_astra emptyContext strictOptions))+        assertBool "consumer was cancelled" (case result of Nothing -> True; _ -> False)+        timeout 1000000 (takeMVar closed) >>= (@?= Just ())+        timeout 1000000 (takeMVar recorded) >>= (@?= Just ())+        events <- readIORef captured+        case [ev | Trace.CallEvidence {Trace.evidence = ev} <- events] of+          [ev] -> ev.status @?= CallAborted+          _ -> assertFailure "expected one abort evidence record",+      testCase "opting out does not attach evidence" $ do+        (response, _) <- replay 200 [wire success] (strictOptions & #evidence .~ Nothing)+        response.evidence @?= Nothing+    ]++proof :: Response -> IO ModelCallEvidence+proof response = case response.evidence of Just ev -> pure ev; Nothing -> assertFailure "missing evidence" >> fail "missing evidence"++strictOptions :: Options+strictOptions = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "offline-key") & #evidence .~ Just (evidenceRequest "responses-strict" & #strictness .~ EvidenceRequired EvidenceRequestedOnly)++replay :: Int -> [ByteString] -> Options -> IO (Response, Value)+replay status chunks opts = do+  sent <- newIORef Null+  reg <- registryFor (byteDriver sent status chunks)+  response <- completeRequestWith reg openai_gpt_6_astra emptyContext opts+  body <- readIORef sent+  pure (response, body)++registryFor :: SseDriver -> IO ProviderRegistry+registryFor driver =+  newProviderRegistryFrom+    [ apiProvider OpenAIResponses (openaiResponsesStreamWith driver)+        & #describeThinking .~ describeThinking+        & #strengthCeiling .~ declaredStrength OpenAIResponses+    ]++byteDriver :: IORef Value -> Int -> [ByteString] -> SseDriver+byteDriver sent status chunks _ _ body onMetadata emit = do+  writeIORef sent body+  remaining <- newIORef chunks+  let reader = do+        xs <- readIORef remaining+        case xs of [] -> pure ""; x : rest -> writeIORef remaining rest >> pure x+      response =+        HTTP.Response+          { HTTP.responseStatus = mkStatus status "",+            HTTP.responseVersion = http11,+            HTTP.responseHeaders = [("x-request-id", "req-wire")],+            HTTP.responseBody = reader,+            HTTP.responseCookieJar = HTTP.createCookieJar [],+            HTTP.responseClose' = HTTP.ResponseClose (pure ()),+            HTTP.responseOriginalRequest = HTTP.defaultRequest,+            HTTP.responseEarlyHints = []+          }+  bracket (pure response) HTTP.responseClose (\r -> sseFromResponse r onMetadata emit)++wire :: Value -> ByteString+wire v = "event: response.event\ndata: " <> LBS.toStrict (Aeson.encode v) <> "\n\n"++reasoningItem :: Value+reasoningItem = object ["type" .= ("reasoning" :: Text), "id" .= ("rs" :: Text), "summary" .= ([] :: [Value]), "encrypted_content" .= ("opaque" :: Text), "future" .= True]++item :: Text -> Value+item text = object ["type" .= ("message" :: Text), "id" .= ("msg" :: Text), "content" .= [object ["type" .= ("output_text" :: Text), "text" .= text]]]++success :: Value+success = object ["type" .= ("response.completed" :: Text), "response" .= object ["id" .= ("response-wire" :: Text), "model" .= ("server-version" :: Text), "output" .= [reasoningItem, item "hello"]]]++added :: Value+added = object ["type" .= ("response.output_item.added" :: Text), "output_index" .= (0 :: Int), "item" .= item ""]++deltaFrame :: Value+deltaFrame = object ["type" .= ("response.output_text.delta" :: Text), "output_index" .= (0 :: Int), "content_index" .= (0 :: Int), "item_id" .= ("msg" :: Text), "delta" .= ("partial" :: Text)]

@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedRecordDot #-}++module ResponsesSpec (tests) where++import Baikai hiding (model, schema)+import Baikai.Models.Generated (openai_gpt_6_astra)+import Baikai.Provider.OpenAI.Responses.Request qualified as R+import Control.Lens ((&), (.~))+import Control.Monad (forM_)+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KM+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Vector qualified as V+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Responses request mapping"+    [ testCase "stateless request carries text, image, system, cap and metadata" $ do+        let ctx =+              (systemUser "system instruction" "hello")+                & #messages .~ V.singleton (UserMessage UserPayload {content = V.fromList [UserText (TextContent "hello"), UserImage (ImageContent "abc" "image/png")], timestamp = Nothing})+            opts = emptyOptions & #maxTokens .~ Just 321 & #metadata .~ Map.singleton "test" (String "value")+        req <- mapped model ctx opts+        field "model" req.requestBody @?= Just (String "renamed-responses-model")+        field "instructions" req.requestBody @?= Just (String "system instruction")+        field "store" req.requestBody @?= Just (Bool False)+        field "stream" req.requestBody @?= Just (Bool True)+        field "max_output_tokens" req.requestBody @?= Just (Number 321)+        field "include" req.requestBody @?= Just (Aeson.toJSON (["reasoning.encrypted_content"] :: [Text]))+        let rendered = Text.pack (show (field "input" req.requestBody))+        assertBool "image encoded inline" ("data:image/png;base64,YWJj" `Text.isInfixOf` rendered)+        assertBool "text is present" ("hello" `Text.isInfixOf` rendered)+        field "metadata" req.requestBody @?= Just (object ["test" .= ("value" :: Text)]),+      testCase "assistant plain text has a valid easy-message input shape" $ do+        req <- mapped model (contextOf [assistant "previous answer"]) emptyOptions+        inputItems req @?= [object ["role" .= ("assistant" :: Text), "content" .= ("previous answer" :: Text)]],+      testCase "empty summary and encrypted items persist into the next tool request" $ do+        let decoded = Aeson.eitherDecode (Aeson.encode thought)+        persisted <- either assertFailure pure decoded+        let response =+              emptyResponse+                & #message . #content .~ V.fromList [AssistantThinking persisted, AssistantToolCall (ToolCall "call_7" "lookup" (object ["x" .= (1 :: Int)]))]+                & #message . #stopReason .~ ToolUse+            ctx = contextOf [user "go"] & #tools .~ V.singleton tool+        next <- appendToolResult ctx response (\_ -> pure (toolResultText "found"))+        req <- mapped model next emptyOptions+        let items = inputItems req+        take 1 (drop 1 items) @?= [reasoningItem]+        field "call_id" (items !! 2) @?= Just (String "call_7")+        field "type" (items !! 2) @?= Just (String "function_call")+        field "call_id" (items !! 3) @?= Just (String "call_7")+        field "output" (items !! 3) @?= Just (String "found")+        field "previous_response_id" req.requestBody @?= Nothing+        req.translation @?= R.describeThinking model emptyOptions,+      testCase "every accepted effort survives; minimal adjusts with evidence" $ do+        forM_ [ThinkingMinimal, ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax] $ \level -> do+          let opts = emptyOptions & #thinking .~ Just level+              expected = if level == ThinkingMinimal then "low" else renderThinkingLevel level+          req <- mapped model emptyContext opts+          field "reasoning" req.requestBody @?= Just (object ["effort" .= expected])+          req.translation @?= R.describeThinking model opts+          req.translation.adjustments @?= [EffortClamped ThinkingMinimal "low" | level == ThinkingMinimal],+      testCase "sampling restriction is visible even without thinking" $ do+        let opts = emptyOptions & #temperature .~ Just 0.5 & #topP .~ Just 0.8+        req <- mapped model emptyContext opts+        field "temperature" req.requestBody @?= Nothing+        field "top_p" req.requestBody @?= Nothing+        req.translation.adjustments @?= [SamplingDroppedUnsupportedModel ["temperature", "top_p"]]+        supported <- mapped (model & #compat .~ CompatOpenAIResponses defaultOpenAIResponsesCompat) emptyContext opts+        field "temperature" supported.requestBody @?= Just (Number 0.5),+      testCase "function tools keep permissive schemas and supported choices" $ do+        let ctx = emptyContext & #tools .~ V.singleton tool+        forM_ [ToolChoiceAuto, ToolChoiceNone, ToolChoiceRequired, ToolChoiceSpecific "lookup"] $ \choice -> do+          req <- mapped model ctx (emptyOptions & #toolChoice .~ Just choice)+          field "tool_choice" req.requestBody @?= case choice of+            ToolChoiceAuto -> Nothing+            ToolChoiceNone -> Just (String "none")+            ToolChoiceRequired -> Just (String "required")+            ToolChoiceSpecific name -> Just (object ["type" .= ("function" :: Text), "name" .= name])+          case field "tools" req.requestBody of+            Just (Array tools) -> do+              field "type" (V.head tools) @?= Just (String "function")+              field "strict" (V.head tools) @?= Just (Bool False)+              field "parameters" (V.head tools) @?= Just schema+            _ -> assertFailure "missing tools"+        rejected emptyContext (emptyOptions & #toolChoice .~ Just ToolChoiceRequired)+        rejected ctx (emptyOptions & #toolChoice .~ Just (ToolChoiceSpecific "missing")),+      testCase "JSON schema and JSON object use Responses text.format" $ do+        strict <- mapped model emptyContext (emptyOptions & #responseFormat .~ Just (JsonSchema (jsonSchemaFormat "answer" schema & #strict .~ True)))+        field "text" strict.requestBody @?= Just (object ["format" .= object ["type" .= ("json_schema" :: Text), "name" .= ("answer" :: Text), "schema" .= schema, "strict" .= True]])+        plain <- mapped model emptyContext (emptyOptions & #responseFormat .~ Just JsonObject)+        field "text" plain.requestBody @?= Just (object ["format" .= object ["type" .= ("json_object" :: Text)]]),+      testCase "cache requests follow endpoint TTL contract" $ do+        req <- mapped model emptyContext (emptyOptions & #cacheRetention .~ Just CacheRetentionShort)+        field "prompt_cache_options" req.requestBody @?= Just (object ["ttl" .= ("30m" :: Text)])+        rejected emptyContext (emptyOptions & #cacheRetention .~ Just CacheRetentionLong),+      testCase "unsupported options fail instead of disappearing" $+        forM_ [emptyOptions & #seed .~ Just 1, emptyOptions & #stopSequences .~ ["stop"], emptyOptions & #frequencyPenalty .~ Just 1, emptyOptions & #presencePenalty .~ Just 1, emptyOptions & #metadata .~ Map.singleton "bad" (Number 1)] (rejected emptyContext),+      testCase "foreign, malformed and duplicate replay fails without exposing payload" $ do+        forM_ [replay & #replayApi .~ AnthropicMessages, replay & #replayModel .~ "other", replay & #replayItems .~ V.empty, replay & #replayItems .~ V.singleton (object []), replay & #replayItems .~ V.fromList [reasoningItem, reasoningItem]] $ \bad -> do+          let ctx = addResponse (emptyResponse & #message . #content .~ V.singleton (AssistantThinking (thought & #replayState .~ Just bad))) emptyContext+          case R.mapRequest model ctx emptyOptions of+            Left err -> assertBool "error contains no opaque data" (not ("SECRET" `Text.isInfixOf` err))+            Right _ -> assertFailure "invalid replay accepted",+      testCase "Anthropic state and incomplete calls cannot be replayed" $ do+        forM_ [AssistantThinking (emptyThinkingContent & #signature .~ Just "sig"), AssistantThinking emptyThinkingContent, AssistantToolCall (ToolCall "call_1" "lookup" (String "{"))] $ \block ->+          rejected (addResponse (emptyResponse & #message . #content .~ V.singleton block) emptyContext) emptyOptions+    ]+  where+    rejected ctx opts = case R.mapRequest model ctx opts of+      Left _ -> pure ()+      Right _ -> assertFailure "expected local rejection"++model :: Model+model =+  openai_gpt_6_astra+    & #api .~ OpenAIResponses+    & #modelId .~ "renamed-responses-model"+    & #compat+      .~ CompatOpenAIResponses+        ( defaultOpenAIResponsesCompat+            & #supportedReasoningEfforts .~ Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax]+            & #supportsSamplingParameters .~ False+            & #supportsPromptCacheOptions .~ True+        )++schema :: Value+schema = object ["type" .= ("object" :: Text), "properties" .= object ["x" .= object ["type" .= ("integer" :: Text)]]]++tool :: Tool+tool = mkTool "lookup" "Look up x" schema++reasoningItem :: Value+reasoningItem = object ["type" .= ("reasoning" :: Text), "id" .= ("rs_7" :: Text), "summary" .= ([] :: [Value]), "encrypted_content" .= ("SECRET" :: Text), "status" .= ("completed" :: Text)]++replay :: ThinkingReplay+replay = ThinkingReplay OpenAIResponses "renamed-responses-model" (V.singleton reasoningItem)++thought :: ThinkingContent+thought = emptyThinkingContent & #replayState .~ Just replay++mapped :: Model -> Context -> Options -> IO R.PreparedRequest+mapped m ctx opts = either (assertFailure . Text.unpack) pure (R.mapRequest m ctx opts)++field :: Aeson.Key -> Value -> Maybe Value+field k (Object o) = KM.lookup k o+field _ _ = Nothing++inputItems :: R.PreparedRequest -> [Value]+inputItems req = case field "input" req.requestBody of+  Just (Array xs) -> V.toList xs+  _ -> []

@@ -0,0 +1,193 @@+{-# LANGUAGE OverloadedRecordDot #-}++module ResponsesStreamSpec (tests) where++import Baikai hiding (delta, model)+import Baikai.Models.Generated (openai_gpt_6_astra)+import Baikai.Provider.OpenAI.Internal.Stream (SseDriver)+import Baikai.Provider.OpenAI.Responses.Stream (openaiResponsesStreamWith)+import Baikai.Provider.OpenAI.Sse (ResponseMetadata (..))+import Contract (assertErrorContract)+import Control.Concurrent (threadDelay)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Control.Exception (finally)+import Control.Lens ((&), (.~), (^.))+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson.KeyMap qualified as KM+import Data.IORef (newIORef, readIORef, writeIORef)+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Vector qualified as V+import Streamly.Data.Stream qualified as Stream+import System.Timeout (timeout)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Responses stream"+    [ testCase "terminal usage merges earlier categories and evidence matches its cost" $ do+        let finished = object ["type" .= ("response.completed" :: Text), "response" .= object ["id" .= ("resp_usage" :: Text), "service_tier" .= ("default" :: Text), "output" .= [item "hello"], "usage" .= object ["output_tokens" .= (100 :: Int), "input_tokens_details" .= object ["cache_write_tokens" .= (3000 :: Int)]]]]+        events <- Stream.toList (openaiResponsesStreamWith (driver [usageStarted, finished, finished]) model emptyContext (options & #evidence .~ Just (evidenceRequest "billing")))+        case last events of+          EventDone p -> case p.message of+            AssistantMessage msg -> do+              let u = msg.usage+              (u.inputTokens, u.cacheReadTokens, u.cacheWriteTokens, u.totalTokens) @?= (0, 12000, 3000, 15100)+              u.cost.usd @?= 109 / 2000+              u.cost.basis.estimateReasons @?= Set.empty+              case p.evidence of+                Just ev -> ev.usage @?= Observed u+                Nothing -> assertFailure "missing evidence"+            _ -> assertFailure "expected assistant"+          _ -> assertFailure "expected completion",+      testCase "partial usage survives a failed stream with missing categories explicit" $ do+        events <- run [usageStarted, added, delta]+        assertErrorContract events+        case last events of+          EventError p -> case p.message of+            AssistantMessage msg -> do+              msg.usage.cacheReadTokens @?= 12000+              msg.usage.inputTokens @?= 3000+              msg.usage.cost.basis.estimateReasons @?= Set.fromList [OutputUsageNotReported, CacheWriteUsageNotReported, ServiceTierNotReported]+            _ -> assertFailure "expected assistant"+          _ -> assertFailure "expected failure",+      testCase "complete folds the same stream, including final-only content" $ do+        response <- streamingComplete (openaiResponsesStreamWith (driver [completed])) model emptyContext options+        response.message.content @?= V.singleton (AssistantText (TextContent "hello"))+        response.message.stopReason @?= Stop+        response.responseId @?= Just "resp_actual",+      testCase "EOF after a text delta closes partial content and fails" $ do+        events <- run [added, delta]+        assertErrorContract events+        case last events of+          EventError p -> case p.message of+            AssistantMessage msg -> msg.content @?= V.singleton (AssistantText (TextContent "hel"))+            _ -> assertFailure "wrong message role"+          _ -> assertFailure "expected error",+      testCase "in-band rate limit preserves classification" $ do+        events <- run [object ["type" .= ("error" :: Text), "code" .= ("rate_limit_exceeded" :: Text), "message" .= ("slow down" :: Text)]]+        assertErrorContract events+        case last events of+          EventError p -> fmap (^. #category) p.errorInfo @?= Just RateLimited+          _ -> assertFailure "expected error",+      testCase "failed response preserves its nested error" $ do+        events <- run [object ["type" .= ("response.failed" :: Text), "response" .= object ["id" .= ("failed_id" :: Text), "error" .= object ["code" .= ("rate_limit_exceeded" :: Text), "message" .= ("busy" :: Text)]]]]+        assertErrorContract events+        case last events of+          EventError p -> do+            p.responseId @?= Just "failed_id"+            fmap (^. #category) p.errorInfo @?= Just RateLimited+          _ -> assertFailure "expected error",+      testCase "malformed event becomes a terminal error with partial text" $ do+        events <- run [added, delta, object []]+        assertErrorContract events,+      testCase "completed terminal cancels a driver waiting for more bytes" $ do+        closed <- newEmptyMVar+        let waiting _ _ _ _ emit = (emit (Right completed) >> threadDelay 10000000) `finally` putMVar closed ()+        result <- timeout 2000000 (Stream.toList (openaiResponsesStreamWith waiting model emptyContext options))+        assertBool "stream completed promptly" (maybe False (not . null) result)+        timeout 1000000 (takeMVar closed) >>= (@?= Just ()),+      testCase "consumer timeout releases a driver blocked mid-response" $ do+        closed <- newEmptyMVar+        let waiting _ _ _ _ emit = (emit (Right added) >> emit (Right delta) >> threadDelay 10000000) `finally` putMVar closed ()+        result <- timeout 100000 (Stream.toList (openaiResponsesStreamWith waiting model emptyContext options))+        assertBool "consumer was cancelled" (case result of Nothing -> True; _ -> False)+        timeout 1000000 (takeMVar closed) >>= (@?= Just ()),+      testCase "slow active consumer can drain the complete response" $ do+        result <- timeout 2000000 $ Stream.toList $ Stream.mapM (\e -> threadDelay 20000 >> pure e) (openaiResponsesStreamWith (driver [added, delta, completed]) model emptyContext options)+        case result of+          Just events -> length [() | EventDone _ <- events] @?= 1+          Nothing -> assertFailure "slow consumer did not finish",+      testCase "validation fails before the driver starts" $ do+        called <- newIORef False+        let forbidden _ _ _ _ _ = writeIORef called True+        events <- Stream.toList (openaiResponsesStreamWith forbidden model emptyContext (options & #seed .~ Just 1))+        assertErrorContract events+        readIORef called >>= (@?= False),+      testCase "public two-turn tool loop preserves encrypted reasoning and call identity" $ do+        requests <- newIORef ([] :: [Value])+        let reasoning = object ["type" .= ("reasoning" :: Text), "id" .= ("rs_1" :: Text), "summary" .= ([] :: [Value]), "encrypted_content" .= ("encrypted" :: Text), "unknown" .= True]+            call = object ["type" .= ("function_call" :: Text), "id" .= ("item_1" :: Text), "call_id" .= ("call_1" :: Text), "name" .= ("lookup" :: Text), "arguments" .= ("{}" :: Text), "status" .= ("completed" :: Text)]+            first = object ["type" .= ("response.completed" :: Text), "response" .= object ["output" .= [reasoning, call]]]+            scripted _ _ body _ emit = do+              previous <- readIORef requests+              writeIORef requests (previous <> [body])+              emit (Right (if null previous then first else completed))+            provider = apiProvider OpenAIResponses (openaiResponsesStreamWith scripted)+            ctx = systemUser "system" "find it" & #tools .~ V.singleton (mkTool "lookup" "lookup" (object ["type" .= ("object" :: Text)]))+        reg <- newProviderRegistryFrom [provider]+        executed <- newIORef ([] :: [Text])+        (_, result) <- runToolLoopWith reg 3 (\tc -> writeIORef executed [tc.id_] >> pure (toolResultText "found")) model ctx options+        result.message.content @?= V.singleton (AssistantText (TextContent "hello"))+        readIORef executed >>= (@?= ["call_1"])+        bodies <- readIORef requests+        length bodies @?= 2+        case bodies of+          [_, Object second] -> case KM.lookup "input" second of+            Just (Array items) -> do+              items V.! 1 @?= reasoning+              case items V.! 3 of+                Object reply -> do+                  KM.lookup "call_id" reply @?= Just (String "call_1")+                  KM.lookup "output" reply @?= Just (String "found")+                _ -> assertFailure "missing function output"+            _ -> assertFailure "missing input"+          _ -> assertFailure "expected two requests",+      testCase "evidence commits to the exact outgoing request and observed header" $ do+        sent <- newIORef Null+        let capturing _ _ body meta emit = do+              writeIORef sent body+              meta (ResponseMetadata 200 [("x-request-id", "req_observed")])+              emit (Right completed)+        events <- Stream.toList (openaiResponsesStreamWith capturing model emptyContext (options & #evidence .~ Just (evidenceRequest "wire-test")))+        body <- readIORef sent+        case last events of+          EventDone p -> case p.evidence of+            Just ev -> do+              ev.requestCommitment @?= commitmentDigest body+              (ev ^. #endpoint ^. #endpoint) @?= Just "https://api.openai.com/v1/responses"+              ev.providerRequestId @?= Observed "req_observed"+              ev.strength @?= declaredStrength OpenAIResponses+            Nothing -> assertFailure "missing evidence"+          _ -> assertFailure "missing success",+      testCase "evidence uses observed model and exact response content" $ do+        events <- Stream.toList (openaiResponsesStreamWith (driver [completed]) model emptyContext (options & #evidence .~ Just (evidenceRequest "responses-test")))+        case last events of+          EventDone p -> case p.evidence of+            Just ev -> do+              ev.observedModel @?= Observed "server-model"+              ev.responseId @?= Observed "resp_actual"+              ev.usage @?= Unobserved+              assertBool "response commitment exists" (case ev.responseCommitment of Observed _ -> True; _ -> False)+            Nothing -> assertFailure "missing evidence"+          _ -> assertFailure "missing success"+    ]++run :: [Value] -> IO [AssistantMessageEvent]+run frames = Stream.toList (openaiResponsesStreamWith (driver frames) model emptyContext options)++driver :: [Value] -> SseDriver+driver frames _ _ _ _ emit = mapM_ (emit . Right) frames++model :: Model+model = openai_gpt_6_astra & #modelId .~ "configured-model"++options :: Options+options = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "offline-test-key")++item :: Text -> Value+item t = object ["type" .= ("message" :: Text), "id" .= ("msg" :: Text), "content" .= [object ["type" .= ("output_text" :: Text), "text" .= t]]]++added :: Value+added = object ["type" .= ("response.output_item.added" :: Text), "output_index" .= (0 :: Int), "item" .= item ""]++delta :: Value+delta = object ["type" .= ("response.output_text.delta" :: Text), "output_index" .= (0 :: Int), "content_index" .= (0 :: Int), "item_id" .= ("msg" :: Text), "delta" .= ("hel" :: Text)]++completed :: Value+completed = object ["type" .= ("response.completed" :: Text), "response" .= object ["id" .= ("resp_actual" :: Text), "model" .= ("server-model" :: Text), "output" .= [item "hello"]]]++usageStarted :: Value+usageStarted = object ["type" .= ("response.created" :: Text), "response" .= object ["id" .= ("resp_usage" :: Text), "usage" .= object ["input_tokens" .= (15000 :: Int), "input_tokens_details" .= object ["cached_tokens" .= (12000 :: Int)]]]]

@@ -0,0 +1,30 @@+module ResponsesTransportSpec (tests) where++import Baikai.Provider.OpenAI.Sse (buildResponsesRequest)+import Baikai.Provider.OpenAI.Transport (getClientEnvCached)+import Data.Aeson qualified as Aeson+import Network.HTTP.Client qualified as HTTP+import Servant.Client qualified as Client+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Responses HTTP request"+    [ testCase "POST path normalizes one version segment and never redirects" $ do+        mapM_+          ( \url -> do+              env <- getClientEnvCached url+              let body = Aeson.object ["store" Aeson..= False]+                  req = buildResponsesRequest (Client.baseUrl env) [("Authorization", "Bearer fixture")] body+              HTTP.path req @?= "/v1/responses"+              HTTP.method req @?= "POST"+              case HTTP.requestBody req of+                HTTP.RequestBodyLBS encoded -> encoded @?= Aeson.encode body+                _ -> assertFailure "expected the prepared JSON body"+              HTTP.redirectCount req @?= 0+              HTTP.requestHeaders req @?= [("Authorization", "Bearer fixture")]+          )+          ["https://api.openai.com", "https://api.openai.com/v1", "https://api.openai.com/v1/"]+    ]

@@ -23,6 +23,7 @@ import Data.Text qualified as Text import Data.Time.Clock (UTCTime) import Data.Vector qualified as Vector+import EndpointModels (chatRestrictedModel) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) @@ -30,7 +31,8 @@ tests =   testGroup     "ShapeSpec"-    [ deepseekShapeTest,+    [ endpointPolicyTests,+      deepseekShapeTest,       nativeHigherEffortTests,       compatibleHigherEffortClampTest,       translationTableTests,@@ -248,6 +250,7 @@           effortText = Nothing,           budgetTokens = Nothing,           wireField = Nothing,+          displayText = Nothing,           adjustments = [ThinkingDroppedUnsupportedHost lvl]         },       [],@@ -263,6 +266,7 @@             effortText = Nothing,             budgetTokens = Nothing,             wireField = Just "enable_thinking",+            displayText = Nothing,             adjustments = [EffortCollapsedToToggle lvl]           },         [("enable_thinking", Bool True)],@@ -278,6 +282,7 @@       effortText = Just wire,       budgetTokens = Nothing,       wireField = Just field,+      displayText = Nothing,       adjustments = adjs     } @@ -489,6 +494,7 @@       toolDeltas = [],       usage = Nothing,       model = Nothing,+      serviceTier = Nothing,       responseId = Nothing     } @@ -507,3 +513,16 @@  testTime :: UTCTime testTime = read "2026-07-03 12:00:00 UTC"++endpointPolicyTests :: TestTree+endpointPolicyTests =+  testGroup+    "endpoint policy"+    [ testCase ("accepted effort " <> show level) $ do+        (body, translation) <- shapedCall fake (emptyOptions & #thinking .~ Just level) emptyContext+        lookupTop "reasoning_effort" body @?= Just (String (renderThinkingLevel level))+        translation ^. #adjustments @?= []+    | level <- [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax]+    ]+  where+    fake = chatRestrictedModel & #modelId .~ "arbitrary-generation"

@@ -239,6 +239,7 @@       toolDeltas = [],       usage = Nothing,       model = Nothing,+      serviceTier = Nothing,       responseId = Nothing     } 

@@ -2,16 +2,22 @@  import Baikai import Baikai.Provider.OpenAI.Api (openaiChatStream)+import Baikai.Provider.OpenAI.Internal.Stream (openaiChatStreamWith)+import Baikai.Provider.OpenAI.Shape (describeThinkingShape) import Baikai.Provider.OpenAI.Transport qualified as Transport+import Contract (assertErrorContract) import Control.Concurrent (threadDelay) import Control.Exception (bracket, try) import Control.Lens ((&), (.~), (^.)) import Control.Monad (forM_)+import Data.Aeson qualified as Aeson import Data.CaseInsensitive qualified as CI-import Data.IORef (newIORef, readIORef, writeIORef)+import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef) import Data.Map.Strict qualified as Map import Data.Text qualified as Text import Data.Text.Encoding qualified as Text+import Data.Vector qualified as Vector+import EndpointModels (chatRestrictedModel) import Network.HTTP.Types.Header (RequestHeaders) import Servant.Client qualified as Client import Streamly.Data.Stream qualified as Stream@@ -23,7 +29,8 @@ tests =   testGroup     "Baikai.Provider.OpenAI.Transport"-    [ clientEnvCacheTest,+    [ endpointRejectionTest,+      clientEnvCacheTest,       requestHeadersTest,       timeoutTest,       nonPositiveTimeoutTest,@@ -168,3 +175,45 @@     (lookupEnv name <* unsetEnv name)     (maybe (unsetEnv name) (setEnv name))     . const++endpointRejectionTest :: TestTree+endpointRejectionTest = testCase "endpoint capability rejection precedes network on complete and stream" $ do+  calls <- newIORef (0 :: Int)+  let driver _ _ _ _ _ = modifyIORef' calls (+ 1)+      stream = openaiChatStreamWith driver+      model = chatRestrictedModel & #modelId .~ "renamed-text-only"+      tool = mkTool "lookup" "lookup" (Aeson.object [])+      provider =+        apiProviderWith OpenAIChatCompletions stream (streamingComplete stream)+          & #describeThinking .~ (\m opts -> describeThinkingShape (openaiCompletionsCompatFor m) (m ^. #reasoning) opts)+      options = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "unused")+  reg <- newProviderRegistry+  registerApiProviderWith reg provider+  forM_+    [ (emptyContext & #tools .~ Vector.singleton tool, options),+      (emptyContext, options & #toolChoice .~ Just ToolChoiceRequired),+      (emptyContext, options & #toolChoice .~ Just (ToolChoiceSpecific "lookup"))+    ]+    $ \(ctx, opts) -> do+      events <- Stream.toList (streamRequestWith reg model ctx opts)+      assertErrorContract events+      case last events of+        EventError payload -> case payload ^. #errorInfo of+          Just err -> do+            err ^. #category @?= InvalidRequest+            assertBool "actionable Responses explanation" ("Responses" `Text.isInfixOf` (err ^. #message))+          _ -> assertFailure "missing error"+        _ -> assertFailure "expected error terminal"+      response <- completeRequestWith reg model ctx opts+      response ^. (#message . #stopReason) @?= ErrorReason+  let strict =+        options+          & #thinking .~ Just ThinkingMinimal+          & #evidence .~ Just (evidenceRequest "strict-endpoint" & #strictness .~ EvidenceRequired EvidenceRequestedOnly)+  strictEvents <- Stream.toList (streamRequestWith reg model emptyContext strict)+  assertErrorContract strictEvents+  strictResponse <- completeRequestWith reg model emptyContext strict+  case responseError strictResponse of+    Just err -> err ^. #category @?= InvalidRequest+    _ -> assertFailure "strict complete must refuse adjusted reasoning"+  readIORef calls >>= (@?= 0)