-- | @\/v1\/messages@
--
-- This module provides types and utilities for the Claude Messages API.
module Claude.V1.Messages
    ( -- * Main types
      CreateMessage(..)
    , _CreateMessage
    , MessageResponse(..)
    , MessageStreamEvent(..)
      -- * Structured outputs
    , OutputFormat(..)
    , jsonSchemaFormat
      -- * Content types
    , Content(..)
    , ContentBlock(..)
    , TextContent(..)
    , ImageSource(..)
    , ToolUseContent(..)
    , ToolResultContent(..)
      -- * Message types
    , Message(..)
    , Role(..)
      -- * Response types
    , StopReason(..)
    , Usage(..)
    , ServerToolUseUsage(..)
      -- * Tool search response types
    , ToolReference(..)
    , ToolSearchToolResultContent(..)
      -- * Programmatic tool calling (PTC) types
    , ContainerInfo(..)
    , ToolCaller(..)
    , CodeExecutionResult(..)
    , CodeExecutionToolResultContent(..)
    , contentBlockToContent
      -- * Tool types (re-exported from Claude.V1.Tool)
    , Tool(..)
    , ToolChoice(..)
    , InputSchema(..)
    , ToolDefinition(..)
    , ToolSearchTool(..)
    , ToolSearchToolType(..)
    , functionTool
    , strictFunctionTool
    , inlineTool
    , deferredTool
    , toolSearchRegex
    , toolSearchBm25
    , codeExecutionTool
    , allowedCallersCodeExecution
    , allowCallers
    , toolChoiceAuto
    , toolChoiceAny
    , toolChoiceTool
      -- * Streaming types
    , ContentBlockDelta(..)
    , TextDelta(..)
    , InputJsonDelta(..)
    , MessageDelta(..)
    , StreamUsage(..)
      -- * Token counting
    , CountTokensRequest(..)
    , _CountTokensRequest
    , TokenCount(..)
      -- * Prompt caching
    , CacheControl(..)
    , ephemeralCache
      -- * Convenience constructors
    , textContent
    , imageContent
      -- * Servant
    , API
    , MessagesAPI
    , CountTokensAPI
    ) where

import           Claude.Prelude
import           Claude.V1.Tool
    ( InputSchema(..)
    , Tool(..)
    , ToolChoice(..)
    , ToolDefinition(..)
    , ToolSearchTool(..)
    , ToolSearchToolType(..)
    , allowCallers
    , allowedCallersCodeExecution
    , codeExecutionTool
    , deferredTool
    , functionTool
    , inlineTool
    , strictFunctionTool
    , toolChoiceAny
    , toolChoiceAuto
    , toolChoiceTool
    , toolSearchBm25
    , toolSearchRegex
    )
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
    deriving stock (Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq, (forall x. Role -> Rep Role x)
-> (forall x. Rep Role x -> Role) -> Generic Role
forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Role -> Rep Role x
from :: forall x. Role -> Rep Role x
$cto :: forall x. Rep Role x -> Role
to :: forall x. Rep Role x -> Role
Generic, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Role -> ShowS
showsPrec :: Int -> Role -> ShowS
$cshow :: Role -> String
show :: Role -> String
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show)

instance FromJSON Role where
    parseJSON :: Value -> Parser Role
parseJSON = Options -> Value -> Parser Role
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON Role where
    toJSON :: Role -> Value
toJSON = Options -> Role -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Image source for vision capabilities
data ImageSource = ImageSource
    { ImageSource -> Text
type_ :: Text           -- ^ "base64"
    , ImageSource -> Text
media_type :: Text      -- ^ "image/jpeg", "image/png", etc.
    , ImageSource -> Text
data_ :: Text           -- ^ Base64 encoded image data
    } deriving stock ((forall x. ImageSource -> Rep ImageSource x)
-> (forall x. Rep ImageSource x -> ImageSource)
-> Generic ImageSource
forall x. Rep ImageSource x -> ImageSource
forall x. ImageSource -> Rep ImageSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImageSource -> Rep ImageSource x
from :: forall x. ImageSource -> Rep ImageSource x
$cto :: forall x. Rep ImageSource x -> ImageSource
to :: forall x. Rep ImageSource x -> ImageSource
Generic, Int -> ImageSource -> ShowS
[ImageSource] -> ShowS
ImageSource -> String
(Int -> ImageSource -> ShowS)
-> (ImageSource -> String)
-> ([ImageSource] -> ShowS)
-> Show ImageSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageSource -> ShowS
showsPrec :: Int -> ImageSource -> ShowS
$cshow :: ImageSource -> String
show :: ImageSource -> String
$cshowList :: [ImageSource] -> ShowS
showList :: [ImageSource] -> ShowS
Show)

instance FromJSON ImageSource where
    parseJSON :: Value -> Parser ImageSource
parseJSON = Options -> Value -> Parser ImageSource
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON ImageSource where
    toJSON :: ImageSource -> Value
toJSON = Options -> ImageSource -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Cache control for prompt caching
data CacheControl = CacheControl
    { CacheControl -> Text
type_ :: Text  -- ^ Currently only "ephemeral" is supported
    } deriving stock ((forall x. CacheControl -> Rep CacheControl x)
-> (forall x. Rep CacheControl x -> CacheControl)
-> Generic CacheControl
forall x. Rep CacheControl x -> CacheControl
forall x. CacheControl -> Rep CacheControl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CacheControl -> Rep CacheControl x
from :: forall x. CacheControl -> Rep CacheControl x
$cto :: forall x. Rep CacheControl x -> CacheControl
to :: forall x. Rep CacheControl x -> CacheControl
Generic, Int -> CacheControl -> ShowS
[CacheControl] -> ShowS
CacheControl -> String
(Int -> CacheControl -> ShowS)
-> (CacheControl -> String)
-> ([CacheControl] -> ShowS)
-> Show CacheControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheControl -> ShowS
showsPrec :: Int -> CacheControl -> ShowS
$cshow :: CacheControl -> String
show :: CacheControl -> String
$cshowList :: [CacheControl] -> ShowS
showList :: [CacheControl] -> ShowS
Show)

instance FromJSON CacheControl where
    parseJSON :: Value -> Parser CacheControl
parseJSON = Options -> Value -> Parser CacheControl
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON CacheControl where
    toJSON :: CacheControl -> Value
toJSON = Options -> CacheControl -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Convenience constructor for ephemeral cache control
ephemeralCache :: CacheControl
ephemeralCache :: CacheControl
ephemeralCache = CacheControl{ type_ :: Text
type_ = Text
"ephemeral" }

-- | Text content block
data TextContent = TextContent
    { TextContent -> Text
text :: Text
    } deriving stock ((forall x. TextContent -> Rep TextContent x)
-> (forall x. Rep TextContent x -> TextContent)
-> Generic TextContent
forall x. Rep TextContent x -> TextContent
forall x. TextContent -> Rep TextContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextContent -> Rep TextContent x
from :: forall x. TextContent -> Rep TextContent x
$cto :: forall x. Rep TextContent x -> TextContent
to :: forall x. Rep TextContent x -> TextContent
Generic, Int -> TextContent -> ShowS
[TextContent] -> ShowS
TextContent -> String
(Int -> TextContent -> ShowS)
-> (TextContent -> String)
-> ([TextContent] -> ShowS)
-> Show TextContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextContent -> ShowS
showsPrec :: Int -> TextContent -> ShowS
$cshow :: TextContent -> String
show :: TextContent -> String
$cshowList :: [TextContent] -> ShowS
showList :: [TextContent] -> ShowS
Show)
      deriving anyclass (Maybe TextContent
Value -> Parser [TextContent]
Value -> Parser TextContent
(Value -> Parser TextContent)
-> (Value -> Parser [TextContent])
-> Maybe TextContent
-> FromJSON TextContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TextContent
parseJSON :: Value -> Parser TextContent
$cparseJSONList :: Value -> Parser [TextContent]
parseJSONList :: Value -> Parser [TextContent]
$comittedField :: Maybe TextContent
omittedField :: Maybe TextContent
FromJSON, [TextContent] -> Value
[TextContent] -> Encoding
TextContent -> Bool
TextContent -> Value
TextContent -> Encoding
(TextContent -> Value)
-> (TextContent -> Encoding)
-> ([TextContent] -> Value)
-> ([TextContent] -> Encoding)
-> (TextContent -> Bool)
-> ToJSON TextContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TextContent -> Value
toJSON :: TextContent -> Value
$ctoEncoding :: TextContent -> Encoding
toEncoding :: TextContent -> Encoding
$ctoJSONList :: [TextContent] -> Value
toJSONList :: [TextContent] -> Value
$ctoEncodingList :: [TextContent] -> Encoding
toEncodingList :: [TextContent] -> Encoding
$comitField :: TextContent -> Bool
omitField :: TextContent -> Bool
ToJSON)

-- | Tool use content block (in assistant messages)
data ToolUseContent = ToolUseContent
    { ToolUseContent -> Text
id :: Text
    , ToolUseContent -> Text
name :: Text
    , ToolUseContent -> Value
input :: Value
    } deriving stock ((forall x. ToolUseContent -> Rep ToolUseContent x)
-> (forall x. Rep ToolUseContent x -> ToolUseContent)
-> Generic ToolUseContent
forall x. Rep ToolUseContent x -> ToolUseContent
forall x. ToolUseContent -> Rep ToolUseContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ToolUseContent -> Rep ToolUseContent x
from :: forall x. ToolUseContent -> Rep ToolUseContent x
$cto :: forall x. Rep ToolUseContent x -> ToolUseContent
to :: forall x. Rep ToolUseContent x -> ToolUseContent
Generic, Int -> ToolUseContent -> ShowS
[ToolUseContent] -> ShowS
ToolUseContent -> String
(Int -> ToolUseContent -> ShowS)
-> (ToolUseContent -> String)
-> ([ToolUseContent] -> ShowS)
-> Show ToolUseContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolUseContent -> ShowS
showsPrec :: Int -> ToolUseContent -> ShowS
$cshow :: ToolUseContent -> String
show :: ToolUseContent -> String
$cshowList :: [ToolUseContent] -> ShowS
showList :: [ToolUseContent] -> ShowS
Show)
      deriving anyclass (Maybe ToolUseContent
Value -> Parser [ToolUseContent]
Value -> Parser ToolUseContent
(Value -> Parser ToolUseContent)
-> (Value -> Parser [ToolUseContent])
-> Maybe ToolUseContent
-> FromJSON ToolUseContent
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ToolUseContent
parseJSON :: Value -> Parser ToolUseContent
$cparseJSONList :: Value -> Parser [ToolUseContent]
parseJSONList :: Value -> Parser [ToolUseContent]
$comittedField :: Maybe ToolUseContent
omittedField :: Maybe ToolUseContent
FromJSON, [ToolUseContent] -> Value
[ToolUseContent] -> Encoding
ToolUseContent -> Bool
ToolUseContent -> Value
ToolUseContent -> Encoding
(ToolUseContent -> Value)
-> (ToolUseContent -> Encoding)
-> ([ToolUseContent] -> Value)
-> ([ToolUseContent] -> Encoding)
-> (ToolUseContent -> Bool)
-> ToJSON ToolUseContent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ToolUseContent -> Value
toJSON :: ToolUseContent -> Value
$ctoEncoding :: ToolUseContent -> Encoding
toEncoding :: ToolUseContent -> Encoding
$ctoJSONList :: [ToolUseContent] -> Value
toJSONList :: [ToolUseContent] -> Value
$ctoEncodingList :: [ToolUseContent] -> Encoding
toEncodingList :: [ToolUseContent] -> Encoding
$comitField :: ToolUseContent -> Bool
omitField :: ToolUseContent -> Bool
ToJSON)

-- | Tool result content (in user messages, following tool use)
data ToolResultContent = ToolResultContent
    { ToolResultContent -> Text
tool_use_id :: Text
    , ToolResultContent -> Maybe Text
content :: Maybe Text
    , ToolResultContent -> Maybe Bool
is_error :: Maybe Bool
    } deriving stock ((forall x. ToolResultContent -> Rep ToolResultContent x)
-> (forall x. Rep ToolResultContent x -> ToolResultContent)
-> Generic ToolResultContent
forall x. Rep ToolResultContent x -> ToolResultContent
forall x. ToolResultContent -> Rep ToolResultContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ToolResultContent -> Rep ToolResultContent x
from :: forall x. ToolResultContent -> Rep ToolResultContent x
$cto :: forall x. Rep ToolResultContent x -> ToolResultContent
to :: forall x. Rep ToolResultContent x -> ToolResultContent
Generic, Int -> ToolResultContent -> ShowS
[ToolResultContent] -> ShowS
ToolResultContent -> String
(Int -> ToolResultContent -> ShowS)
-> (ToolResultContent -> String)
-> ([ToolResultContent] -> ShowS)
-> Show ToolResultContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolResultContent -> ShowS
showsPrec :: Int -> ToolResultContent -> ShowS
$cshow :: ToolResultContent -> String
show :: ToolResultContent -> String
$cshowList :: [ToolResultContent] -> ShowS
showList :: [ToolResultContent] -> ShowS
Show)

instance FromJSON ToolResultContent where
    parseJSON :: Value -> Parser ToolResultContent
parseJSON = Options -> Value -> Parser ToolResultContent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON ToolResultContent where
    toJSON :: ToolResultContent -> Value
toJSON = Options -> ToolResultContent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Content block in a message (for requests)
--
-- For programmatic tool calling (PTC), replay assistant messages using:
--
-- * 'Content_Tool_Use' with optional @caller@ field
-- * 'Content_Server_Tool_Use' for code execution invocations
data Content
    = Content_Text
        { Content -> Text
text :: Text
        , Content -> Maybe CacheControl
cache_control :: Maybe CacheControl
        }
    | Content_Image
        { Content -> ImageSource
source :: ImageSource
        , cache_control :: Maybe CacheControl
        }
    | Content_Tool_Use
        { Content -> Text
id :: Text
        , Content -> Text
name :: Text
        , Content -> Value
input :: Value
        , Content -> Maybe ToolCaller
caller :: Maybe ToolCaller
        }
    | Content_Server_Tool_Use
        { id :: Text
        , name :: Text
        , input :: Value
        }
    | Content_Tool_Result { Content -> Text
tool_use_id :: Text, Content -> Maybe Text
content :: Maybe Text, Content -> Maybe Bool
is_error :: Maybe Bool }
    deriving stock ((forall x. Content -> Rep Content x)
-> (forall x. Rep Content x -> Content) -> Generic Content
forall x. Rep Content x -> Content
forall x. Content -> Rep Content x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Content -> Rep Content x
from :: forall x. Content -> Rep Content x
$cto :: forall x. Rep Content x -> Content
to :: forall x. Rep Content x -> Content
Generic, Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
(Int -> Content -> ShowS)
-> (Content -> String) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Content -> ShowS
showsPrec :: Int -> Content -> ShowS
$cshow :: Content -> String
show :: Content -> String
$cshowList :: [Content] -> ShowS
showList :: [Content] -> ShowS
Show)

-- | Create a text content block without cache control
textContent :: Text -> Content
textContent :: Text -> Content
textContent Text
t = Content_Text{ text :: Text
text = Text
t, cache_control :: Maybe CacheControl
cache_control = Maybe CacheControl
forall a. Maybe a
Nothing }

-- | Create an image content block without cache control
imageContent :: ImageSource -> Content
imageContent :: ImageSource -> Content
imageContent ImageSource
src = Content_Image{ source :: ImageSource
source = ImageSource
src, cache_control :: Maybe CacheControl
cache_control = Maybe CacheControl
forall a. Maybe a
Nothing }

contentOptions :: Options
contentOptions :: Options
contentOptions = Options
aesonOptions
    { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }
    , tagSingleConstructors = True
    , constructorTagModifier = stripPrefix "Content_"
    }

instance FromJSON Content where
    parseJSON :: Value -> Parser Content
parseJSON = Options -> Value -> Parser Content
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
contentOptions

instance ToJSON Content where
    toJSON :: Content -> Value
toJSON = Options -> Content -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
contentOptions

-- | Convert a response 'ContentBlock' to a request 'Content' for replaying
--
-- This is useful for programmatic tool calling (PTC) where you need to
-- replay assistant messages in subsequent requests.
--
-- Returns 'Nothing' for content blocks that don't need to be replayed:
--
-- * 'ContentBlock_Tool_Search_Tool_Result'
-- * 'ContentBlock_Code_Execution_Tool_Result'
-- * 'ContentBlock_Unknown'
contentBlockToContent :: ContentBlock -> Maybe Content
contentBlockToContent :: ContentBlock -> Maybe Content
contentBlockToContent (ContentBlock_Text Text
t) =
    Content -> Maybe Content
forall a. a -> Maybe a
Just Content_Text{ text :: Text
text = Text
t, cache_control :: Maybe CacheControl
cache_control = Maybe CacheControl
forall a. Maybe a
Nothing }
contentBlockToContent (ContentBlock_Tool_Use Text
toolId Text
toolName Value
toolInput Maybe ToolCaller
toolCaller) =
    Content -> Maybe Content
forall a. a -> Maybe a
Just Content_Tool_Use
        { id :: Text
id = Text
toolId
        , name :: Text
name = Text
toolName
        , input :: Value
input = Value
toolInput
        , caller :: Maybe ToolCaller
caller = Maybe ToolCaller
toolCaller
        }
contentBlockToContent (ContentBlock_Server_Tool_Use Text
toolId Text
toolName Value
toolInput) =
    Content -> Maybe Content
forall a. a -> Maybe a
Just Content_Server_Tool_Use
        { id :: Text
id = Text
toolId
        , name :: Text
name = Text
toolName
        , input :: Value
input = Value
toolInput
        }
contentBlockToContent ContentBlock_Tool_Search_Tool_Result{} = Maybe Content
forall a. Maybe a
Nothing
contentBlockToContent ContentBlock_Code_Execution_Tool_Result{} = Maybe Content
forall a. Maybe a
Nothing
contentBlockToContent ContentBlock_Unknown{} = Maybe Content
forall a. Maybe a
Nothing

-- | A reference to a tool found by tool search
data ToolReference = ToolReference
    { ToolReference -> Text
tool_name :: Text
    } deriving stock (ToolReference -> ToolReference -> Bool
(ToolReference -> ToolReference -> Bool)
-> (ToolReference -> ToolReference -> Bool) -> Eq ToolReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToolReference -> ToolReference -> Bool
== :: ToolReference -> ToolReference -> Bool
$c/= :: ToolReference -> ToolReference -> Bool
/= :: ToolReference -> ToolReference -> Bool
Eq, (forall x. ToolReference -> Rep ToolReference x)
-> (forall x. Rep ToolReference x -> ToolReference)
-> Generic ToolReference
forall x. Rep ToolReference x -> ToolReference
forall x. ToolReference -> Rep ToolReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ToolReference -> Rep ToolReference x
from :: forall x. ToolReference -> Rep ToolReference x
$cto :: forall x. Rep ToolReference x -> ToolReference
to :: forall x. Rep ToolReference x -> ToolReference
Generic, Int -> ToolReference -> ShowS
[ToolReference] -> ShowS
ToolReference -> String
(Int -> ToolReference -> ShowS)
-> (ToolReference -> String)
-> ([ToolReference] -> ShowS)
-> Show ToolReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolReference -> ShowS
showsPrec :: Int -> ToolReference -> ShowS
$cshow :: ToolReference -> String
show :: ToolReference -> String
$cshowList :: [ToolReference] -> ShowS
showList :: [ToolReference] -> ShowS
Show)

instance FromJSON ToolReference where
    parseJSON :: Value -> Parser ToolReference
parseJSON = Options -> Value -> Parser ToolReference
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON ToolReference where
    toJSON :: ToolReference -> Value
toJSON = Options -> ToolReference -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Content of a tool search tool result
--
-- This can be either successful search results with tool references,
-- an error, or an unknown type for forward compatibility.
data ToolSearchToolResultContent
    = ToolSearchResult
        { ToolSearchToolResultContent -> Vector ToolReference
tool_references :: Vector ToolReference
        }
    | ToolSearchError
        { ToolSearchToolResultContent -> Text
error_code :: Text
        }
    | ToolSearchResultContent_Unknown Value
    deriving stock (ToolSearchToolResultContent -> ToolSearchToolResultContent -> Bool
(ToolSearchToolResultContent
 -> ToolSearchToolResultContent -> Bool)
-> (ToolSearchToolResultContent
    -> ToolSearchToolResultContent -> Bool)
-> Eq ToolSearchToolResultContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToolSearchToolResultContent -> ToolSearchToolResultContent -> Bool
== :: ToolSearchToolResultContent -> ToolSearchToolResultContent -> Bool
$c/= :: ToolSearchToolResultContent -> ToolSearchToolResultContent -> Bool
/= :: ToolSearchToolResultContent -> ToolSearchToolResultContent -> Bool
Eq, Int -> ToolSearchToolResultContent -> ShowS
[ToolSearchToolResultContent] -> ShowS
ToolSearchToolResultContent -> String
(Int -> ToolSearchToolResultContent -> ShowS)
-> (ToolSearchToolResultContent -> String)
-> ([ToolSearchToolResultContent] -> ShowS)
-> Show ToolSearchToolResultContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolSearchToolResultContent -> ShowS
showsPrec :: Int -> ToolSearchToolResultContent -> ShowS
$cshow :: ToolSearchToolResultContent -> String
show :: ToolSearchToolResultContent -> String
$cshowList :: [ToolSearchToolResultContent] -> ShowS
showList :: [ToolSearchToolResultContent] -> ShowS
Show)

instance FromJSON ToolSearchToolResultContent where
    parseJSON :: Value -> Parser ToolSearchToolResultContent
parseJSON = String
-> (Object -> Parser ToolSearchToolResultContent)
-> Value
-> Parser ToolSearchToolResultContent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ToolSearchToolResultContent" ((Object -> Parser ToolSearchToolResultContent)
 -> Value -> Parser ToolSearchToolResultContent)
-> (Object -> Parser ToolSearchToolResultContent)
-> Value
-> Parser ToolSearchToolResultContent
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
t <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"type"
        case (Text
t :: Text) of
            Text
"tool_search_result" -> do
                Vector ToolReference
tool_references <- Object
o Object -> Key -> Parser (Vector ToolReference)
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"tool_references"
                ToolSearchToolResultContent -> Parser ToolSearchToolResultContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ToolSearchResult{ Vector ToolReference
tool_references :: Vector ToolReference
tool_references :: Vector ToolReference
tool_references }
            Text
"error" -> do
                Text
error_code <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"error_code"
                ToolSearchToolResultContent -> Parser ToolSearchToolResultContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ToolSearchError{ Text
error_code :: Text
error_code :: Text
error_code }
            Text
_ -> ToolSearchToolResultContent -> Parser ToolSearchToolResultContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ToolSearchToolResultContent
ToolSearchResultContent_Unknown (Object -> Value
Aeson.Object Object
o))

instance ToJSON ToolSearchToolResultContent where
    toJSON :: ToolSearchToolResultContent -> Value
toJSON (ToolSearchResult Vector ToolReference
refs) = [Pair] -> Value
Aeson.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (Text
"tool_search_result" :: Text)
        , Key
"tool_references" Key -> Vector ToolReference -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Vector ToolReference
refs
        ]
    toJSON (ToolSearchError Text
code) = [Pair] -> Value
Aeson.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (Text
"error" :: Text)
        , Key
"error_code" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
code
        ]
    toJSON (ToolSearchResultContent_Unknown Value
v) = Value
v

-- | Container information for programmatic tool calling (PTC)
--
-- When using code execution, Claude runs code in a container. The container
-- can be reused across multiple turns by passing its @id@ in subsequent requests.
data ContainerInfo = ContainerInfo
    { ContainerInfo -> Text
id :: Text
    , ContainerInfo -> UTCTime
expires_at :: UTCTime
    } deriving stock (ContainerInfo -> ContainerInfo -> Bool
(ContainerInfo -> ContainerInfo -> Bool)
-> (ContainerInfo -> ContainerInfo -> Bool) -> Eq ContainerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContainerInfo -> ContainerInfo -> Bool
== :: ContainerInfo -> ContainerInfo -> Bool
$c/= :: ContainerInfo -> ContainerInfo -> Bool
/= :: ContainerInfo -> ContainerInfo -> Bool
Eq, (forall x. ContainerInfo -> Rep ContainerInfo x)
-> (forall x. Rep ContainerInfo x -> ContainerInfo)
-> Generic ContainerInfo
forall x. Rep ContainerInfo x -> ContainerInfo
forall x. ContainerInfo -> Rep ContainerInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContainerInfo -> Rep ContainerInfo x
from :: forall x. ContainerInfo -> Rep ContainerInfo x
$cto :: forall x. Rep ContainerInfo x -> ContainerInfo
to :: forall x. Rep ContainerInfo x -> ContainerInfo
Generic, Int -> ContainerInfo -> ShowS
[ContainerInfo] -> ShowS
ContainerInfo -> String
(Int -> ContainerInfo -> ShowS)
-> (ContainerInfo -> String)
-> ([ContainerInfo] -> ShowS)
-> Show ContainerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContainerInfo -> ShowS
showsPrec :: Int -> ContainerInfo -> ShowS
$cshow :: ContainerInfo -> String
show :: ContainerInfo -> String
$cshowList :: [ContainerInfo] -> ShowS
showList :: [ContainerInfo] -> ShowS
Show)

instance FromJSON ContainerInfo where
    parseJSON :: Value -> Parser ContainerInfo
parseJSON = Options -> Value -> Parser ContainerInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON ContainerInfo where
    toJSON :: ContainerInfo -> Value
toJSON = Options -> ContainerInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Identifies who called a tool (for programmatic tool calling)
--
-- * 'ToolCaller_Direct': Claude called the tool directly
-- * 'ToolCaller_CodeExecution': Code execution called the tool programmatically
-- * 'ToolCaller_Unknown': Unknown caller type (forward compatibility)
data ToolCaller
    = ToolCaller_Direct
    | ToolCaller_CodeExecution { ToolCaller -> Text
tool_id :: Text }
    | ToolCaller_Unknown Value
    deriving stock (ToolCaller -> ToolCaller -> Bool
(ToolCaller -> ToolCaller -> Bool)
-> (ToolCaller -> ToolCaller -> Bool) -> Eq ToolCaller
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToolCaller -> ToolCaller -> Bool
== :: ToolCaller -> ToolCaller -> Bool
$c/= :: ToolCaller -> ToolCaller -> Bool
/= :: ToolCaller -> ToolCaller -> Bool
Eq, Int -> ToolCaller -> ShowS
[ToolCaller] -> ShowS
ToolCaller -> String
(Int -> ToolCaller -> ShowS)
-> (ToolCaller -> String)
-> ([ToolCaller] -> ShowS)
-> Show ToolCaller
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolCaller -> ShowS
showsPrec :: Int -> ToolCaller -> ShowS
$cshow :: ToolCaller -> String
show :: ToolCaller -> String
$cshowList :: [ToolCaller] -> ShowS
showList :: [ToolCaller] -> ShowS
Show)

instance FromJSON ToolCaller where
    parseJSON :: Value -> Parser ToolCaller
parseJSON = String
-> (Object -> Parser ToolCaller) -> Value -> Parser ToolCaller
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ToolCaller" ((Object -> Parser ToolCaller) -> Value -> Parser ToolCaller)
-> (Object -> Parser ToolCaller) -> Value -> Parser ToolCaller
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
t <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"type"
        case (Text
t :: Text) of
            Text
"direct" -> ToolCaller -> Parser ToolCaller
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ToolCaller
ToolCaller_Direct
            Text
"code_execution_20250825" -> do
                Text
tool_id <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"tool_id"
                ToolCaller -> Parser ToolCaller
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ToolCaller_CodeExecution{ Text
tool_id :: Text
tool_id :: Text
tool_id }
            Text
_ -> ToolCaller -> Parser ToolCaller
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ToolCaller
ToolCaller_Unknown (Object -> Value
Aeson.Object Object
o))

instance ToJSON ToolCaller where
    toJSON :: ToolCaller -> Value
toJSON ToolCaller
ToolCaller_Direct = [Pair] -> Value
Aeson.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (Text
"direct" :: Text)
        ]
    toJSON (ToolCaller_CodeExecution Text
tid) = [Pair] -> Value
Aeson.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (Text
"code_execution_20250825" :: Text)
        , Key
"tool_id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
tid
        ]
    toJSON (ToolCaller_Unknown Value
v) = Value
v

-- | Result from code execution
--
-- Contains stdout, stderr, return code, and any additional content
-- (e.g., generated files, images).
data CodeExecutionResult = CodeExecutionResult
    { CodeExecutionResult -> Text
stdout :: Text
    , CodeExecutionResult -> Text
stderr :: Text
    , CodeExecutionResult -> Int
return_code :: Int
    , CodeExecutionResult -> Vector Value
content :: Vector Value
    } deriving stock (CodeExecutionResult -> CodeExecutionResult -> Bool
(CodeExecutionResult -> CodeExecutionResult -> Bool)
-> (CodeExecutionResult -> CodeExecutionResult -> Bool)
-> Eq CodeExecutionResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeExecutionResult -> CodeExecutionResult -> Bool
== :: CodeExecutionResult -> CodeExecutionResult -> Bool
$c/= :: CodeExecutionResult -> CodeExecutionResult -> Bool
/= :: CodeExecutionResult -> CodeExecutionResult -> Bool
Eq, (forall x. CodeExecutionResult -> Rep CodeExecutionResult x)
-> (forall x. Rep CodeExecutionResult x -> CodeExecutionResult)
-> Generic CodeExecutionResult
forall x. Rep CodeExecutionResult x -> CodeExecutionResult
forall x. CodeExecutionResult -> Rep CodeExecutionResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CodeExecutionResult -> Rep CodeExecutionResult x
from :: forall x. CodeExecutionResult -> Rep CodeExecutionResult x
$cto :: forall x. Rep CodeExecutionResult x -> CodeExecutionResult
to :: forall x. Rep CodeExecutionResult x -> CodeExecutionResult
Generic, Int -> CodeExecutionResult -> ShowS
[CodeExecutionResult] -> ShowS
CodeExecutionResult -> String
(Int -> CodeExecutionResult -> ShowS)
-> (CodeExecutionResult -> String)
-> ([CodeExecutionResult] -> ShowS)
-> Show CodeExecutionResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeExecutionResult -> ShowS
showsPrec :: Int -> CodeExecutionResult -> ShowS
$cshow :: CodeExecutionResult -> String
show :: CodeExecutionResult -> String
$cshowList :: [CodeExecutionResult] -> ShowS
showList :: [CodeExecutionResult] -> ShowS
Show)

instance FromJSON CodeExecutionResult where
    parseJSON :: Value -> Parser CodeExecutionResult
parseJSON = Options -> Value -> Parser CodeExecutionResult
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON CodeExecutionResult where
    toJSON :: CodeExecutionResult -> Value
toJSON = Options -> CodeExecutionResult -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Content of a code execution tool result
--
-- * 'CodeExecutionResultContent': Successful execution with stdout/stderr
-- * 'CodeExecutionToolResultContent_Unknown': Unknown content type (forward compatibility)
data CodeExecutionToolResultContent
    = CodeExecutionResultContent CodeExecutionResult
    | CodeExecutionToolResultContent_Unknown Value
    deriving stock (CodeExecutionToolResultContent
-> CodeExecutionToolResultContent -> Bool
(CodeExecutionToolResultContent
 -> CodeExecutionToolResultContent -> Bool)
-> (CodeExecutionToolResultContent
    -> CodeExecutionToolResultContent -> Bool)
-> Eq CodeExecutionToolResultContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeExecutionToolResultContent
-> CodeExecutionToolResultContent -> Bool
== :: CodeExecutionToolResultContent
-> CodeExecutionToolResultContent -> Bool
$c/= :: CodeExecutionToolResultContent
-> CodeExecutionToolResultContent -> Bool
/= :: CodeExecutionToolResultContent
-> CodeExecutionToolResultContent -> Bool
Eq, Int -> CodeExecutionToolResultContent -> ShowS
[CodeExecutionToolResultContent] -> ShowS
CodeExecutionToolResultContent -> String
(Int -> CodeExecutionToolResultContent -> ShowS)
-> (CodeExecutionToolResultContent -> String)
-> ([CodeExecutionToolResultContent] -> ShowS)
-> Show CodeExecutionToolResultContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodeExecutionToolResultContent -> ShowS
showsPrec :: Int -> CodeExecutionToolResultContent -> ShowS
$cshow :: CodeExecutionToolResultContent -> String
show :: CodeExecutionToolResultContent -> String
$cshowList :: [CodeExecutionToolResultContent] -> ShowS
showList :: [CodeExecutionToolResultContent] -> ShowS
Show)

instance FromJSON CodeExecutionToolResultContent where
    parseJSON :: Value -> Parser CodeExecutionToolResultContent
parseJSON = String
-> (Object -> Parser CodeExecutionToolResultContent)
-> Value
-> Parser CodeExecutionToolResultContent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"CodeExecutionToolResultContent" ((Object -> Parser CodeExecutionToolResultContent)
 -> Value -> Parser CodeExecutionToolResultContent)
-> (Object -> Parser CodeExecutionToolResultContent)
-> Value
-> Parser CodeExecutionToolResultContent
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
t <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"type"
        case (Text
t :: Text) of
            Text
"code_execution_result" -> do
                CodeExecutionResult
result <- Value -> Parser CodeExecutionResult
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON (Object -> Value
Aeson.Object Object
o)
                CodeExecutionToolResultContent
-> Parser CodeExecutionToolResultContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodeExecutionResult -> CodeExecutionToolResultContent
CodeExecutionResultContent CodeExecutionResult
result)
            Text
_ -> CodeExecutionToolResultContent
-> Parser CodeExecutionToolResultContent
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> CodeExecutionToolResultContent
CodeExecutionToolResultContent_Unknown (Object -> Value
Aeson.Object Object
o))

instance ToJSON CodeExecutionToolResultContent where
    toJSON :: CodeExecutionToolResultContent -> Value
toJSON (CodeExecutionResultContent CodeExecutionResult
result) =
        case CodeExecutionResult -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON CodeExecutionResult
result of
            Aeson.Object Object
o -> Object -> Value
Aeson.Object (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
"type" (Text -> Value
Aeson.String Text
"code_execution_result") Object
o)
            Value
v -> Value
v
    toJSON (CodeExecutionToolResultContent_Unknown Value
v) = Value
v

-- | Content block in a response
--
-- Extended to support:
--
-- * @server_tool_use@: Server-initiated tool use (e.g., tool search, code execution)
-- * @tool_search_tool_result@: Results from server-side tool search
-- * @code_execution_tool_result@: Results from code execution (PTC)
--
-- For programmatic tool calling, 'ContentBlock_Tool_Use' includes an optional
-- @caller@ field indicating whether the tool was called directly by Claude
-- or programmatically by code execution.
data ContentBlock
    = ContentBlock_Text { ContentBlock -> Text
text :: Text }
    | ContentBlock_Tool_Use
        { ContentBlock -> Text
id :: Text
        , ContentBlock -> Text
name :: Text
        , ContentBlock -> Value
input :: Value
        , ContentBlock -> Maybe ToolCaller
caller :: Maybe ToolCaller
        }
    | ContentBlock_Server_Tool_Use { id :: Text, name :: Text, input :: Value }
    | ContentBlock_Tool_Search_Tool_Result
        { ContentBlock -> Text
tool_use_id :: Text
        , ContentBlock -> ToolSearchToolResultContent
tool_search_content :: ToolSearchToolResultContent
        }
    | ContentBlock_Code_Execution_Tool_Result
        { tool_use_id :: Text
        , ContentBlock -> CodeExecutionToolResultContent
code_execution_content :: CodeExecutionToolResultContent
        }
    | ContentBlock_Unknown { ContentBlock -> Text
type_ :: Text, ContentBlock -> Value
raw :: Value }
    deriving stock ((forall x. ContentBlock -> Rep ContentBlock x)
-> (forall x. Rep ContentBlock x -> ContentBlock)
-> Generic ContentBlock
forall x. Rep ContentBlock x -> ContentBlock
forall x. ContentBlock -> Rep ContentBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContentBlock -> Rep ContentBlock x
from :: forall x. ContentBlock -> Rep ContentBlock x
$cto :: forall x. Rep ContentBlock x -> ContentBlock
to :: forall x. Rep ContentBlock x -> ContentBlock
Generic, Int -> ContentBlock -> ShowS
[ContentBlock] -> ShowS
ContentBlock -> String
(Int -> ContentBlock -> ShowS)
-> (ContentBlock -> String)
-> ([ContentBlock] -> ShowS)
-> Show ContentBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentBlock -> ShowS
showsPrec :: Int -> ContentBlock -> ShowS
$cshow :: ContentBlock -> String
show :: ContentBlock -> String
$cshowList :: [ContentBlock] -> ShowS
showList :: [ContentBlock] -> ShowS
Show)

instance FromJSON ContentBlock where
    parseJSON :: Value -> Parser ContentBlock
parseJSON = String
-> (Object -> Parser ContentBlock) -> Value -> Parser ContentBlock
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ContentBlock" ((Object -> Parser ContentBlock) -> Value -> Parser ContentBlock)
-> (Object -> Parser ContentBlock) -> Value -> Parser ContentBlock
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
t <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"type"
        case (Text
t :: Text) of
            Text
"text" -> Text -> ContentBlock
ContentBlock_Text (Text -> ContentBlock) -> Parser Text -> Parser ContentBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"text"
            Text
"tool_use" -> Text -> Text -> Value -> Maybe ToolCaller -> ContentBlock
ContentBlock_Tool_Use
                (Text -> Text -> Value -> Maybe ToolCaller -> ContentBlock)
-> Parser Text
-> Parser (Text -> Value -> Maybe ToolCaller -> ContentBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"id"
                Parser (Text -> Value -> Maybe ToolCaller -> ContentBlock)
-> Parser Text
-> Parser (Value -> Maybe ToolCaller -> ContentBlock)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"name"
                Parser (Value -> Maybe ToolCaller -> ContentBlock)
-> Parser Value -> Parser (Maybe ToolCaller -> ContentBlock)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"input"
                Parser (Maybe ToolCaller -> ContentBlock)
-> Parser (Maybe ToolCaller) -> Parser ContentBlock
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ToolCaller)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:? Key
"caller"
            Text
"server_tool_use" -> Text -> Text -> Value -> ContentBlock
ContentBlock_Server_Tool_Use
                (Text -> Text -> Value -> ContentBlock)
-> Parser Text -> Parser (Text -> Value -> ContentBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"id"
                Parser (Text -> Value -> ContentBlock)
-> Parser Text -> Parser (Value -> ContentBlock)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"name"
                Parser (Value -> ContentBlock)
-> Parser Value -> Parser ContentBlock
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"input"
            Text
"tool_search_tool_result" -> do
                Text
toolUseId <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"tool_use_id"
                ToolSearchToolResultContent
searchContent <- Object
o Object -> Key -> Parser ToolSearchToolResultContent
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"content"
                ContentBlock -> Parser ContentBlock
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContentBlock_Tool_Search_Tool_Result
                    { tool_use_id :: Text
tool_use_id = Text
toolUseId
                    , tool_search_content :: ToolSearchToolResultContent
tool_search_content = ToolSearchToolResultContent
searchContent
                    }
            Text
"code_execution_tool_result" -> do
                Text
toolUseId <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"tool_use_id"
                CodeExecutionToolResultContent
execContent <- Object
o Object -> Key -> Parser CodeExecutionToolResultContent
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"content"
                ContentBlock -> Parser ContentBlock
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContentBlock_Code_Execution_Tool_Result
                    { tool_use_id :: Text
tool_use_id = Text
toolUseId
                    , code_execution_content :: CodeExecutionToolResultContent
code_execution_content = CodeExecutionToolResultContent
execContent
                    }
            Text
_ -> ContentBlock -> Parser ContentBlock
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Value -> ContentBlock
ContentBlock_Unknown Text
t (Object -> Value
Aeson.Object Object
o))

instance ToJSON ContentBlock where
    toJSON :: ContentBlock -> Value
toJSON (ContentBlock_Text Text
t) = [Pair] -> Value
Aeson.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (Text
"text" :: Text)
        , Key
"text" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
t
        ]
    toJSON (ContentBlock_Tool_Use Text
toolId Text
toolName Value
toolInput Maybe ToolCaller
toolCaller) = [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (Text
"tool_use" :: Text)
        , Key
"id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
toolId
        , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
toolName
        , Key
"input" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Value
toolInput
        ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair] -> (ToolCaller -> [Pair]) -> Maybe ToolCaller -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ToolCaller
c -> [Key
"caller" Key -> ToolCaller -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= ToolCaller
c]) Maybe ToolCaller
toolCaller
    toJSON (ContentBlock_Server_Tool_Use Text
toolId Text
toolName Value
toolInput) = [Pair] -> Value
Aeson.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (Text
"server_tool_use" :: Text)
        , Key
"id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
toolId
        , Key
"name" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
toolName
        , Key
"input" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Value
toolInput
        ]
    toJSON (ContentBlock_Tool_Search_Tool_Result Text
toolUseId ToolSearchToolResultContent
searchContent) = [Pair] -> Value
Aeson.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (Text
"tool_search_tool_result" :: Text)
        , Key
"tool_use_id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
toolUseId
        , Key
"content" Key -> ToolSearchToolResultContent -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= ToolSearchToolResultContent
searchContent
        ]
    toJSON (ContentBlock_Code_Execution_Tool_Result Text
toolUseId CodeExecutionToolResultContent
execContent) = [Pair] -> Value
Aeson.object
        [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= (Text
"code_execution_tool_result" :: Text)
        , Key
"tool_use_id" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
toolUseId
        , Key
"content" Key -> CodeExecutionToolResultContent -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= CodeExecutionToolResultContent
execContent
        ]
    toJSON (ContentBlock_Unknown Text
_typeName Value
rawVal) = Value
rawVal

-- | A message in the conversation
--
-- The optional @cache_control@ field allows setting cache breakpoints at
-- the message level (in addition to content-level caching).
data Message = Message
    { Message -> Role
role :: Role
    , Message -> Vector Content
content :: Vector Content
    , Message -> Maybe CacheControl
cache_control :: Maybe CacheControl
    } deriving stock ((forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Message -> Rep Message x
from :: forall x. Message -> Rep Message x
$cto :: forall x. Rep Message x -> Message
to :: forall x. Rep Message x -> Message
Generic, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> String
show :: Message -> String
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show)

instance FromJSON Message where
    parseJSON :: Value -> Parser Message
parseJSON = Options -> Value -> Parser Message
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON Message where
    toJSON :: Message -> Value
toJSON = Options -> Message -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Reason why the model stopped generating
data StopReason
    = End_Turn
    | Max_Tokens
    | Stop_Sequence
    | Tool_Use
    | Refusal
    -- ^ Model refused the request for safety reasons (structured outputs only)
    deriving stock (StopReason -> StopReason -> Bool
(StopReason -> StopReason -> Bool)
-> (StopReason -> StopReason -> Bool) -> Eq StopReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StopReason -> StopReason -> Bool
== :: StopReason -> StopReason -> Bool
$c/= :: StopReason -> StopReason -> Bool
/= :: StopReason -> StopReason -> Bool
Eq, (forall x. StopReason -> Rep StopReason x)
-> (forall x. Rep StopReason x -> StopReason) -> Generic StopReason
forall x. Rep StopReason x -> StopReason
forall x. StopReason -> Rep StopReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StopReason -> Rep StopReason x
from :: forall x. StopReason -> Rep StopReason x
$cto :: forall x. Rep StopReason x -> StopReason
to :: forall x. Rep StopReason x -> StopReason
Generic, Int -> StopReason -> ShowS
[StopReason] -> ShowS
StopReason -> String
(Int -> StopReason -> ShowS)
-> (StopReason -> String)
-> ([StopReason] -> ShowS)
-> Show StopReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StopReason -> ShowS
showsPrec :: Int -> StopReason -> ShowS
$cshow :: StopReason -> String
show :: StopReason -> String
$cshowList :: [StopReason] -> ShowS
showList :: [StopReason] -> ShowS
Show)

stopReasonOptions :: Options
stopReasonOptions :: Options
stopReasonOptions = Options
aesonOptions
    { constructorTagModifier = stripPrefix "" }

instance FromJSON StopReason where
    parseJSON :: Value -> Parser StopReason
parseJSON = Options -> Value -> Parser StopReason
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
stopReasonOptions

instance ToJSON StopReason where
    toJSON :: StopReason -> Value
toJSON = Options -> StopReason -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
stopReasonOptions

-- | Server tool use usage information (e.g., tool search requests, web search requests)
data ServerToolUseUsage = ServerToolUseUsage
    { ServerToolUseUsage -> Maybe Natural
web_search_requests :: Maybe Natural
    , ServerToolUseUsage -> Maybe Natural
tool_search_requests :: Maybe Natural
    } deriving stock (ServerToolUseUsage -> ServerToolUseUsage -> Bool
(ServerToolUseUsage -> ServerToolUseUsage -> Bool)
-> (ServerToolUseUsage -> ServerToolUseUsage -> Bool)
-> Eq ServerToolUseUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerToolUseUsage -> ServerToolUseUsage -> Bool
== :: ServerToolUseUsage -> ServerToolUseUsage -> Bool
$c/= :: ServerToolUseUsage -> ServerToolUseUsage -> Bool
/= :: ServerToolUseUsage -> ServerToolUseUsage -> Bool
Eq, (forall x. ServerToolUseUsage -> Rep ServerToolUseUsage x)
-> (forall x. Rep ServerToolUseUsage x -> ServerToolUseUsage)
-> Generic ServerToolUseUsage
forall x. Rep ServerToolUseUsage x -> ServerToolUseUsage
forall x. ServerToolUseUsage -> Rep ServerToolUseUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerToolUseUsage -> Rep ServerToolUseUsage x
from :: forall x. ServerToolUseUsage -> Rep ServerToolUseUsage x
$cto :: forall x. Rep ServerToolUseUsage x -> ServerToolUseUsage
to :: forall x. Rep ServerToolUseUsage x -> ServerToolUseUsage
Generic, Int -> ServerToolUseUsage -> ShowS
[ServerToolUseUsage] -> ShowS
ServerToolUseUsage -> String
(Int -> ServerToolUseUsage -> ShowS)
-> (ServerToolUseUsage -> String)
-> ([ServerToolUseUsage] -> ShowS)
-> Show ServerToolUseUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerToolUseUsage -> ShowS
showsPrec :: Int -> ServerToolUseUsage -> ShowS
$cshow :: ServerToolUseUsage -> String
show :: ServerToolUseUsage -> String
$cshowList :: [ServerToolUseUsage] -> ShowS
showList :: [ServerToolUseUsage] -> ShowS
Show)

instance FromJSON ServerToolUseUsage where
    parseJSON :: Value -> Parser ServerToolUseUsage
parseJSON = Options -> Value -> Parser ServerToolUseUsage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON ServerToolUseUsage where
    toJSON :: ServerToolUseUsage -> Value
toJSON = Options -> ServerToolUseUsage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Token usage information
data Usage = Usage
    { Usage -> Natural
input_tokens :: Natural
    , Usage -> Natural
output_tokens :: Natural
    , Usage -> Maybe Natural
cache_creation_input_tokens :: Maybe Natural
    , Usage -> Maybe Natural
cache_read_input_tokens :: Maybe Natural
    , Usage -> Maybe ServerToolUseUsage
server_tool_use :: Maybe ServerToolUseUsage
    } deriving stock ((forall x. Usage -> Rep Usage x)
-> (forall x. Rep Usage x -> Usage) -> Generic Usage
forall x. Rep Usage x -> Usage
forall x. Usage -> Rep Usage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Usage -> Rep Usage x
from :: forall x. Usage -> Rep Usage x
$cto :: forall x. Rep Usage x -> Usage
to :: forall x. Rep Usage x -> Usage
Generic, Int -> Usage -> ShowS
[Usage] -> ShowS
Usage -> String
(Int -> Usage -> ShowS)
-> (Usage -> String) -> ([Usage] -> ShowS) -> Show Usage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Usage -> ShowS
showsPrec :: Int -> Usage -> ShowS
$cshow :: Usage -> String
show :: Usage -> String
$cshowList :: [Usage] -> ShowS
showList :: [Usage] -> ShowS
Show)

instance FromJSON Usage where
    parseJSON :: Value -> Parser Usage
parseJSON = Options -> Value -> Parser Usage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON Usage where
    toJSON :: Usage -> Value
toJSON = Options -> Usage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Response from the Messages API
--
-- For programmatic tool calling (PTC), the @container@ field contains
-- information about the code execution container, which can be reused
-- across turns by passing its @id@ in subsequent requests.
data MessageResponse = MessageResponse
    { MessageResponse -> Text
id :: Text
    , MessageResponse -> Text
type_ :: Text
    , MessageResponse -> Role
role :: Role
    , MessageResponse -> Vector ContentBlock
content :: Vector ContentBlock
    , MessageResponse -> Text
model :: Text
    , MessageResponse -> Maybe StopReason
stop_reason :: Maybe StopReason
    , MessageResponse -> Maybe Text
stop_sequence :: Maybe Text
    , MessageResponse -> Usage
usage :: Usage
    , MessageResponse -> Maybe ContainerInfo
container :: Maybe ContainerInfo
    } deriving stock ((forall x. MessageResponse -> Rep MessageResponse x)
-> (forall x. Rep MessageResponse x -> MessageResponse)
-> Generic MessageResponse
forall x. Rep MessageResponse x -> MessageResponse
forall x. MessageResponse -> Rep MessageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageResponse -> Rep MessageResponse x
from :: forall x. MessageResponse -> Rep MessageResponse x
$cto :: forall x. Rep MessageResponse x -> MessageResponse
to :: forall x. Rep MessageResponse x -> MessageResponse
Generic, Int -> MessageResponse -> ShowS
[MessageResponse] -> ShowS
MessageResponse -> String
(Int -> MessageResponse -> ShowS)
-> (MessageResponse -> String)
-> ([MessageResponse] -> ShowS)
-> Show MessageResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageResponse -> ShowS
showsPrec :: Int -> MessageResponse -> ShowS
$cshow :: MessageResponse -> String
show :: MessageResponse -> String
$cshowList :: [MessageResponse] -> ShowS
showList :: [MessageResponse] -> ShowS
Show)

instance FromJSON MessageResponse where
    parseJSON :: Value -> Parser MessageResponse
parseJSON = Options -> Value -> Parser MessageResponse
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON MessageResponse where
    toJSON :: MessageResponse -> Value
toJSON = Options -> MessageResponse -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Output format specification for structured outputs
--
-- Use with the @structured-outputs-2025-11-13@ beta header.
--
-- Example:
--
-- @
-- let outputFormat = jsonSchemaFormat $ Aeson.object
--         [ "type" .= ("object" :: Text)
--         , "properties" .= Aeson.object
--             [ "name" .= Aeson.object ["type" .= ("string" :: Text)]
--             , "age" .= Aeson.object ["type" .= ("integer" :: Text)]
--             ]
--         , "required" .= (["name", "age"] :: [Text])
--         , "additionalProperties" .= False
--         ]
-- @
data OutputFormat = OutputFormat
    { OutputFormat -> Text
type_ :: Text    -- ^ Currently only "json_schema" is supported
    , OutputFormat -> Value
schema :: Value  -- ^ JSON Schema for the output
    } deriving stock (OutputFormat -> OutputFormat -> Bool
(OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputFormat -> OutputFormat -> Bool
== :: OutputFormat -> OutputFormat -> Bool
$c/= :: OutputFormat -> OutputFormat -> Bool
/= :: OutputFormat -> OutputFormat -> Bool
Eq, (forall x. OutputFormat -> Rep OutputFormat x)
-> (forall x. Rep OutputFormat x -> OutputFormat)
-> Generic OutputFormat
forall x. Rep OutputFormat x -> OutputFormat
forall x. OutputFormat -> Rep OutputFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OutputFormat -> Rep OutputFormat x
from :: forall x. OutputFormat -> Rep OutputFormat x
$cto :: forall x. Rep OutputFormat x -> OutputFormat
to :: forall x. Rep OutputFormat x -> OutputFormat
Generic, Int -> OutputFormat -> ShowS
[OutputFormat] -> ShowS
OutputFormat -> String
(Int -> OutputFormat -> ShowS)
-> (OutputFormat -> String)
-> ([OutputFormat] -> ShowS)
-> Show OutputFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputFormat -> ShowS
showsPrec :: Int -> OutputFormat -> ShowS
$cshow :: OutputFormat -> String
show :: OutputFormat -> String
$cshowList :: [OutputFormat] -> ShowS
showList :: [OutputFormat] -> ShowS
Show)

instance FromJSON OutputFormat where
    parseJSON :: Value -> Parser OutputFormat
parseJSON = Options -> Value -> Parser OutputFormat
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON OutputFormat where
    toJSON :: OutputFormat -> Value
toJSON = Options -> OutputFormat -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Create a JSON schema output format
--
-- This is the primary way to use structured outputs.
jsonSchemaFormat :: Value -> OutputFormat
jsonSchemaFormat :: Value -> OutputFormat
jsonSchemaFormat Value
s = OutputFormat
    { type_ :: Text
type_ = Text
"json_schema"
    , schema :: Value
schema = Value
s
    }

-- | Request body for @\/v1\/messages@
--
-- For programmatic tool calling (PTC), use the @container@ field to reuse
-- a code execution container from a previous response.
data CreateMessage = CreateMessage
    { CreateMessage -> Text
model :: Text
    , CreateMessage -> Vector Message
messages :: Vector Message
    , CreateMessage -> Natural
max_tokens :: Natural
    , CreateMessage -> Maybe Text
system :: Maybe Text
    , CreateMessage -> Maybe Double
temperature :: Maybe Double
    , CreateMessage -> Maybe Double
top_p :: Maybe Double
    , CreateMessage -> Maybe Natural
top_k :: Maybe Natural
    , CreateMessage -> Maybe (Vector Text)
stop_sequences :: Maybe (Vector Text)
    , CreateMessage -> Maybe Bool
stream :: Maybe Bool
    , CreateMessage -> Maybe (Map Text Text)
metadata :: Maybe (Map Text Text)
    , CreateMessage -> Maybe (Vector ToolDefinition)
tools :: Maybe (Vector ToolDefinition)
    , CreateMessage -> Maybe ToolChoice
tool_choice :: Maybe ToolChoice
    , CreateMessage -> Maybe Text
container :: Maybe Text
    , CreateMessage -> Maybe OutputFormat
output_format :: Maybe OutputFormat
    -- ^ Structured output format (requires @structured-outputs-2025-11-13@ beta header)
    } deriving stock ((forall x. CreateMessage -> Rep CreateMessage x)
-> (forall x. Rep CreateMessage x -> CreateMessage)
-> Generic CreateMessage
forall x. Rep CreateMessage x -> CreateMessage
forall x. CreateMessage -> Rep CreateMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateMessage -> Rep CreateMessage x
from :: forall x. CreateMessage -> Rep CreateMessage x
$cto :: forall x. Rep CreateMessage x -> CreateMessage
to :: forall x. Rep CreateMessage x -> CreateMessage
Generic, Int -> CreateMessage -> ShowS
[CreateMessage] -> ShowS
CreateMessage -> String
(Int -> CreateMessage -> ShowS)
-> (CreateMessage -> String)
-> ([CreateMessage] -> ShowS)
-> Show CreateMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateMessage -> ShowS
showsPrec :: Int -> CreateMessage -> ShowS
$cshow :: CreateMessage -> String
show :: CreateMessage -> String
$cshowList :: [CreateMessage] -> ShowS
showList :: [CreateMessage] -> ShowS
Show)

instance FromJSON CreateMessage where
    parseJSON :: Value -> Parser CreateMessage
parseJSON = Options -> Value -> Parser CreateMessage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON CreateMessage where
    toJSON :: CreateMessage -> Value
toJSON = Options -> CreateMessage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Default CreateMessage with only required fields
_CreateMessage :: CreateMessage
_CreateMessage :: CreateMessage
_CreateMessage = CreateMessage
    { model :: Text
model = Text
""
    , messages :: Vector Message
messages = Vector Message
forall a. Monoid a => a
mempty
    , max_tokens :: Natural
max_tokens = Natural
1024
    , system :: Maybe Text
system = Maybe Text
forall a. Maybe a
Nothing
    , temperature :: Maybe Double
temperature = Maybe Double
forall a. Maybe a
Nothing
    , top_p :: Maybe Double
top_p = Maybe Double
forall a. Maybe a
Nothing
    , top_k :: Maybe Natural
top_k = Maybe Natural
forall a. Maybe a
Nothing
    , stop_sequences :: Maybe (Vector Text)
stop_sequences = Maybe (Vector Text)
forall a. Maybe a
Nothing
    , stream :: Maybe Bool
stream = Maybe Bool
forall a. Maybe a
Nothing
    , metadata :: Maybe (Map Text Text)
metadata = Maybe (Map Text Text)
forall a. Maybe a
Nothing
    , tools :: Maybe (Vector ToolDefinition)
tools = Maybe (Vector ToolDefinition)
forall a. Maybe a
Nothing
    , tool_choice :: Maybe ToolChoice
tool_choice = Maybe ToolChoice
forall a. Maybe a
Nothing
    , container :: Maybe Text
container = Maybe Text
forall a. Maybe a
Nothing
    , output_format :: Maybe OutputFormat
output_format = Maybe OutputFormat
forall a. Maybe a
Nothing
    }

-- | Text delta in streaming
data TextDelta = TextDelta
    { TextDelta -> Text
text :: Text
    } deriving stock ((forall x. TextDelta -> Rep TextDelta x)
-> (forall x. Rep TextDelta x -> TextDelta) -> Generic TextDelta
forall x. Rep TextDelta x -> TextDelta
forall x. TextDelta -> Rep TextDelta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextDelta -> Rep TextDelta x
from :: forall x. TextDelta -> Rep TextDelta x
$cto :: forall x. Rep TextDelta x -> TextDelta
to :: forall x. Rep TextDelta x -> TextDelta
Generic, Int -> TextDelta -> ShowS
[TextDelta] -> ShowS
TextDelta -> String
(Int -> TextDelta -> ShowS)
-> (TextDelta -> String)
-> ([TextDelta] -> ShowS)
-> Show TextDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextDelta -> ShowS
showsPrec :: Int -> TextDelta -> ShowS
$cshow :: TextDelta -> String
show :: TextDelta -> String
$cshowList :: [TextDelta] -> ShowS
showList :: [TextDelta] -> ShowS
Show)
      deriving anyclass (Maybe TextDelta
Value -> Parser [TextDelta]
Value -> Parser TextDelta
(Value -> Parser TextDelta)
-> (Value -> Parser [TextDelta])
-> Maybe TextDelta
-> FromJSON TextDelta
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TextDelta
parseJSON :: Value -> Parser TextDelta
$cparseJSONList :: Value -> Parser [TextDelta]
parseJSONList :: Value -> Parser [TextDelta]
$comittedField :: Maybe TextDelta
omittedField :: Maybe TextDelta
FromJSON, [TextDelta] -> Value
[TextDelta] -> Encoding
TextDelta -> Bool
TextDelta -> Value
TextDelta -> Encoding
(TextDelta -> Value)
-> (TextDelta -> Encoding)
-> ([TextDelta] -> Value)
-> ([TextDelta] -> Encoding)
-> (TextDelta -> Bool)
-> ToJSON TextDelta
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TextDelta -> Value
toJSON :: TextDelta -> Value
$ctoEncoding :: TextDelta -> Encoding
toEncoding :: TextDelta -> Encoding
$ctoJSONList :: [TextDelta] -> Value
toJSONList :: [TextDelta] -> Value
$ctoEncodingList :: [TextDelta] -> Encoding
toEncodingList :: [TextDelta] -> Encoding
$comitField :: TextDelta -> Bool
omitField :: TextDelta -> Bool
ToJSON)

-- | Input JSON delta in streaming (for tool use)
data InputJsonDelta = InputJsonDelta
    { InputJsonDelta -> Text
partial_json :: Text
    } deriving stock ((forall x. InputJsonDelta -> Rep InputJsonDelta x)
-> (forall x. Rep InputJsonDelta x -> InputJsonDelta)
-> Generic InputJsonDelta
forall x. Rep InputJsonDelta x -> InputJsonDelta
forall x. InputJsonDelta -> Rep InputJsonDelta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputJsonDelta -> Rep InputJsonDelta x
from :: forall x. InputJsonDelta -> Rep InputJsonDelta x
$cto :: forall x. Rep InputJsonDelta x -> InputJsonDelta
to :: forall x. Rep InputJsonDelta x -> InputJsonDelta
Generic, Int -> InputJsonDelta -> ShowS
[InputJsonDelta] -> ShowS
InputJsonDelta -> String
(Int -> InputJsonDelta -> ShowS)
-> (InputJsonDelta -> String)
-> ([InputJsonDelta] -> ShowS)
-> Show InputJsonDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputJsonDelta -> ShowS
showsPrec :: Int -> InputJsonDelta -> ShowS
$cshow :: InputJsonDelta -> String
show :: InputJsonDelta -> String
$cshowList :: [InputJsonDelta] -> ShowS
showList :: [InputJsonDelta] -> ShowS
Show)

instance FromJSON InputJsonDelta where
    parseJSON :: Value -> Parser InputJsonDelta
parseJSON = Options -> Value -> Parser InputJsonDelta
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON InputJsonDelta where
    toJSON :: InputJsonDelta -> Value
toJSON = Options -> InputJsonDelta -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Content block delta in streaming
data ContentBlockDelta
    = Delta_Text_Delta { ContentBlockDelta -> Text
text :: Text }
    | Delta_Input_Json_Delta { ContentBlockDelta -> Text
partial_json :: Text }
    deriving stock ((forall x. ContentBlockDelta -> Rep ContentBlockDelta x)
-> (forall x. Rep ContentBlockDelta x -> ContentBlockDelta)
-> Generic ContentBlockDelta
forall x. Rep ContentBlockDelta x -> ContentBlockDelta
forall x. ContentBlockDelta -> Rep ContentBlockDelta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContentBlockDelta -> Rep ContentBlockDelta x
from :: forall x. ContentBlockDelta -> Rep ContentBlockDelta x
$cto :: forall x. Rep ContentBlockDelta x -> ContentBlockDelta
to :: forall x. Rep ContentBlockDelta x -> ContentBlockDelta
Generic, Int -> ContentBlockDelta -> ShowS
[ContentBlockDelta] -> ShowS
ContentBlockDelta -> String
(Int -> ContentBlockDelta -> ShowS)
-> (ContentBlockDelta -> String)
-> ([ContentBlockDelta] -> ShowS)
-> Show ContentBlockDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentBlockDelta -> ShowS
showsPrec :: Int -> ContentBlockDelta -> ShowS
$cshow :: ContentBlockDelta -> String
show :: ContentBlockDelta -> String
$cshowList :: [ContentBlockDelta] -> ShowS
showList :: [ContentBlockDelta] -> ShowS
Show)

contentBlockDeltaOptions :: Options
contentBlockDeltaOptions :: Options
contentBlockDeltaOptions = Options
aesonOptions
    { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }
    , tagSingleConstructors = True
    , constructorTagModifier = \String
s -> case String
s of
        String
"Delta_Text_Delta" -> String
"text_delta"
        String
"Delta_Input_Json_Delta" -> String
"input_json_delta"
        String
_ -> String
s
    }

instance FromJSON ContentBlockDelta where
    parseJSON :: Value -> Parser ContentBlockDelta
parseJSON = Options -> Value -> Parser ContentBlockDelta
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
contentBlockDeltaOptions

instance ToJSON ContentBlockDelta where
    toJSON :: ContentBlockDelta -> Value
toJSON = Options -> ContentBlockDelta -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
contentBlockDeltaOptions

-- | Message delta in streaming (for stop_reason, etc.)
data MessageDelta = MessageDelta
    { MessageDelta -> Maybe StopReason
stop_reason :: Maybe StopReason
    , MessageDelta -> Maybe Text
stop_sequence :: Maybe Text
    } deriving stock ((forall x. MessageDelta -> Rep MessageDelta x)
-> (forall x. Rep MessageDelta x -> MessageDelta)
-> Generic MessageDelta
forall x. Rep MessageDelta x -> MessageDelta
forall x. MessageDelta -> Rep MessageDelta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageDelta -> Rep MessageDelta x
from :: forall x. MessageDelta -> Rep MessageDelta x
$cto :: forall x. Rep MessageDelta x -> MessageDelta
to :: forall x. Rep MessageDelta x -> MessageDelta
Generic, Int -> MessageDelta -> ShowS
[MessageDelta] -> ShowS
MessageDelta -> String
(Int -> MessageDelta -> ShowS)
-> (MessageDelta -> String)
-> ([MessageDelta] -> ShowS)
-> Show MessageDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageDelta -> ShowS
showsPrec :: Int -> MessageDelta -> ShowS
$cshow :: MessageDelta -> String
show :: MessageDelta -> String
$cshowList :: [MessageDelta] -> ShowS
showList :: [MessageDelta] -> ShowS
Show)

instance FromJSON MessageDelta where
    parseJSON :: Value -> Parser MessageDelta
parseJSON = Options -> Value -> Parser MessageDelta
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON MessageDelta where
    toJSON :: MessageDelta -> Value
toJSON = Options -> MessageDelta -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Usage in streaming message_delta events
data StreamUsage = StreamUsage
    { StreamUsage -> Natural
output_tokens :: Natural
    } deriving stock ((forall x. StreamUsage -> Rep StreamUsage x)
-> (forall x. Rep StreamUsage x -> StreamUsage)
-> Generic StreamUsage
forall x. Rep StreamUsage x -> StreamUsage
forall x. StreamUsage -> Rep StreamUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StreamUsage -> Rep StreamUsage x
from :: forall x. StreamUsage -> Rep StreamUsage x
$cto :: forall x. Rep StreamUsage x -> StreamUsage
to :: forall x. Rep StreamUsage x -> StreamUsage
Generic, Int -> StreamUsage -> ShowS
[StreamUsage] -> ShowS
StreamUsage -> String
(Int -> StreamUsage -> ShowS)
-> (StreamUsage -> String)
-> ([StreamUsage] -> ShowS)
-> Show StreamUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StreamUsage -> ShowS
showsPrec :: Int -> StreamUsage -> ShowS
$cshow :: StreamUsage -> String
show :: StreamUsage -> String
$cshowList :: [StreamUsage] -> ShowS
showList :: [StreamUsage] -> ShowS
Show)

instance FromJSON StreamUsage where
    parseJSON :: Value -> Parser StreamUsage
parseJSON = Options -> Value -> Parser StreamUsage
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON StreamUsage where
    toJSON :: StreamUsage -> Value
toJSON = Options -> StreamUsage -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Streaming events for @\/v1\/messages@
data MessageStreamEvent
    = Message_Start
        { MessageStreamEvent -> MessageResponse
message :: MessageResponse
        }
    | Content_Block_Start
        { MessageStreamEvent -> Natural
index :: Natural
        , MessageStreamEvent -> ContentBlock
content_block :: ContentBlock
        }
    | Content_Block_Delta
        { index :: Natural
        , MessageStreamEvent -> ContentBlockDelta
delta :: ContentBlockDelta
        }
    | Content_Block_Stop
        { index :: Natural
        }
    | Message_Delta
        { MessageStreamEvent -> MessageDelta
message_delta :: MessageDelta
        , MessageStreamEvent -> StreamUsage
usage :: StreamUsage
        }
    | Message_Stop
    | Ping
    | Error
        { MessageStreamEvent -> Value
error :: Value
        }
    deriving stock ((forall x. MessageStreamEvent -> Rep MessageStreamEvent x)
-> (forall x. Rep MessageStreamEvent x -> MessageStreamEvent)
-> Generic MessageStreamEvent
forall x. Rep MessageStreamEvent x -> MessageStreamEvent
forall x. MessageStreamEvent -> Rep MessageStreamEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageStreamEvent -> Rep MessageStreamEvent x
from :: forall x. MessageStreamEvent -> Rep MessageStreamEvent x
$cto :: forall x. Rep MessageStreamEvent x -> MessageStreamEvent
to :: forall x. Rep MessageStreamEvent x -> MessageStreamEvent
Generic, Int -> MessageStreamEvent -> ShowS
[MessageStreamEvent] -> ShowS
MessageStreamEvent -> String
(Int -> MessageStreamEvent -> ShowS)
-> (MessageStreamEvent -> String)
-> ([MessageStreamEvent] -> ShowS)
-> Show MessageStreamEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageStreamEvent -> ShowS
showsPrec :: Int -> MessageStreamEvent -> ShowS
$cshow :: MessageStreamEvent -> String
show :: MessageStreamEvent -> String
$cshowList :: [MessageStreamEvent] -> ShowS
showList :: [MessageStreamEvent] -> ShowS
Show)

messageStreamEventOptions :: Options
messageStreamEventOptions :: Options
messageStreamEventOptions = Options
aesonOptions
    { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }
    , tagSingleConstructors = True
    , constructorTagModifier = \String
s -> case String
s of
        String
"Message_Start" -> String
"message_start"
        String
"Content_Block_Start" -> String
"content_block_start"
        String
"Content_Block_Delta" -> String
"content_block_delta"
        String
"Content_Block_Stop" -> String
"content_block_stop"
        String
"Message_Delta" -> String
"message_delta"
        String
"Message_Stop" -> String
"message_stop"
        String
"Ping" -> String
"ping"
        String
"Error" -> String
"error"
        String
_ -> String
s
    , fieldLabelModifier = \String
s -> case String
s of
        String
"message_delta" -> String
"delta"
        String
other -> ShowS
labelModifier String
other
    }

instance FromJSON MessageStreamEvent where
    parseJSON :: Value -> Parser MessageStreamEvent
parseJSON = Options -> Value -> Parser MessageStreamEvent
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
messageStreamEventOptions

instance ToJSON MessageStreamEvent where
    toJSON :: MessageStreamEvent -> Value
toJSON = Options -> MessageStreamEvent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
messageStreamEventOptions

-- | Request body for @\/v1\/messages\/count_tokens@
--
-- Note: This differs from CreateMessage - it doesn't include max_tokens
-- and other generation parameters.
data CountTokensRequest = CountTokensRequest
    { CountTokensRequest -> Text
model :: Text
    , CountTokensRequest -> Vector Message
messages :: Vector Message
    , CountTokensRequest -> Maybe Text
system :: Maybe Text
    , CountTokensRequest -> Maybe (Vector ToolDefinition)
tools :: Maybe (Vector ToolDefinition)
    , CountTokensRequest -> Maybe ToolChoice
tool_choice :: Maybe ToolChoice
    } deriving stock ((forall x. CountTokensRequest -> Rep CountTokensRequest x)
-> (forall x. Rep CountTokensRequest x -> CountTokensRequest)
-> Generic CountTokensRequest
forall x. Rep CountTokensRequest x -> CountTokensRequest
forall x. CountTokensRequest -> Rep CountTokensRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CountTokensRequest -> Rep CountTokensRequest x
from :: forall x. CountTokensRequest -> Rep CountTokensRequest x
$cto :: forall x. Rep CountTokensRequest x -> CountTokensRequest
to :: forall x. Rep CountTokensRequest x -> CountTokensRequest
Generic, Int -> CountTokensRequest -> ShowS
[CountTokensRequest] -> ShowS
CountTokensRequest -> String
(Int -> CountTokensRequest -> ShowS)
-> (CountTokensRequest -> String)
-> ([CountTokensRequest] -> ShowS)
-> Show CountTokensRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CountTokensRequest -> ShowS
showsPrec :: Int -> CountTokensRequest -> ShowS
$cshow :: CountTokensRequest -> String
show :: CountTokensRequest -> String
$cshowList :: [CountTokensRequest] -> ShowS
showList :: [CountTokensRequest] -> ShowS
Show)

instance FromJSON CountTokensRequest where
    parseJSON :: Value -> Parser CountTokensRequest
parseJSON = Options -> Value -> Parser CountTokensRequest
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

instance ToJSON CountTokensRequest where
    toJSON :: CountTokensRequest -> Value
toJSON = Options -> CountTokensRequest -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonOptions

-- | Default CountTokensRequest
_CountTokensRequest :: CountTokensRequest
_CountTokensRequest :: CountTokensRequest
_CountTokensRequest = CountTokensRequest
    { model :: Text
model = Text
""
    , messages :: Vector Message
messages = Vector Message
forall a. Monoid a => a
mempty
    , system :: Maybe Text
system = Maybe Text
forall a. Maybe a
Nothing
    , tools :: Maybe (Vector ToolDefinition)
tools = Maybe (Vector ToolDefinition)
forall a. Maybe a
Nothing
    , tool_choice :: Maybe ToolChoice
tool_choice = Maybe ToolChoice
forall a. Maybe a
Nothing
    }

-- | Response from the token counting endpoint
data TokenCount = TokenCount
    { TokenCount -> Natural
input_tokens :: Natural
    } deriving stock ((forall x. TokenCount -> Rep TokenCount x)
-> (forall x. Rep TokenCount x -> TokenCount) -> Generic TokenCount
forall x. Rep TokenCount x -> TokenCount
forall x. TokenCount -> Rep TokenCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TokenCount -> Rep TokenCount x
from :: forall x. TokenCount -> Rep TokenCount x
$cto :: forall x. Rep TokenCount x -> TokenCount
to :: forall x. Rep TokenCount x -> TokenCount
Generic, Int -> TokenCount -> ShowS
[TokenCount] -> ShowS
TokenCount -> String
(Int -> TokenCount -> ShowS)
-> (TokenCount -> String)
-> ([TokenCount] -> ShowS)
-> Show TokenCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenCount -> ShowS
showsPrec :: Int -> TokenCount -> ShowS
$cshow :: TokenCount -> String
show :: TokenCount -> String
$cshowList :: [TokenCount] -> ShowS
showList :: [TokenCount] -> ShowS
Show)
      deriving anyclass (Maybe TokenCount
Value -> Parser [TokenCount]
Value -> Parser TokenCount
(Value -> Parser TokenCount)
-> (Value -> Parser [TokenCount])
-> Maybe TokenCount
-> FromJSON TokenCount
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TokenCount
parseJSON :: Value -> Parser TokenCount
$cparseJSONList :: Value -> Parser [TokenCount]
parseJSONList :: Value -> Parser [TokenCount]
$comittedField :: Maybe TokenCount
omittedField :: Maybe TokenCount
FromJSON, [TokenCount] -> Value
[TokenCount] -> Encoding
TokenCount -> Bool
TokenCount -> Value
TokenCount -> Encoding
(TokenCount -> Value)
-> (TokenCount -> Encoding)
-> ([TokenCount] -> Value)
-> ([TokenCount] -> Encoding)
-> (TokenCount -> Bool)
-> ToJSON TokenCount
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TokenCount -> Value
toJSON :: TokenCount -> Value
$ctoEncoding :: TokenCount -> Encoding
toEncoding :: TokenCount -> Encoding
$ctoJSONList :: [TokenCount] -> Value
toJSONList :: [TokenCount] -> Value
$ctoEncodingList :: [TokenCount] -> Encoding
toEncodingList :: [TokenCount] -> Encoding
$comitField :: TokenCount -> Bool
omitField :: TokenCount -> Bool
ToJSON)

-- | Servant API for @\/v1\/messages@
type MessagesAPI =
        ReqBody '[JSON] CreateMessage
    :>  Post '[JSON] MessageResponse

-- | Servant API for @\/v1\/messages\/count_tokens@
type CountTokensAPI =
        "count_tokens"
    :>  ReqBody '[JSON] CountTokensRequest
    :>  Post '[JSON] TokenCount

-- | Combined Servant API
type API =
        "messages"
    :>  (MessagesAPI :<|> CountTokensAPI)