baikai-claude 0.7.0.0 → 0.7.1.0
raw patch · 9 files changed
+633/−125 lines, 9 filesdep ~baikaiPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: baikai
API changes (from Hackage documentation)
Files
- CHANGELOG.md +159/−0
- baikai-claude.cabal +84/−73
- src/Baikai/Provider/Claude/Api.hs +2/−0
- src/Baikai/Provider/Claude/Cli.hs +65/−9
- src/Baikai/Provider/Claude/Internal/Request.hs +24/−21
- test/FableContractsSpec.hs +27/−1
- test/Main.hs +2/−0
- test/StructuredCliSpec.hs +223/−0
- test/ThinkingSpec.hs +47/−21
CHANGELOG.md view
@@ -7,6 +7,165 @@ ## [Unreleased] +## [baikai 0.7.2.0] - 2026-09-30++### Added++- Curated GPT-6.1 Sol on OpenAI Responses and Claude Sonnet 5.5 on Anthropic+ Messages (`openai_gpt_6_1_sol`, `anthropic_claude_sonnet_5_5`), with endpoint+ compatibility facts, standard prices, GPT-6.1 Sol's 272K-token context tier,+ and Sonnet 5.5's one-hour cache-write rate. Sonnet 5.5 rejects forced tool+ choice locally and has no fast mode. Both passed live text and function-tool+ acceptance on 2026-09-30 through `/v1/responses` and `/v1/messages`+ ([record](docs/validation/plan-85/2026-09-30-complete.json),+ [plan 85](docs/plans/85-prove-gpt-6-1-sol-and-claude-sonnet-5-5-live-compatibility.md)).+ The focused smoke runner gains the `sol61-*` and `sonnet55-*` cases.+- `Baikai.ResponseFormat.StructuredOutputSupport`+ (`NativeJsonSchema | NoStructuredOutput`), `declaredStructuredOutput :: Api ->+ StructuredOutputSupport`, and a `structuredOutput` field on `ApiProvider`+ (default `NoStructuredOutput` in `apiProviderWith`), so a caller can ask+ whether a transport enforces a schema without calling it. Every built-in+ provider declares `NativeJsonSchema`.++## [baikai-claude 0.7.1.0] - 2026-09-30++Requires `baikai >=0.7.2`.++### Added++- `claude -p` honours a `JsonSchema` response format (IR-11): it receives+ `--json-schema '<schema>'` and the response text is the tool's validated+ `structured_output`. A missing `structured_output` is a `DecodeFailure`; a+ `claude` too old for the flag yields an `InvalidRequest` error with the exit+ code rather than unconstrained text. `JsonObject`, `name` and `strict` are not+ forwarded; requests without a schema render the same argument vector as+ before. Both Claude providers declare `structuredOutput = NativeJsonSchema`.++### Fixed++- Anthropic adaptive `ThinkingHigh` now sends+ `output_config.effort: "high"` instead of omitting the field. Claude Opus 5.5+ defaults to `medium`, so it previously ran `ThinkingHigh` at medium effort;+ other adaptive models default to `high` and behave as before. Evidence for+ these calls records `effortText = "high"` and no longer carries+ `effort_omitted`, so strict evidence mode no longer refuses them.+ `Baikai.Evidence.EffortOmitted` stays exported, and older records still decode.++## [baikai-openai 0.7.1.0] - 2026-09-30++Requires `baikai >=0.7.2`.++### Added++- `codex exec` honours a `JsonSchema` response format (IR-11): the schema is+ written to a temporary file passed as `--output-schema <file>` and deleted+ however the call ends. A `codex` too old for the flag yields an+ `InvalidRequest` error with the exit code rather than unconstrained text.+ `JsonObject`, `name` and `strict` are not forwarded; requests without a schema+ render the same argument vector as before. All three OpenAI providers declare+ `structuredOutput = NativeJsonSchema`.+- `codexCliCommandWith`, which renders the `codex exec`+ vector with a given `--output-schema` file. `codexCliCommand` is unchanged+ and never renders the flag.++## [baikai 0.7.1.0] - 2026-09-23++### Added++- Curated GPT-6 Sol and Luna on OpenAI Responses and Claude Opus 5.5 on+ Anthropic Messages (`openai_gpt_6_sol`, `openai_gpt_6_luna`,+ `anthropic_claude_opus_5_5`), with endpoint compatibility and standard,+ long-context, cache-duration, and fast-mode prices where applicable. All+ three passed live acceptance on 2026-09-23. Sol and Luna dispatch to+ `OpenAIResponses`, so calling them requires the+ `Baikai.Provider.OpenAI.Responses.register` call that `baikai-openai 0.7.0.0`+ introduced.++## [baikai-kit 0.3.0.0] - 2026-09-23++Closes four improvement requests from the tools that ship `baikai-kit` as their+`kit` command: project scope resolves from a configurable root (IR-8),+`kit status` reports local edits separately from upstream drift (IR-7),+`kit install` without a name asks a tool-supplied chooser (IR-6), and `list`,+`status` and `update` print versioned JSON (IR-9). A consumer raising its bound+builds `KitConfig` with `kitConfig`, passes it to `kitCommandParser`, and+matches on `StatusRow.conditions`; each break is at a call site the compiler+names.++### Added++- `baikai-kit`: `KitConfig.projectRoot :: IO FilePath` says where project scope+ lives. Install, status, update, uninstall and `agentDirsForSession` all derive+ project-scope paths from it, so they agree whichever subdirectory a command+ runs from. `kitConfig` builds a configuration with every optional field at its+ default (project scope is the current directory, as before);+ `projectRootByMarkers [".git", ".mytool"]` is a ready-made resolver that walks+ up to the nearest marker and falls back to the current directory, and+ `findProjectRoot` is the underlying walk. Resolves IR-8.++- `baikai-kit`: `kit status` reports local edits. It runs the same+ installed-file check `kit update` uses to skip an item, and shows+ `modified` for an edited copy and `edits-unknown` for one whose sidecar+ predates the installed-file hash. The check is exported as+ `checkLocalEdits`, returning `LocalEdits` (`Unedited`, `Edited`,+ `EditsUnknown`). Resolves IR-7.++- `baikai-kit`: `kit install` with no name asks a chooser the tool supplies in+ the new `KitConfig.chooseItem :: Maybe (KitManifest -> IO (Maybe Text))`+ field. The engine refreshes the kit, passes the whole manifest, and installs+ what the chooser returns; a cancelled choice prints+ `No item chosen; nothing installed.` and exits 0. With no chooser (the+ `kitConfig` default) the command fails with the new `KitItemNameRequired`+ error, which tells the user to pass `NAME`. The engine ships no picker.+ `KitCommand` derives `Eq`, and `kit install --help` names the tool's+ `.<tool>/agents` directory. Resolves IR-6.++- `baikai-kit`: `kit list`, `kit status` and `kit update` accept `--json` and+ print exactly one versioned JSON document on stdout+ (`{"formatVersion": 1, "document": "kit-list" | "kit-status" | "kit-update", …}`);+ warnings and the first-clone notice go to stderr, and a failed command writes+ nothing to stdout. The shapes are written by explicit encoders —+ `Baikai.Kit.Json.listDocument`, `statusDocument`, `updateDocument`, and+ `kitJsonFormatVersion` — so library callers get the same values, and they are+ pinned by golden tests. `Baikai.Kit.Command.OutputFormat` selects the mode,+ and `Baikai.Kit.Status.InstalledCopy` / `installedCopies` report where each+ item is installed. Resolves IR-9.++### Changed++- `baikai-kit`: `KitConfig` gains the strict field `projectRoot`, so a record+ literal must set it; build the configuration with+ `kitConfig toolName repoUrl providers` instead and override fields with record+ update syntax. `KitConfig`'s `Show` instance is now hand-written and prints+ `<IO FilePath>` for the resolver. __Breaking__.++- `baikai-kit`: `kit status` conditions compose, and `dirty` is renamed+ `changed-upstream` (it meant the upstream sources changed without a version+ bump, not local edits); `dirty+outdated` now reads+ `outdated+changed-upstream`. `StatusRow.state :: KitState` is replaced by+ `StatusRow.conditions :: [KitCondition]` (sorted; empty means up to date),+ `renderState` by `conditionLabel` and `renderConditions`, and `classify`+ returns `[KitCondition]`. `KitUpToDate`, `KitDirty` and `KitDirtyOutdated`+ are gone; match on the list instead. __Breaking__.++- `baikai-kit`: `KitInstall` takes `Maybe Text` (`Nothing` asks the chooser),+ `kitCommandParser` takes the `KitConfig` (migration: `kitCommandParser`+ becomes `kitCommandParser myKitConfig`), `KitConfig` gains the `chooseItem`+ field (set by `kitConfig`), and `KitError` gains `KitItemNameRequired`.+ __Breaking__.++- `baikai-kit`: `KitList`, `KitStatus` and `KitUpdate` gain a trailing+ `OutputFormat` field (`HumanOutput` for the previous behaviour).+ __Breaking__.++## [baikai-effectful 0.4.0.2] - 2026-09-15++### Changed (dependencies)++- Requires `effectful-core ^>=2.7` (was `^>=2.6`). No API change: none of the+ 2.7 breaking APIs (`LocalEnv`'s second type parameter, `SharedSuffix`,+ `KnownEffects`, the ticked strict modules) are used.+ ## [baikai 0.7.0.0] - 2026-09-08 ### Added
baikai-claude.cabal view
@@ -1,27 +1,33 @@-cabal-version: 3.4-name: baikai-claude-version: 0.7.0.0-synopsis: Anthropic Claude providers for the baikai abstraction+cabal-version: 3.4+name: baikai-claude+version: 0.7.1.0+synopsis: Anthropic Claude providers for the baikai abstraction description: Anthropic backends for baikai: the Messages API over SSE, the claude -p batch provider, a launcher for interactive Claude Code sessions, and the renderer for unattended claude runs driven by baikai-agent. -category: AI-license: BSD-3-Clause-license-file: LICENSE-author: Nadeem Bitar-maintainer: nadeem@gmail.com-copyright: (c) 2026 Nadeem Bitar-build-type: Simple-tested-with: GHC ==9.12.4+category: AI+license: BSD-3-Clause+license-file: LICENSE+author: Nadeem Bitar+maintainer: nadeem@gmail.com+copyright: (c) 2026 Nadeem Bitar+build-type: Simple+tested-with: ghc ==9.12.4 extra-doc-files: CHANGELOG.md common common-options ghc-options:- -Wall -Wcompat -Widentities -Wincomplete-uni-patterns- -Wincomplete-record-updates -Wredundant-constraints- -fhide-source-paths -Wmissing-export-lists -Wpartial-fields+ -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ -fhide-source-paths+ -Wmissing-export-lists+ -Wpartial-fields -Wmissing-deriving-strategies -- Exhaustiveness is an error, not a warning. A non-exhaustive match@@ -36,10 +42,11 @@ -- fail the build on warnings that are stylistic or that a future GHC -- invents, and would push people toward blanket suppression. ghc-options:- -Werror=incomplete-patterns -Werror=incomplete-uni-patterns+ -Werror=incomplete-patterns+ -Werror=incomplete-uni-patterns -Werror=incomplete-record-updates - default-language: GHC2024+ default-language: GHC2024 default-extensions: DeriveAnyClass DuplicateRecordFields@@ -47,8 +54,8 @@ OverloadedStrings library- import: common-options- hs-source-dirs: src+ import: common-options+ hs-source-dirs: src exposed-modules: Baikai.Provider.Claude.Agent Baikai.Provider.Claude.Api@@ -61,38 +68,38 @@ Baikai.Provider.Claude.Sse Baikai.Provider.Claude.Transport - other-modules: Paths_baikai_claude+ other-modules: Paths_baikai_claude autogen-modules: Paths_baikai_claude build-depends:- , aeson ^>=2.2- , baikai ^>=0.7.0- , base >=4.20 && <5- , base16-bytestring ^>=1.0- , base64-bytestring ^>=1.2- , bytestring ^>=0.12- , case-insensitive ^>=1.2- , claude ^>=1.5- , containers ^>=0.7- , cradle ^>=0.0- , cryptohash-sha256 ^>=0.11- , crypton >=1.0 && <1.2- , generic-lens ^>=2.3- , http-client ^>=0.7- , http-client-tls >=0.3 && <0.5- , http-types ^>=0.12- , lens ^>=5.3- , servant-client ^>=0.20- , streamly >=0.11 && <0.13- , streamly-core >=0.3 && <0.5- , text ^>=2.1- , time ^>=1.14- , vector ^>=0.13+ aeson ^>=2.2,+ baikai ^>=0.7.2,+ base >=4.20 && <5,+ base16-bytestring ^>=1.0,+ base64-bytestring ^>=1.2,+ bytestring ^>=0.12,+ case-insensitive ^>=1.2,+ claude ^>=1.5,+ containers ^>=0.7,+ cradle ^>=0.0,+ cryptohash-sha256 ^>=0.11,+ crypton >=1.0 && <1.2,+ generic-lens ^>=2.3,+ http-client ^>=0.7,+ http-client-tls >=0.3 && <0.5,+ http-types ^>=0.12,+ lens ^>=5.3,+ servant-client ^>=0.20,+ streamly >=0.11 && <0.13,+ streamly-core >=0.3 && <0.5,+ text ^>=2.1,+ time ^>=1.14,+ vector ^>=0.13, test-suite baikai-claude-test- import: common-options- type: exitcode-stdio-1.0+ import: common-options+ type: exitcode-stdio-1.0 hs-source-dirs: test- main-is: Main.hs+ main-is: Main.hs other-modules: CliEvidenceSpec Contract@@ -104,35 +111,39 @@ PublicSurfaceSpec ShapeSpec SseSpec+ StructuredCliSpec ThinkingSpec TransportSpec -- cradle (used by Baikai.Provider.Claude.Interactive) requires the threaded RTS.- ghc-options: -threaded -with-rtsopts=-N+ ghc-options:+ -threaded+ -with-rtsopts=-N+ build-depends:- , aeson- , baikai ^>=0.7.0- , baikai-claude- , base >=4.20 && <5- , bytestring- , case-insensitive- , claude- , containers- , directory- , filepath- , generic-lens- , http-client- , http-types- , lens ^>=5.3- , network- , servant-client- , stm- , streamly- , streamly-core >=0.3 && <0.5- , tasty- , tasty-hunit- , temporary- , text ^>=2.1- , time- , tls- , vector+ aeson,+ baikai ^>=0.7.2,+ baikai-claude,+ base >=4.20 && <5,+ bytestring,+ case-insensitive,+ claude,+ containers,+ directory,+ filepath,+ generic-lens,+ http-client,+ http-types,+ lens ^>=5.3,+ network,+ servant-client,+ stm,+ streamly,+ streamly-core >=0.3 && <0.5,+ tasty,+ tasty-hunit,+ temporary,+ text ^>=2.1,+ time,+ tls,+ vector,
src/Baikai/Provider/Claude/Api.hs view
@@ -38,6 +38,7 @@ import Baikai.Provider.Claude.Internal.Request (describeThinkingFor) import Baikai.Provider.Claude.Internal.Stream (claudeMessagesStreamWith, liveSseDriver) import Baikai.Provider.Registry (registerApiProvider)+import Baikai.ResponseFormat (declaredStructuredOutput) import Baikai.Stream.Event (AssistantMessageEvent) import Control.Lens ((&), (.~)) import Data.Generics.Labels ()@@ -59,6 +60,7 @@ -- the gate's answer and the wire's behaviour cannot disagree. & #describeThinking .~ describeThinkingFor & #strengthCeiling .~ Ev.declaredStrength AnthropicMessages+ & #structuredOutput .~ declaredStructuredOutput AnthropicMessages -- | Streaming producer for the Anthropic Messages API. --
src/Baikai/Provider/Claude/Cli.hs view
@@ -21,6 +21,19 @@ -- not which model served the request, so a successful exit never -- raises the recorded 'Baikai.Evidence.EvidenceStrength' — see -- 'Baikai.Provider.Cli.Internal.subprocessStrength'.+--+-- Structured output: a 'Baikai.ResponseFormat.JsonSchema' in+-- 'Baikai.Options.responseFormat' is passed as @--json-schema '<schema>'@+-- (compact JSON). The tool answers through its internal+-- @StructuredOutput@ tool and the response text is the validated value:+-- the result's @result@ string verbatim when it decodes to the same+-- value as @structured_output@, otherwise the compact encoding of+-- @structured_output@. A successful run with no @structured_output@ is a+-- 'Baikai.Error.DecodeFailure'. An installed @claude@ too old to know+-- the flag yields an 'Baikai.Error.InvalidRequest' error carrying the+-- exit code, never unconstrained text. 'Baikai.ResponseFormat.JsonObject'+-- and the schema's @name@ and @strict@ have no CLI analogue and are not+-- forwarded. module Baikai.Provider.Claude.Cli ( ClaudeCliConfig, executable,@@ -37,7 +50,7 @@ import Baikai.Api (Api (..)) import Baikai.Content (AssistantContent (..), TextContent (..)) import Baikai.Context (Context)-import Baikai.Error (BaikaiError, processError, providerError)+import Baikai.Error (BaikaiError, decodeError, processError, providerError) import Baikai.Evidence qualified as Ev import Baikai.Evidence.Build qualified as Build import Baikai.Message (AssistantPayload (..))@@ -50,6 +63,7 @@ registerApiProvider, ) import Baikai.Response qualified as Resp+import Baikai.ResponseFormat (ResponseFormat (..), declaredStructuredOutput) import Baikai.StopReason (StopReason (..)) import Baikai.Stream (liftCompleteToStream) import Baikai.ThinkingLevel (ThinkingLevel (ThinkingMinimal), renderThinkingLevel)@@ -66,10 +80,13 @@ setNoStdin, setWorkingDir, )+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy qualified as LBS import Data.Generics.Labels () import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime) import Data.Vector qualified as Vector import GHC.Generics (Generic)@@ -116,6 +133,7 @@ -- control is a command-line flag derived from Options alone. & #describeThinking .~ (\_ opts -> claudeCliThinking opts) & #strengthCeiling .~ Ev.declaredStrength AnthropicMessagesCli+ & #structuredOutput .~ declaredStructuredOutput AnthropicMessagesCli -- | Render the executable and arguments for a @claude -p@ batch call. -- The prompt is preceded by @--@ so dash-leading prompts and variadic@@ -128,10 +146,36 @@ <> ["--output-format", "json", "--no-session-persistence"] <> systemPromptArgs ctx <> effortArgs opts+ <> schemaArgs opts <> fmap Text.unpack (cfg ^. #extraArgs) <> ["--", Text.unpack (Internal.renderPrompt ctx)] ) +-- | Render @--json-schema@ from a 'JsonSchema' response format, as the+-- schema's compact JSON. Every other format renders nothing.+schemaArgs :: Options -> [String]+schemaArgs opts = case opts ^. #responseFormat of+ Just (JsonSchema f) -> ["--json-schema", compactJson (f ^. #schema)]+ _ -> []++compactJson :: Aeson.Value -> String+compactJson = Text.unpack . Internal.decodeUtf8Lenient . LBS.toStrict . Aeson.encode++-- | The response text for a run given @--json-schema@.+--+-- The @result@ string is kept byte for byte when it is a JSON copy of+-- @structured_output@; otherwise the enforced value wins, encoded+-- compactly. No @structured_output@ at all means the tool did not+-- answer through the schema, and returning its prose would be the+-- silent fallback the caller asked not to get.+structuredBody :: Internal.ClaudeCliReport -> Either BaikaiError Text+structuredBody r = case r ^. #structuredOutput of+ Nothing ->+ Left (decodeError "claude -p: --json-schema was sent but the result has no structured_output")+ Just v+ | Aeson.decodeStrict (Text.encodeUtf8 (r ^. #result)) == Just v -> Right (r ^. #result)+ | otherwise -> Right (Internal.decodeUtf8Lenient (LBS.toStrict (Aeson.encode v)))+ -- | Render @--effort@ from 'Options.thinking'. Claude's @--effort@ has -- no @minimal@, so the lowest Baikai level collapses to @low@; when -- 'thinking' is unset, no effort flag is emitted.@@ -213,19 +257,31 @@ ev <- evidenceFor mReport Ev.CallFailed (Just err) let resp = Resp.errorResponse m end (millisBetween start end) err pure resp {Resp.evidence = ev, Resp.responseId = mReport >>= (^. #sessionId)}+ succeeded r = do+ ev <- evidenceFor (Just r) Ev.CallSucceeded Nothing+ let resp = mkResponse m start end r+ pure resp {Resp.evidence = ev}+ schemaRequested = not (null (schemaArgs opts)) case executed of Left ex -> failedWith Nothing (exceptionToError ex) Right (exitCode, StdoutRaw out, StderrRaw err) -> case exitCode of- ExitFailure n -> failedWith Nothing (processError n (Internal.decodeUtf8Lenient err))+ ExitFailure n ->+ let stderr = Internal.decodeUtf8Lenient err+ flagRejected+ | schemaRequested = Internal.unsupportedFlagError "claude" "--json-schema" n stderr+ | otherwise = Nothing+ in failedWith Nothing (fromMaybe (processError n stderr) flagRejected) ExitSuccess -> case Internal.decodeClaudeCliResult out of Left e -> failedWith Nothing e- Right r ->- if r ^. #isError- then failedWith (Just r) (providerError (r ^. #result))- else do- ev <- evidenceFor (Just r) Ev.CallSucceeded Nothing- let resp = mkResponse m start end r- pure resp {Resp.evidence = ev}+ Right r+ | r ^. #isError -> failedWith (Just r) (providerError (r ^. #result))+ | schemaRequested -> case structuredBody r of+ Left e -> failedWith (Just r) e+ -- The body replaces 'result' before either the response+ -- or its commitment is built, so the commitment covers+ -- exactly the text the caller receives.+ Right body -> succeeded (r & #result .~ body)+ | otherwise -> succeeded r -- | Fill in what the tool reported and what baikai knows about the -- process it launched.
src/Baikai/Provider/Claude/Internal/Request.hs view
@@ -367,13 +367,13 @@ let e = adaptiveEffort lvl in ( ThinkingPlan { field = Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized),- effort = e,+ effort = Just e, budget = Nothing }, ThinkingTranslation { requested = Just lvl, mode = ThinkingModeAdaptive,- effortText = e,+ effortText = Just e, budgetTokens = Nothing, wireField = Just "thinking", displayText = Just "summarized",@@ -400,30 +400,33 @@ } ) -adaptiveEffort :: ThinkingLevel -> Maybe Text+-- | The effort word sent for each level on the adaptive style.+--+-- Every level sends a word, @high@ included. Anthropic's defaults differ+-- by model (Claude Opus 5.5 defaults to @medium@, other adaptive models+-- to @high@; see+-- <https://platform.claude.com/docs/en/build-with-claude/effort>), so an+-- omitted field does not mean @high@. Sending a model's default+-- explicitly is documented as identical to omitting it.+adaptiveEffort :: ThinkingLevel -> Text adaptiveEffort = \case- ThinkingMinimal -> Just "low"- ThinkingLow -> Just "low"- ThinkingMedium -> Just "medium"- ThinkingHigh -> Nothing- ThinkingXHigh -> Just "xhigh"- ThinkingMax -> Just "max"+ ThinkingMinimal -> "low"+ ThinkingLow -> "low"+ ThinkingMedium -> "medium"+ ThinkingHigh -> "high"+ ThinkingXHigh -> "xhigh"+ ThinkingMax -> "max" -- | What Anthropic's adaptive vocabulary did to the requested level. -- -- Derived from what 'adaptiveEffort' actually produced rather than from--- a second table beside it, so the two cannot drift. 'Nothing' means no--- effort field is sent at all, which leaves the request--- wire-indistinguishable from a caller who expressed no preference and--- took Anthropic's own default depth. An effort word that differs from--- the level's canonical name is a clamp onto the nearest word the--- adaptive vocabulary has — Anthropic's has no @minimal@.-adaptiveAdjustments :: ThinkingLevel -> Maybe Text -> [ThinkingAdjustment]-adaptiveAdjustments lvl = \case- Nothing -> [EffortOmitted lvl]- Just wire- | wire == renderThinkingLevel lvl -> []- | otherwise -> [EffortClamped lvl wire]+-- a second table beside it, so the two cannot drift. An effort word that+-- differs from the level's canonical name is a clamp onto the nearest+-- word the adaptive vocabulary has — Anthropic's has no @minimal@.+adaptiveAdjustments :: ThinkingLevel -> Text -> [ThinkingAdjustment]+adaptiveAdjustments lvl wire+ | wire == renderThinkingLevel lvl = []+ | otherwise = [EffortClamped lvl wire] -- | Record that, after all, nothing about thinking reached the wire. --
test/FableContractsSpec.hs view
@@ -3,7 +3,7 @@ module FableContractsSpec (tests) where import Baikai hiding (messages, model)-import Baikai.Models.Generated (anthropic_claude_fable_5_1)+import Baikai.Models.Generated (anthropic_claude_fable_5_1, anthropic_claude_opus_5_5, anthropic_claude_sonnet_5_5) import Baikai.Provider.Claude.Internal.Request qualified as R import Baikai.Provider.Claude.Internal.Stream (SseDriver, claudeMessagesStreamWith) import Claude.V1.Messages qualified as C@@ -27,6 +27,32 @@ testGroup "Fable contracts" [ summaryTests,+ testCase "Opus 5.5 and Sonnet 5.5 reject forced tools and replay signed empty thinking" $+ forM_ [anthropic_claude_opus_5_5, anthropic_claude_sonnet_5_5] $ \opus -> do+ opus.api @?= AnthropicMessages+ forM_ [ToolChoiceRequired, ToolChoiceSpecific "lookup"] $ \choice ->+ case R.mapRequest opus context (options & #toolChoice .~ Just choice) of+ Left _ -> pure ()+ Right _ -> assertFailure (T.unpack opus.modelId <> " accepted forced tool choice")+ forM_ [(ToolChoiceAuto, "auto"), (ToolChoiceNone, "none")] $ \(choice, expected) -> do+ body <- newIORef Null+ let capture call _ emit = writeIORef body (call ^. #requestBody) >> send finalTurn emit+ _ <- streamingComplete (claudeMessagesStreamWith capture) opus context (options & #toolChoice .~ Just choice)+ raw <- readIORef body+ (field "tool_choice" raw >>= field "type") @?= Just (String expected)+ let response =+ emptyResponse+ & #message . #content .~ V.fromList [AssistantThinking (emptyThinkingContent & #signature .~ Just "sig-one"), AssistantToolCall (ToolCall "toolu_1" "lookup" (object []))]+ & #message . #stopReason .~ ToolUse+ next <- appendToolResult context response (\_ -> pure (toolResultText "found"))+ (req, _) <- either (\e -> assertFailure (T.unpack e) >> fail "map") pure (R.mapRequest opus next options)+ let raw = Aeson.toJSON req+ replayed = messages raw+ (firstReq, _) <- either (\e -> assertFailure (T.unpack e) >> fail "map") pure (R.mapRequest opus context options)+ field "system" raw @?= field "system" (Aeson.toJSON firstReq)+ field "tools" raw @?= field "tools" (Aeson.toJSON firstReq)+ contentAt 1 replayed @?= V.fromList [signed "" "sig-one", toolItem "toolu_1"]+ field "tool_use_id" (contentAt 2 replayed V.! 0) @?= Just (String "toolu_1"), testCase "forced choices fail before the driver for complete and stream, including renamed models" $ forM_ [model, model & #modelId .~ "renamed-generation"] $ \m -> forM_ [ToolChoiceRequired, ToolChoiceSpecific "lookup"] $ \choice -> do
test/Main.hs view
@@ -37,6 +37,7 @@ import ShapeSpec qualified import SseSpec qualified import Streamly.Data.Stream qualified as Stream+import StructuredCliSpec qualified import System.Directory (getPermissions, getTemporaryDirectory, setOwnerExecutable, setPermissions) import System.Environment (lookupEnv, setEnv, unsetEnv) import System.FilePath ((</>))@@ -84,6 +85,7 @@ PublicSurfaceSpec.tests, ShapeSpec.tests, SseSpec.tests,+ StructuredCliSpec.tests, ThinkingSpec.tests, TransportSpec.tests ]
+ test/StructuredCliSpec.hs view
@@ -0,0 +1,223 @@+-- | Structured-output passthrough for the @claude -p@ subprocess+-- provider.+--+-- The process cases run a real child process: a few lines of @sh@+-- written into a temporary directory that record the argument vector,+-- print a canned stdout and stderr, and exit with a chosen code. The+-- argument vector is rendered by 'ClaudeCli.claudeCliCommand', spawned+-- by the real provider, and decoded by the real parser.+module StructuredCliSpec (tests) where++import Baikai+import Baikai.Provider.Claude.Cli qualified as ClaudeCli+import Control.Lens ((&), (.~), (^.))+import Data.Aeson ((.=))+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy qualified as LBS+import Data.Generics.Labels ()+import Data.List (isPrefixOf)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Text.IO qualified as TextIO+import Data.Vector qualified as Vector+import System.Directory (getPermissions, setOwnerExecutable, setPermissions)+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))++tests :: TestTree+tests =+ testGroup+ "StructuredCliSpec: claude -p --json-schema passthrough"+ [ renderingTests,+ processTests,+ testCase "the provider declares NativeJsonSchema without spawning anything" $+ ClaudeCli.claudeCliProvider ClaudeCli.defaultClaudeCliConfig ^. #structuredOutput+ @?= NativeJsonSchema+ ]++-- ============================================================+-- Pure argument rendering+-- ============================================================++renderingTests :: TestTree+renderingTests =+ testGroup+ "argument rendering"+ [ testCase "JsonObject renders the same vector as no response format" $+ render (emptyOptions & #responseFormat .~ Just JsonObject) @?= render emptyOptions,+ testCase "no response format renders no --json-schema" $+ assertBool "no schema flag" ("--json-schema" `notElem` snd (render emptyOptions)),+ testCase "JsonSchema renders --json-schema <compact schema> before the extra args" $ do+ let (_, args) = render schemaOptions+ case break (== "--json-schema") args of+ (_, "--json-schema" : value : rest) -> do+ Aeson.decode (LBS.fromStrict (Text.encodeUtf8 (Text.pack value))) @?= Just itemsSchema+ assertBool+ ("extra args follow the schema: " <> show rest)+ (["--allowedTools", "Read"] `isPrefixOf` rest)+ _ -> assertFailure ("no --json-schema in " <> show args)+ ]+ where+ cfg =+ ClaudeCli.defaultClaudeCliConfig+ { ClaudeCli.executable = "/bin/claude",+ ClaudeCli.extraArgs = ["--allowedTools", "Read"]+ }+ render = ClaudeCli.claudeCliCommand cfg testModel testContext++-- ============================================================+-- A real child process+-- ============================================================++processTests :: TestTree+processTests =+ testGroup+ "fake claude process"+ [ testCase "a nested schema round-trips: the result text is returned byte for byte" $ do+ (resp, argv) <- runFake schemaOptions (Fake (resultEvent (Just conformingText) (Just conformingValue)) "" 0)+ responseError resp @?= Nothing+ flattenAssistantText (resp ^. #message . #content) @?= conformingText+ case break (== "--json-schema") argv of+ (_, "--json-schema" : value : _) ->+ Aeson.decode (LBS.fromStrict (Text.encodeUtf8 value)) @?= Just itemsSchema+ _ -> assertFailure ("the schema never reached the tool: " <> show argv),+ testCase "prose in result yields the compact structured_output instead" $ do+ (resp, _) <- runFake schemaOptions (Fake (resultEvent (Just "Here you go.") (Just conformingValue)) "" 0)+ responseError resp @?= Nothing+ let body = flattenAssistantText (resp ^. #message . #content)+ Aeson.decode (LBS.fromStrict (Text.encodeUtf8 body)) @?= Just conformingValue,+ testCase "a schema run without structured_output is a DecodeFailure" $ do+ (resp, _) <- runFake schemaOptions (Fake (resultEvent (Just conformingText) Nothing) "" 0)+ fmap (^. #category) (responseError resp) @?= Just DecodeFailure,+ testCase "claude rejecting --json-schema is InvalidRequest with the exit code" $ do+ (resp, _) <- runFake schemaOptions (Fake "" "error: unknown option '--json-schema'\n" 1)+ case responseError resp of+ Nothing -> assertFailure "expected an error-shaped response"+ Just e -> do+ e ^. #category @?= InvalidRequest+ e ^. #exitCode @?= Just 1+ assertBool (show (e ^. #message)) ("--json-schema" `Text.isInfixOf` (e ^. #message)),+ testCase "the same stderr without a schema request stays a ProcessFailure" $ do+ (resp, argv) <- runFake emptyOptions (Fake "" "error: unknown option '--json-schema'\n" 1)+ assertBool "no schema flag sent" ("--json-schema" `notElem` argv)+ fmap (^. #category) (responseError resp) @?= Just ProcessFailure+ ]++-- | What the fake prints and how it exits.+data Fake = Fake+ { stdoutBody :: LBS.ByteString,+ stderrBody :: Text,+ code :: Int+ }++runFake :: Options -> Fake -> IO (Response, [Text])+runFake opts fake =+ withSystemTempDirectory "baikai-claude-structured" $ \dir -> do+ let argvPath = dir </> "argv"+ outPath = dir </> "stdout"+ errPath = dir </> "stderr"+ LBS.writeFile outPath (stdoutBody fake)+ TextIO.writeFile errPath (stderrBody fake)+ exe <-+ writeFakeExecutable dir "claude" $+ unlines+ [ "#!/bin/sh",+ "printf '%s\\n' \"$@\" > '" <> argvPath <> "'",+ "cat '" <> outPath <> "'",+ "cat '" <> errPath <> "' >&2",+ "exit " <> show (code fake)+ ]+ reg <- newProviderRegistry+ registerApiProviderWith+ reg+ (ClaudeCli.claudeCliProvider ClaudeCli.defaultClaudeCliConfig {ClaudeCli.executable = exe})+ resp <- completeRequestWith reg testModel testContext opts+ argv <- Text.lines <$> TextIO.readFile argvPath+ pure (resp, argv)++writeFakeExecutable :: FilePath -> String -> String -> IO FilePath+writeFakeExecutable dir name body = do+ let path = dir </> name+ writeFile path body+ perms <- getPermissions path+ setPermissions path (setOwnerExecutable True perms)+ pure path++-- | A @result@ event in the shape Claude Code 2.1.285 emits for a+-- @--json-schema@ run.+resultEvent :: Maybe Text -> Maybe Aeson.Value -> LBS.ByteString+resultEvent body structured =+ Aeson.encode+ [ Aeson.object ["type" .= ("system" :: Text), "subtype" .= ("init" :: Text)],+ Aeson.object+ ( [ "type" .= ("result" :: Text),+ "subtype" .= ("success" :: Text),+ "is_error" .= False,+ "stop_reason" .= ("tool_use" :: Text),+ "session_id" .= ("01890000-0000-4000-8000-000000000002" :: Text)+ ]+ <> maybe [] (\b -> ["result" .= b]) body+ <> maybe [] (\v -> ["structured_output" .= v]) structured+ )+ ]++-- ============================================================+-- Fixtures+-- ============================================================++testModel :: Model+testModel =+ emptyModel+ & #modelId .~ "sonnet"+ & #api .~ AnthropicMessagesCli+ & #provider .~ "anthropic"++testContext :: Context+testContext = emptyContext & #messages .~ Vector.singleton (user "List two fruits.")++schemaOptions :: Options+schemaOptions =+ emptyOptions & #responseFormat .~ Just (JsonSchema (jsonSchemaFormat "fruits" itemsSchema))++-- | An object holding an array of objects, one field an enum.+itemsSchema :: Aeson.Value+itemsSchema =+ Aeson.object+ [ "type" .= ("object" :: Text),+ "properties"+ .= Aeson.object+ [ "items"+ .= Aeson.object+ [ "type" .= ("array" :: Text),+ "items"+ .= Aeson.object+ [ "type" .= ("object" :: Text),+ "properties"+ .= Aeson.object+ [ "label" .= Aeson.object ["type" .= ("string" :: Text)],+ "level"+ .= Aeson.object+ [ "type" .= ("string" :: Text),+ "enum" .= (["low", "high"] :: [Text])+ ]+ ],+ "required" .= (["label", "level"] :: [Text]),+ "additionalProperties" .= False+ ]+ ]+ ],+ "required" .= (["items"] :: [Text]),+ "additionalProperties" .= False+ ]++conformingText :: Text+conformingText =+ "{\"items\":[{\"label\":\"Strawberry\",\"level\":\"low\"},{\"label\":\"Mango\",\"level\":\"high\"}]}"++conformingValue :: Aeson.Value+conformingValue =+ fromMaybe (error "conformingText is JSON") (Aeson.decodeStrict (Text.encodeUtf8 conformingText))
test/ThinkingSpec.hs view
@@ -41,6 +41,7 @@ translationTableTests, conditionalDowngradeTests, adaptiveHigherEffortTests,+ opus55HighTest, maxBudgetTest, explicitMaxTokensTest, handRolledUnclampedTest,@@ -77,9 +78,11 @@ ("claude-opus-4-7", anthropic_claude_opus_4_7, AnthropicThinkingAdaptive, False, True, False), ("claude-opus-4-8", anthropic_claude_opus_4_8, AnthropicThinkingAdaptive, False, True, True), ("claude-opus-5", anthropic_claude_opus_5, AnthropicThinkingAdaptive, False, True, True),+ ("claude-opus-5-5", anthropic_claude_opus_5_5, AnthropicThinkingAdaptive, False, False, True), ("claude-sonnet-4-5", anthropic_claude_sonnet_4_5, AnthropicThinkingBudget, True, True, False), ("claude-sonnet-4-6", anthropic_claude_sonnet_4_6, AnthropicThinkingAdaptive, True, True, False),- ("claude-sonnet-5", anthropic_claude_sonnet_5, AnthropicThinkingAdaptive, False, True, False)+ ("claude-sonnet-5", anthropic_claude_sonnet_5, AnthropicThinkingAdaptive, False, True, False),+ ("claude-sonnet-5-5", anthropic_claude_sonnet_5_5, AnthropicThinkingAdaptive, False, False, False) ] thinkingLevels :: [(String, ThinkingLevel)]@@ -152,14 +155,7 @@ ), (AnthropicThinkingAdaptive, ThinkingLow, Just "low", Nothing, []), (AnthropicThinkingAdaptive, ThinkingMedium, Just "medium", Nothing, []),- -- "high" sends no effort field at all, which on the wire is- -- indistinguishable from expressing no preference.- ( AnthropicThinkingAdaptive,- ThinkingHigh,- Nothing,- Nothing,- [EffortOmitted ThinkingHigh]- ),+ (AnthropicThinkingAdaptive, ThinkingHigh, Just "high", Nothing, []), (AnthropicThinkingAdaptive, ThinkingXHigh, Just "xhigh", Nothing, []), (AnthropicThinkingAdaptive, ThinkingMax, Just "max", Nothing, []) ]@@ -244,6 +240,29 @@ ] ] +-- | Claude Opus 5.5 defaults to @medium@ effort, so an omitted effort+-- field would silently run 'ThinkingHigh' at medium. The request must+-- carry @high@ explicitly, and the evidence must say so without an+-- adjustment a strict caller would be refused for.+opus55HighTest :: TestTree+opus55HighTest =+ testCase "Opus 5.5 high sends explicit high effort" $ do+ (req, t) <-+ mappedFor+ anthropic_claude_opus_5_5+ emptyContext+ (emptyOptions & #thinking .~ Just ThinkingHigh)+ requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)+ (req ^. #output_config >>= Messages.effort) @?= Just "high"+ t ^. #mode @?= ThinkingModeAdaptive+ t ^. #effortText @?= Just "high"+ t ^. #adjustments @?= []+ checkEvidenceRequirements+ (EvidenceRequired EvidenceRequestedOnly)+ (declaredStrength AnthropicMessages)+ t+ @?= []+ maxBudgetTest :: TestTree maxBudgetTest = testCase "manual max effort uses 32768 tokens with visible-output room" $ do@@ -301,17 +320,24 @@ mergedOutputConfigTest :: TestTree mergedOutputConfigTest =- testCase "adaptive effort merges with responseFormat output_config" $ do- let schema = Aeson.object ["type" Aeson..= ("object" :: Text.Text)]- opts =- emptyOptions- & #thinking .~ Just ThinkingMedium- & #responseFormat- .~ Just (JsonSchema (jsonSchemaFormat "answer" schema) {strict = True})- expected = (Messages.jsonSchemaConfig schema) {Messages.effort = Just "medium"}- req <- requestFor anthropic_claude_opus_4_6 opts- requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)- req ^. #output_config @?= Just expected+ testGroup+ "adaptive effort merges with responseFormat output_config"+ [ testCase (Text.unpack word) $ do+ let schema = Aeson.object ["type" Aeson..= ("object" :: Text.Text)]+ opts =+ emptyOptions+ & #thinking .~ Just level+ & #responseFormat+ .~ Just (JsonSchema (jsonSchemaFormat "answer" schema) {strict = True})+ expected = (Messages.jsonSchemaConfig schema) {Messages.effort = Just word}+ req <- requestFor model opts+ requestThinking req @?= Just (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)+ req ^. #output_config @?= Just expected+ | (model, level, word) <-+ [ (anthropic_claude_opus_4_6, ThinkingMedium, "medium"),+ (anthropic_claude_opus_5_5, ThinkingHigh, "high")+ ]+ ] explicitCompatOverridesDefaultTest :: TestTree explicitCompatOverridesDefaultTest =@@ -348,7 +374,7 @@ ThinkingMinimal -> Just "low" ThinkingLow -> Just "low" ThinkingMedium -> Just "medium"- ThinkingHigh -> Nothing+ ThinkingHigh -> Just "high" ThinkingXHigh -> Just "xhigh" ThinkingMax -> Just "max"