baikai 0.8.0.0 → 0.10.0.0
raw patch · 44 files changed
Files
- CHANGELOG.md +192/−0
- baikai.cabal +10/−2
- data/models/anthropic.json +28/−14
- data/models/openai.json +51/−7
- data/models/typesafe.json +46/−0
- fetch/FetchModelsCore.hs +57/−16
- gen/GenModels.hs +4/−0
- gen/GenModelsCore.hs +57/−7
- src/Baikai.hs +4/−0
- src/Baikai/Api.hs +3/−0
- src/Baikai/Auth.hs +1/−0
- src/Baikai/Compat.hs +76/−12
- src/Baikai/Content.hs +42/−2
- src/Baikai/Context.hs +12/−0
- src/Baikai/Cost/Log.hs +18/−4
- src/Baikai/Error.hs +34/−5
- src/Baikai/Evidence.hs +61/−6
- src/Baikai/Internal/Data.hs +34/−0
- src/Baikai/Internal/JSON.hs +112/−0
- src/Baikai/Judgment.hs +241/−0
- src/Baikai/Message.hs +16/−1
- src/Baikai/Model.hs +30/−1
- src/Baikai/Models/Generated.hs +295/−34
- src/Baikai/Options.hs +10/−0
- src/Baikai/Provider/Cli/Internal.hs +2/−0
- src/Baikai/Response.hs +8/−1
- src/Baikai/Response/JSON.hs +34/−0
- src/Baikai/ResponseFormat.hs +3/−1
- src/Baikai/Stream.hs +7/−1
- src/Baikai/Stream/Event.hs +60/−2
- src/Baikai/ThinkingLevel.hs +18/−3
- src/Baikai/Trace.hs +32/−3
- src/Baikai/Trace/Event.hs +7/−1
- test/CatalogSpec.hs +36/−23
- test/CostSpec.hs +7/−1
- test/DataContentSpec.hs +146/−0
- test/EvidenceSpec.hs +9/−2
- test/FetchModelsSpec.hs +39/−7
- test/GenModelsSpec.hs +32/−1
- test/JudgmentSpec.hs +151/−0
- test/Main.hs +4/−0
- test/StrictEvidenceSpec.hs +8/−0
- test/ThinkingLevelSpec.hs +2/−1
- test/TraceSpec.hs +2/−0
CHANGELOG.md view
@@ -7,6 +7,198 @@ ## [Unreleased] +## [baikai 0.10.0.0] - 2026-10-25++### Added++- `ThinkingNone` (`none`) explicitly requests reasoning off; `Nothing` still+ leaves provider defaults untouched. Anthropic compatibility records declare+ `supportsThinkingDisabled`; legacy records conservatively default to False.+- Endpoint-specific `NativeCachePolicy` records distinguish modern, legacy and+ unsupported native OpenAI cache controls. Policies survive legacy JSON and+ catalog refresh; Luna Responses Long has verified 12h base and tier rates.+- Evidence schema 2.8 includes the `none` preference and content-free native+ cache controls and input structure. Digest rules and the separation of+ requested, translated and observed reasoning are unchanged.++### Changed (breaking)++- `ThinkingLevel` gains `ThinkingNone` as its least constructor. Update exhaustive+ matches. Anthropic and OpenAI compatibility records gain fields; use the+ default records or update explicit record construction.+- All seven dependent packages now require `baikai ^>=0.10.0` and release+ independently below. The unchanged adapters take dependency-only patch bumps.++## [baikai-claude 0.7.3.0] - 2026-10-25++### Added++- Export `injectSystemCacheControl` for shared system-prefix cache markers.+- `ThinkingNone` sends catalog-gated `thinking: {"type": "disabled"}` without+ effort, display or a budget. Unsupported off requests remain visible+ adjustments and fail strict evidence before dispatch. A host with no thinking+ controls is not assumed to be a non-reasoning model.++### Fixed++- Short and long `cacheRetention` mark non-empty system prompts so fresh+ conversations with different first questions can reuse the tools-and-system+ prefix. System, last-tool and automatic markers share the effective TTL,+ including host downgrades, and use at most three breakpoints. Empty or absent+ system prompts and disabled caching keep their existing shape. Regression+ coverage includes tool compatibility and an isolated live shared-prefix case.+ Implements issue #2 and the approach in PR #3.++### Changed++- Require `baikai ^>=0.10.0`.++## [baikai-openai 0.7.3.0] - 2026-10-25++### Added++- Export `applyNativeCache` for validated native cache plans.+- OpenAI-compatible Chat (including Ollama) and Responses carry `none` where+ supported. Z.ai and Qwen emit `enable_thinking: false`; unsupported off+ requests remain visible adjustments and fail strict evidence before dispatch.++### Fixed++- Native OpenAI Short caching marks shared non-empty system prefixes on+ catalog-supported Responses and Chat bindings. Unsupported native requests+ fail locally. Effective duration reaches terminal pricing, partial usage+ and evidence.+- Funded live prefix checks pass for Luna Responses Short/Long and GPT-5.6 Chat+ Short. Luna Long uses verified 12h base and tier rates; unsupported Chat Long+ and unverified modern bindings remain locally refused.++### Changed++- Require `baikai ^>=0.10.0`. Catalog effort policies distinguish GPT-5/o-series+ models that cannot disable reasoning, Sol/Luna that accept none, and+ Astra/GPT-6.1 Sol that do not.++## [baikai-typesafe 0.1.0.1] - 2026-10-25++### Changed++- Require `baikai ^>=0.10.0`. Dependency-only update; no package API change.++## [baikai-trace-otel 0.4.1.1] - 2026-10-25++### Changed++- Require `baikai ^>=0.10.0`. Dependency-only update; no package API change.++## [baikai-effectful 0.4.0.5] - 2026-10-25++### Changed++- Require `baikai ^>=0.10.0`. Dependency-only update; no package API change.++## [baikai-kit 0.4.0.3] - 2026-10-25++### Changed++- Require `baikai ^>=0.10.0`. Dependency-only update; no package API change.++## [baikai-agent 0.2.0.4] - 2026-10-25++### Fixed++- Layered job configuration accepts `thinking "none"` through the shared+ canonical parser, keeping explicit off distinct from an absent preference.++### Changed++- Require `baikai ^>=0.10.0`, `baikai-claude ^>=0.7.3` and+ `baikai-openai ^>=0.7.3` for explicit-off handling in both vendor renderers.++## [baikai 0.9.0.0] - 2026-10-25++### Added++- `Baikai.Judgment` compiles closed-set schemas into ordered questions, refuses+ generation controls and validates neutral answers without normalizing provider+ probabilities or deriving confidence and expected scores.+- `UserData`, `AssistantData`/`DataContent`, user-data message helpers, atomic+ data events, and named full-response JSON codecs preserve structured answers.+- `TypeSafeSystemOne`, catalog-owned `OutputKind`/`isJudgmentOnly`, `InputData`,+ and `typesafe_jev_latest`/`typesafe_jev_preview`. Legacy model JSON defaults to+ generative output. Register the new `baikai-typesafe` provider explicitly.++### Changed (breaking)++- Public content/event sums and model, error, trace and log records gain fields+ or constructors. Update exhaustive matches and record construction on upgrade.+- Terminal traces and both call-log paths preserve structured answer payloads.+ Evidence schema 2.6 includes structured response commitments and typed request+ problems; existing digest rules are unchanged.++## [baikai-typesafe 0.1.0.0] - 2026-10-25++### Added++- Initial explicitly registered TypeSafe System One provider using the released+ `typesafe-hs ^>=0.1.0.0` wire client. Strict request and response validation,+ atomic synthetic streaming, truthful call evidence, bounded HTTP calls and an+ opt-in live test. No retry policy is embedded.+- Installation, schema, refusal and consumer migration guide, plus CAP-27.++## [baikai-claude 0.7.2.0] - 2026-10-25++### Changed++- Require `baikai ^>=0.9.0`, encode user data as canonical JSON text, and refuse+ structured assistant history before dispatch with a typed field path.++### Fixed++- The offline cancellation fixture waits until the response reader is active+ before cancelling, eliminating a fixed-startup-delay race under build load.++## [baikai-openai 0.7.2.0] - 2026-10-25++### Changed++- Require `baikai ^>=0.9.0`, encode user data as canonical JSON text, and refuse+ structured assistant history before dispatch with a typed field path across+ Chat Completions, Responses and batch CLI calls.++### Fixed++- The offline cancellation fixture waits until the response reader is active+ before cancelling, eliminating a fixed-startup-delay race under build load.++## [baikai-trace-otel 0.4.1.0] - 2026-10-25++### Added++- Export structured answer data as canonical JSON under+ `baikai.response.structured_data`, on success and failure terminals.++### Changed++- Require `baikai ^>=0.9.0` for the expanded trace protocol.++## [baikai-effectful 0.4.0.4] - 2026-10-25++### Changed++- Require `baikai ^>=0.9.0`. Dependency-only update; no package API change.++## [baikai-kit 0.4.0.2] - 2026-10-25++### Changed++- Require `baikai ^>=0.9.0`. Dependency-only update; no package API change.++## [baikai-agent 0.2.0.3] - 2026-10-25++### Changed++- Require `baikai ^>=0.9.0`. Dependency-only update; no package API change.+ ## [baikai 0.8.0.0] - 2026-10-10 ### Added
baikai.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: baikai-version: 0.8.0.0+version: 0.10.0.0 synopsis: Unified Haskell interface for multiple AI providers description: baikai provides a unified, provider-agnostic Haskell interface for working@@ -82,6 +82,7 @@ Baikai.Header Baikai.Http Baikai.Interactive+ Baikai.Judgment Baikai.Message Baikai.Model Baikai.Models.Generated@@ -94,6 +95,7 @@ Baikai.Provider.Registry Baikai.Provider.Transport.Classify Baikai.Response+ Baikai.Response.JSON Baikai.ResponseFormat Baikai.Speed Baikai.StopReason@@ -112,7 +114,11 @@ -- it so an evidence record can name the build that produced it, -- centrally rather than through a literal in each of the five -- packages that construct evidence.- other-modules: Paths_baikai+ other-modules:+ Baikai.Internal.Data+ Baikai.Internal.JSON+ Paths_baikai+ autogen-modules: Paths_baikai build-depends: aeson ^>=2.2,@@ -210,6 +216,7 @@ CliProcessSpec ContextSpec CostSpec+ DataContentSpec EmbeddingSpec ErrorInfoSpec ErrorSpec@@ -220,6 +227,7 @@ GenModelsSpec HelpersSpec InteractiveSpec+ JudgmentSpec PricingPolicySpec PublicSurfaceSpec StreamSpec
data/models/anthropic.json view
@@ -22,7 +22,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": false, "supportsFastMode": false,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": false }, "enabled": true },@@ -45,7 +46,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": false, "supportsFastMode": false,- "supportsForcedToolChoice": false+ "supportsForcedToolChoice": false,+ "supportsThinkingDisabled": false }, "enabled": true },@@ -67,7 +69,8 @@ "thinkingStyle": "budget", "supportsSamplingParameters": true, "supportsFastMode": false,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": true }, "enabled": true },@@ -90,7 +93,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": false, "supportsFastMode": false,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": true }, "enabled": true },@@ -112,7 +116,8 @@ "thinkingStyle": "budget", "supportsSamplingParameters": true, "supportsFastMode": false,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": true }, "enabled": true },@@ -134,7 +139,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": true, "supportsFastMode": false,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": true }, "enabled": true },@@ -156,7 +162,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": false, "supportsFastMode": false,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": true }, "enabled": true },@@ -180,7 +187,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": false, "supportsFastMode": true,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": true }, "enabled": true },@@ -204,7 +212,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": false, "supportsFastMode": true,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": true }, "enabled": true },@@ -228,7 +237,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": false, "supportsFastMode": true,- "supportsForcedToolChoice": false+ "supportsForcedToolChoice": false,+ "supportsThinkingDisabled": false }, "enabled": true },@@ -250,7 +260,8 @@ "thinkingStyle": "budget", "supportsSamplingParameters": true, "supportsFastMode": false,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": true }, "enabled": true },@@ -272,7 +283,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": true, "supportsFastMode": false,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": true }, "enabled": true },@@ -294,7 +306,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": false, "supportsFastMode": false,- "supportsForcedToolChoice": true+ "supportsForcedToolChoice": true,+ "supportsThinkingDisabled": true }, "enabled": true },@@ -317,7 +330,8 @@ "thinkingStyle": "adaptive", "supportsSamplingParameters": false, "supportsFastMode": false,- "supportsForcedToolChoice": false+ "supportsForcedToolChoice": false,+ "supportsThinkingDisabled": false }, "enabled": true }
data/models/openai.json view
@@ -17,7 +17,11 @@ }, "contextWindow": 1047576, "maxOutputTokens": 32768,- "enabled": true+ "enabled": true,+ "compat": {+ "kind": "openai-completions",+ "nativeCachePolicy": {"tag": "NativeCacheLegacy", "contents": [true, true]}+ } }, { "id": "gpt-4.1-mini",@@ -92,6 +96,10 @@ }, "contextWindow": 400000, "maxOutputTokens": 128000,+ "compat": {+ "kind": "openai-completions",+ "supportedReasoningEfforts": ["minimal", "low", "medium", "high"]+ }, "enabled": true }, {@@ -107,6 +115,10 @@ }, "contextWindow": 400000, "maxOutputTokens": 128000,+ "compat": {+ "kind": "openai-completions",+ "supportedReasoningEfforts": ["minimal", "low", "medium", "high"]+ }, "enabled": true }, {@@ -122,6 +134,10 @@ }, "contextWindow": 400000, "maxOutputTokens": 128000,+ "compat": {+ "kind": "openai-completions",+ "supportedReasoningEfforts": ["minimal", "low", "medium", "high"]+ }, "enabled": true }, {@@ -212,7 +228,11 @@ }, "contextWindow": 1050000, "maxOutputTokens": 128000,- "enabled": true+ "enabled": true,+ "compat": {+ "kind": "openai-completions",+ "nativeCachePolicy": {"tag": "NativeCacheLegacy", "contents": [false, true]}+ } }, { "id": "gpt-5.6",@@ -227,7 +247,11 @@ }, "contextWindow": 1050000, "maxOutputTokens": 128000,- "enabled": true+ "enabled": true,+ "compat": {+ "kind": "openai-completions",+ "nativeCachePolicy": {"tag": "NativeCacheModern", "contents": [false, true]}+ } }, { "id": "gpt-5.6-luna",@@ -290,6 +314,7 @@ "api": "openai-responses", "pricingPolicy": {"inputTiers": [{"inputAbove": 272000, "rates": {"input": 20.0, "output": 75.0, "cacheRead": 2.0, "cacheWrite": 25.0}}]}, "compat": {+ "nativeCachePolicy": {"tag": "NativeCacheModern", "contents": [false, true]}, "kind": "openai-responses", "supportsSamplingParameters": false, "supportsLongCacheRetention": false,@@ -312,13 +337,14 @@ "contextWindow": 1050000, "maxOutputTokens": 128000, "api": "openai-responses",- "pricingPolicy": {"inputTiers": [{"inputAbove": 272000, "rates": {"input": 0.2, "output": 0.75, "cacheRead": 0.02, "cacheWrite": 0.25}}]},+ "pricingPolicy": {"inputTiers": [{"inputAbove": 272000, "rates": {"input": 0.2, "output": 0.75, "cacheRead": 0.02, "cacheWrite": 0.25}, "longCacheWriteCost": 0.5}], "longCacheWriteCost": 0.25}, "compat": {+ "nativeCachePolicy": {"tag": "NativeCacheModern", "contents": [true, true]}, "kind": "openai-responses", "supportsSamplingParameters": false,- "supportsLongCacheRetention": false,+ "supportsLongCacheRetention": true, "supportsPromptCacheOptions": true,- "supportedReasoningEfforts": ["low", "medium", "high", "xhigh", "max"]+ "supportedReasoningEfforts": ["none", "low", "medium", "high", "xhigh", "max"] }, "enabled": true },@@ -338,11 +364,12 @@ "api": "openai-responses", "pricingPolicy": {"inputTiers": [{"inputAbove": 272000, "rates": {"input": 4.0, "output": 15.0, "cacheRead": 0.4, "cacheWrite": 5.0}}]}, "compat": {+ "nativeCachePolicy": {"tag": "NativeCacheModern", "contents": [false, true]}, "kind": "openai-responses", "supportsSamplingParameters": false, "supportsLongCacheRetention": false, "supportsPromptCacheOptions": true,- "supportedReasoningEfforts": ["low", "medium", "high", "xhigh", "max"]+ "supportedReasoningEfforts": ["none", "low", "medium", "high", "xhigh", "max"] }, "enabled": true },@@ -362,6 +389,7 @@ "api": "openai-responses", "pricingPolicy": {"inputTiers": [{"inputAbove": 272000, "rates": {"input": 4.0, "output": 15.0, "cacheRead": 0.2, "cacheWrite": 5.0}}]}, "compat": {+ "nativeCachePolicy": {"tag": "NativeCacheModern", "contents": [false, true]}, "kind": "openai-responses", "supportsSamplingParameters": false, "supportsLongCacheRetention": false,@@ -383,6 +411,10 @@ }, "contextWindow": 200000, "maxOutputTokens": 100000,+ "compat": {+ "kind": "openai-completions",+ "supportedReasoningEfforts": ["low", "medium", "high"]+ }, "enabled": true }, {@@ -398,6 +430,10 @@ }, "contextWindow": 200000, "maxOutputTokens": 100000,+ "compat": {+ "kind": "openai-completions",+ "supportedReasoningEfforts": ["low", "medium", "high"]+ }, "enabled": true }, {@@ -413,6 +449,10 @@ }, "contextWindow": 200000, "maxOutputTokens": 100000,+ "compat": {+ "kind": "openai-completions",+ "supportedReasoningEfforts": ["low", "medium", "high"]+ }, "enabled": true }, {@@ -428,6 +468,10 @@ }, "contextWindow": 200000, "maxOutputTokens": 100000,+ "compat": {+ "kind": "openai-completions",+ "supportedReasoningEfforts": ["low", "medium", "high"]+ }, "enabled": true } ]
+ data/models/typesafe.json view
@@ -0,0 +1,46 @@+{+ "provider": "typesafe",+ "baseUrl": "https://api.typesafe.ai",+ "api": "typesafe-system-one",+ "compat": "auto",+ "models": [+ {+ "id": "jev-latest",+ "name": "jev-latest",+ "reasoning": false,+ "input": [+ "text",+ "data"+ ],+ "outputKind": "judgment",+ "cost": {+ "input": 0,+ "output": 0,+ "cacheRead": 0,+ "cacheWrite": 0+ },+ "contextWindow": 0,+ "maxOutputTokens": 0,+ "enabled": true+ },+ {+ "id": "jev-preview",+ "name": "jev-preview",+ "reasoning": false,+ "input": [+ "text",+ "data"+ ],+ "outputKind": "judgment",+ "cost": {+ "input": 0,+ "output": 0,+ "cacheRead": 0,+ "cacheWrite": 0+ },+ "contextWindow": 0,+ "maxOutputTokens": 0,+ "enabled": true+ }+ ]+}
fetch/FetchModelsCore.hs view
@@ -65,7 +65,7 @@ ) where -import Baikai.Compat (AnthropicThinkingStyle (..), OpenAICompletionsCompat (..), OpenAIResponsesCompat (..), defaultOpenAIResponsesCompat)+import Baikai.Compat (AnthropicThinkingStyle (..), NativeCachePolicy (..), OpenAICompletionsCompat (..), OpenAIResponsesCompat (..), defaultOpenAICompletionsCompat, defaultOpenAIResponsesCompat) import Baikai.Model (InputModality (..)) import Baikai.Model qualified as Model import Baikai.Prelude@@ -204,6 +204,8 @@ { thinkingStyle :: !AnthropicThinkingStyle, supportsSamplingParameters :: !Bool, supportsForcedToolChoice :: !Bool,+ -- | Whether the generation accepts @thinking: {"type": "disabled"}@.+ supportsThinkingDisabled :: !Bool, fastModeCost :: !(Maybe CatalogCost) } deriving stock (Eq, Show, Generic)@@ -222,6 +224,7 @@ name :: !Text, reasoning :: !Bool, input :: ![InputModality],+ outputKind :: !Model.OutputKind, cost :: !CatalogCost, fastModeCost :: !(Maybe CatalogCost), pricingPolicy :: !(Maybe Model.PricingPolicy),@@ -266,10 +269,20 @@ openaiInclude = Map.union ( Map.fromList- [ ("gpt-6-astra", Just (CatalogResponsesCompat astraResponsesFacts)),+ [ ("gpt-5.6", Just (CatalogOpenAICompat (defaultOpenAICompletionsCompat & #nativeCachePolicy .~ Just (NativeCacheModern False True)))),+ ("gpt-5.5", Just (CatalogOpenAICompat (defaultOpenAICompletionsCompat & #nativeCachePolicy .~ Just (NativeCacheLegacy False True)))),+ ("gpt-4.1", Just (CatalogOpenAICompat (defaultOpenAICompletionsCompat & #nativeCachePolicy .~ Just (NativeCacheLegacy True True)))),+ ("gpt-5", Just (CatalogOpenAICompat gpt5Facts)),+ ("gpt-5-mini", Just (CatalogOpenAICompat gpt5Facts)),+ ("gpt-5-nano", Just (CatalogOpenAICompat gpt5Facts)),+ ("o1", Just (CatalogOpenAICompat oSeriesFacts)),+ ("o3", Just (CatalogOpenAICompat oSeriesFacts)),+ ("o3-mini", Just (CatalogOpenAICompat oSeriesFacts)),+ ("o4-mini", Just (CatalogOpenAICompat oSeriesFacts)),+ ("gpt-6-astra", Just (CatalogResponsesCompat astraResponsesFacts)), ("gpt-6.1-sol", Just (CatalogResponsesCompat gpt61ResponsesFacts)), ("gpt-6-sol", Just (CatalogResponsesCompat gpt6ResponsesFacts)),- ("gpt-6-luna", Just (CatalogResponsesCompat gpt6ResponsesFacts))+ ("gpt-6-luna", Just (CatalogResponsesCompat lunaResponsesFacts)) ] ) $ Map.fromList@@ -300,11 +313,25 @@ ] ] where+ -- 2026-10-25: Endpoint cache facts from the caching guide and Chat/Responses+ -- references: https://developers.openai.com/api/docs/guides/prompt-caching+ -- Short and breakpoint support passed live pairs on Luna Responses and+ -- GPT-5.6 Chat. A funded Luna Responses 12h probe completed and reported+ -- ttl_12h_tokens; GPT-5.6 Chat rejected 12h with HTTP 400 (30m only).+ -- Enable Long only on the probed Luna endpoint, with its published rates.+ -- https://developers.openai.com/api/docs/pricing+ lunaResponsesFacts = gpt6ResponsesFacts & #nativeCachePolicy .~ Just (NativeCacheModern True True) & #supportsLongCacheRetention .~ True -- 2026-09-23: Sol and Luna require Responses for function calling at -- their default reasoning effort; Chat permits it only at effort none. -- https://developers.openai.com/api/docs/models/gpt-6-sol -- https://developers.openai.com/api/docs/models/gpt-6-luna- gpt6ResponsesFacts = astraResponsesFacts+ gpt6ResponsesFacts = astraResponsesFacts & #supportedReasoningEfforts .~ Just [ThinkingNone, ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax]+ -- 2026-10-25: GPT-5 accepts minimal through high, o-series low through+ -- high. Neither accepts none; keep this fact through catalog refreshes.+ -- https://developers.openai.com/api/docs/models/gpt-5+ -- https://developers.openai.com/api/docs/guides/reasoning+ gpt5Facts = defaultOpenAICompletionsCompat & #supportedReasoningEfforts .~ Just [ThinkingMinimal, ThinkingLow, ThinkingMedium, ThinkingHigh]+ oSeriesFacts = defaultOpenAICompletionsCompat & #supportedReasoningEfforts .~ Just [ThinkingLow, ThinkingMedium, ThinkingHigh] -- 2026-09-29: as Astra, tool calling requires Responses; efforts low -- through max (no none or minimal); sampling removed; 30m cache TTL. -- https://developers.openai.com/api/docs/models/gpt-6.1-sol@@ -314,7 +341,8 @@ -- https://developers.openai.com/api/docs/guides/latest-model astraResponsesFacts = defaultOpenAIResponsesCompat- { supportsPromptCacheOptions = True,+ { nativeCachePolicy = Just (NativeCacheModern False True),+ supportsPromptCacheOptions = True, supportsLongCacheRetention = False, supportsSamplingParameters = False, supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax]@@ -371,11 +399,11 @@ -- and sent it budget_tokens — same source. ("claude-sonnet-5", adaptiveNoSampling), -- 2026-09-29: adaptive thinking on by default; forced tool choice and- -- nondefault sampling return 400; no fast mode. Baikai never sends- -- the rejected "disabled" thinking type.+ -- nondefault sampling return 400; no fast mode. The "disabled" thinking+ -- type returns 400 too; its lowest setting is "between_tools". -- https://platform.claude.com/docs/en/models/sonnet-5-5/whats-new-sonnet-5-5 -- https://platform.claude.com/docs/en/build-with-claude/fast-mode- ("claude-sonnet-5-5", adaptiveNoSampling & #supportsForcedToolChoice .~ False),+ ("claude-sonnet-5-5", adaptiveNoSampling & #supportsForcedToolChoice .~ False & #supportsThinkingDisabled .~ False), -- 2026-08-27: as claude-opus-4-6 — budget deprecated but functional, -- sampling accepted; baikai prefers the non-deprecated shape — same -- source. Plan 40 left this membership to a live check that never@@ -394,23 +422,27 @@ -- https://platform.claude.com/docs/en/build-with-claude/effort ("claude-haiku-5-5", adaptiveNoSampling), -- 2026-08-27: adaptive-only, sampling parameters rejected — same source.- ("claude-fable-5", adaptiveNoSampling),+ ("claude-fable-5", adaptiveNoSampling & #supportsThinkingDisabled .~ False), -- 2026-09-07: always-on adaptive thinking; omit sampling parameters. -- https://platform.claude.com/docs/en/models/fable-5-1/whats-new-fable-5-1- ("claude-fable-5-1", adaptiveNoSampling & #supportsForcedToolChoice .~ False)+ ("claude-fable-5-1", adaptiveNoSampling & #supportsForcedToolChoice .~ False & #supportsThinkingDisabled .~ False) ] where- opus55Facts = adaptiveNoSampling & #supportsForcedToolChoice .~ False & #fastModeCost ?~ CatalogCost 8 40 0.4 10+ opus55Facts = adaptiveNoSampling & #supportsForcedToolChoice .~ False & #supportsThinkingDisabled .~ False & #fastModeCost ?~ CatalogCost 8 40 0.4 10 -- 2026-09-23: Fable 5.1 and Opus 5.5 reject forced choice; older curated -- models accept it subject to their separate manual-thinking constraint. -- https://platform.claude.com/docs/en/api/errors -- https://platform.claude.com/docs/en/models/fable-5-1/migration-guide+ -- 2026-10-19: Opus 5.5, Sonnet 5.5, Fable 5 and Fable 5.1 reject+ -- thinking {"type": "disabled"} with a 400; every other curated model+ -- accepts it (Haiku 5.5 and Opus 5 only at effort high or below).+ -- https://platform.claude.com/docs/en/build-with-claude/thinking-troubleshooting -- 2026-09-07: Opus 5 and 4.8 only; cache multipliers stack on fast rates. -- https://platform.claude.com/docs/en/build-with-claude/fast-mode fastAdaptive = adaptiveNoSampling & #fastModeCost ?~ CatalogCost 10 50 1 12.5- adaptiveNoSampling = AnthropicGenerationFacts AnthropicThinkingAdaptive False True Nothing- adaptiveWithSampling = AnthropicGenerationFacts AnthropicThinkingAdaptive True True Nothing- budgetWithSampling = AnthropicGenerationFacts AnthropicThinkingBudget True True Nothing+ adaptiveNoSampling = AnthropicGenerationFacts AnthropicThinkingAdaptive False True True Nothing+ adaptiveWithSampling = AnthropicGenerationFacts AnthropicThinkingAdaptive True True True Nothing+ budgetWithSampling = AnthropicGenerationFacts AnthropicThinkingBudget True True True Nothing -- | OpenAI curation with a Chat default and explicit Responses overrides. openaiSpec :: ProviderSpec@@ -463,6 +495,7 @@ { modelId = m ^. #modelId, name = normalizeName (fromMaybe (m ^. #modelId) (m ^. #name)), reasoning = m ^. #reasoning,+ outputKind = Model.GenerativeOutput, input = if "image" `elem` (m ^. #inputModalities) then [InputText, InputImage]@@ -658,6 +691,7 @@ " \"contextWindow\": " <> Text.pack (show (m ^. #contextWindow)) <> ",", " \"maxOutputTokens\": " <> Text.pack (show (m ^. #maxOutputTokens)) <> "," ]+ ++ [" \"outputKind\": \"judgment\"," | m ^. #outputKind == Model.JudgmentOutput] ++ maybe [] (\a -> [" \"api\": " <> jsonString a <> ","]) (m ^. #apiOverride) ++ maybe [] (\r -> [" \"fastModeCost\": " <> renderFastCost r <> ","]) (m ^. #fastModeCost) ++ maybe [] (\p -> [" \"pricingPolicy\": " <> renderPricingPolicy p <> ","]) (m ^. #pricingPolicy)@@ -692,7 +726,10 @@ (("anthropic", "claude-sonnet-5-5"), Model.PricingPolicy [] (Just 4)), (("openai", "gpt-6.1-sol"), Model.PricingPolicy [Model.InputPriceTier 272000 (Model.ModelCost 4 15 0.2 5) Nothing] Nothing), (("openai", "gpt-6-sol"), Model.PricingPolicy [Model.InputPriceTier 272000 (Model.ModelCost 4 15 0.4 5) Nothing] Nothing),- (("openai", "gpt-6-luna"), Model.PricingPolicy [Model.InputPriceTier 272000 (Model.ModelCost 0.2 0.75 0.02 0.25) Nothing] Nothing),+ -- 2026-10-25: Luna Responses accepts 12h. The standard pricing table+ -- publishes 0.25/M below/at 272K and 0.50/M above, matching the+ -- guide's total 2.5x uncached-input rate (not an added surcharge).+ (("openai", "gpt-6-luna"), Model.PricingPolicy [Model.InputPriceTier 272000 (Model.ModelCost 0.2 0.75 0.02 0.25) (Just 0.5)] (Just 0.25)), (("anthropic", "claude-fable-5-1"), Model.PricingPolicy [] (Just 20)), (("anthropic", "claude-haiku-5-5"), Model.PricingPolicy [Model.InputPriceTier 100000 (Model.ModelCost 0.5 2.5 0.05 0.625) (Just 1)] (Just 0.2)) ]@@ -722,7 +759,8 @@ <> jsonBool (facts ^. #supportsSamplingParameters) <> ",", " \"supportsFastMode\": " <> jsonBool (maybe False (const True) (facts ^. #fastModeCost)) <> ",",- " \"supportsForcedToolChoice\": " <> jsonBool (facts ^. #supportsForcedToolChoice),+ " \"supportsForcedToolChoice\": " <> jsonBool (facts ^. #supportsForcedToolChoice) <> ",",+ " \"supportsThinkingDisabled\": " <> jsonBool (facts ^. #supportsThinkingDisabled), " }," ] renderModelCompat (Just (CatalogOpenAICompat facts)) =@@ -730,6 +768,7 @@ " \"kind\": \"openai-completions\",", " \"supportsToolCalls\": " <> jsonBool (facts ^. #supportsToolCalls) <> ",", " \"supportsSamplingParameters\": " <> jsonBool (facts ^. #supportsSamplingParameters) <> ",",+ " \"nativeCachePolicy\": " <> maybe "null" (decodeUtf8 . LBS.toStrict . encode) (facts ^. #nativeCachePolicy) <> ",", " \"supportedReasoningEfforts\": " <> maybe "null" (\xs -> "[" <> Text.intercalate ", " (map (jsonString . renderThinkingLevel) xs) <> "]") (facts ^. #supportedReasoningEfforts), " }," ]@@ -739,6 +778,7 @@ " \"supportsSamplingParameters\": " <> jsonBool (facts ^. #supportsSamplingParameters) <> ",", " \"supportsLongCacheRetention\": " <> jsonBool (facts ^. #supportsLongCacheRetention) <> ",", " \"supportsPromptCacheOptions\": " <> jsonBool (facts ^. #supportsPromptCacheOptions) <> ",",+ " \"nativeCachePolicy\": " <> maybe "null" (decodeUtf8 . LBS.toStrict . encode) (facts ^. #nativeCachePolicy) <> ",", " \"supportedReasoningEfforts\": " <> maybe "null" (\xs -> "[" <> Text.intercalate ", " (map (jsonString . renderThinkingLevel) xs) <> "]") (facts ^. #supportedReasoningEfforts), " }," ]@@ -756,6 +796,7 @@ where one InputText = "\"text\"" one InputImage = "\"image\""+ one InputData = "\"data\"" jsonBool :: Bool -> Text jsonBool True = "true"
gen/GenModels.hs view
@@ -36,6 +36,7 @@ import GenModelsCore ( checkAnthropicCompat, checkIdentifierCollisions,+ checkNativeCacheCompat, flattenEntries, renderModule, )@@ -60,6 +61,9 @@ Left err -> die (Text.unpack err) Right () -> pure () case checkAnthropicCompat allEntries of+ Left err -> die (Text.unpack err)+ Right () -> pure ()+ case checkNativeCacheCompat allEntries of Left err -> die (Text.unpack err) Right () -> pure () let sorted = sortOn fst allEntries
gen/GenModelsCore.hs view
@@ -15,6 +15,7 @@ flattenEntries, checkIdentifierCollisions, checkAnthropicCompat,+ checkNativeCacheCompat, parseAnthropicThinkingStyle, sanitizeIdentifier, renderModule,@@ -30,14 +31,17 @@ supportsForcedToolChoice, supportsLongCacheRetention, supportsSamplingParameters,+ supportsThinkingDisabled, thinkingStyle ), AnthropicThinkingStyle (..), CacheControlFormat (..), MaxTokensField (..),+ NativeCachePolicy (..), OpenAICompletionsCompat ( cacheControlFormat, maxTokensField,+ nativeCachePolicy, requiresThinkingAsText, supportedReasoningEfforts, supportsLongCacheRetention,@@ -52,6 +56,7 @@ defaultAnthropicMessagesCompat, defaultOpenAICompletionsCompat, defaultOpenAIResponsesCompat,+ validateNativeCachePolicy, ) import Baikai.Model (InputModality (..)) import Baikai.Model qualified as Model@@ -123,8 +128,9 @@ _ -> pure () sampling <- o .:? "supportsSamplingParameters" .!= d.supportsSamplingParameters long <- o .:? "supportsLongCacheRetention" .!= d.supportsLongCacheRetention+ native <- o .:? "nativeCachePolicy" modern <- o .:? "supportsPromptCacheOptions" .!= d.supportsPromptCacheOptions- pure d {supportedReasoningEfforts = efforts, supportsSamplingParameters = sampling, supportsLongCacheRetention = long, supportsPromptCacheOptions = modern}+ pure d {nativeCachePolicy = native, supportedReasoningEfforts = efforts, supportsSamplingParameters = sampling, supportsLongCacheRetention = long, supportsPromptCacheOptions = modern} parseOpenAICompat :: Aeson.Object -> Parser OpenAICompletionsCompat parseOpenAICompat o = do@@ -133,6 +139,7 @@ sst <- o .:? "supportsStrictMode" .!= supportsStrictMode d rtat <- o .:? "requiresThinkingAsText" .!= requiresThinkingAsText d tf <- optionalField o "thinkingFormat" parseThinkingFormat (thinkingFormat d)+ native <- o .:? "nativeCachePolicy" ccf <- optionalMaybeField o "cacheControlFormat" parseCacheControlFormat (cacheControlFormat d) sus <- o .:? "supportsUsageInStreaming" .!= d.supportsUsageInStreaming slcr <- o .:? "supportsLongCacheRetention" .!= d.supportsLongCacheRetention@@ -145,7 +152,8 @@ _ -> pure () pure d- { supportsToolCalls = stc,+ { nativeCachePolicy = native,+ supportsToolCalls = stc, supportsSamplingParameters = ssp, supportedReasoningEfforts = efforts, maxTokensField = mtf,@@ -167,6 +175,7 @@ ssp <- o .:? "supportsSamplingParameters" .!= d.supportsSamplingParameters fast <- o .:? "supportsFastMode" .!= False forced <- o .:? "supportsForcedToolChoice" .!= d.supportsForcedToolChoice+ disabled <- o .:? "supportsThinkingDisabled" .!= d.supportsThinkingDisabled pure d { supportsLongCacheRetention = slcr,@@ -175,7 +184,8 @@ thinkingStyle = ts, supportsSamplingParameters = ssp, supportsFastMode = fast,- supportsForcedToolChoice = forced+ supportsForcedToolChoice = forced,+ supportsThinkingDisabled = disabled } -- | The catalog dialect spells the extended-thinking wire shape as a@@ -242,6 +252,7 @@ entryName :: !Text, entryReasoning :: !Bool, entryInput :: ![InputModality],+ entryOutputKind :: !Model.OutputKind, entryCost :: !CostEntry, entryFastModeCost :: !(Maybe CostEntry), entryPricingPolicy :: !(Maybe Model.PricingPolicy),@@ -259,6 +270,7 @@ <*> o .: "name" <*> o .:? "reasoning" .!= False <*> (o .: "input" >>= traverse parseInputModality)+ <*> o .:? "outputKind" .!= Model.GenerativeOutput <*> o .: "cost" <*> o .:? "fastModeCost" <*> (o .:? "pricingPolicy" >>= traverse parsePricingPolicy)@@ -272,6 +284,7 @@ parseInputModality = \case "text" -> pure InputText "image" -> pure InputImage+ "data" -> pure InputData t -> fail $ "unknown input modality: " <> Text.unpack t -- | Per-million-token cost rates. Parsed as 'Scientific' so the@@ -329,6 +342,7 @@ baseUrl :: !Text, reasoning :: !Bool, input :: ![InputModality],+ outputKind :: !Model.OutputKind, cost :: !CostEntry, fastModeCost :: !(Maybe CostEntry), pricingPolicy :: !(Maybe Model.PricingPolicy),@@ -353,6 +367,7 @@ baseUrl = c.baseUrl, reasoning = entryReasoning m, input = entryInput m,+ outputKind = entryOutputKind m, cost = entryCost m, fastModeCost = entryFastModeCost m, pricingPolicy = entryPricingPolicy m,@@ -419,6 +434,26 @@ <> ",\"thinkingStyle\":\"budget\"|\"adaptive\"" <> ",\"supportsSamplingParameters\":true|false}" +-- | Validate native endpoint facts and modern Long pricing together.+checkNativeCacheCompat :: [(Text, GeneratedEntry)] -> Either Text ()+checkNativeCacheCompat entries = mapM_ checkNative (map snd entries)+ where+ checkNative e = do+ let (format, policy) = case e.compat of+ CatalogCompatOpenAI c -> (c.cacheControlFormat, c.nativeCachePolicy)+ CatalogCompatResponses c -> (Nothing, c.nativeCachePolicy)+ _ -> (Nothing, Nothing)+ named = either (Left . ((e.modelId <> ": ") <>)) Right+ named (validateNativeCachePolicy format policy)+ case policy of+ Just (NativeCacheModern True _) -> named $ case e.pricingPolicy of+ Just p+ | Just _ <- p.longCacheWriteCost,+ all (\t -> t.longCacheWriteCost /= Nothing) (Model.inputTiers p) ->+ Right ()+ _ -> Left "modern Long requires base and every tier long cache-write rates"+ _ -> Right ()+ -- | Replace any non-identifier character with @_@. Haskell allows -- letters, digits, underscore, and apostrophe; everything else -- (slash, dash, dot, colon, ...) becomes an underscore.@@ -469,13 +504,16 @@ " supportsForcedToolChoice,", " supportsLongCacheRetention,", " supportsSamplingParameters,",+ " supportsThinkingDisabled,", " thinkingStyle", " ),", " AnthropicThinkingStyle (..),", " CacheControlFormat (..),",+ " NativeCachePolicy (..),", " MaxTokensField (..),", " OpenAICompletionsCompat",- " ( cacheControlFormat,",+ " ( nativeCachePolicy,",+ " cacheControlFormat,", " maxTokensField,", " requiresThinkingAsText,", " supportedReasoningEfforts,",@@ -498,6 +536,7 @@ " InputPriceTier (..),", " Model,", " ModelCost (..),",+ " OutputKind (..),", " PricingPolicy (..),", " api,", " baseUrl,",@@ -511,6 +550,7 @@ " maxOutputTokens,", " modelId,", " name,",+ " outputKind,", " pricingPolicy,", " provider,", " reasoning,",@@ -552,6 +592,7 @@ " baseUrl = " <> renderText g.baseUrl <> ",", " reasoning = " <> renderBool g.reasoning <> ",", " input = " <> renderInputList g.input <> ",",+ " outputKind = " <> (if g.outputKind == Model.JudgmentOutput then "JudgmentOutput" else "GenerativeOutput") <> ",", " cost =", renderCost g.cost <> ",", renderFastCost g.fastModeCost,@@ -581,6 +622,7 @@ where renderInput InputText = "InputText" renderInput InputImage = "InputImage"+ renderInput InputData = "InputData" renderApiCtor :: Api -> Text renderApiCtor = \case@@ -589,6 +631,7 @@ AnthropicMessages -> "AnthropicMessages" OpenAICompletionsCli -> "OpenAICompletionsCli" AnthropicMessagesCli -> "AnthropicMessagesCli"+ TypeSafeSystemOne -> "TypeSafeSystemOne" Custom t -> "Custom " <> renderText t renderCost :: CostEntry -> Text@@ -638,7 +681,8 @@ " supportsSamplingParameters = " <> renderBool c.supportsSamplingParameters <> ",", " supportedReasoningEfforts = " <> maybe "Nothing" (\xs -> "Just [" <> Text.intercalate ", " (map (Text.pack . show) xs) <> "]") c.supportedReasoningEfforts <> ",", " supportsUsageInStreaming = " <> renderBool c.supportsUsageInStreaming <> ",",- " supportsLongCacheRetention = " <> renderBool c.supportsLongCacheRetention,+ " supportsLongCacheRetention = " <> renderBool c.supportsLongCacheRetention <> ",",+ " nativeCachePolicy = " <> renderNativeCache c.nativeCachePolicy, " }" ] CatalogCompatResponses c ->@@ -648,7 +692,8 @@ " { supportedReasoningEfforts = " <> maybe "Nothing" (\xs -> "Just [" <> Text.intercalate ", " (map (Text.pack . show) xs) <> "]") c.supportedReasoningEfforts <> ",", " supportsSamplingParameters = " <> renderBool c.supportsSamplingParameters <> ",", " supportsLongCacheRetention = " <> renderBool c.supportsLongCacheRetention <> ",",- " supportsPromptCacheOptions = " <> renderBool c.supportsPromptCacheOptions,+ " supportsPromptCacheOptions = " <> renderBool c.supportsPromptCacheOptions <> ",",+ " nativeCachePolicy = " <> renderNativeCache c.nativeCachePolicy, " }" ] CatalogCompatAnthropic c ->@@ -661,7 +706,8 @@ " thinkingStyle = " <> renderAnthropicThinkingStyle c.thinkingStyle <> ",", " supportsSamplingParameters = " <> renderBool c.supportsSamplingParameters <> ",", " supportsFastMode = " <> renderBool c.supportsFastMode <> ",",- " supportsForcedToolChoice = " <> renderBool c.supportsForcedToolChoice,+ " supportsForcedToolChoice = " <> renderBool c.supportsForcedToolChoice <> ",",+ " supportsThinkingDisabled = " <> renderBool c.supportsThinkingDisabled, " }" ] @@ -705,3 +751,7 @@ " }", " )," ]++renderNativeCache :: Maybe NativeCachePolicy -> Text+renderNativeCache Nothing = "Nothing"+renderNativeCache (Just p) = "Just (" <> Text.pack (show p) <> ")"
src/Baikai.hs view
@@ -48,6 +48,8 @@ -- * Streaming module Baikai.Stream, module Baikai.Stream.Event,+ module Baikai.Response.JSON,+ module Baikai.Judgment, ) where @@ -64,11 +66,13 @@ import Baikai.Evidence.Build import Baikai.Header import Baikai.Interactive+import Baikai.Judgment import Baikai.Message import Baikai.Model import Baikai.Options import Baikai.Provider import Baikai.Response+import Baikai.Response.JSON import Baikai.ResponseFormat import Baikai.Speed import Baikai.StopReason
src/Baikai/Api.hs view
@@ -32,6 +32,7 @@ | AnthropicMessages | OpenAICompletionsCli | AnthropicMessagesCli+ | TypeSafeSystemOne | Custom !Text deriving stock (Eq, Ord, Show, Generic) @@ -43,6 +44,7 @@ AnthropicMessages -> "anthropic-messages" OpenAICompletionsCli -> "openai-completions-cli" AnthropicMessagesCli -> "anthropic-messages-cli"+ TypeSafeSystemOne -> "typesafe-system-one" Custom t -> t -- | Parse a wire string into an 'Api' tag. Unknown strings become@@ -54,6 +56,7 @@ "anthropic-messages" -> AnthropicMessages "openai-completions-cli" -> OpenAICompletionsCli "anthropic-messages-cli" -> AnthropicMessagesCli+ "typesafe-system-one" -> TypeSafeSystemOne t -> Custom t -- | Collapse a 'Custom' tag that spells a built-in API onto that
src/Baikai/Auth.hs view
@@ -69,6 +69,7 @@ match host where match host+ | hostMatchesSuffix host "api.typesafe.ai" = Just "TYPESAFE_API_KEY" | hostMatchesSuffix host "api.openai.com" = Just "OPENAI_API_KEY" | hostMatchesSuffix host "api.deepseek.com" = Just "DEEPSEEK_API_KEY" | hostMatchesSuffix host "openrouter.ai" = Just "OPENROUTER_API_KEY"
src/Baikai/Compat.hs view
@@ -33,6 +33,7 @@ requiresThinkingAsText, thinkingFormat, cacheControlFormat,+ nativeCachePolicy, supportsToolCalls, supportsSamplingParameters, supportedReasoningEfforts,@@ -43,9 +44,11 @@ MaxTokensField (..), ThinkingFormat (..), CacheControlFormat (..),+ NativeCachePolicy (..),+ validateNativeCachePolicy, -- * OpenAI Responses compat- OpenAIResponsesCompat (supportedReasoningEfforts, supportsSamplingParameters, supportsLongCacheRetention, supportsPromptCacheOptions),+ OpenAIResponsesCompat (supportedReasoningEfforts, supportsSamplingParameters, supportsLongCacheRetention, supportsPromptCacheOptions, nativeCachePolicy), defaultOpenAIResponsesCompat, -- * Anthropic Messages compat@@ -56,6 +59,7 @@ thinkingStyle, supportsFastMode, supportsForcedToolChoice,+ supportsThinkingDisabled, supportsSamplingParameters ), AnthropicThinkingStyle (..),@@ -132,6 +136,25 @@ deriving stock (Eq, Show, Generic) deriving anyclass (FromJSON, ToJSON) +-- | Endpoint-specific native OpenAI caching. Absence on a compat record+-- preserves its legacy behavior; explicit unsupported overrides old flags.+-- Legacy arguments declare in_memory and 24h independently. Modern arguments+-- declare 12h and prefix breakpoints; modern always supports the 30m default.+-- The sum prevents mixing legacy retention with modern breakpoints.+data NativeCachePolicy+ = NativeCacheUnsupported+ | NativeCacheLegacy !Bool !Bool+ | NativeCacheModern !Bool !Bool+ deriving stock (Eq, Show, Generic)+ deriving anyclass (FromJSON, ToJSON)++-- | Reject contradictory caller-built as well as curated endpoint facts.+validateNativeCachePolicy :: Maybe CacheControlFormat -> Maybe NativeCachePolicy -> Either Text ()+validateNativeCachePolicy format policy = case (format, policy) of+ (Just _, Just _) -> Left "native and Anthropic cache controls cannot share a binding"+ (_, Just (NativeCacheLegacy False False)) -> Left "legacy cache policy must accept at least one retention value"+ _ -> Right ()+ -- | Which request shape an Anthropic-compatible host/model accepts -- for extended thinking. Budget-era models take -- @{"type":"enabled","budget_tokens":N}@; adaptive-era models take@@ -194,10 +217,11 @@ -- Anthropic-style cache_control marker. Consumed by -- @Baikai.Provider.OpenAI.Shape.injectCacheControl@ when -- 'cacheControlFormat' is 'Just CacheControlFormatAnthropic'.- supportsLongCacheRetention :: !Bool+ supportsLongCacheRetention :: !Bool,+ nativeCachePolicy :: !(Maybe NativeCachePolicy) } deriving stock (Eq, Show, Generic)- deriving anyclass (FromJSON, ToJSON)+ deriving anyclass (ToJSON) -- | OpenAI's own host: every flag at the OpenAI default. defaultOpenAICompletionsCompat :: OpenAICompletionsCompat@@ -212,7 +236,8 @@ supportsToolCalls = True, supportsSamplingParameters = True, supportedReasoningEfforts = Nothing,- supportsLongCacheRetention = True+ supportsLongCacheRetention = True,+ nativeCachePolicy = Nothing } -- | Model and endpoint facts for native Responses. This is separate@@ -222,10 +247,11 @@ supportsSamplingParameters :: !Bool, supportsLongCacheRetention :: !Bool, -- | Use prompt_cache_options rather than legacy prompt_cache_retention.- supportsPromptCacheOptions :: !Bool+ supportsPromptCacheOptions :: !Bool,+ nativeCachePolicy :: !(Maybe NativeCachePolicy) } deriving stock (Eq, Show, Generic)- deriving anyclass (FromJSON, ToJSON)+ deriving anyclass (ToJSON) defaultOpenAIResponsesCompat :: OpenAIResponsesCompat defaultOpenAIResponsesCompat =@@ -233,9 +259,35 @@ { supportedReasoningEfforts = Nothing, supportsSamplingParameters = True, supportsLongCacheRetention = True,- supportsPromptCacheOptions = False+ supportsPromptCacheOptions = False,+ nativeCachePolicy = Nothing } +-- New policy fields are optional in persisted compatibility JSON.+instance FromJSON OpenAICompletionsCompat where+ parseJSON = withObject "OpenAICompletionsCompat" $ \o ->+ OpenAICompletionsCompat+ <$> o .: "maxTokensField"+ <*> o .: "supportsStrictMode"+ <*> o .: "requiresThinkingAsText"+ <*> o .: "thinkingFormat"+ <*> o .:? "cacheControlFormat"+ <*> o .: "supportsUsageInStreaming"+ <*> o .: "supportsToolCalls"+ <*> o .: "supportsSamplingParameters"+ <*> o .:? "supportedReasoningEfforts"+ <*> o .: "supportsLongCacheRetention"+ <*> o .:? "nativeCachePolicy"++instance FromJSON OpenAIResponsesCompat where+ parseJSON = withObject "OpenAIResponsesCompat" $ \o ->+ OpenAIResponsesCompat+ <$> o .:? "supportedReasoningEfforts"+ <*> o .: "supportsSamplingParameters"+ <*> o .: "supportsLongCacheRetention"+ <*> o .: "supportsPromptCacheOptions"+ <*> o .:? "nativeCachePolicy"+ -- | Feature flags for one Anthropic Messages-compatible host. data AnthropicMessagesCompat = AnthropicMessagesCompat { -- | Whether the host honours Anthropic's@@ -243,8 +295,9 @@ -- long-retention preferences silently downgrade to ephemeral. -- Consumed by @Baikai.Provider.Claude.Internal.Request.computeCacheControl@ -- for top-level cache markers and by- -- @Baikai.Provider.Claude.Shape.injectToolCacheControl@ for- -- tool cache markers.+ -- @Baikai.Provider.Claude.Shape.injectToolCacheControl@ and+ -- @Baikai.Provider.Claude.Shape.injectSystemCacheControl@ for+ -- tool and system-prompt cache markers. supportsLongCacheRetention :: !Bool, -- | Whether tool definitions accept @cache_control@ markers. -- Consumed by@@ -276,7 +329,15 @@ supportsFastMode :: !Bool, -- | Whether this generation accepts required or named tool choice. -- Defaults to True; explicit catalog facts disable unsupported choices.- supportsForcedToolChoice :: !Bool+ supportsForcedToolChoice :: !Bool,+ -- | Whether this generation accepts @thinking: {"type": "disabled"}@,+ -- which 'Baikai.ThinkingLevel.ThinkingNone' sends. Defaults to False:+ -- unannotated and legacy records do not establish disable support.+ -- Claude Opus 5.5, Sonnet 5.5, Fable 5 and Fable 5.1 reject it with a 400, and their catalog+ -- records say so; there @none@ clamps to the lowest adaptive effort+ -- and the clamp is recorded. Consumed by+ -- @Baikai.Provider.Claude.Internal.Request.computeThinking@.+ supportsThinkingDisabled :: !Bool } deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON)@@ -291,10 +352,12 @@ thinkingStyle = AnthropicThinkingBudget, supportsSamplingParameters = True, supportsFastMode = False,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = False } --- | Older persisted models predate fast-mode and forced-choice capabilities.+-- | Older persisted models predate the fast-mode, forced-choice and+-- disabled-thinking capabilities. instance FromJSON AnthropicMessagesCompat where parseJSON = withObject "AnthropicMessagesCompat" $ \o -> AnthropicMessagesCompat@@ -305,6 +368,7 @@ <*> o .: "supportsSamplingParameters" <*> o .:? "supportsFastMode" .!= False <*> o .:? "supportsForcedToolChoice" .!= True+ <*> o .:? "supportsThinkingDisabled" .!= False -- | Pick a sensible compat record for an unknown OpenAI-compatible -- host based on its @baseUrl@. Falls back to
src/Baikai/Content.hs view
@@ -4,9 +4,9 @@ -- -- A message no longer carries a single opaque blob of text. Instead it -- holds a vector of typed blocks. For user input the blocks can be text--- or an inline base64-encoded image. For assistant output a block can be+-- or an inline base64-encoded image, or structured JSON. Assistant output can be -- text, a thinking trace (for reasoning-capable models), or a tool--- invocation. For tool-result messages (a caller-supplied reply to a+-- invocation or structured data with answer evidence. For tool-result messages (a caller-supplied reply to a -- model-issued tool call) blocks can be text or image. -- -- Image content is restricted to@@ -17,6 +17,8 @@ module Baikai.Content ( -- * Block primitives TextContent (..),+ DataContent (..),+ canonicalDataText, ThinkingContent (..), ThinkingReplay (..), ToolCall (..),@@ -40,6 +42,7 @@ where import Baikai.Api (Api)+import Baikai.Evidence (canonicalEncode) import Data.Aeson ( FromJSON (parseJSON), Options (..),@@ -60,6 +63,8 @@ import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.ByteString.Base64 qualified as Base64+import Data.Map.Strict (Map)+import Data.Scientific qualified as Scientific import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text@@ -73,6 +78,35 @@ deriving stock (Eq, Show, Generic) deriving anyclass (FromJSON, ToJSON) +-- | Structured output and optional provider-reported answer evidence.+-- Probabilities need not sum to one. Confidence is never derived locally.+data DataContent = DataContent+ { value :: !Value,+ probabilities :: !(Maybe (Map Text (Map Text Double))),+ confidence :: !(Maybe (Map Text Double)),+ method :: !(Maybe Text)+ }+ deriving stock (Eq, Show, Generic)++instance ToJSON DataContent where+ toJSON d =+ object $+ ["value" .= value d]+ <> maybe [] (\x -> ["probabilities" .= x]) (probabilities d)+ <> maybe [] (\x -> ["confidence" .= x]) (confidence d)+ <> maybe [] (\x -> ["method" .= x]) (method d)++instance FromJSON DataContent where+ parseJSON = withObject "DataContent" $ \o -> do+ v <- o .: "value"+ ps <- o .:? "probabilities"+ cs <- o .:? "confidence"+ m <- o .:? "method"+ let check n+ | n < 0 || n > (1 :: Scientific.Scientific) = fail "expected a probability in [0,1]"+ | otherwise = pure (Scientific.toRealFloat n :: Double)+ DataContent v <$> traverse (traverse (traverse check)) ps <*> traverse (traverse check) cs <*> pure m+ -- | A reasoning trace block produced by thinking-capable models. The -- @signature@ field is an opaque continuation token returned by the -- provider; it must be threaded back into the next request unchanged for@@ -169,6 +203,7 @@ data UserContent = UserText !TextContent | UserImage !ImageContent+ | UserData !Value deriving stock (Eq, Show, Generic) -- | What a provider can put into a 'Baikai.Message.AssistantMessage'.@@ -176,6 +211,7 @@ = AssistantText !TextContent | AssistantThinking !ThinkingContent | AssistantToolCall !ToolCall+ | AssistantData !DataContent deriving stock (Eq, Show, Generic) -- | What a caller can put into a 'Baikai.Message.ToolResultMessage'.@@ -283,3 +319,7 @@ instance ToJSON ToolResultContent where toJSON = genericToJSON contentSumOptions++-- | Deterministic UTF-8 JSON text for a structured input block.+canonicalDataText :: Value -> Text+canonicalDataText = Text.decodeUtf8 . canonicalEncode
src/Baikai/Context.hs view
@@ -19,6 +19,7 @@ messages, tools, emptyContext,+ refuseAssistantDataHistory, contextOf, systemUser, addUser,@@ -30,6 +31,7 @@ where import Baikai.Content (AssistantContent (..), ToolCall (..), isCutOffToolCall)+import Baikai.Error (BaikaiError, unsupportedFeature) import Baikai.Message (Message (..), ToolResult, toolResultErrorText, toolResultFromCallNow, toolResultText, user) import Baikai.Response (Response (..), responseError, responseMessage) import Baikai.Tool (Tool)@@ -38,6 +40,7 @@ import Data.Aeson (ToJSON) import Data.Generics.Labels () import Data.Text (Text)+import Data.Text qualified as Text import Data.Vector (Vector) import Data.Vector qualified as V import GHC.Generics (Generic)@@ -169,3 +172,12 @@ IO Context appendToolResultText ctx resp dispatcher = appendToolResult ctx resp (fmap toolResultText . dispatcher)++-- | Generative transports cannot replay structured answer evidence losslessly.+refuseAssistantDataHistory :: Context -> Either BaikaiError ()+refuseAssistantDataHistory ctx = case [ "messages[" <> Text.pack (show i) <> "].content[" <> Text.pack (show j) <> "]"+ | (i, AssistantMessage p) <- zip [0 :: Int ..] (V.toList (messages ctx)),+ (j, AssistantData _) <- zip [0 :: Int ..] (V.toList (p ^. #content))+ ] of+ [] -> Right ()+ path : _ -> Left (unsupportedFeature path "This transport cannot replay AssistantData evidence")
src/Baikai/Cost/Log.hs view
@@ -40,7 +40,8 @@ ) where -import Baikai.Content (TextContent (..), UserContent (..))+import Baikai.Content (DataContent, TextContent (..), UserContent (..))+import Baikai.Content qualified as Content import Baikai.Context (Context) import Baikai.Cost (CostBasis, usdAsScientific) import Baikai.Cost qualified as Cost@@ -55,7 +56,7 @@ completeRequestWith, globalProviderRegistry, )-import Baikai.Response (Response)+import Baikai.Response (Response, flattenAssistantData) import Baikai.Usage (Usage) import Baikai.Usage qualified as Usage import Control.Concurrent (forkIO)@@ -68,6 +69,7 @@ import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO) import Data.Aeson (FromJSON, ToJSON) import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KM import Data.ByteString.Lazy qualified as BSL import Data.Foldable (find) import Data.Function ((&))@@ -113,11 +115,18 @@ reasoningTokens :: !(Maybe Natural), usd :: !(Maybe Scientific), latencyMs :: !Int,- promptSummary :: !Text+ promptSummary :: !Text,+ structuredData :: !(Maybe (Vector.Vector DataContent)) } deriving stock (Eq, Show, Generic)- deriving anyclass (FromJSON, ToJSON) +instance FromJSON CallLogEntry where parseJSON = Aeson.genericParseJSON Aeson.defaultOptions++instance ToJSON CallLogEntry where+ toJSON e = case Aeson.genericToJSON Aeson.defaultOptions e of+ Aeson.Object o | Nothing <- structuredData e -> Aeson.Object (KM.delete "structuredData" o)+ v -> v+ -- | Opaque handle for an open call log. data CallLogHandle = CallLogHandle { chan :: !(Chan (Maybe CallLogEntry)),@@ -230,6 +239,7 @@ -- which entry point produced it. usd = Just (usdAsScientific (Usage.cost u)), latencyMs = resp ^. #latencyMs,+ structuredData = nonEmptyData (flattenAssistantData ((resp ^. #message) ^. #content)), promptSummary = summarizeContext ctx } appendEntry h entry@@ -283,4 +293,8 @@ concatUserText = Text.concat . Vector.toList . Vector.mapMaybe pickText where pickText (UserText (TextContent t)) = Just t+ pickText (UserData v) = Just (Content.canonicalDataText v) pickText _ = Nothing++nonEmptyData :: Vector.Vector a -> Maybe (Vector.Vector a)+nonEmptyData v = if Vector.null v then Nothing else Just v
src/Baikai/Error.hs view
@@ -1,6 +1,9 @@ module Baikai.Error ( BaikaiError (..), ErrorCategory (..),+ RequestProblem (..),+ unsupportedFeature,+ unsupportedModel, -- * Smart constructors providerError,@@ -37,6 +40,8 @@ genericParseJSON, genericToJSON, )+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KM import Data.Maybe (listToMaybe, mapMaybe) import Data.Text (Text) import Data.Text qualified as Text@@ -93,6 +98,28 @@ genericParseJSON defaultOptions {constructorTagModifier = camelTo2 '_'} +-- | A machine-readable request refusal, with its offending field or model.+data RequestProblem = UnsupportedFeature Text | UnsupportedModel Text+ deriving stock (Eq, Show, Generic)++instance ToJSON RequestProblem where+ toJSON (UnsupportedFeature path) = Aeson.object ["kind" Aeson..= ("unsupported_feature" :: Text), "field" Aeson..= path]+ toJSON (UnsupportedModel model) = Aeson.object ["kind" Aeson..= ("unsupported_model" :: Text), "model" Aeson..= model]++instance FromJSON RequestProblem where+ parseJSON = Aeson.withObject "RequestProblem" $ \o -> do+ k <- o Aeson..: "kind"+ case k :: Text of+ "unsupported_feature" -> UnsupportedFeature <$> o Aeson..: "field"+ "unsupported_model" -> UnsupportedModel <$> o Aeson..: "model"+ _ -> fail "unknown request problem kind"++unsupportedFeature :: Text -> Text -> BaikaiError+unsupportedFeature path msg = (invalidRequest msg) {requestProblem = Just (UnsupportedFeature path)}++unsupportedModel :: Text -> Text -> BaikaiError+unsupportedModel model msg = (invalidRequest msg) {requestProblem = Just (UnsupportedModel model)}+ -- | A failed baikai call. The 'category' drives caller policy; the -- remaining fields carry optional structured hints. No record-field -- prefixes (project convention): fields are plain names.@@ -109,15 +136,16 @@ exitCode :: !(Maybe Int), -- | Provider-reported refusal category, an open vocabulary. Present only -- when a content refusal names one; never inferred from message text.- refusalCategory :: !(Maybe Text)+ refusalCategory :: !(Maybe Text),+ requestProblem :: !(Maybe RequestProblem) } deriving stock (Eq, Show, Generic) -- | Fields serialize as snake_case (e.g. @http_status@, @retry_after_seconds@). instance ToJSON BaikaiError where- toJSON =- genericToJSON- defaultOptions {fieldLabelModifier = camelTo2 '_'}+ toJSON e = case genericToJSON defaultOptions {fieldLabelModifier = camelTo2 '_'} e of+ Aeson.Object o | Nothing <- requestProblem e -> Aeson.Object (KM.delete "request_problem" o)+ v -> v instance FromJSON BaikaiError where parseJSON =@@ -137,7 +165,8 @@ httpStatus = Nothing, retryAfterSeconds = Nothing, exitCode = Nothing,- refusalCategory = Nothing+ refusalCategory = Nothing,+ requestProblem = Nothing } -- Smart constructors. These keep call sites close to the old API: an
src/Baikai/Evidence.hs view
@@ -320,12 +320,16 @@ -- the requested thinking level; it must not refuse one merely because -- a sampling parameter had nowhere to go. The six level-carrying -- constructors weaken thinking; the sampling and speed ones do not.+--+-- A model catalogued as non-reasoning already satisfies ThinkingNone.+-- A host without controls may still reason by default: dropping none+-- there cannot satisfy a strict caller. weakensThinking :: ThinkingAdjustment -> Bool weakensThinking = \case EffortClamped {} -> True EffortCollapsedToToggle {} -> True EffortOmitted {} -> True- ThinkingDroppedUnsupportedModel {} -> True+ ThinkingDroppedUnsupportedModel lvl -> lvl /= ThinkingNone ThinkingDroppedUnsupportedHost {} -> True ThinkingDroppedBudgetExceeded {} -> True SamplingDroppedUnsupportedModel {} -> False@@ -788,6 +792,7 @@ OpenAIResponses -> EvidenceModelObserved AnthropicMessagesCli -> EvidenceModelObserved OpenAICompletionsCli -> EvidenceCorrelated+ TypeSafeSystemOne -> EvidenceModelObserved Custom _ -> EvidenceRequestedOnly -- ============================================================@@ -916,7 +921,13 @@ -- thinking_summary_unavailable diagnostic; existing digest rules are unchanged. -- Version 2.5 adds error_info.refusal_category, an optional provider fact. -- Older error objects decode with Nothing; digest inputs are unchanged.-evidenceSchemaVersion = "baikai.model-call-evidence/2.5"+-- Version 2.6 adds structured response content and optional request_problem.+-- The canonical encoding and data-free commitment fixtures are unchanged.+-- Version 2.7 adds the explicit none thinking preference. Existing digests and+-- observations are unchanged; a transmitted off request remains unobserved.+-- Version 2.8 projects native cache controls and content-free Responses input+-- structure. Envelopes lacking the new fields preserve their prior digests.+evidenceSchemaVersion = "baikai.model-call-evidence/2.8" -- | Everything Baikai can say about one completed provider call. --@@ -1267,6 +1278,10 @@ where keep (k, v) = case Key.toText k of "messages" -> [(k, summariseMessages v)]+ "input" -> [(k, summariseInput v)]+ "instructions" -> [(k, charSummary v)]+ "prompt_cache_options" -> [(k, summariseNativeControl v)]+ "prompt_cache_retention" -> [(k, allowedString ["in_memory", "24h"] v)] "system" -> [(k, charSummary v)] "tools" -> [(k, summariseTools v)] "output_config" -> [(k, summariseOutputConfig v)]@@ -1309,10 +1324,12 @@ summariseMessage = \case Object m -> object- [ "role" .= roleOf (KeyMap.lookup "role" m),- "blocks" .= blockCount (KeyMap.lookup "content" m),- "chars" .= maybe 0 totalStringChars (KeyMap.lookup "content" m)- ]+ ( [ "role" .= roleOf (KeyMap.lookup "role" m),+ "blocks" .= blockCount (KeyMap.lookup "content" m),+ "chars" .= maybe 0 totalStringChars (KeyMap.lookup "content" m)+ ]+ <> markerSummary (KeyMap.lookup "content" m)+ ) _ -> Null where roleOf = \case@@ -1324,6 +1341,44 @@ Just Null -> 0 Nothing -> 0 Just _ -> 1++-- Only native policy vocabulary is configuration. Unknown nested fields,+-- cache identities, text, replay IDs and encrypted state never enter it.+allowedString :: [Text] -> Value -> Value+allowedString values v@(String t) | t `elem` values = v+allowedString _ _ = Null++summariseNativeControl :: Value -> Value+summariseNativeControl (Object o) =+ Object+ ( KeyMap.fromList+ [(k, allowedString values v) | (k, values) <- [("mode", ["implicit", "explicit"]), ("ttl", ["30m", "12h"])], Just v <- [KeyMap.lookup k o]]+ )+summariseNativeControl _ = Null++markerSummary :: Maybe Value -> [(Key.Key, Value)]+markerSummary (Just (Array parts)) =+ let markers =+ [ object ["index" .= i, "control" .= summariseNativeControl marker]+ | (i, Object part) <- zip [0 :: Int ..] (Vector.toList parts),+ Just marker <- [KeyMap.lookup "prompt_cache_breakpoint" part]+ ]+ in [("cache_breakpoints", toJSON markers) | not (null markers)]+markerSummary _ = []++summariseInput :: Value -> Value+summariseInput (Array items) = toJSON (map item (Vector.toList items))+ where+ item (Object o) =+ object+ ( [ "role" .= maybe Null (allowedString ["system", "developer", "user", "assistant"]) (KeyMap.lookup "role" o),+ "type" .= maybe Null (allowedString ["message", "reasoning", "function_call", "function_call_output"]) (KeyMap.lookup "type" o),+ "chars" .= totalStringChars (Object o)+ ]+ <> markerSummary (KeyMap.lookup "content" o)+ )+ item v = charSummary v+summariseInput v = charSummary v -- | Total characters across every JSON string anywhere inside a value. -- Recursive on purpose: a content block's text can sit at any depth,
+ src/Baikai/Internal/Data.hs view
@@ -0,0 +1,34 @@+-- | Recover atomic data omitted by a failure terminal, without duplicating+-- blocks when event indices have gaps and terminal content is compacted.+module Baikai.Internal.Data (recoverDataBlocks) where++import Baikai.Content (AssistantContent (..), DataContent, TextContent (..))+import Data.IntMap.Strict (IntMap)+import Data.IntMap.Strict qualified as IntMap+import Data.List (mapAccumL)+import Data.Vector (Vector)+import Data.Vector qualified as V++recoverDataBlocks :: IntMap AssistantContent -> Vector AssistantContent -> Vector AssistantContent+recoverDataBlocks closed terminal+ | not (IntMap.null closed), V.all blankText terminal = V.fromList (IntMap.elems closed)+ | otherwise = foldl insert terminal missing+ where+ blankText (AssistantText (TextContent "")) = True+ blankText _ = False+ terminalData = [d | AssistantData d <- V.toList terminal]+ (_, candidates) = mapAccumL consume terminalData (zip [0 ..] (IntMap.elems closed))+ missing = [entry | Just entry <- candidates]+ consume remaining (ordinal, AssistantData d) = case removeOne d remaining of+ Just rest -> (rest, Nothing)+ Nothing -> (remaining, Just (ordinal, AssistantData d))+ consume remaining _ = (remaining, Nothing)+ insert blocks (ordinal, block) =+ let position = min ordinal (V.length blocks)+ in V.take position blocks <> V.singleton block <> V.drop position blocks++removeOne :: DataContent -> [DataContent] -> Maybe [DataContent]+removeOne _ [] = Nothing+removeOne wanted (d : ds)+ | wanted == d = Just ds+ | otherwise = (d :) <$> removeOne wanted ds
+ src/Baikai/Internal/JSON.hs view
@@ -0,0 +1,112 @@+-- | Local persistence parsers. These deliberately introduce no orphan instances.+module Baikai.Internal.JSON (parseAssistant, parseMessage, parseUsage, parseEvidence) where++import Baikai.Cost qualified as C+import Baikai.Evidence qualified as E+import Baikai.Message qualified as M+import Baikai.Usage qualified as U+import Data.Aeson+import Data.Aeson.Types (Parser)+import Data.Scientific (Scientific)+import Data.Text (Text)++parseAssistant :: Value -> Parser M.AssistantPayload+parseAssistant = withObject "AssistantPayload" $ \o ->+ M.AssistantPayload+ <$> o .: "content"+ <*> (o .: "usage" >>= parseUsage)+ <*> o .: "stopReason"+ <*> o .:? "errorMessage"+ <*> o .:? "timestamp"++parseMessage :: Value -> Parser M.Message+parseMessage = withObject "Message" $ \o -> do+ tag <- o .: "tag"+ v <- o .: "contents"+ case tag :: Text of+ "AssistantMessage" -> M.AssistantMessage <$> parseAssistant v+ "UserMessage" -> withObject "UserPayload" (\d -> M.UserMessage <$> (M.UserPayload <$> d .: "content" <*> d .:? "timestamp")) v+ "ToolResultMessage" -> withObject "ToolResultPayload" (\d -> M.ToolResultMessage <$> (M.ToolResultPayload <$> d .: "toolCallId" <*> d .: "toolName" <*> d .: "content" <*> d .: "isError" <*> d .:? "timestamp")) v+ _ -> fail "unknown message tag"++parseUsage :: Value -> Parser U.Usage+parseUsage = withObject "Usage" $ \o ->+ U.Usage+ <$> o .: "input_tokens"+ <*> o .: "output_tokens"+ <*> o .: "cache_read_tokens"+ <*> o .: "cache_write_tokens"+ <*> o .:? "reasoning_tokens"+ <*> o .: "total_tokens"+ <*> o .:? "availability"+ <*> (o .: "cost" >>= parseCost)++parseCost :: Value -> Parser C.Cost+parseCost = withObject "Cost" $ \o ->+ C.Cost+ <$> (toRational <$> (o .: "usd" :: Parser Scientific))+ <*> (o .: "breakdown" >>= parseBreakdown)+ <*> o .:? "basis" .!= mempty++parseBreakdown :: Value -> Parser C.CostBreakdown+parseBreakdown = withObject "CostBreakdown" $ \o ->+ let rat k = toRational <$> (o .: k :: Parser Scientific)+ in C.CostBreakdown <$> rat "input_usd" <*> rat "output_usd" <*> rat "cached_input_usd" <*> rat "cached_write_usd"++parseEvidence :: Value -> Parser E.ModelCallEvidence+parseEvidence = withObject "ModelCallEvidence" $ \o ->+ build+ <$> o .: "schema_version"+ <*> o .: "run_id"+ <*> o .: "call_id"+ <*> o .: "attempt"+ <*> o .:? "supersedes"+ <*> o .: "endpoint"+ <*> o .: "requested_model"+ <*> o .: "thinking"+ <*> o .: "observed_model"+ <*> o .: "observed_thinking"+ <*> o .: "response_id"+ <*> o .: "provider_request_id"+ <*> o .:? "client_request_id"+ <*> o .: "started_at"+ <*> o .: "ended_at"+ <*> o .: "latency_ms"+ <*> o .: "status"+ <*> o .:? "error_info"+ <*> (o .: "usage" >>= parseObservedUsage)+ <*> o .: "strength"+ <*> o .: "request_commitment"+ <*> o .: "request_configuration"+ <*> o .: "response_commitment"+ where+ build v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16 v17 v18 v19 v20 v21 v22 =+ (E.baseEvidence (E.evidenceRequest v1) v2 v5 v6 v7 v13 v14 v16 v20 v21)+ { E.schemaVersion = v0,+ E.runId = v1,+ E.callId = v2,+ E.attempt = v3,+ E.supersedes = v4,+ E.endpoint = v5,+ E.requestedModel = v6,+ E.thinking = v7,+ E.observedModel = v8,+ E.observedThinking = v9,+ E.responseId = v10,+ E.providerRequestId = v11,+ E.clientRequestId = v12,+ E.startedAt = v13,+ E.endedAt = v14,+ E.latencyMs = v15,+ E.status = v16,+ E.errorInfo = v17,+ E.usage = v18,+ E.strength = v19,+ E.requestCommitment = v20,+ E.requestConfiguration = v21,+ E.responseCommitment = v22+ }++parseObservedUsage :: Value -> Parser (E.Observed U.Usage)+parseObservedUsage (String "unobserved") = pure E.Unobserved+parseObservedUsage v = withObject "Observed Usage" (\o -> E.Observed <$> (o .: "observed" >>= parseUsage)) v
+ src/Baikai/Judgment.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE LambdaCase #-}++-- | Provider-neutral closed-set questions and strict answer validation.+module Baikai.Judgment+ ( JudgmentKind (..),+ Judgment (..),+ Judgments,+ judgmentList,+ lookupJudgment,+ compileJudgments,+ judgmentUserMessage,+ refuseGenerationControls,+ prepareJudgment,+ JudgmentAnswer (..),+ validateAnswers,+ judgmentMethod,+ )+where++import Baikai.CacheRetention (CacheRetention (..))+import Baikai.Content (DataContent (..))+import Baikai.Context (Context)+import Baikai.Error+import Baikai.Message (Message (..))+import Baikai.Options (Options)+import Baikai.ResponseFormat (JsonSchemaFormat, ResponseFormat (..))+import Control.Lens ((^.))+import Control.Monad (forM, unless, when)+import Data.Aeson (Object, Value (..))+import Data.Aeson qualified as A+import Data.Aeson.Key qualified as K+import Data.Aeson.KeyMap qualified as KM+import Data.Generics.Labels ()+import Data.List (sort, sortOn)+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (isJust)+import Data.Scientific qualified as Sci+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as T+import Data.Vector (Vector)+import Data.Vector qualified as V+import GHC.Generics (Generic)++data JudgmentKind+ = PredicateJudgment (Maybe (Value, Value))+ | ChoiceJudgment (Vector (Text, Maybe Value))+ | ScoreJudgment (Vector (Maybe Value))+ deriving stock (Eq, Show, Generic)++data Judgment = Judgment {name :: !Text, instructions :: !Value, kind :: !JudgmentKind}+ deriving stock (Eq, Show, Generic)++data Judgments = Judgments !(Vector Judgment) !(Map Text Judgment)+ deriving stock (Eq, Show)++judgmentList :: Judgments -> Vector Judgment+judgmentList (Judgments js _) = js++lookupJudgment :: Text -> Judgments -> Maybe Judgment+lookupJudgment n (Judgments _ ix) = Map.lookup n ix++schemaPath :: Text+schemaPath = "Options.responseFormat.schema"++refuse :: Text -> Text -> Either BaikaiError a+refuse p why = Left (unsupportedFeature p (p <> ": " <> why))++asObject :: Text -> Value -> Either BaikaiError Object+asObject _ (Object o) = Right o+asObject p _ = refuse p "expected an object"++allowed :: Text -> [Text] -> Object -> Either BaikaiError ()+allowed p keys o = case sort [K.toText k | k <- KM.keys o, K.toText k `notElem` keys] of+ [] -> Right ()+ k : _ -> refuse (p <> "." <> k) "unsupported schema keyword"++description :: Object -> Maybe Value+description o = case KM.lookup "description" o of Just Null -> Nothing; x -> x++compileJudgments :: JsonSchemaFormat -> Either BaikaiError Judgments+compileJudgments format = do+ o <- asObject schemaPath (format ^. #schema)+ allowed schemaPath ["type", "properties", "required", "additionalProperties", "title", "description"] o+ unless (KM.lookup "type" o == Just (String "object")) (refuse (schemaPath <> ".type") "expected object type")+ props <- maybe (refuse (schemaPath <> ".properties") "properties required") (asObject (schemaPath <> ".properties")) (KM.lookup "properties" o)+ when (KM.null props) (refuse (schemaPath <> ".properties") "questions must not be empty")+ case KM.lookup "additionalProperties" o of+ Nothing -> pure ()+ Just (Bool False) -> pure ()+ _ -> refuse (schemaPath <> ".additionalProperties") "only false is supported"+ let names = sort (map K.toText (KM.keys props))+ required <- case KM.lookup "required" o of+ Nothing -> pure []+ Just (Array xs) -> forM (V.toList xs) $ \case+ String t | t `elem` names -> pure t+ _ -> refuse (schemaPath <> ".required") "required must name declared properties"+ _ -> refuse (schemaPath <> ".required") "expected an array"+ let order = if sort required == names then required else names+ js <- forM order $ \n -> do+ let p = schemaPath <> ".properties." <> n+ prop <- maybe (refuse p "property missing") (asObject p) (KM.lookup (K.fromText n) props)+ k <- compileKind p prop+ pure (Judgment n (maybe (String n) id (description prop)) k)+ pure (Judgments (V.fromList js) (Map.fromList [(name j, j) | j <- js]))++compileKind :: Text -> Object -> Either BaikaiError JudgmentKind+compileKind p o = do+ allowed p ["type", "enum", "anyOf", "oneOf", "title", "description"] o+ let alternatives = [v | key <- ["enum", "anyOf", "oneOf"], Just v <- [KM.lookup key o]]+ case alternatives of+ [] | KM.lookup "type" o == Just (String "boolean") -> pure (PredicateJudgment Nothing)+ [v] -> do+ let enum = KM.member "enum" o+ xs <- case v of Array a | not (V.null a) -> pure (V.toList a); _ -> refuse p "expected nonempty alternatives"+ entries <-+ if enum+ then pure [(x, Nothing) | x <- xs]+ else forM xs $ \branch -> do+ b <- asObject p branch+ allowed p ["const", "description", "title"] b+ val <- maybe (refuse p "const required on every branch") pure (KM.lookup "const" b)+ pure (val, description b)+ let values = map fst entries+ ty = KM.lookup "type" o+ typeAllowed allowedTypes = unless (maybe True (`elem` map String allowedTypes) ty) (refuse p "conflicting property type")+ when (length values /= Set.size (Set.fromList values)) (refuse p "duplicate alternatives")+ case values of+ Bool _ : _ -> do+ typeAllowed ["boolean"]+ unless (sort values == [Bool False, Bool True]) (refuse p "predicate must declare true and false")+ let get b = maybe Null id (lookup (Bool b) entries >>= id)+ criteria = if any (isJust . snd) entries then Just (get True, get False) else Nothing+ pure (PredicateJudgment criteria)+ String _ : _ -> do+ typeAllowed ["string"]+ labels <- forM entries $ \case (String t, d) -> pure (t, d); _ -> refuse p "mixed alternatives"+ when (length labels > 255) (refuse p "at most 255 labels")+ pure (ChoiceJudgment (V.fromList labels))+ Number _ : _ -> do+ typeAllowed ["integer"]+ levels <- forM entries $ \case+ (Number n, d) | Just i <- (Sci.toBoundedInteger n :: Maybe Int) -> pure (i, d)+ _ -> refuse p "levels must be integral numbers"+ let ordered = sortOn fst levels; count = length ordered+ unless (count >= 2 && count <= 10 && map fst ordered == [0 .. count - 1]) (refuse p "score levels must be 0 to N-1 with 2 to 10 levels")+ pure (ScoreJudgment (V.fromList (map snd ordered)))+ _ -> refuse p "unsupported alternatives"+ _ -> refuse p "unsupported or conflicting validation keywords"++judgmentUserMessage :: Context -> Either BaikaiError Message+judgmentUserMessage ctx = do+ when (isJust (ctx ^. #systemPrompt)) (refuse "Context.systemPrompt" "judgments do not accept a system prompt")+ unless (V.length (ctx ^. #messages) == 1) (refuse "Context.messages" "exactly one user message required")+ msg <- case V.head (ctx ^. #messages) of+ m@UserMessage {} -> Right m+ _ -> refuse "Context.messages[0]" "expected a user message"+ unless (V.null (ctx ^. #tools)) (refuse "Context.tools" "judgments do not accept tools")+ pure msg++refuseGenerationControls :: Options -> Either BaikaiError ()+refuseGenerationControls o =+ mapM_+ check+ [ ("maxTokens", isJust (o ^. #maxTokens)),+ ("temperature", isJust (o ^. #temperature)),+ ("topP", isJust (o ^. #topP)),+ ("stopSequences", not (null (o ^. #stopSequences))),+ ("seed", isJust (o ^. #seed)),+ ("frequencyPenalty", isJust (o ^. #frequencyPenalty)),+ ("presencePenalty", isJust (o ^. #presencePenalty)),+ ("thinking", isJust (o ^. #thinking)),+ ("toolChoice", isJust (o ^. #toolChoice)),+ ("cacheRetention", maybe False (/= CacheRetentionNone) (o ^. #cacheRetention)),+ ("speed", isJust (o ^. #speed))+ ]+ where+ check (n, True) = refuse ("Options." <> n) "generation control is unsupported for judgments"+ check (_, False) = pure ()++prepareJudgment :: Context -> Options -> Either BaikaiError (Message, Judgments)+prepareJudgment ctx opts = do+ msg <- judgmentUserMessage ctx+ refuseGenerationControls opts+ fmt <- case opts ^. #responseFormat of+ Just (JsonSchema f) -> pure f+ _ -> refuse "Options.responseFormat" "closed-set JsonSchema required"+ js <- compileJudgments fmt+ pure (msg, js)++data JudgmentAnswer+ = PredicateAnswer Double+ | ChoiceAnswer {selected :: Text, probabilities :: Map Text Double, confidence :: Maybe Double}+ | ScoreAnswer {expected :: Maybe Double, probabilities :: Map Text Double, confidence :: Maybe Double}+ | RefusedAnswer (Maybe Text)+ deriving stock (Eq, Show, Generic)++judgmentMethod :: Text+judgmentMethod = "provider_classification"++validateAnswers :: Judgments -> Map Text JudgmentAnswer -> Either BaikaiError DataContent+validateAnswers js answers = do+ let names = Set.fromList [name j | j <- V.toList (judgmentList js)]+ actual = Map.keysSet answers+ unless (actual == names) (Left (decodeError ("answer names differ: " <> T.intercalate "," (Set.toAscList ((names Set.\\ actual) <> (actual Set.\\ names))))))+ rows <- forM (V.toList (judgmentList js)) $ \j -> do+ a <- maybe (Left (decodeError (name j <> ": missing answer"))) Right (Map.lookup (name j) answers)+ let bad :: Text -> Either BaikaiError a+ bad why = Left (decodeError (name j <> ": " <> why))+ unit x = unless (not (isNaN x || isInfinite x) && x >= 0 && x <= 1) (bad "expected finite probability/confidence in [0,1]")+ distribution keys ps c = do+ unless (Map.keysSet ps == Set.fromList keys) (bad "distribution keys differ")+ mapM_ unit ps+ mapM_ unit c+ (v, ps, c) <- case (kind j, a) of+ (_, RefusedAnswer category) -> Left ((contentFiltered (name j <> ": provider refused answer")) {refusalCategory = category})+ (PredicateJudgment _, PredicateAnswer p) -> do+ unit p+ pure (Bool (p >= 0.5), Map.fromList [("true", p), ("false", 1 - p)], Nothing)+ (ChoiceJudgment choices, ChoiceAnswer chosen ps c) -> do+ let labels = map fst (V.toList choices)+ distribution labels ps c+ unless (chosen `elem` labels) (bad "selected undeclared label")+ pure (String chosen, ps, c)+ (ScoreJudgment levels, ScoreAnswer expScore ps c) -> do+ let indices = [0 .. V.length levels - 1]; keys = map (T.pack . show) indices+ distribution keys ps c+ mapM_ (\x -> unless (not (isNaN x || isInfinite x) && x >= 0 && x <= fromIntegral (V.length levels - 1)) (bad "expected score outside declared range")) expScore+ let best = foldl (\best i -> if Map.findWithDefault 0 (T.pack (show i)) ps > Map.findWithDefault 0 (T.pack (show best)) ps then i else best) 0 indices+ score = maybe (A.toJSON best) A.toJSON expScore+ pure (score, ps, c)+ _ -> bad "answer kind differs from question"+ pure (name j, v, ps, c)+ pure+ ( DataContent+ (Object (KM.fromList [(K.fromText n, v) | (n, v, _, _) <- rows]))+ (Just (Map.fromList [(n, ps) | (n, _, ps, _) <- rows]))+ (let cs = Map.fromList [(n, c) | (n, _, _, Just c) <- rows] in if Map.null cs then Nothing else Just cs)+ (Just judgmentMethod)+ )
src/Baikai/Message.hs view
@@ -38,6 +38,9 @@ ToolResultPayload (..), ToolResult (..), user,+ userData,+ userDataAt,+ userDataNow, userAt, userNow, userImage,@@ -72,7 +75,7 @@ ) import Baikai.StopReason (StopReason (..)) import Baikai.Usage (Usage, zeroUsage)-import Data.Aeson (ToJSON)+import Data.Aeson (ToJSON, Value) import Data.Text (Text) import Data.Time (UTCTime, getCurrentTime) import Data.Vector (Vector)@@ -194,6 +197,18 @@ userImageNow img mPrefix = do now <- getCurrentTime pure (userImageAt now img mPrefix)++-- | Build one structured user block, without a timestamp.+userData :: Value -> Message+userData v = UserMessage (UserPayload (V.singleton (UserData v)) Nothing)++-- | Build one structured user block at an explicit timestamp.+userDataAt :: UTCTime -> Value -> Message+userDataAt ts v = UserMessage (UserPayload (V.singleton (UserData v)) (Just ts))++-- | Build one structured user block using the current time.+userDataNow :: Value -> IO Message+userDataNow v = (\ts -> userDataAt ts v) <$> getCurrentTime -- | Build a one-text-block assistant message with zero usage, a @stop@ -- stop reason, and no recorded timestamp.
src/Baikai/Model.hs view
@@ -39,6 +39,9 @@ -- * Capabilities InputModality (..),+ OutputKind (..),+ outputKind,+ isJudgmentOnly, -- * Compatibility shim Compat (..),@@ -71,6 +74,8 @@ (.:), (.:?), )+import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KM import Data.List (nub, sort) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map@@ -83,9 +88,27 @@ data InputModality = InputText | InputImage+ | InputData deriving stock (Eq, Ord, Show, Generic) deriving anyclass (FromJSON, ToJSON) +-- | Catalog-owned output semantics. Legacy model JSON is generative.+data OutputKind = GenerativeOutput | JudgmentOutput+ deriving stock (Eq, Show, Generic)++instance ToJSON OutputKind where+ toJSON GenerativeOutput = Aeson.String "generative"+ toJSON JudgmentOutput = Aeson.String "judgment"++instance FromJSON OutputKind where+ parseJSON = Aeson.withText "OutputKind" $ \t -> case t of+ "generative" -> pure GenerativeOutput+ "judgment" -> pure JudgmentOutput+ _ -> fail "unknown output kind"++isJudgmentOnly :: Model -> Bool+isJudgmentOnly m = outputKind m == JudgmentOutput+ -- | Per-million-token prices in USD as exact 'Rational' values. data ModelCost = ModelCost { inputCost :: !Rational,@@ -196,6 +219,7 @@ baseUrl :: !Text, reasoning :: !Bool, input :: ![InputModality],+ outputKind :: !OutputKind, cost :: !ModelCost, -- | Optional premium speed rates, in USD per million tokens. fastModeCost :: !(Maybe ModelCost),@@ -215,8 +239,11 @@ compat :: !Compat } deriving stock (Eq, Generic)- deriving anyclass (FromJSON) +instance FromJSON Model where+ parseJSON = Aeson.withObject "Model" $ \o ->+ Aeson.genericParseJSON Aeson.defaultOptions (Aeson.Object (if KM.member "outputKind" o then o else KM.insert "outputKind" (Aeson.String "generative") o))+ -- | Rendered field by field rather than derived, so that the value of a -- credential-carrying header prints as 'Auth.redactedMarker'. A 'Model' -- is the record most likely to reach a log: it is embedded in every@@ -247,6 +274,7 @@ . next "baseUrl" (baseUrl m) . next "reasoning" (reasoning m) . next "input" (input m)+ . next "outputKind" (outputKind m) . next "cost" (cost m) . next "fastModeCost" (fastModeCost m) . next "pricingPolicy" (pricingPolicy m)@@ -298,6 +326,7 @@ baseUrl = "", reasoning = False, input = [InputText],+ outputKind = GenerativeOutput, cost = zeroModelCost, fastModeCost = Nothing, pricingPolicy = Nothing,
src/Baikai/Models/Generated.hs view
@@ -15,13 +15,16 @@ supportsForcedToolChoice, supportsLongCacheRetention, supportsSamplingParameters,+ supportsThinkingDisabled, thinkingStyle ), AnthropicThinkingStyle (..), CacheControlFormat (..),+ NativeCachePolicy (..), MaxTokensField (..), OpenAICompletionsCompat- ( cacheControlFormat,+ ( nativeCachePolicy,+ cacheControlFormat, maxTokensField, requiresThinkingAsText, supportedReasoningEfforts,@@ -44,6 +47,7 @@ InputPriceTier (..), Model, ModelCost (..),+ OutputKind (..), PricingPolicy (..), api, baseUrl,@@ -57,6 +61,7 @@ maxOutputTokens, modelId, name,+ outputKind, pricingPolicy, provider, reasoning,@@ -75,6 +80,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 10 % 1,@@ -96,7 +102,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False, supportsFastMode = False,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = False } } @@ -110,6 +117,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 10 % 1,@@ -131,7 +139,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False, supportsFastMode = False,- supportsForcedToolChoice = False+ supportsForcedToolChoice = False,+ supportsThinkingDisabled = False } } @@ -145,6 +154,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 1 % 1,@@ -166,7 +176,8 @@ thinkingStyle = AnthropicThinkingBudget, supportsSamplingParameters = True, supportsFastMode = False,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = True } } @@ -180,6 +191,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 1 % 10,@@ -201,7 +213,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False, supportsFastMode = False,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = True } } @@ -215,6 +228,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 5 % 1,@@ -236,7 +250,8 @@ thinkingStyle = AnthropicThinkingBudget, supportsSamplingParameters = True, supportsFastMode = False,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = True } } @@ -250,6 +265,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 5 % 1,@@ -271,7 +287,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = True, supportsFastMode = False,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = True } } @@ -285,6 +302,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 5 % 1,@@ -306,7 +324,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False, supportsFastMode = False,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = True } } @@ -320,6 +339,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 5 % 1,@@ -349,7 +369,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False, supportsFastMode = True,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = True } } @@ -363,6 +384,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 5 % 1,@@ -392,7 +414,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False, supportsFastMode = True,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = True } } @@ -406,6 +429,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 4 % 1,@@ -435,7 +459,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False, supportsFastMode = True,- supportsForcedToolChoice = False+ supportsForcedToolChoice = False,+ supportsThinkingDisabled = False } } @@ -449,6 +474,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 3 % 1,@@ -470,7 +496,8 @@ thinkingStyle = AnthropicThinkingBudget, supportsSamplingParameters = True, supportsFastMode = False,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = True } } @@ -484,6 +511,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 3 % 1,@@ -505,7 +533,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = True, supportsFastMode = False,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = True } } @@ -519,6 +548,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 2 % 1,@@ -540,7 +570,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False, supportsFastMode = False,- supportsForcedToolChoice = True+ supportsForcedToolChoice = True,+ supportsThinkingDisabled = True } } @@ -554,6 +585,7 @@ baseUrl = "https://api.anthropic.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 2 % 1,@@ -575,7 +607,8 @@ thinkingStyle = AnthropicThinkingAdaptive, supportsSamplingParameters = False, supportsFastMode = False,- supportsForcedToolChoice = False+ supportsForcedToolChoice = False,+ supportsThinkingDisabled = False } } @@ -589,6 +622,7 @@ baseUrl = "https://api.deepseek.com", reasoning = False, input = [InputText],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 27 % 100,@@ -614,6 +648,7 @@ baseUrl = "https://api.deepseek.com", reasoning = True, input = [InputText],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 11 % 20,@@ -639,6 +674,7 @@ baseUrl = "https://api.openai.com", reasoning = False, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 2 % 1,@@ -651,7 +687,21 @@ contextWindow = 1047576, maxOutputTokens = 32768, headers = Map.empty,- compat = CompatNone+ compat =+ CompatOpenAICompletions+ defaultOpenAICompletionsCompat+ { maxTokensField = MaxCompletionTokensField,+ supportsStrictMode = True,+ requiresThinkingAsText = False,+ thinkingFormat = ThinkingFormatOpenAI,+ cacheControlFormat = Nothing,+ supportsToolCalls = True,+ supportsSamplingParameters = True,+ supportedReasoningEfforts = Nothing,+ supportsUsageInStreaming = True,+ supportsLongCacheRetention = True,+ nativeCachePolicy = Just (NativeCacheLegacy True True)+ } } openai_gpt_4_1_mini :: Model@@ -664,6 +714,7 @@ baseUrl = "https://api.openai.com", reasoning = False, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 2 % 5,@@ -689,6 +740,7 @@ baseUrl = "https://api.openai.com", reasoning = False, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 1 % 10,@@ -714,6 +766,7 @@ baseUrl = "https://api.openai.com", reasoning = False, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 5 % 2,@@ -739,6 +792,7 @@ baseUrl = "https://api.openai.com", reasoning = False, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 3 % 20,@@ -764,6 +818,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 5 % 4,@@ -776,7 +831,21 @@ contextWindow = 400000, maxOutputTokens = 128000, headers = Map.empty,- compat = CompatNone+ compat =+ CompatOpenAICompletions+ defaultOpenAICompletionsCompat+ { maxTokensField = MaxCompletionTokensField,+ supportsStrictMode = True,+ requiresThinkingAsText = False,+ thinkingFormat = ThinkingFormatOpenAI,+ cacheControlFormat = Nothing,+ supportsToolCalls = True,+ supportsSamplingParameters = True,+ supportedReasoningEfforts = Just [ThinkingMinimal, ThinkingLow, ThinkingMedium, ThinkingHigh],+ supportsUsageInStreaming = True,+ supportsLongCacheRetention = True,+ nativeCachePolicy = Nothing+ } } openai_gpt_5_1 :: Model@@ -789,6 +858,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 5 % 4,@@ -814,6 +884,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 7 % 4,@@ -839,6 +910,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 5 % 2,@@ -864,6 +936,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 3 % 4,@@ -889,6 +962,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 1 % 5,@@ -914,6 +988,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 5 % 1,@@ -926,7 +1001,21 @@ contextWindow = 1050000, maxOutputTokens = 128000, headers = Map.empty,- compat = CompatNone+ compat =+ CompatOpenAICompletions+ defaultOpenAICompletionsCompat+ { maxTokensField = MaxCompletionTokensField,+ supportsStrictMode = True,+ requiresThinkingAsText = False,+ thinkingFormat = ThinkingFormatOpenAI,+ cacheControlFormat = Nothing,+ supportsToolCalls = True,+ supportsSamplingParameters = True,+ supportedReasoningEfforts = Nothing,+ supportsUsageInStreaming = True,+ supportsLongCacheRetention = True,+ nativeCachePolicy = Just (NativeCacheLegacy False True)+ } } openai_gpt_5_6 :: Model@@ -939,6 +1028,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 4 % 1,@@ -951,7 +1041,21 @@ contextWindow = 1050000, maxOutputTokens = 128000, headers = Map.empty,- compat = CompatNone+ compat =+ CompatOpenAICompletions+ defaultOpenAICompletionsCompat+ { maxTokensField = MaxCompletionTokensField,+ supportsStrictMode = True,+ requiresThinkingAsText = False,+ thinkingFormat = ThinkingFormatOpenAI,+ cacheControlFormat = Nothing,+ supportsToolCalls = True,+ supportsSamplingParameters = True,+ supportedReasoningEfforts = Nothing,+ supportsUsageInStreaming = True,+ supportsLongCacheRetention = True,+ nativeCachePolicy = Just (NativeCacheModern False True)+ } } openai_gpt_5_6_luna :: Model@@ -964,6 +1068,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 1 % 5,@@ -989,6 +1094,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 4 % 1,@@ -1014,6 +1120,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 2 % 1,@@ -1039,6 +1146,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 1 % 4,@@ -1051,7 +1159,21 @@ contextWindow = 400000, maxOutputTokens = 128000, headers = Map.empty,- compat = CompatNone+ compat =+ CompatOpenAICompletions+ defaultOpenAICompletionsCompat+ { maxTokensField = MaxCompletionTokensField,+ supportsStrictMode = True,+ requiresThinkingAsText = False,+ thinkingFormat = ThinkingFormatOpenAI,+ cacheControlFormat = Nothing,+ supportsToolCalls = True,+ supportsSamplingParameters = True,+ supportedReasoningEfforts = Just [ThinkingMinimal, ThinkingLow, ThinkingMedium, ThinkingHigh],+ supportsUsageInStreaming = True,+ supportsLongCacheRetention = True,+ nativeCachePolicy = Nothing+ } } openai_gpt_5_nano :: Model@@ -1064,6 +1186,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 1 % 20,@@ -1076,7 +1199,21 @@ contextWindow = 400000, maxOutputTokens = 128000, headers = Map.empty,- compat = CompatNone+ compat =+ CompatOpenAICompletions+ defaultOpenAICompletionsCompat+ { maxTokensField = MaxCompletionTokensField,+ supportsStrictMode = True,+ requiresThinkingAsText = False,+ thinkingFormat = ThinkingFormatOpenAI,+ cacheControlFormat = Nothing,+ supportsToolCalls = True,+ supportsSamplingParameters = True,+ supportedReasoningEfforts = Just [ThinkingMinimal, ThinkingLow, ThinkingMedium, ThinkingHigh],+ supportsUsageInStreaming = True,+ supportsLongCacheRetention = True,+ nativeCachePolicy = Nothing+ } } openai_gpt_6_1_sol :: Model@@ -1089,6 +1226,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 2 % 1,@@ -1107,7 +1245,8 @@ { supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax], supportsSamplingParameters = False, supportsLongCacheRetention = False,- supportsPromptCacheOptions = True+ supportsPromptCacheOptions = True,+ nativeCachePolicy = Just (NativeCacheModern False True) } } @@ -1121,6 +1260,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 10 % 1,@@ -1139,7 +1279,8 @@ { supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax], supportsSamplingParameters = False, supportsLongCacheRetention = False,- supportsPromptCacheOptions = True+ supportsPromptCacheOptions = True,+ nativeCachePolicy = Just (NativeCacheModern False True) } } @@ -1153,6 +1294,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 1 % 10,@@ -1161,17 +1303,18 @@ cacheWriteCost = 1 % 8 }, fastModeCost = Nothing,- pricingPolicy = Just (PricingPolicy [InputPriceTier 272000 (ModelCost (1 % 5) (3 % 4) (1 % 50) (1 % 4)) Nothing] Nothing),+ pricingPolicy = Just (PricingPolicy [InputPriceTier 272000 (ModelCost (1 % 5) (3 % 4) (1 % 50) (1 % 4)) (Just (1 % 2))] (Just (1 % 4))), contextWindow = 1050000, maxOutputTokens = 128000, headers = Map.empty, compat = CompatOpenAIResponses defaultOpenAIResponsesCompat- { supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax],+ { supportedReasoningEfforts = Just [ThinkingNone, ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax], supportsSamplingParameters = False,- supportsLongCacheRetention = False,- supportsPromptCacheOptions = True+ supportsLongCacheRetention = True,+ supportsPromptCacheOptions = True,+ nativeCachePolicy = Just (NativeCacheModern True True) } } @@ -1185,6 +1328,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 2 % 1,@@ -1200,10 +1344,11 @@ compat = CompatOpenAIResponses defaultOpenAIResponsesCompat- { supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax],+ { supportedReasoningEfforts = Just [ThinkingNone, ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax], supportsSamplingParameters = False, supportsLongCacheRetention = False,- supportsPromptCacheOptions = True+ supportsPromptCacheOptions = True,+ nativeCachePolicy = Just (NativeCacheModern False True) } } @@ -1217,6 +1362,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 15 % 1,@@ -1229,7 +1375,21 @@ contextWindow = 200000, maxOutputTokens = 100000, headers = Map.empty,- compat = CompatNone+ compat =+ CompatOpenAICompletions+ defaultOpenAICompletionsCompat+ { maxTokensField = MaxCompletionTokensField,+ supportsStrictMode = True,+ requiresThinkingAsText = False,+ thinkingFormat = ThinkingFormatOpenAI,+ cacheControlFormat = Nothing,+ supportsToolCalls = True,+ supportsSamplingParameters = True,+ supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh],+ supportsUsageInStreaming = True,+ supportsLongCacheRetention = True,+ nativeCachePolicy = Nothing+ } } openai_o3 :: Model@@ -1242,6 +1402,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 2 % 1,@@ -1254,7 +1415,21 @@ contextWindow = 200000, maxOutputTokens = 100000, headers = Map.empty,- compat = CompatNone+ compat =+ CompatOpenAICompletions+ defaultOpenAICompletionsCompat+ { maxTokensField = MaxCompletionTokensField,+ supportsStrictMode = True,+ requiresThinkingAsText = False,+ thinkingFormat = ThinkingFormatOpenAI,+ cacheControlFormat = Nothing,+ supportsToolCalls = True,+ supportsSamplingParameters = True,+ supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh],+ supportsUsageInStreaming = True,+ supportsLongCacheRetention = True,+ nativeCachePolicy = Nothing+ } } openai_o3_mini :: Model@@ -1267,6 +1442,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 11 % 10,@@ -1279,7 +1455,21 @@ contextWindow = 200000, maxOutputTokens = 100000, headers = Map.empty,- compat = CompatNone+ compat =+ CompatOpenAICompletions+ defaultOpenAICompletionsCompat+ { maxTokensField = MaxCompletionTokensField,+ supportsStrictMode = True,+ requiresThinkingAsText = False,+ thinkingFormat = ThinkingFormatOpenAI,+ cacheControlFormat = Nothing,+ supportsToolCalls = True,+ supportsSamplingParameters = True,+ supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh],+ supportsUsageInStreaming = True,+ supportsLongCacheRetention = True,+ nativeCachePolicy = Nothing+ } } openai_o4_mini :: Model@@ -1292,6 +1482,7 @@ baseUrl = "https://api.openai.com", reasoning = True, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 11 % 10,@@ -1304,7 +1495,21 @@ contextWindow = 200000, maxOutputTokens = 100000, headers = Map.empty,- compat = CompatNone+ compat =+ CompatOpenAICompletions+ defaultOpenAICompletionsCompat+ { maxTokensField = MaxCompletionTokensField,+ supportsStrictMode = True,+ requiresThinkingAsText = False,+ thinkingFormat = ThinkingFormatOpenAI,+ cacheControlFormat = Nothing,+ supportsToolCalls = True,+ supportsSamplingParameters = True,+ supportedReasoningEfforts = Just [ThinkingLow, ThinkingMedium, ThinkingHigh],+ supportsUsageInStreaming = True,+ supportsLongCacheRetention = True,+ nativeCachePolicy = Nothing+ } } openrouter_anthropic_claude_sonnet_4 :: Model@@ -1317,6 +1522,7 @@ baseUrl = "https://openrouter.ai/api", reasoning = False, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 3 % 1,@@ -1342,6 +1548,7 @@ baseUrl = "https://openrouter.ai/api", reasoning = False, input = [InputText, InputImage],+ outputKind = GenerativeOutput, cost = ModelCost { inputCost = 3 % 20,@@ -1357,6 +1564,58 @@ compat = CompatNone } +typesafe_jev_latest :: Model+typesafe_jev_latest =+ emptyModel+ { modelId = "jev-latest",+ name = "jev-latest",+ api = TypeSafeSystemOne,+ provider = "typesafe",+ baseUrl = "https://api.typesafe.ai",+ reasoning = False,+ input = [InputText, InputData],+ outputKind = JudgmentOutput,+ cost =+ ModelCost+ { inputCost = 0 % 1,+ outputCost = 0 % 1,+ cacheReadCost = 0 % 1,+ cacheWriteCost = 0 % 1+ },+ fastModeCost = Nothing,+ pricingPolicy = Nothing,+ contextWindow = 0,+ maxOutputTokens = 0,+ headers = Map.empty,+ compat = CompatNone+ }++typesafe_jev_preview :: Model+typesafe_jev_preview =+ emptyModel+ { modelId = "jev-preview",+ name = "jev-preview",+ api = TypeSafeSystemOne,+ provider = "typesafe",+ baseUrl = "https://api.typesafe.ai",+ reasoning = False,+ input = [InputText, InputData],+ outputKind = JudgmentOutput,+ cost =+ ModelCost+ { inputCost = 0 % 1,+ outputCost = 0 % 1,+ cacheReadCost = 0 % 1,+ cacheWriteCost = 0 % 1+ },+ fastModeCost = Nothing,+ pricingPolicy = Nothing,+ contextWindow = 0,+ maxOutputTokens = 0,+ headers = Map.empty,+ compat = CompatNone+ }+ -- | Every model in the generated catalog, in declaration order. allModels :: [Model] allModels =@@ -1403,5 +1662,7 @@ openai_o3_mini, openai_o4_mini, openrouter_anthropic_claude_sonnet_4,- openrouter_openai_gpt_4o_mini+ openrouter_openai_gpt_4o_mini,+ typesafe_jev_latest,+ typesafe_jev_preview ]
src/Baikai/Options.hs view
@@ -105,11 +105,21 @@ -- | 'Nothing' and @Just 'CacheRetentionNone'@ are the same request: -- both send no cache-control marker. The constructor is kept for a -- caller who wants to say "no caching" explicitly.+ --+ -- On Anthropic Messages hosts a retention sets up to three cache+ -- breakpoints: the top-level automatic marker (the end of the+ -- request), the last tool definition, and the system prompt, which+ -- is then sent as one text block carrying @cache_control@. The+ -- system-prompt breakpoint lets requests that share a static system+ -- prefix but differ in their messages read it from the cache. cacheRetention :: !(Maybe CacheRetention), -- | Nothing omits the speed field; standard explicitly requests standard -- speed. Fast is catalog-gated by Anthropic and dropped with evidence on -- unsupported models. See "Baikai.Speed" for availability and pricing. speed :: !(Maybe Speed),+ -- | Nothing leaves the provider default; Just ThinkingNone requests off.+ -- Unsupported requests are recorded as adjustments; strict evidence refuses+ -- a fallback before dispatch. Translation is not proof of server execution. thinking :: !(Maybe ThinkingLevel), responseFormat :: !(Maybe ResponseFormat), evidence :: !(Maybe EvidenceRequest),
src/Baikai/Provider/Cli/Internal.hs view
@@ -42,6 +42,7 @@ ToolResultContent (..), UserContent (..), )+import Baikai.Content qualified as Content import Baikai.Context (Context) import Baikai.Cost (Cost (..), providerReportedBasis, zeroCost, zeroCostBreakdown) import Baikai.Error (BaikaiError (..), ErrorCategory (..), decodeError, processError)@@ -129,6 +130,7 @@ flattenUser = Text.concat . Vector.toList . Vector.mapMaybe pickU where pickU (UserText (TextContent t)) = Just t+ pickU (UserData v) = Just (Content.canonicalDataText v) pickU _ = Nothing flattenAssistant :: Vector AssistantContent -> Text
src/Baikai/Response.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ -- | The provider response envelope. -- -- A 'Response' wraps the model's assistant payload ('message') with@@ -16,13 +18,14 @@ responseMessage, flattenAssistantBlocks, flattenAssistantText,+ flattenAssistantData, responseError, errorResponse, ) where import Baikai.Api (Api (..))-import Baikai.Content (AssistantContent (..), TextContent (..))+import Baikai.Content (AssistantContent (..), DataContent, TextContent (..)) import Baikai.Error (BaikaiError, providerError) import Baikai.Error qualified as Error import Baikai.Evidence (ModelCallEvidence)@@ -139,3 +142,7 @@ errorInfo = Just err, evidence = Nothing }++-- | Structured output blocks in content order, independent of call evidence.+flattenAssistantData :: Vector AssistantContent -> Vector DataContent+flattenAssistantData = V.mapMaybe (\case AssistantData d -> Just d; _ -> Nothing)
+ src/Baikai/Response/JSON.hs view
@@ -0,0 +1,34 @@+-- | Named full-response persistence, without global response/usage instances.+-- Decimal costs use the existing encoder's precision; arbitrary rationals+-- are not promised to round-trip exactly. Optional evidence is preserved.+module Baikai.Response.JSON (responseToJSON, responseFromJSON) where++import Baikai.Internal.JSON (parseAssistant, parseEvidence)+import Baikai.Response (Response (..))+import Data.Aeson+import Data.Aeson.Types (Parser)++responseToJSON :: Response -> Value+responseToJSON r =+ object $+ [ "message" .= message r,+ "model" .= model r,+ "api" .= api r,+ "provider" .= provider r,+ "responseId" .= responseId r,+ "latencyMs" .= latencyMs r,+ "errorInfo" .= errorInfo r+ ]+ <> maybe [] (\e -> ["evidence" .= e]) (evidence r)++responseFromJSON :: Value -> Parser Response+responseFromJSON = withObject "Response" $ \o ->+ Response+ <$> (o .: "message" >>= parseAssistant)+ <*> o .: "model"+ <*> o .: "api"+ <*> o .: "provider"+ <*> o .:? "responseId"+ <*> o .: "latencyMs"+ <*> o .:? "errorInfo"+ <*> (o .:? "evidence" >>= traverse parseEvidence)
src/Baikai/ResponseFormat.hs view
@@ -36,7 +36,8 @@ -- | A named JSON Schema to enforce. -- -- The 'schema' is a raw JSON Schema document (an aeson 'Value'), passed--- through verbatim; baikai never inspects or validates it. 'strict'+-- through verbatim by generative providers. Judgment providers accept only the+-- closed-set subset compiled by 'Baikai.Judgment.compileJudgments'. 'strict' -- requests the provider's strict schema-enforcement mode where available -- (OpenAI honours it; Anthropic structured outputs are always -- schema-enforcing and ignore it).@@ -136,4 +137,5 @@ OpenAIResponses -> NativeJsonSchema AnthropicMessagesCli -> NativeJsonSchema OpenAICompletionsCli -> NativeJsonSchema+ TypeSafeSystemOne -> NativeJsonSchema Custom _ -> NoStructuredOutput
src/Baikai/Stream.hs view
@@ -39,6 +39,7 @@ import Baikai.Evidence (ModelCallEvidence) import Baikai.Evidence qualified as Evidence import Baikai.Evidence.Build qualified as Build+import Baikai.Internal.Data (recoverDataBlocks) import Baikai.Message (AssistantPayload (..), Message (AssistantMessage)) import Baikai.Message qualified as Msg import Baikai.Model (Model)@@ -56,6 +57,7 @@ import Baikai.Stream.Event ( AssistantMessageEvent (..), BlockEndPayload (..),+ DataEndPayload (..), DeltaPayload (..), IndexPayload (..), StartPayload (..),@@ -273,6 +275,9 @@ i (AssistantThinking tc) & #thinkBuf %~ IntMap.delete i+ DataStart _ -> s+ DataEnd DataEndPayload {contentIndex = i, content = d} ->+ s & #blocks %~ IntMap.insert i (AssistantData d) ToolCallStart IndexPayload {contentIndex = i} -> s & #toolArgsBuf %~ IntMap.insert i Text.empty ToolCallDelta DeltaPayload {contentIndex = i, delta = d} ->@@ -325,7 +330,7 @@ finalContent | not sawTerminal = assembled | Vector.null terminalContent = assembled- | terminalFailed = terminalContent <> Vector.fromList (IntMap.elems dangling)+ | terminalFailed = recoverDataBlocks (s ^. #blocks) terminalContent <> Vector.fromList (IntMap.elems dangling) | otherwise = terminalContent message' = overrideBlocksAndReason terminalReason terminalMsg finalContent now latency = case (s ^. #skeleton >>= messageTimestamp, assistantPayloadTimestamp message') of@@ -545,6 +550,7 @@ ThinkingDelta DeltaPayload {contentIndex = i, delta = t}, ThinkingEnd ThinkingEndPayload {contentIndex = i, content = th} ]+ AssistantData d -> [DataStart (IndexPayload i), DataEnd (DataEndPayload i d)] AssistantToolCall tc -> let argsText = Text.decodeUtf8 (BSL.toStrict (Aeson.encode (Content.arguments tc)))
src/Baikai/Stream/Event.hs view
@@ -33,6 +33,7 @@ ( AssistantMessageEvent (..), StartPayload (..), IndexPayload (..),+ DataEndPayload (..), DeltaPayload (..), BlockEndPayload (..), ThinkingEndPayload (..),@@ -44,12 +45,14 @@ ) where -import Baikai.Content (ThinkingContent, ToolCall)+import Baikai.Content (DataContent, ThinkingContent, ToolCall) import Baikai.Error (BaikaiError) import Baikai.Evidence (ModelCallEvidence)+import Baikai.Internal.JSON (parseEvidence, parseMessage) import Baikai.Message (Message) import Baikai.StopReason (StopReason)-import Data.Aeson (ToJSON)+import Data.Aeson+import Data.Aeson.Types (Parser) import Data.Text (Text) import GHC.Generics (Generic) @@ -92,6 +95,8 @@ -- carries the full 'ThinkingContent', including provider -- signature and redacted flag when available. ThinkingEnd ThinkingEndPayload+ | DataStart IndexPayload+ | DataEnd DataEndPayload | -- | A tool-call content block is about to receive argument-JSON -- chunks. The tool's @id_@ and @name@ become known on this event -- when the upstream API delivers them up front (Anthropic), or on@@ -172,6 +177,14 @@ deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON) +-- | Atomic structured block; there are no incremental data deltas.+data DataEndPayload = DataEndPayload+ { contentIndex :: !Int,+ content :: !DataContent+ }+ deriving stock (Eq, Show, Generic)+ deriving anyclass (ToJSON)+ -- | Payload of 'ToolCallEnd': the fully parsed 'toolCall'. data ToolCallEndPayload = ToolCallEndPayload { contentIndex :: !Int,@@ -257,3 +270,48 @@ EventDone {} -> True EventError {} -> True _ -> False++instance FromJSON IndexPayload where parseJSON = genericParseJSON defaultOptions++instance FromJSON DeltaPayload where parseJSON = genericParseJSON defaultOptions++instance FromJSON BlockEndPayload where parseJSON = genericParseJSON defaultOptions++instance FromJSON ThinkingEndPayload where parseJSON = genericParseJSON defaultOptions++instance FromJSON ToolCallEndPayload where parseJSON = genericParseJSON defaultOptions++instance FromJSON DataEndPayload where parseJSON = genericParseJSON defaultOptions++instance FromJSON StartPayload where+ parseJSON = withObject "StartPayload" $ \o -> StartPayload <$> (o .: "partial" >>= parseMessage) <*> o .:? "responseId"++instance FromJSON TerminalPayload where+ parseJSON = withObject "TerminalPayload" $ \o ->+ TerminalPayload+ <$> o .: "reason"+ <*> (o .: "message" >>= parseMessage)+ <*> o .:? "responseId"+ <*> o .:? "errorInfo"+ <*> (o .:? "evidence" >>= traverse parseEvidence)++instance FromJSON AssistantMessageEvent where+ parseJSON = withObject "AssistantMessageEvent" $ \o -> do+ tag <- o .: "tag" :: Parser Text+ v <- o .: "contents"+ case tag of+ "EventStart" -> EventStart <$> parseJSON v+ "TextStart" -> TextStart <$> parseJSON v+ "TextDelta" -> TextDelta <$> parseJSON v+ "TextEnd" -> TextEnd <$> parseJSON v+ "ThinkingStart" -> ThinkingStart <$> parseJSON v+ "ThinkingDelta" -> ThinkingDelta <$> parseJSON v+ "ThinkingEnd" -> ThinkingEnd <$> parseJSON v+ "ToolCallStart" -> ToolCallStart <$> parseJSON v+ "ToolCallDelta" -> ToolCallDelta <$> parseJSON v+ "ToolCallEnd" -> ToolCallEnd <$> parseJSON v+ "DataStart" -> DataStart <$> parseJSON v+ "DataEnd" -> DataEnd <$> parseJSON v+ "EventDone" -> EventDone <$> parseJSON v+ "EventError" -> EventError <$> parseJSON v+ _ -> fail "unknown assistant event tag"
src/Baikai/ThinkingLevel.hs view
@@ -3,7 +3,7 @@ -- | Provider-agnostic reasoning-effort preference. -- -- Each provider maps the value to its own primitive. The canonical--- rendering spans @minimal@ through @max@, while provider boundaries+-- rendering spans @none@ through @max@, while provider boundaries -- may preserve, translate, or clamp values according to their APIs. -- 'thinkingTokenBudget' provides the recommended budget for -- token-based providers.@@ -25,7 +25,18 @@ -- provider's vocabulary, fine enough to influence behaviour in a -- meaningful way. data ThinkingLevel- = ThinkingMinimal+ = -- | Ask for no reasoning at all. This is not the same as leaving+ -- 'Baikai.Options.thinking' at 'Nothing': that sends nothing and+ -- leaves the model's own default in force, which on an adaptive+ -- Anthropic generation such as Claude Haiku 5.5 is to think. This+ -- level asks for thinking to be turned off: Anthropic Messages+ -- sends @thinking: {"type": "disabled"}@ to a model whose catalog+ -- record says it accepts that ('Baikai.Compat.supportsThinkingDisabled')+ -- and otherwise records a fallback. OpenAI sends @none@ when the+ -- model's accepted-effort policy permits it. Strict evidence refuses+ -- substitutions before dispatch; no mapping proves server execution.+ ThinkingNone+ | ThinkingMinimal | ThinkingLow | ThinkingMedium | ThinkingHigh@@ -37,6 +48,7 @@ -- | Render the canonical Baikai name for a reasoning-effort level. renderThinkingLevel :: ThinkingLevel -> Text renderThinkingLevel = \case+ ThinkingNone -> "none" ThinkingMinimal -> "minimal" ThinkingLow -> "low" ThinkingMedium -> "medium"@@ -51,6 +63,7 @@ -- @Baikai.Agent.Cli@ — did the first time a level was added. parseThinkingLevel :: Text -> Maybe ThinkingLevel parseThinkingLevel = \case+ "none" -> Just ThinkingNone "minimal" -> Just ThinkingMinimal "low" -> Just ThinkingLow "medium" -> Just ThinkingMedium@@ -60,9 +73,11 @@ _ -> Nothing -- | Recommended token budget for providers that take an explicit--- count (Anthropic's @thinking.budget_tokens@).+-- count (Anthropic's @thinking.budget_tokens@). 'ThinkingNone' asks+-- for no budget, so it is @0@; no provider sends a budget for it. thinkingTokenBudget :: ThinkingLevel -> Natural thinkingTokenBudget = \case+ ThinkingNone -> 0 ThinkingMinimal -> 1024 ThinkingLow -> 2048 ThinkingMedium -> 8192
src/Baikai/Trace.hs view
@@ -70,22 +70,25 @@ -- does 'Baikai.Trace.Event.TraceEvent'. They mean different things and -- both belong in this module, so the status constructors stay behind -- the @Evidence.@ qualifier.++import Baikai.Content (AssistantContent (..), TextContent (..)) import Baikai.Evidence ( ModelCallEvidence, newCallId, ) import Baikai.Evidence qualified as Evidence import Baikai.Evidence.Build qualified as Build+import Baikai.Internal.Data (recoverDataBlocks) import Baikai.Message (AssistantPayload (..), Message (..)) import Baikai.Model (Model) import Baikai.Options (Options) import Baikai.Prelude import Baikai.Provider.Registry (ProviderRegistry, globalProviderRegistry) import Baikai.Provider.Registry qualified as Registry-import Baikai.Response (Response)+import Baikai.Response (Response, flattenAssistantData) import Baikai.StopReason (StopReason (ErrorReason)) import Baikai.Stream (reassembleResponse, streamRequestWith)-import Baikai.Stream.Event (AssistantMessageEvent (..), TerminalPayload (..))+import Baikai.Stream.Event (AssistantMessageEvent (..), BlockEndPayload (..), DataEndPayload (..), TerminalPayload (..), ThinkingEndPayload (..), ToolCallEndPayload (..)) import Baikai.Trace.Event (TraceEvent (..)) import Baikai.Trace.Sink (TraceSink (..)) import Baikai.Usage (Usage)@@ -97,8 +100,10 @@ import Control.Monad (forM_, unless, void) import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO) import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)+import Data.IntMap.Strict qualified as IntMap import Data.Maybe (fromMaybe, isJust) import Data.Time (UTCTime, diffUTCTime, getCurrentTime)+import Data.Vector qualified as V import Foreign.StablePtr (StablePtr, freeStablePtr, newStablePtr) import Streamly.Data.Stream (Stream) import Streamly.Data.Stream qualified as Stream@@ -218,6 +223,7 @@ closed :: !(IORef Bool), sinkError :: !(IORef (Maybe SomeException)), terminalSent :: !(IORef Bool),+ dataBlocks :: !(IORef (IntMap.IntMap AssistantContent)), stableRoot :: !(IORef (Maybe (StablePtr TraceState))) } deriving stock (Generic)@@ -229,8 +235,9 @@ r <- newIORef False e <- newIORef Nothing t <- newIORef False+ dat <- newIORef IntMap.empty root <- newIORef Nothing- let state = TraceState {chan = c, done = d, closed = r, sinkError = e, terminalSent = t, stableRoot = root}+ let state = TraceState {chan = c, done = d, closed = r, sinkError = e, terminalSent = t, dataBlocks = dat, stableRoot = root} sp <- newStablePtr state writeIORef root (Just sp) pure state@@ -276,6 +283,7 @@ costBasis = Nothing, usageAvailability = Nothing, usd = Nothing,+ structuredData = Nothing, errorMessage = abortText } -- The consumer stopped before the terminal event, so no adapter@@ -482,7 +490,25 @@ AssistantMessageEvent -> IO AssistantMessageEvent traceEvent reg state eid start m opts ev = do+ let remember i block = atomicModifyIORef' (state ^. #dataBlocks) (\old -> (IntMap.insert i block old, ())) case ev of+ DataEnd DataEndPayload {contentIndex = i, content = d} -> remember i (AssistantData d)+ TextEnd BlockEndPayload {contentIndex = i, content = t} -> remember i (AssistantText (TextContent t))+ ThinkingEnd ThinkingEndPayload {contentIndex = i, content = t} -> remember i (AssistantThinking t)+ ToolCallEnd ToolCallEndPayload {contentIndex = i, toolCall = t} -> remember i (AssistantToolCall t)+ _ -> pure ()+ closed <- readIORef (state ^. #dataBlocks)+ let dataFor failed msg = case msg of+ AssistantMessage p ->+ let blocks = p ^. #content+ recovered+ | V.null blocks = V.fromList (IntMap.elems closed)+ | failed = recoverDataBlocks closed blocks+ | otherwise = blocks+ ds = flattenAssistantData recovered+ in if V.null ds then Nothing else Just ds+ _ -> Nothing+ case ev of EventDone TerminalPayload {message = msg, evidence = mev} -> do now <- getCurrentTime let latency = millisBetween start now@@ -513,6 +539,7 @@ -- common case rather than a corner. costBasis = mu >>= Cost.nonEmptyBasis . Usage.cost, usageAvailability = mu >>= Usage.availability,+ structuredData = dataFor False msg, usd = fmap (usdAsScientific . Usage.cost) mu } -- Evidence goes out *before* the terminal, so a sink that keys@@ -549,6 +576,7 @@ totalTokens = fmap Usage.totalTokens mu, costBasis = mu >>= Cost.nonEmptyBasis . Usage.cost, usageAvailability = mu >>= Usage.availability,+ structuredData = dataFor True msg, usd = fmap (usdAsScientific . Usage.cost) mu, errorMessage = errMsg }@@ -634,6 +662,7 @@ -- zero. usd = fmap (usdAsScientific . Usage.cost) mu, latencyMs = resp ^. #latencyMs,+ structuredData = let ds = flattenAssistantData ((resp ^. #message) ^. #content) in if V.null ds then Nothing else Just ds, promptSummary = summarizeContext ctx } appendEntry h entry
src/Baikai/Trace/Event.hs view
@@ -15,6 +15,7 @@ ) where +import Baikai.Content (DataContent) import Baikai.Cost (CostBasis) import Baikai.Evidence (ModelCallEvidence) import Baikai.Usage (UsageAvailability)@@ -34,6 +35,7 @@ import Data.Scientific (Scientific) import Data.Text (Text) import Data.Time (UTCTime)+import Data.Vector (Vector) import GHC.Generics (Generic) import Numeric.Natural (Natural) @@ -87,7 +89,8 @@ totalTokens :: !(Maybe Natural), costBasis :: !(Maybe CostBasis), usageAvailability :: !(Maybe UsageAvailability),- usd :: !(Maybe Scientific)+ usd :: !(Maybe Scientific),+ structuredData :: !(Maybe (Vector DataContent)) } | CallFailed { eventId :: !Text,@@ -104,6 +107,7 @@ costBasis :: !(Maybe CostBasis), usageAvailability :: !(Maybe UsageAvailability), usd :: !(Maybe Scientific),+ structuredData :: !(Maybe (Vector DataContent)), errorMessage :: !Text } | -- | The complete evidence record for one terminal provider call.@@ -198,6 +202,7 @@ <*> d .:? "costBasis" <*> d .:? "usageAvailability" <*> d .:? "usd"+ <*> d .:? "structuredData" "call_failed" -> CallFailed <$> d .: "eventId"@@ -214,6 +219,7 @@ <*> d .:? "costBasis" <*> d .:? "usageAvailability" <*> d .:? "usd"+ <*> d .:? "structuredData" <*> d .: "errorMessage" "call_evidence" -> fail
test/CatalogSpec.hs view
@@ -28,8 +28,10 @@ supportsFastMode, supportsForcedToolChoice, supportsSamplingParameters,+ supportsThinkingDisabled, thinkingStyle, )+import Baikai.Compat qualified as C import Baikai.Model ( Compat (CompatAnthropicMessages, CompatOpenAIResponses), Model,@@ -37,6 +39,7 @@ compat, modelId, )+import Baikai.Model qualified as M import Baikai.Models.Generated (allModels) import Baikai.ThinkingLevel (ThinkingLevel (..)) import Data.ByteString qualified as BS@@ -51,7 +54,17 @@ tests = testGroup "Baikai.Models.Generated"- [ testCase "Astra selects Responses with explicit endpoint facts" $ do+ [ testCase "native cache facts enable verified Luna Long and keep Chat gated" $ do+ let findModel mid = case filter ((== mid) . modelId) allModels of [m] -> pure m; _ -> assertFailure "missing model"+ luna <- findModel "gpt-6-luna"+ chat <- findModel "gpt-5.6"+ both <- findModel "gpt-4.1"+ longOnly <- findModel "gpt-5.5"+ (M.openaiResponsesCompatFor luna).nativeCachePolicy @?= Just (C.NativeCacheModern True True)+ (M.openaiCompletionsCompatFor chat).nativeCachePolicy @?= Just (C.NativeCacheModern False True)+ (M.openaiCompletionsCompatFor both).nativeCachePolicy @?= Just (C.NativeCacheLegacy True True)+ (M.openaiCompletionsCompatFor longOnly).nativeCachePolicy @?= Just (C.NativeCacheLegacy False True),+ testCase "Astra selects Responses with explicit endpoint facts" $ do [api m | m <- allModels, modelId m == "gpt-6-astra"] @?= [OpenAIResponses] case [compat m | m <- allModels, modelId m == "gpt-6-astra"] of [CompatOpenAIResponses c] -> do@@ -67,9 +80,9 @@ case [compat m | m <- allModels, modelId m == mid] of [CompatOpenAIResponses c] -> do c.supportsPromptCacheOptions @?= True- c.supportsLongCacheRetention @?= False+ c.supportsLongCacheRetention @?= (mid == "gpt-6-luna") c.supportsSamplingParameters @?= False- c.supportedReasoningEfforts @?= Just [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax]+ c.supportedReasoningEfforts @?= Just ([ThinkingNone | mid /= "gpt-6.1-sol"] <> [ThinkingLow, ThinkingMedium, ThinkingHigh, ThinkingXHigh, ThinkingMax]) _ -> assertFailure "GPT-6 Sol/Luna need explicit OpenAI Responses facts" ) ["gpt-6-sol", "gpt-6-luna", "gpt-6.1-sol"],@@ -103,25 +116,25 @@ anthropicCatalogModels :: [Model] anthropicCatalogModels = [m | m <- allModels, api m == AnthropicMessages] --- | The shipped thinking style and sampling support of each Anthropic--- catalog id, written out by hand from--- @baikai\/data\/models\/anthropic.json@.-expectedAnthropicFacts :: [(Text, (AnthropicThinkingStyle, Bool, Bool, Bool))]+-- | The shipped thinking style, sampling, forced-choice, fast-mode and+-- disabled-thinking support of each Anthropic catalog id, written out by+-- hand from @baikai\/data\/models\/anthropic.json@.+expectedAnthropicFacts :: [(Text, (AnthropicThinkingStyle, Bool, Bool, Bool, Bool))] expectedAnthropicFacts =- [ ("claude-fable-5", (AnthropicThinkingAdaptive, False, True, False)),- ("claude-fable-5-1", (AnthropicThinkingAdaptive, False, False, False)),- ("claude-haiku-4-5", (AnthropicThinkingBudget, True, True, False)),- ("claude-haiku-5-5", (AnthropicThinkingAdaptive, False, True, False)),- ("claude-opus-4-5", (AnthropicThinkingBudget, True, True, False)),- ("claude-opus-4-6", (AnthropicThinkingAdaptive, True, True, False)),- ("claude-opus-4-7", (AnthropicThinkingAdaptive, False, True, False)),- ("claude-opus-4-8", (AnthropicThinkingAdaptive, False, True, True)),- ("claude-opus-5", (AnthropicThinkingAdaptive, False, True, True)),- ("claude-opus-5-5", (AnthropicThinkingAdaptive, False, False, True)),- ("claude-sonnet-4-5", (AnthropicThinkingBudget, True, True, False)),- ("claude-sonnet-4-6", (AnthropicThinkingAdaptive, True, True, False)),- ("claude-sonnet-5", (AnthropicThinkingAdaptive, False, True, False)),- ("claude-sonnet-5-5", (AnthropicThinkingAdaptive, False, False, False))+ [ ("claude-fable-5", (AnthropicThinkingAdaptive, False, True, False, False)),+ ("claude-fable-5-1", (AnthropicThinkingAdaptive, False, False, False, False)),+ ("claude-haiku-4-5", (AnthropicThinkingBudget, True, True, False, True)),+ ("claude-haiku-5-5", (AnthropicThinkingAdaptive, False, True, False, True)),+ ("claude-opus-4-5", (AnthropicThinkingBudget, True, True, False, True)),+ ("claude-opus-4-6", (AnthropicThinkingAdaptive, True, True, False, True)),+ ("claude-opus-4-7", (AnthropicThinkingAdaptive, False, True, False, True)),+ ("claude-opus-4-8", (AnthropicThinkingAdaptive, False, True, True, True)),+ ("claude-opus-5", (AnthropicThinkingAdaptive, False, True, True, True)),+ ("claude-opus-5-5", (AnthropicThinkingAdaptive, False, False, True, False)),+ ("claude-sonnet-4-5", (AnthropicThinkingBudget, True, True, False, True)),+ ("claude-sonnet-4-6", (AnthropicThinkingAdaptive, True, True, False, True)),+ ("claude-sonnet-5", (AnthropicThinkingAdaptive, False, True, False, True)),+ ("claude-sonnet-5-5", (AnthropicThinkingAdaptive, False, False, False, False)) ] assertFacts :: Model -> IO ()@@ -139,5 +152,5 @@ <> show other ) where- facts :: AnthropicMessagesCompat -> (AnthropicThinkingStyle, Bool, Bool, Bool)- facts c = (thinkingStyle c, c.supportsSamplingParameters, c.supportsForcedToolChoice, c.supportsFastMode)+ facts :: AnthropicMessagesCompat -> (AnthropicThinkingStyle, Bool, Bool, Bool, Bool)+ facts c = (thinkingStyle c, c.supportsSamplingParameters, c.supportsForcedToolChoice, c.supportsFastMode, c.supportsThinkingDisabled)
test/CostSpec.hs view
@@ -47,7 +47,12 @@ tests = testGroup "Baikai.Cost"- [ fastCostTests,+ [ testCase "synthetic native duration rates select the complete input tier once" $ do+ let m = knownModel & #pricingPolicy .~ Just (PricingPolicy [InputPriceTier 100 (ModelCost 2 4 (1 / 5) (5 / 2)) (Just 5)] (Just (5 / 2)))+ u = Usage.observeBilling [Usage.BillingServiceTier "default"] (zeroUsage & #cacheWriteTokens .~ 200 & #totalTokens .~ 200)+ (computeCostForService (Just CacheRetentionShort) Nothing m u) ^. #usd @?= 1 / 2000+ (computeCostForService (Just CacheRetentionLong) Nothing m u) ^. #usd @?= 1 / 1000,+ fastCostTests, computeTests, attachCostTests, callLogTests@@ -280,6 +285,7 @@ cacheWriteTokens = Nothing, costBasis = Nothing, usageAvailability = Nothing,+ structuredData = Nothing, usd = Nothing, latencyMs = 0, promptSummary = ""
+ test/DataContentSpec.hs view
@@ -0,0 +1,146 @@+module DataContentSpec (tests) where++import Baikai+import Baikai.Cost.Log qualified as Log+import Baikai.Evidence.Build qualified+import Baikai.Prelude+import Baikai.Trace (runRequestWithRegistry, withTraceWith)+import Baikai.Trace.Event qualified as T+import Baikai.Trace.Sink qualified as Sink+import Control.Monad (forM_)+import Data.Aeson qualified as A+import Data.Aeson.KeyMap qualified as KM+import Data.Aeson.Types (parseEither)+import Data.ByteString.Lazy qualified as BL+import Data.Either (isLeft)+import Data.Map.Strict qualified as Map+import Data.Ratio ((%))+import Data.Text qualified as Text+import Data.Vector qualified as V+import Streamly.Data.Stream qualified as S+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit++sample :: DataContent+sample =+ DataContent+ (A.object ["urgent" A..= True, "category" A..= ("technical" :: Text.Text), "severity" A..= (2 :: Int)])+ (Just (Map.fromList [("urgent", Map.fromList [("true", 0.8), ("false", 0.2)]), ("category", Map.fromList [("billing", 0.2), ("technical", 0.7)]), ("severity", Map.fromList [("0", 0), ("1", 0.1), ("2", 1)])]))+ (Just (Map.fromList [("category", 0.7), ("severity", 0.9)]))+ (Just "provider_classification")++payload :: AssistantPayload+payload = (emptyResponse ^. #message) & #content .~ V.fromList [AssistantText (TextContent "before"), AssistantData sample, AssistantText (TextContent "after")]++modelFixture :: Model+modelFixture = emptyModel & #api .~ Custom "data-fixture" & #provider .~ "data-fixture"++responseFixture :: Response+responseFixture = emptyResponse & #message . #usage . #cost .~ (zeroCost & #usd .~ (3 % 10) & #breakdown . #inputUsd .~ (3 % 10)) & #model .~ modelFixture & #api .~ Custom "data-fixture" & #message .~ (payload & #usage . #cost .~ (zeroCost & #usd .~ (3 % 10) & #breakdown . #inputUsd .~ (3 % 10)))++-- Deliberately leave the error terminal empty to exercise closed-block recovery.+events :: Bool -> [AssistantMessageEvent]+events failed =+ [ EventStart (StartPayload (assistant "") Nothing),+ TextStart (IndexPayload 0),+ TextEnd (BlockEndPayload 0 "before"),+ DataStart (IndexPayload 1),+ DataEnd (DataEndPayload 1 sample),+ TextStart (IndexPayload 2),+ TextEnd (BlockEndPayload 2 "after")+ ]+ <> [ if failed+ then EventError (errorTerminal Nothing Nothing ErrorReason (assistant "") (providerError "failed"))+ else EventDone (doneTerminal Nothing Nothing Stop (AssistantMessage payload))+ ]++tests :: TestTree+tests =+ testGroup+ "structured content"+ [ testCase "data, scalar inputs and typed refusals round-trip" $ do+ A.eitherDecode (A.encode (AssistantData sample)) @?= Right (AssistantData sample)+ forM_ [A.Null, A.Bool True, A.String "日本語", A.toJSON ([1, 2] :: [Int]), value sample] $ \v -> do+ A.eitherDecode (A.encode (UserData v)) @?= Right (UserData v)+ let ctx = contextOf [userData v]+ Log.summarizeContext ctx @?= Text.take 200 (canonicalDataText v)+ forM_ [unsupportedFeature "messages[0].content[1]" "cannot replay", unsupportedModel "unknown" "not supported"] $ \e -> do+ A.eitherDecode (A.encode e) @?= Right e+ isRetryable e @?= False,+ testCase "invalid individual probabilities/confidences fail without normalizing totals" $ do+ forM_ ["probabilities", "confidence"] $ \key ->+ forM_ [A.toJSON (-0.1 :: Double), A.toJSON (1.1 :: Double), A.String "bad", A.Null, A.Number 1e10000] $ \bad -> do+ let v = A.object ["value" A..= A.Null, key A..= if key == "probabilities" then A.object ["field" A..= A.object ["x" A..= bad]] else A.object ["field" A..= bad]]+ assertBool "invalid numeric evidence rejected" (isLeft (parseEither A.parseJSON v :: Either String DataContent))+ A.eitherDecode (A.encode sample) @?= Right sample,+ testCase "atomic events serialize and retain mixed blocks on success and failure" $ do+ forM_ [False, True] $ \failed -> do+ let es = events failed+ A.eitherDecode (A.encode es) @?= Right es+ r <- S.fold (reassembleResponse modelFixture) (S.fromList es)+ (r ^. #message) ^. #content @?= payload ^. #content+ r2 <- S.fold (reassembleResponse modelFixture) (S.fromList (es <> [EventDone (doneTerminal Nothing Nothing Stop (assistant "overwrite"))]))+ r2 ^. #message @?= r ^. #message+ r <- S.fold (reassembleResponse modelFixture) (S.fromList [DataStart (IndexPayload 0)])+ flattenAssistantData ((r ^. #message) ^. #content) @?= V.empty,+ testCase "gapped data indices are not duplicated and partial failure terminals recover all data" $ do+ let first = sample+ second = sample & #method .~ Just "second"+ finalOne = (emptyResponse ^. #message) & #content .~ V.singleton (AssistantData first)+ terminal = EventError (errorTerminal Nothing Nothing ErrorReason (AssistantMessage finalOne) (providerError "partial terminal"))+ es = [DataStart (IndexPayload 2), DataEnd (DataEndPayload 2 first)]+ r <- S.fold (reassembleResponse modelFixture) (S.fromList (es <> [terminal]))+ flattenAssistantData (r ^. #message . #content) @?= V.singleton first+ let both = es <> [DataStart (IndexPayload 5), DataEnd (DataEndPayload 5 second), terminal]+ r2 <- S.fold (reassembleResponse modelFixture) (S.fromList both)+ flattenAssistantData (r2 ^. #message . #content) @?= V.fromList [first, second]+ reg <- newProviderRegistry+ let stream _ _ _ = S.fromList both+ registerApiProviderWith reg (apiProviderWith (Custom "data-fixture") stream (streamingComplete stream))+ withSystemTempDirectory "baikai-gapped-data" $ \dir -> do+ sink <- Sink.fileSink (dir </> "trace.jsonl")+ _ <- withTraceWith reg sink modelFixture emptyContext emptyOptions+ bytes <- BL.readFile (dir </> "trace.jsonl")+ ts <- either assertFailure pure (traverse A.eitherDecode (filter (not . BL.null) (BL.split 10 bytes)) :: Either String [T.TraceEvent])+ [ds | T.CallFailed {T.structuredData = ds} <- ts] @?= [Just (V.fromList [first, second])],+ testCase "named response bytes, optional evidence and response commitments" $ do+ ev <- Baikai.Evidence.Build.minimalEvidence modelFixture (emptyOptions & #evidence .~ Just (evidenceRequest "data-test")) TransportHttpApi noThinkingRequested (A.object []) (read "2026-10-25 00:00:00 UTC") (read "2026-10-25 00:00:01 UTC") CallSucceeded Nothing+ forM_ [responseFixture, responseFixture & #evidence .~ fmap (\e -> e & #usage .~ Observed (responseFixture ^. #message . #usage)) ev, responseFixture & #errorInfo .~ Just (unsupportedFeature "x" "refused") & #message . #stopReason .~ ErrorReason] $ \r -> do+ let encoded = responseToJSON r+ case parseEither responseFromJSON encoded of+ Left e -> assertFailure e+ Right decoded -> do+ canonicalEncode (responseToJSON decoded) @?= canonicalEncode encoded+ flattenAssistantData ((decoded ^. #message) ^. #content) @?= V.singleton sample+ let cached = case encoded of A.Object o -> A.Object (KM.delete "evidence" o); v -> v+ fmap (flattenAssistantData . (^. #content) . (^. #message)) (parseEither responseFromJSON cached) @?= Right (V.singleton sample)+ let changed = sample {method = Just "another"}+ assertBool "probability is committed" (commitmentDigest (A.toJSON sample) /= commitmentDigest (A.toJSON (sample & #probabilities .~ Just Map.empty)))+ assertBool "method is committed" (commitmentDigest (A.toJSON sample) /= commitmentDigest (A.toJSON changed)),+ testCase "file trace and both call-log entry points preserve data without evidence opt-in" $+ withSystemTempDirectory "baikai-data" $ \dir ->+ forM_ [False, True] $ \failed -> do+ reg <- newProviderRegistry+ let stream _ _ _ = S.fromList (events failed)+ registerApiProviderWith reg (apiProviderWith (Custom "data-fixture") stream (streamingComplete stream))+ let tracePath = dir </> (if failed then "failed-trace.jsonl" else "trace.jsonl")+ logPath = dir </> (if failed then "failed-log.jsonl" else "log.jsonl")+ sink <- Sink.fileSink tracePath+ Log.withCallLog (Log.callLogConfig logPath) $ \h -> do+ _ <- runRequestWithRegistry reg sink h modelFixture emptyContext emptyOptions+ _ <- Log.runRequestWithLogWith reg h modelFixture emptyContext emptyOptions+ pure ()+ traceBytes <- BL.readFile tracePath+ let decodedTrace = traverse A.eitherDecode (filter (not . BL.null) (BL.split 10 traceBytes)) :: Either String [T.TraceEvent]+ case decodedTrace of+ Right ts -> case [ds | T.CallFinished {T.structuredData = ds} <- ts] <> [ds | T.CallFailed {T.structuredData = ds} <- ts] of+ [ds] -> ds @?= Just (V.singleton sample)+ _ -> assertFailure "expected one terminal"+ Left e -> assertFailure e+ logBytes <- BL.readFile logPath+ case traverse A.eitherDecode (filter (not . BL.null) (BL.split 10 logBytes)) :: Either String [Log.CallLogEntry] of+ Right entries -> map (\e -> e ^. #structuredData) entries @?= replicate 2 (Just (V.singleton sample))+ Left e -> assertFailure e+ ]
test/EvidenceSpec.hs view
@@ -27,7 +27,14 @@ tests = testGroup "Evidence"- [ translationDisplayTests,+ [ testCase "native cache configuration redacts replay and records marker position" $ do+ let marker = object ["mode" .= ("explicit" :: Text.Text), "secret" .= ("PRIVATE_CONTROL" :: Text.Text)]+ block marked = object (["type" .= ("input_text" :: Text.Text), "text" .= ("PRIVATE_TEXT" :: Text.Text)] <> ["prompt_cache_breakpoint" .= marker | marked])+ body marked = object ["prompt_cache_options" .= object ["ttl" .= ("30m" :: Text.Text), "cache_key" .= ("PRIVATE_KEY" :: Text.Text)], "input" .= [object ["role" .= ("developer" :: Text.Text), "content" .= [block marked]], object ["type" .= ("reasoning" :: Text.Text), "encrypted_content" .= ("PRIVATE_REPLAY" :: Text.Text), "id" .= ("PRIVATE_ID" :: Text.Text)]]]+ projection = Text.pack (show (configurationProjection (body True)))+ assertBool "no private content" (not ("PRIVATE" `Text.isInfixOf` projection))+ assertBool "marker placement matters" (configurationDigest (body True) /= configurationDigest (body False)),+ translationDisplayTests, canonicalTests, digestTests, usageEnvelopeTests,@@ -271,7 +278,7 @@ testGroup "usage envelope" [ testCase "cost basis is serialized additively without changing provider commitments" $ do- evidenceSchemaVersion @?= "baikai.model-call-evidence/2.5"+ evidenceSchemaVersion @?= "baikai.model-call-evidence/2.8" let estimated = zeroUsage {cost = estimateCost [CacheWriteUsageNotReported] zeroCost} usageEnvelope estimated @?= usageEnvelope zeroUsage assertBool "usage JSON retains the local calculation basis" (Aeson.toJSON estimated /= Aeson.toJSON zeroUsage),
test/FetchModelsSpec.hs view
@@ -1,13 +1,18 @@+{-# LANGUAGE OverloadedRecordDot #-}+ -- | Unit tests for the pure core of @baikai-fetch-models@ -- ('FetchModelsCore'): filtering, curation, modality mapping, cost -- defaulting, and rendering, exercised against a checked-in -- models.dev-shaped fixture. No network is involved. module FetchModelsSpec (tests) where -import Baikai.Compat (AnthropicThinkingStyle (..), defaultOpenAIResponsesCompat)+import Baikai.Compat (AnthropicThinkingStyle (..), defaultOpenAICompletionsCompat, defaultOpenAIResponsesCompat)+import Baikai.Compat qualified as C import Baikai.Model (InputModality (..))+import Baikai.Model qualified import Baikai.Model qualified as Model import Baikai.Prelude+import Baikai.ThinkingLevel (ThinkingLevel (..)) import Control.Monad (forM_) import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KeyMap@@ -59,19 +64,21 @@ name = "GPT-5 Nano", reasoning = True, input = [InputText, InputImage],+ outputKind = Baikai.Model.GenerativeOutput, cost = CatalogCost 0.05 0.4 0 0, fastModeCost = Nothing, pricingPolicy = Nothing, contextWindow = 400000, maxOutputTokens = 128000, apiOverride = Nothing,- compat = Nothing+ compat = Just (CatalogOpenAICompat (defaultOpenAICompletionsCompat & #supportedReasoningEfforts .~ Just [ThinkingMinimal, ThinkingLow, ThinkingMedium, ThinkingHigh])) }, CatalogModel { modelId = "gpt-5.4", name = "GPT-5.4", reasoning = True, input = [InputText, InputImage],+ outputKind = Baikai.Model.GenerativeOutput, cost = CatalogCost 2.5 15 0.25 0, fastModeCost = Nothing, pricingPolicy = Nothing,@@ -98,6 +105,7 @@ name = "Claude Opus 4.5", reasoning = True, input = [InputText, InputImage],+ outputKind = Baikai.Model.GenerativeOutput, cost = CatalogCost 5 25 1.5 6.25, fastModeCost = Nothing, pricingPolicy = Nothing,@@ -111,6 +119,7 @@ { thinkingStyle = AnthropicThinkingBudget, supportsSamplingParameters = True, supportsForcedToolChoice = True,+ supportsThinkingDisabled = True, fastModeCost = Nothing } )@@ -123,8 +132,20 @@ tests = testGroup "Baikai.FetchModels"- [ testCase "per-model API and Responses compat survive normalization and rendering" $ do+ [ testCase "curated native cache facts survive fetch rendering and generator parsing" $ do upstream <- loadUpstream+ let sample = head (Map.elems (Map.findWithDefault Map.empty "openai" upstream))+ forM_ [("gpt-6-luna", C.NativeCacheModern True True), ("gpt-5.6", C.NativeCacheModern False True), ("gpt-4.1", C.NativeCacheLegacy True True), ("gpt-5.5", C.NativeCacheLegacy False True)] $ \(mid, expected) -> do+ let cat = normalizeProvider openaiSpec (Map.singleton mid (sample & #modelId .~ mid & #toolCall .~ True))+ parsed <- either assertFailure pure (Aeson.eitherDecode (BSL.fromStrict (renderCatalog cat)))+ let entries = Gen.flattenEntries parsed+ case map (\(_, e) -> e.compat) entries of+ [Gen.CatalogCompatOpenAI c] -> c ^. #nativeCachePolicy @?= Just expected+ [Gen.CatalogCompatResponses c] -> c ^. #nativeCachePolicy @?= Just expected+ _ -> assertFailure "missing native compat"+ assertBool "generator renders policy" (Text.pack (show expected) `Text.isInfixOf` Gen.renderModule entries),+ testCase "per-model API and Responses compat survive normalization and rendering" $ do+ upstream <- loadUpstream let spec = openaiSpec & #apiFor@@ -153,6 +174,14 @@ _ -> assertFailure "wrong entries" _ -> assertFailure "missing models" _ -> assertFailure "invalid rendered catalog",+ testCase "refresh and generation preserve which OpenAI models accept none" $ do+ upstream <- loadUpstream+ let sample = (upstream Map.! "openai") Map.! "gpt-5.4"+ forM_ [("gpt-5", "ThinkingMinimal"), ("o3", "ThinkingLow"), ("gpt-6-sol", "ThinkingNone"), ("gpt-6-luna", "ThinkingNone"), ("gpt-6-astra", "ThinkingLow"), ("gpt-6.1-sol", "ThinkingLow")] $ \(mid, lowest) -> do+ let refreshed = normalizeProvider openaiSpec (Map.singleton mid (sample & #modelId .~ mid))+ case Aeson.eitherDecode (BSL.fromStrict (renderCatalog refreshed)) of+ Left err -> assertFailure err+ Right catalog -> assertBool (Text.unpack mid <> " preserves its lowest effort") (("supportedReasoningEfforts = Just [" <> lowest <> ",") `Text.isInfixOf` Gen.renderModule (Gen.flattenEntries catalog)), testCase "refresh preserves Astra endpoint restrictions despite upstream tool support" $ do upstream <- loadUpstream let sample = (upstream Map.! "openai") Map.! "gpt-5.4"@@ -181,7 +210,7 @@ forM_ [ (openaiSpec, "gpt-6-astra", Model.PricingPolicy [Model.InputPriceTier 272000 (Model.ModelCost 20 75 2 25) Nothing] Nothing), (openaiSpec, "gpt-6-sol", Model.PricingPolicy [Model.InputPriceTier 272000 (Model.ModelCost 4 15 0.4 5) Nothing] Nothing),- (openaiSpec, "gpt-6-luna", Model.PricingPolicy [Model.InputPriceTier 272000 (Model.ModelCost 0.2 0.75 0.02 0.25) Nothing] Nothing),+ (openaiSpec, "gpt-6-luna", Model.PricingPolicy [Model.InputPriceTier 272000 (Model.ModelCost 0.2 0.75 0.02 0.25) (Just 0.5)] (Just 0.25)), (anthropicSpec, "claude-fable-5-1", Model.PricingPolicy [] (Just 20)), (anthropicSpec, "claude-opus-5-5", Model.PricingPolicy [] (Just 8)) ]@@ -238,6 +267,7 @@ name = nameWithControls, reasoning = False, input = [InputText],+ outputKind = Baikai.Model.GenerativeOutput, cost = CatalogCost 0 0 0 0, fastModeCost = Nothing, pricingPolicy = Nothing,@@ -281,14 +311,16 @@ " \"thinkingStyle\": \"budget\",", " \"supportsSamplingParameters\": true,", " \"supportsFastMode\": false,",- " \"supportsForcedToolChoice\": true",+ " \"supportsForcedToolChoice\": true,",+ " \"supportsThinkingDisabled\": true", " }," ] `Text.isInfixOf` rendered ),- testCase "an OpenAI model renders no compat block" $ do+ testCase "an unconstrained OpenAI model renders no compat block" $ do upstream <- loadUpstream- let rendered = renderText (catalogFor upstream openaiSpec)+ let catalog = catalogFor upstream openaiSpec+ rendered = renderText (catalog & #models .~ filter ((== "gpt-5.4") . (^. #modelId)) (catalog ^. #models)) assertBool "no per-model compat block (the file-level \"compat\": \"auto\" stays)" (not ("\"compat\": {" `Text.isInfixOf` rendered)),
test/GenModelsSpec.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedRecordDot #-}+ module GenModelsSpec (tests) where import Baikai.Api (Api (AnthropicMessages, OpenAIChatCompletions, OpenAIResponses))@@ -6,11 +8,15 @@ defaultAnthropicMessagesCompat, supportsFastMode, supportsSamplingParameters,+ supportsThinkingDisabled, thinkingStyle, )+import Baikai.Compat qualified as C import Baikai.Model (InputModality (InputText))+import Baikai.Model qualified import Control.Monad (forM_) import Data.Aeson qualified as Aeson+import Data.Aeson.KeyMap qualified as KM import Data.Text (Text) import Data.Text qualified as Text import GenModelsCore@@ -21,7 +27,31 @@ tests = testGroup "Baikai.GenModels"- [ testCase "fast capability and rates must agree in both directions" $ do+ [ testCase "legacy OpenAI runtime JSON defaults missing native policy" $ do+ let legacy c = case Aeson.toJSON c of Aeson.Object o -> Aeson.Object (KM.delete "nativeCachePolicy" (KM.delete "cacheControlFormat" (KM.delete "supportedReasoningEfforts" o))); v -> v+ case Aeson.fromJSON (legacy C.defaultOpenAIResponsesCompat) of+ Aeson.Success c -> assertBool "absent Responses policy" ((c :: C.OpenAIResponsesCompat).nativeCachePolicy == Nothing)+ Aeson.Error err -> assertFailure err+ case Aeson.fromJSON (legacy C.defaultOpenAICompletionsCompat) of+ Aeson.Success c -> assertBool "absent Chat policy" ((c :: C.OpenAICompletionsCompat).nativeCachePolicy == Nothing)+ Aeson.Error err -> assertFailure err,+ testCase "native catalog rejects contradictory controls and unpriced Long naming model" $ do+ let conflicting = CatalogCompatOpenAI (C.defaultOpenAICompletionsCompat {C.cacheControlFormat = Just C.CacheControlFormatAnthropic, C.nativeCachePolicy = Just (C.NativeCacheModern False True)})+ unpriced = CatalogCompatResponses (C.defaultOpenAIResponsesCompat {C.nativeCachePolicy = Just (C.NativeCacheModern True True)})+ emptyLegacy = CatalogCompatResponses (C.defaultOpenAIResponsesCompat {C.nativeCachePolicy = Just (C.NativeCacheLegacy False False)})+ forM_ [conflicting, unpriced, emptyLegacy] $ \block -> do+ let c = collisionCatalog {models = [(model "invalid-cache-model") {entryCompatOverride = Just block}]}+ case checkNativeCacheCompat (flattenEntries c) of+ Left err -> assertBool "names model" ("invalid-cache-model" `Text.isInfixOf` err)+ Right () -> assertFailure "invalid policy accepted",+ testCase "legacy Anthropic model JSON does not invent disable support" $ do+ let raw = case Aeson.toJSON (defaultAnthropicMessagesCompat {supportsThinkingDisabled = True}) of+ Aeson.Object o -> Aeson.Object (KM.delete "supportsThinkingDisabled" o)+ other -> other+ case Aeson.fromJSON raw of+ Aeson.Error err -> assertFailure err+ Aeson.Success c -> assertBool "missing fact is conservative" (not (supportsThinkingDisabled c)),+ testCase "fast capability and rates must agree in both directions" $ do forM_ [(True, Nothing), (False, Just (CostEntry 10 50 1 12.5))] $ \(supported, rates) -> do let block = CatalogCompatAnthropic (defaultAnthropicMessagesCompat {supportsFastMode = supported}) catalog = (anthropicCatalog CatalogCompatAuto (Just block)) {models = [(model "claude-x") {entryCompatOverride = Just block, entryFastModeCost = rates}]}@@ -127,6 +157,7 @@ entryName = mid, entryReasoning = False, entryInput = [InputText],+ entryOutputKind = Baikai.Model.GenerativeOutput, entryCost = CostEntry { costInput = 0,
+ test/JudgmentSpec.hs view
@@ -0,0 +1,151 @@+module JudgmentSpec (tests) where++import Baikai hiding (confidence, format, kind, name, probabilities)+import Baikai.Judgment qualified as J+import Baikai.Models.Generated qualified as Models+import Control.Lens ((&), (.~), (^.))+import Control.Monad (forM_)+import Data.Aeson qualified as A+import Data.Aeson.Key qualified+import Data.Aeson.KeyMap qualified as KM+import Data.ByteString.Lazy qualified as BL+import Data.Either (isLeft)+import Data.Generics.Labels ()+import Data.Map.Strict qualified as M+import Data.Text (Text)+import Data.Text qualified+import Data.Vector qualified as V+import FetchModelsCore qualified as F+import GenModelsCore qualified as G+import Test.Tasty+import Test.Tasty.HUnit++schemaFixture :: A.Value+schemaFixture =+ A.object+ [ "type" A..= ("object" :: Text),+ "additionalProperties" A..= False,+ "required" A..= (["urgent", "category", "severity"] :: [Text]),+ "properties"+ A..= A.object+ [ "urgent" A..= A.object ["type" A..= ("boolean" :: Text), "description" A..= ("Is service blocked?" :: Text)],+ "category" A..= branches [A.String "billing", A.String "technical"] [A.String "Payment issue", A.String "Product malfunction"] "Classify the issue.",+ "severity" A..= branches (map A.toJSON [0 :: Int, 1, 2]) (map A.String ["Minor", "Disruptive", "Blocking"]) "Rate impact."+ ]+ ]++branches :: [A.Value] -> [A.Value] -> Text -> A.Value+branches vs ds instr = A.object ["description" A..= instr, "anyOf" A..= [A.object ["const" A..= v, "description" A..= d] | (v, d) <- zip vs ds]]++format :: A.Value -> JsonSchemaFormat+format = jsonSchemaFormat "judgments"++opts :: Options+opts = emptyOptions & #responseFormat .~ Just (JsonSchema (format schemaFixture))++ctx :: Context+ctx = contextOf [userData (A.object ["ticket" A..= ("Checkout is unavailable." :: Text)])]++answers :: M.Map Text JudgmentAnswer+answers =+ M.fromList+ [ ("urgent", PredicateAnswer 0.83),+ ("category", ChoiceAnswer "technical" (M.fromList [("billing", 0.2), ("technical", 0.7)]) (Just 0.65)),+ ("severity", ScoreAnswer (Just 1.5) (M.fromList [("0", 0.1), ("1", 0.3), ("2", 0.6)]) (Just 0.55))+ ]++withProperty :: A.Value -> A.Value+withProperty v = A.object ["type" A..= ("object" :: Text), "properties" A..= A.object ["x" A..= v]]++enum :: [A.Value] -> A.Value+enum vs = A.object ["enum" A..= vs]++compiled :: IO Judgments+compiled = either (assertFailure . show) pure (compileJudgments (format schemaFixture))++assertPath :: Text -> Either BaikaiError a -> IO ()+assertPath p r = case r of+ Left e -> e ^. #requestProblem @?= Just (UnsupportedFeature p)+ Right _ -> assertFailure "expected refusal"++tests :: TestTree+tests =+ testGroup+ "neutral judgments"+ [ testCase "fetch render preserves curated judgment output and data modality" $ do+ let m = F.CatalogModel "jev-latest" "Jev" False [InputText, InputData] JudgmentOutput (F.CatalogCost 0 0 0 0) Nothing Nothing 0 0 Nothing Nothing+ c = F.Catalog "typesafe" "https://api.typesafe.ai" "typesafe-system-one" [m]+ case A.eitherDecode (BL.fromStrict (F.renderCatalog c)) :: Either String G.CatalogFile of+ Left e -> assertFailure e+ Right catalog -> case G.flattenEntries catalog of+ [(_, g)] -> do G.outputKind g @?= JudgmentOutput; G.input g @?= [InputText, InputData]+ _ -> assertFailure "one model required",+ testCase "catalog facts and generative legacy default" $ do+ forM_ [Models.typesafe_jev_latest, Models.typesafe_jev_preview] $ \m -> do+ isJudgmentOnly m @?= True+ m ^. #api @?= TypeSafeSystemOne+ m ^. #input @?= [InputText, InputData]+ A.eitherDecode (A.encode m) @?= Right m+ forM_ Models.allModels $ \m -> isJudgmentOnly m @?= (m ^. #provider == "typesafe")+ let old = case A.toJSON emptyModel of A.Object o -> A.Object (KM.delete "outputKind" o); v -> v+ fmap (^. #outputKind) ((A.fromJSON old :: A.Result Model)) @?= A.Success GenerativeOutput,+ testCase "ordered fixture with exact instructions and criteria; deterministic fallback" $ do+ js <- compiled+ V.toList (judgmentList js)+ @?= [ Judgment "urgent" (A.String "Is service blocked?") (PredicateJudgment Nothing),+ Judgment "category" (A.String "Classify the issue.") (ChoiceJudgment (V.fromList [("billing", Just (A.String "Payment issue")), ("technical", Just (A.String "Product malfunction"))])),+ Judgment "severity" (A.String "Rate impact.") (ScoreJudgment (V.fromList (map (Just . A.String) ["Minor", "Disruptive", "Blocking"])))+ ]+ let noRequired = case schemaFixture of A.Object o -> A.Object (KM.delete "required" o); v -> v+ fallback <- either (assertFailure . show) pure (compileJudgments (format noRequired))+ map (^. #name) (V.toList (judgmentList fallback)) @?= ["category", "severity", "urgent"],+ testCase "predicate criteria and neutral non-string content are preserved" $ do+ forM_ [A.String "", A.Bool False, A.Number 0, A.object [], A.toJSON ([] :: [Int])] $ \d -> do+ let p = A.object ["description" A..= d, "oneOf" A..= [A.object ["const" A..= False, "description" A..= ("no" :: Text)], A.object ["const" A..= True, "description" A..= ("yes" :: Text)]]]+ js <- either (assertFailure . show) pure (compileJudgments (format (withProperty p)))+ lookupJudgment "x" js @?= Just (Judgment "x" d (PredicateJudgment (Just (A.String "yes", A.String "no")))),+ testCase "all unsupported schema shapes and boundary sizes" $ do+ forM_ [A.object [], A.object ["type" A..= ("string" :: Text)], A.object ["type" A..= ("object" :: Text)], enum [], enum [A.String "x", A.String "x"], enum [A.Bool True, A.String "x"], enum (map A.toJSON [0 :: Int, 2]), enum (map A.toJSON [1 :: Int, 2, 3]), enum [A.Number 0], enum (map A.toJSON [0 :: Int .. 10]), enum [A.Number 0, A.Number 1.5], A.object ["allOf" A..= ([] :: [Int])], A.object ["anyOf" A..= [A.object []]], A.object ["type" A..= ("boolean" :: Text), "enum" A..= [A.String "x"]]] $ \p ->+ assertBool (show p) (isLeft (compileJudgments (format (withProperty p))))+ forM_ [1, 255] $ \n -> assertBool "choice boundary accepted" (not (isLeft (compileJudgments (format (withProperty (enum [A.String (fromString (show i)) | i <- [1 .. n :: Int]]))))))+ forM_ [2, 10] $ \n -> assertBool "score boundary accepted" (not (isLeft (compileJudgments (format (withProperty (enum (map A.toJSON [0 .. n - 1 :: Int])))))))+ assertPath "Options.responseFormat.schema.properties.x" (compileJudgments (format (withProperty (enum [A.String (fromString (show i)) | i <- [1 .. 256 :: Int]]))))+ forM_ [("required", A.toJSON (["missing"] :: [Text])), ("additionalProperties", A.Bool True), ("$ref", A.String "#defs/x")] $ \(k, v) -> do+ let s = case schemaFixture of A.Object o -> A.Object (KM.insert k v o); x -> x+ assertPath ("Options.responseFormat.schema." <> fromString (showKey k)) (compileJudgments (format s)),+ testCase "every explicit generation control is refused by path" $ do+ let controls = [("maxTokens", opts & #maxTokens .~ Just 1), ("temperature", opts & #temperature .~ Just 0), ("topP", opts & #topP .~ Just 1), ("stopSequences", opts & #stopSequences .~ ["x"]), ("seed", opts & #seed .~ Just 1), ("frequencyPenalty", opts & #frequencyPenalty .~ Just 0), ("presencePenalty", opts & #presencePenalty .~ Just 0), ("thinking", opts & #thinking .~ Just ThinkingLow), ("cacheRetention", opts & #cacheRetention .~ Just CacheRetentionShort), ("speed", opts & #speed .~ Just SpeedStandard)]+ forM_ controls $ \(field, o) -> assertPath ("Options." <> field) (prepareJudgment ctx o)+ forM_ [ToolChoiceAuto, ToolChoiceNone, ToolChoiceRequired, ToolChoiceSpecific "x"] $ \choice -> assertPath "Options.toolChoice" (prepareJudgment ctx (opts & #toolChoice .~ Just choice))+ assertBool "explicit no caching accepted" (not (isLeft (prepareJudgment ctx (opts & #cacheRetention .~ Just CacheRetentionNone)))),+ testCase "context checks precede option and schema checks" $ do+ assertPath "Context.systemPrompt" (prepareJudgment (ctx & #systemPrompt .~ Just "") emptyOptions)+ forM_ [contextOf [], contextOf [user "x", user "y"]] $ \c -> assertPath "Context.messages" (prepareJudgment c opts)+ assertPath "Context.messages[0]" (prepareJudgment (contextOf [assistant "x"]) opts)+ assertPath "Context.messages[0]" (prepareJudgment (contextOf [toolResult "call" "tool" "result" False]) opts)+ assertPath "Context.tools" (prepareJudgment (ctx & #tools .~ V.singleton emptyTool) opts)+ forM_ [emptyOptions, emptyOptions & #responseFormat .~ Just JsonObject] $ \o -> assertPath "Options.responseFormat" (prepareJudgment ctx o),+ testCase "complete data preserves provider selection, expected score and non-normalized probabilities" $ do+ js <- compiled+ d <- either (assertFailure . show) pure (validateAnswers js answers)+ d ^. #value @?= A.object ["urgent" A..= True, "category" A..= ("technical" :: Text), "severity" A..= (1.5 :: Double)]+ d ^. #confidence @?= Just (M.fromList [("category", 0.65), ("severity", 0.55)])+ A.eitherDecode (A.encode d) @?= Right d+ let other = M.insert "category" (ChoiceAnswer "billing" (M.fromList [("billing", 0.2), ("technical", 0.7)]) Nothing) answers+ selected <- either (assertFailure . show) pure (validateAnswers js other)+ case selected ^. #value of A.Object o -> KM.lookup "category" o @?= Just (A.String "billing"); _ -> assertFailure "object required"+ tied <- either (assertFailure . show) pure (validateAnswers js (M.insert "severity" (ScoreAnswer Nothing (M.fromList [("0", 0.5), ("1", 0.5), ("2", 0)]) Nothing) answers))+ case tied ^. #value of A.Object o -> KM.lookup "severity" o @?= Just (A.Number 0); _ -> assertFailure "object required",+ testCase "malformed answer names, kinds, distributions, selected labels and numeric evidence" $ do+ js <- compiled+ forM_ [M.delete "urgent" answers, M.insert "extra" (PredicateAnswer 0.5) answers, M.insert "category" (PredicateAnswer 0.5) answers, M.insert "category" (ChoiceAnswer "other" (M.fromList [("billing", 0.2), ("technical", 0.7)]) Nothing) answers, M.insert "category" (ChoiceAnswer "billing" M.empty Nothing) answers] $ \as ->+ case validateAnswers js as of Left e -> e ^. #category @?= DecodeFailure; Right _ -> assertFailure "expected failure"+ forM_ [-0.1, 1.1, 1 / 0, 0 / 0] $ \bad -> forM_ [M.insert "urgent" (PredicateAnswer bad) answers, M.insert "category" (ChoiceAnswer "billing" (M.fromList [("billing", 0.2), ("technical", 0.7)]) (Just bad)) answers] $ \as ->+ case validateAnswers js as of Left e -> e ^. #category @?= DecodeFailure; Right _ -> assertFailure "expected numeric failure"+ case validateAnswers js (M.insert "urgent" (RefusedAnswer (Just "policy")) answers) of+ Left e -> do e ^. #category @?= ContentFiltered; e ^. #refusalCategory @?= Just "policy"+ Right _ -> assertFailure "refusal required"+ ]+ where+ fromString = Data.Text.pack+ showKey = Data.Aeson.Key.toString
test/Main.hs view
@@ -23,6 +23,7 @@ import Data.Proxy (Proxy (..)) import Data.Text qualified as Text import Data.Vector qualified as V+import DataContentSpec qualified import EmbeddingSpec qualified import ErrorInfoSpec qualified import ErrorSpec qualified@@ -32,6 +33,7 @@ import GenModelsSpec qualified import HelpersSpec qualified import InteractiveSpec qualified+import JudgmentSpec qualified import PricingPolicySpec qualified import PublicSurfaceSpec qualified import StreamSpec qualified@@ -112,6 +114,7 @@ CliInternalSpec.tests, CliProcessSpec.tests, ContextSpec.tests,+ DataContentSpec.tests, CostSpec.tests, EmbeddingSpec.tests, ErrorInfoSpec.tests,@@ -121,6 +124,7 @@ GenModelsSpec.tests, HelpersSpec.tests, InteractiveSpec.tests,+ JudgmentSpec.tests, PricingPolicySpec.tests, PublicSurfaceSpec.tests, StreamSpec.tests,
test/StrictEvidenceSpec.hs view
@@ -195,6 +195,14 @@ "a thinking budget that will not fit the output ceiling is discarded" (ThinkingDroppedBudgetExceeded ThinkingMax 32000 8192) "does not fit inside the resolved output ceiling",+ refusesDowngrade+ "a host without controls may still think by default when none is requested"+ (ThinkingDroppedUnsupportedHost ThinkingNone)+ "exposes no reasoning controls",+ refusesDowngrade+ "a minimum positive effort cannot satisfy explicit off"+ (EffortClamped ThinkingNone "low")+ "would be sent as low", testCase "several downgrades on one call are reported together" $ case checkEvidenceRequirements (EvidenceRequired EvidenceRequestedOnly)
test/ThinkingLevelSpec.hs view
@@ -16,7 +16,8 @@ levels :: [(String, ThinkingLevel, Text, Integer)] levels =- [ ("minimal", ThinkingMinimal, "minimal", 1024),+ [ ("none", ThinkingNone, "none", 0),+ ("minimal", ThinkingMinimal, "minimal", 1024), ("low", ThinkingLow, "low", 2048), ("medium", ThinkingMedium, "medium", 8192), ("high", ThinkingHigh, "high", 16384),
test/TraceSpec.hs view
@@ -1240,6 +1240,7 @@ totalTokens = Just 26, costBasis = Nothing, usageAvailability = Nothing,+ structuredData = Nothing, usd = Just 0 } @@ -1259,6 +1260,7 @@ totalTokens = Nothing, costBasis = Nothing, usageAvailability = Nothing,+ structuredData = Nothing, usd = Nothing, errorMessage = "boom" }