diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 ''` 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 ` 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 + `./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 + `` 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 diff --git a/baikai-claude.cabal b/baikai-claude.cabal --- a/baikai-claude.cabal +++ b/baikai-claude.cabal @@ -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, diff --git a/src/Baikai/Provider/Claude/Api.hs b/src/Baikai/Provider/Claude/Api.hs --- a/src/Baikai/Provider/Claude/Api.hs +++ b/src/Baikai/Provider/Claude/Api.hs @@ -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. -- diff --git a/src/Baikai/Provider/Claude/Cli.hs b/src/Baikai/Provider/Claude/Cli.hs --- a/src/Baikai/Provider/Claude/Cli.hs +++ b/src/Baikai/Provider/Claude/Cli.hs @@ -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 ''@ +-- (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. diff --git a/src/Baikai/Provider/Claude/Internal/Request.hs b/src/Baikai/Provider/Claude/Internal/Request.hs --- a/src/Baikai/Provider/Claude/Internal/Request.hs +++ b/src/Baikai/Provider/Claude/Internal/Request.hs @@ -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 +-- ), 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. -- diff --git a/test/FableContractsSpec.hs b/test/FableContractsSpec.hs --- a/test/FableContractsSpec.hs +++ b/test/FableContractsSpec.hs @@ -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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 ] diff --git a/test/StructuredCliSpec.hs b/test/StructuredCliSpec.hs new file mode 100644 --- /dev/null +++ b/test/StructuredCliSpec.hs @@ -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 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)) diff --git a/test/ThinkingSpec.hs b/test/ThinkingSpec.hs --- a/test/ThinkingSpec.hs +++ b/test/ThinkingSpec.hs @@ -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"