packages feed

baikai-claude 0.6.0.0 → 0.7.0.0

raw patch · 13 files changed

+816/−95 lines, 13 filesdep ~baikaidep ~http-client-tlsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: baikai, http-client-tls

API changes (from Hackage documentation)

+ Baikai.Provider.Claude.Internal.Request: planSpeed :: AnthropicMessagesCompat -> Maybe Speed -> (Maybe Speed, [ThinkingAdjustment])
+ Baikai.Provider.Claude.Internal.Stream: [cacheDuration] :: Assembler -> !Maybe CacheRetention
+ Baikai.Provider.Claude.Internal.Stream: [fastRequested] :: Assembler -> !Bool
+ Baikai.Provider.Claude.Internal.Stream: [stopDetails] :: Assembler -> !Maybe StopDetails
- Baikai.Provider.Claude.Internal.Stream: Assembler :: !Model -> !UTCTime -> !Maybe Text -> !IntMap AssistantContent -> !IntMap Text -> !IntMap Text -> !IntMap Text -> !IntMap Text -> !IntMap Text -> !IntMap (Text, Text) -> !Usage -> !StopReason -> !Observed Text -> !Observed Text -> !Maybe Int -> !Bool -> Assembler
+ Baikai.Provider.Claude.Internal.Stream: Assembler :: !Model -> !UTCTime -> !Maybe Text -> !IntMap AssistantContent -> !IntMap Text -> !IntMap Text -> !IntMap Text -> !IntMap Text -> !IntMap Text -> !IntMap (Text, Text) -> !Usage -> !Maybe CacheRetention -> !Bool -> !StopReason -> !Maybe StopDetails -> !Observed Text -> !Observed Text -> !Maybe Int -> !Bool -> Assembler

Files

CHANGELOG.md view
@@ -7,6 +7,206 @@  ## [Unreleased] +## [baikai 0.7.0.0] - 2026-09-08++### Added++- `BaikaiError.refusalCategory` preserves an Anthropic refusal's+  provider category. JSON adds `refusal_category`; older errors still decode.+  Evidence schema 2.5 records the addition without changing digest inputs.+  __Breaking__ to construct a `BaikaiError` from its full field list.++- `Speed`, `Options.speed`, catalog-owned fast rates and+  `computeCostAtSpeed`. Anthropic gates fast mode by model capability, adds the+  beta header and records unsupported drops. Terminal pricing uses observed+  speed, including cache duration; unreported speed is an explicit estimate.+  Older `Model` JSON defaults the new fields safely. __Breaking__: public+  records and sum types gain fields and constructors.++- API usage now records observed service tiers, inference speed and server-tool+  use in optional billing facts covered by evidence schema 2.2. Missing service+  information and uncurated products produce explicit standard-rate estimates.+  `computeCostForService` separates requested and observed service, while+  `computeCostAtRates` prices a resolved rate set once for future speed policies.+  Empty billing facts preserve legacy availability JSON; a CLI-reported zero+  cost retains its reported-total source. __Breaking__: the public vocabulary+  and records gain members.++- Failed trace terminals now retain partial response token counts, cost basis,+  usage availability and USD totals. Synthetic aborts leave unreported billing+  absent; legacy failed trace JSON still decodes. __Breaking__: `TraceEvent`'s+  `CallFailed` gains fields. See `baikai-trace-otel 0.4.0.1` for the export.++- Successful trace terminals and call-log records carry optional cost basis and+  usage availability; call logs also carry cache-write counts. Old JSON decodes+  with absent metadata and empty additive-zero bases stay omitted from traces.+  __Breaking__: `CallFinished` and the call-log record gain fields.++- Optional `Usage.availability` and shared inclusive/exclusive billing+  normalization, in the new `Baikai.Usage.Normalize`. OpenAI Chat/Responses and+  Claude preserve missing cache counters as explicit estimation reasons,+  distinguish reported zeroes, and merge cumulative usage without+  double-counting. Schema 2.2 commits provider availability while preserving+  legacy usage digests. __Breaking__: `Usage` gains a field.++- Optional `Model.pricingPolicy`, exact whole-request context tiers,+  and an explicit cache-duration rate resolver. Generated Astra pricing changes+  above 272000 input tokens; Fable exposes its one-hour write price. `Cost.basis`+  preserves calculation sources and estimation reasons when summed. Evidence+  schema 2.2 serializes the local basis without including local pricing metadata+  in provider commitments. __Breaking__: `Model` and `Cost` gain fields.++- Separate `OpenAIResponses` dispatch and compatibility types, and+  optional provider/model-scoped `ThinkingContent.replayState` with opaque+  diagnostic output and backward-compatible JSON decoding. Evidence schema 2.2+  includes replay state and optional billing facts in commitments while preserving+  legacy encodings when those fields are absent. __Breaking__ for a `case` over+  `Api` that is exhaustive without a wildcard.++- `Baikai.Evidence.ThinkingTranslation` gains `displayText` and+  `ThinkingAdjustment` gains `ThinkingSummaryUnavailable`, so a transport can+  record the thinking display setting it asked for and diagnose a successful+  response whose thinking blocks carry no readable summary. `Baikai.Compat`+  gains `supportsForcedToolChoice`; legacy JSON defaults it to True.+  __Breaking__ for an exhaustive `case` over `ThinkingAdjustment`.++- GPT-6 Astra and Claude Fable 5.1 catalog bindings, with verified+  pricing, token limits, and Anthropic thinking/sampling compatibility.++- Repository `update-models` skill for verifying provider releases and refreshing+  the curated JSON and generated Haskell catalog.++### Fixed++- Preserve OpenAI endpoint capability facts through catalog refreshes.++- Chat and Claude reject provider-scoped reasoning replay they cannot encode.++- Widened the `http-client-tls` bound to admit 0.4 (carried forward from the+  tagged but never-published 0.6.0.1).++## [baikai-claude 0.7.0.0] - 2026-09-08++### Changed++- Refusal messages include the reported category and explanation,+  retaining the original message when neither exists. Classification remains+  non-retryable `ContentFiltered`. Server-side fallbacks remain deliberately+  unsupported, as recorded in ADR 0005.++- Adaptive reasoning requests explicitly ask for summarized+  thinking. Evidence schema 2.4 records the display setting and diagnoses+  successful responses whose thinking blocks contain no readable summary.+  Budget and absent-thinking request shapes, signed empty blocks, redacted+  content and multi-turn replay are preserved.++- Fast mode is gated by the generated model capability: it adds the Anthropic+  beta header for a model that advertises it and records an evidence adjustment+  for one that does not.++### Fixed++- Price Fable cache writes using the TTL in the shaped request,+  including compatibility downgrades. Missing write-duration context is explicit+  in the cost basis.++- Reject forced tool choices locally on Fable 5.1, using the+  generated `supportsForcedToolChoice` capability. Automatic tool rounds retain+  signed empty/visible thinking, redacted blocks and prior-message order.++- Widened the `http-client-tls` bound to admit 0.4 (carried forward from the+  tagged but never-published 0.6.0.1).++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`.++## [baikai-openai 0.7.0.0] - 2026-09-08++### Added++- Explicit `Baikai.Provider.OpenAI.Responses` registration and+  stream/complete provider with stateless reasoning replay, function tool turns,+  structured output and bounded worker cleanup, across the new+  `Baikai.Provider.OpenAI.Responses.{Request,Stream,Assembler}` modules. Astra+  now selects this provider through a per-model catalog override; callers must+  register it explicitly. Cache writes, billing availability and context pricing+  are integrated.++- `Baikai.Provider.OpenAI.Internal.Usage`, the shared usage mapping both the+  Chat Completions and Responses transports read.++### Fixed++- Reject tools locally for models whose Chat Completions endpoint+  disallows them, including GPT-6 Astra. Respect generated effort policies and+  sampling restrictions, with matching translation evidence and strict refusal.++- Validate Responses terminals and enforce the stream contracts.++- Widened the `http-client-tls` bound to admit 0.4 (carried forward from the+  tagged but never-published 0.6.0.1).++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`.++## [baikai-trace-otel 0.4.0.1] - 2026-09-08++### Added++- Successful and failed spans export `baikai.cost.basis` and+  `baikai.usage.availability` as canonically encoded JSON. A failed span now+  also carries the input/output token counts and USD total that+  `baikai 0.7.0.0` retains on `CallFailed`, alongside its error status.++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`, and now depends on `aeson ^>=2.2` to encode the+  two new attributes.++## [baikai-effectful 0.4.0.1] - 2026-09-08++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`. No API change.++## [baikai-kit 0.2.0.1] - 2026-09-08++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`. No API change.++## [baikai-agent 0.2.0.1] - 2026-09-08++### Changed (dependencies)++- Requires `baikai ^>=0.7.0`, `baikai-claude ^>=0.7` and+  `baikai-openai ^>=0.7`. No API change.++## [baikai 0.6.0.1] - 2026-08-30++### Fixed++- widened the `http-client-tls` bound to admit 0.4. The 0.4 API retains the+  manager functions this package uses and belongs to the same TLS 2.x / Crypton+  1.1 dependency cohort as baikai 0.6; the old `^>=0.3` cap made baikai 0.6+  impossible to solve in applications that require Crypton 1.1.++## [baikai-claude 0.6.0.1] - 2026-08-30++### Fixed++- widened the `http-client-tls` bound to admit 0.4, allowing applications that+  require Crypton 1.1 to solve the dependency set.++## [baikai-openai 0.6.0.1] - 2026-08-30++### Fixed++- widened the `http-client-tls` bound to admit 0.4, allowing applications that+  require Crypton 1.1 to solve the dependency set.+ ## [baikai 0.6.0.0] - 2026-08-28  ### Added
baikai-claude.cabal view
@@ -1,6 +1,6 @@ cabal-version:   3.4 name:            baikai-claude-version:         0.6.0.0+version:         0.7.0.0 synopsis:        Anthropic Claude providers for the baikai abstraction description:   Anthropic backends for baikai: the Messages API over SSE, the claude -p batch@@ -65,7 +65,7 @@   autogen-modules: Paths_baikai_claude   build-depends:     , aeson              ^>=2.2-    , baikai             ^>=0.6.0+    , baikai             ^>=0.7.0     , base               >=4.20   && <5     , base16-bytestring  ^>=1.0     , base64-bytestring  ^>=1.2@@ -78,7 +78,7 @@     , crypton            >=1.0    && <1.2     , generic-lens       ^>=2.3     , http-client        ^>=0.7-    , http-client-tls    ^>=0.3+    , http-client-tls    >=0.3    && <0.5     , http-types         ^>=0.12     , lens               ^>=5.3     , servant-client     ^>=0.20@@ -98,6 +98,7 @@     Contract     ErrorClassSpec     EvidenceSpec+    FableContractsSpec     LifecycleSpec     MidStreamSpec     PublicSurfaceSpec@@ -110,7 +111,7 @@   ghc-options:    -threaded -with-rtsopts=-N   build-depends:     , aeson-    , baikai            ^>=0.6.0+    , baikai            ^>=0.7.0     , baikai-claude     , base              >=4.20   && <5     , bytestring
src/Baikai/Provider/Claude/Agent.hs view
@@ -138,6 +138,7 @@             effortText = Just wire,             budgetTokens = Nothing,             wireField = Just "--effort",+            displayText = Nothing,             adjustments = [EffortClamped lvl wire | wire /= renderThinkingLevel lvl]           } 
src/Baikai/Provider/Claude/Cli.hs view
@@ -166,6 +166,7 @@             effortText = Just wire,             budgetTokens = Nothing,             wireField = Just "--effort",+            displayText = Nothing,             adjustments = [Ev.EffortClamped lvl wire | wire /= renderThinkingLevel lvl]           } 
src/Baikai/Provider/Claude/Internal/Request.hs view
@@ -8,6 +8,7 @@ module Baikai.Provider.Claude.Internal.Request   ( mapRequest,     planRequest,+    planSpeed,     planThinking,     describeThinkingFor,     ThinkingPlan (..),@@ -32,6 +33,7 @@ import Baikai.Model (Model, anthropicMessagesCompatFor) import Baikai.Options (Options (..)) import Baikai.ResponseFormat (JsonSchemaFormat (..), ResponseFormat (..))+import Baikai.Speed (Speed (..)) import Baikai.ThinkingLevel (ThinkingLevel (..), renderThinkingLevel, thinkingTokenBudget) import Baikai.Tool qualified as Tool import Claude.V1.Messages qualified as Messages@@ -77,6 +79,24 @@ mapRequest ::   Model -> Context -> Options -> Either Text (Messages.CreateMessage, ThinkingTranslation) mapRequest m ctx opts = do+  case opts ^. #toolChoice of+    Just Tool.ToolChoiceRequired | not (anthropicMessagesCompatFor m).supportsForcedToolChoice -> unsupportedForcedChoice+    Just (Tool.ToolChoiceSpecific _) | not (anthropicMessagesCompatFor m).supportsForcedToolChoice -> unsupportedForcedChoice+    _ -> pure ()+  mapM_+    ( \msg -> case msg of+        Msg.AssistantMessage payload ->+          mapM_+            ( \block -> case block of+                Content.AssistantThinking th+                  | Just _ <- Content.replayState th ->+                      Left "This endpoint cannot replay provider-scoped reasoning state; use its originating API and model"+                _ -> pure ()+            )+            (payload ^. #content)+        _ -> pure ()+    )+    (ctx ^. #messages)   msgs <- catMaybes <$> traverse mapMessage (Vector.toList (ctx ^. #messages))   let compat = anthropicMessagesCompatFor m       cap = m ^. #maxOutputTokens@@ -109,12 +129,16 @@           Messages.tools = toolsField,           Messages.tool_choice = toolChoiceField,           Messages.cache_control = cacheControlField,+          Messages.speed = fst (planSpeed compat (opts ^. #speed)),           Messages.thinking = field plan,           Messages.output_config = outputConfigField         },       translation     ) +unsupportedForcedChoice :: Either Text ()+unsupportedForcedChoice = Left "This model does not support forced tool choice; use ToolChoiceAuto or ToolChoiceNone"+ -- | The sampling parameters that will reach the wire, after the compat -- record's gate. 'Nothing' means the field is omitted — the SDK encodes -- 'Messages.CreateMessage' with @omitNothingFields = True@, so a@@ -185,7 +209,7 @@ -- separately: one is a fact about the model, the other about the API. planRequest :: Model -> Options -> (ThinkingPlan, SamplingPlan, ThinkingTranslation) planRequest m opts =-  (plan, sampling, translation & #adjustments %~ (<> samplingAdjustments))+  (plan, sampling, translation & #adjustments %~ (<> (samplingAdjustments <> snd (planSpeed compat (opts ^. #speed)))))   where     compat = anthropicMessagesCompatFor m     cap = m ^. #maxOutputTokens@@ -201,7 +225,7 @@             )       _ -> (plan0, translation0) -    gated = not (supportsSamplingParameters compat)+    gated = not (compat ^. #supportsSamplingParameters)     sampling       | gated = SamplingPlan {temperature = Nothing, topP = Nothing}       | otherwise =@@ -315,6 +339,9 @@ -- provider-neutral description of what the caller's level became. -- -- The two travel together because they are two views of one decision.+-- Adaptive requests explicitly ask for summarized display, using the catalog+-- thinking style. Budget requests retain their existing provider default.+-- Display changes visibility only; it does not establish reasoning depth. -- Returning only the first is what this provider used to do, and it is -- why a caller could never tell an honoured request from a dropped one. computeThinking ::@@ -332,13 +359,14 @@             effortText = Nothing,             budgetTokens = Nothing,             wireField = Nothing,+            displayText = Nothing,             adjustments = [ThinkingDroppedUnsupportedModel lvl]           }       )   | thinkingStyle compat == AnthropicThinkingAdaptive =       let e = adaptiveEffort lvl        in ( ThinkingPlan-              { field = Just Messages.ThinkingAdaptive,+              { field = Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized),                 effort = e,                 budget = Nothing               },@@ -348,6 +376,7 @@                 effortText = e,                 budgetTokens = Nothing,                 wireField = Just "thinking",+                displayText = Just "summarized",                 adjustments = adaptiveAdjustments lvl e               }           )@@ -366,6 +395,7 @@                 -- A budget expresses the requested level exactly, so                 -- there is nothing to adjust.                 wireField = Just "thinking",+                displayText = Nothing,                 adjustments = []               }           )@@ -407,6 +437,7 @@     & #effortText .~ Nothing     & #budgetTokens .~ Nothing     & #wireField .~ Nothing+    & #displayText .~ Nothing     & #adjustments %~ (<> [adj])  -- | Map a baikai 'Tool.Tool' into the upstream Anthropic@@ -637,3 +668,12 @@ nonEmpty t   | Text.null t = Nothing   | otherwise = Just t++-- | One capability gate shared by wire mapping, headers and the describer.+planSpeed :: AnthropicMessagesCompat -> Maybe Speed -> (Maybe Messages.Speed, [ThinkingAdjustment])+planSpeed compat = \case+  Nothing -> (Nothing, [])+  Just SpeedStandard -> (Just Messages.SpeedStandard, [])+  Just SpeedFast+    | compat ^. #supportsFastMode -> (Just Messages.SpeedFast, [])+    | otherwise -> (Nothing, [FastModeDroppedUnsupportedModel])
src/Baikai/Provider/Claude/Internal/Stream.hs view
@@ -29,9 +29,10 @@   ) where +import Baikai.CacheRetention (CacheRetention (..)) import Baikai.Content qualified as Content import Baikai.Context (Context (..))-import Baikai.Cost (zeroCost)+import Baikai.Cost (CostEstimateReason (CacheDurationNotReported, SpeedNotReported), estimateCost) import Baikai.Cost.Pricing qualified as Pricing import Baikai.Error (BaikaiError, contentFiltered, invalidRequest, providerError) import Baikai.Evidence qualified as Ev@@ -66,11 +67,14 @@   ) import Baikai.Url qualified as Url import Baikai.Usage qualified as Usage+import Baikai.Usage.Normalize qualified as Normalize import Claude.V1.Messages qualified as Messages+import Control.Applicative ((<|>)) import Control.Exception (SomeAsyncException (..), SomeException, fromException, throwIO, try) import Control.Lens ((%~), (&), (.~), (^.)) import Data.Aeson (Value) import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Lazy qualified as BSL import Data.CaseInsensitive qualified as CI import Data.Generics.Labels ()@@ -79,6 +83,7 @@ import Data.IntMap.Strict qualified as IntMap import Data.IntSet qualified as IntSet import Data.Maybe (fromMaybe)+import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text@@ -136,7 +141,7 @@         -- separately by 'Transport.requestHeaders'.         mkEvidence <-           Build.prepareEvidenceAt-            (call ^. #baseUrl)+            (Text.pack (Client.showBaseUrl (Client.baseUrl (call ^. #clientEnv))) <> "/v1/messages")             m             opts             Ev.TransportHttpApi@@ -161,7 +166,10 @@                             responseId = Nothing                           }                     ],-                  assembler = emptyAssembler m startTime,+                  assembler =+                    emptyAssembler m startTime+                      & #cacheDuration .~ shapedCacheDuration (call ^. #requestBody)+                      & #fastRequested .~ shapedFastRequested (call ^. #requestBody),                   finished = False,                   terminalRef = tref,                   metadataRef = mref,@@ -393,8 +401,9 @@ -- unconditionally, because each costs a lookup and each improves the -- 'Baikai.Response.Response' for every caller. ----- Nothing here consults the request. An observation the provider did not--- make stays 'Ev.Unobserved'.+-- Observed fields never borrow the request. An observation the provider did+-- not make stays 'Ev.Unobserved'. The separate summary diagnostic relates+-- the translated request to completed blocks without claiming observed effort. observeAnthropic ::   Ev.CallStatus -> Assembler -> Ev.ModelCallEvidence -> Ev.ModelCallEvidence observeAnthropic st ass ev =@@ -404,6 +413,7 @@     & #providerRequestId .~ (ass ^. #providerRequestId)     & #responseId .~ maybe Ev.Unobserved Ev.Observed (ass ^. #responseId)     & #usage .~ observedUsage ass+    & #thinking . #adjustments %~ (<> summaryDiagnostics st ass (ev ^. #thinking))     & #responseCommitment .~ responseCommitment st ass     & #strength       .~ Ev.deriveStrength@@ -411,6 +421,23 @@         (ass ^. #providerRequestId)         (maybe Ev.Unobserved Ev.Observed (ass ^. #responseId)) +-- | Diagnose visibility after a successful response, without inventing an+-- observation of effort or weakening the original translation. Adaptive calls+-- may legitimately contain no thinking blocks. Failed streams may simply have+-- stopped before text arrived, so neither case claims an unavailable summary.+summaryDiagnostics :: Ev.CallStatus -> Assembler -> Ev.ThinkingTranslation -> [Ev.ThinkingAdjustment]+summaryDiagnostics st ass translation+  | st == Ev.CallSucceeded,+    Just _ <- translation ^. #requested,+    translation ^. #mode `elem` [Ev.ThinkingModeAdaptive, Ev.ThinkingModeBudget],+    not (null thinkingBlocks),+    all unreadable thinkingBlocks =+      [Ev.ThinkingSummaryUnavailable]+  | otherwise = []+  where+    thinkingBlocks = [t | Content.AssistantThinking t <- Vector.toList (blocksInOrder ass)]+    unreadable t = t ^. #redacted || Text.null (t ^. #thinking)+ -- | The token accounting, but only if Anthropic actually reported it. -- -- The assembler initialises 'usage' to zeroes, so reporting it@@ -551,7 +578,11 @@     toolArgsBuf :: !(IntMap Text),     toolMeta :: !(IntMap (Text, Text)),     usage :: !Usage.Usage,+    cacheDuration :: !(Maybe CacheRetention),+    fastRequested :: !Bool,     stopReason :: !Stop.StopReason,+    -- | Refusal detail reported in the delta, consumed at message_stop.+    stopDetails :: !(Maybe Messages.StopDetails),     -- | Anthropic's own correlation identifier for this call, from the     -- response headers.     providerRequestId :: !(Ev.Observed Text),@@ -585,7 +616,10 @@       toolArgsBuf = IntMap.empty,       toolMeta = IntMap.empty,       usage = Usage.zeroUsage,+      cacheDuration = Nothing,+      fastRequested = False,       stopReason = Stop.Stop,+      stopDetails = Nothing,       providerRequestId = Ev.Unobserved,       observedModel = Ev.Unobserved,       httpStatus = Nothing,@@ -650,27 +684,35 @@         -- 'Messages.StreamUsage' has no 'GHC.Generics.Generic' instance,         -- so these are record dots rather than the generic-lens labels         -- used for 'Messages.Usage'.-        inputFinal = fromMaybe (u ^. #inputTokens) su.stream_input_tokens-        outputFinal = su.output_tokens-        cacheReadFinal = fromMaybe (u ^. #cacheReadTokens) su.stream_cache_read_input_tokens-        cacheWriteFinal = fromMaybe (u ^. #cacheWriteTokens) su.stream_cache_creation_input_tokens-        reasoningFinal = case su.stream_output_tokens_details of-          Just d -> Just d.thinking_tokens-          Nothing -> u ^. #reasoningTokens+        known category getter = case u ^. #availability of+          Just facts | category `Set.notMember` Usage.missingCategories facts -> Just (getter u)+          _ -> Nothing         u' =-          u-            & #inputTokens .~ inputFinal-            & #outputTokens .~ outputFinal-            & #cacheReadTokens .~ cacheReadFinal-            & #cacheWriteTokens .~ cacheWriteFinal-            & #reasoningTokens .~ reasoningFinal-            & #totalTokens .~ (inputFinal + outputFinal + cacheReadFinal + cacheWriteFinal)-     in ([], ass & #stopReason .~ stopR & #usage .~ u' & #usageReported .~ True)+          Usage.observeBilling (maybe [] (Set.toList . Usage.billingFacts) (u ^. #availability) <> toolBilling su.stream_server_tool_use) $+            Normalize.normalizeUsage+              Normalize.ExclusiveInput+              ( Normalize.ReportedUsage+                  (su.stream_input_tokens <|> known Usage.InputUsage Usage.inputTokens)+                  (Just su.output_tokens)+                  (su.stream_cache_read_input_tokens <|> known Usage.CacheReadUsage Usage.cacheReadTokens)+                  (su.stream_cache_creation_input_tokens <|> known Usage.CacheWriteUsage Usage.cacheWriteTokens)+                  ((Messages.thinking_tokens <$> su.stream_output_tokens_details) <|> (u ^. #reasoningTokens))+              )+     in ([], ass & #stopReason .~ stopR & #stopDetails .~ (md ^. #stop_details) & #usage .~ u' & #usageReported .~ True)   Messages.Message_Stop ->     let reason = ass ^. #stopReason         -- A refusal is a filter: the content, not the transport, is         -- the problem, and a caller can branch on the category.-        refusal = contentFiltered "Anthropic refused to generate a response (stop_reason=refusal)"+        details = ass ^. #stopDetails+        refusalCategory = details >>= (\d -> d.category)+        explanation = details >>= (\d -> d.explanation)+        refusal =+          contentFiltered+            ( "Anthropic refused to generate a response (stop_reason=refusal)"+                <> maybe "" (\c -> " [category=" <> c <> "]") refusalCategory+                <> maybe "" (": " <>) explanation+            )+            & #refusalCategory .~ refusalCategory         msg =           if reason == Stop.ErrorReason             then finalMessageOnError ass now (refusal ^. #message)@@ -772,7 +814,8 @@             Content.ThinkingContent               { Content.thinking = payload,                 Content.signature = Nothing,-                Content.redacted = True+                Content.redacted = True,+                Content.replayState = Nothing               }           block = Content.AssistantThinking thinkingContent        in ( [ThinkingEnd ThinkingEndPayload {contentIndex = i, content = thinkingContent}],@@ -786,7 +829,8 @@             Content.ThinkingContent               { Content.thinking = body,                 Content.signature = if maybe True Text.null sig then Nothing else sig,-                Content.redacted = False+                Content.redacted = False,+                Content.replayState = Nothing               }           block = Content.AssistantThinking thinkingContent        in ( [ThinkingEnd ThinkingEndPayload {contentIndex = i, content = thinkingContent}],@@ -841,21 +885,31 @@ -- Shared so the terminal message and the evidence record cannot report -- two different figures for one call. ----- __Known limitation: cache writes are priced at one rate.__ Anthropic--- bills a one-hour ('Baikai.CacheRetention.CacheRetentionLong') cache--- write at roughly twice the five-minute rate, but the catalog carries a--- single @cacheWriteCost@ — the five-minute one — and the SDK's--- 'Messages.Usage' reports a single @cache_creation_input_tokens@ with--- no per-TTL split (see 'anthroUsageToBaikai'). A long-retention write--- is therefore /under-stated/ here. Token counts are unaffected; only--- the dollar figure is low. Fixing it needs a second value carried off--- the worker channel, a second field inside the evidence record, and a--- second rate models.dev does not publish.+-- The duration comes from the shaped request body, so a compatibility+-- downgrade to a short cache cannot accidentally incur the long-write rate. finalUsage :: Assembler -> Usage.Usage finalUsage ass =-  let usageBare = ass ^. #usage-   in usageBare & #cost .~ Pricing.computeCost (ass ^. #model) usageBare+  let usageBare = if ass ^. #usageReported then ass ^. #usage else Normalize.normalizeUsage Normalize.ExclusiveInput (Normalize.ReportedUsage Nothing Nothing Nothing Nothing Nothing)+      calculated = Pricing.computeCostForService (ass ^. #cacheDuration) Nothing (ass ^. #model) usageBare+      reasons =+        [CacheDurationNotReported | usageBare ^. #cacheWriteTokens > 0, Nothing <- [ass ^. #cacheDuration]]+          <> [SpeedNotReported | ass ^. #fastRequested, not (any isSpeed (maybe [] (Set.toList . Usage.billingFacts) (usageBare ^. #availability)))]+      isSpeed (Usage.BillingSpeed _) = True+      isSpeed _ = False+   in usageBare & #cost .~ estimateCost reasons calculated +shapedFastRequested :: Aeson.Value -> Bool+shapedFastRequested (Aeson.Object body) = KeyMap.lookup "speed" body == Just (Aeson.String "fast")+shapedFastRequested _ = False++shapedCacheDuration :: Aeson.Value -> Maybe CacheRetention+shapedCacheDuration (Aeson.Object body) = case KeyMap.lookup "cache_control" body of+  Just (Aeson.Object marker) -> Just $ case KeyMap.lookup "ttl" marker of+    Just (Aeson.String "1h") -> CacheRetentionLong+    _ -> CacheRetentionShort+  _ -> Nothing+shapedCacheDuration _ = Nothing+ finalMessage :: Assembler -> UTCTime -> Msg.Message finalMessage ass now =   Msg.AssistantMessage@@ -947,26 +1001,25 @@ -- output tokens rather than a billed class of its own, so it moves no -- total. ----- @cache_creation_input_tokens@ is one number covering both cache-write--- TTLs. The SDK's 'Messages.Usage' has no per-TTL breakdown, so baikai--- cannot tell a five-minute write from a one-hour one and prices both at--- the catalog's single @cacheWriteCost@; see 'finalUsage' and--- @docs\/user\/prompt-caching.md@.+-- @cache_creation_input_tokens@ is a total across cache writes. The final+-- calculation uses the duration selected by the actual shaped request body. anthroUsageToBaikai :: Messages.Usage -> Usage.Usage anthroUsageToBaikai u =-  let i = u ^. #input_tokens-      o = u ^. #output_tokens-      cr = fromMaybe 0 (u ^. #cache_read_input_tokens)-      cw = fromMaybe 0 (u ^. #cache_creation_input_tokens)-   in Usage.Usage-        { Usage.inputTokens = i,-          Usage.outputTokens = o,-          Usage.cacheReadTokens = cr,-          Usage.cacheWriteTokens = cw,-          Usage.reasoningTokens = fmap (^. #thinking_tokens) (u ^. #output_tokens_details),-          Usage.totalTokens = i + o + cr + cw,-          Usage.cost = zeroCost-        }+  Usage.observeBilling ([Usage.BillingServiceTier tier | Just tier <- [u ^. #service_tier]] <> [Usage.BillingSpeed speed | Just value <- [u ^. #speed], Aeson.String speed <- [Aeson.toJSON value]] <> toolBilling (u ^. #server_tool_use)) $+    Normalize.normalizeUsage+      Normalize.ExclusiveInput+      ( Normalize.ReportedUsage+          (Just (u ^. #input_tokens))+          (Just (u ^. #output_tokens))+          (u ^. #cache_read_input_tokens)+          (u ^. #cache_creation_input_tokens)+          (fmap (^. #thinking_tokens) (u ^. #output_tokens_details))+      )++-- Server-side tool products are outside the token-rate calculation.+toolBilling :: Maybe Messages.ServerToolUseUsage -> [Usage.BillingFact]+toolBilling Nothing = []+toolBilling (Just usage) = [Usage.BillingServerToolUse | fromMaybe 0 (usage ^. #web_search_requests) + fromMaybe 0 (usage ^. #tool_search_requests) > 0]  mapStopReason :: Maybe Messages.StopReason -> Stop.StopReason mapStopReason = \case
src/Baikai/Provider/Claude/Transport.hs view
@@ -25,6 +25,8 @@ import Baikai.Message qualified as Msg import Baikai.Model (Model (..)) import Baikai.Options (Options (..))+import Baikai.Provider.Claude.Internal.Request (planSpeed)+import Claude.V1.Messages qualified as Messages import Control.Exception (throwIO) import Control.Lens ((^.)) import Crypto.Hash (Digest, SHA256)@@ -55,12 +57,16 @@         id         (\v -> (("anthropic-version", Text.encodeUtf8 v) :))         anthropicVersion-        ( sessionHeaders+        ( speedHeaders+            <> sessionHeaders             <> [ ("x-api-key", Text.encodeUtf8 apiKey),                  ("Accept", "text/event-stream"),                  ("Content-Type", "application/json")                ]         )+    speedHeaders = case fst (planSpeed compat (opts ^. #speed)) of+      Just Messages.SpeedFast -> [("anthropic-beta", "fast-mode-2026-02-01")]+      _ -> []     sessionHeaders =       if sendSessionAffinityHeaders compat         then [("x-session-affinity", Text.encodeUtf8 (sessionAffinityValue ctx))]@@ -142,7 +148,8 @@       message = "provider stream exceeded timeoutMs=" <> Text.pack (show ms),       httpStatus = Nothing,       retryAfterSeconds = Nothing,-      exitCode = Nothing+      exitCode = Nothing,+      refusalCategory = Nothing     }  -- | Apply caller overrides over the provider's own headers.
test/EvidenceSpec.hs view
@@ -224,7 +224,7 @@       oneEvidence         =<< replayWith (testModel & #baseUrl .~ "") 200 successHeaders successBody baseOptions     case field "endpoint" ev of-      Just (Object e) -> KeyMap.lookup "endpoint" e @?= Just (String "https://api.anthropic.com")+      Just (Object e) -> KeyMap.lookup "endpoint" e @?= Just (String "https://api.anthropic.com/v1/messages")       other -> assertFailure ("expected an endpoint identity, got: " <> show other)  -- | A response that names its model and its message id but carries no@@ -382,7 +382,7 @@           testModel             & #compat               .~ CompatAnthropicMessages-                (defaultAnthropicMessagesCompat {supportsSamplingParameters = False})+                (defaultAnthropicMessagesCompat & #supportsSamplingParameters .~ False)     ev <-       oneEvidence         =<< replayWith
+ test/FableContractsSpec.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE OverloadedRecordDot #-}++module FableContractsSpec (tests) where++import Baikai hiding (messages, model)+import Baikai.Models.Generated (anthropic_claude_fable_5_1)+import Baikai.Provider.Claude.Internal.Request qualified as R+import Baikai.Provider.Claude.Internal.Stream (SseDriver, claudeMessagesStreamWith)+import Claude.V1.Messages qualified as C+import Contract (assertErrorContract)+import Control.Lens ((&), (.~), (^.))+import Control.Monad (forM_)+import Data.Aeson (Value (..), object, (.=))+import Data.Aeson qualified as Aeson+import Data.Aeson.Key (Key)+import Data.Aeson.KeyMap qualified as KM+import Data.IORef (newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector qualified as V+import Streamly.Data.Stream qualified as Stream+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+  testGroup+    "Fable contracts"+    [ summaryTests,+      testCase "forced choices fail before the driver for complete and stream, including renamed models" $+        forM_ [model, model & #modelId .~ "renamed-generation"] $ \m ->+          forM_ [ToolChoiceRequired, ToolChoiceSpecific "lookup"] $ \choice -> do+            sent <- newIORef False+            let never _ _ _ = writeIORef sent True+                opts = options & #toolChoice .~ Just choice+            events <- Stream.toList (claudeMessagesStreamWith never m context opts)+            assertErrorContract events+            response <- streamingComplete (claudeMessagesStreamWith never) m context opts+            fmap (.category) (responseError response) @?= Just InvalidRequest+            assertBool "useful correction" (maybe False (T.isInfixOf "ToolChoiceAuto" . (.message)) (responseError response))+            readIORef sent >>= (@?= False),+      testCase "auto and none keep their exact wire meaning" $+        forM_ [(ToolChoiceAuto, "auto"), (ToolChoiceNone, "none")] $ \(choice, expected) -> do+          body <- newIORef Null+          let capture call _ emit = writeIORef body (call ^. #requestBody) >> send finalTurn emit+          _ <- streamingComplete (claudeMessagesStreamWith capture) model context (options & #toolChoice .~ Just choice)+          raw <- readIORef body+          (field "tool_choice" raw >>= field "type") @?= Just (String expected),+      testCase "supporting compatibility retains required and named choice" $+        forM_ [(ToolChoiceRequired, "any"), (ToolChoiceSpecific "lookup", "tool")] $ \(choice, expected) -> do+          let m = model & #modelId .~ "supporting-generation" & #compat .~ CompatAnthropicMessages (anthropicMessagesCompatFor model & #supportsForcedToolChoice .~ True)+          (req, _) <- either (\e -> assertFailure (T.unpack e) >> fail "map") pure (R.mapRequest m context (options & #toolChoice .~ Just choice))+          (field "tool_choice" (Aeson.toJSON req) >>= field "type") @?= Just (String expected),+      testCase "unset effort is no preference and small caps never create a manual budget" $+        forM_ [Nothing, Just ThinkingMinimal, Just ThinkingLow, Just ThinkingMedium, Just ThinkingHigh, Just ThinkingXHigh, Just ThinkingMax] $ \level -> do+          let opts = options & #thinking .~ level & #maxTokens .~ Just 1+          (req, translation) <- either (\e -> assertFailure (T.unpack e) >> fail "map") pure (R.mapRequest model context opts)+          let raw = Aeson.toJSON req+          field "max_tokens" raw @?= Just (Number 1)+          translation @?= R.describeThinkingFor model opts+          case level of+            Nothing -> do+              field "thinking" raw @?= Nothing+              translation @?= noThinkingRequested+            Just _ -> do+              (field "thinking" raw >>= field "type") @?= Just (String "adaptive")+              (field "thinking" raw >>= field "budget_tokens") @?= Nothing,+      testCase "legacy serialized compat defaults to supporting forced choice" $ do+        let raw = case Aeson.toJSON defaultAnthropicMessagesCompat of Object o -> Object (KM.delete "supportsForcedToolChoice" o); v -> v+        case Aeson.fromJSON raw of+          Aeson.Success c -> (c :: AnthropicMessagesCompat).supportsForcedToolChoice @?= True+          Aeson.Error err -> assertFailure err,+      testCase "two consecutive tool rounds preserve signed empty, visible and redacted thinking" $ do+        requests <- newIORef ([] :: [Value])+        executed <- newIORef ([] :: [Text])+        let scripted call _ emit = do+              previous <- readIORef requests+              writeIORef requests (previous <> [call ^. #requestBody])+              send (case length previous of 0 -> toolTurn "" "sig-one" "toolu_1" True; 1 -> toolTurn "visible summary" "sig-two" "toolu_2" False; _ -> finalTurn) emit+        reg <- newProviderRegistryFrom [apiProvider AnthropicMessages (claudeMessagesStreamWith scripted)]+        (history, response) <- runToolLoopWith reg 4 (\tc -> do xs <- readIORef executed; writeIORef executed (xs <> [tc.id_]); pure (toolResultText "found")) model context summaryOptions+        response.message.content @?= V.singleton (AssistantText (TextContent "done"))+        readIORef executed >>= (@?= ["toolu_1", "toolu_2"])+        bodies <- readIORef requests+        length bodies @?= 3+        case bodies of+          [first, second, third] -> do+            let a = messages first; b = messages second; c = messages third+            V.take (V.length a) b @?= a+            V.take (V.length b) c @?= b+            field "system" first @?= field "system" third+            field "tools" first @?= field "tools" third+            forM_ bodies $ \body -> (field "thinking" body >>= field "display") @?= Just (String "summarized")+            contentAt 1 b @?= V.fromList [signed "" "sig-one", redactedItem, toolItem "toolu_1"]+            contentAt 3 c @?= V.fromList [signed "visible summary" "sig-two", toolItem "toolu_2"]+            field "tool_use_id" (contentAt 2 b V.! 0) @?= Just (String "toolu_1")+            field "tool_use_id" (contentAt 4 c V.! 0) @?= Just (String "toolu_2")+            persisted <- V.mapM persistThinking (history ^. #messages)+            (req, _) <- either (\e -> assertFailure (T.unpack e) >> fail "map") pure (R.mapRequest model (history & #messages .~ persisted) summaryOptions)+            messages (Aeson.toJSON req) @?= c+          _ -> assertFailure "expected three requests",+      testCase "error cleanup retains completed signed thinking for persistence" $ do+        let partial _ _ emit = send (take 4 (toolTurn "" "sig-one" "toolu_1" False)) emit >> emit (Left (providerError "interrupted"))+        response <- streamingComplete (claudeMessagesStreamWith partial) model context options+        assertBool "failed response" (responseError response /= Nothing)+        case V.toList response.message.content of+          [AssistantThinking t] -> do+            t.thinking @?= ""+            t.signature @?= Just "sig-one"+            t.replayState @?= Nothing+          _ -> assertFailure "signed state was discarded on error"+    ]++model :: Model+model = anthropic_claude_fable_5_1++options :: Options+options = emptyOptions & #apiKey .~ Just (ApiKeyLiteral "offline-key")++context :: Context+context = systemUser "unchanged system" "look twice" & #tools .~ V.singleton (mkTool "lookup" "lookup" (object ["type" .= ("object" :: Text)]))++send :: [Value] -> (Either BaikaiError C.MessageStreamEvent -> IO ()) -> IO ()+send frames emit = forM_ frames $ \raw -> case Aeson.fromJSON raw of+  Aeson.Error err -> assertFailure err+  Aeson.Success ev -> emit (Right ev)++start :: Value+start = object ["type" .= ("message_start" :: Text), "message" .= object ["id" .= ("msg" :: Text), "type" .= ("message" :: Text), "role" .= ("assistant" :: Text), "model" .= ("claude-fable-5-1" :: Text), "content" .= ([] :: [Value]), "usage" .= object ["input_tokens" .= (5 :: Int), "output_tokens" .= (0 :: Int)]]]++block :: Int -> Value -> Value+block n b = object ["type" .= ("content_block_start" :: Text), "index" .= n, "content_block" .= b]++stopBlock :: Int -> Value+stopBlock n = object ["type" .= ("content_block_stop" :: Text), "index" .= n]++end :: Text -> [Value]+end reason = [object ["type" .= ("message_delta" :: Text), "delta" .= object ["stop_reason" .= reason], "usage" .= object ["output_tokens" .= (5 :: Int)]], object ["type" .= ("message_stop" :: Text)]]++signed :: Text -> Text -> Value+signed text sig = object ["type" .= ("thinking" :: Text), "thinking" .= text, "signature" .= sig]++redactedItem :: Value+redactedItem = object ["type" .= ("redacted_thinking" :: Text), "data" .= ("encrypted-redacted" :: Text)]++toolItem :: Text -> Value+toolItem ident = object ["type" .= ("tool_use" :: Text), "id" .= ident, "name" .= ("lookup" :: Text), "input" .= object []]++toolTurn :: Text -> Text -> Text -> Bool -> [Value]+toolTurn text sig ident redacted =+  [start, block 0 (signed "" "")]+    <> (if T.null text then [] else [object ["type" .= ("content_block_delta" :: Text), "index" .= (0 :: Int), "delta" .= object ["type" .= ("thinking_delta" :: Text), "thinking" .= text]]])+    <> [object ["type" .= ("content_block_delta" :: Text), "index" .= (0 :: Int), "delta" .= object ["type" .= ("signature_delta" :: Text), "signature" .= sig]], stopBlock 0]+    <> (if redacted then [block 1 redactedItem, stopBlock 1] else [])+    <> [block (if redacted then 2 else 1) (toolItem ident), stopBlock (if redacted then 2 else 1)]+    <> end "tool_use"++finalTurn :: [Value]+finalTurn = [start, block 0 (object ["type" .= ("text" :: Text), "text" .= ("" :: Text)]), object ["type" .= ("content_block_delta" :: Text), "index" .= (0 :: Int), "delta" .= object ["type" .= ("text_delta" :: Text), "text" .= ("done" :: Text)]], stopBlock 0] <> end "end_turn"++field :: Key -> Value -> Maybe Value+field k (Object o) = KM.lookup k o+field _ _ = Nothing++messages :: Value -> V.Vector Value+messages raw = case field "messages" raw of Just (Array xs) -> xs; _ -> V.empty++contentAt :: Int -> V.Vector Value -> V.Vector Value+contentAt n xs = case xs V.!? n >>= field "content" of Just (Array cs) -> cs; _ -> V.empty++-- Applications own the surrounding history store; ThinkingContent supplies+-- its JSON round trip. Exercise that payload without inventing a Context decoder.+persistThinking :: Message -> IO Message+persistThinking (AssistantMessage payload) = do+  blocks <- V.mapM persist (payload ^. #content)+  pure (AssistantMessage (payload & #content .~ blocks))+  where+    persist (AssistantThinking t) = AssistantThinking <$> either assertFailure pure (Aeson.eitherDecode (Aeson.encode t))+    persist block = pure block+persistThinking other = pure other++summaryOptions :: Options+summaryOptions = options & #thinking .~ Just ThinkingLow & #evidence .~ Just (evidenceRequest "summary-replay")++summaryTests :: TestTree+summaryTests =+  testGroup+    "summary visibility"+    [ testCase "summarized reasoning assembles into non-empty thinking content" $ do+        response <- completeFrames (toolTurn "visible summary" "signed-summary" "toolu_summary" False) summaryOptions+        let blocks = [t | AssistantThinking t <- V.toList (response ^. #message . #content)]+        map (^. #thinking) blocks @?= ["visible summary"]+        map (^. #signature) blocks @?= [Just "signed-summary"]+        ev <- evidenceOf response+        ev ^. #thinking . #displayText @?= Just "summarized"+        ev ^. #thinking . #adjustments @?= []+        ev ^. #observedThinking @?= Unobserved,+      testCase "reasoning requested but returned empty is recorded in the evidence" $ do+        forM_ [[signed "" "empty-signature"], [redactedItem], [signed "" "empty-signature", redactedItem]] $ \blocks -> do+          response <- completeFrames (blocksTurn blocks) summaryOptions+          ev <- evidenceOf response+          ev ^. #thinking . #adjustments @?= [ThinkingSummaryUnavailable]+          ev ^. #thinking . #displayText @?= Just "summarized"+          ev ^. #observedThinking @?= Unobserved+          ev ^. #status @?= CallSucceeded+          responseError response @?= Nothing+          weakensThinking ThinkingSummaryUnavailable @?= False+          let actual = [t | AssistantThinking t <- V.toList (response ^. #message . #content)]+          length actual @?= length blocks+          -- Encrypted payloads and signed empty blocks remain usable history.+          (req, _) <- either (\e -> assertFailure (T.unpack e) >> fail "map") pure (R.mapRequest model (emptyContext & #messages .~ V.singleton (AssistantMessage (response ^. #message))) summaryOptions)+          contentAt 0 (messages (Aeson.toJSON req)) @?= V.fromList blocks,+      testCase "one visible block among empty and redacted blocks is a readable summary" $ do+        response <- completeFrames (blocksTurn [signed "" "empty", redactedItem, signed "visible" "visible-signature"]) summaryOptions+        ev <- evidenceOf response+        ev ^. #thinking . #adjustments @?= [],+      testCase "no thinking block and no thinking preference do not invent missing summaries" $ do+        noBlocks <- completeFrames finalTurn summaryOptions+        ev <- evidenceOf noBlocks+        ev ^. #thinking . #adjustments @?= []+        noPreference <- completeFrames (blocksTurn [signed "" "sig"]) (options & #evidence .~ Just (evidenceRequest "no-thinking"))+        ev2 <- evidenceOf noPreference+        ev2 ^. #thinking @?= noThinkingRequested,+      testCase "failed streams do not label partial thinking as a missing completed summary" $ do+        let driver _ _ emit = send [start, block 0 (signed "" "sig"), stopBlock 0] emit >> emit (Left (providerError "interrupted"))+        response <- streamingComplete (claudeMessagesStreamWith driver) model emptyContext summaryOptions+        ev <- evidenceOf response+        ev ^. #status @?= CallFailed+        ev ^. #thinking . #adjustments @?= []+        assertBool "failure retained" (responseError response /= Nothing)+    ]+  where+    completeFrames frames opts = streamingComplete (claudeMessagesStreamWith (\_ _ emit -> send frames emit)) model emptyContext opts+    blocksTurn blocks = [start] <> concat [blockFrames i b | (i, b) <- zip [0 ..] blocks] <> end "end_turn"+    blockFrames i b = case (field "type" b, field "thinking" b, field "signature" b) of+      (Just (String "thinking"), Just (String text), Just (String sig)) ->+        [ block i (signed "" ""),+          object ["type" .= ("content_block_delta" :: Text), "index" .= i, "delta" .= object ["type" .= ("thinking_delta" :: Text), "thinking" .= text]],+          object ["type" .= ("content_block_delta" :: Text), "index" .= i, "delta" .= object ["type" .= ("signature_delta" :: Text), "signature" .= sig]],+          stopBlock i+        ]+      _ -> [block i b, stopBlock i]+    evidenceOf response = maybe (assertFailure "missing evidence" >> fail "evidence") pure (response ^. #evidence)
test/Main.hs view
@@ -30,6 +30,7 @@ import Data.Vector qualified as Vector import ErrorClassSpec qualified import EvidenceSpec qualified+import FableContractsSpec qualified import LifecycleSpec qualified import MidStreamSpec qualified import PublicSurfaceSpec qualified@@ -77,6 +78,7 @@         CliEvidenceSpec.tests,         ErrorClassSpec.tests,         EvidenceSpec.tests,+        FableContractsSpec.tests,         LifecycleSpec.tests,         MidStreamSpec.tests,         PublicSurfaceSpec.tests,@@ -458,6 +460,7 @@                     effortText = Just wire,                     budgetTokens = Nothing,                     wireField = Just "--effort",+                    displayText = Nothing,                     adjustments = expected                   }           | (level, wire, expected) <-
test/ShapeSpec.hs view
@@ -2,13 +2,16 @@  import Baikai import Baikai.Models.Generated qualified as Models-import Baikai.Provider.Claude.Internal.Request (mapRequest)+import Baikai.Provider.Claude.Internal.Request (describeThinkingFor, mapRequest) import Baikai.Provider.Claude.Shape (streamRequestBody)-import Control.Lens ((&), (.~))+import Baikai.Provider.Claude.Transport qualified as Transport+import Control.Lens ((&), (.~), (^.))+import Control.Monad (forM_) import Data.Aeson (Value (..), (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as AesonKey import Data.Aeson.KeyMap qualified as KeyMap+import Data.Map.Strict qualified as Map import Data.Text qualified as Text import Data.Vector qualified as Vector import Test.Tasty (TestTree, testGroup)@@ -18,7 +21,12 @@ tests =   testGroup     "ShapeSpec"-    [ verbatimToolSchemaTest,+    [ testCase "server-side fallbacks stay absent from the request" $ do+        value <- shapedBody Models.anthropic_claude_opus_5 emptyContext emptyOptions+        lookupPath ["fallbacks"] value @?= Nothing,+      summaryDisplayTest,+      fastSpeedTests,+      verbatimToolSchemaTest,       toolChoiceNoneTest,       toolCacheControlTest,       toolCacheControlCompatGateTest@@ -124,3 +132,59 @@     i < Vector.length xs =       lookupPath rest (xs Vector.! i) lookupPath _ _ = Nothing++fastSpeedTests :: TestTree+fastSpeedTests =+  testGroup+    "speed"+    [ testCase "a fast-mode request on claude-opus-5 carries speed and the beta header" $ do+        let m = Models.anthropic_claude_opus_5+            opts = emptyOptions & #speed .~ Just SpeedFast+        value <- shapedBody m emptyContext opts+        lookupPath ["speed"] value @?= Just (String "fast")+        lookup "anthropic-beta" (headers m opts) @?= Just "fast-mode-2026-02-01",+      testCase "a fast-mode request on claude-sonnet-5 omits speed and records the drop" $ do+        let m = Models.anthropic_claude_sonnet_5+            opts = emptyOptions & #speed .~ Just SpeedFast+        value <- shapedBody m emptyContext opts+        lookupPath ["speed"] value @?= Nothing+        lookup "anthropic-beta" (headers m opts) @?= Nothing+        case mapRequest m emptyContext opts of+          Left err -> assertFailure (show err)+          Right (_, translation) -> do+            translation @?= describeThinkingFor m opts+            translation ^. #adjustments @?= [FastModeDroppedUnsupportedModel]+        weakensThinking FastModeDroppedUnsupportedModel @?= False+        Aeson.fromJSON (Aeson.toJSON FastModeDroppedUnsupportedModel) @?= Aeson.Success FastModeDroppedUnsupportedModel,+      testCase "absent and explicit standard speed remain distinct on unsupported models" $ do+        let m = Models.anthropic_claude_sonnet_5+            opts = emptyOptions & #speed .~ Just SpeedStandard+        absent <- shapedBody m emptyContext emptyOptions+        standard <- shapedBody m emptyContext opts+        lookupPath ["speed"] absent @?= Nothing+        lookupPath ["speed"] standard @?= Just (String "standard")+        lookup "anthropic-beta" (headers m opts) @?= Nothing+        describeThinkingFor m opts ^. #adjustments @?= [],+      testCase "caller beta headers override model and automatic fast beta headers" $ do+        let m = Models.anthropic_claude_opus_5 & #headers .~ Map.singleton "anthropic-beta" "model-beta"+            opts = emptyOptions & #speed .~ Just SpeedFast & #headers .~ Map.singleton "Anthropic-Beta" "caller-beta"+        lookup "anthropic-beta" (headers m emptyOptions) @?= Just "model-beta"+        lookup "anthropic-beta" (headers m opts) @?= Just "caller-beta"+    ]+  where+    headers m opts = Transport.requestHeaders "test-key" Nothing (anthropicMessagesCompatFor m) emptyContext m opts++summaryDisplayTest :: TestTree+summaryDisplayTest = testCase "adaptive requests ask for summarized display; budget and absent thinking retain their shapes" $ do+  let opts = emptyOptions & #thinking .~ Just ThinkingLow+  forM_ [Models.anthropic_claude_opus_5, Models.anthropic_claude_opus_4_6, Models.anthropic_claude_fable_5_1, Models.anthropic_claude_opus_5 & #modelId .~ "renamed"] $ \m -> do+    body <- shapedBody m emptyContext opts+    lookupPath ["thinking"] body @?= Just (Aeson.object ["type" .= ("adaptive" :: Text.Text), "display" .= ("summarized" :: Text.Text)])+    describeThinkingFor m opts ^. #displayText @?= Just "summarized"+    absent <- shapedBody m emptyContext emptyOptions+    lookupPath ["thinking"] absent @?= Nothing+    describeThinkingFor m emptyOptions ^. #displayText @?= Nothing+  let budget = Models.anthropic_claude_haiku_4_5+  body <- shapedBody budget emptyContext opts+  lookupPath ["thinking"] body @?= Just (Aeson.object ["type" .= ("enabled" :: Text.Text), "budget_tokens" .= thinkingTokenBudget ThinkingLow])+  describeThinkingFor budget opts ^. #displayText @?= Nothing
test/SseSpec.hs view
@@ -2,7 +2,7 @@  import Baikai import Baikai.Http qualified as Http-import Baikai.Models.Generated (anthropic_claude_haiku_4_5)+import Baikai.Models.Generated (anthropic_claude_fable_5_1, anthropic_claude_haiku_4_5, anthropic_claude_opus_5) import Baikai.Provider.Claude.Internal.Stream (Assembler, SseDriver, claudeMessagesStreamWith, emptyAssembler, translate) import Baikai.Provider.Claude.Sse   ( ResponseMetadata,@@ -10,6 +10,7 @@     claudeSseStreamValueWithHeaders,     sseFromResponse,   )+import Baikai.Usage qualified as Usage import Claude.V1.Messages qualified as Messages import Contract (assertErrorContract) import Control.Lens ((&), (.~), (^.))@@ -18,9 +19,11 @@ import Data.ByteString (ByteString) import Data.ByteString qualified as SBS import Data.ByteString.Char8 qualified as S8+import Data.ByteString.Lazy qualified as LBS import Data.CaseInsensitive qualified as CI import Data.Generics.Labels () import Data.IORef (IORef, atomicModifyIORef', modifyIORef', newIORef, readIORef, writeIORef)+import Data.Set qualified as Set import Data.Text qualified as Text import Data.Time.Clock (UTCTime) import Data.Vector (Vector)@@ -124,6 +127,19 @@             -- fixture also carries must not be recorded.             md ^. #headers @?= [("request-id", "req_abc123")]           other -> assertFailure ("expected exactly one metadata value, got: " <> show other),+      testCase "partial and repeated usage snapshots preserve reported cache categories" $ do+        let start = frameOf "{\"type\":\"message_start\",\"message\":{\"id\":\"msg_usage\",\"type\":\"message\",\"role\":\"assistant\",\"content\":[],\"model\":\"claude-test\",\"stop_reason\":null,\"stop_sequence\":null,\"usage\":{\"input_tokens\":10,\"output_tokens\":0,\"cache_read_input_tokens\":20}}}"+            partial = frameOf "{\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},\"usage\":{\"output_tokens\":100}}"+            final = frameOf "{\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},\"usage\":{\"output_tokens\":100,\"cache_creation_input_tokens\":30}}"+        (_, before) <- replayTranslate [start, partial]+        (before ^. #usage) ^. #availability @?= Just (Usage.UsageAvailability (Set.singleton Usage.CacheWriteUsage) False Set.empty)+        (_, once) <- replayTranslate [start, partial, final]+        (_, twice) <- replayTranslate [start, partial, final, final]+        once ^. #usage @?= twice ^. #usage+        (once ^. #usage) ^. #totalTokens @?= 160+        (once ^. #usage) ^. #availability @?= Just (Usage.UsageAvailability Set.empty False Set.empty)+        let (_, failed) = translate (Left (providerUnavailable "reset")) once testTime+        failed ^. #usage @?= once ^. #usage,       testCase "the observed model comes from message_start, not the configured model" $ do         (_, ass) <- replay 200 [("request-id", "req_abc123")] successBody         ass ^. #observedModel @?= Observed "claude-haiku-4-5-20990101-server-side"@@ -168,7 +184,23 @@ blockClosingTests =   testGroup     "block closing under failure"-    [ testCase "a tool call cut off by max_tokens closes with its raw argument text" $ do+    [ testCase "fast terminal pricing follows observed speed, including missing observations" $ do+        forM_ [(Just "fast", 1 / 50, Set.empty), (Just "standard", 1 / 100, Set.empty), (Nothing, 1 / 100, Set.singleton SpeedNotReported)] $ \(observed, expected, reasons) -> do+          let speedJson = maybe "" (\v -> ",\"speed\":\"" <> v <> "\"") observed+              body = [frameOf ("{\"type\":\"message_start\",\"message\":{\"id\":\"msg_fast\",\"type\":\"message\",\"role\":\"assistant\",\"content\":[],\"model\":\"claude-opus-5\",\"stop_reason\":null,\"stop_sequence\":null,\"usage\":{\"input_tokens\":0,\"output_tokens\":0,\"cache_read_input_tokens\":0,\"cache_creation_input_tokens\":1000,\"service_tier\":\"standard\"" <> speedJson <> "}}}"), frameOf "{\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},\"usage\":{\"output_tokens\":0}}", frameOf "{\"type\":\"message_stop\"}"]+          response <- streamingComplete (claudeMessagesStreamWith (replayDriver 200 [] body)) anthropic_claude_opus_5 emptyContext (testOptions & #cacheRetention .~ Just CacheRetentionLong & #speed .~ Just SpeedFast)+          response ^. #message . #usage . #cost . #usd @?= expected+          response ^. #message . #usage . #cost . #basis . #estimateReasons @?= reasons,+      testCase "Fable cache writes use the shaped duration including compatibility downgrades" $ do+        let fable = anthropic_claude_fable_5_1+            downgraded = fable & #compat .~ CompatAnthropicMessages (anthropicMessagesCompatFor fable & #supportsLongCacheRetention .~ False)+            body = [frameOf "{\"type\":\"message_start\",\"message\":{\"id\":\"msg_cost\",\"type\":\"message\",\"role\":\"assistant\",\"content\":[],\"model\":\"claude-fable-5-1\",\"stop_reason\":null,\"stop_sequence\":null,\"usage\":{\"input_tokens\":0,\"output_tokens\":0,\"cache_read_input_tokens\":0,\"cache_creation_input_tokens\":1000,\"service_tier\":\"standard\",\"speed\":\"standard\"}}}", frameOf "{\"type\":\"message_delta\",\"delta\":{\"stop_reason\":\"end_turn\",\"stop_sequence\":null},\"usage\":{\"output_tokens\":0}}", frameOf "{\"type\":\"message_stop\"}"]+        forM_ [(fable, CacheRetentionLong, 1 / 50), (fable, CacheRetentionShort, 1 / 80), (downgraded, CacheRetentionLong, 1 / 80)] $ \(m, duration, expected) -> do+          response <- streamingComplete (claudeMessagesStreamWith (replayDriver 200 [] body)) m emptyContext (testOptions & #cacheRetention .~ Just duration)+          response ^. #message . #usage . #cost . #usd @?= expected+          response ^. #message . #usage . #cost . #basis . #estimateReasons @?= Set.empty+          fmap Usage.billingFacts (response ^. #message . #usage . #availability) @?= Just (Set.fromList [Usage.BillingServiceTier "standard", Usage.BillingSpeed "standard"]),+      testCase "a tool call cut off by max_tokens closes with its raw argument text" $ do         events <- replayStream 200 [] cutOffToolBody         let calls = [tc | ToolCallEnd ToolCallEndPayload {toolCall = tc} <- events]         case calls of@@ -191,6 +223,7 @@             be ^. #category @?= ContentFiltered             isRetryable be @?= False           other -> assertFailure ("expected a terminal EventError, got: " <> show (take 1 other)),+      refusalDetailTests,       testCase "a mid-stream transport error closes open blocks before the terminal" $ do         -- The failure is injected through 'translate' rather than the         -- transport, because what is under test is the assembler's@@ -550,3 +583,65 @@     redirectResponse =       S8.pack         "HTTP/1.1 302 Found\r\nLocation: http://evil.test/steal\r\nContent-Length: 0\r\n\r\n"++refusalDetailTests :: TestTree+refusalDetailTests =+  testGroup+    "refusal details"+    [ testCase "a categorised refusal names its category and explanation" $+        check (Just "cyber") (Just "Provider explanation"),+      testCase "unknown categories survive without an enum update" $+        check (Just "future_category") Nothing,+      testCase "an explanation survives without a category" $+        check Nothing (Just "Provider explanation"),+      testCase "null details preserve the original refusal message" $ do+        events <- replayStream 200 [] (refusalWithDetails Aeson.Null)+        be <- terminalError events+        be ^. #refusalCategory @?= Nothing+        be ^. #message @?= base,+      testCase "absent detail fields preserve the original refusal message" $+        check Nothing Nothing,+      testCase "explicit null category and explanation remain absent" $ do+        events <- replayStream 200 [] (refusalWithDetails (Aeson.object ["type" Aeson..= ("refusal" :: Text.Text), "category" Aeson..= Aeson.Null, "explanation" Aeson..= Aeson.Null]))+        be <- terminalError events+        be ^. #refusalCategory @?= Nothing+        be ^. #message @?= base,+      testCase "non-refusal completion does not turn stray details into an error" $ do+        let body = map (S8.pack . Text.unpack . Text.replace "\"stop_reason\":\"refusal\"" "\"stop_reason\":\"end_turn\"" . Text.pack . S8.unpack) (refusalWithDetails (detail (Just "cyber") Nothing))+        events <- replayStream 200 [] body+        case reverse events of+          EventDone TerminalPayload {errorInfo = Nothing} : _ -> pure ()+          other -> assertFailure (show other),+      testCase "blocking completion preserves the structured refusal" $ do+        response <- streamingComplete (claudeMessagesStreamWith (replayDriver 200 [] (refusalWithDetails (detail (Just "bio") Nothing)))) testModel emptyContext testOptions+        fmap (\be -> be ^. #refusalCategory) (response ^. #errorInfo) @?= Just (Just "bio")+    ]+  where+    base = "Anthropic refused to generate a response (stop_reason=refusal)"+    detail :: Maybe Text.Text -> Maybe Text.Text -> Aeson.Value+    detail c e = Aeson.object (["type" Aeson..= ("refusal" :: Text.Text)] <> maybe [] (\v -> ["category" Aeson..= v]) c <> maybe [] (\v -> ["explanation" Aeson..= v]) e)+    check c e = do+      events <- replayStream 200 [] (refusalWithDetails (detail c e))+      assertErrorContract events+      be <- terminalError events+      be ^. #category @?= ContentFiltered+      isRetryable be @?= False+      be ^. #refusalCategory @?= c+      be ^. #message @?= base <> maybe "" (\v -> " [category=" <> v <> "]") c <> maybe "" (": " <>) e++refusalWithDetails :: Aeson.Value -> [ByteString]+refusalWithDetails details =+  take 1 refusalBody+    <> [ frameOf+           ( LBS.toStrict+               ( Aeson.encode+                   ( Aeson.object+                       [ "type" Aeson..= ("message_delta" :: Text.Text),+                         "delta" Aeson..= Aeson.object ["stop_reason" Aeson..= ("refusal" :: Text.Text), "stop_details" Aeson..= details],+                         "usage" Aeson..= Aeson.object ["output_tokens" Aeson..= (1 :: Int)]+                       ]+                   )+               )+           ),+         frameOf "{\"type\":\"message_stop\"}"+       ]
test/ThinkingSpec.hs view
@@ -30,7 +30,14 @@ tests =   testGroup     "ThinkingSpec"-    [ testGroup "mapRequest max_tokens" (neverExceedsCapTests <> styleTests),+    [ testCase "foreign opaque reasoning cannot enter this endpoint" $ do+        let thought = emptyThinkingContent & #replayState .~ Just (ThinkingReplay OpenAIResponses "gpt-6-astra" (Vector.singleton (Aeson.object [])))+            response = emptyResponse & #message . #content .~ Vector.singleton (AssistantThinking thought)+            ctx = addResponse response emptyContext+        case mapRequest anthropic_claude_fable_5_1 ctx emptyOptions of+          Left _ -> pure ()+          Right _ -> assertFailure "foreign state was silently accepted",+      testGroup "mapRequest max_tokens" (neverExceedsCapTests <> styleTests),       translationTableTests,       conditionalDowngradeTests,       adaptiveHigherEffortTests,@@ -41,6 +48,8 @@       mergedOutputConfigTest,       explicitCompatOverridesDefaultTest,       anthropicModelsCoverCatalogTest,+      testGroup "fast-mode catalog facts" [testCase name ((anthropicMessagesCompatFor m ^. #supportsFastMode) @?= fast) | (name, m, _, _, _, fast) <- anthropicModels],+      testGroup "forced-tool catalog facts" [testCase name ((anthropicMessagesCompatFor m ^. #supportsForcedToolChoice) @?= forced) | (name, m, _, _, forced, _) <- anthropicModels],       samplingTests,       claude15UsageTests,       zeroCapFloorTests,@@ -49,27 +58,28 @@       streamFidelityTests     ] --- | Every Anthropic model in the generated catalog, with the two+-- | Every Anthropic model in the generated catalog, with the three -- request-shaping facts its compat record states. Written out by hand -- rather than read off the record, so a catalog refresh that changes a -- generation's wire shape fails a row here instead of quietly agreeing -- with itself. The last column is--- 'Baikai.Compat.supportsSamplingParameters'.+-- 'Baikai.Compat.supportsForcedToolChoice'. -- -- @anthropicModelsCoverCatalogTest@ ties the table to @allModels@, so a -- newly curated model cannot arrive unpinned.-anthropicModels :: [(String, Model, AnthropicThinkingStyle, Bool)]+anthropicModels :: [(String, Model, AnthropicThinkingStyle, Bool, Bool, Bool)] anthropicModels =-  [ ("claude-fable-5", anthropic_claude_fable_5, AnthropicThinkingAdaptive, False),-    ("claude-haiku-4-5", anthropic_claude_haiku_4_5, AnthropicThinkingBudget, True),-    ("claude-opus-4-5", anthropic_claude_opus_4_5, AnthropicThinkingBudget, True),-    ("claude-opus-4-6", anthropic_claude_opus_4_6, AnthropicThinkingAdaptive, True),-    ("claude-opus-4-7", anthropic_claude_opus_4_7, AnthropicThinkingAdaptive, False),-    ("claude-opus-4-8", anthropic_claude_opus_4_8, AnthropicThinkingAdaptive, False),-    ("claude-opus-5", anthropic_claude_opus_5, AnthropicThinkingAdaptive, False),-    ("claude-sonnet-4-5", anthropic_claude_sonnet_4_5, AnthropicThinkingBudget, True),-    ("claude-sonnet-4-6", anthropic_claude_sonnet_4_6, AnthropicThinkingAdaptive, True),-    ("claude-sonnet-5", anthropic_claude_sonnet_5, AnthropicThinkingAdaptive, False)+  [ ("claude-fable-5", anthropic_claude_fable_5, AnthropicThinkingAdaptive, False, True, False),+    ("claude-fable-5-1", anthropic_claude_fable_5_1, AnthropicThinkingAdaptive, False, False, False),+    ("claude-haiku-4-5", anthropic_claude_haiku_4_5, AnthropicThinkingBudget, True, True, False),+    ("claude-opus-4-5", anthropic_claude_opus_4_5, AnthropicThinkingBudget, True, True, False),+    ("claude-opus-4-6", anthropic_claude_opus_4_6, AnthropicThinkingAdaptive, True, True, False),+    ("claude-opus-4-7", anthropic_claude_opus_4_7, AnthropicThinkingAdaptive, False, True, False),+    ("claude-opus-4-8", anthropic_claude_opus_4_8, AnthropicThinkingAdaptive, False, True, True),+    ("claude-opus-5", anthropic_claude_opus_5, AnthropicThinkingAdaptive, False, True, True),+    ("claude-sonnet-4-5", anthropic_claude_sonnet_4_5, AnthropicThinkingBudget, True, True, False),+    ("claude-sonnet-4-6", anthropic_claude_sonnet_4_6, AnthropicThinkingAdaptive, True, True, False),+    ("claude-sonnet-5", anthropic_claude_sonnet_5, AnthropicThinkingAdaptive, False, True, False)   ]  thinkingLevels :: [(String, ThinkingLevel)]@@ -88,7 +98,7 @@       req <- requestFor model (emptyOptions & #thinking .~ Just level)       req ^. #max_tokens <= model ^. #maxOutputTokens         @?= True-  | (name, model, _, _) <- anthropicModels,+  | (name, model, _, _, _, _) <- anthropicModels,     (levelName, level) <- thinkingLevels   ] @@ -105,11 +115,11 @@             "max_tokens leaves visible-output room beyond budget"             (req ^. #max_tokens > expectedBudget)         AnthropicThinkingAdaptive -> do-          requestThinking req @?= Just Messages.ThinkingAdaptive+          requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)           req ^. #max_tokens @?= model ^. #maxOutputTokens           (req ^. #output_config >>= Messages.effort)             @?= adaptiveEffort level-  | (name, model, style, _) <- anthropicModels,+  | (name, model, style, _, _, _) <- anthropicModels,     (levelName, level) <- thinkingLevels   ] @@ -226,7 +236,7 @@           requestFor             anthropic_claude_opus_4_7             (emptyOptions & #thinking .~ Just level)-        requestThinking req @?= Just Messages.ThinkingAdaptive+        requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)         (req ^. #output_config >>= Messages.effort) @?= Just expected     | (name, level, expected) <-         [ ("xhigh is preserved", ThinkingXHigh, "xhigh"),@@ -300,7 +310,7 @@               .~ Just (JsonSchema (jsonSchemaFormat "answer" schema) {strict = True})         expected = (Messages.jsonSchemaConfig schema) {Messages.effort = Just "medium"}     req <- requestFor anthropic_claude_opus_4_6 opts-    requestThinking req @?= Just Messages.ThinkingAdaptive+    requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)     req ^. #output_config @?= Just expected  explicitCompatOverridesDefaultTest :: TestTree@@ -315,7 +325,7 @@             & #compat .~ CompatAnthropicMessages compat         opts = emptyOptions & #thinking .~ Just ThinkingLow     req <- requestFor model opts-    requestThinking req @?= Just Messages.ThinkingAdaptive+    requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)     (req ^. #output_config >>= Messages.effort) @?= Just "low"  requestFor :: Model -> Options -> IO Messages.CreateMessage@@ -349,7 +359,7 @@ anthropicModelsCoverCatalogTest :: TestTree anthropicModelsCoverCatalogTest =   testCase "anthropicModels covers exactly the catalog's Anthropic ids" $-    List.sort [m ^. #modelId | (_, m, _, _) <- anthropicModels]+    List.sort [m ^. #modelId | (_, m, _, _, _, _) <- anthropicModels]       @?= List.sort [m ^. #modelId | m <- allModels, m ^. #api == AnthropicMessages]  -- | Sampling parameters against the catalog's own record.@@ -376,7 +386,7 @@               Messages.top_p req @?= Nothing               filter isSamplingAdjustment (t ^. #adjustments)                 @?= [SamplingDroppedUnsupportedModel ["temperature", "top_p"]]-      | (name, model, _, supported) <- anthropicModels,+      | (name, model, _, supported, _, _) <- anthropicModels,         let verb = if supported then "forwards temperature and top_p" else "drops temperature and top_p and records it"       ]         <> [ testCase "sampling is dropped and recorded even when no thinking level is set" $ do@@ -481,7 +491,7 @@         msgs <-           mappedMessages             [ assistantBlocks-                [AssistantThinking ThinkingContent {thinking = "hmm", signature = Nothing, redacted = False}],+                [AssistantThinking ThinkingContent {thinking = "hmm", signature = Nothing, redacted = False, replayState = Nothing}],               user "next"             ]         Vector.length msgs @?= 1,@@ -681,13 +691,15 @@               ThinkingContent                 { thinking = "because therefore",                   signature = Just "sig-final",-                  redacted = False+                  redacted = False,+                  replayState = Nothing                 }             expectedRedacted =               ThinkingContent                 { thinking = "ENCRYPTED==",                   signature = Nothing,-                  redacted = True+                  redacted = True,+                  replayState = Nothing                 }         thinkingEnds events           @?= [expectedSigned, expectedRedacted]@@ -734,7 +746,8 @@                             ThinkingContent                               { thinking = "draft",                                 signature = Nothing,-                                redacted = False+                                redacted = False,+                                replayState = Nothing                               },                           AssistantText (TextContent "visible")                         ],