diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,17 @@ +1.5.0: + +- Add Claude 5 Messages API support: + - `thinking.display` with summarized and omitted output modes + - `thinking: { "type": "disabled" }` + - refusal `stop_details` and `pause_turn` stop reasons +- Add beta server-side fallback request and response types: + - default and explicit fallback chains + - fallback transition content blocks + - per-iteration usage +- Add beta mid-conversation tool changes with system messages and tool + addition/removal content blocks +- Add live API coverage for Claude Sonnet 5, Claude Opus 5, and Claude Fable 5 + 1.4.0: - Expand prompt caching support: diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -24,7 +24,7 @@ let Methods{ createMessage } = makeMethods clientEnv (Text.pack key) (Just "2023-06-01") MessageResponse{ content } <- createMessage _CreateMessage - { model = "claude-sonnet-4-5-20250929" + { model = "claude-sonnet-5" , messages = [ Message{ role = User, content = [ textContent "Hello!" ] } ] , max_tokens = 1024 } @@ -45,7 +45,7 @@ ```haskell MessageResponse{ usage } <- createMessage _CreateMessage - { model = "claude-sonnet-4-5-20250929" + { model = "claude-sonnet-5" , max_tokens = 1024 , cache_control = Just (ephemeralCacheWithTTLDuration "1h") , system = Just $ systemBlocks 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.4.0 +version: 1.5.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/examples/claude-programmatic-tool-calling-example/Main.hs b/examples/claude-programmatic-tool-calling-example/Main.hs --- a/examples/claude-programmatic-tool-calling-example/Main.hs +++ b/examples/claude-programmatic-tool-calling-example/Main.hs @@ -249,6 +249,8 @@ Text.IO.putStrLn " [Thinking]" printContentBlock (Messages.ContentBlock_Redacted_Thinking{}) = Text.IO.putStrLn " [Redacted thinking]" +printContentBlock (Messages.ContentBlock_Fallback{}) = + Text.IO.putStrLn " [Fallback]" printContentBlock (Messages.ContentBlock_Unknown{ Messages.type_ = t }) = Text.IO.putStrLn $ " [Unknown] " <> t diff --git a/examples/claude-tool-example/Main.hs b/examples/claude-tool-example/Main.hs --- a/examples/claude-tool-example/Main.hs +++ b/examples/claude-tool-example/Main.hs @@ -190,5 +190,7 @@ Text.IO.putStrLn "[Thinking]" printContent (Messages.ContentBlock_Redacted_Thinking{}) = Text.IO.putStrLn "[Redacted thinking]" +printContent (Messages.ContentBlock_Fallback{}) = + Text.IO.putStrLn "[Fallback]" printContent (Messages.ContentBlock_Unknown{ Messages.type_ = t }) = Text.IO.putStrLn $ "[Unknown block type: " <> t <> "]" diff --git a/examples/claude-tool-search-example/Main.hs b/examples/claude-tool-search-example/Main.hs --- a/examples/claude-tool-search-example/Main.hs +++ b/examples/claude-tool-search-example/Main.hs @@ -194,5 +194,7 @@ Text.IO.putStrLn " [thinking]" printContent (Messages.ContentBlock_Redacted_Thinking{}) = Text.IO.putStrLn " [redacted_thinking]" +printContent (Messages.ContentBlock_Fallback{}) = + Text.IO.putStrLn " [fallback]" printContent (Messages.ContentBlock_Unknown{ Messages.type_ = t }) = Text.IO.putStrLn $ " [unknown] type: " <> t 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 @@ -20,11 +20,17 @@ , inputTokensTrigger -- * Request routing/speed , Speed(..) + , Fallback(..) + , Fallbacks(..) -- * Thinking , Thinking(..) + , ThinkingDisplay(..) -- * Content types , Content(..) , ContentBlock(..) + , ToolChangeReference(..) + , FallbackInfo(..) + , FallbackTrigger(..) , TextContent(..) , ImageSource(..) , ToolUseContent(..) @@ -34,7 +40,10 @@ , Role(..) -- * Response types , StopReason(..) + , StopDetails(..) , Usage(..) + , IterationUsage(..) + , OutputTokensDetails(..) , ServerToolUseUsage(..) -- * Tool search response types , ToolReference(..) @@ -124,16 +133,16 @@ , toolChoiceAny , toolChoiceAuto , toolChoiceTool - , withToolCacheControl , toolSearchBm25 , toolSearchRegex + , withToolCacheControl ) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KeyMap import Data.Time (UTCTime) -- | Role of a message participant -data Role = User | Assistant +data Role = User | Assistant | System deriving stock (Eq, Generic, Show) instance FromJSON Role where @@ -269,6 +278,19 @@ | Content_Tool_Result { tool_use_id :: Text, content :: Maybe Text, is_error :: Maybe Bool } | Content_Thinking { thinking :: Text, signature :: Text } | Content_Redacted_Thinking { data_ :: Text } + | Content_Tool_Addition + { tool :: ToolChangeReference + , cache_control :: Maybe CacheControl + } + | Content_Tool_Removal + { tool :: ToolChangeReference + , cache_control :: Maybe CacheControl + } + | Content_Fallback + { from_ :: FallbackInfo + , to :: FallbackInfo + , trigger :: FallbackTrigger + } deriving stock (Generic, Show) -- | Create a text content block without cache control @@ -324,8 +346,49 @@ Just Content_Thinking{ thinking = t, signature = sig } contentBlockToContent (ContentBlock_Redacted_Thinking d) = Just Content_Redacted_Thinking{ data_ = d } +contentBlockToContent (ContentBlock_Fallback fromModel toModel fallbackTrigger) = + Just Content_Fallback + { from_ = fromModel + , to = toModel + , trigger = fallbackTrigger + } contentBlockToContent ContentBlock_Unknown{} = Nothing +-- | A tool reference used by mid-conversation tool changes. +data ToolChangeReference + = ToolChangeReference { name :: Text } + | MCPToolChangeReference { server_name :: Text, name :: Text } + | MCPToolsetChangeReference { server_name :: Text } + deriving stock (Eq, Show) + +instance FromJSON ToolChangeReference where + parseJSON = Aeson.withObject "ToolChangeReference" $ \o -> do + t <- o Aeson..: "type" + case (t :: Text) of + "tool_reference" -> ToolChangeReference <$> o Aeson..: "name" + "mcp_tool_reference" -> + MCPToolChangeReference + <$> o Aeson..: "server_name" + <*> o Aeson..: "name" + "mcp_toolset_reference" -> + MCPToolsetChangeReference <$> o Aeson..: "server_name" + _ -> fail $ "Unknown tool change reference type: " <> show t + +instance ToJSON ToolChangeReference where + toJSON (ToolChangeReference n) = Aeson.object + [ "type" Aeson..= ("tool_reference" :: Text) + , "name" Aeson..= n + ] + toJSON (MCPToolChangeReference serverName n) = Aeson.object + [ "type" Aeson..= ("mcp_tool_reference" :: Text) + , "server_name" Aeson..= serverName + , "name" Aeson..= n + ] + toJSON (MCPToolsetChangeReference serverName) = Aeson.object + [ "type" Aeson..= ("mcp_toolset_reference" :: Text) + , "server_name" Aeson..= serverName + ] + -- | A reference to a tool found by tool search data ToolReference = ToolReference { tool_name :: Text @@ -492,6 +555,11 @@ } | ContentBlock_Thinking { thinking :: Text, signature :: Text } | ContentBlock_Redacted_Thinking { data_ :: Text } + | ContentBlock_Fallback + { from_ :: FallbackInfo + , to :: FallbackInfo + , trigger :: FallbackTrigger + } | ContentBlock_Unknown { type_ :: Text, raw :: Value } deriving stock (Generic, Show) @@ -528,6 +596,10 @@ <*> o Aeson..: "signature" "redacted_thinking" -> ContentBlock_Redacted_Thinking <$> o Aeson..: "data" + "fallback" -> ContentBlock_Fallback + <$> o Aeson..: "from" + <*> o Aeson..: "to" + <*> o Aeson..: "trigger" _ -> pure (ContentBlock_Unknown t (Aeson.Object o)) instance ToJSON ContentBlock where @@ -566,8 +638,37 @@ [ "type" Aeson..= ("redacted_thinking" :: Text) , "data" Aeson..= d ] + toJSON (ContentBlock_Fallback fromModel toModel fallbackTrigger) = Aeson.object + [ "type" Aeson..= ("fallback" :: Text) + , "from" Aeson..= fromModel + , "to" Aeson..= toModel + , "trigger" Aeson..= fallbackTrigger + ] toJSON (ContentBlock_Unknown _typeName rawVal) = rawVal +-- | A model participating in a server-side fallback transition. +data FallbackInfo = FallbackInfo + { model :: Text + } deriving stock (Eq, Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | The refusal that triggered a server-side fallback. +data FallbackTrigger = FallbackTrigger + { category :: Maybe Text + } deriving stock (Eq, Show) + +instance FromJSON FallbackTrigger where + parseJSON = Aeson.withObject "FallbackTrigger" $ \o -> do + t <- o Aeson..: "type" + if (t :: Text) == "refusal" + then FallbackTrigger <$> o Aeson..:? "category" + else fail $ "Unknown fallback trigger type: " <> show t + +instance ToJSON FallbackTrigger where + toJSON (FallbackTrigger fallbackCategory) = Aeson.object $ + [ "type" Aeson..= ("refusal" :: Text) + ] <> maybe [] (\c -> ["category" Aeson..= c]) fallbackCategory + -- | A message in the conversation -- -- The optional @cache_control@ field allows setting cache breakpoints at @@ -590,6 +691,7 @@ | Max_Tokens | Stop_Sequence | Tool_Use + | Pause_Turn | Refusal -- ^ Model refused the request for safety reasons | Model_Context_Window_Exceeded @@ -606,6 +708,27 @@ instance ToJSON StopReason where toJSON = genericToJSON stopReasonOptions +-- | Structured information returned when Claude refuses a request. +data StopDetails = StopDetails + { category :: Maybe Text + , explanation :: Maybe Text + } deriving stock (Eq, Show) + +instance FromJSON StopDetails where + parseJSON = Aeson.withObject "StopDetails" $ \o -> do + t <- o Aeson..: "type" + if (t :: Text) == "refusal" + then StopDetails + <$> o Aeson..:? "category" + <*> o Aeson..:? "explanation" + else fail $ "Unknown stop details type: " <> show t + +instance ToJSON StopDetails where + toJSON StopDetails{ category, explanation } = Aeson.object $ + [ "type" Aeson..= ("refusal" :: Text) + ] <> maybe [] (\c -> ["category" Aeson..= c]) category + <> maybe [] (\e -> ["explanation" Aeson..= e]) explanation + -- | Server tool use usage information (e.g., tool search requests, web search requests) data ServerToolUseUsage = ServerToolUseUsage { web_search_requests :: Maybe Natural @@ -618,6 +741,43 @@ instance ToJSON ServerToolUseUsage where toJSON = genericToJSON aesonOptions +-- | Breakdown of output tokens spent on internal reasoning. +data OutputTokensDetails = OutputTokensDetails + { thinking_tokens :: Natural + } deriving stock (Eq, Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Per-iteration usage returned by beta features such as server-side fallback. +data IterationUsage = IterationUsage + { iteration_type :: Text + , iteration_model :: Maybe Text + , iteration_input_tokens :: Maybe Natural + , iteration_output_tokens :: Maybe Natural + , iteration_cache_creation_input_tokens :: Maybe Natural + , iteration_cache_read_input_tokens :: Maybe Natural + } deriving stock (Eq, Generic, Show) + +instance FromJSON IterationUsage where + parseJSON = Aeson.withObject "IterationUsage" $ \o -> + IterationUsage + <$> o Aeson..: "type" + <*> o Aeson..:? "model" + <*> o Aeson..:? "input_tokens" + <*> o Aeson..:? "output_tokens" + <*> o Aeson..:? "cache_creation_input_tokens" + <*> o Aeson..:? "cache_read_input_tokens" + +instance ToJSON IterationUsage where + toJSON IterationUsage{..} = Aeson.object $ + [ "type" Aeson..= iteration_type + ] <> maybe [] (\m -> ["model" Aeson..= m]) iteration_model + <> maybe [] (\n -> ["input_tokens" Aeson..= n]) iteration_input_tokens + <> maybe [] (\n -> ["output_tokens" Aeson..= n]) iteration_output_tokens + <> maybe [] (\n -> ["cache_creation_input_tokens" Aeson..= n]) + iteration_cache_creation_input_tokens + <> maybe [] (\n -> ["cache_read_input_tokens" Aeson..= n]) + iteration_cache_read_input_tokens + -- | Token usage information data Usage = Usage { input_tokens :: Natural @@ -625,6 +785,11 @@ , cache_creation_input_tokens :: Maybe Natural , cache_read_input_tokens :: Maybe Natural , server_tool_use :: Maybe ServerToolUseUsage + , inference_geo :: Maybe Text + , output_tokens_details :: Maybe OutputTokensDetails + , service_tier :: Maybe Text + , speed :: Maybe Speed + , iterations :: Maybe (Vector IterationUsage) } deriving stock (Generic, Show) instance FromJSON Usage where @@ -646,6 +811,7 @@ , model :: Text , stop_reason :: Maybe StopReason , stop_sequence :: Maybe Text + , stop_details :: Maybe StopDetails , usage :: Usage , container :: Maybe ContainerInfo } deriving stock (Generic, Show) @@ -698,8 +864,8 @@ -- Good for simple tasks, classification, or high-volume use cases. -- * @"medium"@ — Balanced approach with moderate token savings. -- * @"high"@ — Full capability (the default when effort is omitted). +-- * @"xhigh"@ — Extended capability for long-horizon work on supported models. -- * @"max"@ — Absolute maximum capability, no constraints on token spending. --- Opus 4.6 only. -- -- Setting @"high"@ is equivalent to not setting effort at all. -- @@ -721,9 +887,8 @@ -- @ data OutputConfig = OutputConfig { effort :: Maybe Text - -- ^ Effort level: @"low"@, @"medium"@, @"high"@, or @"max"@. + -- ^ Effort level: @"low"@, @"medium"@, @"high"@, @"xhigh"@, or @"max"@. -- Controls token spend vs thoroughness. @"high"@ is the default. - -- @"max"@ is Opus 4.6 only. -- See , format :: Maybe OutputFormat -- ^ Structured output format (use 'jsonSchemaFormat' to construct) @@ -848,15 +1013,66 @@ toJSON SpeedStandard = Aeson.String "standard" toJSON SpeedFast = Aeson.String "fast" +-- | One model in a server-side fallback chain. +data Fallback = Fallback + { model :: Text + , max_tokens :: Maybe Natural + , output_config :: Maybe OutputConfig + , speed :: Maybe Speed + , thinking :: Maybe Thinking + } deriving stock (Eq, Generic, Show) + +instance FromJSON Fallback where + parseJSON = genericParseJSON aesonOptions + +instance ToJSON Fallback where + toJSON = genericToJSON aesonOptions + +-- | Server-side fallback configuration (beta). +data Fallbacks + = FallbacksDefault + | FallbacksModels (Vector Fallback) + deriving stock (Eq, Show) + +instance FromJSON Fallbacks where + parseJSON (Aeson.String "default") = pure FallbacksDefault + parseJSON (Aeson.Array models) = FallbacksModels <$> traverse Aeson.parseJSON models + parseJSON _ = fail "Fallbacks must be \"default\" or an array of fallback models" + +instance ToJSON Fallbacks where + toJSON FallbacksDefault = Aeson.String "default" + toJSON (FallbacksModels models) = Aeson.toJSON models + +-- | Controls whether readable thinking summaries are returned. +data ThinkingDisplay + = ThinkingSummarized + | ThinkingOmitted + deriving stock (Eq, Show) + +instance FromJSON ThinkingDisplay where + parseJSON = Aeson.withText "ThinkingDisplay" $ \t -> case t of + "summarized" -> pure ThinkingSummarized + "omitted" -> pure ThinkingOmitted + _ -> fail $ "Unknown thinking display: " <> show t + +instance ToJSON ThinkingDisplay where + toJSON ThinkingSummarized = Aeson.String "summarized" + toJSON ThinkingOmitted = Aeson.String "omitted" + -- | Thinking configuration for extended thinking -- --- * 'ThinkingAdaptive': Let Claude decide when and how much to think (Opus 4.6+). +-- * 'ThinkingAdaptive': Let Claude decide when and how much to think. -- Use the effort parameter ('effortConfig') to guide thinking depth. +-- * 'ThinkingAdaptiveWithDisplay': Adaptive thinking with summarized or omitted output. -- * 'ThinkingEnabled': Enable thinking with a fixed token budget --- (all models; deprecated on Opus 4.6). +-- (older models only). +-- * 'ThinkingDisabled': Disable thinking on models that support it. -- -- @ --- -- Adaptive thinking (recommended for Opus 4.6) +-- -- Adaptive thinking with readable summaries +-- thinking = Just $ ThinkingAdaptiveWithDisplay ThinkingSummarized +-- +-- -- Adaptive thinking with the model's default display behavior -- thinking = Just ThinkingAdaptive -- -- -- Manual thinking with budget (older models) @@ -864,26 +1080,52 @@ -- @ data Thinking = ThinkingAdaptive + | ThinkingAdaptiveWithDisplay { display :: ThinkingDisplay } | ThinkingEnabled { budget_tokens :: Natural } + | ThinkingEnabledWithDisplay + { budget_tokens :: Natural + , display :: ThinkingDisplay + } + | ThinkingDisabled deriving stock (Eq, Generic, Show) instance FromJSON Thinking where parseJSON = Aeson.withObject "Thinking" $ \o -> do t <- o Aeson..: "type" case (t :: Text) of - "adaptive" -> pure ThinkingAdaptive + "adaptive" -> do + display <- o Aeson..:? "display" + pure $ maybe ThinkingAdaptive ThinkingAdaptiveWithDisplay display "enabled" -> do budget <- o Aeson..: "budget_tokens" - pure ThinkingEnabled{ budget_tokens = budget } + display <- o Aeson..:? "display" + pure $ case display of + Nothing -> ThinkingEnabled{ budget_tokens = budget } + Just d -> ThinkingEnabledWithDisplay + { budget_tokens = budget + , display = d + } + "disabled" -> pure ThinkingDisabled _ -> fail $ "Unknown thinking type: " <> show t instance ToJSON Thinking where toJSON ThinkingAdaptive = Aeson.object [ "type" Aeson..= ("adaptive" :: Text) ] + toJSON (ThinkingAdaptiveWithDisplay thinkingDisplay) = Aeson.object + [ "type" Aeson..= ("adaptive" :: Text) + , "display" Aeson..= thinkingDisplay + ] toJSON (ThinkingEnabled budget) = Aeson.object [ "type" Aeson..= ("enabled" :: Text) , "budget_tokens" Aeson..= budget ] + toJSON (ThinkingEnabledWithDisplay budget thinkingDisplay) = Aeson.object + [ "type" Aeson..= ("enabled" :: Text) + , "budget_tokens" Aeson..= budget + , "display" Aeson..= thinkingDisplay + ] + toJSON ThinkingDisabled = Aeson.object + [ "type" Aeson..= ("disabled" :: Text) ] -- | Create a JSON schema output format jsonSchemaFormat :: Value -> OutputFormat @@ -923,8 +1165,9 @@ -- ^ Output configuration: effort level and/or structured output format. -- Use 'effortConfig', 'jsonSchemaConfig', or construct 'OutputConfig' directly. , thinking :: Maybe Thinking - -- ^ Thinking configuration. Use 'ThinkingAdaptive' for Opus 4.6 - -- or 'ThinkingEnabled' with @budget_tokens@ for older models. + -- ^ Thinking configuration. Claude 5 models default to adaptive thinking. + , fallbacks :: Maybe Fallbacks + -- ^ Server-side refusal fallback configuration (beta). } deriving stock (Generic, Show) instance FromJSON CreateMessage where @@ -955,6 +1198,7 @@ , speed = Nothing , output_config = Nothing , thinking = Nothing + , fallbacks = Nothing } -- | Text delta in streaming @@ -1004,6 +1248,7 @@ data MessageDelta = MessageDelta { stop_reason :: Maybe StopReason , stop_sequence :: Maybe Text + , stop_details :: Maybe StopDetails } deriving stock (Generic, Show) instance FromJSON MessageDelta where @@ -1014,14 +1259,38 @@ -- | Usage in streaming message_delta events data StreamUsage = StreamUsage - { output_tokens :: Natural - } deriving stock (Generic, Show) + { stream_input_tokens :: Maybe Natural + , output_tokens :: Natural + , stream_cache_creation_input_tokens :: Maybe Natural + , stream_cache_read_input_tokens :: Maybe Natural + , stream_server_tool_use :: Maybe ServerToolUseUsage + , stream_output_tokens_details :: Maybe OutputTokensDetails + , stream_iterations :: Maybe (Vector IterationUsage) + } deriving stock (Show) instance FromJSON StreamUsage where - parseJSON = genericParseJSON aesonOptions + parseJSON = Aeson.withObject "StreamUsage" $ \o -> + StreamUsage + <$> o Aeson..:? "input_tokens" + <*> o Aeson..: "output_tokens" + <*> o Aeson..:? "cache_creation_input_tokens" + <*> o Aeson..:? "cache_read_input_tokens" + <*> o Aeson..:? "server_tool_use" + <*> o Aeson..:? "output_tokens_details" + <*> o Aeson..:? "iterations" instance ToJSON StreamUsage where - toJSON = genericToJSON aesonOptions + toJSON StreamUsage{..} = Aeson.object $ + [ "output_tokens" Aeson..= output_tokens + ] <> maybe [] (\n -> ["input_tokens" Aeson..= n]) stream_input_tokens + <> maybe [] (\n -> ["cache_creation_input_tokens" Aeson..= n]) + stream_cache_creation_input_tokens + <> maybe [] (\n -> ["cache_read_input_tokens" Aeson..= n]) + stream_cache_read_input_tokens + <> maybe [] (\u -> ["server_tool_use" Aeson..= u]) stream_server_tool_use + <> maybe [] (\d -> ["output_tokens_details" Aeson..= d]) + stream_output_tokens_details + <> maybe [] (\is -> ["iterations" Aeson..= is]) stream_iterations -- | Streaming events for @\/v1\/messages@ data MessageStreamEvent diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -17,6 +17,7 @@ import qualified Control.Concurrent as Concurrent import qualified Control.Exception as Exception import qualified Data.Aeson as Aeson +import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.Types as Aeson.Types import Data.Foldable (toList) import qualified Data.IORef as IORef @@ -507,6 +508,183 @@ HUnit.assertBool "Expected non-empty streamed text" (not (Text.null text)) + let claude5WireTypesTest = + HUnit.testCase "Claude 5 wire types" do + HUnit.assertEqual + "Adaptive thinking should include display" + (Aeson.object + [ "type" Aeson..= ("adaptive" :: Text.Text) + , "display" Aeson..= ("summarized" :: Text.Text) + ]) + (Aeson.toJSON + (Messages.ThinkingAdaptiveWithDisplay Messages.ThinkingSummarized)) + + HUnit.assertEqual + "Disabled thinking should use the disabled wire value" + (Aeson.object ["type" Aeson..= ("disabled" :: Text.Text)]) + (Aeson.toJSON Messages.ThinkingDisabled) + + HUnit.assertEqual + "Tool removal should reference a declared tool" + (Aeson.object + [ "type" Aeson..= ("tool_removal" :: Text.Text) + , "tool" Aeson..= Aeson.object + [ "type" Aeson..= ("tool_reference" :: Text.Text) + , "name" Aeson..= ("get_weather" :: Text.Text) + ] + ]) + (Aeson.toJSON Messages.Content_Tool_Removal + { Messages.tool = Messages.ToolChangeReference "get_weather" + , Messages.cache_control = Nothing + }) + + let streamUsage = Aeson.object + [ "input_tokens" Aeson..= (24 :: Int) + , "output_tokens" Aeson..= (12 :: Int) + , "output_tokens_details" Aeson..= Aeson.object + [ "thinking_tokens" Aeson..= (8 :: Int) + ] + , "iterations" Aeson..= + ([ Aeson.object + [ "type" Aeson..= ("fallback_message" :: Text.Text) + , "model" Aeson..= ("claude-sonnet-5" :: Text.Text) + , "input_tokens" Aeson..= (24 :: Int) + , "output_tokens" Aeson..= (12 :: Int) + ] + ] :: [Aeson.Value]) + ] + + case Aeson.fromJSON streamUsage of + Aeson.Success Messages.StreamUsage + { Messages.stream_output_tokens_details = + Just Messages.OutputTokensDetails + { Messages.thinking_tokens = 8 + } + , Messages.stream_iterations = Just [_] + } -> pure () + result -> HUnit.assertFailure $ + "Failed to decode Claude 5 streaming usage: " <> show result + + let fallbackRequest = Messages._CreateMessage + { Messages.model = "claude-fable-5" + , Messages.messages = + [ Messages.Message + { Messages.role = Messages.User + , Messages.content = [Messages.textContent "Hello"] + , Messages.cache_control = Nothing + } + ] + , Messages.fallbacks = Just Messages.FallbacksDefault + } + + case Aeson.toJSON fallbackRequest of + Aeson.Object o -> + HUnit.assertEqual + "Default fallbacks should serialize as a string" + (Just (Aeson.String "default")) + (KeyMap.lookup "fallbacks" o) + _ -> HUnit.assertFailure "CreateMessage should serialize as an object" + + let refusalResponse = Aeson.object + [ "id" Aeson..= ("msg_refusal" :: Text.Text) + , "type" Aeson..= ("message" :: Text.Text) + , "role" Aeson..= ("assistant" :: Text.Text) + , "model" Aeson..= ("claude-fable-5" :: Text.Text) + , "content" Aeson..= ([] :: [Aeson.Value]) + , "stop_reason" Aeson..= ("refusal" :: Text.Text) + , "stop_sequence" Aeson..= Aeson.Null + , "stop_details" Aeson..= Aeson.object + [ "type" Aeson..= ("refusal" :: Text.Text) + , "category" Aeson..= ("reasoning_extraction" :: Text.Text) + , "explanation" Aeson..= ("Request declined" :: Text.Text) + ] + , "usage" Aeson..= Aeson.object + [ "input_tokens" Aeson..= (12 :: Int) + , "output_tokens" Aeson..= (0 :: Int) + ] + ] + + case Aeson.fromJSON refusalResponse of + Aeson.Success Messages.MessageResponse + { Messages.stop_reason = Just Messages.Refusal + , Messages.stop_details = Just Messages.StopDetails + { Messages.category = Just "reasoning_extraction" + } + } -> pure () + result -> HUnit.assertFailure $ + "Failed to decode Claude 5 refusal response: " <> show result + + let fallbackBlock = Aeson.object + [ "type" Aeson..= ("fallback" :: Text.Text) + , "from" Aeson..= Aeson.object + [ "model" Aeson..= ("claude-fable-5" :: Text.Text) + ] + , "to" Aeson..= Aeson.object + [ "model" Aeson..= ("claude-sonnet-5" :: Text.Text) + ] + , "trigger" Aeson..= Aeson.object + [ "type" Aeson..= ("refusal" :: Text.Text) + , "category" Aeson..= ("cyber" :: Text.Text) + ] + ] + + case Aeson.fromJSON fallbackBlock of + Aeson.Success Messages.ContentBlock_Fallback + { Messages.from_ = Messages.FallbackInfo "claude-fable-5" + , Messages.to = Messages.FallbackInfo "claude-sonnet-5" + } -> + case Messages.contentBlockToContent + (Messages.ContentBlock_Fallback + { Messages.from_ = + Messages.FallbackInfo "claude-fable-5" + , Messages.to = + Messages.FallbackInfo "claude-sonnet-5" + , Messages.trigger = + Messages.FallbackTrigger (Just "cyber") + }) of + Just Messages.Content_Fallback{} -> pure () + _ -> HUnit.assertFailure + "Fallback transition should be replayable" + result -> HUnit.assertFailure $ + "Failed to decode fallback transition: " <> show result + + let claude5ModelTests = + Tasty.testGroup "Claude 5 models" $ + flip map ["claude-sonnet-5", "claude-opus-5", "claude-fable-5"] $ \modelName -> + HUnit.testCase (Text.unpack modelName) do + Messages.MessageResponse + { Messages.model = responseModel + , Messages.content = responseContent + } <- + createMessage + Messages._CreateMessage + { Messages.model = modelName + , Messages.messages = + [ Messages.Message + { Messages.role = Messages.User + , Messages.content = + [ Messages.textContent + "Respond with exactly: ok" + ] + , Messages.cache_control = Nothing + } + ] + , Messages.max_tokens = 1024 + , Messages.output_config = + Just (Messages.effortConfig "low") + , Messages.thinking = Just + (Messages.ThinkingAdaptiveWithDisplay + Messages.ThinkingOmitted) + } + + HUnit.assertEqual + "Response should come from the requested model" + modelName + responseModel + HUnit.assertBool + "Response should have content" + (not (null responseContent)) + let promptCachingLiveTest = HUnit.testCase "Create message - prompt caching" do let largeSystemText = @@ -877,6 +1055,8 @@ , strictToolUseTest , adaptiveThinkingTest , adaptiveThinkingStreamingTest + , claude5WireTypesTest + , claude5ModelTests , promptCachingLiveTest , inferenceGeoLiveTest , compactionLiveTest