baikai 0.6.0.1 → 0.7.0.0

raw patch · 39 files changed

+1775/−185 lines, 39 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +177/−0
• baikai.cabal +4/−1
• fetch/FetchModelsCore.hs +133/−45
• gen/GenModelsCore.hs +139/−12
• src/Baikai.hs +2/−0
• src/Baikai/Api.hs +3/−0
• src/Baikai/Compat.hs +66/−5
• src/Baikai/Content.hs +35/−4
• src/Baikai/Cost.hs +82/−5
• src/Baikai/Cost/Log.hs +8/−1
• src/Baikai/Cost/Pricing.hs +129/−23
• src/Baikai/Error.hs +6/−2
• src/Baikai/Evidence.hs +59/−18
• src/Baikai/Evidence/Build.hs +2/−0
• src/Baikai/Model.hs +59/−1
• src/Baikai/Models/Generated.hs +199/−10
• src/Baikai/Options.hs +8/−0
• src/Baikai/Provider/Cli/Internal.hs +4/−2
• src/Baikai/Speed.hs +13/−0
• src/Baikai/Stream.hs +1/−1
• src/Baikai/Trace.hs +25/−0
• src/Baikai/Trace/Event.hs +24/−0
• src/Baikai/Usage.hs +61/−12
• src/Baikai/Usage/Normalize.hs +44/−0
• test/CatalogSpec.hs +32/−16
• test/CliInternalSpec.hs +9/−1
• test/ContextSpec.hs +38/−3
• test/CostSpec.hs +58/−3
• test/ErrorSpec.hs +26/−0
• test/EvidenceSpec.hs +32/−5
• test/FetchModelsSpec.hs +81/−4
• test/GenModelsSpec.hs +44/−2
• test/Main.hs +2/−0
• test/PricingPolicySpec.hs +110/−0
• test/PublicSurfaceSpec.hs +12/−1
• test/StreamSpec.hs +3/−3
• test/StrictEvidenceSpec.hs +5/−1
• test/TraceSpec.hs +37/−2
• test/UsageSpec.hs +3/−2

@@ -7,6 +7,183 @@  ## [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

@@ -1,6 +1,6 @@ cabal-version:   3.4 name:            baikai-version:         0.6.0.1+version:         0.7.0.0 synopsis:        Unified Haskell interface for multiple AI providers description:   baikai provides a unified, provider-agnostic Haskell interface for working@@ -83,6 +83,7 @@     Baikai.Provider.Transport.Classify     Baikai.Response     Baikai.ResponseFormat+    Baikai.Speed     Baikai.StopReason     Baikai.Stream     Baikai.Stream.Event@@ -93,6 +94,7 @@     Baikai.Trace.Sink     Baikai.Url     Baikai.Usage+    Baikai.Usage.Normalize    -- The cabal-generated version module. 'Baikai.Evidence.Build' reads   -- it so an evidence record can name the build that produced it,@@ -193,6 +195,7 @@     GenModelsSpec     HelpersSpec     InteractiveSpec+    PricingPolicySpec     PublicSurfaceSpec     StreamSpec     StreamWorkerSpec

@@ -16,7 +16,8 @@ -- emitted, and only if upstream marks them @tool_call: true@. For -- @openai@ this excludes Responses-API-only ids (@*-pro@, @*-codex@, -- @*-deep-research@) because @baikai/data/models/openai.json@ speaks--- @openai-chat-completions@ and 'Baikai.Api' has no Responses tag.+-- @openai-chat-completions@ by default. Per-model API overrides allow+-- explicitly curated Responses models without changing the older routes. -- -- == Override philosophy --@@ -64,9 +65,11 @@   ) where -import Baikai.Compat (AnthropicThinkingStyle (..))+import Baikai.Compat (AnthropicThinkingStyle (..), OpenAICompletionsCompat (..), OpenAIResponsesCompat (..), defaultOpenAIResponsesCompat) import Baikai.Model (InputModality (..))+import Baikai.Model qualified as Model import Baikai.Prelude+import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel) import Data.Aeson (Value (String), eitherDecode, encode, withObject, (.!=), (.:), (.:?)) import Data.Aeson.Types (Parser) import Data.ByteString (ByteString)@@ -77,8 +80,7 @@ import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe)-import Data.Scientific (FPFormat (Fixed), Scientific, formatScientific)-import Data.Set (Set)+import Data.Scientific (FPFormat (Fixed), Scientific, formatScientific, fromRationalRepetendUnlimited) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Encoding (decodeUtf8, encodeUtf8)@@ -200,15 +202,17 @@ -- JSON into the generated 'Baikai.Compat.AnthropicMessagesCompat'. data AnthropicGenerationFacts = AnthropicGenerationFacts   { thinkingStyle :: !AnthropicThinkingStyle,-    supportsSamplingParameters :: !Bool+    supportsSamplingParameters :: !Bool,+    supportsForcedToolChoice :: !Bool,+    fastModeCost :: !(Maybe CatalogCost)   }   deriving stock (Eq, Show, Generic) --- | A per-model @compat@ block in the catalog JSON. Only--- @anthropic-messages@ needs one today; the OpenAI-compatible side is--- fully covered by the file-level @"compat": "auto"@ directive and--- 'Baikai.Compat.autoDetectOpenAICompletions'.-data CatalogModelCompat = CatalogAnthropicCompat !AnthropicGenerationFacts+-- | Per-model endpoint facts preserved through catalog refreshes.+data CatalogModelCompat+  = CatalogAnthropicCompat !AnthropicGenerationFacts+  | CatalogOpenAICompat !OpenAICompletionsCompat+  | CatalogResponsesCompat !OpenAIResponsesCompat   deriving stock (Eq, Show, Generic)  -- | One emitted catalog model. @enabled@ is always @true@ for emitted@@ -219,8 +223,11 @@     reasoning :: !Bool,     input :: ![InputModality],     cost :: !CatalogCost,+    fastModeCost :: !(Maybe CatalogCost),+    pricingPolicy :: !(Maybe Model.PricingPolicy),     contextWindow :: !Integer,     maxOutputTokens :: !Integer,+    apiOverride :: !(Maybe Text),     compat :: !(Maybe CatalogModelCompat)   }   deriving stock (Eq, Show, Generic)@@ -247,6 +254,7 @@     -- | The per-model @compat@ block to render, if this provider needs     -- one. 'const Nothing' for a provider whose file-level     -- @"compat": "auto"@ directive says everything.+    apiFor :: !(Text -> Maybe Text),     compatFor :: !(Text -> Maybe CatalogModelCompat)   }   deriving stock (Generic)@@ -254,32 +262,46 @@ -- | Curation include set for OpenAI: the chat-completions-compatible -- current line. Responses-API-only ids (@*-pro@, @*-codex@, -- @*-deep-research@) are deliberately absent.-openaiInclude :: Set Text+openaiInclude :: Map Text (Maybe CatalogModelCompat) openaiInclude =-  Set.fromList-    [ "gpt-5.6",-      "gpt-5.6-luna",-      "gpt-5.6-sol",-      "gpt-5.6-terra",-      "gpt-5.5",-      "gpt-5.4",-      "gpt-5.4-mini",-      "gpt-5.4-nano",-      "gpt-5.2",-      "gpt-5.1",-      "gpt-5",-      "gpt-5-mini",-      "gpt-5-nano",-      "gpt-4.1",-      "gpt-4.1-mini",-      "gpt-4.1-nano",-      "gpt-4o",-      "gpt-4o-mini",-      "o3",-      "o3-mini",-      "o4-mini",-      "o1"-    ]+  Map.insert "gpt-6-astra" (Just (CatalogResponsesCompat astraResponsesFacts)) $+    Map.fromList+      [ (model, Nothing)+      | model <-+          [ "gpt-5.6",+            "gpt-5.6-luna",+            "gpt-5.6-sol",+            "gpt-5.6-terra",+            "gpt-5.5",+            "gpt-5.4",+            "gpt-5.4-mini",+            "gpt-5.4-nano",+            "gpt-5.2",+            "gpt-5.1",+            "gpt-5",+            "gpt-5-mini",+            "gpt-5-nano",+            "gpt-4.1",+            "gpt-4.1-mini",+            "gpt-4.1-nano",+            "gpt-4o",+            "gpt-4o-mini",+            "o3",+            "o3-mini",+            "o4-mini",+            "o1"+          ]+      ]+  where+    -- 2026-09-07: native tools require Responses; only modern 30m cache TTL.+    -- https://developers.openai.com/api/docs/guides/latest-model+    astraResponsesFacts =+      defaultOpenAIResponsesCompat+        { supportsPromptCacheOptions = True,+          supportsLongCacheRetention = False,+          supportsSamplingParameters = False,+          supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax]+        }  -- | Curation include set for Anthropic: the current generations, each -- keyed to the request-shaping facts of its generation.@@ -299,10 +321,10 @@       -- by REV-2 C.1 (docs/reviews/correctness-and-api-review-follow-up.md).       -- docs/plans/60-... named this id as the one the include set did not       -- yet carry, and stated the facts it would have to arrive with.-      ("claude-opus-5", adaptiveNoSampling),+      ("claude-opus-5", fastAdaptive),       -- 2026-08-27: adaptive-only, sampling parameters rejected with a       -- 400 — same source.-      ("claude-opus-4-8", adaptiveNoSampling),+      ("claude-opus-4-8", fastAdaptive),       -- 2026-08-27: adaptive-only, sampling parameters rejected — same source.       ("claude-opus-4-7", adaptiveNoSampling),       -- 2026-08-27: accepts both thinking shapes, but the budget shape is@@ -325,22 +347,35 @@       -- 2026-08-27: budget shape, sampling parameters accepted — same source.       ("claude-haiku-4-5", budgetWithSampling),       -- 2026-08-27: adaptive-only, sampling parameters rejected — same source.-      ("claude-fable-5", adaptiveNoSampling)+      ("claude-fable-5", adaptiveNoSampling),+      -- 2026-09-07: always-on adaptive thinking; omit sampling parameters.+      -- https://platform.claude.com/docs/en/models/fable-5-1/whats-new-fable-5-1+      ("claude-fable-5-1", adaptiveNoSampling & #supportsForcedToolChoice .~ False)     ]   where-    adaptiveNoSampling = AnthropicGenerationFacts AnthropicThinkingAdaptive False-    adaptiveWithSampling = AnthropicGenerationFacts AnthropicThinkingAdaptive True-    budgetWithSampling = AnthropicGenerationFacts AnthropicThinkingBudget True+    -- 2026-09-07: all curated predecessors accept forced choice (subject to+    -- their separate manual-thinking constraint); only Fable 5.1 rejects it.+    -- https://platform.claude.com/docs/en/api/errors+    -- https://platform.claude.com/docs/en/models/fable-5-1/migration-guide+    -- 2026-09-07: Opus 5 and 4.8 only; cache multipliers stack on fast rates.+    -- https://platform.claude.com/docs/en/build-with-claude/fast-mode+    fastAdaptive = adaptiveNoSampling & #fastModeCost ?~ CatalogCost 10 50 1 12.5+    adaptiveNoSampling = AnthropicGenerationFacts AnthropicThinkingAdaptive False True Nothing+    adaptiveWithSampling = AnthropicGenerationFacts AnthropicThinkingAdaptive True True Nothing+    budgetWithSampling = AnthropicGenerationFacts AnthropicThinkingBudget True True Nothing --- | Provider spec for OpenAI's first-party chat-completions endpoint.+-- | OpenAI curation with a Chat default and explicit Responses overrides. openaiSpec :: ProviderSpec openaiSpec =   ProviderSpec     { provider = "openai",       baseUrl = "https://api.openai.com",       api = "openai-chat-completions",-      include = (`Set.member` openaiInclude),-      compatFor = const Nothing+      include = (`Map.member` openaiInclude),+      apiFor = \mid -> case Map.lookup mid openaiInclude >>= id of+        Just (CatalogResponsesCompat _) -> Just "openai-responses"+        _ -> Nothing,+      compatFor = \mid -> Map.lookup mid openaiInclude >>= id     }  -- | Provider spec for Anthropic's first-party messages endpoint.@@ -351,6 +386,7 @@       baseUrl = "https://api.anthropic.com",       api = "anthropic-messages",       include = (`Map.member` anthropicInclude),+      apiFor = const Nothing,       compatFor = fmap CatalogAnthropicCompat . (`Map.lookup` anthropicInclude)     } @@ -390,8 +426,13 @@                 cacheReadCost = fromMaybe 0 (m ^. #cacheReadCost),                 cacheWriteCost = fromMaybe 0 (m ^. #cacheWriteCost)               },+          fastModeCost = case (spec ^. #compatFor) (m ^. #modelId) of+            Just (CatalogAnthropicCompat facts) -> facts ^. #fastModeCost+            _ -> Nothing,+          pricingPolicy = Map.lookup (spec ^. #provider, m ^. #modelId) pricingPolicies,           contextWindow = fromMaybe 0 (m ^. #contextWindow),           maxOutputTokens = fromMaybe 0 (m ^. #maxOutputTokens),+          apiOverride = (spec ^. #apiFor) (m ^. #modelId),           compat = (spec ^. #compatFor) (m ^. #modelId)         } @@ -569,6 +610,9 @@     "      \"contextWindow\": " <> Text.pack (show (m ^. #contextWindow)) <> ",",     "      \"maxOutputTokens\": " <> Text.pack (show (m ^. #maxOutputTokens)) <> ","   ]+    ++ maybe [] (\a -> ["      \"api\": " <> jsonString a <> ","]) (m ^. #apiOverride)+    ++ maybe [] (\r -> ["      \"fastModeCost\": " <> renderFastCost r <> ","]) (m ^. #fastModeCost)+    ++ maybe [] (\p -> ["      \"pricingPolicy\": " <> renderPricingPolicy p <> ","]) (m ^. #pricingPolicy)     ++ renderModelCompat (m ^. #compat)     ++ [ "      \"enabled\": true",          "    }"@@ -576,6 +620,27 @@   where     c = m ^. #cost +-- | Provider documentation verified 2026-09-07. These rules supplement base+-- models.dev rates, which do not describe the full request billing policy.+-- https://developers.openai.com/api/docs/models/gpt-6-astra+-- https://platform.claude.com/docs/en/models/fable-5-1/overview+-- https://platform.claude.com/docs/en/build-with-claude/fast-mode+pricingPolicies :: Map (Text, Text) Model.PricingPolicy+pricingPolicies =+  Map.fromList+    [ (("anthropic", "claude-opus-5"), Model.PricingPolicy [] (Just 10)),+      (("anthropic", "claude-opus-4-8"), Model.PricingPolicy [] (Just 10)),+      (("openai", "gpt-6-astra"), Model.PricingPolicy [Model.InputPriceTier 272000 (Model.ModelCost 20 75 2 25)] Nothing),+      (("anthropic", "claude-fable-5-1"), Model.PricingPolicy [] (Just 20))+    ]++renderPricingPolicy :: Model.PricingPolicy -> Text+renderPricingPolicy p = "{\"inputTiers\": [" <> Text.intercalate ", " (map tier (Model.inputTiers p)) <> "]" <> maybe "" (\r -> ", \"longCacheWriteCost\": " <> num r) (Model.longCacheWriteCost p) <> "}"+  where+    num = renderNum . fst . fromRationalRepetendUnlimited+    tier t = "{\"inputAbove\": " <> Text.pack (show (Model.inputAbove t)) <> ", \"rates\": " <> rates (Model.rates t) <> "}"+    rates c = "{\"input\": " <> num (Model.inputCost c) <> ", \"output\": " <> num (Model.outputCost c) <> ", \"cacheRead\": " <> num (Model.cacheReadCost c) <> ", \"cacheWrite\": " <> num (Model.cacheWriteCost c) <> "}"+ -- | Render the per-model @compat@ block, if the provider spec supplied -- one. The block sits between @maxOutputTokens@ and @enabled@ so a -- @git diff@ over the catalog shows a generation's wire facts next to@@ -589,9 +654,29 @@       <> jsonString (renderThinkingStyle (facts ^. #thinkingStyle))       <> ",",     "        \"supportsSamplingParameters\": "-      <> jsonBool (facts ^. #supportsSamplingParameters),+      <> jsonBool (facts ^. #supportsSamplingParameters)+      <> ",",+    "        \"supportsFastMode\": " <> jsonBool (maybe False (const True) (facts ^. #fastModeCost)) <> ",",+    "        \"supportsForcedToolChoice\": " <> jsonBool (facts ^. #supportsForcedToolChoice),     "      },"   ]+renderModelCompat (Just (CatalogOpenAICompat facts)) =+  [ "      \"compat\": {",+    "        \"kind\": \"openai-completions\",",+    "        \"supportsToolCalls\": " <> jsonBool (facts ^. #supportsToolCalls) <> ",",+    "        \"supportsSamplingParameters\": " <> jsonBool (facts ^. #supportsSamplingParameters) <> ",",+    "        \"supportedReasoningEfforts\": " <> maybe "null" (\xs -> "[" <> Text.intercalate ", " (map (jsonString . renderThinkingLevel) xs) <> "]") (facts ^. #supportedReasoningEfforts),+    "      },"+  ]+renderModelCompat (Just (CatalogResponsesCompat facts)) =+  [ "      \"compat\": {",+    "        \"kind\": \"openai-responses\",",+    "        \"supportsSamplingParameters\": " <> jsonBool (facts ^. #supportsSamplingParameters) <> ",",+    "        \"supportsLongCacheRetention\": " <> jsonBool (facts ^. #supportsLongCacheRetention) <> ",",+    "        \"supportsPromptCacheOptions\": " <> jsonBool (facts ^. #supportsPromptCacheOptions) <> ",",+    "        \"supportedReasoningEfforts\": " <> maybe "null" (\xs -> "[" <> Text.intercalate ", " (map (jsonString . renderThinkingLevel) xs) <> "]") (facts ^. #supportedReasoningEfforts),+    "      },"+  ]  -- | The catalog dialect spells the thinking style as a word, as every -- other catalog enum does. The derived JSON instance on@@ -621,3 +706,6 @@ -- control characters, quotes, and backslashes follow the JSON encoder exactly. jsonString :: Text -> Text jsonString = decodeUtf8 . LBS.toStrict . encode . String++renderFastCost :: CatalogCost -> Text+renderFastCost c = "{\"input\": " <> renderNum (c ^. #inputCost) <> ", \"output\": " <> renderNum (c ^. #outputCost) <> ", \"cacheRead\": " <> renderNum (c ^. #cacheReadCost) <> ", \"cacheWrite\": " <> renderNum (c ^. #cacheWriteCost) <> "}"

@@ -26,6 +26,8 @@   ( AnthropicMessagesCompat       ( sendSessionAffinityHeaders,         supportsCacheControlOnTools,+        supportsFastMode,+        supportsForcedToolChoice,         supportsLongCacheRetention,         supportsSamplingParameters,         thinkingStyle@@ -37,19 +39,27 @@       ( cacheControlFormat,         maxTokensField,         requiresThinkingAsText,+        supportedReasoningEfforts,         supportsLongCacheRetention,+        supportsSamplingParameters,         supportsStrictMode,+        supportsToolCalls,         supportsUsageInStreaming,         thinkingFormat       ),+    OpenAIResponsesCompat (..),     ThinkingFormat (..),     defaultAnthropicMessagesCompat,     defaultOpenAICompletionsCompat,+    defaultOpenAIResponsesCompat,   ) import Baikai.Model (InputModality (..))+import Baikai.Model qualified as Model+import Baikai.ThinkingLevel (parseThinkingLevel) import Data.Aeson (FromJSON (..), (.!=), (.:), (.:?)) import Data.Aeson qualified as Aeson import Data.Aeson.Types (Parser, typeMismatch)+import Data.List (nub, sort) import Data.Map.Strict qualified as Map import Data.Ratio (denominator, numerator) import Data.Scientific (Scientific)@@ -84,6 +94,7 @@ data CatalogCompat   = CatalogCompatAuto   | CatalogCompatOpenAI !OpenAICompletionsCompat+  | CatalogCompatResponses !OpenAIResponsesCompat   | CatalogCompatAnthropic !AnthropicMessagesCompat   deriving stock (Show) @@ -95,12 +106,26 @@       case kind of         "openai-completions" ->           CatalogCompatOpenAI <$> parseOpenAICompat o+        "openai-responses" -> CatalogCompatResponses <$> parseResponsesCompat o         "anthropic-messages" ->           CatalogCompatAnthropic <$> parseAnthropicCompat o         _ ->           fail $ "CatalogCompat: unknown kind " <> show kind     v -> typeMismatch "CatalogCompat (expected \"auto\" or {\"kind\": ...})" v +parseResponsesCompat :: Aeson.Object -> Parser OpenAIResponsesCompat+parseResponsesCompat o = do+  let d = defaultOpenAIResponsesCompat+  raw <- o .:? "supportedReasoningEfforts"+  efforts <- traverse (traverse (\t -> maybe (fail "Unknown reasoning effort") pure (parseThinkingLevel t))) raw+  case efforts of+    Just xs | null xs || xs /= sort (nub xs) -> fail "supportedReasoningEfforts must be nonempty, unique and ordered"+    _ -> pure ()+  sampling <- o .:? "supportsSamplingParameters" .!= d.supportsSamplingParameters+  long <- o .:? "supportsLongCacheRetention" .!= d.supportsLongCacheRetention+  modern <- o .:? "supportsPromptCacheOptions" .!= d.supportsPromptCacheOptions+  pure d {supportedReasoningEfforts = efforts, supportsSamplingParameters = sampling, supportsLongCacheRetention = long, supportsPromptCacheOptions = modern}+ parseOpenAICompat :: Aeson.Object -> Parser OpenAICompletionsCompat parseOpenAICompat o = do   let d = defaultOpenAICompletionsCompat@@ -111,9 +136,19 @@   ccf <- optionalMaybeField o "cacheControlFormat" parseCacheControlFormat (cacheControlFormat d)   sus <- o .:? "supportsUsageInStreaming" .!= d.supportsUsageInStreaming   slcr <- o .:? "supportsLongCacheRetention" .!= d.supportsLongCacheRetention+  stc <- o .:? "supportsToolCalls" .!= d.supportsToolCalls+  ssp <- o .:? "supportsSamplingParameters" .!= d.supportsSamplingParameters+  rawEfforts <- o .:? "supportedReasoningEfforts"+  efforts <- traverse (traverse (\t -> maybe (fail "Unknown reasoning effort") pure (parseThinkingLevel t))) rawEfforts+  case efforts of+    Just xs | null xs || xs /= sort (nub xs) -> fail "supportedReasoningEfforts must be nonempty, unique and ordered"+    _ -> pure ()   pure     d-      { maxTokensField = mtf,+      { supportsToolCalls = stc,+        supportsSamplingParameters = ssp,+        supportedReasoningEfforts = efforts,+        maxTokensField = mtf,         supportsStrictMode = sst,         requiresThinkingAsText = rtat,         thinkingFormat = tf,@@ -130,13 +165,17 @@   ssah <- o .:? "sendSessionAffinityHeaders" .!= d.sendSessionAffinityHeaders   ts <- optionalField o "thinkingStyle" parseAnthropicThinkingStyle d.thinkingStyle   ssp <- o .:? "supportsSamplingParameters" .!= d.supportsSamplingParameters+  fast <- o .:? "supportsFastMode" .!= False+  forced <- o .:? "supportsForcedToolChoice" .!= d.supportsForcedToolChoice   pure     d       { supportsLongCacheRetention = slcr,         supportsCacheControlOnTools = scot,         sendSessionAffinityHeaders = ssah,         thinkingStyle = ts,-        supportsSamplingParameters = ssp+        supportsSamplingParameters = ssp,+        supportsFastMode = fast,+        supportsForcedToolChoice = forced       }  -- | The catalog dialect spells the extended-thinking wire shape as a@@ -204,10 +243,13 @@     entryReasoning :: !Bool,     entryInput :: ![InputModality],     entryCost :: !CostEntry,+    entryFastModeCost :: !(Maybe CostEntry),+    entryPricingPolicy :: !(Maybe Model.PricingPolicy),     entryContextWindow :: !Natural,     entryMaxOutputTokens :: !Natural,     entryEnabled :: !Bool,-    entryCompatOverride :: !(Maybe CatalogCompat)+    entryCompatOverride :: !(Maybe CatalogCompat),+    entryApiOverride :: !(Maybe Api)   }  instance FromJSON ModelEntry where@@ -218,10 +260,13 @@       <*> o .:? "reasoning" .!= False       <*> (o .: "input" >>= traverse parseInputModality)       <*> o .: "cost"+      <*> o .:? "fastModeCost"+      <*> (o .:? "pricingPolicy" >>= traverse parsePricingPolicy)       <*> o .: "contextWindow"       <*> o .: "maxOutputTokens"       <*> o .:? "enabled" .!= True       <*> o .:? "compat"+      <*> (fmap parseApi <$> o .:? "api")  parseInputModality :: Text -> Parser InputModality parseInputModality = \case@@ -240,13 +285,33 @@   }  instance FromJSON CostEntry where-  parseJSON = Aeson.withObject "CostEntry" $ \o ->-    CostEntry-      <$> o .: "input"-      <*> o .: "output"-      <*> o .:? "cacheRead" .!= 0-      <*> o .:? "cacheWrite" .!= 0+  parseJSON = Aeson.withObject "CostEntry" $ \o -> do+    c <-+      CostEntry+        <$> o .: "input"+        <*> o .: "output"+        <*> o .:? "cacheRead" .!= 0+        <*> o .:? "cacheWrite" .!= 0+    if all (>= 0) [costInput c, costOutput c, costCacheRead c, costCacheWrite c]+      then pure c+      else fail "Cost rates must be nonnegative" +-- | Catalog prices use decimal numbers; runtime policy rates are exact rationals.+parsePricingPolicy :: Aeson.Value -> Parser Model.PricingPolicy+parsePricingPolicy = Aeson.withObject "PricingPolicy" $ \o -> do+  tiers <- o .:? "inputTiers" .!= [] >>= traverse parseTier+  long <- fmap toRational <$> (o .:? "longCacheWriteCost" :: Parser (Maybe Scientific))+  let policy = Model.PricingPolicy tiers long+  either (fail . Text.unpack) (const (pure policy)) (Model.validatePricingPolicy policy)+  where+    parseTier = Aeson.withObject "InputPriceTier" $ \o ->+      Model.InputPriceTier <$> o .: "inputAbove" <*> (o .: "rates" >>= parseCompleteRates)+    parseCompleteRates = Aeson.withObject "Complete tier rates" $ \o ->+      toModelCost <$> (CostEntry <$> o .: "input" <*> o .: "output" <*> o .: "cacheRead" <*> o .: "cacheWrite")++toModelCost :: CostEntry -> Model.ModelCost+toModelCost c = Model.ModelCost (toRational (costInput c)) (toRational (costOutput c)) (toRational (costCacheRead c)) (toRational (costCacheWrite c))+ -- * Flattening ---------------------------------------------------------  -- | One generated Haskell identifier plus the 'Model'-shaped record@@ -262,6 +327,8 @@     reasoning :: !Bool,     input :: ![InputModality],     cost :: !CostEntry,+    fastModeCost :: !(Maybe CostEntry),+    pricingPolicy :: !(Maybe Model.PricingPolicy),     contextWindow :: !Natural,     maxOutputTokens :: !Natural,     compat :: !CatalogCompat@@ -278,12 +345,14 @@                 sanitizeIdentifier (c.provider <> "_" <> entryId m),               modelId = entryId m,               name = entryName m,-              api = c.api,+              api = maybe c.api id (entryApiOverride m),               provider = c.provider,               baseUrl = c.baseUrl,               reasoning = entryReasoning m,               input = entryInput m,               cost = entryCost m,+              fastModeCost = entryFastModeCost m,+              pricingPolicy = entryPricingPolicy m,               contextWindow = entryContextWindow m,               maxOutputTokens = entryMaxOutputTokens m,               compat =@@ -327,9 +396,14 @@ checkAnthropicCompat :: [(Text, GeneratedEntry)] -> Either Text () checkAnthropicCompat entries =   case [e | (_, e) <- entries, e.api == AnthropicMessages, not (stated e.compat)] of-    [] -> Right ()+    [] -> case [e | (_, e) <- entries, fastSupported e /= maybe False (const True) e.fastModeCost] of+      [] -> Right ()+      bad -> Left ("fast-mode capability and rates disagree: " <> Text.intercalate ", " (map modelId bad))     missing -> Left (Text.intercalate "; " (map complain missing))   where+    fastSupported e = case e.compat of+      CatalogCompatAnthropic c -> c.supportsFastMode+      _ -> False     stated = \case       CatalogCompatAnthropic _ -> True       _ -> False@@ -388,6 +462,8 @@         "  ( AnthropicMessagesCompat",         "      ( sendSessionAffinityHeaders,",         "        supportsCacheControlOnTools,",+        "        supportsFastMode,",+        "        supportsForcedToolChoice,",         "        supportsLongCacheRetention,",         "        supportsSamplingParameters,",         "        thinkingStyle",@@ -399,34 +475,44 @@         "      ( cacheControlFormat,",         "        maxTokensField,",         "        requiresThinkingAsText,",+        "        supportedReasoningEfforts,",         "        supportsLongCacheRetention,",+        "        supportsSamplingParameters,",         "        supportsStrictMode,",+        "        supportsToolCalls,",         "        supportsUsageInStreaming,",         "        thinkingFormat",         "      ),",+        "    OpenAIResponsesCompat (..),",         "    ThinkingFormat (..),",         "    defaultAnthropicMessagesCompat,",         "    defaultOpenAICompletionsCompat,",+        "    defaultOpenAIResponsesCompat,",         "  )",         "import Baikai.Model",         "  ( Compat (..),",         "    InputModality (..),",+        "    InputPriceTier (..),",         "    Model,",         "    ModelCost (..),",+        "    PricingPolicy (..),",         "    api,",         "    baseUrl,",         "    compat,",         "    contextWindow,",         "    cost,",         "    emptyModel,",+        "    fastModeCost,",         "    headers,",         "    input,",         "    maxOutputTokens,",         "    modelId,",         "    name,",+        "    pricingPolicy,",         "    provider,",         "    reasoning,",         "  )",+        "import Baikai.ThinkingLevel (ThinkingLevel (..))",         "import Data.Map.Strict qualified as Map",         "import Data.Ratio ((%))",         ""@@ -465,6 +551,8 @@     "      input = " <> renderInputList g.input <> ",",     "      cost =",     renderCost g.cost <> ",",+    renderFastCost g.fastModeCost,+    "      pricingPolicy = " <> renderPolicy g.pricingPolicy <> ",",     "      contextWindow = " <> Text.pack (show g.contextWindow) <> ",",     "      maxOutputTokens = " <> Text.pack (show g.maxOutputTokens) <> ",",     "      headers = Map.empty,"@@ -494,6 +582,7 @@ renderApiCtor :: Api -> Text renderApiCtor = \case   OpenAIChatCompletions -> "OpenAIChatCompletions"+  OpenAIResponses -> "OpenAIResponses"   AnthropicMessages -> "AnthropicMessages"   OpenAICompletionsCli -> "OpenAICompletionsCli"   AnthropicMessagesCli -> "AnthropicMessagesCli"@@ -511,6 +600,13 @@       "          }"     ] +renderPolicy :: Maybe Model.PricingPolicy -> Text+renderPolicy Nothing = "Nothing"+renderPolicy (Just p) = "Just (PricingPolicy [" <> Text.intercalate ", " (map tier (Model.inputTiers p)) <> "] " <> maybe "Nothing" (\r -> "(Just (" <> renderRational r <> "))") (Model.longCacheWriteCost p) <> ")"+  where+    tier t = "InputPriceTier " <> Text.pack (show (Model.inputAbove t)) <> " (" <> rates (Model.rates t) <> ")"+    rates c = "ModelCost " <> Text.unwords (map (\r -> "(" <> renderRational r <> ")") [Model.inputCost c, Model.outputCost c, Model.cacheReadCost c, Model.cacheWriteCost c])+ renderRational :: Rational -> Text renderRational r =   Text.pack (show (numerator r)) <> " % " <> Text.pack (show (denominator r))@@ -534,10 +630,23 @@       "              requiresThinkingAsText = " <> renderBool c.requiresThinkingAsText <> ",",       "              thinkingFormat = " <> renderThinkingFormat c.thinkingFormat <> ",",       "              cacheControlFormat = " <> renderMaybeCacheControl c.cacheControlFormat <> ",",+      "              supportsToolCalls = " <> renderBool c.supportsToolCalls <> ",",+      "              supportsSamplingParameters = " <> renderBool c.supportsSamplingParameters <> ",",+      "              supportedReasoningEfforts = " <> maybe "Nothing" (\xs -> "Just [" <> Text.intercalate ", " (map (Text.pack . show) xs) <> "]") c.supportedReasoningEfforts <> ",",       "              supportsUsageInStreaming = " <> renderBool c.supportsUsageInStreaming <> ",",       "              supportsLongCacheRetention = " <> renderBool c.supportsLongCacheRetention,       "            }"     ]+  CatalogCompatResponses c ->+    [ "      compat =",+      "        CompatOpenAIResponses",+      "          defaultOpenAIResponsesCompat",+      "            { supportedReasoningEfforts = " <> maybe "Nothing" (\xs -> "Just [" <> Text.intercalate ", " (map (Text.pack . show) xs) <> "]") c.supportedReasoningEfforts <> ",",+      "              supportsSamplingParameters = " <> renderBool c.supportsSamplingParameters <> ",",+      "              supportsLongCacheRetention = " <> renderBool c.supportsLongCacheRetention <> ",",+      "              supportsPromptCacheOptions = " <> renderBool c.supportsPromptCacheOptions,+      "            }"+    ]   CatalogCompatAnthropic c ->     [ "      compat =",       "        CompatAnthropicMessages",@@ -546,7 +655,9 @@       "              supportsCacheControlOnTools = " <> renderBool c.supportsCacheControlOnTools <> ",",       "              sendSessionAffinityHeaders = " <> renderBool c.sendSessionAffinityHeaders <> ",",       "              thinkingStyle = " <> renderAnthropicThinkingStyle c.thinkingStyle <> ",",-      "              supportsSamplingParameters = " <> renderBool c.supportsSamplingParameters,+      "              supportsSamplingParameters = " <> renderBool c.supportsSamplingParameters <> ",",+      "              supportsFastMode = " <> renderBool c.supportsFastMode <> ",",+      "              supportsForcedToolChoice = " <> renderBool c.supportsForcedToolChoice,       "            }"     ] @@ -574,3 +685,19 @@ renderMaybeCacheControl = \case   Nothing -> "Nothing"   Just CacheControlFormatAnthropic -> "Just CacheControlFormatAnthropic"++renderFastCost :: Maybe CostEntry -> Text+renderFastCost Nothing = "      fastModeCost = Nothing,"+renderFastCost (Just c) =+  Text.intercalate+    "\n"+    [ "      fastModeCost =",+      "        Just",+      "          ( ModelCost",+      "              { inputCost = " <> renderRational (toRational (costInput c)) <> ",",+      "                outputCost = " <> renderRational (toRational (costOutput c)) <> ",",+      "                cacheReadCost = " <> renderRational (toRational (costCacheRead c)) <> ",",+      "                cacheWriteCost = " <> renderRational (toRational (costCacheWrite c)),+      "              }",+      "          ),"+    ]

@@ -37,6 +37,7 @@      -- * Per-API compat shims and call-time options     module Baikai.Compat,+    module Baikai.Speed,     module Baikai.CacheRetention,     module Baikai.ResponseFormat,     module Baikai.ThinkingLevel,@@ -69,6 +70,7 @@ import Baikai.Provider import Baikai.Response import Baikai.ResponseFormat+import Baikai.Speed import Baikai.StopReason import Baikai.Stream import Baikai.Stream.Event

@@ -28,6 +28,7 @@ -- | The supported upstream API surfaces, plus an open escape hatch. data Api   = OpenAIChatCompletions+  | OpenAIResponses   | AnthropicMessages   | OpenAICompletionsCli   | AnthropicMessagesCli@@ -37,6 +38,7 @@ -- | Render an 'Api' tag as its canonical kebab-cased wire string. renderApi :: Api -> Text renderApi = \case+  OpenAIResponses -> "openai-responses"   OpenAIChatCompletions -> "openai-chat-completions"   AnthropicMessages -> "anthropic-messages"   OpenAICompletionsCli -> "openai-completions-cli"@@ -47,6 +49,7 @@ -- 'Custom' values so callers can use the same tag space. parseApi :: Text -> Api parseApi = \case+  "openai-responses" -> OpenAIResponses   "openai-chat-completions" -> OpenAIChatCompletions   "anthropic-messages" -> AnthropicMessages   "openai-completions-cli" -> OpenAICompletionsCli

@@ -33,6 +33,9 @@         requiresThinkingAsText,         thinkingFormat,         cacheControlFormat,+        supportsToolCalls,+        supportsSamplingParameters,+        supportedReasoningEfforts,         supportsUsageInStreaming,         supportsLongCacheRetention       ),@@ -41,12 +44,18 @@     ThinkingFormat (..),     CacheControlFormat (..), +    -- * OpenAI Responses compat+    OpenAIResponsesCompat (supportedReasoningEfforts, supportsSamplingParameters, supportsLongCacheRetention, supportsPromptCacheOptions),+    defaultOpenAIResponsesCompat,+     -- * Anthropic Messages compat     AnthropicMessagesCompat       ( supportsLongCacheRetention,         supportsCacheControlOnTools,         sendSessionAffinityHeaders,         thinkingStyle,+        supportsFastMode,+        supportsForcedToolChoice,         supportsSamplingParameters       ),     AnthropicThinkingStyle (..),@@ -60,8 +69,9 @@   ) where +import Baikai.ThinkingLevel (ThinkingLevel) import Baikai.Url (hostMatchesSuffix, urlHost)-import Data.Aeson (FromJSON, ToJSON)+import Data.Aeson (FromJSON (parseJSON), ToJSON, withObject, (.!=), (.:), (.:?)) import Data.Text (Text) import GHC.Generics (Generic) @@ -82,7 +92,8 @@   = -- | OpenAI-native: top-level @reasoning_effort: "minimal" | "low"     --   | "medium" | "high" | "xhigh" | "max"@.     ---    --   This shape sends the canonical baikai level verbatim. Three of+    --   This shape sends the canonical level unless the model declares+    --   a restricted supportedReasoningEfforts vocabulary. Three of     --   the other six — OpenRouter, DeepSeek and Together — route     --   through @Baikai.Provider.OpenAI.Shape.compatibleEffort@, which     --   clamps @minimal@ to @low@ and both @xhigh@ and @max@ to @high@ —@@ -173,6 +184,12 @@     --   @Baikai.Provider.OpenAI.Shape.streamRequestBody@ to include     --   or omit @stream_options.include_usage@.     supportsUsageInStreaming :: !Bool,+    -- | Whether this endpoint accepts function tools for the model.+    supportsToolCalls :: !Bool,+    -- | Whether this model accepts sampling controls.+    supportsSamplingParameters :: !Bool,+    -- | Accepted effort levels in increasing order; Nothing is unconstrained.+    supportedReasoningEfforts :: !(Maybe [ThinkingLevel]),     -- | Whether the host honours long (1h) cache TTLs through the     --   Anthropic-style cache_control marker. Consumed by     --   @Baikai.Provider.OpenAI.Shape.injectCacheControl@ when@@ -192,9 +209,33 @@       thinkingFormat = ThinkingFormatOpenAI,       cacheControlFormat = Nothing,       supportsUsageInStreaming = True,+      supportsToolCalls = True,+      supportsSamplingParameters = True,+      supportedReasoningEfforts = Nothing,       supportsLongCacheRetention = True     } +-- | Model and endpoint facts for native Responses. This is separate+-- from Chat Completions: a host implementing one need not implement both.+data OpenAIResponsesCompat = OpenAIResponsesCompat+  { supportedReasoningEfforts :: !(Maybe [ThinkingLevel]),+    supportsSamplingParameters :: !Bool,+    supportsLongCacheRetention :: !Bool,+    -- | Use prompt_cache_options rather than legacy prompt_cache_retention.+    supportsPromptCacheOptions :: !Bool+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (FromJSON, ToJSON)++defaultOpenAIResponsesCompat :: OpenAIResponsesCompat+defaultOpenAIResponsesCompat =+  OpenAIResponsesCompat+    { supportedReasoningEfforts = Nothing,+      supportsSamplingParameters = True,+      supportsLongCacheRetention = True,+      supportsPromptCacheOptions = False+    }+ -- | Feature flags for one Anthropic Messages-compatible host. data AnthropicMessagesCompat = AnthropicMessagesCompat   { -- | Whether the host honours Anthropic's@@ -229,10 +270,16 @@     --   generations accept them is a fact of the generated catalog     --   record, not of this type. Consumed by     --   @Baikai.Provider.Claude.Internal.Request.planRequest@.-    supportsSamplingParameters :: !Bool+    supportsSamplingParameters :: !Bool,+    -- | Whether this model accepts fast inference. Defaults to False;+    -- curated availability and premium rates must agree.+    supportsFastMode :: !Bool,+    -- | Whether this generation accepts required or named tool choice.+    -- Defaults to True; explicit catalog facts disable unsupported choices.+    supportsForcedToolChoice :: !Bool   }   deriving stock (Eq, Show, Generic)-  deriving anyclass (FromJSON, ToJSON)+  deriving anyclass (ToJSON)  -- | Anthropic's own host: every flag at its default. defaultAnthropicMessagesCompat :: AnthropicMessagesCompat@@ -242,8 +289,22 @@       supportsCacheControlOnTools = True,       sendSessionAffinityHeaders = False,       thinkingStyle = AnthropicThinkingBudget,-      supportsSamplingParameters = True+      supportsSamplingParameters = True,+      supportsFastMode = False,+      supportsForcedToolChoice = True     }++-- | Older persisted models predate fast-mode and forced-choice capabilities.+instance FromJSON AnthropicMessagesCompat where+  parseJSON = withObject "AnthropicMessagesCompat" $ \o ->+    AnthropicMessagesCompat+      <$> o .: "supportsLongCacheRetention"+      <*> o .: "supportsCacheControlOnTools"+      <*> o .: "sendSessionAffinityHeaders"+      <*> o .: "thinkingStyle"+      <*> o .: "supportsSamplingParameters"+      <*> o .:? "supportsFastMode" .!= False+      <*> o .:? "supportsForcedToolChoice" .!= True  -- | Pick a sensible compat record for an unknown OpenAI-compatible -- host based on its @baseUrl@. Falls back to

@@ -18,6 +18,7 @@   ( -- * Block primitives     TextContent (..),     ThinkingContent (..),+    ThinkingReplay (..),     ToolCall (..),     ImageContent (..), @@ -38,6 +39,7 @@   ) where +import Baikai.Api (Api) import Data.Aeson   ( FromJSON (parseJSON),     Options (..),@@ -51,6 +53,7 @@     object,     withObject,     (.:),+    (.:?),     (.=),   ) import Data.Aeson qualified as Aeson@@ -60,6 +63,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text+import Data.Vector (Vector) import GHC.Generics (Generic)  -- | A plain-text block. The wire form is @{"text": "..."}@.@@ -80,10 +84,32 @@ data ThinkingContent = ThinkingContent   { thinking :: !Text,     signature :: !(Maybe Text),-    redacted :: !Bool+    redacted :: !Bool,+    -- | Provider-owned continuation, persisted but never rendered as text.+    replayState :: !(Maybe ThinkingReplay)   }   deriving stock (Eq, Show, Generic) +-- | Ordered opaque provider items needed to continue a reasoning turn.+-- The API and model identify where these items may be replayed. Providers+-- validate that scope before sending them. JSON persistence is lossless;+-- Show deliberately omits the opaque item payloads.+data ThinkingReplay = ThinkingReplay+  { replayApi :: !Api,+    replayModel :: !Text,+    replayItems :: !(Vector Value)+  }+  deriving stock (Eq, Generic)++instance Show ThinkingReplay where+  show _ = "ThinkingReplay <opaque>"++instance FromJSON ThinkingReplay where+  parseJSON = genericParseJSON snakeOptions++instance ToJSON ThinkingReplay where+  toJSON = genericToJSON snakeOptions+ -- | A model-issued tool invocation. @id_@ has a trailing underscore in -- Haskell to dodge a clash with @Prelude.id@; the JSON encoding strips -- it back to @id@.@@ -166,7 +192,8 @@   ThinkingContent     { thinking = Text.empty,       signature = Nothing,-      redacted = False+      redacted = False,+      replayState = Nothing     }  emptyToolCall :: ToolCall@@ -190,10 +217,14 @@ snakeOptions = defaultOptions {fieldLabelModifier = camelTo2 '_'}  instance FromJSON ThinkingContent where-  parseJSON = genericParseJSON snakeOptions+  parseJSON = withObject "ThinkingContent" $ \o ->+    ThinkingContent <$> o .: "thinking" <*> o .:? "signature" <*> o .: "redacted" <*> o .:? "replay_state"  instance ToJSON ThinkingContent where-  toJSON = genericToJSON snakeOptions+  toJSON c =+    object $+      ["thinking" .= thinking c, "signature" .= signature c, "redacted" .= redacted c]+        <> maybe [] (\r -> ["replay_state" .= r]) (replayState c)  -- Strip the trailing underscore on @id_@ so the wire form is @id@; the -- other fields keep their natural names.

@@ -1,16 +1,91 @@ module Baikai.Cost   ( Cost (..),     CostBreakdown (..),+    CostBasis (..),+    CostSource (..),+    CostEstimateReason (..),+    standardCostBasis,+    providerReportedBasis,+    estimateCost,+    nonEmptyBasis,     zeroCost,     zeroCostBreakdown,     usdAsScientific,   ) where -import Data.Aeson (ToJSON (toJSON), object, (.=))+import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, (.=))+import Data.Aeson qualified as Aeson import Data.Scientific (Scientific, fromRationalRepetendUnlimited)+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text) import GHC.Generics (Generic) +-- | What the number represents; a standard token calculation is not an invoice.+data CostSource = StandardTokenRates | ResolvedTokenRates | ProviderReportedTotal+  deriving stock (Eq, Ord, Show, Generic)++data CostEstimateReason+  = UsageNotReported+  | InputUsageNotReported+  | OutputUsageNotReported+  | CacheReadUsageNotReported+  | CacheWriteUsageNotReported+  | InconsistentUsage+  | ServiceTierNotReported+  | UnsupportedServiceTier Text+  | SpeedNotReported+  | UnsupportedSpeed Text+  | ServiceTierMismatch Text Text+  | PricingUnavailable+  | InvalidPricingPolicy+  | CacheDurationNotReported+  | AdditionalChargesExcluded+  deriving stock (Eq, Ord, Show, Generic)++-- | Sources and estimation reasons survive aggregation by set union.+-- An empty basis belongs to the additive zero, not to an observed free call.+data CostBasis = CostBasis+  { sources :: !(Set CostSource),+    estimateReasons :: !(Set CostEstimateReason)+  }+  deriving stock (Eq, Show, Generic)++basisOptions :: Aeson.Options+basisOptions = Aeson.defaultOptions {Aeson.fieldLabelModifier = Aeson.camelTo2 '_', Aeson.constructorTagModifier = Aeson.camelTo2 '_'}++instance ToJSON CostSource where toJSON = Aeson.genericToJSON basisOptions++instance FromJSON CostSource where parseJSON = Aeson.genericParseJSON basisOptions++instance ToJSON CostEstimateReason where toJSON = Aeson.genericToJSON basisOptions++instance FromJSON CostEstimateReason where parseJSON = Aeson.genericParseJSON basisOptions++instance ToJSON CostBasis where toJSON = Aeson.genericToJSON basisOptions++instance FromJSON CostBasis where parseJSON = Aeson.genericParseJSON basisOptions++instance Semigroup CostBasis where+  a <> b = CostBasis (sources a <> sources b) (estimateReasons a <> estimateReasons b)++instance Monoid CostBasis where mempty = CostBasis Set.empty Set.empty++standardCostBasis :: CostBasis+standardCostBasis = CostBasis (Set.singleton StandardTokenRates) Set.empty++providerReportedBasis :: CostBasis+providerReportedBasis = CostBasis (Set.singleton ProviderReportedTotal) Set.empty++estimateCost :: [CostEstimateReason] -> Cost -> Cost+estimateCost reasons c = c {basis = basis c <> CostBasis Set.empty (Set.fromList reasons)}++-- | The additive zero carries no calculation facts. Omit that empty basis+-- when adding optional metadata to existing trace and log formats.+nonEmptyBasis :: Cost -> Maybe CostBasis+nonEmptyBasis c = if basis c == mempty then Nothing else Just (basis c)+ data CostBreakdown = CostBreakdown   { inputUsd :: !Rational,     outputUsd :: !Rational,@@ -21,7 +96,8 @@  data Cost = Cost   { usd :: !Rational,-    breakdown :: !CostBreakdown+    breakdown :: !CostBreakdown,+    basis :: !CostBasis   }   deriving stock (Eq, Show, Generic) @@ -35,7 +111,7 @@     }  zeroCost :: Cost-zeroCost = Cost {usd = 0, breakdown = zeroCostBreakdown}+zeroCost = Cost {usd = 0, breakdown = zeroCostBreakdown, basis = mempty}  -- Field-wise combination so callers can total per-call costs with -- '(<>)'/'mconcat'. 'mempty' reuses the existing zero value, so the@@ -54,7 +130,7 @@   mempty = zeroCostBreakdown  instance Semigroup Cost where-  a <> b = Cost {usd = usd a + usd b, breakdown = breakdown a <> breakdown b}+  a <> b = Cost {usd = usd a + usd b, breakdown = breakdown a <> breakdown b, basis = basis a <> basis b}  instance Monoid Cost where   mempty = zeroCost@@ -72,7 +148,8 @@   toJSON c =     object       [ "usd" .= ratToSci (usd c),-        "breakdown" .= breakdown c+        "breakdown" .= breakdown c,+        "basis" .= basis c       ]  usdAsScientific :: Cost -> Scientific

@@ -42,7 +42,8 @@  import Baikai.Content (TextContent (..), UserContent (..)) import Baikai.Context (Context)-import Baikai.Cost (usdAsScientific)+import Baikai.Cost (CostBasis, usdAsScientific)+import Baikai.Cost qualified as Cost import Baikai.Message   ( Message (..),     UserPayload (..),@@ -106,6 +107,9 @@     inputTokens :: !(Maybe Natural),     outputTokens :: !(Maybe Natural),     cachedInputTokens :: !(Maybe Natural),+    cacheWriteTokens :: !(Maybe Natural),+    costBasis :: !(Maybe CostBasis),+    usageAvailability :: !(Maybe Usage.UsageAvailability),     reasoningTokens :: !(Maybe Natural),     usd :: !(Maybe Scientific),     latencyMs :: !Int,@@ -215,6 +219,9 @@             inputTokens = positive (Usage.inputTokens u),             outputTokens = positive (Usage.outputTokens u),             cachedInputTokens = positive (Usage.cacheReadTokens u),+            cacheWriteTokens = Just (Usage.cacheWriteTokens u),+            costBasis = Cost.nonEmptyBasis (Usage.cost u),+            usageAvailability = Usage.availability u,             reasoningTokens = Usage.reasoningTokens u,             -- A zero cost is reported as zero. The other entry-building             -- site ('Baikai.Trace.runRequestWithRegistry') used to

@@ -1,30 +1,102 @@ -- | Cost computation from a 'Baikai.Model.Model' and a 'Usage'. ----- The previous map-based lookup (@Map Text PricingRate@) is gone.--- Pricing rates live on 'Baikai.Model.Model.cost' directly, so the--- computation collapses to a record-field access. Models without--- published pricing carry a zero 'Baikai.Model.ModelCost' (the--- default in 'emptyModel'), producing a zero 'Cost'.+-- Base prices and optional context/duration policies live on the model.+-- Arithmetic stays exact, and unavailable pricing carries an estimate reason. module Baikai.Cost.Pricing   ( computeCost,+    computeCostAtSpeed,     attachCost,+    resolveRates,+    computeCostWith,+    computeCostForService,+    computeCostAtRates,   ) where -import Baikai.Cost (Cost (..), CostBreakdown (..))+import Baikai.CacheRetention (CacheRetention (..))+import Baikai.Cost (Cost (..), CostBreakdown (..), CostEstimateReason (..), CostSource (..), estimateCost, standardCostBasis) import Baikai.Message (AssistantPayload (..))-import Baikai.Model (Model, ModelCost (..))+import Baikai.Model (InputPriceTier (..), Model, ModelCost (..), PricingPolicy (..), validatePricingPolicy, zeroModelCost) import Baikai.Prelude import Baikai.Response (Response (..))-import Baikai.Usage (Usage (..))+import Baikai.Speed (Speed (..))+import Baikai.Usage (BillingFact (..), Usage (..), UsageAvailability (..), UsageCategory (..))+import Data.Set qualified as Set  -- | Compute a 'Cost' from a model's per-million-token rates and a--- 'Usage'. Returns a zero 'Cost' when the model carries zero rates,--- which is the truthful signal for providers without published--- pricing (CLI providers, custom hosts).+-- 'Usage'. Zero rates retain the old numeric total and now mark pricing+-- unavailable. This entry point assumes the standard cache duration.+-- Use 'computeCostAtSpeed' to select premium speed rates explicitly. computeCost :: Model -> Usage -> Cost-computeCost m u =-  let rates = m ^. #cost+computeCost = computeCostWith Nothing++-- | Duration must be the value selected by request shaping, not merely+-- requested by the caller. Service-tier and usage availability are supplied+-- by adapters as estimation reasons on the resulting cost.+computeCostWith :: Maybe CacheRetention -> Model -> Usage -> Cost+computeCostWith duration m u = priceUsage (resolveRates duration m u) u++-- | Shared terminal pricing entry point. Observed tiers and speed come from+-- Usage availability, never from the caller's preference. Uncurated products+-- retain a standard-rate estimate with a specific reason.+computeCostForService :: Maybe CacheRetention -> Maybe Text -> Model -> Usage -> Cost+computeCostForService duration requested m u =+  let facts = maybe [] (Set.toList . billingFacts) (u ^. #availability)+      tiers = [t | BillingServiceTier t <- facts]+      speeds = [s | BillingSpeed s <- facts]+      reasons =+        [ServiceTierNotReported | null tiers]+          <> [AdditionalChargesExcluded | BillingServerToolUse `elem` facts]+          <> [UnsupportedServiceTier t | t <- tiers, t `notElem` ["default", "standard"]]+          <> [UnsupportedSpeed s | s <- speeds, s /= "standard", s /= "fast" || m ^. #fastModeCost == Nothing]+          <> [InconsistentUsage | length speeds > 1]+          <> [ServiceTierMismatch wanted actual | Just wanted <- [requested], wanted /= "auto", actual <- tiers, not (matches wanted actual)]+   in estimateCost reasons (if speeds == ["fast"] then priceAtSpeed duration m SpeedFast u else computeCostWith duration m u)+  where+    matches wanted actual = wanted == actual || (wanted == "standard_only" && actual == "standard") || (wanted == "fast" && actual == "priority")++-- | Price an explicitly selected speed with the standard cache duration.+-- Standard agrees exactly with 'computeCost'. Missing fast rates retain a+-- standard-rate estimate with 'UnsupportedSpeed', never a fabricated zero.+-- This helper does not claim the provider observed the selected speed.+computeCostAtSpeed :: Model -> Speed -> Usage -> Cost+computeCostAtSpeed = priceAtSpeed Nothing++priceAtSpeed :: Maybe CacheRetention -> Model -> Speed -> Usage -> Cost+priceAtSpeed duration m SpeedStandard u = computeCostWith duration m u+priceAtSpeed duration m SpeedFast u = case m ^. #fastModeCost of+  Nothing -> estimateCost [UnsupportedSpeed "fast"] (computeCostWith duration m u)+  Just fast ->+    let resolved = do+          validatePricingPolicy (PricingPolicy [InputPriceTier 0 fast] Nothing)+          standard <- resolveRates duration m u+          let base = m ^. #cost+              -- Apply each premium rate's ratio to the resolved policy once.+              -- A zero base cannot define a ratio for a nonzero policy rate.+              scale b f r+                | b > 0 = Right (r * f / b)+                | r == 0 = Right f+                | otherwise = Left "Cannot apply fast rates to a zero-base pricing policy"+          ModelCost+            <$> scale (inputCost base) (inputCost fast) (inputCost standard)+            <*> scale (outputCost base) (outputCost fast) (outputCost standard)+            <*> scale (cacheReadCost base) (cacheReadCost fast) (cacheReadCost standard)+            <*> scale (cacheWriteCost base) (cacheWriteCost fast) (cacheWriteCost standard)+        computed = priceUsage resolved u+     in computed & #basis . #sources .~ Set.singleton ResolvedTokenRates++-- | Price one resolved rate record exactly once.+computeCostAtRates :: ModelCost -> Usage -> Cost+computeCostAtRates rates u =+  let resolved = validatePricingPolicy (PricingPolicy [InputPriceTier 0 rates] Nothing) >> pure rates+      computed = priceUsage resolved u+   in computed & #basis . #sources .~ Set.singleton ResolvedTokenRates++priceUsage :: Either Text ModelCost -> Usage -> Cost+priceUsage resolved u =+  let selected = either (const zeroModelCost) id resolved+      problems = [InvalidPricingPolicy | Left _ <- [resolved]] <> [PricingUnavailable | selected == ModelCost 0 0 0 0]+      rates = selected       inRate = inputCost rates       outRate = outputCost rates       crRate = cacheReadCost rates@@ -34,16 +106,50 @@       cachedUsd = toRational (u ^. #cacheReadTokens) * crRate / 1_000_000       cacheWriteUsd = toRational (u ^. #cacheWriteTokens) * cwRate / 1_000_000       total = inUsd + outUsd + cachedUsd + cacheWriteUsd-   in Cost-        { usd = total,-          breakdown =-            CostBreakdown-              { inputUsd = inUsd,-                outputUsd = outUsd,-                cachedInputUsd = cachedUsd,-                cachedWriteUsd = cacheWriteUsd-              }-        }+   in estimateCost+        (problems <> usageProblems u)+        Cost+          { usd = total,+            basis = standardCostBasis,+            breakdown =+              CostBreakdown+                { inputUsd = inUsd,+                  outputUsd = outUsd,+                  cachedInputUsd = cachedUsd,+                  cachedWriteUsd = cacheWriteUsd+                }+          }++-- | Legacy, manually constructed usages have no availability annotation.+-- Normalized provider usages always carry one, even for an entirely absent body.+usageProblems :: Usage -> [CostEstimateReason]+usageProblems u = case u ^. #availability of+  Nothing -> []+  Just facts ->+    [InconsistentUsage | inconsistent facts]+      <> if Set.size (missingCategories facts) == 4+        then [UsageNotReported]+        else map reason (Set.toList (missingCategories facts))+  where+    reason InputUsage = InputUsageNotReported+    reason OutputUsage = OutputUsageNotReported+    reason CacheReadUsage = CacheReadUsageNotReported+    reason CacheWriteUsage = CacheWriteUsageNotReported++-- | Choose one complete rate record. Thresholds are exclusive and use+-- disjoint normalized input categories, including both cache counters.+resolveRates :: Maybe CacheRetention -> Model -> Usage -> Either Text ModelCost+resolveRates duration m u = do+  validatePricingPolicy (PricingPolicy [InputPriceTier 0 (m ^. #cost)] Nothing)+  case m ^. #pricingPolicy of+    Nothing -> pure (m ^. #cost)+    Just policy -> do+      validatePricingPolicy policy+      let totalInput = (u ^. #inputTokens) + (u ^. #cacheReadTokens) + (u ^. #cacheWriteTokens)+          selected = foldl' (\current tier -> if totalInput > inputAbove tier then rates tier else current) (m ^. #cost) (inputTiers policy)+      pure $ case (duration, longCacheWriteCost policy) of+        (Just CacheRetentionLong, Just price) -> selected {cacheWriteCost = price}+        _ -> selected  -- | Replace the assistant response payload's embedded 'Cost' with one -- computed from the supplied model.

@@ -106,7 +106,10 @@     -- header in either its integer or its HTTP-date form.     retryAfterSeconds :: !(Maybe Int),     -- | The subprocess exit code, for 'ProcessFailure'.-    exitCode :: !(Maybe Int)+    exitCode :: !(Maybe Int),+    -- | Provider-reported refusal category, an open vocabulary. Present only+    -- when a content refusal names one; never inferred from message text.+    refusalCategory :: !(Maybe Text)   }   deriving stock (Eq, Show, Generic) @@ -133,7 +136,8 @@       message = m,       httpStatus = Nothing,       retryAfterSeconds = Nothing,-      exitCode = Nothing+      exitCode = Nothing,+      refusalCategory = Nothing     }  -- Smart constructors. These keep call sites close to the old API: an

@@ -259,19 +259,20 @@ -- between the canonical 'ThinkingLevel' and the wire. -- -- This is the type that makes an otherwise silent downgrade visible.--- Every constructor corresponds to a real site in this repository--- where a request is weakened, dropped, or made indistinguishable from--- the provider's own default.+-- Request adjustments correspond to sites where a request is weakened,+-- dropped, or made indistinguishable from the provider's own default.+-- 'ThinkingSummaryUnavailable' is instead a response-only diagnostic. -- -- Levels are carried as 'ThinkingLevel' rather than text so that -- strict evidence mode can compare them; they render through -- 'Baikai.ThinkingLevel.renderThinkingLevel' in JSON. ----- Two constructors are not about thinking: the sampling drops record+-- Sampling and speed drops are not about thinking: sampling drops record -- that @temperature@, @top_p@, @seed@ and their kind were removed -- because the model generation or the API rejects them. They carry no -- requested level and 'weakensThinking' is 'False' for them, so strict--- evidence mode does not refuse a call over one.+-- evidence mode does not refuse a call over one. Fast-mode drops follow+-- the same rule: losing speed does not weaken reasoning. data ThinkingAdjustment   = -- | The requested level was replaced by a weaker one the transport     -- accepts. Carries the requested level and the wire text sent.@@ -306,6 +307,11 @@     -- @presence_penalty@. Carries the wire names removed, in wire     -- order.     SamplingDroppedUnsupportedApi ![Text]+  | -- | Fast speed was requested but the model does not support it.+    FastModeDroppedUnsupportedModel+  | -- | Response-only diagnostic: completed thinking blocks carried no+    -- readable summary. This says nothing about reasoning depth or billing.+    ThinkingSummaryUnavailable   deriving stock (Eq, Show, Generic)  -- | Whether an adjustment weakens the /thinking/ the caller asked for.@@ -313,7 +319,7 @@ -- Strict evidence mode refuses a call whose translation would weaken -- the requested thinking level; it must not refuse one merely because -- a sampling parameter had nowhere to go. The six level-carrying--- constructors weaken thinking; the two sampling ones do not.+-- constructors weaken thinking; the sampling and speed ones do not. weakensThinking :: ThinkingAdjustment -> Bool weakensThinking = \case   EffortClamped {} -> True@@ -324,6 +330,8 @@   ThinkingDroppedBudgetExceeded {} -> True   SamplingDroppedUnsupportedModel {} -> False   SamplingDroppedUnsupportedApi {} -> False+  FastModeDroppedUnsupportedModel -> False+  ThinkingSummaryUnavailable -> False  -- | Adjustments encode as a tagged object whose @kind@ names the -- constructor in snake_case and whose @requested@ field carries the@@ -349,6 +357,10 @@       untagged "sampling_dropped_unsupported_model" fields     SamplingDroppedUnsupportedApi fields ->       untagged "sampling_dropped_unsupported_api" fields+    ThinkingSummaryUnavailable ->+      object ["kind" .= ("thinking_summary_unavailable" :: Text)]+    FastModeDroppedUnsupportedModel ->+      object ["kind" .= ("fast_mode_dropped_unsupported_model" :: Text)]     where       tagged kind lvl extra =         object@@ -382,6 +394,8 @@           SamplingDroppedUnsupportedModel <$> o .: "fields"         "sampling_dropped_unsupported_api" ->           SamplingDroppedUnsupportedApi <$> o .: "fields"+        "thinking_summary_unavailable" -> pure ThinkingSummaryUnavailable+        "fast_mode_dropped_unsupported_model" -> pure FastModeDroppedUnsupportedModel         other -> fail ("unknown thinking adjustment: " <> show other)     v -> typeMismatch "ThinkingAdjustment" v @@ -421,9 +435,14 @@     -- in, for example @"thinking"@, @"reasoning_effort"@, or     -- @"--effort"@. 'Nothing' when nothing was sent.     wireField :: !(Maybe Text),+    -- | Exact display setting sent, such as Anthropic's @summarized@.+    -- Nothing means no display setting was sent, not a provider observation.+    displayText :: !(Maybe Text),     -- | Everything that happened to the request between the canonical-    -- level and the wire, in the order it was applied. Empty means the-    -- request was expressed exactly.+    -- level and the wire, in the order it was applied, followed by any+    -- response diagnostics. Empty means no adjustment or diagnostic was recorded.+    -- The provider may append ThinkingSummaryUnavailable after successful+    -- assembly; it never changes the request fields or observed effort.     --     -- Reasoning /and/ sampling changes travel here: a     -- 'SamplingDroppedUnsupportedModel' entry can appear on a call@@ -437,13 +456,15 @@ instance ToJSON ThinkingTranslation where   toJSON t =     object-      [ "requested" .= fmap renderThinkingLevel (requested t),-        "mode" .= mode t,-        "effort_text" .= effortText t,-        "budget_tokens" .= budgetTokens t,-        "wire_field" .= wireField t,-        "adjustments" .= adjustments t-      ]+      ( [ "requested" .= fmap renderThinkingLevel (requested t),+          "mode" .= mode t,+          "effort_text" .= effortText t,+          "budget_tokens" .= budgetTokens t,+          "wire_field" .= wireField t,+          "adjustments" .= adjustments t+        ]+          <> maybe [] (\d -> ["display_text" .= d]) (displayText t)+      )  instance FromJSON ThinkingTranslation where   parseJSON = \case@@ -455,6 +476,7 @@         <*> o .:? "effort_text"         <*> o .:? "budget_tokens"         <*> o .:? "wire_field"+        <*> o .:? "display_text"         <*> o .: "adjustments"     v -> typeMismatch "ThinkingTranslation" v @@ -476,6 +498,7 @@       effortText = Nothing,       budgetTokens = Nothing,       wireField = Nothing,+      displayText = Nothing,       adjustments = []     } @@ -496,6 +519,7 @@         effortText = Nothing,         budgetTokens = Nothing,         wireField = Nothing,+        displayText = Nothing,         adjustments = []       } @@ -506,12 +530,12 @@ -- not reported by the provider, so including it made -- @response_commitment@ change whenever pricing was edited and left a -- verifier holding only the response unable to recompute it. The six--- counts are listed through record selectors rather than encoded+-- counts and optional availability facts are listed through record selectors rather than encoded -- wholesale, so a field added to 'Usage' later does not silently join -- the digest. usageEnvelope :: Usage -> Value usageEnvelope u =-  object+  object $     [ "input_tokens" .= Usage.inputTokens u,       "output_tokens" .= Usage.outputTokens u,       "cache_read_tokens" .= Usage.cacheReadTokens u,@@ -519,6 +543,7 @@       "reasoning_tokens" .= Usage.reasoningTokens u,       "total_tokens" .= Usage.totalTokens u     ]+      <> maybe [] (\facts -> ["availability" .= facts]) (Usage.availability u)  -- ============================================================ -- Endpoint and transport@@ -760,6 +785,7 @@ declaredStrength = \case   AnthropicMessages -> EvidenceModelObserved   OpenAIChatCompletions -> EvidenceModelObserved+  OpenAIResponses -> EvidenceModelObserved   AnthropicMessagesCli -> EvidenceModelObserved   OpenAICompletionsCli -> EvidenceCorrelated   Custom _ -> EvidenceRequestedOnly@@ -876,7 +902,21 @@ -- further compatible addition rides along: @thinking.mode@ may now be -- @"not_translated"@. evidenceSchemaVersion :: Text-evidenceSchemaVersion = "baikai.model-call-evidence/2.0"+-- Version 2.1 adds optional provider-scoped replay_state to thinking+-- content. It participates in content commitments, but is omitted when+-- absent, preserving every pre-existing content encoding and digest.+-- Version 2.2 adds the local cost calculation basis to serialized usage.+-- Like the local numeric cost, this basis is excluded from response commitments.+-- Optional provider availability facts do join usage commitments. Their absence+-- preserves the six-field envelope and every legacy usage digest.+-- Version 2.3 adds fast-mode drops and speed-unreported cost estimates.+-- Newly emitted speed fields join the configuration projection; envelopes+-- without speed retain their existing digests.+-- Version 2.4 adds optional thinking.display_text and a response-only+-- thinking_summary_unavailable diagnostic; existing digest rules are unchanged.+-- Version 2.5 adds error_info.refusal_category, an optional provider fact.+-- Older error objects decode with Nothing; digest inputs are unchanged.+evidenceSchemaVersion = "baikai.model-call-evidence/2.5"  -- | Everything Baikai can say about one completed provider call. --@@ -1251,6 +1291,7 @@       "reasoning",       "reasoning_effort",       "seed",+      "speed",       "stop_sequences",       "stream",       "temperature",

@@ -418,6 +418,8 @@   SamplingDroppedUnsupportedModel fields ->     Text.intercalate ", " fields       <> " would be dropped, because this model generation rejects sampling parameters"+  ThinkingSummaryUnavailable -> "the response contained thinking blocks but no readable summary"+  FastModeDroppedUnsupportedModel -> "fast mode would be dropped, because this model does not support it"   SamplingDroppedUnsupportedApi fields ->     Text.intercalate ", " fields       <> " would be dropped, because this API has no such field on any generation"

@@ -21,6 +21,8 @@     reasoning,     input,     cost,+    fastModeCost,+    pricingPolicy,     contextWindow,     maxOutputTokens,     headers,@@ -31,6 +33,9 @@     -- * Cost rates     ModelCost (..),     zeroModelCost,+    PricingPolicy (..),+    InputPriceTier (..),+    validatePricingPolicy,      -- * Capabilities     InputModality (..),@@ -38,6 +43,7 @@     -- * Compatibility shim     Compat (..),     openaiCompletionsCompatFor,+    openaiResponsesCompatFor,     anthropicMessagesCompatFor,   ) where@@ -47,17 +53,24 @@ import Baikai.Compat   ( AnthropicMessagesCompat,     OpenAICompletionsCompat,+    OpenAIResponsesCompat,     autoDetectAnthropicMessages,     autoDetectOpenAICompletions,+    defaultOpenAIResponsesCompat,   ) import Baikai.Header (HeaderName)+import Control.Monad (unless) import Data.Aeson-  ( FromJSON,+  ( FromJSON (parseJSON),     ToJSON (toEncoding, toJSON),     defaultOptions,     genericToEncoding,     genericToJSON,+    withObject,+    (.!=),+    (.:?),   )+import Data.List (nub, sort) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text (Text)@@ -82,6 +95,37 @@   deriving stock (Eq, Show, Generic)   deriving anyclass (FromJSON, ToJSON) +-- | An exclusive input-context threshold. Its complete rate record+-- applies to every token category in the call once total input exceeds it.+data InputPriceTier = InputPriceTier+  { inputAbove :: !Natural,+    rates :: !ModelCost+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (FromJSON, ToJSON)++-- | Optional catalog policy layered over Model.cost. Long cache-write+-- pricing is an absolute per-million rate, selected only for a shaped+-- long-duration request. It overrides the selected tier's write rate.+data PricingPolicy = PricingPolicy+  { inputTiers :: ![InputPriceTier],+    longCacheWriteCost :: !(Maybe Rational)+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (ToJSON)++instance FromJSON PricingPolicy where+  parseJSON = withObject "PricingPolicy" $ \o -> do+    p <- PricingPolicy <$> o .:? "inputTiers" .!= [] <*> o .:? "longCacheWriteCost"+    either (fail . show) (const (pure p)) (validatePricingPolicy p)++validatePricingPolicy :: PricingPolicy -> Either Text ()+validatePricingPolicy p = do+  let thresholds = map inputAbove (inputTiers p)+      validRates r = all (>= 0) [inputCost r, outputCost r, cacheReadCost r, cacheWriteCost r]+  unless (thresholds == sort (nub thresholds)) (Left "Pricing thresholds must be strictly increasing")+  unless (all (validRates . rates) (inputTiers p) && maybe True (>= 0) (longCacheWriteCost p)) (Left "Pricing rates must be nonnegative")+ -- | Per-API compatibility shim. 'CompatNone' tells the provider to -- pick a sensible record by inspecting 'baseUrl'; the two real -- constructors carry an explicit per-host record that overrides the@@ -90,6 +134,7 @@ -- dependency. data Compat   = CompatNone+  | CompatOpenAIResponses !OpenAIResponsesCompat   | CompatOpenAICompletions !OpenAICompletionsCompat   | CompatAnthropicMessages !AnthropicMessagesCompat   deriving stock (Eq, Show, Generic)@@ -103,6 +148,12 @@   CompatOpenAICompletions c -> c   _ -> autoDetectOpenAICompletions (baseUrl m) +-- | Explicit Responses facts or the native Responses defaults.+openaiResponsesCompatFor :: Model -> OpenAIResponsesCompat+openaiResponsesCompatFor m = case compat m of+  CompatOpenAIResponses c -> c+  _ -> defaultOpenAIResponsesCompat+ -- | Project the 'AnthropicMessagesCompat' that applies to a 'Model': -- the explicit one if 'compat' is 'CompatAnthropicMessages', -- otherwise the result of inspecting 'baseUrl' via@@ -133,6 +184,9 @@     reasoning :: !Bool,     input :: ![InputModality],     cost :: !ModelCost,+    -- | Optional premium speed rates, in USD per million tokens.+    fastModeCost :: !(Maybe ModelCost),+    pricingPolicy :: !(Maybe PricingPolicy),     contextWindow :: !Natural,     -- | The provider's cap on output tokens for this model, or @0@     -- when it is unknown (a hand-rolled model built from@@ -181,6 +235,8 @@         . next "reasoning" (reasoning m)         . next "input" (input m)         . next "cost" (cost m)+        . next "fastModeCost" (fastModeCost m)+        . next "pricingPolicy" (pricingPolicy m)         . next "contextWindow" (contextWindow m)         . next "maxOutputTokens" (maxOutputTokens m)         . next "headers" (Auth.redactHeaderValues (headers m))@@ -230,6 +286,8 @@       reasoning = False,       input = [InputText],       cost = zeroModelCost,+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 0,       maxOutputTokens = 0,       headers = Map.empty,

@@ -11,6 +11,8 @@   ( AnthropicMessagesCompat       ( sendSessionAffinityHeaders,         supportsCacheControlOnTools,+        supportsFastMode,+        supportsForcedToolChoice,         supportsLongCacheRetention,         supportsSamplingParameters,         thinkingStyle@@ -22,34 +24,44 @@       ( cacheControlFormat,         maxTokensField,         requiresThinkingAsText,+        supportedReasoningEfforts,         supportsLongCacheRetention,+        supportsSamplingParameters,         supportsStrictMode,+        supportsToolCalls,         supportsUsageInStreaming,         thinkingFormat       ),+    OpenAIResponsesCompat (..),     ThinkingFormat (..),     defaultAnthropicMessagesCompat,     defaultOpenAICompletionsCompat,+    defaultOpenAIResponsesCompat,   ) import Baikai.Model   ( Compat (..),     InputModality (..),+    InputPriceTier (..),     Model,     ModelCost (..),+    PricingPolicy (..),     api,     baseUrl,     compat,     contextWindow,     cost,     emptyModel,+    fastModeCost,     headers,     input,     maxOutputTokens,     modelId,     name,+    pricingPolicy,     provider,     reasoning,   )+import Baikai.ThinkingLevel (ThinkingLevel (..)) import Data.Map.Strict qualified as Map import Data.Ratio ((%)) @@ -70,6 +82,8 @@             cacheReadCost = 1 % 1,             cacheWriteCost = 25 % 2           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1000000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -80,10 +94,47 @@               supportsCacheControlOnTools = True,               sendSessionAffinityHeaders = False,               thinkingStyle = AnthropicThinkingAdaptive,-              supportsSamplingParameters = False+              supportsSamplingParameters = False,+              supportsFastMode = False,+              supportsForcedToolChoice = True             }     } +anthropic_claude_fable_5_1 :: Model+anthropic_claude_fable_5_1 =+  emptyModel+    { modelId = "claude-fable-5-1",+      name = "Claude Fable 5.1",+      api = AnthropicMessages,+      provider = "anthropic",+      baseUrl = "https://api.anthropic.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 10 % 1,+            outputCost = 50 % 1,+            cacheReadCost = 1 % 4,+            cacheWriteCost = 25 % 2+          },+      fastModeCost = Nothing,+      pricingPolicy = Just (PricingPolicy [] (Just (20 % 1))),+      contextWindow = 1000000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat =+        CompatAnthropicMessages+          defaultAnthropicMessagesCompat+            { supportsLongCacheRetention = True,+              supportsCacheControlOnTools = True,+              sendSessionAffinityHeaders = False,+              thinkingStyle = AnthropicThinkingAdaptive,+              supportsSamplingParameters = False,+              supportsFastMode = False,+              supportsForcedToolChoice = False+            }+    }+ anthropic_claude_haiku_4_5 :: Model anthropic_claude_haiku_4_5 =   emptyModel@@ -101,6 +152,8 @@             cacheReadCost = 1 % 10,             cacheWriteCost = 5 % 4           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 200000,       maxOutputTokens = 64000,       headers = Map.empty,@@ -111,7 +164,9 @@               supportsCacheControlOnTools = True,               sendSessionAffinityHeaders = False,               thinkingStyle = AnthropicThinkingBudget,-              supportsSamplingParameters = True+              supportsSamplingParameters = True,+              supportsFastMode = False,+              supportsForcedToolChoice = True             }     } @@ -132,6 +187,8 @@             cacheReadCost = 1 % 2,             cacheWriteCost = 25 % 4           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 200000,       maxOutputTokens = 64000,       headers = Map.empty,@@ -142,7 +199,9 @@               supportsCacheControlOnTools = True,               sendSessionAffinityHeaders = False,               thinkingStyle = AnthropicThinkingBudget,-              supportsSamplingParameters = True+              supportsSamplingParameters = True,+              supportsFastMode = False,+              supportsForcedToolChoice = True             }     } @@ -163,6 +222,8 @@             cacheReadCost = 1 % 2,             cacheWriteCost = 25 % 4           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1000000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -173,7 +234,9 @@               supportsCacheControlOnTools = True,               sendSessionAffinityHeaders = False,               thinkingStyle = AnthropicThinkingAdaptive,-              supportsSamplingParameters = True+              supportsSamplingParameters = True,+              supportsFastMode = False,+              supportsForcedToolChoice = True             }     } @@ -194,6 +257,8 @@             cacheReadCost = 1 % 2,             cacheWriteCost = 25 % 4           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1000000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -204,7 +269,9 @@               supportsCacheControlOnTools = True,               sendSessionAffinityHeaders = False,               thinkingStyle = AnthropicThinkingAdaptive,-              supportsSamplingParameters = False+              supportsSamplingParameters = False,+              supportsFastMode = False,+              supportsForcedToolChoice = True             }     } @@ -225,6 +292,16 @@             cacheReadCost = 1 % 2,             cacheWriteCost = 25 % 4           },+      fastModeCost =+        Just+          ( ModelCost+              { inputCost = 10 % 1,+                outputCost = 50 % 1,+                cacheReadCost = 1 % 1,+                cacheWriteCost = 25 % 2+              }+          ),+      pricingPolicy = Just (PricingPolicy [] (Just (10 % 1))),       contextWindow = 1000000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -235,7 +312,9 @@               supportsCacheControlOnTools = True,               sendSessionAffinityHeaders = False,               thinkingStyle = AnthropicThinkingAdaptive,-              supportsSamplingParameters = False+              supportsSamplingParameters = False,+              supportsFastMode = True,+              supportsForcedToolChoice = True             }     } @@ -256,6 +335,16 @@             cacheReadCost = 1 % 2,             cacheWriteCost = 25 % 4           },+      fastModeCost =+        Just+          ( ModelCost+              { inputCost = 10 % 1,+                outputCost = 50 % 1,+                cacheReadCost = 1 % 1,+                cacheWriteCost = 25 % 2+              }+          ),+      pricingPolicy = Just (PricingPolicy [] (Just (10 % 1))),       contextWindow = 1000000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -266,7 +355,9 @@               supportsCacheControlOnTools = True,               sendSessionAffinityHeaders = False,               thinkingStyle = AnthropicThinkingAdaptive,-              supportsSamplingParameters = False+              supportsSamplingParameters = False,+              supportsFastMode = True,+              supportsForcedToolChoice = True             }     } @@ -287,6 +378,8 @@             cacheReadCost = 3 % 10,             cacheWriteCost = 15 % 4           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1000000,       maxOutputTokens = 64000,       headers = Map.empty,@@ -297,7 +390,9 @@               supportsCacheControlOnTools = True,               sendSessionAffinityHeaders = False,               thinkingStyle = AnthropicThinkingBudget,-              supportsSamplingParameters = True+              supportsSamplingParameters = True,+              supportsFastMode = False,+              supportsForcedToolChoice = True             }     } @@ -318,6 +413,8 @@             cacheReadCost = 3 % 10,             cacheWriteCost = 15 % 4           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1000000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -328,7 +425,9 @@               supportsCacheControlOnTools = True,               sendSessionAffinityHeaders = False,               thinkingStyle = AnthropicThinkingAdaptive,-              supportsSamplingParameters = True+              supportsSamplingParameters = True,+              supportsFastMode = False,+              supportsForcedToolChoice = True             }     } @@ -349,6 +448,8 @@             cacheReadCost = 1 % 5,             cacheWriteCost = 5 % 2           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1000000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -359,7 +460,9 @@               supportsCacheControlOnTools = True,               sendSessionAffinityHeaders = False,               thinkingStyle = AnthropicThinkingAdaptive,-              supportsSamplingParameters = False+              supportsSamplingParameters = False,+              supportsFastMode = False,+              supportsForcedToolChoice = True             }     } @@ -380,6 +483,8 @@             cacheReadCost = 7 % 100,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 64000,       maxOutputTokens = 8192,       headers = Map.empty,@@ -403,6 +508,8 @@             cacheReadCost = 7 % 50,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 64000,       maxOutputTokens = 8192,       headers = Map.empty,@@ -426,6 +533,8 @@             cacheReadCost = 1 % 2,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1047576,       maxOutputTokens = 32768,       headers = Map.empty,@@ -449,6 +558,8 @@             cacheReadCost = 1 % 10,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1047576,       maxOutputTokens = 32768,       headers = Map.empty,@@ -472,6 +583,8 @@             cacheReadCost = 1 % 40,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1047576,       maxOutputTokens = 32768,       headers = Map.empty,@@ -495,6 +608,8 @@             cacheReadCost = 5 % 4,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 128000,       maxOutputTokens = 16384,       headers = Map.empty,@@ -518,6 +633,8 @@             cacheReadCost = 3 % 40,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 128000,       maxOutputTokens = 16384,       headers = Map.empty,@@ -541,6 +658,8 @@             cacheReadCost = 1 % 8,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 400000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -564,6 +683,8 @@             cacheReadCost = 1 % 8,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 400000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -587,6 +708,8 @@             cacheReadCost = 7 % 40,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 400000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -610,6 +733,8 @@             cacheReadCost = 1 % 4,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1050000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -633,6 +758,8 @@             cacheReadCost = 3 % 40,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 400000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -656,6 +783,8 @@             cacheReadCost = 1 % 50,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 400000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -679,6 +808,8 @@             cacheReadCost = 1 % 2,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1050000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -702,6 +833,8 @@             cacheReadCost = 2 % 5,             cacheWriteCost = 5 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1050000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -725,6 +858,8 @@             cacheReadCost = 1 % 50,             cacheWriteCost = 1 % 4           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1050000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -748,6 +883,8 @@             cacheReadCost = 2 % 5,             cacheWriteCost = 5 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1050000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -771,6 +908,8 @@             cacheReadCost = 1 % 5,             cacheWriteCost = 5 % 2           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 1050000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -794,6 +933,8 @@             cacheReadCost = 1 % 40,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 400000,       maxOutputTokens = 128000,       headers = Map.empty,@@ -817,12 +958,46 @@             cacheReadCost = 1 % 200,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 400000,       maxOutputTokens = 128000,       headers = Map.empty,       compat = CompatNone     } +openai_gpt_6_astra :: Model+openai_gpt_6_astra =+  emptyModel+    { modelId = "gpt-6-astra",+      name = "GPT-6 Astra",+      api = OpenAIResponses,+      provider = "openai",+      baseUrl = "https://api.openai.com",+      reasoning = True,+      input = [InputText, InputImage],+      cost =+        ModelCost+          { inputCost = 10 % 1,+            outputCost = 50 % 1,+            cacheReadCost = 1 % 1,+            cacheWriteCost = 25 % 2+          },+      fastModeCost = Nothing,+      pricingPolicy = Just (PricingPolicy [InputPriceTier 272000 (ModelCost (20 % 1) (75 % 1) (2 % 1) (25 % 1))] Nothing),+      contextWindow = 1050000,+      maxOutputTokens = 128000,+      headers = Map.empty,+      compat =+        CompatOpenAIResponses+          defaultOpenAIResponsesCompat+            { supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax],+              supportsSamplingParameters = False,+              supportsLongCacheRetention = False,+              supportsPromptCacheOptions = True+            }+    }+ openai_o1 :: Model openai_o1 =   emptyModel@@ -840,6 +1015,8 @@             cacheReadCost = 15 % 2,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 200000,       maxOutputTokens = 100000,       headers = Map.empty,@@ -863,6 +1040,8 @@             cacheReadCost = 1 % 2,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 200000,       maxOutputTokens = 100000,       headers = Map.empty,@@ -886,6 +1065,8 @@             cacheReadCost = 11 % 20,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 200000,       maxOutputTokens = 100000,       headers = Map.empty,@@ -909,6 +1090,8 @@             cacheReadCost = 11 % 40,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 200000,       maxOutputTokens = 100000,       headers = Map.empty,@@ -932,6 +1115,8 @@             cacheReadCost = 3 % 10,             cacheWriteCost = 15 % 4           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 200000,       maxOutputTokens = 8192,       headers = Map.empty,@@ -955,6 +1140,8 @@             cacheReadCost = 3 % 40,             cacheWriteCost = 0 % 1           },+      fastModeCost = Nothing,+      pricingPolicy = Nothing,       contextWindow = 128000,       maxOutputTokens = 16384,       headers = Map.empty,@@ -965,6 +1152,7 @@ allModels :: [Model] allModels =   [ anthropic_claude_fable_5,+    anthropic_claude_fable_5_1,     anthropic_claude_haiku_4_5,     anthropic_claude_opus_4_5,     anthropic_claude_opus_4_6,@@ -994,6 +1182,7 @@     openai_gpt_5_6_terra,     openai_gpt_5_mini,     openai_gpt_5_nano,+    openai_gpt_6_astra,     openai_o1,     openai_o3,     openai_o3_mini,

@@ -56,6 +56,7 @@     toolChoice,     cacheRetention,     thinking,+    speed,     responseFormat,     evidence,     topP,@@ -73,6 +74,7 @@ import Baikai.Evidence (EvidenceRequest) import Baikai.Header (HeaderName) import Baikai.ResponseFormat (ResponseFormat)+import Baikai.Speed (Speed) import Baikai.ThinkingLevel (ThinkingLevel) import Baikai.Tool (ToolChoice) import Data.Aeson@@ -104,6 +106,10 @@     -- both send no cache-control marker. The constructor is kept for a     -- caller who wants to say "no caching" explicitly.     cacheRetention :: !(Maybe CacheRetention),+    -- | Nothing omits the speed field; standard explicitly requests standard+    -- speed. Fast is catalog-gated by Anthropic and dropped with evidence on+    -- unsupported models. See "Baikai.Speed" for availability and pricing.+    speed :: !(Maybe Speed),     thinking :: !(Maybe ThinkingLevel),     responseFormat :: !(Maybe ResponseFormat),     evidence :: !(Maybe EvidenceRequest),@@ -144,6 +150,7 @@         . next "metadata" (metadata o)         . next "toolChoice" (toolChoice o)         . next "cacheRetention" (cacheRetention o)+        . next "speed" (speed o)         . next "thinking" (thinking o)         . next "responseFormat" (responseFormat o)         . next "evidence" (evidence o)@@ -179,6 +186,7 @@       metadata = Map.empty,       toolChoice = Nothing,       cacheRetention = Nothing,+      speed = Nothing,       thinking = Nothing,       responseFormat = Nothing,       evidence = Nothing,

@@ -40,7 +40,7 @@     UserContent (..),   ) import Baikai.Context (Context)-import Baikai.Cost (Cost (..), zeroCost, zeroCostBreakdown)+import Baikai.Cost (Cost (..), providerReportedBasis, zeroCost, zeroCostBreakdown) import Baikai.Error (BaikaiError, decodeError) import Baikai.Evidence (EvidenceStrength (..), Observed (..), deriveStrength, usageEnvelope) import Baikai.Message@@ -418,6 +418,7 @@           cacheWriteTokens = written,           reasoningTokens = natFieldMaybe u "reasoning_output_tokens",           totalTokens = nonCached + out + cached + written,+          availability = Nothing,           cost = zeroCost         } @@ -538,12 +539,13 @@                   cacheWriteTokens = cw,                   reasoningTokens = Nothing,                   totalTokens = i + out + cr + cw,+                  availability = Nothing,                   cost = reportedCost                 }   _ -> Nothing   where     reportedCost = case KeyMap.lookup "total_cost_usd" o of-      Just (Number n) | n > 0 -> Cost {usd = toRational n, breakdown = zeroCostBreakdown}+      Just (Number n) | n >= 0 -> Cost {usd = toRational n, breakdown = zeroCostBreakdown, basis = providerReportedBasis}       _ -> zeroCost  claudeUsageKeys :: [Key]

@@ -0,0 +1,13 @@+-- | Provider-independent inference speed preference. Anthropic sends fast mode+-- only for catalog entries advertising it (currently Opus 5 and Opus 4.8).+-- Their published fast rates are twice standard rates. Unsupported fast+-- requests are dropped with an evidence adjustment. Other providers omit it.+-- A request is a preference; only provider usage reports which speed ran.+module Baikai.Speed (Speed (..)) where++import Data.Aeson (FromJSON, ToJSON)+import GHC.Generics (Generic)++data Speed = SpeedStandard | SpeedFast+  deriving stock (Eq, Show, Generic)+  deriving anyclass (FromJSON, ToJSON)

@@ -370,7 +370,7 @@     thinkingBlock t       | Text.null t = Nothing       | otherwise =-          Just (AssistantThinking ThinkingContent {thinking = t, signature = Nothing, redacted = False})+          Just (AssistantThinking ThinkingContent {thinking = t, signature = Nothing, redacted = False, replayState = Nothing})      toolBlock raw       | Text.null raw = Nothing

@@ -57,6 +57,7 @@  import Baikai.Context (Context) import Baikai.Cost (usdAsScientific)+import Baikai.Cost qualified as Cost import Baikai.Cost.Log   ( CallLogEntry (..),     CallLogHandle,@@ -265,6 +266,15 @@                   provider = m ^. #provider,                   model = m ^. #modelId,                   latencyMs = millisBetween start now,+                  inputTokens = Nothing,+                  outputTokens = Nothing,+                  cachedInputTokens = Nothing,+                  cacheWriteTokens = Nothing,+                  reasoningTokens = Nothing,+                  totalTokens = Nothing,+                  costBasis = Nothing,+                  usageAvailability = Nothing,+                  usd = Nothing,                   errorMessage = abortText                 }         -- The consumer stopped before the terminal event, so no adapter@@ -500,6 +510,8 @@                 -- baikai could not compute — and the subscription-based                 -- CLI providers always compute zero, so that was the                 -- common case rather than a corner.+                costBasis = mu >>= Cost.nonEmptyBasis . Usage.cost,+                usageAvailability = mu >>= Usage.availability,                 usd = fmap (usdAsScientific . Usage.cost) mu               }       -- Evidence goes out *before* the terminal, so a sink that keys@@ -517,6 +529,7 @@     EventError TerminalPayload {message = msg, evidence = mev} -> do       now <- getCurrentTime       let latency = millisBetween start now+          mu = assistantUsageFromMsg msg           errMsg = case msg of             AssistantMessage AssistantPayload {errorMessage = Just t} -> t             _ -> "stream terminated with EventError"@@ -527,6 +540,15 @@                 provider = m ^. #provider,                 model = m ^. #modelId,                 latencyMs = latency,+                inputTokens = fmap Usage.inputTokens mu,+                outputTokens = fmap Usage.outputTokens mu,+                cachedInputTokens = fmap Usage.cacheReadTokens mu,+                cacheWriteTokens = fmap Usage.cacheWriteTokens mu,+                reasoningTokens = mu >>= Usage.reasoningTokens,+                totalTokens = fmap Usage.totalTokens mu,+                costBasis = mu >>= Cost.nonEmptyBasis . Usage.cost,+                usageAvailability = mu >>= Usage.availability,+                usd = fmap (usdAsScientific . Usage.cost) mu,                 errorMessage = errMsg               }       commitTerminal state eid now m mev failed@@ -601,6 +623,9 @@             inputTokens = mu >>= positiveNat . Usage.inputTokens,             outputTokens = mu >>= positiveNat . Usage.outputTokens,             cachedInputTokens = mu >>= positiveNat . Usage.cacheReadTokens,+            cacheWriteTokens = fmap Usage.cacheWriteTokens mu,+            costBasis = mu >>= Cost.nonEmptyBasis . Usage.cost,+            usageAvailability = mu >>= Usage.availability,             reasoningTokens = mu >>= Usage.reasoningTokens,             -- Report a zero cost as zero. Suppressing it made "this             -- call was free" indistinguishable from "baikai could not

@@ -15,7 +15,9 @@   ) where +import Baikai.Cost (CostBasis) import Baikai.Evidence (ModelCallEvidence)+import Baikai.Usage (UsageAvailability) import Data.Aeson   ( FromJSON (parseJSON),     Options (..),@@ -83,6 +85,8 @@         cacheWriteTokens :: !(Maybe Natural),         reasoningTokens :: !(Maybe Natural),         totalTokens :: !(Maybe Natural),+        costBasis :: !(Maybe CostBasis),+        usageAvailability :: !(Maybe UsageAvailability),         usd :: !(Maybe Scientific)       }   | CallFailed@@ -91,6 +95,15 @@         provider :: !Text,         model :: !Text,         latencyMs :: !Int,+        inputTokens :: !(Maybe Natural),+        outputTokens :: !(Maybe Natural),+        cachedInputTokens :: !(Maybe Natural),+        cacheWriteTokens :: !(Maybe Natural),+        reasoningTokens :: !(Maybe Natural),+        totalTokens :: !(Maybe Natural),+        costBasis :: !(Maybe CostBasis),+        usageAvailability :: !(Maybe UsageAvailability),+        usd :: !(Maybe Scientific),         errorMessage :: !Text       }   | -- | The complete evidence record for one terminal provider call.@@ -182,6 +195,8 @@           <*> d .:? "cacheWriteTokens"           <*> d .:? "reasoningTokens"           <*> d .:? "totalTokens"+          <*> d .:? "costBasis"+          <*> d .:? "usageAvailability"           <*> d .:? "usd"       "call_failed" ->         CallFailed@@ -190,6 +205,15 @@           <*> d .: "provider"           <*> d .: "model"           <*> d .: "latencyMs"+          <*> d .:? "inputTokens"+          <*> d .:? "outputTokens"+          <*> d .:? "cachedInputTokens"+          <*> d .:? "cacheWriteTokens"+          <*> d .:? "reasoningTokens"+          <*> d .:? "totalTokens"+          <*> d .:? "costBasis"+          <*> d .:? "usageAvailability"+          <*> d .:? "usd"           <*> d .: "errorMessage"       "call_evidence" ->         fail

@@ -22,20 +22,55 @@ -- every cost-reading caller would have to handle. 'Baikai.Cost.Pricing.computeCost' -- depends on the token classes being disjoint so each class is billed -- exactly once.-module Baikai.Usage (Usage (..), zeroUsage, sumUsage) where+module Baikai.Usage (Usage (..), UsageAvailability (..), UsageCategory (..), BillingFact (..), observeBilling, zeroUsage, sumUsage) where  import Baikai.Cost (Cost, zeroCost)-import Data.Aeson-  ( Options (fieldLabelModifier),-    ToJSON (toJSON),-    camelTo2,-    defaultOptions,-    genericToJSON,-  )+import Data.Aeson (FromJSON (parseJSON), Options (constructorTagModifier, fieldLabelModifier), ToJSON (toJSON), camelTo2, defaultOptions, genericToJSON, (.!=), (.:), (.:?))+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KeyMap import Data.Maybe (fromMaybe)+import Data.Set (Set)+import Data.Set qualified as Set+import Data.Text (Text) import GHC.Generics (Generic) import Numeric.Natural (Natural) +-- | Billed categories whose omission affects the local calculation.+data UsageCategory = InputUsage | OutputUsage | CacheReadUsage | CacheWriteUsage+  deriving stock (Eq, Ord, Show, Generic)++-- | Provider observations, independent of the requested tier and local rates.+data BillingFact = BillingServiceTier Text | BillingSpeed Text | BillingServerToolUse+  deriving stock (Eq, Ord, Show, Generic)++instance FromJSON BillingFact where parseJSON = Aeson.genericParseJSON usageOptions++instance ToJSON BillingFact where toJSON = genericToJSON usageOptions++-- | Provider facts, independent of local prices. Missing categories are not+-- observed zeroes; inconsistent counters cannot support an exact calculation.+data UsageAvailability = UsageAvailability+  { missingCategories :: !(Set UsageCategory),+    inconsistent :: !Bool,+    billingFacts :: !(Set BillingFact)+  }+  deriving stock (Eq, Show, Generic)++instance FromJSON UsageCategory where parseJSON = Aeson.genericParseJSON usageOptions++instance ToJSON UsageCategory where toJSON = genericToJSON usageOptions++instance FromJSON UsageAvailability where+  parseJSON = Aeson.withObject "UsageAvailability" $ \o -> UsageAvailability <$> o .: "missing_categories" <*> o .: "inconsistent" <*> o .:? "billing_facts" .!= Set.empty++instance ToJSON UsageAvailability where+  toJSON facts = case genericToJSON usageOptions facts of+    Aeson.Object o | Set.null (billingFacts facts) -> Aeson.Object (KeyMap.delete "billing_facts" o)+    value -> value++instance Semigroup UsageAvailability where+  a <> b = UsageAvailability (missingCategories a <> missingCategories b) (inconsistent a || inconsistent b) (billingFacts a <> billingFacts b)+ -- | Provider-normalized token usage for one model call. -- -- The prompt-side classes are disjoint: 'inputTokens' excludes@@ -62,16 +97,21 @@     -- 'inputTokens' + 'outputTokens' + 'cacheReadTokens' +     -- 'cacheWriteTokens'.     totalTokens :: !Natural,-    -- | Computed cost for this usage. Providers without pricing data-    -- use 'zeroCost'.+    -- | Availability of provider billing facts. Nothing is the legacy/manual+    -- representation; normalized API responses always carry an annotation.+    availability :: !(Maybe UsageAvailability),+    -- | Computed cost. Incomplete usage or prices carry estimation reasons.     cost :: !Cost   }   deriving stock (Eq, Show, Generic)  usageOptions :: Options-usageOptions = defaultOptions {fieldLabelModifier = camelTo2 '_'}+usageOptions = defaultOptions {fieldLabelModifier = camelTo2 '_', constructorTagModifier = camelTo2 '_'} -instance ToJSON Usage where toJSON = genericToJSON usageOptions+instance ToJSON Usage where+  toJSON u = case genericToJSON usageOptions u of+    Aeson.Object o | Nothing <- availability u -> Aeson.Object (KeyMap.delete "availability" o)+    value -> value  -- | Empty usage with every count and cost set to zero. zeroUsage :: Usage@@ -83,6 +123,7 @@       cacheWriteTokens = 0,       reasoningTokens = Nothing,       totalTokens = 0,+      availability = Nothing,       cost = zeroCost     } @@ -103,6 +144,7 @@         cacheWriteTokens = cacheWriteTokens a + cacheWriteTokens b,         reasoningTokens = combineReasoning (reasoningTokens a) (reasoningTokens b),         totalTokens = totalTokens a + totalTokens b,+        availability = availability a <> availability b,         cost = cost a <> cost b       } @@ -112,3 +154,10 @@ -- | Total a collection of per-call usages into one. sumUsage :: (Foldable f) => f Usage -> Usage sumUsage = foldl' (<>) mempty++-- | Add actual response observations without overwriting missing-count facts.+observeBilling :: [BillingFact] -> Usage -> Usage+observeBilling [] u = u+observeBilling facts u =+  let previous = fromMaybe (UsageAvailability Set.empty False Set.empty) (availability u)+   in u {availability = Just previous {billingFacts = billingFacts previous <> Set.fromList facts}}

@@ -0,0 +1,44 @@+-- | Shared billing-category normalization. Adapters extract optional wire+-- counts; this module preserves their availability without inferring writes.+module Baikai.Usage.Normalize (InputAccounting (..), ReportedUsage (..), normalizeUsage) where++import Baikai.Usage qualified as U+import Data.Maybe (fromMaybe, isNothing)+import Data.Set qualified as Set+import Numeric.Natural (Natural)++data InputAccounting = InclusiveInput | ExclusiveInput+  deriving stock (Eq, Show)++data ReportedUsage = ReportedUsage+  { inputTokens :: !(Maybe Natural),+    outputTokens :: !(Maybe Natural),+    cacheReadTokens :: !(Maybe Natural),+    cacheWriteTokens :: !(Maybe Natural),+    reasoningTokens :: !(Maybe Natural)+  }+  deriving stock (Eq, Show)++normalizeUsage :: InputAccounting -> ReportedUsage -> U.Usage+normalizeUsage accounting r =+  let input = fromMaybe 0 (inputTokens r)+      output = fromMaybe 0 (outputTokens r)+      cached = fromMaybe 0 (cacheReadTokens r)+      writes = fromMaybe 0 (cacheWriteTokens r)+      fresh = case accounting of+        ExclusiveInput -> input+        InclusiveInput -> if cached + writes > input then 0 else input - cached - writes+      invalidInput = accounting == InclusiveInput && maybe False (cached + writes >) (inputTokens r)+      invalidReasoning = case (reasoningTokens r, outputTokens r) of+        (Just reasoning, Just out) -> reasoning > out+        _ -> False+      missing = Set.fromList [category | (category, count) <- [(U.InputUsage, inputTokens r), (U.OutputUsage, outputTokens r), (U.CacheReadUsage, cacheReadTokens r), (U.CacheWriteUsage, cacheWriteTokens r)], isNothing count]+   in U.zeroUsage+        { U.inputTokens = fresh,+          U.outputTokens = output,+          U.cacheReadTokens = cached,+          U.cacheWriteTokens = writes,+          U.reasoningTokens = reasoningTokens r,+          U.totalTokens = fresh + output + cached + writes,+          U.availability = Just (U.UsageAvailability missing (invalidInput || invalidReasoning) Set.empty)+        }

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedRecordDot #-}+ -- | Regression test that locks down the contract between the JSON -- catalog files under @baikai\/data\/models\/@ and the auto-generated -- @baikai\/src\/Baikai\/Models\/Generated.hs@ module.@@ -18,21 +20,25 @@ -- JSON file changed without a paired regeneration. module CatalogSpec (tests) where -import Baikai.Api (Api (AnthropicMessages))+import Baikai.Api (Api (AnthropicMessages, OpenAIResponses)) import Baikai.Compat   ( AnthropicMessagesCompat,     AnthropicThinkingStyle (..),+    OpenAIResponsesCompat (supportedReasoningEfforts, supportsLongCacheRetention, supportsPromptCacheOptions, supportsSamplingParameters),+    supportsFastMode,+    supportsForcedToolChoice,     supportsSamplingParameters,     thinkingStyle,   ) import Baikai.Model-  ( Compat (CompatAnthropicMessages),+  ( Compat (CompatAnthropicMessages, CompatOpenAIResponses),     Model,     api,     compat,     modelId,   ) import Baikai.Models.Generated (allModels)+import Baikai.ThinkingLevel (ThinkingLevel (..)) import Data.ByteString qualified as BS import Data.List (sort) import Data.Text (Text)@@ -45,7 +51,16 @@ tests =   testGroup     "Baikai.Models.Generated"-    [ testCase "regenerating from data/models produces no diff" $+    [ testCase "Astra selects Responses with explicit endpoint facts" $ do+        [api m | m <- allModels, modelId m == "gpt-6-astra"] @?= [OpenAIResponses]+        case [compat m | m <- allModels, modelId m == "gpt-6-astra"] of+          [CompatOpenAIResponses c] -> do+            c.supportsPromptCacheOptions @?= True+            c.supportsLongCacheRetention @?= False+            c.supportsSamplingParameters @?= False+            c.supportedReasoningEfforts @?= Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax]+          _ -> assertFailure "Astra needs explicit OpenAI endpoint facts",+      testCase "regenerating from data/models produces no diff" $         withSystemTempDirectory "baikai-catalog-spec" $ \tmpDir -> do           let regenPath = tmpDir <> "/Generated.hs"               committedPath = "src/Baikai/Models/Generated.hs"@@ -78,18 +93,19 @@ -- | The shipped thinking style and sampling support of each Anthropic -- catalog id, written out by hand from -- @baikai\/data\/models\/anthropic.json@.-expectedAnthropicFacts :: [(Text, (AnthropicThinkingStyle, Bool))]+expectedAnthropicFacts :: [(Text, (AnthropicThinkingStyle, Bool, Bool, Bool))] expectedAnthropicFacts =-  [ ("claude-fable-5", (AnthropicThinkingAdaptive, False)),-    ("claude-haiku-4-5", (AnthropicThinkingBudget, True)),-    ("claude-opus-4-5", (AnthropicThinkingBudget, True)),-    ("claude-opus-4-6", (AnthropicThinkingAdaptive, True)),-    ("claude-opus-4-7", (AnthropicThinkingAdaptive, False)),-    ("claude-opus-4-8", (AnthropicThinkingAdaptive, False)),-    ("claude-opus-5", (AnthropicThinkingAdaptive, False)),-    ("claude-sonnet-4-5", (AnthropicThinkingBudget, True)),-    ("claude-sonnet-4-6", (AnthropicThinkingAdaptive, True)),-    ("claude-sonnet-5", (AnthropicThinkingAdaptive, False))+  [ ("claude-fable-5", (AnthropicThinkingAdaptive, False, True, False)),+    ("claude-fable-5-1", (AnthropicThinkingAdaptive, False, False, False)),+    ("claude-haiku-4-5", (AnthropicThinkingBudget, True, True, False)),+    ("claude-opus-4-5", (AnthropicThinkingBudget, True, True, False)),+    ("claude-opus-4-6", (AnthropicThinkingAdaptive, True, True, False)),+    ("claude-opus-4-7", (AnthropicThinkingAdaptive, False, True, False)),+    ("claude-opus-4-8", (AnthropicThinkingAdaptive, False, True, True)),+    ("claude-opus-5", (AnthropicThinkingAdaptive, False, True, True)),+    ("claude-sonnet-4-5", (AnthropicThinkingBudget, True, True, False)),+    ("claude-sonnet-4-6", (AnthropicThinkingAdaptive, True, True, False)),+    ("claude-sonnet-5", (AnthropicThinkingAdaptive, False, True, False))   ]  assertFacts :: Model -> IO ()@@ -107,5 +123,5 @@           <> show other       )   where-    facts :: AnthropicMessagesCompat -> (AnthropicThinkingStyle, Bool)-    facts c = (thinkingStyle c, supportsSamplingParameters c)+    facts :: AnthropicMessagesCompat -> (AnthropicThinkingStyle, Bool, Bool, Bool)+    facts c = (thinkingStyle c, c.supportsSamplingParameters, c.supportsForcedToolChoice, c.supportsFastMode)

@@ -196,7 +196,15 @@ claudeParserTests =   testGroup     "claude -p --output-format json result"-    [ testCase "a recorded run yields its text, session id, model, usage, and cost" $ do+    [ testCase "a reported zero total retains its source instead of becoming missing cost" $ do+        case decodeClaudeCliResult "{\"result\":\"ok\",\"is_error\":false,\"usage\":{\"input_tokens\":0},\"total_cost_usd\":0}" of+          Left err -> assertFailure (show err)+          Right report -> case report ^. #usage of+            Just u -> do+              u ^. #cost . #usd @?= 0+              u ^. #cost . #basis @?= providerReportedBasis+            Nothing -> assertFailure "usage disappeared",+      testCase "a recorded run yields its text, session id, model, usage, and cost" $ do         recorded <- BS.readFile "test/fixtures/claude-cli-result.json"         case decodeClaudeCliResult recorded of           Left err -> assertFailure ("expected the recording to decode: " <> show err)

@@ -3,16 +3,18 @@ import Baikai import Control.Lens ((&), (.~), (^.)) import Data.Aeson qualified as Aeson+import Data.Text qualified as Text import Data.Time (UTCTime) import Data.Vector qualified as V import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.HUnit (assertBool, testCase, (@?=))  tests :: TestTree tests =   testGroup     "Context helpers"-    [ monoidTests,+    [ replayStateTests,+      monoidTests,       constructorTests,       timestampTests,       flattenTextTests,@@ -129,7 +131,8 @@                   ThinkingContent                     { thinking = "hidden",                       signature = Nothing,-                      redacted = False+                      redacted = False,+                      replayState = Nothing                     },                 AssistantToolCall emptyToolCall {name = "lookup", arguments = Aeson.object []},                 AssistantText (TextContent " world")@@ -153,3 +156,35 @@  (|>) :: a -> (a -> b) -> b (|>) x f = f x++replayStateTests :: TestTree+replayStateTests =+  testGroup+    "provider-scoped reasoning replay"+    [ testCase "legacy JSON remains valid and byte-compatible" $ do+        let old = Aeson.object ["thinking" Aeson..= ("" :: Text.Text), "signature" Aeson..= Aeson.Null, "redacted" Aeson..= False]+        Aeson.fromJSON old @?= Aeson.Success emptyThinkingContent+        Aeson.toJSON emptyThinkingContent @?= old,+      testCase "empty summary and ordered encrypted items survive content persistence and context appending" $ do+        let saved = Aeson.eitherDecode (Aeson.encode thought)+        saved @?= Right thought+        let resp = emptyResponse & #message . #content .~ V.singleton (AssistantThinking thought)+            context = addResponse resp (contextOf [user "go"])+        context ^. #messages @?= V.fromList [user "go", responseMessage resp]+        flattenAssistantText (resp ^. #message . #content) @?= ""+        assertBool "Show omits encrypted content" (not ("encrypted-secret" `Text.isInfixOf` Text.pack (show resp))),+      testCase "response content commitment binds replay scope, identity, payload and order" $ do+        let digest t = commitmentDigest (Aeson.object ["content" Aeson..= V.singleton (AssistantThinking t)])+            changed r = thought & #replayState .~ Just r+        mapM_+          (\r -> assertBool "replay mutation must change commitment" (digest thought /= digest (changed r)))+          [ state & #replayApi .~ AnthropicMessages,+            state & #replayModel .~ "other-model",+            state & #replayItems .~ V.reverse items,+            state & #replayItems .~ V.singleton (Aeson.object ["id" Aeson..= ("different" :: Text.Text)])+          ]+    ]+  where+    items = V.fromList [Aeson.object ["type" Aeson..= ("reasoning" :: Text.Text), "id" Aeson..= ("rs_1" :: Text.Text), "summary" Aeson..= ([] :: [Aeson.Value]), "encrypted_content" Aeson..= ("encrypted-secret" :: Text.Text)], Aeson.object ["id" Aeson..= ("rs_2" :: Text.Text)]]+    state = ThinkingReplay OpenAIResponses "gpt-6-astra" items+    thought = emptyThinkingContent & #replayState .~ Just state

@@ -1,6 +1,7 @@ module CostSpec (tests) where  import Baikai.Api (Api (..))+import Baikai.CacheRetention (CacheRetention (..)) import Baikai.Content (AssistantContent (..), TextContent (..)) import Baikai.Context (Context (..), emptyContext) import Baikai.Cost qualified as Cost@@ -13,9 +14,10 @@     runRequestWithLog,     withCallLog,   )-import Baikai.Cost.Pricing (attachCost, computeCost)+import Baikai.Cost.Pricing (attachCost, computeCost, computeCostAtSpeed, computeCostForService) import Baikai.Message (AssistantPayload (..), user)-import Baikai.Model (Model (..), ModelCost (..), emptyModel)+import Baikai.Model (InputPriceTier (..), Model (..), ModelCost (..), PricingPolicy (..), emptyModel)+import Baikai.Models.Generated qualified as Models import Baikai.Options (Options, emptyOptions) import Baikai.Prelude import Baikai.Provider@@ -23,13 +25,16 @@     registerApiProvider,   ) import Baikai.Response (Response (..), flattenAssistantBlocks)+import Baikai.Speed (Speed (..)) import Baikai.StopReason (StopReason (..)) import Baikai.Stream (liftCompleteToStream) import Baikai.Usage (Usage, zeroUsage)+import Baikai.Usage qualified as Usage import Data.Aeson qualified as Aeson import Data.ByteString.Lazy.Char8 qualified as BSL import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) import Data.Maybe (fromJust, isJust)+import Data.Set qualified as Set import Data.Time (UTCTime, getCurrentTime) import Data.Vector qualified as V import System.Directory (getTemporaryDirectory, removeFile)@@ -42,7 +47,8 @@ tests =   testGroup     "Baikai.Cost"-    [ computeTests,+    [ fastCostTests,+      computeTests,       attachCostTests,       callLogTests     ]@@ -230,6 +236,8 @@         entry ^. #latencyMs @?= 7         entry ^. #promptSummary @?= "Hello world"         isJust (entry ^. #usd) @?= True+        entry ^. #costBasis @?= Just (cannedHaiku ^. #message . #usage . #cost . #basis)+        entry ^. #cacheWriteTokens @?= Just (cannedHaiku ^. #message . #usage . #cacheWriteTokens)         removeFile path',       testCase "closeCallLog returns even when the log path is unwritable" $ do         tmp <- getTemporaryDirectory@@ -269,7 +277,54 @@       outputTokens = Nothing,       cachedInputTokens = Nothing,       reasoningTokens = Nothing,+      cacheWriteTokens = Nothing,+      costBasis = Nothing,+      usageAvailability = Nothing,       usd = Nothing,       latencyMs = 0,       promptSummary = ""     }++fastCostTests :: TestTree+fastCostTests =+  testGroup+    "fast pricing"+    [ testCase "fast premiums compose with context tiers before pricing" $ do+        let m = Models.anthropic_claude_opus_5 & #pricingPolicy .~ Just (PricingPolicy [InputPriceTier 1000 (ModelCost 10 50 1 12.5)] Nothing)+        Cost.usd (computeCostAtSpeed m SpeedFast u) @?= 2 * Cost.usd (computeCost m u),+      testCase "invalid premium rates and undefined policy ratios are explicit" $ do+        let negative = knownModel & #fastModeCost .~ Just (ModelCost (-1) 10 0.2 2.5)+            undefinedRatio = knownModel & #cost .~ ModelCost 0 5 0.1 1.25 & #fastModeCost .~ Just (ModelCost 10 10 0.2 2.5) & #pricingPolicy .~ Just (PricingPolicy [InputPriceTier 1 (ModelCost 5 5 0.1 1.25)] Nothing)+        mapM_ (\m -> Set.member Cost.InvalidPricingPolicy (Cost.estimateReasons (Cost.basis (computeCostAtSpeed m SpeedFast u))) @?= True) [negative, undefinedRatio],+      testCase "contradictory speed observations remain an explicit standard estimate" $ do+        let usage = Usage.observeBilling [Usage.BillingSpeed "fast", Usage.BillingSpeed "standard"] u+            result = computeCostForService Nothing Nothing Models.anthropic_claude_opus_5 usage+        Cost.usd result @?= Cost.usd (computeCost Models.anthropic_claude_opus_5 u)+        Set.member Cost.InconsistentUsage (Cost.estimateReasons (Cost.basis result)) @?= True,+      testCase "fast Opus costs exactly twice standard across all four token categories" $ do+        mapM_+          ( \m -> do+              let standard = computeCost m u+                  fast = computeCostAtSpeed m SpeedFast u+              Cost.usd fast @?= 2 * Cost.usd standard+              Cost.breakdown fast @?= Cost.breakdown (standard <> standard)+              computeCostAtSpeed m SpeedStandard u @?= standard+              Cost.sources (Cost.basis fast) @?= Set.singleton Cost.ResolvedTokenRates+          )+          [Models.anthropic_claude_opus_5, Models.anthropic_claude_opus_4_8],+      testCase "uncurated fast pricing retains the standard amount and marks the estimate" $ do+        let m = Models.anthropic_claude_sonnet_5+            fast = computeCostAtSpeed m SpeedFast u+        Cost.usd fast @?= Cost.usd (computeCost m u)+        Set.member (Cost.UnsupportedSpeed "fast") (Cost.estimateReasons (Cost.basis fast)) @?= True,+      testCase "observed fast speed selects premium long-cache rates once" $ do+        let usage = Usage.observeBilling [Usage.BillingSpeed "fast", Usage.BillingServiceTier "standard"] (zeroUsage & #cacheWriteTokens .~ 1000000)+            price = computeCostForService (Just CacheRetentionLong) Nothing Models.anthropic_claude_opus_5 usage+        Cost.usd price @?= 20+        Set.member (Cost.UnsupportedSpeed "fast") (Cost.estimateReasons (Cost.basis price)) @?= False,+      testCase "observed standard speed retains standard long-cache rates" $ do+        let usage = Usage.observeBilling [Usage.BillingSpeed "standard", Usage.BillingServiceTier "standard"] (zeroUsage & #cacheWriteTokens .~ 1000000)+        Cost.usd (computeCostForService (Just CacheRetentionLong) Nothing Models.anthropic_claude_opus_5 usage) @?= 10+    ]+  where+    u = sampleUsage & #cacheReadTokens .~ 200 & #cacheWriteTokens .~ 300

@@ -5,6 +5,7 @@     ErrorCategory (..),     classifyHttpStatus,     classifyHttpStatusWithBody,+    contentFiltered,     decodeError,     httpError,     invalidRequest,@@ -15,6 +16,7 @@     rateLimited,     retryAfterSecondsAt,   )+import Data.Aeson qualified as Aeson import Data.Time (UTCTime) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=))@@ -27,6 +29,7 @@       bodyClassifyTests,       httpHelperTests,       retryTests,+      refusalJsonTests,       constructorTests     ] @@ -150,4 +153,27 @@         category (invalidRequest "x") @?= InvalidRequest,       testCase "decodeError category" $         category (decodeError "x") @?= DecodeFailure+    ]++refusalJsonTests :: TestTree+refusalJsonTests =+  testGroup+    "refusal error JSON"+    [ testCase "provider category round-trips under its snake-case key" $ do+        let e = (contentFiltered "declined") {refusalCategory = Just "future_category"}+        Aeson.eitherDecode (Aeson.encode e) @?= Right e+        Aeson.toJSON e+          @?= Aeson.object+            [ "category" Aeson..= ("content_filtered" :: String),+              "message" Aeson..= ("declined" :: String),+              "http_status" Aeson..= Aeson.Null,+              "retry_after_seconds" Aeson..= Aeson.Null,+              "exit_code" Aeson..= Aeson.Null,+              "refusal_category" Aeson..= ("future_category" :: String)+            ],+      testCase "legacy errors without refusal_category still decode" $+        Aeson.eitherDecode "{\"category\":\"content_filtered\",\"message\":\"declined\",\"http_status\":null,\"retry_after_seconds\":null,\"exit_code\":null}"+          @?= Right (contentFiltered "declined"),+      testCase "ordinary failures have no refusal category" $+        refusalCategory (httpError 429 Nothing "slow down") @?= Nothing     ]

@@ -6,7 +6,7 @@ -- through. module EvidenceSpec (tests) where -import Baikai.Cost (Cost (..), zeroCost)+import Baikai.Cost (Cost (..), CostEstimateReason (CacheWriteUsageNotReported), estimateCost, zeroCost) import Baikai.Evidence import Baikai.Provider.Cli.Internal qualified as Internal import Baikai.ThinkingLevel (ThinkingLevel (..))@@ -27,7 +27,8 @@ tests =   testGroup     "Evidence"-    [ canonicalTests,+    [ translationDisplayTests,+      canonicalTests,       digestTests,       usageEnvelopeTests,       deriveStrengthTests,@@ -60,7 +61,8 @@             ThinkingDroppedUnsupportedHost ThinkingMinimal,             ThinkingDroppedBudgetExceeded ThinkingMax 32000 8192,             SamplingDroppedUnsupportedModel ["temperature", "top_p"],-            SamplingDroppedUnsupportedApi ["seed", "frequency_penalty", "presence_penalty"]+            SamplingDroppedUnsupportedApi ["seed", "frequency_penalty", "presence_penalty"],+            ThinkingSummaryUnavailable           ]       ]         <> [ testCase "a sampling drop encodes its kind and fields and no requested level" $@@ -158,7 +160,13 @@ digestTests =   testGroup     "digests"-    [ testCase "a digest is sha256: plus 64 lowercase hex characters" $ do+    [ testCase "speed participates in the configuration fingerprint" $ do+        let absent = object ["model" .= ("claude-opus-5" :: Text.Text)]+            standard = object ["model" .= ("claude-opus-5" :: Text.Text), "speed" .= ("standard" :: Text.Text)]+            fast = object ["model" .= ("claude-opus-5" :: Text.Text), "speed" .= ("fast" :: Text.Text)]+        assertBool "fast differs from standard" (configurationDigest fast /= configurationDigest standard)+        assertBool "explicit standard differs from absent" (configurationDigest standard /= configurationDigest absent),+      testCase "a digest is sha256: plus 64 lowercase hex characters" $ do         env <- loadFixture         let d = commitmentDigest env         assertBool ("expected a sha256: prefix, got " <> Text.unpack d) $@@ -262,7 +270,12 @@ usageEnvelopeTests =   testGroup     "usage envelope"-    [ testCase "two usages differing only in cost produce the same envelope" $ do+    [ testCase "cost basis is serialized additively without changing provider commitments" $ do+        evidenceSchemaVersion @?= "baikai.model-call-evidence/2.5"+        let estimated = zeroUsage {cost = estimateCost [CacheWriteUsageNotReported] zeroCost}+        usageEnvelope estimated @?= usageEnvelope zeroUsage+        assertBool "usage JSON retains the local calculation basis" (Aeson.toJSON estimated /= Aeson.toJSON zeroUsage),+      testCase "two usages differing only in cost produce the same envelope" $ do         -- The cost is computed here from the caller's catalog rates, not         -- read off the response, so a verifier holding only the response         -- could not recompute a digest that covered it — and the digest@@ -270,6 +283,10 @@         let cheap = zeroUsage {inputTokens = 10, outputTokens = 20}             dear = cheap {cost = zeroCost {usd = 1234}}         usageEnvelope cheap @?= usageEnvelope dear,+      testCase "legacy usage envelope has exactly the original six keys" $+        case usageEnvelope zeroUsage of+          Object fields -> KeyMap.size fields @?= 6+          _ -> assertFailure "usage envelope is not an object",       testCase "the encoded envelope carries no cost key" $ do         let encoded = BS8.unpack (canonicalEncode (usageEnvelope zeroUsage))         assertBool@@ -492,3 +509,13 @@   case raw of     Left err -> assertFailure ("could not read " <> fixturePath <> ": " <> err)     Right v -> pure v++translationDisplayTests :: TestTree+translationDisplayTests = testCase "display translation is optional in legacy JSON and round-trips when present" $ do+  let legacy = Aeson.toJSON noThinkingRequested+      summary = noThinkingRequested {displayText = Just "summarized"}+  case legacy of+    Object o -> KeyMap.lookup "display_text" o @?= Nothing+    _ -> assertFailure "translation must be an object"+  Aeson.fromJSON legacy @?= Aeson.Success noThinkingRequested+  Aeson.fromJSON (Aeson.toJSON summary) @?= Aeson.Success summary

@@ -4,9 +4,11 @@ -- models.dev-shaped fixture. No network is involved. module FetchModelsSpec (tests) where -import Baikai.Compat (AnthropicThinkingStyle (..))+import Baikai.Compat (AnthropicThinkingStyle (..), defaultOpenAIResponsesCompat) import Baikai.Model (InputModality (..))+import Baikai.Model qualified as Model import Baikai.Prelude+import Control.Monad (forM_) import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Lazy qualified as BSL@@ -19,6 +21,7 @@ import Data.Text.Encoding (decodeUtf8) import Data.Vector qualified as V import FetchModelsCore+import GenModelsCore qualified as Gen import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) @@ -57,8 +60,11 @@               reasoning = True,               input = [InputText, InputImage],               cost = CatalogCost 0.05 0.4 0 0,+              fastModeCost = Nothing,+              pricingPolicy = Nothing,               contextWindow = 400000,               maxOutputTokens = 128000,+              apiOverride = Nothing,               compat = Nothing             },           CatalogModel@@ -67,8 +73,11 @@               reasoning = True,               input = [InputText, InputImage],               cost = CatalogCost 2.5 15 0.25 0,+              fastModeCost = Nothing,+              pricingPolicy = Nothing,               contextWindow = 1050000,               maxOutputTokens = 128000,+              apiOverride = Nothing,               compat = Nothing             }         ]@@ -90,14 +99,19 @@               reasoning = True,               input = [InputText, InputImage],               cost = CatalogCost 5 25 1.5 6.25,+              fastModeCost = Nothing,+              pricingPolicy = Nothing,               contextWindow = 200000,               maxOutputTokens = 64000,+              apiOverride = Nothing,               compat =                 Just                   ( CatalogAnthropicCompat                       ( AnthropicGenerationFacts                           { thinkingStyle = AnthropicThinkingBudget,-                            supportsSamplingParameters = True+                            supportsSamplingParameters = True,+                            supportsForcedToolChoice = True,+                            fastModeCost = Nothing                           }                       )                   )@@ -109,8 +123,66 @@ tests =   testGroup     "Baikai.FetchModels"-    [ testCase "OpenAI normalization filters, curates, and maps fields" $ do+    [ testCase "per-model API and Responses compat survive normalization and rendering" $ do         upstream <- loadUpstream+        let spec =+              openaiSpec+                & #apiFor+                .~ (\mid -> if mid == "gpt-5.4" then Just "openai-responses" else Nothing)+                & #compatFor+                .~ (\mid -> if mid == "gpt-5.4" then Just (CatalogResponsesCompat defaultOpenAIResponsesCompat) else Nothing)+            refreshed = catalogFor upstream spec+            raw = renderCatalog refreshed+        map (^. #apiOverride) (refreshed ^. #models) @?= [Nothing, Just "openai-responses"]+        case Aeson.eitherDecode (BSL.fromStrict raw) of+          Left err -> assertFailure err+          Right catalog -> do+            let generated = Gen.renderModule (Gen.flattenEntries catalog)+            assertBool "generator reads the rendered override" ("api = OpenAIResponses" `Text.isInfixOf` generated)+            assertBool "generator keeps the inherited default" ("api = OpenAIChatCompletions" `Text.isInfixOf` generated)++        case Aeson.eitherDecode (BSL.fromStrict raw) of+          Right (Aeson.Object root) -> case KeyMap.lookup "models" root of+            Just (Aeson.Array entries) -> case V.toList entries of+              [Aeson.Object legacy, Aeson.Object native] -> do+                KeyMap.lookup "api" legacy @?= Nothing+                KeyMap.lookup "api" native @?= Just (Aeson.String "openai-responses")+                case KeyMap.lookup "compat" native of+                  Just (Aeson.Object facts) -> KeyMap.lookup "kind" facts @?= Just (Aeson.String "openai-responses")+                  _ -> assertFailure "missing Responses compat"+              _ -> assertFailure "wrong entries"+            _ -> assertFailure "missing models"+          _ -> assertFailure "invalid rendered catalog",+      testCase "refresh preserves Astra endpoint restrictions despite upstream tool support" $ do+        upstream <- loadUpstream+        let sample = (upstream Map.! "openai") Map.! "gpt-5.4"+            astra = sample & #modelId .~ "gpt-6-astra"+            refreshed = normalizeProvider openaiSpec (Map.singleton "gpt-6-astra" astra)+            expected = Map.lookup "gpt-6-astra" openaiInclude >>= id+        map (^. #apiOverride) (refreshed ^. #models) @?= [Just "openai-responses"]+        map (^. #compat) (refreshed ^. #models) @?= [expected]+        assertBool "explicit compat survives rendering" ("openai-responses" `Text.isInfixOf` decodeUtf8 (renderCatalog refreshed)),+      testCase "fast rates and capability survive fetch and generator on exactly two curated models" $ do+        upstream <- loadUpstream+        let sample = (upstream Map.! "openai") Map.! "gpt-5.4"+        forM_ (Map.keys anthropicInclude) $ \mid -> do+          let refreshed = normalizeProvider anthropicSpec (Map.singleton mid (sample & #modelId .~ mid))+              expected = if mid `elem` ["claude-opus-5", "claude-opus-4-8"] then Just (CatalogCost 10 50 1 12.5) else Nothing+          map (^. #fastModeCost) (refreshed ^. #models) @?= [expected]+          case Aeson.eitherDecode (BSL.fromStrict (renderCatalog refreshed)) of+            Left err -> assertFailure err+            Right catalog -> Gen.checkAnthropicCompat (Gen.flattenEntries catalog) @?= Right (),+      testCase "curated pricing survives fetch rendering and generator parsing" $ do+        upstream <- loadUpstream+        let sample = (upstream Map.! "openai") Map.! "gpt-5.4"+        forM_ [(openaiSpec, "gpt-6-astra", Model.PricingPolicy [Model.InputPriceTier 272000 (Model.ModelCost 20 75 2 25)] Nothing), (anthropicSpec, "claude-fable-5-1", Model.PricingPolicy [] (Just 20))] $ \(spec, mid, policy) -> do+          let refreshed = normalizeProvider spec (Map.singleton mid (sample & #modelId .~ mid))+          map (^. #pricingPolicy) (refreshed ^. #models) @?= [Just policy]+          case Aeson.eitherDecode (BSL.fromStrict (renderCatalog refreshed)) of+            Left err -> assertFailure err+            Right catalog -> map (Gen.pricingPolicy . snd) (Gen.flattenEntries catalog) @?= [Just policy],+      testCase "OpenAI normalization filters, curates, and maps fields" $ do+        upstream <- loadUpstream         catalogFor upstream openaiSpec @?= expectedOpenAI,       testCase "tool_call: false model is excluded" $ do         upstream <- loadUpstream@@ -157,8 +229,11 @@                           reasoning = False,                           input = [InputText],                           cost = CatalogCost 0 0 0 0,+                          fastModeCost = Nothing,+                          pricingPolicy = Nothing,                           contextWindow = 1,                           maxOutputTokens = 1,+                          apiOverride = Nothing,                           compat = Nothing                         }                     ]@@ -194,7 +269,9 @@               [ "      \"compat\": {",                 "        \"kind\": \"anthropic-messages\",",                 "        \"thinkingStyle\": \"budget\",",-                "        \"supportsSamplingParameters\": true",+                "        \"supportsSamplingParameters\": true,",+                "        \"supportsFastMode\": false,",+                "        \"supportsForcedToolChoice\": true",                 "      },"               ]               `Text.isInfixOf` rendered

@@ -1,13 +1,16 @@ module GenModelsSpec (tests) where -import Baikai.Api (Api (AnthropicMessages, OpenAIChatCompletions))+import Baikai.Api (Api (AnthropicMessages, OpenAIChatCompletions, OpenAIResponses)) import Baikai.Compat   ( AnthropicThinkingStyle (AnthropicThinkingAdaptive),     defaultAnthropicMessagesCompat,+    supportsFastMode,     supportsSamplingParameters,     thinkingStyle,   ) import Baikai.Model (InputModality (InputText))+import Control.Monad (forM_)+import Data.Aeson qualified as Aeson import Data.Text (Text) import Data.Text qualified as Text import GenModelsCore@@ -18,7 +21,43 @@ tests =   testGroup     "Baikai.GenModels"-    [ testCase "checkIdentifierCollisions rejects sanitized binding duplicates" $ do+    [ testCase "fast capability and rates must agree in both directions" $ do+        forM_ [(True, Nothing), (False, Just (CostEntry 10 50 1 12.5))] $ \(supported, rates) -> do+          let block = CatalogCompatAnthropic (defaultAnthropicMessagesCompat {supportsFastMode = supported})+              catalog = (anthropicCatalog CatalogCompatAuto (Just block)) {models = [(model "claude-x") {entryCompatOverride = Just block, entryFastModeCost = rates}]}+          case checkAnthropicCompat (flattenEntries catalog) of+            Left err -> assertBool "names model" ("claude-x" `Text.isInfixOf` err)+            Right () -> assertFailure "contradictory fast-mode catalog accepted",+      testCase "catalog rejects invalid policy thresholds and negative rates" $ do+        let cost n = Aeson.object ["input" Aeson..= (n :: Int), "output" Aeson..= (1 :: Int), "cacheRead" Aeson..= (0 :: Int), "cacheWrite" Aeson..= (0 :: Int)]+            tier n rate = Aeson.object ["inputAbove" Aeson..= (n :: Int), "rates" Aeson..= cost rate]+            policy tiers = Aeson.object ["inputTiers" Aeson..= tiers]+            entry p = Aeson.object ["id" Aeson..= ("test" :: Text), "name" Aeson..= ("Test" :: Text), "input" Aeson..= (["text"] :: [Text]), "cost" Aeson..= cost 1, "contextWindow" Aeson..= (1 :: Int), "maxOutputTokens" Aeson..= (1 :: Int), "pricingPolicy" Aeson..= p]+        forM_ [policy [Aeson.object ["inputAbove" Aeson..= (1 :: Int), "rates" Aeson..= Aeson.object ["input" Aeson..= (1 :: Int), "output" Aeson..= (1 :: Int)]]], policy [tier (-1) 1], policy [tier 1 1, tier 1 1], policy [tier 2 1, tier 1 1], policy [tier 1 (-1)], Aeson.object ["longCacheWriteCost" Aeson..= (-1 :: Int)]] $ \p ->+          case Aeson.fromJSON (entry p) :: Aeson.Result ModelEntry of+            Aeson.Error _ -> pure ()+            Aeson.Success _ -> assertFailure "invalid policy accepted",+      testCase "per-model API override changes only the selected binding" $ do+        let catalog = collisionCatalog {models = [model "legacy", (model "native") {entryApiOverride = Just OpenAIResponses}]}+            rendered = renderModule (flattenEntries catalog)+        assertBool "legacy inherits file API" ("api = OpenAIChatCompletions" `Text.isInfixOf` rendered)+        assertBool "native overrides API" ("api = OpenAIResponses" `Text.isInfixOf` rendered),+      testCase "Responses catalog compat parses and renders all endpoint facts" $ do+        let raw = Aeson.object ["kind" Aeson..= ("openai-responses" :: Text), "supportsSamplingParameters" Aeson..= False, "supportsLongCacheRetention" Aeson..= False, "supportsPromptCacheOptions" Aeson..= True, "supportedReasoningEfforts" Aeson..= (["low", "max"] :: [Text])]+        case Aeson.fromJSON raw of+          Aeson.Error err -> assertFailure err+          Aeson.Success block -> do+            let rendered = renderModule (flattenEntries collisionCatalog {models = [(model "native") {entryApiOverride = Just OpenAIResponses, entryCompatOverride = Just block}]})+            mapM_ (\expected -> assertBool (Text.unpack expected) (expected `Text.isInfixOf` rendered)) ["CompatOpenAIResponses", "supportsPromptCacheOptions = True", "supportsLongCacheRetention = False", "supportsSamplingParameters = False", "Just [ThinkingLow, ThinkingMax]"],+      testCase "OpenAI effort policy rejects empty, duplicate, unordered and unknown levels" $+        mapM_+          ( \levels ->+              case Aeson.fromJSON (Aeson.object ["kind" Aeson..= ("openai-completions" :: Text), "supportedReasoningEfforts" Aeson..= levels]) :: Aeson.Result CatalogCompat of+                Aeson.Error _ -> pure ()+                Aeson.Success _ -> assertFailure "invalid effort policy accepted"+          )+          ([[], ["low", "low"], ["high", "low"], ["unknown"]] :: [[Text]]),+      testCase "checkIdentifierCollisions rejects sanitized binding duplicates" $ do         let entries = flattenEntries collisionCatalog         case checkIdentifierCollisions entries of           Right () -> assertFailure "expected duplicate generated identifier to be rejected"@@ -95,8 +134,11 @@             costCacheRead = 0,             costCacheWrite = 0           },+      entryFastModeCost = Nothing,+      entryPricingPolicy = Nothing,       entryContextWindow = 1,       entryMaxOutputTokens = 1,       entryEnabled = True,+      entryApiOverride = Nothing,       entryCompatOverride = Nothing     }

@@ -31,6 +31,7 @@ import GenModelsSpec qualified import HelpersSpec qualified import InteractiveSpec qualified+import PricingPolicySpec qualified import PublicSurfaceSpec qualified import StreamSpec qualified import StreamWorkerSpec qualified@@ -118,6 +119,7 @@         GenModelsSpec.tests,         HelpersSpec.tests,         InteractiveSpec.tests,+        PricingPolicySpec.tests,         PublicSurfaceSpec.tests,         StreamSpec.tests,         StreamWorkerSpec.tests,

@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedRecordDot #-}++module PricingPolicySpec (tests) where++import Baikai.CacheRetention (CacheRetention (..))+import Baikai.Cost qualified as C+import Baikai.Cost.Pricing (computeCost, computeCostAtRates, computeCostForService, computeCostWith, resolveRates)+import Baikai.Evidence qualified as Ev+import Baikai.Model qualified as M+import Baikai.Models.Generated qualified as Models+import Baikai.Usage qualified as U+import Baikai.Usage.Normalize qualified as N+import Control.Lens ((&), (.~))+import Control.Monad (forM_)+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KM+import Data.Set qualified as Set+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Pricing policy"+    [ testCase "requested tiers never substitute for observed service" $ do+        let unknown = N.normalizeUsage N.InclusiveInput (N.ReportedUsage (Just 1000) (Just 0) (Just 0) (Just 0) Nothing)+            standard = U.observeBilling [U.BillingServiceTier "default"] unknown+            priority = U.observeBilling [U.BillingServiceTier "priority"] unknown+        (computeCostForService Nothing (Just "default") astra unknown).basis.estimateReasons @?= Set.singleton C.ServiceTierNotReported+        (computeCostForService Nothing (Just "default") astra standard).basis.estimateReasons @?= Set.empty+        (computeCostForService Nothing (Just "default") astra priority).basis.estimateReasons @?= Set.fromList [C.UnsupportedServiceTier "priority", C.ServiceTierMismatch "default" "priority"]+        assertBool "observed tier joins commitment" (Ev.usageEnvelope standard /= Ev.usageEnvelope priority),+      testCase "standard-only matches observed standard and fast remains an explicit estimate" $ do+        let u = N.normalizeUsage N.ExclusiveInput (N.ReportedUsage (Just 1000) (Just 0) (Just 0) (Just 0) Nothing)+            standard = U.observeBilling [U.BillingServiceTier "standard", U.BillingSpeed "standard"] u+            fast = U.observeBilling [U.BillingServiceTier "standard", U.BillingSpeed "fast"] u+        (computeCostForService Nothing (Just "standard_only") fable standard).basis.estimateReasons @?= Set.empty+        (computeCostForService Nothing Nothing fable fast).basis.estimateReasons @?= Set.singleton (C.UnsupportedSpeed "fast")+        (computeCostForService Nothing Nothing fable fast).usd @?= (computeCost fable u).usd,+      testCase "server-side tool products are explicitly outside token charges" $ do+        let u = U.observeBilling [U.BillingServiceTier "standard", U.BillingServerToolUse] (U.zeroUsage & #inputTokens .~ 1000)+        (computeCostForService Nothing Nothing fable u).basis.estimateReasons @?= Set.singleton C.AdditionalChargesExcluded,+      testCase "resolved rate seam prices a speed policy exactly once" $ do+        let u = U.zeroUsage & #inputTokens .~ 1000 & #outputTokens .~ 100+            doubled = M.ModelCost 20 100 2 25+            selected = computeCostAtRates doubled u+        selected.usd @?= 2 * (computeCost astra u).usd+        selected.basis.sources @?= Set.singleton C.ResolvedTokenRates,+      testCase "legacy availability JSON preserves its encoding without billing facts" $ do+        let old = Aeson.object ["missing_categories" Aeson..= ([] :: [U.UsageCategory]), "inconsistent" Aeson..= False]+        case Aeson.fromJSON old of+          Aeson.Success facts -> Aeson.toJSON (facts :: U.UsageAvailability) @?= old+          Aeson.Error err -> assertFailure err,+      testCase "context thresholds are exclusive and price the whole request" $+        forM_ [(271999, base), (272000, base), (272001, high)] $ \(n, expectedRates) -> do+          let u = U.zeroUsage & #inputTokens .~ n & #outputTokens .~ 100+          resolveRates Nothing astra u @?= Right expectedRates+          (computeCost astra u).usd @?= (fromIntegral n * expectedRates.inputCost + 100 * expectedRates.outputCost) / 1000000,+      testCase "272001 input plus 100 output costs exactly 5.44752" $+        (computeCost astra (U.zeroUsage & #inputTokens .~ 272001 & #outputTokens .~ 100)).usd @?= 544752 / 100000,+      testCase "cache reads and writes both contribute to context threshold" $ do+        forM_ [U.zeroUsage & #inputTokens .~ 272000 & #cacheReadTokens .~ 1, U.zeroUsage & #inputTokens .~ 272000 & #cacheWriteTokens .~ 1] $ \u -> resolveRates Nothing astra u @?= Right high+        resolveRates Nothing astra (U.zeroUsage & #cacheReadTokens .~ 136000 & #cacheWriteTokens .~ 136000) @?= Right base,+      testCase "Fable cache reads and shaped write duration use exact rates" $ do+        (computeCost fable (U.zeroUsage & #cacheReadTokens .~ 1000)).usd @?= 1 / 4000+        (computeCostWith (Just CacheRetentionShort) fable (U.zeroUsage & #cacheWriteTokens .~ 1000)).usd @?= 1 / 80+        (computeCostWith (Just CacheRetentionLong) fable (U.zeroUsage & #cacheWriteTokens .~ 1000)).usd @?= 1 / 50,+      testCase "reasoning is a subset of output, not an extra charge" $ do+        let u = U.zeroUsage & #outputTokens .~ 100+        computeCost astra (u & #reasoningTokens .~ Just 75) @?= computeCost astra u,+      testCase "flat policies retain base calculations" $ do+        let flat = astra & #pricingPolicy .~ Nothing+        resolveRates (Just CacheRetentionLong) flat (U.zeroUsage & #inputTokens .~ 900000) @?= Right base,+      testCase "duplicate, unordered and negative policy data are rejected" $ do+        forM_ [M.PricingPolicy [M.InputPriceTier 2 high, M.InputPriceTier 2 base] Nothing, M.PricingPolicy [M.InputPriceTier 2 high, M.InputPriceTier 1 base] Nothing, M.PricingPolicy [] (Just (-1)), M.PricingPolicy [M.InputPriceTier 1 (base & #inputCost .~ (-1))] Nothing] $ \p -> do+          assertBool "pure validation rejects" (case M.validatePricingPolicy p of Left _ -> True; _ -> False)+          case Aeson.fromJSON (Aeson.toJSON p) :: Aeson.Result M.PricingPolicy of Aeson.Error _ -> pure (); _ -> assertFailure "invalid policy decoded"+        let negative = Aeson.object ["inputTiers" Aeson..= [Aeson.object ["inputAbove" Aeson..= (-1 :: Int), "rates" Aeson..= base]]]+        case Aeson.fromJSON negative :: Aeson.Result M.PricingPolicy of Aeson.Error _ -> pure (); _ -> assertFailure "negative threshold decoded",+      testCase "old model JSON without a policy decodes and new policy round trips" $ do+        let old = case Aeson.toJSON M.emptyModel of Aeson.Object o -> Aeson.Object (KM.delete "pricingPolicy" o); v -> v+        case Aeson.fromJSON old of Aeson.Success m -> (m :: M.Model).pricingPolicy @?= Nothing; Aeson.Error err -> assertFailure err+        case Aeson.fromJSON (Aeson.toJSON astra) of Aeson.Success m -> (m :: M.Model) @?= astra; Aeson.Error err -> assertFailure err,+      testCase "estimated components retain reasons and provenance when summed" $ do+        let known = computeCost fable (U.zeroUsage & #cacheReadTokens .~ 1000)+            missing = C.estimateCost [C.CacheWriteUsageNotReported] known+            unknown = C.estimateCost [C.ServiceTierNotReported, C.CacheWriteUsageNotReported] known+            total = known <> missing <> unknown+        total.usd @?= 3 * known.usd+        total.basis.estimateReasons @?= Set.fromList [C.CacheWriteUsageNotReported, C.ServiceTierNotReported]+        total.basis.sources @?= Set.singleton C.StandardTokenRates+        mempty <> total @?= total+        total <> mempty @?= total+        (known <> missing) <> unknown @?= known <> (missing <> unknown)+        case Aeson.fromJSON (Aeson.toJSON total.basis) of Aeson.Success decoded -> decoded @?= total.basis; Aeson.Error err -> assertFailure err,+      testCase "unavailable prices carry an explicit estimate reason" $+        (computeCost M.emptyModel (U.zeroUsage & #inputTokens .~ 50)).basis.estimateReasons @?= Set.singleton C.PricingUnavailable+    ]++base :: M.ModelCost+base = M.ModelCost 10 50 1 (25 / 2)++high :: M.ModelCost+high = M.ModelCost 20 75 2 25++astra :: M.Model+astra = Models.openai_gpt_6_astra++fable :: M.Model+fable = Models.anthropic_claude_fable_5_1

@@ -21,6 +21,7 @@ import Baikai.Cost.Log (CallLogConfig (enabled, path), callLogConfig) import Baikai.Embedding qualified as Embedding import Data.Aeson (Value (Null))+import Data.Aeson qualified as Aeson import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Vector qualified as V@@ -32,7 +33,17 @@ tests =   testGroup     "public surface"-    [ testCase "every hidden record is buildable with record update alone" $ do+    [ testCase "Responses API and compatibility are public and serializable" $ do+        parseApi "openai-responses" @?= OpenAIResponses+        renderApi OpenAIResponses @?= "openai-responses"+        normaliseApi (Custom "openai-responses") @?= OpenAIResponses+        let model =+              (mkModel OpenAIResponses "probe" "https://api.openai.com")+                { compat = CompatOpenAIResponses defaultOpenAIResponsesCompat {supportsPromptCacheOptions = True}+                }+        (openaiResponsesCompatFor model).supportsPromptCacheOptions @?= True+        Aeson.fromJSON (Aeson.toJSON model) @?= Aeson.Success model,+      testCase "every hidden record is buildable with record update alone" $ do         probeTool.name @?= "probe"         probeLog.path @?= "/dev/null"         probeLog.enabled @?= True

@@ -76,7 +76,7 @@  signedThinking :: ThinkingContent signedThinking =-  ThinkingContent {thinking = "t", signature = Just "sig-abc", redacted = True}+  ThinkingContent {thinking = "t", signature = Just "sig-abc", redacted = True, replayState = Nothing}  tests :: TestTree tests =@@ -133,7 +133,7 @@         let expected =               Vector.fromList                 [ AssistantText (TextContent "first"),-                  AssistantThinking ThinkingContent {thinking = "partial-think", signature = Nothing, redacted = False},+                  AssistantThinking ThinkingContent {thinking = "partial-think", signature = Nothing, redacted = False, replayState = Nothing},                   AssistantText (TextContent "last"),                   AssistantToolCall ToolCall {id_ = "", name = "", arguments = Aeson.String "{\"a\":1"}                 ]@@ -339,7 +339,7 @@     resp ^. #message ^. #content       @?= Vector.fromList         [ AssistantText (TextContent "closed"),-          AssistantThinking ThinkingContent {thinking = "half a thought", signature = Nothing, redacted = False}+          AssistantThinking ThinkingContent {thinking = "half a thought", signature = Nothing, redacted = False, replayState = Nothing}         ]  -- | A terminal that carries no content is not authoritative about

@@ -299,7 +299,9 @@                   ThinkingDroppedUnsupportedHost lvl,                   ThinkingDroppedBudgetExceeded lvl 32000 8192,                   SamplingDroppedUnsupportedModel ["temperature"],-                  SamplingDroppedUnsupportedApi ["seed"]+                  SamplingDroppedUnsupportedApi ["seed"],+                  FastModeDroppedUnsupportedModel,+                  ThinkingSummaryUnavailable                 ]             ]     ]@@ -308,6 +310,8 @@ -- group above is separately identifiable when it fails. adjustmentName :: ThinkingAdjustment -> String adjustmentName = \case+  ThinkingSummaryUnavailable -> "summary unavailable"+  FastModeDroppedUnsupportedModel -> "fast mode dropped"   EffortClamped {} -> "clamped"   EffortCollapsedToToggle {} -> "collapsed"   EffortOmitted {} -> "omitted"

@@ -3,6 +3,7 @@ import Baikai.Api (Api (..)) import Baikai.Content (AssistantContent (..), TextContent (..)) import Baikai.Context (Context (..), emptyContext)+import Baikai.Cost qualified as Cost import Baikai.Error (BaikaiError, ErrorCategory (..), providerError) import Baikai.Evidence   ( ModelCallEvidence,@@ -487,6 +488,8 @@     .~ Just 4     & #totalTokens     .~ 26+    & #cost+    .~ Cost.estimateCost [Cost.ServiceTierNotReported] Cost.zeroCost  registerWithUsage :: Api -> Usage -> IO () registerWithUsage a u =@@ -503,7 +506,25 @@ fidelityTest =   testGroup     "CallFinished fidelity"-    [ testCase "carries the full disjoint token breakdown" $ do+    [ testCase "failed terminal retains the partial response billing" $ do+        let a = Custom "baikai-partial-billing"+            partial = stubResponse a & #message . #usage .~ richUsage & #message . #stopReason .~ ErrorReason & #message . #errorMessage .~ Just "reset"+            handler _ _ _ = pure partial+        registerApiProvider (apiProviderWith a (liftCompleteToStream handler) handler)+        (ref, sink) <- memorySink+        response <- withTrace sink (stubModel a) stubContext stubOptions+        events <- reverse <$> readTVarIO ref+        case [f | f@CallFailed {} <- events] of+          [CallFailed {inputTokens, outputTokens, cachedInputTokens, cacheWriteTokens, totalTokens, usd, costBasis}] -> do+            inputTokens @?= Just 11+            outputTokens @?= Just 7+            cachedInputTokens @?= Just 5+            cacheWriteTokens @?= Just 3+            totalTokens @?= Just 26+            usd @?= Just (Cost.usdAsScientific (response ^. #message . #usage . #cost))+            costBasis @?= Cost.nonEmptyBasis (response ^. #message . #usage . #cost)+          other -> assertFailure (show other),+      testCase "carries the full disjoint token breakdown" $ do         let a = Custom "baikai-trace-usage-fidelity"         registerWithUsage a richUsage         (ref, sink) <- memorySink@@ -520,7 +541,8 @@                 cachedInputTokens,                 cacheWriteTokens,                 reasoningTokens,-                totalTokens+                totalTokens,+                costBasis               }             ] -> do               inputTokens @?= Just 11@@ -529,6 +551,7 @@               cacheWriteTokens @?= Just 3               reasoningTokens @?= Just 4               totalTokens @?= Just 26+              costBasis @?= Just (Cost.basis (richUsage ^. #cost))           other -> assertFailure ("expected one CallFinished, got: " <> show other),       -- A zero cost used to be suppressed, which made "this call was       -- free" indistinguishable from "baikai could not price this@@ -623,6 +646,7 @@             Ev.effortText = Nothing,             Ev.budgetTokens = Just 1024,             Ev.wireField = Just "thinking",+            Ev.displayText = Nothing,             Ev.adjustments = []           }    in registerApiProvider@@ -1214,6 +1238,8 @@       cacheWriteTokens = Just 3,       reasoningTokens = Just 4,       totalTokens = Just 26,+      costBasis = Nothing,+      usageAvailability = Nothing,       usd = Just 0     } @@ -1225,5 +1251,14 @@       provider = "stub.trace",       model = "stub-1",       latencyMs = 12,+      inputTokens = Nothing,+      outputTokens = Nothing,+      cachedInputTokens = Nothing,+      cacheWriteTokens = Nothing,+      reasoningTokens = Nothing,+      totalTokens = Nothing,+      costBasis = Nothing,+      usageAvailability = Nothing,+      usd = Nothing,       errorMessage = "boom"     }

@@ -1,6 +1,6 @@ module UsageSpec (tests) where -import Baikai.Cost (Cost (..), CostBreakdown (..), zeroCost, zeroCostBreakdown)+import Baikai.Cost (Cost (..), CostBreakdown (..), standardCostBasis, zeroCost, zeroCostBreakdown) import Baikai.Usage (Usage (..), sumUsage, zeroUsage) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase, (@?=))@@ -35,7 +35,8 @@ costOf :: Rational -> Rational -> Rational -> Rational -> Cost costOf i o ci cw =   Cost-    { usd = (i + o + ci + cw) / 100,+    { basis = standardCostBasis,+      usd = (i + o + ci + cw) / 100,       breakdown =         CostBreakdown           { inputUsd = i / 100,