claude 1.3.1 → 1.4.0

raw patch · 7 files changed

+401/−31 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• README.md +22/−0
• claude.cabal +2/−1
• src/Claude/V1/CacheControl.hs +62/−0
• src/Claude/V1/Messages.hs +79/−11
• src/Claude/V1/Tool.hs +83/−18
• tasty/Main.hs +134/−1

@@ -1,3 +1,22 @@+1.4.0:++- Expand prompt caching support:+  - Add top-level `cache_control` on `CreateMessage` (automatic caching).+  - Add `ttl` support on `CacheControl` via `CacheTTL`.+  - Add cache-control helpers:+    - `ephemeralCacheWithTTL`+    - `ephemeralCacheWithTTLSeconds`+    - `ephemeralCacheWithTTLDuration`+- Add structured system prompt support:+  - `SystemPrompt` (string or blocks)+  - `SystemBlock` with per-block `cache_control`+  - `systemText`, `systemBlocks`, `systemTextBlock`, `systemTextBlockCached`+  - `CreateMessage.system` and `CountTokensRequest.system` now use `Maybe SystemPrompt`+  - breaking: `system = Just someTextVar` (where `someTextVar :: Text`) now needs `system = Just (systemText someTextVar)`+- Add tool-level cache control support:+  - `ToolDefinition` variants now accept optional `cache_control`+  - new helper `withToolCacheControl`+ 1.3.1:  - Remove `advanced-tool-use-2025-11-20` beta header requirement — tool search,

@@ -34,6 +34,28 @@     traverse_ display content ``` +## Prompt caching++The bindings support prompt caching at multiple levels:++- top-level request (`CreateMessage.cache_control`)+- system blocks (`SystemBlock.cache_control`)+- message/content blocks (`Message.cache_control`, text/image content block cache control)+- tool definitions (`withToolCacheControl`)++```haskell+MessageResponse{ usage } <- createMessage _CreateMessage+    { model = "claude-sonnet-4-5-20250929"+    , max_tokens = 1024+    , cache_control = Just (ephemeralCacheWithTTLDuration "1h")+    , system = Just $ systemBlocks+        [ systemTextBlockCached ephemeralCache "You are a coding assistant."+        ]+    , messages =+        [ Message{ role = User, content = [ textContent "Summarize this file." ] } ]+    }+```+ ## Setup  ### Using Nix with Flakes (Recommended)

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               claude-version:            1.3.1+version:            1.4.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@@ -47,6 +47,7 @@                         Claude.V1.Messages.Batches                         Claude.V1.Tool     other-modules:      Claude.Prelude+                        Claude.V1.CacheControl     default-extensions: DataKinds                       , DeriveAnyClass                       , DeriveGeneric

@@ -0,0 +1,62 @@+module Claude.V1.CacheControl+    ( CacheControl(..)+    , CacheTTL(..)+    , ephemeralCache+    , ephemeralCacheWithTTL+    , ephemeralCacheWithTTLSeconds+    , ephemeralCacheWithTTLDuration+    ) where++import Claude.Prelude+import qualified Data.Aeson as Aeson++-- | Cache TTL configuration for prompt caching.+--+-- Supports both numeric seconds and duration strings for forward compatibility.+data CacheTTL+    = CacheTTLSeconds Natural+    | CacheTTLDuration Text+    deriving stock (Eq, Show)++instance FromJSON CacheTTL where+    parseJSON n@(Aeson.Number _) = CacheTTLSeconds <$> Aeson.parseJSON n+    parseJSON (Aeson.String t) = pure (CacheTTLDuration t)+    parseJSON _ = fail "CacheTTL must be a number (seconds) or string duration"++instance ToJSON CacheTTL where+    toJSON (CacheTTLSeconds n) = Aeson.toJSON n+    toJSON (CacheTTLDuration t) = Aeson.toJSON t++-- | Cache control for prompt caching.+data CacheControl = CacheControl+    { type_ :: Text+    , ttl :: Maybe CacheTTL+    } deriving stock (Eq, Generic, Show)++instance FromJSON CacheControl where+    parseJSON = genericParseJSON aesonOptions++instance ToJSON CacheControl where+    toJSON = genericToJSON aesonOptions++-- | Convenience constructor for ephemeral cache control.+ephemeralCache :: CacheControl+ephemeralCache = CacheControl+    { type_ = "ephemeral"+    , ttl = Nothing+    }++-- | Convenience constructor for ephemeral cache control with TTL.+ephemeralCacheWithTTL :: CacheTTL -> CacheControl+ephemeralCacheWithTTL cacheTTL = CacheControl+    { type_ = "ephemeral"+    , ttl = Just cacheTTL+    }++-- | Convenience constructor for ephemeral cache control with TTL in seconds.+ephemeralCacheWithTTLSeconds :: Natural -> CacheControl+ephemeralCacheWithTTLSeconds = ephemeralCacheWithTTL . CacheTTLSeconds++-- | Convenience constructor for ephemeral cache control with TTL duration text.+ephemeralCacheWithTTLDuration :: Text -> CacheControl+ephemeralCacheWithTTLDuration = ephemeralCacheWithTTL . CacheTTLDuration

@@ -61,6 +61,7 @@     , codeExecutionTool     , allowedCallersCodeExecution     , allowCallers+    , withToolCacheControl     , toolChoiceAuto     , toolChoiceAny     , toolChoiceTool@@ -76,7 +77,18 @@     , TokenCount(..)       -- * Prompt caching     , CacheControl(..)+    , CacheTTL(..)     , ephemeralCache+    , ephemeralCacheWithTTL+    , ephemeralCacheWithTTLSeconds+    , ephemeralCacheWithTTLDuration+      -- * System prompt helpers+    , SystemPrompt(..)+    , SystemBlock(..)+    , systemText+    , systemBlocks+    , systemTextBlock+    , systemTextBlockCached       -- * Convenience constructors     , textContent     , imageContent@@ -87,6 +99,14 @@     ) where  import           Claude.Prelude+import           Claude.V1.CacheControl+    ( CacheControl(..)+    , CacheTTL(..)+    , ephemeralCache+    , ephemeralCacheWithTTL+    , ephemeralCacheWithTTLDuration+    , ephemeralCacheWithTTLSeconds+    ) import           Claude.V1.Tool     ( InputSchema(..)     , Tool(..)@@ -104,6 +124,7 @@     , toolChoiceAny     , toolChoiceAuto     , toolChoiceTool+    , withToolCacheControl     , toolSearchBm25     , toolSearchRegex     )@@ -134,21 +155,64 @@ instance ToJSON ImageSource where     toJSON = genericToJSON aesonOptions --- | Cache control for prompt caching-data CacheControl = CacheControl-    { type_ :: Text  -- ^ Currently only "ephemeral" is supported-    } deriving stock (Generic, Show)+-- | A system prompt block.+--+-- Use @type_ = \"text\"@ for text system blocks.+data SystemBlock = SystemBlock+    { type_ :: Text+    , text :: Text+    , cache_control :: Maybe CacheControl+    } deriving stock (Eq, Generic, Show) -instance FromJSON CacheControl where+instance FromJSON SystemBlock where     parseJSON = genericParseJSON aesonOptions -instance ToJSON CacheControl where+instance ToJSON SystemBlock where     toJSON = genericToJSON aesonOptions --- | Convenience constructor for ephemeral cache control-ephemeralCache :: CacheControl-ephemeralCache = CacheControl{ type_ = "ephemeral" }+-- | System prompt, either a plain string or an array of system blocks.+data SystemPrompt+    = SystemPromptText Text+    | SystemPromptBlocks (Vector SystemBlock)+    deriving stock (Eq, Show) +instance IsString SystemPrompt where+    fromString = SystemPromptText . fromString++instance FromJSON SystemPrompt where+    parseJSON (Aeson.String t) = pure (SystemPromptText t)+    parseJSON (Aeson.Array arr) =+        SystemPromptBlocks <$> traverse Aeson.parseJSON arr+    parseJSON _ = fail "SystemPrompt must be a string or array of system blocks"++instance ToJSON SystemPrompt where+    toJSON (SystemPromptText t) = Aeson.String t+    toJSON (SystemPromptBlocks blocks) = Aeson.toJSON blocks++-- | Create a plain-text system prompt.+systemText :: Text -> SystemPrompt+systemText = SystemPromptText++-- | Create a block-based system prompt.+systemBlocks :: Vector SystemBlock -> SystemPrompt+systemBlocks = SystemPromptBlocks++-- | Create a text system block without cache control.+systemTextBlock :: Text -> SystemBlock+systemTextBlock t = SystemBlock+    { type_ = "text"+    , text = t+    , cache_control = Nothing+    }++-- | Create a text system block with cache control.+systemTextBlockCached :: CacheControl -> Text -> SystemBlock+systemTextBlockCached cc t = SystemBlock+    { type_ = "text"+    , text = t+    , cache_control = Just cc+    }+ -- | Text content block data TextContent = TextContent     { text :: Text@@ -836,7 +900,10 @@     { model :: Text     , messages :: Vector Message     , max_tokens :: Natural-    , system :: Maybe Text+    , system :: Maybe SystemPrompt+    -- ^ System prompt, either plain text or structured system blocks.+    , cache_control :: Maybe CacheControl+    -- ^ Top-level automatic prompt caching configuration.     , temperature :: Maybe Double     , top_p :: Maybe Double     , top_k :: Maybe Natural@@ -873,6 +940,7 @@     , messages = mempty     , max_tokens = 1024     , system = Nothing+    , cache_control = Nothing     , temperature = Nothing     , top_p = Nothing     , top_k = Nothing@@ -1014,7 +1082,7 @@ data CountTokensRequest = CountTokensRequest     { model :: Text     , messages :: Vector Message-    , system :: Maybe Text+    , system :: Maybe SystemPrompt     , tools :: Maybe (Vector ToolDefinition)     , tool_choice :: Maybe ToolChoice     } deriving stock (Generic, Show)

@@ -31,6 +31,13 @@     , ToolDefinition(..)     , ToolSearchTool(..)     , ToolSearchToolType(..)+      -- * Prompt caching+    , CacheControl(..)+    , CacheTTL(..)+    , ephemeralCache+    , ephemeralCacheWithTTL+    , ephemeralCacheWithTTLSeconds+    , ephemeralCacheWithTTLDuration       -- * Tool constructors     , functionTool     , strictFunctionTool@@ -44,6 +51,7 @@     , codeExecutionTool     , allowedCallersCodeExecution     , allowCallers+    , withToolCacheControl       -- * ToolChoice constructors     , toolChoiceAuto     , toolChoiceAny@@ -56,6 +64,14 @@     ) where  import Claude.Prelude+import Claude.V1.CacheControl+    ( CacheControl(..)+    , CacheTTL(..)+    , ephemeralCache+    , ephemeralCacheWithTTL+    , ephemeralCacheWithTTLDuration+    , ephemeralCacheWithTTLSeconds+    )  import qualified Data.Aeson as Aeson import qualified Data.Aeson.Key as Key@@ -265,11 +281,16 @@         { tool :: Tool         , defer_loading :: Maybe Bool         , allowed_callers :: Maybe (Vector Text)+        , cache_control :: Maybe CacheControl         }-    | ToolDef_SearchTool ToolSearchTool+    | ToolDef_SearchTool+        { tool_search_tool :: ToolSearchTool+        , cache_control :: Maybe CacheControl+        }     | ToolDef_CodeExecutionTool         { name :: Text         , type_ :: Text+        , cache_control :: Maybe CacheControl         }     deriving stock (Eq, Show) @@ -277,19 +298,32 @@     parseJSON = Aeson.withObject "ToolDefinition" $ \o -> do         -- Check if this is a tool search tool or code execution tool by looking for "type" field         mType <- o Aeson..:? "type"+        cache_control <- o Aeson..:? "cache_control"         case mType of             Just t | isToolSearchType t -> do                 searchTool <- Aeson.parseJSON (Aeson.Object o)-                pure (ToolDef_SearchTool searchTool)+                pure ToolDef_SearchTool+                    { tool_search_tool = searchTool+                    , cache_control = cache_control+                    }             Just t | isCodeExecutionType t -> do                 name <- o Aeson..: "name"-                pure ToolDef_CodeExecutionTool{ name, type_ = t }+                pure ToolDef_CodeExecutionTool+                    { name+                    , type_ = t+                    , cache_control = cache_control+                    }             _ -> do                 -- Parse as function tool                 tool <- Aeson.parseJSON (Aeson.Object o)                 defer_loading <- o Aeson..:? "defer_loading"                 allowed_callers <- o Aeson..:? "allowed_callers"-                pure ToolDef_Function{ tool, defer_loading, allowed_callers }+                pure ToolDef_Function+                    { tool+                    , defer_loading+                    , allowed_callers+                    , cache_control = cache_control+                    }       where         isToolSearchType :: Text -> Bool         isToolSearchType t = t == "tool_search_tool_regex_20251119"@@ -298,7 +332,7 @@         isCodeExecutionType t = t == "code_execution_20250825"  instance ToJSON ToolDefinition where-    toJSON (ToolDef_Function Tool{ name, description, input_schema, strict } defer_loading allowed_callers) =+    toJSON (ToolDef_Function Tool{ name, description, input_schema, strict } defer_loading allowed_callers cache_control) =         Aeson.Object (baseMap <> optionalFields)       where         baseObj = Aeson.object $@@ -311,20 +345,37 @@         optionalFields = KeyMap.fromList $             maybe [] (\dl -> [("defer_loading", Aeson.toJSON dl)]) defer_loading <>             maybe [] (\ac -> [("allowed_callers", Aeson.toJSON ac)]) allowed_callers <>-            maybe [] (\s -> [("strict", Aeson.toJSON s)]) strict-    toJSON (ToolDef_SearchTool searchTool) = Aeson.toJSON searchTool-    toJSON (ToolDef_CodeExecutionTool name type_) = Aeson.object+            maybe [] (\s -> [("strict", Aeson.toJSON s)]) strict <>+            maybe [] (\cc -> [("cache_control", Aeson.toJSON cc)]) cache_control+    toJSON (ToolDef_SearchTool searchTool cache_control) =+        case Aeson.toJSON searchTool of+            Aeson.Object baseMap ->+                Aeson.Object $+                    baseMap <> KeyMap.fromList+                        (maybe [] (\cc -> [("cache_control", Aeson.toJSON cc)]) cache_control)+            other -> other+    toJSON (ToolDef_CodeExecutionTool name type_ cache_control) = Aeson.object $         [ "name" Aeson..= name         , "type" Aeson..= type_-        ]+        ] <> maybe [] (\cc -> ["cache_control" Aeson..= cc]) cache_control  -- | Wrap a tool for inline (non-deferred) loading inlineTool :: Tool -> ToolDefinition-inlineTool t = ToolDef_Function{ tool = t, defer_loading = Nothing, allowed_callers = Nothing }+inlineTool t = ToolDef_Function+    { tool = t+    , defer_loading = Nothing+    , allowed_callers = Nothing+    , cache_control = Nothing+    }  -- | Wrap a tool for deferred loading (used with tool search) deferredTool :: Tool -> ToolDefinition-deferredTool t = ToolDef_Function{ tool = t, defer_loading = Just True, allowed_callers = Nothing }+deferredTool t = ToolDef_Function+    { tool = t+    , defer_loading = Just True+    , allowed_callers = Nothing+    , cache_control = Nothing+    }  -- | Code execution tool for programmatic tool calling (PTC) --@@ -334,6 +385,7 @@ codeExecutionTool = ToolDef_CodeExecutionTool     { name = "code_execution"     , type_ = "code_execution_20250825"+    , cache_control = Nothing     }  -- | Allowed callers for code execution (PTC)@@ -352,21 +404,34 @@ -- allowCallers allowedCallersCodeExecution (inlineTool myTool) -- @ allowCallers :: Vector Text -> ToolDefinition -> ToolDefinition-allowCallers callers (ToolDef_Function t dl _) = ToolDef_Function t dl (Just callers)+allowCallers callers (ToolDef_Function t dl _ cc) = ToolDef_Function t dl (Just callers) cc allowCallers _ td = td +-- | Set cache_control on a tool definition.+withToolCacheControl :: CacheControl -> ToolDefinition -> ToolDefinition+withToolCacheControl cc (ToolDef_Function t dl ac _) = ToolDef_Function t dl ac (Just cc)+withToolCacheControl cc (ToolDef_SearchTool t _) = ToolDef_SearchTool t (Just cc)+withToolCacheControl cc (ToolDef_CodeExecutionTool n t _) =+    ToolDef_CodeExecutionTool n t (Just cc)+ -- | Tool search using regex matching toolSearchRegex :: ToolDefinition-toolSearchRegex = ToolDef_SearchTool ToolSearchTool-    { name = "tool_search_tool_regex"-    , type_ = ToolSearchTool_Regex_20251119+toolSearchRegex = ToolDef_SearchTool+    { tool_search_tool = ToolSearchTool+        { name = "tool_search_tool_regex"+        , type_ = ToolSearchTool_Regex_20251119+        }+    , cache_control = Nothing     }  -- | Tool search using BM25 matching toolSearchBm25 :: ToolDefinition-toolSearchBm25 = ToolDef_SearchTool ToolSearchTool-    { name = "tool_search_tool_bm25"-    , type_ = ToolSearchTool_Bm25_20251119+toolSearchBm25 = ToolDef_SearchTool+    { tool_search_tool = ToolSearchTool+        { name = "tool_search_tool_bm25"+        , type_ = ToolSearchTool_Bm25_20251119+        }+    , cache_control = Nothing     }  -- | Content block types (duplicated here for helper functions)

@@ -52,6 +52,94 @@     let version = Just "2023-06-01"     let Methods{..} = V1.makeMethods clientEnv (Text.pack key) version +    let systemPromptStringLiveTest =+            HUnit.testCase "Create message - system prompt string" do+                Messages.MessageResponse{ content } <-+                    createMessage+                        Messages._CreateMessage+                            { Messages.model = model+                            , Messages.messages =+                                [ Messages.Message+                                    { Messages.role = Messages.User+                                    , Messages.content =+                                        [ Messages.textContent "Say exactly: system-string-ok"+                                        ]+                                    , Messages.cache_control = Nothing+                                    }+                                ]+                            , Messages.max_tokens = 32+                            , Messages.system = Just "Respond with exactly: system-string-ok"+                            }++                HUnit.assertBool "Response should have content"+                    (not (null content))++    let systemPromptBlocksLiveTest =+            HUnit.testCase "Create message - system prompt blocks with cache control" do+                Messages.MessageResponse{ content } <-+                    createMessage+                        Messages._CreateMessage+                            { Messages.model = model+                            , Messages.messages =+                                [ Messages.Message+                                    { Messages.role = Messages.User+                                    , Messages.content =+                                        [ Messages.textContent "Follow the system instructions."+                                        ]+                                    , Messages.cache_control = Nothing+                                    }+                                ]+                            , Messages.max_tokens = 64+                            , Messages.system = Just $ Messages.systemBlocks+                                [ Messages.systemTextBlockCached+                                    Messages.ephemeralCache+                                    "Respond with exactly: system-block-ok"+                                ]+                            }++                HUnit.assertBool "Response should have content"+                    (not (null content))++    let toolDefinitionCacheControlLiveTest =+            HUnit.testCase "Create message - tool cache_control" do+                let weatherTool = Tool.functionTool+                        "get_weather"+                        (Just "Get weather for a location")+                        $ Aeson.object+                            [ "properties" Aeson..= Aeson.object+                                [ "location" Aeson..= Aeson.object+                                    [ "type" Aeson..= ("string" :: Text.Text)+                                    ]+                                ]+                            , "required" Aeson..= (["location"] :: [Text.Text])+                            ]++                Messages.MessageResponse{ stop_reason } <-+                    createMessage+                        Messages._CreateMessage+                            { Messages.model = model+                            , Messages.messages =+                                [ Messages.Message+                                    { Messages.role = Messages.User+                                    , Messages.content =+                                        [ Messages.textContent "What's the weather in SF? Use the tool."+                                        ]+                                    , Messages.cache_control = Nothing+                                    }+                                ]+                            , Messages.max_tokens = 200+                            , Messages.tools = Just+                                [ Tool.withToolCacheControl+                                    Messages.ephemeralCache+                                    (Tool.inlineTool weatherTool)+                                ]+                            , Messages.tool_choice = Just Tool.ToolChoice_Any+                            }++                HUnit.assertEqual "Should stop for tool use"+                    (Just Messages.Tool_Use)+                    stop_reason+     let messagesMinimalTest =             HUnit.testCase "Create message - minimal" do                 Messages.MessageResponse{ content } <-@@ -419,6 +507,47 @@                 HUnit.assertBool "Expected non-empty streamed text"                     (not (Text.null text)) +    let promptCachingLiveTest =+            HUnit.testCase "Create message - prompt caching" do+                let largeSystemText =+                        Text.intercalate " " (replicate 6000 ("cacheable-guidance" :: Text.Text))+                let systemPrompt = Messages.systemBlocks+                        [ Messages.systemTextBlockCached Messages.ephemeralCache largeSystemText+                        ]+                let request = Messages._CreateMessage+                        { Messages.model = model+                        , Messages.messages =+                            [ Messages.Message+                                { Messages.role = Messages.User+                                , Messages.content =+                                    [ Messages.textContent "Respond with exactly: cachetest"+                                    ]+                                , Messages.cache_control = Nothing+                                }+                            ]+                        , Messages.max_tokens = 64+                        , Messages.system = Just systemPrompt+                        , Messages.cache_control = Just Messages.ephemeralCache+                        }++                Messages.MessageResponse{ Messages.usage = usage1 } <- createMessage request+                Messages.MessageResponse{ Messages.usage = usage2 } <- createMessage request++                let firstCreatedCache =+                        maybe False (> 0) (Messages.cache_creation_input_tokens usage1)+                let firstReadCache =+                        maybe False (> 0) (Messages.cache_read_input_tokens usage1)+                let readCache =+                        maybe False (> 0) (Messages.cache_read_input_tokens usage2)++                HUnit.assertBool+                    "First request should create or read prompt cache tokens"+                    (firstCreatedCache || firstReadCache)++                HUnit.assertBool+                    "Second request should read prompt cache tokens"+                    readCache+     let inferenceGeoLiveTest =             HUnit.testCase "Create message - inference_geo" do                 Messages.MessageResponse{ content } <-@@ -735,7 +864,10 @@                         HUnit.assertFailure $ "Unexpected stop_reason: " <> show other      let tests =-            [ messagesMinimalTest+            [ systemPromptStringLiveTest+            , systemPromptBlocksLiveTest+            , toolDefinitionCacheControlLiveTest+            , messagesMinimalTest             , messagesWithSystemTest             , messagesStreamingTest             , messagesConversationTest@@ -745,6 +877,7 @@             , strictToolUseTest             , adaptiveThinkingTest             , adaptiveThinkingStreamingTest+            , promptCachingLiveTest             , inferenceGeoLiveTest             , compactionLiveTest             , fastModeLiveTest