packages feed

baikai-openai 0.7.2.0 → 0.7.3.0

raw patch · 16 files changed

+644/−89 lines, 16 filesdep ~baikaiPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: baikai

API changes (from Hackage documentation)

+ Baikai.Provider.OpenAI.Internal.Cache: CachePlan :: ![(Key, Value)] -> !Bool -> !Maybe CacheRetention -> CachePlan
+ Baikai.Provider.OpenAI.Internal.Cache: [cacheFields] :: CachePlan -> ![(Key, Value)]
+ Baikai.Provider.OpenAI.Internal.Cache: [effectiveRetention] :: CachePlan -> !Maybe CacheRetention
+ Baikai.Provider.OpenAI.Internal.Cache: [markPrefix] :: CachePlan -> !Bool
+ Baikai.Provider.OpenAI.Internal.Cache: cacheCost :: Maybe CacheRetention -> Model -> Usage -> Cost
+ Baikai.Provider.OpenAI.Internal.Cache: chatCachePlan :: Model -> Options -> Either Text CachePlan
+ Baikai.Provider.OpenAI.Internal.Cache: data CachePlan
+ Baikai.Provider.OpenAI.Internal.Cache: instance GHC.Classes.Eq Baikai.Provider.OpenAI.Internal.Cache.CachePlan
+ Baikai.Provider.OpenAI.Internal.Cache: instance GHC.Internal.Show.Show Baikai.Provider.OpenAI.Internal.Cache.CachePlan
+ Baikai.Provider.OpenAI.Internal.Cache: responsesCachePlan :: Model -> Options -> Either Text CachePlan
+ Baikai.Provider.OpenAI.Internal.Stream: [effectiveRetention] :: Assembler -> !Maybe CacheRetention
+ Baikai.Provider.OpenAI.Internal.Usage: checkCacheDuration :: UsageEndpoint -> Maybe CacheRetention -> Maybe Value -> Usage -> Usage
+ Baikai.Provider.OpenAI.Responses.Request: [effectiveRetention] :: PreparedRequest -> !Maybe CacheRetention
+ Baikai.Provider.OpenAI.Shape: applyNativeCache :: CachePlan -> Value -> Value
- Baikai.Provider.OpenAI.Internal.Stream: Assembler :: !Model -> !UTCTime -> !Maybe Int -> !Text -> !Bool -> !Maybe Int -> !Text -> !TagScanState -> !IntMap Int -> !Map Text Int -> !Maybe Int -> !IntMap (Text, Text) -> !IntMap Text -> !IntMap AssistantContent -> !Int -> !Usage -> !StopReason -> !Bool -> !Maybe BaikaiError -> !Maybe Text -> !Observed Text -> !Observed Text -> !Maybe Text -> !Maybe Int -> !Set Text -> !Maybe Value -> !Bool -> Assembler
+ Baikai.Provider.OpenAI.Internal.Stream: Assembler :: !Model -> !UTCTime -> !Maybe Int -> !Text -> !Bool -> !Maybe Int -> !Text -> !TagScanState -> !IntMap Int -> !Map Text Int -> !Maybe Int -> !IntMap (Text, Text) -> !IntMap Text -> !IntMap AssistantContent -> !Int -> !Maybe CacheRetention -> !Usage -> !StopReason -> !Bool -> !Maybe BaikaiError -> !Maybe Text -> !Observed Text -> !Observed Text -> !Maybe Text -> !Maybe Int -> !Set Text -> !Maybe Value -> !Bool -> Assembler
- Baikai.Provider.OpenAI.Responses.Request: PreparedRequest :: !Value -> !ThinkingTranslation -> PreparedRequest
+ Baikai.Provider.OpenAI.Responses.Request: PreparedRequest :: !Value -> !ThinkingTranslation -> !Maybe CacheRetention -> PreparedRequest

Files

CHANGELOG.md view
@@ -7,6 +7,113 @@  ## [Unreleased] +## [baikai 0.10.0.0] - 2026-10-25++### Added++- `ThinkingNone` (`none`) explicitly requests reasoning off; `Nothing` still+  leaves provider defaults untouched. Anthropic compatibility records declare+  `supportsThinkingDisabled`; legacy records conservatively default to False.+- Endpoint-specific `NativeCachePolicy` records distinguish modern, legacy and+  unsupported native OpenAI cache controls. Policies survive legacy JSON and+  catalog refresh; Luna Responses Long has verified 12h base and tier rates.+- Evidence schema 2.8 includes the `none` preference and content-free native+  cache controls and input structure. Digest rules and the separation of+  requested, translated and observed reasoning are unchanged.++### Changed (breaking)++- `ThinkingLevel` gains `ThinkingNone` as its least constructor. Update exhaustive+  matches. Anthropic and OpenAI compatibility records gain fields; use the+  default records or update explicit record construction.+- All seven dependent packages now require `baikai ^>=0.10.0` and release+  independently below. The unchanged adapters take dependency-only patch bumps.++## [baikai-claude 0.7.3.0] - 2026-10-25++### Added++- Export `injectSystemCacheControl` for shared system-prefix cache markers.+- `ThinkingNone` sends catalog-gated `thinking: {"type": "disabled"}` without+  effort, display or a budget. Unsupported off requests remain visible+  adjustments and fail strict evidence before dispatch. A host with no thinking+  controls is not assumed to be a non-reasoning model.++### Fixed++- Short and long `cacheRetention` mark non-empty system prompts so fresh+  conversations with different first questions can reuse the tools-and-system+  prefix. System, last-tool and automatic markers share the effective TTL,+  including host downgrades, and use at most three breakpoints. Empty or absent+  system prompts and disabled caching keep their existing shape. Regression+  coverage includes tool compatibility and an isolated live shared-prefix case.+  Implements issue #2 and the approach in PR #3.++### Changed++- Require `baikai ^>=0.10.0`.++## [baikai-openai 0.7.3.0] - 2026-10-25++### Added++- Export `applyNativeCache` for validated native cache plans.+- OpenAI-compatible Chat (including Ollama) and Responses carry `none` where+  supported. Z.ai and Qwen emit `enable_thinking: false`; unsupported off+  requests remain visible adjustments and fail strict evidence before dispatch.++### Fixed++- Native OpenAI Short caching marks shared non-empty system prefixes on+  catalog-supported Responses and Chat bindings. Unsupported native requests+  fail locally. Effective duration reaches terminal pricing, partial usage+  and evidence.+- Funded live prefix checks pass for Luna Responses Short/Long and GPT-5.6 Chat+  Short. Luna Long uses verified 12h base and tier rates; unsupported Chat Long+  and unverified modern bindings remain locally refused.++### Changed++- Require `baikai ^>=0.10.0`. Catalog effort policies distinguish GPT-5/o-series+  models that cannot disable reasoning, Sol/Luna that accept none, and+  Astra/GPT-6.1 Sol that do not.++## [baikai-typesafe 0.1.0.1] - 2026-10-25++### Changed++- Require `baikai ^>=0.10.0`. Dependency-only update; no package API change.++## [baikai-trace-otel 0.4.1.1] - 2026-10-25++### Changed++- Require `baikai ^>=0.10.0`. Dependency-only update; no package API change.++## [baikai-effectful 0.4.0.5] - 2026-10-25++### Changed++- Require `baikai ^>=0.10.0`. Dependency-only update; no package API change.++## [baikai-kit 0.4.0.3] - 2026-10-25++### Changed++- Require `baikai ^>=0.10.0`. Dependency-only update; no package API change.++## [baikai-agent 0.2.0.4] - 2026-10-25++### Fixed++- Layered job configuration accepts `thinking "none"` through the shared+  canonical parser, keeping explicit off distinct from an absent preference.++### Changed++- Require `baikai ^>=0.10.0`, `baikai-claude ^>=0.7.3` and+  `baikai-openai ^>=0.7.3` for explicit-off handling in both vendor renderers.+ ## [baikai 0.9.0.0] - 2026-10-25  ### Added
baikai-openai.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: baikai-openai-version: 0.7.2.0+version: 0.7.3.0 synopsis: OpenAI providers for the baikai abstraction description:   OpenAI-compatible backends for baikai: Chat Completions over SSE against OpenAI and@@ -61,6 +61,7 @@     Baikai.Provider.OpenAI.Api     Baikai.Provider.OpenAI.Cli     Baikai.Provider.OpenAI.Interactive+    Baikai.Provider.OpenAI.Internal.Cache     Baikai.Provider.OpenAI.Internal.ErrorClass     Baikai.Provider.OpenAI.Internal.Request     Baikai.Provider.OpenAI.Internal.Stream@@ -77,7 +78,7 @@   autogen-modules: Paths_baikai_openai   build-depends:     aeson ^>=2.2,-    baikai ^>=0.9.0,+    baikai ^>=0.10.0,     base >=4.20 && <5,     base64-bytestring ^>=1.2,     bytestring ^>=0.12,@@ -117,6 +118,7 @@     EvidenceSpec     LifecycleSpec     MidStreamSpec+    NativeCacheSpec     PublicSurfaceSpec     ReasoningSpec     ResponsesAssemblerSpec@@ -131,7 +133,7 @@    build-depends:     aeson,-    baikai ^>=0.9.0,+    baikai ^>=0.10.0,     baikai-openai,     base >=4.20 && <5,     bytestring,
src/Baikai/Provider/OpenAI/Agent.hs view
@@ -121,7 +121,7 @@ -- The adjustment list is derived by comparing what 'effortArgs' actually -- sends — through the same 'codexEffortValue' — with the canonical level -- name, rather than being hardcoded empty. It is empty at every level,--- because codex is the one tool baikai drives that accepts all six+-- because codex is the one tool baikai drives that accepts all seven -- verbatim; writing @[]@ by hand would keep claiming that after someone -- changed the mapping. --@@ -195,7 +195,7 @@   Just mid -> ["--model", Text.unpack mid]  -- | Codex receives reasoning effort through a config override and--- accepts all six canonical Baikai levels, so there is no clamp here —+-- accepts all seven canonical Baikai levels, so there is no clamp here — -- unlike Claude, whose @--effort@ has no @minimal@ value. The -- provider-only @none@ and @ultra@ values remain available through raw -- provider arguments.@@ -206,7 +206,7 @@     ["-c", "model_reasoning_effort=" <> Text.unpack (codexEffortValue lvl)]  -- | The word codex's @model_reasoning_effort@ override receives. Codex--- accepts all six baikai levels verbatim, which makes this the identity.+-- accepts all seven baikai levels verbatim, which makes this the identity. codexEffortValue :: ThinkingLevel -> Text codexEffortValue = renderThinkingLevel 
src/Baikai/Provider/OpenAI/Cli.hs view
@@ -188,7 +188,7 @@   )  -- | Render Codex's reasoning-effort config override from--- 'Options.thinking'. Codex accepts all six Baikai levels verbatim;+-- 'Options.thinking'. Codex accepts all seven Baikai levels verbatim; -- when 'thinking' is unset, no override is emitted. effortArgs :: Options -> [String] effortArgs opts = case opts ^. #thinking of@@ -196,7 +196,7 @@   Just lvl -> ["-c", "model_reasoning_effort=" <> Text.unpack (codexEffortValue lvl)]  -- | The word codex's @model_reasoning_effort@ override receives. Codex--- accepts all six baikai levels verbatim, which makes this the identity+-- accepts all seven baikai levels verbatim, which makes this the identity -- — and makes it the one transport in baikai that expresses every level -- exactly. codexEffortValue :: ThinkingLevel -> Text
+ src/Baikai/Provider/OpenAI/Internal/Cache.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE OverloadedRecordDot #-}++-- | Internal native cache planning and terminal pricing. One prepared policy+-- supplies the wire controls, prefix placement and effective billing duration.+module Baikai.Provider.OpenAI.Internal.Cache+  ( CachePlan (..),+    responsesCachePlan,+    chatCachePlan,+    cacheCost,+  )+where++import Baikai.CacheRetention (CacheRetention (..))+import Baikai.Compat+import Baikai.Cost qualified as C+import Baikai.Cost.Pricing qualified as Pricing+import Baikai.Model qualified as M+import Baikai.Options (Options (..))+import Baikai.Usage qualified as U+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson.Key (Key)+import Data.Text (Text)++data CachePlan = CachePlan+  { cacheFields :: ![(Key, Value)],+    markPrefix :: !Bool,+    effectiveRetention :: !(Maybe CacheRetention)+  }+  deriving stock (Eq, Show)++responsesCachePlan :: M.Model -> Options -> Either Text CachePlan+responsesCachePlan m opts = do+  let c = M.openaiResponsesCompatFor m+      -- Absent metadata preserves the prior Responses mappings, but never+      -- invents explicit breakpoint support.+      policy = case c.nativeCachePolicy of+        Just p -> p+        Nothing+          | c.supportsPromptCacheOptions -> NativeCacheModern False False+          | otherwise -> NativeCacheLegacy True c.supportsLongCacheRetention+  plan m Nothing (Just policy) opts++chatCachePlan :: M.Model -> Options -> Either Text CachePlan+chatCachePlan m opts =+  let c = M.openaiCompletionsCompatFor m+   in do+        native <- plan m c.cacheControlFormat c.nativeCachePolicy opts+        -- The existing compatible-host downgrade is an independent wire contract.+        pure $ case (c.cacheControlFormat, opts.cacheRetention) of+          (Just CacheControlFormatAnthropic, Just CacheRetentionShort) -> native {effectiveRetention = Just CacheRetentionShort}+          (Just CacheControlFormatAnthropic, Just CacheRetentionLong) -> native {effectiveRetention = Just (if c.supportsLongCacheRetention then CacheRetentionLong else CacheRetentionShort)}+          _ -> native++plan :: M.Model -> Maybe CacheControlFormat -> Maybe NativeCachePolicy -> Options -> Either Text CachePlan+plan m format policy opts = named $ do+  validateNativeCachePolicy format policy+  case M.pricingPolicy m of+    Just p -> M.validatePricingPolicy p+    Nothing -> Right ()+  case policy of+    Just (NativeCacheModern True _) -> requireLongRates+    _ -> Right ()+  case opts.cacheRetention of+    Nothing -> pure absent+    Just CacheRetentionNone -> pure absent+    Just requested -> case policy of+      Nothing -> pure absent -- native Chat is opt-in through endpoint facts+      Just NativeCacheUnsupported -> refuse+      Just (NativeCacheLegacy short long) -> case requested of+        CacheRetentionShort | short -> legacy "in_memory"+        CacheRetentionLong | long -> legacy "24h"+        _ -> refuse+      Just (NativeCacheModern long prefix) -> case requested of+        CacheRetentionShort -> modern "30m" prefix CacheRetentionShort+        CacheRetentionLong | long -> modern "12h" prefix CacheRetentionLong+        _ -> refuse+  where+    named = either (Left . ((M.modelId m <> ": ") <>)) Right+    absent = CachePlan [] False $ case policy of+      Just (NativeCacheModern _ _) -> Just CacheRetentionShort+      _ -> Nothing+    refuse = Left "native cache policy cannot honor requested retention"+    -- Legacy 24h has no duration premium. Always resolve base write prices.+    legacy ttl = pure (CachePlan [("prompt_cache_retention", String ttl)] False (Just CacheRetentionShort))+    modern ttl prefix duration = pure (CachePlan [("prompt_cache_options", object ["ttl" .= (ttl :: Text)])] prefix (Just duration))+    requireLongRates = case M.pricingPolicy m of+      Just p+        | Just _ <- p.longCacheWriteCost,+          all (\t -> t.longCacheWriteCost /= Nothing) p.inputTiers ->+            Right ()+      _ -> Left "modern Long requires base and every tier long cache-write rates"++-- | Unknown duration remains an explicit estimate only when it matters to+-- reported writes. Do not infer duration from a read counter.+cacheCost :: Maybe CacheRetention -> M.Model -> U.Usage -> C.Cost+cacheCost duration m usage = C.estimateCost reasons (Pricing.computeCostForService duration Nothing m usage)+  where+    reasons = [C.CacheDurationNotReported | duration == Nothing, usage.cacheWriteTokens > 0, durationSensitive]+    durationSensitive = case m.pricingPolicy of+      Nothing -> False+      Just p -> p.longCacheWriteCost /= Nothing || any (\t -> t.longCacheWriteCost /= Nothing) p.inputTiers
src/Baikai/Provider/OpenAI/Internal/Request.hs view
@@ -21,6 +21,7 @@ import Baikai.Message qualified as Msg import Baikai.Model (Model, openaiCompletionsCompatFor) import Baikai.Options (Options (..))+import Baikai.Provider.OpenAI.Internal.Cache qualified as Cache import Baikai.Provider.OpenAI.Shape (resolveSupportedEffort) import Baikai.ResponseFormat (JsonSchemaFormat (..), ResponseFormat (..)) import Baikai.ThinkingLevel (ThinkingLevel (..))@@ -51,6 +52,7 @@ mapRequest ::   Model -> Context -> Options -> Either Text Chat.CreateChatCompletion mapRequest m ctx opts = do+  _ <- Cache.chatCachePlan m opts   either (Left . Error.message) pure (Context.refuseAssistantDataHistory ctx)   let capability = openaiCompletionsCompatFor m       forced = case opts ^. #toolChoice of@@ -176,6 +178,7 @@  toReasoningEffort :: ThinkingLevel -> Chat.ReasoningEffort toReasoningEffort = \case+  ThinkingNone -> Chat.ReasoningEffort_None   ThinkingMinimal -> Chat.ReasoningEffort_Minimal   ThinkingLow -> Chat.ReasoningEffort_Low   ThinkingMedium -> Chat.ReasoningEffort_Medium
src/Baikai/Provider/OpenAI/Internal/Stream.hs view
@@ -42,11 +42,11 @@   ) where +import Baikai.CacheRetention (CacheRetention) import Baikai.Compat (OpenAICompletionsCompat (requiresThinkingAsText)) import Baikai.Content qualified as Content import Baikai.Context (Context (..)) import Baikai.Context qualified as Context-import Baikai.Cost.Pricing qualified as Pricing import Baikai.Error (BaikaiError, contentFiltered, invalidRequest, providerError) import Baikai.Evidence qualified as Ev import Baikai.Evidence.Build qualified as Build@@ -60,10 +60,11 @@     pushFrame,     withFrameWorker,   )+import Baikai.Provider.OpenAI.Internal.Cache qualified as Cache 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.Shape (applyNativeCache, describeThinkingShape, streamRequestBody) import Baikai.Provider.OpenAI.Sse (ResponseMetadata, capturedHeaderNames, openaiSseStreamValueWithHeaders) import Baikai.Provider.OpenAI.Transport qualified as Transport import Baikai.StopReason qualified as Stop@@ -170,7 +171,7 @@               ProducerState                 { chan = q,                   pending = [EventStart StartPayload {partial = skeletonStart m startTime, responseId = Nothing}],-                  assembler = emptyAssembler m startTime,+                  assembler = emptyAssembler m startTime & #effectiveRetention .~ (call ^. #effectiveRetention),                   finished = False,                   terminalRef = tref,                   metadataRef = mref,@@ -205,7 +206,8 @@     -- request, as 'streamRequestBody' described it. Carried from here     -- rather than recomputed at the terminal: only the shaping step     -- knows which of the seven host wire shapes was used.-    thinking :: !Ev.ThinkingTranslation+    thinking :: !Ev.ThinkingTranslation,+    effectiveRetention :: !(Maybe CacheRetention)   }   deriving stock (Generic) @@ -221,33 +223,38 @@   | Left e <- Context.refuseAssistantDataHistory ctx = pure (Left e)   | otherwise = case mapRequest m ctx opts of       Left e -> pure (Left (invalidRequest e))-      Right req -> do-        let url = resolvedBaseUrl m-        -- Checked before the key is resolved, so a base URL baikai will not-        -- send to never causes a credential to be read out of the-        -- environment. The message names the problem and what to write-        -- instead; it renders the URL without its userinfo or query, so an-        -- error reaching a log cannot carry a key someone put in either.-        case Url.baseUrlProblem url of-          Just problem ->-            pure (Left (invalidRequest ("Model.baseUrl is not usable: " <> problem)))-          Nothing -> do-            key <- Transport.resolveKey url opts-            env <- Transport.getClientEnvCached url-            let compat = openaiCompletionsCompatFor m-                (body, translation) = streamRequestBody compat (m ^. #reasoning) opts req-                headers = Transport.requestHeaders key m opts-            pure-              ( Right-                  OpenAICall-                    { clientEnv = env,-                      requestHeaders = headers,-                      timeoutMs = opts ^. #timeoutMs,-                      requestBody = body,-                      baseUrl = url,-                      thinking = translation-                    }-              )+      Right req -> case Cache.chatCachePlan m opts of+        Left err -> pure (Left (invalidRequest err))+        Right cache -> prepare req cache+  where+    prepare req cache = do+      let url = resolvedBaseUrl m+      -- Checked before the key is resolved, so a base URL baikai will not+      -- send to never causes a credential to be read out of the+      -- environment. The message names the problem and what to write+      -- instead; it renders the URL without its userinfo or query, so an+      -- error reaching a log cannot carry a key someone put in either.+      case Url.baseUrlProblem url of+        Just problem ->+          pure (Left (invalidRequest ("Model.baseUrl is not usable: " <> problem)))+        Nothing -> do+          key <- Transport.resolveKey url opts+          env <- Transport.getClientEnvCached url+          let compat = openaiCompletionsCompatFor m+              (body, translation) = streamRequestBody compat (m ^. #reasoning) opts req+              headers = Transport.requestHeaders key m opts+          pure+            ( Right+                OpenAICall+                  { clientEnv = env,+                    requestHeaders = headers,+                    timeoutMs = opts ^. #timeoutMs,+                    requestBody = applyNativeCache cache body,+                    baseUrl = url,+                    thinking = translation,+                    effectiveRetention = Cache.effectiveRetention cache+                  }+            )  -- | A loose summary of one streamed chunk. The raw 'Aeson.Value' is -- pre-parsed into the fields we care about; unknown fields are@@ -800,6 +807,7 @@     -- between them produces 0, 1, 2, … in the order the host sent them,     -- which is the order reassembly rebuilds the message in.     nextContentIndex :: !Int,+    effectiveRetention :: !(Maybe CacheRetention),     usage :: !Usage.Usage,     stopReason :: !Stop.StopReason,     -- | 'True' once a chunk carrying @finish_reason@ has been@@ -858,6 +866,7 @@       toolArgs = IntMap.empty,       closed = IntMap.empty,       nextContentIndex = 0,+      effectiveRetention = Nothing,       usage = Usage.zeroUsage,       stopReason = Stop.Stop,       finishSeen = False,@@ -1229,8 +1238,8 @@ -- cannot report different numbers for the same call. finalUsage :: Assembler -> Usage.Usage finalUsage ass =-  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+  let usageBare = Billing.checkCacheDuration Billing.ChatUsage (ass ^. #effectiveRetention) (ass ^. #usageSnapshot) $ Usage.observeBilling (map Usage.BillingServiceTier (Set.toList (ass ^. #serviceTiers))) (if ass ^. #usageReported then ass ^. #usage else Billing.unreportedUsage)+   in usageBare & #cost .~ Cache.cacheCost (ass ^. #effectiveRetention) (ass ^. #model) usageBare  finalMessage ::   Assembler -> UTCTime -> Maybe Text -> Stop.StopReason -> Msg.Message
src/Baikai/Provider/OpenAI/Internal/Usage.hs view
@@ -4,8 +4,9 @@ -- 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+module Baikai.Provider.OpenAI.Internal.Usage (UsageEndpoint (..), readUsage, unreportedUsage, mergeUsage, checkCacheDuration) where +import Baikai.CacheRetention (CacheRetention (..)) import Baikai.Usage qualified as U import Baikai.Usage.Normalize qualified as N import Data.Aeson (Value (..))@@ -53,3 +54,29 @@     merge Null previous = previous     merge (Object newer) (Object previous) = Object (KM.unionWith merge newer previous)     merge newer _ = newer++-- | Duration counters are a consistency check, never extra aggregate writes.+-- Missing subcategories stay missing across partial cumulative snapshots.+checkCacheDuration :: UsageEndpoint -> Maybe CacheRetention -> Maybe Value -> U.Usage -> U.Usage+checkCacheDuration endpoint duration raw usage =+  usage {U.availability = (\a -> a {U.inconsistent = U.inconsistent a || bad}) <$> U.availability usage}+  where+    inputKey = case endpoint of ChatUsage -> "prompt_tokens_details"; ResponsesUsage -> "input_tokens_details"+    details = raw >>= field inputKey >>= field "cache_write_tokens_details"+    shortRaw = details >>= field "ttl_30m_tokens"+    longRaw = details >>= field "ttl_12h_tokens"+    totalRaw = raw >>= field inputKey >>= field "cache_write_tokens"+    short = shortRaw >>= count+    long = longRaw >>= count+    total = totalRaw >>= count+    bad =+      (case details of Just (Object _) -> False; Just _ -> True; Nothing -> False)+        || any (\v -> isJust v && isNothing (v >>= count)) [shortRaw, longRaw]+        || (case total of Just t -> maybe 0 id short + maybe 0 id long > t; Nothing -> False)+        || (maybe False (> 0) short && maybe False (> 0) long)+        || (case (short, long, total) of (Just s, Just l, Just t) -> s + l /= t; _ -> False)+        || (case duration of Just CacheRetentionShort -> maybe False (> 0) long; Just CacheRetentionLong -> maybe False (> 0) short; _ -> False)+    field k (Object o) = case KM.lookup k o of Just Null -> Nothing; v -> v+    field _ _ = Nothing+    count (Number n) | n >= 0, fromInteger (floor n) == n = Just (fromInteger (floor n) :: Natural)+    count _ = Nothing
src/Baikai/Provider/OpenAI/Responses/Request.hs view
@@ -26,6 +26,7 @@ import Baikai.Message qualified as M import Baikai.Model (Model, api, maxOutputTokens, modelId, openaiResponsesCompatFor, reasoning) import Baikai.Options (Options (..))+import Baikai.Provider.OpenAI.Internal.Cache qualified as Cache import Baikai.Provider.OpenAI.Shape (resolveSupportedEffort) import Baikai.ResponseFormat (JsonSchemaFormat (..), ResponseFormat (..)) import Baikai.ThinkingLevel (renderThinkingLevel)@@ -51,7 +52,8 @@ -- No Show instance: a prepared body can contain opaque continuation. data PreparedRequest = PreparedRequest   { requestBody :: !Value,-    translation :: !E.ThinkingTranslation+    translation :: !E.ThinkingTranslation,+    effectiveRetention :: !(Maybe CacheRetention)   }   deriving stock (Eq, Generic) @@ -71,14 +73,16 @@   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+  cache <- Cache.responsesCachePlan m opts+  let marked = cache.markPrefix && maybe False (not . Text.null) ctx.systemPrompt+      prefix = [object ["role" .= ("developer" :: Text), "content" .= [object ["type" .= ("input_text" :: Text), "text" .= text, "prompt_cache_breakpoint" .= object ["mode" .= ("explicit" :: Text)]]]] | marked, Just text <- [ctx.systemPrompt]]   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.instructions = if marked then Nothing else ctx.systemPrompt,               R.store = Just False,               R.stream = Just True,               R.include = Just (V.singleton "reasoning.encrypted_content"),@@ -88,9 +92,9 @@               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+      extras = [("input", Aeson.toJSON (prefix <> items))] <> reasoning <> choice <> cache.cacheFields <> formatFields opts   case base of-    Object obj -> pure (PreparedRequest (Object (KM.union (KM.fromList extras) obj)) translation)+    Object obj -> pure (PreparedRequest (Object (KM.union (KM.fromList extras) obj)) translation cache.effectiveRetention)     _ -> Left "Responses SDK request did not encode as an object"   where     metadataText (String t) | Text.length t <= 512 = Right t@@ -152,19 +156,6 @@           ]       )     ]--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
src/Baikai/Provider/OpenAI/Responses/Stream.hs view
@@ -8,10 +8,10 @@   ) where +import Baikai.CacheRetention (CacheRetention) import Baikai.Content qualified as C import Baikai.Context (Context) import Baikai.Context qualified as 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@@ -19,6 +19,7 @@ import Baikai.Model (Model) import Baikai.Options (Options) import Baikai.Provider.Internal.StreamWorker+import Baikai.Provider.OpenAI.Internal.Cache qualified as Cache import Baikai.Provider.OpenAI.Internal.ErrorClass (classifyErrorFrame, classifyException) import Baikai.Provider.OpenAI.Internal.Stream (SseDriver) import Baikai.Provider.OpenAI.Internal.Usage qualified as Billing@@ -84,13 +85,14 @@               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+          initial = State q meta m req.effectiveRetention (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,+    effectiveRetention :: !(Maybe CacheRetention),     assembler :: !A.Assembler,     observed :: !(Maybe Value),     pending :: ![E.AssistantMessageEvent],@@ -130,7 +132,7 @@         Nothing -> (s.assembler, [])         Just _ -> A.closePartial s.assembler       reason = maybe (fromMaybe Stop (A.terminalReason assembled)) (const ErrorReason) err-      usage = responseUsage s.model s.observed+      usage = responseUsage s.model s.effectiveRetention s.observed       payload = M.AssistantPayload (A.assembledContent assembled) usage reason (fmap (^. #message) err) (Just now)       msg = M.AssistantMessage payload       rid = s.observed >>= textField "id"@@ -169,10 +171,10 @@ 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+responseUsage :: Model -> Maybe CacheRetention -> Maybe Value -> U.Usage+responseUsage m duration raw =+  let normalized = Billing.checkCacheDuration Billing.ResponsesUsage duration (raw >>= lookupField "usage") $ U.observeBilling [U.BillingServiceTier tier | Just tier <- [raw >>= textField "service_tier"]] (fromMaybe Billing.unreportedUsage (raw >>= lookupField "usage" >>= Billing.readUsage Billing.ResponsesUsage))+   in normalized & #cost .~ Cache.cacheCost duration m normalized  observe :: Ev.CallStatus -> Maybe ResponseMetadata -> Maybe Value -> M.AssistantPayload -> Ev.ModelCallEvidence -> Ev.ModelCallEvidence observe status md raw payload ev =
src/Baikai/Provider/OpenAI/Shape.hs view
@@ -15,6 +15,7 @@     describeThinkingShape,     resolveSupportedEffort,     injectCacheControl,+    applyNativeCache,   ) where @@ -40,6 +41,7 @@     noThinkingRequested,   ) import Baikai.Options (Options, cacheRetention, temperature, thinking, topP)+import Baikai.Provider.OpenAI.Internal.Cache (CachePlan (..)) import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel) import Control.Lens ((%~), (&), (^.)) import Data.Aeson (Value (..), (.=))@@ -50,6 +52,7 @@ import Data.Generics.Labels () import Data.Maybe (isJust) import Data.Text (Text)+import Data.Text qualified as Text import Data.Vector (Vector) import Data.Vector qualified as Vector import OpenAI.V1.Chat.Completions qualified as Chat@@ -164,7 +167,8 @@  -- | 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.+-- Invalid empty policies are rejected by request validation. A policy+-- that does not list @none@ resolves it to its lowest level. resolveSupportedEffort :: Maybe [ThinkingLevel] -> ThinkingLevel -> ThinkingLevel resolveSupportedEffort Nothing lvl = lvl resolveSupportedEffort (Just []) lvl = lvl@@ -226,11 +230,11 @@               effortTranslation lvl e "reasoning_effort"             )       ThinkingFormatZai ->-        ( insertTop "enable_thinking" (Bool True) body,+        ( insertTop "enable_thinking" (Bool (lvl /= ThinkingNone)) body,           toggleTranslation lvl         )       ThinkingFormatQwen ->-        ( insertTop "enable_thinking" (Bool True) body,+        ( insertTop "enable_thinking" (Bool (lvl /= ThinkingNone)) body,           toggleTranslation lvl         ) @@ -275,7 +279,8 @@ -- Every level collapses, including the ones whose canonical name a -- richer host would have accepted, because the wire carries no depth: -- a caller asking for @max@ and a caller asking for @low@ produce--- byte-identical requests here.+-- byte-identical requests here. @none@ is the one level such a host+-- expresses exactly: it sends @enable_thinking: false@. toggleTranslation :: ThinkingLevel -> ThinkingTranslation toggleTranslation lvl =   ThinkingTranslation@@ -285,7 +290,7 @@       budgetTokens = Nothing,       wireField = Just "enable_thinking",       displayText = Nothing,-      adjustments = [EffortCollapsedToToggle lvl]+      adjustments = [EffortCollapsedToToggle lvl | lvl /= ThinkingNone]     }  injectCacheControl :: OpenAICompletionsCompat -> Options -> Aeson.Value -> Aeson.Value@@ -390,12 +395,35 @@ key = AesonKey.fromText  -- | Common effort vocabulary supported by the non-native--- OpenAI-compatible request shapes above.+-- OpenAI-compatible request shapes above. It has no word for no+-- reasoning, so @none@ clamps to @low@ and the clamp is recorded. compatibleEffort :: ThinkingLevel -> Text compatibleEffort = \case+  ThinkingNone -> "low"   ThinkingMinimal -> "low"   ThinkingLow -> "low"   ThinkingMedium -> "medium"   ThinkingHigh -> "high"   ThinkingXHigh -> "high"   ThinkingMax -> "high"++-- | Apply the already validated native plan. Only the initial instruction+-- message can carry the prefix marker; all later history stays byte-for-byte.+applyNativeCache :: CachePlan -> Value -> Value+applyNativeCache plan = mapObject $ \o ->+  let fields = KeyMap.union (KeyMap.fromList (cacheFields plan)) o+   in if markPrefix plan then adjustKey "messages" markInitial fields else fields+  where+    markInitial (Array xs) = case Vector.uncons xs of+      Just (Object first, rest)+        | KeyMap.lookup "role" first `elem` [Just (String "system"), Just (String "developer")],+          Just text <- instructionText =<< KeyMap.lookup "content" first,+          not (Text.null text) ->+            Array (Vector.cons (Object (KeyMap.insert "content" (Aeson.toJSON [Aeson.object ["type" .= ("text" :: Text), "text" .= text, "prompt_cache_breakpoint" .= Aeson.object ["mode" .= ("explicit" :: Text)]]]) first)) rest)+      _ -> Array xs+    markInitial v = v+    instructionText (String text) = Just text+    instructionText (Array xs) = case Vector.toList xs of+      [Object part] | KeyMap.lookup "type" part == Just (String "text"), Just (String text) <- KeyMap.lookup "text" part -> Just text+      _ -> Nothing+    instructionText _ = Nothing
test/BillingSpec.hs view
@@ -3,6 +3,7 @@ module BillingSpec (tests) where  import Baikai qualified as B+import Baikai.CacheRetention (CacheRetention (..)) import Baikai.Cost qualified as C import Baikai.Cost.Pricing (computeCost) import Baikai.Evidence (commitmentDigest, usageEnvelope)@@ -25,7 +26,17 @@ tests =   testGroup     "Billing normalization"-    [ testCase "Chat observes the reported tier and discloses unsupported pricing" $+    [ testCase "duration details remain consistency checks across cumulative snapshots" $ do+        let base = wire ResponsesUsage 1000 ["cached_tokens" .= (0 :: Int), "cache_write_tokens" .= (200 :: Int)]+            details short long = object ["input_tokens_details" .= object ["cache_write_tokens_details" .= object ["ttl_30m_tokens" .= (short :: Int), "ttl_12h_tokens" .= (long :: Int)]]]+        forM_ [(200, 0, False), (200, 1, True), (199, 0, True), (-1, 0, True)] $ \(s, l, bad) -> do+          let merged = mergeUsage (Just base) (Just (details s l))+          mergeUsage merged (Just (details s l)) @?= merged+          u <- maybe (assertFailure "missing usage") (parsed ResponsesUsage) merged+          let checked = checkCacheDuration ResponsesUsage (Just CacheRetentionShort) merged u+          checked.cacheWriteTokens @?= 200+          U.inconsistent <$> checked.availability @?= Just bad,+      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)
test/Main.hs view
@@ -46,6 +46,7 @@ import EvidenceSpec qualified import LifecycleSpec qualified import MidStreamSpec qualified+import NativeCacheSpec qualified import OpenAI.V1.Chat.Completions qualified as Chat import OpenAI.V1.ResponseFormat qualified as RF import PublicSurfaceSpec qualified@@ -72,7 +73,8 @@   defaultMain $     testGroup       "Baikai.Provider.OpenAI"-      [ DataInputSpec.tests,+      [ NativeCacheSpec.tests,+        DataInputSpec.tests,         commandRenderingTest,         effortRenderingTests,         safetyRefusalTest,@@ -405,7 +407,8 @@                 "--ephemeral"               ]     | (name, level, expected) <--        [ ("minimal", ThinkingMinimal, "minimal"),+        [ ("none", ThinkingNone, "none"),+          ("minimal", ThinkingMinimal, "minimal"),           ("low", ThinkingLow, "low"),           ("medium", ThinkingMedium, "medium"),           ("high", ThinkingHigh, "high"),@@ -796,7 +799,8 @@               ["-c", "model_reasoning_effort=" <> expected, "--", "prompt"]             )     | (name, level, expected) <--        [ ("minimal", ThinkingMinimal, "minimal"),+        [ ("none", ThinkingNone, "none"),+          ("minimal", ThinkingMinimal, "minimal"),           ("low", ThinkingLow, "low"),           ("medium", ThinkingMedium, "medium"),           ("high", ThinkingHigh, "high"),
+ test/NativeCacheSpec.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE OverloadedRecordDot #-}++module NativeCacheSpec (tests) where++import Baikai hiding (model)+import Baikai.Compat (NativeCachePolicy (..), nativeCachePolicy)+import Baikai.Models.Generated qualified as Models+import Baikai.Provider.OpenAI.Internal.Cache qualified as Cache+import Baikai.Provider.OpenAI.Internal.Stream qualified as Chat+import Baikai.Provider.OpenAI.Internal.Usage qualified as Billing+import Baikai.Provider.OpenAI.Responses.Request qualified as Responses+import Baikai.Provider.OpenAI.Responses.Stream qualified as Responses+import Baikai.Provider.OpenAI.Shape qualified as Shape+import Control.Lens ((&), (.~))+import Control.Monad (forM_)+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson qualified as A+import Data.Aeson.KeyMap qualified as KM+import Data.IORef+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Streamly.Data.Stream qualified as Stream+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "native cache contract"+    [ testCase "verified Luna Long plan emits 12h with published duration rates" $ do+        let m = Models.openai_gpt_6_luna+        plan <- right (Cache.responsesCachePlan m (short & #cacheRetention .~ Just CacheRetentionLong))+        Cache.cacheFields plan @?= [("prompt_cache_options", object ["ttl" .= ("12h" :: Text)])]+        Cache.effectiveRetention plan @?= Just CacheRetentionLong+        Cache.markPrefix plan @?= True+        forM_ [(272000, 17 / 250), (272001, 272001 / 2000000)] $ \(count, expected) -> do+          let u = observeBilling [BillingServiceTier "default"] (zeroUsage & #cacheWriteTokens .~ count & #totalTokens .~ count)+          (Cache.cacheCost (Just CacheRetentionLong) m u).usd @?= expected,+      testCase "Responses preserves exactly one identical prefix across fresh questions" $ do+        a <- mapped (systemUser "private prefix" "first") short+        b <- mapped (systemUser "private prefix" "second") short+        field "instructions" a.requestBody @?= Nothing+        field "store" a.requestBody @?= Just (Bool False)+        take 1 (items a.requestBody) @?= take 1 (items b.requestBody)+        assertBool "questions differ" (drop 1 (items a.requestBody) /= drop 1 (items b.requestBody))+        head (items a.requestBody) @?= developer "private prefix"+        a.effectiveRetention @?= Just CacheRetentionShort,+      testCase "absent/None controls preserve wire; default duration is known only for modern policy" $ do+        forM_ [Nothing, Just CacheRetentionNone] $ \preference -> do+          r <- mapped (systemUser "prefix" "question") (emptyOptions & #cacheRetention .~ preference)+          field "instructions" r.requestBody @?= Just (String "prefix")+          field "prompt_cache_options" r.requestBody @?= Nothing+          length (items r.requestBody) @?= 1+          r.effectiveRetention @?= Just CacheRetentionShort,+      testCase "missing/empty system never becomes an empty cacheable block" $+        forM_ [Nothing, Just ""] $ \prompt -> do+          r <- mapped (contextOf [user "question"] & #systemPrompt .~ prompt) short+          length (items r.requestBody) @?= 1,+      testCase "marker survives tool continuation with opaque reasoning unchanged" $ do+        let opaque = object ["type" .= ("reasoning" :: Text), "id" .= ("rs" :: Text), "summary" .= ([] :: [Value]), "encrypted_content" .= ("SECRET_REPLAY" :: Text)]+            thought = emptyThinkingContent & #replayState .~ Just (ThinkingReplay OpenAIResponses model.modelId (V.singleton opaque))+            response = emptyResponse & #message . #content .~ V.fromList [AssistantThinking thought, AssistantToolCall (ToolCall "call" "lookup" (object []))] & #message . #stopReason .~ ToolUse+        next <- appendToolResult (systemUser "prefix" "question") response (\_ -> pure (toolResultText "result"))+        req <- mapped next short+        take 1 (items req.requestBody) @?= [developer "prefix"]+        items req.requestBody !! 2 @?= opaque+        field "call_id" (items req.requestBody !! 4) @?= Just (String "call"),+      testCase "native Chat marks only initial instructions and retains their role" $ do+        plan <- right (Cache.chatCachePlan chatModel short)+        forM_ ["system", "developer"] $ \role -> do+          let first = object ["role" .= (role :: Text), "content" .= ("prefix" :: Text)]+              rest = [object ["role" .= ("user" :: Text), "content" .= ("question" :: Text)], first]+              body = Shape.applyNativeCache plan (object ["messages" .= (first : rest), "tools" .= ([] :: [Value])])+          field "messages" body @?= Just (A.toJSON (object ["role" .= role, "content" .= [object ["type" .= ("text" :: Text), "text" .= ("prefix" :: Text), "prompt_cache_breakpoint" .= marker]]] : rest))+          field "prompt_cache_options" body @?= Just (object ["ttl" .= ("30m" :: Text)]),+      testCase "legacy native controls accept exactly the declared values and have no premium" $ do+        let legacy policy = chatModel & #compat .~ CompatOpenAICompletions (defaultOpenAICompletionsCompat & #nativeCachePolicy .~ Just policy)+        forM_ [(NativeCacheLegacy True True, CacheRetentionShort, "in_memory"), (NativeCacheLegacy True True, CacheRetentionLong, "24h"), (NativeCacheLegacy False True, CacheRetentionLong, "24h")] $ \(policy, pref, ttl) -> do+          plan <- right (Cache.chatCachePlan (legacy policy) (emptyOptions & #cacheRetention .~ Just pref))+          Cache.cacheFields plan @?= [("prompt_cache_retention", String ttl)]+          Cache.markPrefix plan @?= False+          Cache.effectiveRetention plan @?= Just CacheRetentionShort+        assertLeft (Cache.chatCachePlan (legacy (NativeCacheLegacy False True)) short),+      testCase "absent Responses policy preserves legacy mappings; explicit unsupported wins" $ do+        let base = model & #compat .~ CompatOpenAIResponses defaultOpenAIResponsesCompat+            unsupported = model & #compat .~ CompatOpenAIResponses (defaultOpenAIResponsesCompat & #supportsPromptCacheOptions .~ True & #nativeCachePolicy .~ Just NativeCacheUnsupported)+        p <- right (Cache.responsesCachePlan base short)+        Cache.cacheFields p @?= [("prompt_cache_retention", String "in_memory")]+        Cache.markPrefix p @?= False+        assertLeft (Cache.responsesCachePlan unsupported short),+      testCase "public complete/stream dispatch both endpoints through the same prepared prefix" $+        forM_ [model, chatModel] $ \m -> do+          sent <- newIORef []+          let driver _ _ body _ emit = do+                modifyIORef' sent (<> [body])+                emit (Right (terminal m))+              handler = if m.api == OpenAIResponses then Responses.openaiResponsesStreamWith driver else Chat.openaiChatStreamWith driver+          reg <- newProviderRegistryFrom [apiProvider m.api handler]+          let opts = short & #apiKey .~ Just (ApiKeyLiteral "offline")+          a <- completeRequestWith reg m (systemUser "prefix" "first") opts+          responseError a @?= Nothing+          es <- Stream.toList (streamRequestWith reg m (systemUser "prefix" "second") opts)+          assertBool "stream completes" (case last es of EventDone _ -> True; _ -> False)+          bodies <- readIORef sent+          length bodies @?= 2+          let key = if m.api == OpenAIResponses then "input" else "messages"+              initial body = case field key body of Just (Array xs) -> V.head xs; _ -> Null+          map initial bodies @?= replicate 2 (initial (head bodies))+          assertBool "wire contains explicit marker" ("prompt_cache_breakpoint" `T.isInfixOf` T.pack (show (initial (head bodies)))),+      testCase "public refusals precede invalid credentials and driver for both endpoints" $+        forM_ [model, chatModel] $ \m -> do+          let driver _ _ _ _ _ = assertFailure "driver must not run"+              handler = if m.api == OpenAIResponses then Responses.openaiResponsesStreamWith driver else Chat.openaiChatStreamWith driver+              opts = short & #cacheRetention .~ Just CacheRetentionLong & #apiKey .~ Just (ApiKeyEnv "BAIKAI_CACHE_TEST_MISSING_KEY")+          reg <- newProviderRegistryFrom [apiProvider m.api handler]+          r <- completeRequestWith reg m emptyContext opts+          assertBool "model-named local refusal" (maybe False (\e -> T.isInfixOf m.modelId e.message) (responseError r))+          events <- Stream.toList (streamRequestWith reg m emptyContext opts)+          assertBool "stream refuses" (case last events of EventError _ -> True; _ -> False),+      testCase "contradictory controls and missing long prices fail locally" $ do+        let bad = chatModel & #compat .~ CompatOpenAICompletions (defaultOpenAICompletionsCompat & #cacheControlFormat .~ Just CacheControlFormatAnthropic & #nativeCachePolicy .~ Just (NativeCacheModern False True))+            longModel = model & #compat .~ CompatOpenAIResponses (defaultOpenAIResponsesCompat & #nativeCachePolicy .~ Just (NativeCacheModern True True))+        assertLeft (Cache.chatCachePlan bad short)+        forM_ [Nothing, Just (PricingPolicy [] Nothing), Just (PricingPolicy [InputPriceTier 100 (ModelCost 2 3 1 2) Nothing] (Just 4))] $ \policy ->+          assertLeft (Cache.responsesCachePlan (longModel & #pricingPolicy .~ policy) (short & #cacheRetention .~ Just CacheRetentionLong)),+      testCase "synthetic long/short pricing reaches both successful and partial-error terminals" $+        forM_ [model, chatModel] $ \base -> forM_ [CacheRetentionShort, CacheRetentionLong] $ \duration -> forM_ [False, True] $ \failed -> do+          let m =+                base+                  & #cost .~ ModelCost 1 2 (1 / 10) (5 / 4)+                  & #pricingPolicy .~ Just (PricingPolicy [InputPriceTier 100 (ModelCost 2 4 (1 / 5) (5 / 2)) (Just 5)] (Just (5 / 2)))+                  & #compat+                    .~ ( if base.api == OpenAIResponses+                           then CompatOpenAIResponses (defaultOpenAIResponsesCompat & #nativeCachePolicy .~ Just (NativeCacheModern True True))+                           else CompatOpenAICompletions (defaultOpenAICompletionsCompat & #nativeCachePolicy .~ Just (NativeCacheModern True True))+                       )+              isResponses = m.api == OpenAIResponses+              (ik, ok, dk) = if isResponses then ("input_tokens", "output_tokens", "input_tokens_details") else ("prompt_tokens", "completion_tokens", "prompt_tokens_details")+              input = object [ik .= (1000 :: Int), dk .= object ["cached_tokens" .= (100 :: Int), "cache_write_tokens" .= (200 :: Int)]]+              output = object [ok .= (10 :: Int)]+              frame usage = if isResponses then object ["type" .= ("response.in_progress" :: Text), "response" .= object ["service_tier" .= ("default" :: Text), "usage" .= usage]] else object ["service_tier" .= ("default" :: Text), "usage" .= usage, "choices" .= ([] :: [Value])]+              driver _ _ _ _ emit = do+                mapM_ (emit . Right . frame) [input, output, output]+                if failed then emit (Left (providerError "synthetic interruption")) else emit (Right (terminal m))+              handler = if isResponses then Responses.openaiResponsesStreamWith driver else Chat.openaiChatStreamWith driver+              opts = short & #cacheRetention .~ Just duration & #apiKey .~ Just (ApiKeyLiteral "offline") & #evidence .~ Just (evidenceRequest "synthetic-cache-billing")+          r <- streamingComplete handler m emptyContext opts+          let u = r.message.usage+          (u.inputTokens, u.cacheReadTokens, u.cacheWriteTokens, u.outputTokens, u.totalTokens) @?= (700, 100, 200, 10, 1010)+          u.cost.usd @?= if duration == CacheRetentionShort then 49 / 25000 else 123 / 50000+          u.cost.basis.estimateReasons @?= Set.empty+          case r.evidence of Just e -> e.usage @?= Observed u; Nothing -> assertFailure "missing terminal evidence",+      testCase "synthetic duration prices cross input tiers and unknown duration stays estimated" $ do+        let m = model & #cost .~ ModelCost 1 2 (1 / 10) (5 / 4) & #pricingPolicy .~ Just (PricingPolicy [InputPriceTier 100 (ModelCost 2 4 (1 / 5) (5 / 2)) (Just 5)] (Just (5 / 2)))+            u = observeBilling [BillingServiceTier "default"] (zeroUsage & #cacheWriteTokens .~ 200 & #totalTokens .~ 200)+        (Cache.cacheCost (Just CacheRetentionShort) m u).usd @?= 1 / 2000+        (Cache.cacheCost (Just CacheRetentionLong) m u).usd @?= 1 / 1000+        assertBool "duration estimate" (CacheDurationNotReported `Set.member` (Cache.cacheCost Nothing m u).basis.estimateReasons),+      testCase "duration details check totals and selected TTL without adding writes" $ do+        let usage = object ["input_tokens" .= (100 :: Int), "output_tokens" .= (1 :: Int), "input_tokens_details" .= object ["cached_tokens" .= (0 :: Int), "cache_write_tokens" .= (100 :: Int), "cache_write_tokens_details" .= object ["ttl_30m_tokens" .= (40 :: Int), "ttl_12h_tokens" .= (60 :: Int)]]]+        u <- maybe (assertFailure "usage absent") pure (Billing.readUsage Billing.ResponsesUsage usage)+        let checked = Billing.checkCacheDuration Billing.ResponsesUsage (Just CacheRetentionShort) (Just usage) u+        checked.cacheWriteTokens @?= 100+        inconsistent <$> checked.availability @?= Just True,+      testCase "configuration evidence keeps TTL and placement but excludes private payloads" $ do+        a <- mapped (systemUser "PRIVATE_PROMPT" "SECRET_QUERY") short+        let body = a.requestBody+            changed = case body of Object o -> Object (KM.insert "prompt_cache_options" (object ["ttl" .= ("12h" :: Text), "private" .= ("PRIVATE_NESTED" :: Text)]) o); _ -> body+            projected = T.pack (show (configurationProjection changed))+        forM_ ["PRIVATE_PROMPT", "SECRET_QUERY", "PRIVATE_NESTED"] $ \secret -> assertBool "no content leaked" (not (secret `T.isInfixOf` projected))+        assertBool "ttl changes configuration" (configurationDigest body /= configurationDigest changed)+        sameLength <- mapped (systemUser "REDACTED_VALUE" "HIDDEN_QUERY") short+        configurationDigest body @?= configurationDigest sameLength.requestBody+    ]++model :: Model+model =+  Models.openai_gpt_6_luna+    & #modelId .~ "renamed-responses"+    & #compat .~ CompatOpenAIResponses (openaiResponsesCompatFor Models.openai_gpt_6_luna & #nativeCachePolicy .~ Just (NativeCacheModern False True))++chatModel :: Model+chatModel = Models.openai_gpt_5_6 & #modelId .~ "renamed-chat"++short :: Options+short = emptyOptions & #cacheRetention .~ Just CacheRetentionShort++marker :: Value+marker = object ["mode" .= ("explicit" :: Text)]++developer :: Text -> Value+developer text = object ["role" .= ("developer" :: Text), "content" .= [object ["type" .= ("input_text" :: Text), "text" .= text, "prompt_cache_breakpoint" .= marker]]]++field :: A.Key -> Value -> Maybe Value+field k (Object o) = KM.lookup k o+field _ _ = Nothing++items :: Value -> [Value]+items body = case field "input" body of Just (Array xs) -> V.toList xs; _ -> []++mapped :: Context -> Options -> IO Responses.PreparedRequest+mapped ctx opts = right (Responses.mapRequest model ctx opts)++right :: Either Text a -> IO a+right = either (assertFailure . T.unpack) pure++assertLeft :: Either Text a -> IO ()+assertLeft (Left err) = assertBool "model named" ("renamed" `T.isInfixOf` err)+assertLeft (Right _) = assertFailure "expected refusal"++terminal :: Model -> Value+terminal m+  | m.api == OpenAIResponses = object ["type" .= ("response.completed" :: Text), "response" .= object ["id" .= ("resp" :: Text), "output" .= ([] :: [Value])]]+  | otherwise = object ["choices" .= [object ["delta" .= object [], "finish_reason" .= ("stop" :: Text)]]]
test/ResponsesSpec.hs view
@@ -21,7 +21,12 @@ tests =   testGroup     "Responses request mapping"-    [ testCase "Sol, GPT-6.1 Sol, and Luna catalog bindings retain Responses shaping and replay identity" $+    [ testCase "none is preserved only for catalog models that accept it" $+        forM_ [(openai_gpt_6_sol, "none", []), (openai_gpt_6_luna, "none", []), (openai_gpt_6_astra, "low", [EffortClamped ThinkingNone "low"]), (openai_gpt_6_1_sol, "low", [EffortClamped ThinkingNone "low"])] $ \(m, wire, changes) -> do+          req <- mapped m emptyContext (emptyOptions & #thinking .~ Just ThinkingNone)+          field "reasoning" req.requestBody @?= Just (object ["effort" .= (wire :: Text)])+          req.translation.adjustments @?= changes,+      testCase "Sol, GPT-6.1 Sol, and Luna catalog bindings retain Responses shaping and replay identity" $         forM_ [openai_gpt_6_sol, openai_gpt_6_1_sol, openai_gpt_6_luna] $ \m -> do           m.api @?= OpenAIResponses           let opts = emptyOptions & #thinking .~ Just ThinkingLow & #temperature .~ Just 0.5 & #topP .~ Just 0.8@@ -76,14 +81,15 @@         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+      testCase "every accepted effort survives; none and minimal adjust with evidence" $ do+        forM_ [ThinkingNone, ThinkingMinimal, ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax] $ \level -> do           let opts = emptyOptions & #thinking .~ Just level-              expected = if level == ThinkingMinimal then "low" else renderThinkingLevel level+              clamped = level < ThinkingLow+              expected = if clamped 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],+          req.translation.adjustments @?= [EffortClamped level "low" | clamped],       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
test/ShapeSpec.hs view
@@ -13,8 +13,9 @@     emptyAssembler,     translate,   )-import Baikai.Provider.OpenAI.Shape (streamRequestBody)+import Baikai.Provider.OpenAI.Shape (describeThinkingShape, streamRequestBody) import Control.Lens ((&), (.~), (^.))+import Control.Monad (forM_) import Data.Aeson (Value (..), (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as AesonKey@@ -24,6 +25,7 @@ import Data.Time.Clock (UTCTime) import Data.Vector qualified as Vector import EndpointModels (chatRestrictedModel)+import Streamly.Data.Stream qualified as Stream import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) @@ -31,7 +33,8 @@ tests =   testGroup     "ShapeSpec"-    [ endpointPolicyTests,+    [ thinkingNoneTests,+      endpointPolicyTests,       deepseekShapeTest,       nativeHigherEffortTests,       compatibleHigherEffortClampTest,@@ -148,7 +151,7 @@     lookupTop "reasoning_effort" value @?= Just (String "high")  -- ============================================================--- The forty-two-row translation table+-- The forty-nine-row translation table -- ============================================================  -- | Every canonical level against every wire shape: what goes on the@@ -196,7 +199,8 @@ -- empty adjustment list means. effortRows :: [(ThinkingLevel, Text.Text, Text.Text, [ThinkingAdjustment])] effortRows =-  [ (ThinkingMinimal, "minimal", "low", [EffortClamped ThinkingMinimal "low"]),+  [ (ThinkingNone, "none", "low", [EffortClamped ThinkingNone "low"]),+    (ThinkingMinimal, "minimal", "low", [EffortClamped ThinkingMinimal "low"]),     (ThinkingLow, "low", "low", []),     (ThinkingMedium, "medium", "medium", []),     (ThinkingHigh, "high", "high", []),@@ -258,7 +262,8 @@     )   where     -- Z.ai and Qwen carry no depth at all, so every level collapses ---    -- including the ones a richer host would have accepted verbatim.+    -- including the ones a richer host would have accepted verbatim --+    -- except none, which a toggle expresses exactly by switching off.     collapsed =       ( ThinkingTranslation           { requested = Just lvl,@@ -267,9 +272,9 @@             budgetTokens = Nothing,             wireField = Just "enable_thinking",             displayText = Nothing,-            adjustments = [EffortCollapsedToToggle lvl]+            adjustments = [EffortCollapsedToToggle lvl | lvl /= ThinkingNone]           },-        [("enable_thinking", Bool True)],+        [("enable_thinking", Bool (lvl /= ThinkingNone))],         ["reasoning_effort", "reasoning", "thinking"]       ) @@ -526,3 +531,46 @@     ]   where     fake = chatRestrictedModel & #modelId .~ "arbitrary-generation"++-- Exercise serialization and the actual registry gate, not a duplicated mapper.+thinkingNoneTests :: TestTree+thinkingNoneTests =+  testGroup+    "explicit thinking off"+    [ testCase "Ollama-compatible localhost emits none; default omits the field" $ do+        let model = emptyModel & #api .~ OpenAIChatCompletions & #modelId .~ "qwen3:0.6b" & #baseUrl .~ "http://localhost:11434/v1" & #reasoning .~ True+        (body, translated) <- shapedCall model off emptyContext+        lookupTop "reasoning_effort" body @?= Just (String "none")+        translated ^. #requested @?= Just ThinkingNone+        translated ^. #effortText @?= Just "none"+        translated ^. #adjustments @?= []+        defaultBody <- shapedBody model emptyOptions emptyContext+        lookupTop "reasoning_effort" defaultBody @?= Nothing,+      testCase "catalog reasoning models never send an unsupported none" $+        forM_ [(Models.openai_gpt_5, "minimal"), (Models.openai_gpt_5_mini, "minimal"), (Models.openai_gpt_5_nano, "minimal"), (Models.openai_o1, "low"), (Models.openai_o3, "low"), (Models.openai_o3_mini, "low"), (Models.openai_o4_mini, "low")] $ \(model, wire) -> do+          (body, translated) <- shapedCall model off emptyContext+          lookupTop "reasoning_effort" body @?= Just (String wire)+          translated ^. #adjustments @?= [EffortClamped ThinkingNone wire],+      testCase "non-reasoning catalog model satisfies off without a field" $ do+        (body, translated) <- shapedCall Models.openai_gpt_4o_mini off emptyContext+        lookupTop "reasoning_effort" body @?= Nothing+        translated ^. #adjustments @?= [ThinkingDroppedUnsupportedModel ThinkingNone]+        checkEvidenceRequirements (EvidenceRequired EvidenceRequestedOnly) EvidenceModelObserved translated @?= [],+      testCase "strict complete and stream refuse off on a host with no controls before dispatch" $ do+        let model = emptyModel & #api .~ OpenAIChatCompletions & #reasoning .~ True & #compat .~ CompatOpenAICompletions (defaultOpenAICompletionsCompat {thinkingFormat = ThinkingFormatNone})+            opts = off & #evidence .~ Just (evidenceRequest "off" & #strictness .~ EvidenceRequired EvidenceRequestedOnly)+            describe m = describeThinkingShape (openaiCompletionsCompatFor m) (m ^. #reasoning)+            provider = apiProviderWith OpenAIChatCompletions (\_ _ _ -> error "stream dispatched") (\_ _ _ -> error "complete dispatched") & #describeThinking .~ describe & #strengthCeiling .~ EvidenceModelObserved+        reg <- newProviderRegistry+        registerApiProviderWith reg provider+        response <- completeRequestWith reg model emptyContext opts+        case responseError response of+          Just err -> err ^. #category @?= InvalidRequest+          Nothing -> assertFailure "strict off unexpectedly succeeded"+        events <- Stream.toList (streamRequestWith reg model emptyContext opts)+        case events of+          [EventStart _, EventError payload] -> (payload ^. #errorInfo) /= Nothing @?= True+          other -> assertFailure ("expected pre-dispatch stream refusal: " <> show other)+    ]+  where+    off = emptyOptions & #thinking .~ Just ThinkingNone