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 +200/−0
- baikai-claude.cabal +5/−4
- src/Baikai/Provider/Claude/Agent.hs +1/−0
- src/Baikai/Provider/Claude/Cli.hs +1/−0
- src/Baikai/Provider/Claude/Internal/Request.hs +43/−3
- src/Baikai/Provider/Claude/Internal/Stream.hs +106/−53
- src/Baikai/Provider/Claude/Transport.hs +9/−2
- test/EvidenceSpec.hs +2/−2
- test/FableContractsSpec.hs +243/−0
- test/Main.hs +3/−0
- test/ShapeSpec.hs +67/−3
- test/SseSpec.hs +97/−2
- test/ThinkingSpec.hs +39/−26
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") ],