diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,17 @@ +1.3.0: + +- Add request support for Claude Opus 4.6 routing and speed controls: + - `inference_geo` on `CreateMessage` + - `speed` on `CreateMessage` with `SpeedStandard` / `SpeedFast` +- Add context management/compaction request types: + - `context_management` on `CreateMessage` + - `ContextManagementConfig`, `ContextManagementEdit` + - `CompactionTrigger` and `inputTokensTrigger` helper +- Add live API tests for: + - `inference_geo` + - `context_management` compaction (`compact-2026-01-12`) + - `speed = fast` (`fast-mode-2026-02-01`, including waitlist-gated handling) + 1.2.0: - Add `Thinking` type with `ThinkingAdaptive` and `ThinkingEnabled` constructors diff --git a/claude.cabal b/claude.cabal --- a/claude.cabal +++ b/claude.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: claude -version: 1.2.0 +version: 1.3.0 synopsis: Servant bindings to Anthropic's Claude API description: This package provides comprehensive and type-safe bindings to Anthropic's Claude API, providing both a Servant interface diff --git a/src/Claude/V1/Messages.hs b/src/Claude/V1/Messages.hs --- a/src/Claude/V1/Messages.hs +++ b/src/Claude/V1/Messages.hs @@ -13,6 +13,13 @@ , jsonSchemaConfig , jsonSchemaFormat , effortConfig + -- * Context management / compaction (beta) + , ContextManagementConfig(..) + , ContextManagementEdit(..) + , CompactionTrigger(..) + , inputTokensTrigger + -- * Request routing/speed + , Speed(..) -- * Thinking , Thinking(..) -- * Content types @@ -690,6 +697,93 @@ , format = Just $ jsonSchemaFormat s } +-- | Context management configuration (beta) +-- +-- This allows you to control context edits applied by the API. +-- Use 'ContextManagementEdit_Compact_20260112' to enable automatic compaction. +data ContextManagementConfig = ContextManagementConfig + { edits :: Vector ContextManagementEdit + -- ^ Context edits to apply + } deriving stock (Eq, Generic, Show) + +instance FromJSON ContextManagementConfig where + parseJSON = genericParseJSON aesonOptions + +instance ToJSON ContextManagementConfig where + toJSON = genericToJSON aesonOptions + +-- | Context management edit (beta) +data ContextManagementEdit + = ContextManagementEdit_Compact_20260112 + { instructions :: Maybe Text + -- ^ Additional instructions for summarization. + , pause_after_compaction :: Maybe Bool + -- ^ Whether to pause and return a compaction block after compaction. + , trigger :: Maybe CompactionTrigger + -- ^ Compaction trigger configuration. + } + deriving stock (Eq, Generic, Show) + +contextManagementEditOptions :: Options +contextManagementEditOptions = aesonOptions + { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + , tagSingleConstructors = True + , constructorTagModifier = \s -> case s of + "ContextManagementEdit_Compact_20260112" -> "compact_20260112" + _ -> s + } + +instance FromJSON ContextManagementEdit where + parseJSON = genericParseJSON contextManagementEditOptions + +instance ToJSON ContextManagementEdit where + toJSON = genericToJSON contextManagementEditOptions + +-- | Compaction trigger for context management. +-- +-- Currently, only @input_tokens@ triggers are supported. +data CompactionTrigger = CompactionTrigger_Input_Tokens + { value :: Natural + -- ^ Trigger threshold in input tokens. + } deriving stock (Eq, Generic, Show) + +compactionTriggerOptions :: Options +compactionTriggerOptions = aesonOptions + { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + , tagSingleConstructors = True + , constructorTagModifier = \s -> case s of + "CompactionTrigger_Input_Tokens" -> "input_tokens" + _ -> s + } + +instance FromJSON CompactionTrigger where + parseJSON = genericParseJSON compactionTriggerOptions + +instance ToJSON CompactionTrigger where + toJSON = genericToJSON compactionTriggerOptions + +-- | Convenience constructor for an @input_tokens@ compaction trigger. +inputTokensTrigger :: Natural -> CompactionTrigger +inputTokensTrigger n = CompactionTrigger_Input_Tokens{ value = n } + +-- | Inference speed mode. +-- +-- @"fast"@ is a research preview and may require an Anthropic beta header. +data Speed + = SpeedStandard + | SpeedFast + deriving stock (Eq, Generic, Show) + +instance FromJSON Speed where + parseJSON = Aeson.withText "Speed" $ \t -> case t of + "standard" -> pure SpeedStandard + "fast" -> pure SpeedFast + _ -> fail $ "Unknown speed mode: " <> show t + +instance ToJSON Speed where + toJSON SpeedStandard = Aeson.String "standard" + toJSON SpeedFast = Aeson.String "fast" + -- | Thinking configuration for extended thinking -- -- * 'ThinkingAdaptive': Let Claude decide when and how much to think (Opus 4.6+). @@ -752,6 +846,12 @@ , tools :: Maybe (Vector ToolDefinition) , tool_choice :: Maybe ToolChoice , container :: Maybe Text + , context_management :: Maybe ContextManagementConfig + -- ^ Context management configuration (beta), including automatic compaction edits. + , inference_geo :: Maybe Text + -- ^ Inference region routing hint, e.g. @"global"@ or @"us"@. + , speed :: Maybe Speed + -- ^ Inference speed mode. @SpeedFast@ may require a beta header. , output_config :: Maybe OutputConfig -- ^ Output configuration: effort level and/or structured output format. -- Use 'effortConfig', 'jsonSchemaConfig', or construct 'OutputConfig' directly. @@ -782,6 +882,9 @@ , tools = Nothing , tool_choice = Nothing , container = Nothing + , context_management = Nothing + , inference_geo = Nothing + , speed = Nothing , output_config = Nothing , thinking = Nothing } diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -15,10 +15,12 @@ import qualified Claude.V1.Messages as Messages import qualified Claude.V1.Tool as Tool import qualified Control.Concurrent as Concurrent +import qualified Control.Exception as Exception import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as Aeson.Types import Data.Foldable (toList) import qualified Data.IORef as IORef +import qualified Data.List as List import Data.Maybe (mapMaybe) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text @@ -417,6 +419,106 @@ HUnit.assertBool "Expected non-empty streamed text" (not (Text.null text)) + let inferenceGeoLiveTest = + HUnit.testCase "Create message - inference_geo" do + Messages.MessageResponse{ content } <- + createMessage + Messages._CreateMessage + { Messages.model = "claude-opus-4-6" + , Messages.messages = + [ Messages.Message + { Messages.role = Messages.User + , Messages.content = + [ Messages.textContent "Respond with exactly: geotest" + ] + , Messages.cache_control = Nothing + } + ] + , Messages.max_tokens = 64 + , Messages.inference_geo = Just "us" + } + + HUnit.assertBool "Response should have content" + (not (null content)) + + let compactionOptions = V1.defaultClientOptions + { V1.apiKey = Text.pack key + , V1.anthropicBeta = Just "compact-2026-01-12" + } + let V1.Methods{ V1.createMessage = createMessageCompaction } = + V1.makeMethodsWith clientEnv compactionOptions + + let compactionLiveTest = + HUnit.testCase "Create message - context_management compaction" do + Messages.MessageResponse{ content } <- + createMessageCompaction + Messages._CreateMessage + { Messages.model = "claude-opus-4-6" + , Messages.messages = + [ Messages.Message + { Messages.role = Messages.User + , Messages.content = + [ Messages.textContent "Respond with exactly: compaction-ok" + ] + , Messages.cache_control = Nothing + } + ] + , Messages.max_tokens = 64 + , Messages.context_management = Just Messages.ContextManagementConfig + { Messages.edits = + [ Messages.ContextManagementEdit_Compact_20260112 + { Messages.instructions = Just "Preserve key facts only" + , Messages.pause_after_compaction = Nothing + , Messages.trigger = Just (Messages.inputTokensTrigger 150000) + } + ] + } + } + + HUnit.assertBool "Response should have content" + (not (null content)) + + let fastModeOptions = V1.defaultClientOptions + { V1.apiKey = Text.pack key + , V1.anthropicBeta = Just "fast-mode-2026-02-01" + } + let V1.Methods{ V1.createMessage = createMessageFast } = + V1.makeMethodsWith clientEnv fastModeOptions + + let fastModeLiveTest = + HUnit.testCase "Create message - speed fast" do + result <- + Exception.try + (createMessageFast + Messages._CreateMessage + { Messages.model = "claude-opus-4-6" + , Messages.messages = + [ Messages.Message + { Messages.role = Messages.User + , Messages.content = + [ Messages.textContent "Respond with exactly: fast-mode-ok" + ] + , Messages.cache_control = Nothing + } + ] + , Messages.max_tokens = 64 + , Messages.speed = Just Messages.SpeedFast + } + ) + :: IO (Either Exception.SomeException Messages.MessageResponse) + + case result of + Right Messages.MessageResponse{ content } -> + HUnit.assertBool "Response should have content" (not (null content)) + Left err -> do + let errMsg = show err + -- Fast mode is waitlist-gated. In orgs without fast capacity, + -- Anthropic returns a 429 with fast token limits set to 0. + if "rate limit of 0 input tokens per minute" `List.isInfixOf` errMsg + || "anthropic-fast-input-tokens-limit\",\"0\"" `List.isInfixOf` errMsg + then pure () + else HUnit.assertFailure $ "Unexpected fast mode failure: " <> errMsg + -- Tool search test requires beta header let betaOptions = V1.defaultClientOptions { V1.apiKey = Text.pack key @@ -637,6 +739,9 @@ , strictToolUseTest , adaptiveThinkingTest , adaptiveThinkingStreamingTest + , inferenceGeoLiveTest + , compactionLiveTest + , fastModeLiveTest , toolSearchTest , programmaticToolCallingTest ]