diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +2.4.0: + +- Add Structured Outputs support to the Responses API (`TextConfig`, `TextFormat`, `TextFormat_JSON_Schema`). +- Extend Responses supplementary request/response fields, including `conversation`, `prompt`, `tool_resources`, `truncation`, `max_output_tokens`, `max_tool_calls`, `top_logprobs`, `safety_identifier`, `prompt_cache_key`, and `user`. +- Add `verbosity` support on Responses text config via `Verbosity` and `text.verbosity`. +- Add `ReasoningEffort_None` for Responses reasoning effort. + 2.3.0: - Add `ChatCompletionStreamOptions` support for including usage in chat completion streams. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -73,6 +73,56 @@ print res ``` +### Responses API (Structured Outputs) + +```haskell +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} + +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text +import qualified OpenAI.V1 as V1 +import qualified OpenAI.V1.Responses as Responses + +main :: IO () +main = do + key <- System.Environment.getEnv "OPENAI_KEY" + + env <- V1.getClientEnv "https://api.openai.com" + let V1.Methods{ createResponse } = V1.makeMethods env (Text.pack key) Nothing Nothing + + let schemaObject = Aeson.object + [ "type" Aeson..= ("object" :: Text.Text) + , "properties" Aeson..= Aeson.object + [ "greeting" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text.Text) ] ] + , "required" Aeson..= (["greeting"] :: [Text.Text]) + , "additionalProperties" Aeson..= False + ] + + let req = Responses._CreateResponse + { Responses.model = "gpt-5" + , Responses.input = Just (Responses.Input + [ Responses.Item_Input_Message + { Responses.role = Responses.User + , Responses.content = [ Responses.Input_Text{ Responses.text = "Say hello." } ] + , Responses.status = Nothing + } + ]) + , Responses.text = Just Responses._TextConfig + { Responses.format = Responses.TextFormat_JSON_Schema + { Responses.name = "greeting" + , Responses.description = Just "Greeting payload" + , Responses.schema = Just schemaObject + , Responses.strict = Just True + } + } + } + + res <- createResponse req + print res +``` ## Setup diff --git a/examples/responses-example/Main.hs b/examples/responses-example/Main.hs --- a/examples/responses-example/Main.hs +++ b/examples/responses-example/Main.hs @@ -8,6 +8,7 @@ import Data.Foldable (toList) import System.Environment (getEnv) +import qualified Data.Aeson as Aeson import qualified Data.Text as Text import qualified Data.Text.IO as TextIO import qualified OpenAI.V1 as V1 @@ -20,7 +21,7 @@ let V1.Methods{ createResponse } = V1.makeMethods env key Nothing Nothing - let req = Responses._CreateResponse + let classicRequest = Responses._CreateResponse { Responses.model = "gpt-5" , Responses.input = Just (Responses.Input [ Responses.Item_Input_Message @@ -33,10 +34,42 @@ { Responses.effort = Just Responses.ReasoningEffort_Minimal } } - resp <- createResponse req + classicResponse <- createResponse classicRequest + TextIO.putStrLn "--- Classic response ---" + mapM_ TextIO.putStrLn (collectText classicResponse) - let texts = collectText resp - mapM_ TextIO.putStrLn texts + let schemaObject = Aeson.object + [ "type" Aeson..= ("object" :: Text.Text) + , "properties" Aeson..= Aeson.object + [ "story" Aeson..= Aeson.object [ "type" Aeson..= ("string" :: Text.Text) ] + ] + , "required" Aeson..= (["story"] :: [Text.Text]) + , "additionalProperties" Aeson..= False + ] + structuredRequest = Responses._CreateResponse + { Responses.model = "gpt-5" + , Responses.input = Just (Responses.Input + [ Responses.Item_Input_Message + { Responses.role = Responses.User + , Responses.content = [ Responses.Input_Text{ Responses.text = "Return a bedtime story JSON object." } ] + , Responses.status = Nothing + } + ]) + , Responses.text = Just Responses._TextConfig + { Responses.format = Responses.TextFormat_JSON_Schema + { Responses.description = Just "A bedtime story payload" + , Responses.name = "bedtime_story" + , Responses.schema = Just schemaObject + , Responses.strict = Just True + } + } + , Responses.reasoning = Just Responses._Reasoning + { Responses.effort = Just Responses.ReasoningEffort_Minimal } + } + + structuredResponse <- createResponse structuredRequest + TextIO.putStrLn "--- Structured response ---" + mapM_ TextIO.putStrLn (collectText structuredResponse) collectText :: Responses.ResponseObject -> [Text.Text] collectText Responses.ResponseObject{ Responses.output } = do diff --git a/openai.cabal b/openai.cabal --- a/openai.cabal +++ b/openai.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: openai -version: 2.3.0 +version: 2.4.0 synopsis: Servant bindings to OpenAI description: This package provides comprehensive and type-safe bindings to OpenAI, providing both a Servant interface and @@ -157,6 +157,7 @@ hs-source-dirs: examples/responses-example main-is: Main.hs build-depends: base + , aeson , openai , text , vector diff --git a/src/OpenAI/V1/Responses.hs b/src/OpenAI/V1/Responses.hs --- a/src/OpenAI/V1/Responses.hs +++ b/src/OpenAI/V1/Responses.hs @@ -5,6 +5,14 @@ ( -- * Main types CreateResponse(..) , _CreateResponse + , Conversation(..) + , ConversationParam(..) + , TextConfig(..) + , TextFormat(..) + , Verbosity(..) + , Prompt(..) + , Truncation(..) + , _TextConfig , Input(..) , InputItem(..) , InputRole(..) @@ -48,10 +56,13 @@ import OpenAI.V1.AutoOr (AutoOr(..)) import OpenAI.V1.ListOf (ListOf) import OpenAI.V1.Models (Model) +import OpenAI.V1.ToolResources (ToolResources) import OpenAI.V1.Tool (CodeInterpreterContainer, RankingOptions, ToolChoice(..)) +import qualified Data.Aeson as Aeson + -- | Status constants for function call outputs statusIncomplete, statusCompleted :: Text statusIncomplete = "incomplete" @@ -66,7 +77,8 @@ -- result in faster responses with fewer reasoning tokens. The `gpt-5-pro` -- model currently only supports @ReasoningEffort_High@. data ReasoningEffort - = ReasoningEffort_Minimal + = ReasoningEffort_None + | ReasoningEffort_Minimal | ReasoningEffort_Low | ReasoningEffort_Medium | ReasoningEffort_High @@ -132,6 +144,87 @@ , generate_summary = Nothing } +-- | Verbosity options for text responses. +data Verbosity + = Verbosity_Low + | Verbosity_Medium + | Verbosity_High + deriving stock (Eq, Generic, Show) + +verbosityOptions :: Options +verbosityOptions = + aesonOptions + { constructorTagModifier = stripPrefix "Verbosity_" } + +instance FromJSON Verbosity where + parseJSON = genericParseJSON verbosityOptions + +instance ToJSON Verbosity where + toJSON = genericToJSON verbosityOptions + +-- | Prompt template reference. +data Prompt = Prompt + { id :: Text + , version :: Maybe Text + , variables :: Maybe Value + } deriving stock (Eq, Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Conversation reference supplied when creating responses. +data ConversationParam + = ConversationParam_ID Text + | ConversationParam_Object + { id :: Text + } + deriving stock (Eq, Generic, Show) + +instance FromJSON ConversationParam where + parseJSON value = + case value of + String conversationId -> pure (ConversationParam_ID conversationId) + Object _ -> + Aeson.withObject "ConversationParam" (\object -> ConversationParam_Object <$> object Aeson..: "id") value + _ -> fail "ConversationParam must be a string ID or object with an id field" + +instance ToJSON ConversationParam where + toJSON (ConversationParam_ID conversationId) = toJSON conversationId + toJSON ConversationParam_Object{ id = conversationId } = + Aeson.object [ "id" Aeson..= conversationId ] + +-- | Conversation metadata returned by the API. +newtype Conversation = Conversation + { id :: Text + } deriving stock (Eq, Generic, Show) + +instance FromJSON Conversation where + parseJSON value = + case value of + String conversationId -> pure (Conversation conversationId) + Object _ -> + Aeson.withObject "Conversation" (\object -> Conversation <$> object Aeson..: "id") value + _ -> fail "Conversation must be a string ID or object with an id field" + +instance ToJSON Conversation where + toJSON Conversation{ id = conversationId } = + Aeson.object [ "id" Aeson..= conversationId ] + +-- | Truncation strategy controls for responses. +data Truncation + = Truncation_Auto + | Truncation_Disabled + deriving stock (Eq, Generic, Show) + +truncationOptions :: Options +truncationOptions = + aesonOptions + { constructorTagModifier = stripPrefix "Truncation_" } + +instance FromJSON Truncation where + parseJSON = genericParseJSON truncationOptions + +instance ToJSON Truncation where + toJSON = genericToJSON truncationOptions + -- | Input for the Responses API: a list of input items newtype Input = Input (Vector InputItem) deriving stock (Generic, Show) @@ -808,59 +901,145 @@ , instructions :: Maybe Value , model :: Model , output :: Vector OutputItem + , output_text :: Maybe Text , parallel_tool_calls :: Bool + , conversation :: Maybe Conversation , previous_response_id :: Maybe Text , reasoning :: Maybe Reasoning + , background :: Maybe Bool + , max_output_tokens :: Maybe Natural + , max_tool_calls :: Maybe Natural + , text :: Maybe TextConfig + , prompt :: Maybe Prompt , service_tier :: Maybe ServiceTier + , tool_resources :: Maybe ToolResources , store :: Maybe Bool , temperature :: Maybe Double + , top_logprobs :: Maybe Word , tool_choice :: Maybe ToolChoice , tools :: Maybe (Vector Tool) , top_p :: Maybe Double - , truncation :: Maybe Text + , truncation :: Maybe Truncation , usage :: Maybe ResponseUsage , user :: Maybe Text + , safety_identifier :: Maybe Text + , prompt_cache_key :: Maybe Text , metadata :: Maybe (Map Text Text) } deriving stock (Generic, Show) deriving anyclass (FromJSON, ToJSON) +-- | Format settings for the `text` object in \/v1/responses requests. +data TextFormat + = TextFormat_Text + | TextFormat_JSON_Schema + { name :: Text + , description :: Maybe Text + , schema :: Maybe Value + , strict :: Maybe Bool + } + deriving stock (Eq, Generic, Show) + +textFormatOptions :: Options +textFormatOptions = + aesonOptions + { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + , tagSingleConstructors = True + , constructorTagModifier = stripPrefix "TextFormat_" + } + +instance FromJSON TextFormat where + parseJSON = genericParseJSON textFormatOptions + +instance ToJSON TextFormat where + toJSON = genericToJSON textFormatOptions + +-- | Text generation configuration for \/v1/responses requests. +data TextConfig = TextConfig + { format :: TextFormat + , verbosity :: Maybe Verbosity + } deriving stock (Generic, Show) + +instance FromJSON TextConfig where + parseJSON = genericParseJSON aesonOptions + +instance ToJSON TextConfig where + toJSON = genericToJSON aesonOptions + +-- | Default text configuration for CreateResponse. +_TextConfig :: TextConfig +_TextConfig = TextConfig + { format = TextFormat_Text + , verbosity = Nothing + } + -- | Request body for \/v1/responses data CreateResponse = CreateResponse { model :: Model , input :: Maybe Input + , previous_response_id :: Maybe Text + , conversation :: Maybe ConversationParam , include :: Maybe (Vector Text) , reasoning :: Maybe Reasoning + , text :: Maybe TextConfig , service_tier :: Maybe (AutoOr ServiceTier) + , background :: Maybe Bool + , max_output_tokens :: Maybe Natural + , max_tool_calls :: Maybe Natural , parallel_tool_calls :: Maybe Bool + , tool_resources :: Maybe ToolResources , store :: Maybe Bool , instructions :: Maybe Text , stream :: Maybe Bool , stream_options :: Maybe Value , metadata :: Maybe (Map Text Text) + , top_logprobs :: Maybe Word , temperature :: Maybe Double , top_p :: Maybe Double + , prompt_cache_key :: Maybe Text + , safety_identifier :: Maybe Text + , user :: Maybe Text + , prompt :: Maybe Prompt , tools :: Maybe (Vector Tool) , tool_choice :: Maybe ToolChoice + , truncation :: Maybe Truncation } deriving stock (Generic, Show) - deriving anyclass (FromJSON, ToJSON) +instance FromJSON CreateResponse where + parseJSON = genericParseJSON aesonOptions + +instance ToJSON CreateResponse where + toJSON = genericToJSON aesonOptions + -- | Default CreateResponse _CreateResponse :: CreateResponse _CreateResponse = CreateResponse { input = Nothing + , previous_response_id = Nothing + , conversation = Nothing , include = Nothing , reasoning = Nothing + , text = Nothing , service_tier = Nothing + , background = Nothing + , max_output_tokens = Nothing + , max_tool_calls = Nothing , parallel_tool_calls = Nothing + , tool_resources = Nothing , store = Nothing , instructions = Nothing , stream = Nothing , stream_options = Nothing , metadata = Nothing + , top_logprobs = Nothing , temperature = Nothing , top_p = Nothing + , prompt_cache_key = Nothing + , safety_identifier = Nothing + , user = Nothing + , prompt = Nothing , tools = Nothing , tool_choice = Nothing + , truncation = Nothing } -- | Servant API for \/v1/responses diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -7,7 +7,10 @@ import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson +import qualified Data.Aeson.KeyMap as KeyMap import Control.Exception (SomeException, catch) +import Data.Foldable (toList) +import Data.Maybe (listToMaybe) import OpenAI.V1 (Methods(..)) import OpenAI.V1.Audio.Speech (CreateSpeech(..), Voice(..), _CreateSpeech) import OpenAI.V1.Audio.Transcriptions (CreateTranscription(..)) @@ -52,6 +55,7 @@ import qualified Control.Concurrent as Concurrent import qualified Data.IORef as IORef import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text.Encoding import qualified Network.HTTP.Client as HTTP.Client import qualified Network.HTTP.Client.TLS as TLS import qualified OpenAI.V1 as V1 @@ -85,7 +89,7 @@ let user = "openai Haskell package" let chatModel = "gpt-4o-mini" - let reasoningModel = "o3-mini" + let reasoningModel = "gpt-5.2-2025-12-11" let ttsModel = "tts-1" let Methods {..} = V1.makeMethods clientEnv (Text.pack key) Nothing Nothing @@ -511,23 +515,6 @@ return () - let createImageMinimalTest = do - HUnit.testCase "Create image - minimal" do - _ <- - createImage - CreateImage - { prompt = "A baby panda", - model = Nothing, - n = Nothing, - quality = Nothing, - response_format = Nothing, - size = Nothing, - style = Nothing, - user = Nothing - } - - return () - let createImageMaximalTest = do HUnit.testCase "Create image - maximal" do _ <- @@ -1049,61 +1036,161 @@ return () - let responsesReasoningInputSerializationTest = - HUnit.testCase "Responses - reasoning input serialization" do - let reasoningItem = - Responses.Item_Input_Reasoning - { Responses.reasoning_id = "reasoning_123" - , Responses.reasoning_encrypted_content = Just "ciphertext" - , Responses.reasoning_summary = - Just - [ Responses.Summary_Text - { Responses.text = "High-level plan" } - ] - , Responses.reasoning_content = - Just - [ Responses.Reasoning_Text - { Responses.text = "Step 1: inspect tool output." } - ] - , Responses.reasoning_status = Just Responses.statusCompleted - } - encoded = Aeson.encode reasoningItem - expected :: Aeson.Value - expected = - Aeson.object - [ "type" .= ("reasoning" :: Text.Text) - , "id" .= ("reasoning_123" :: Text.Text) - , "encrypted_content" .= ("ciphertext" :: Text.Text) - , "summary" - .= ( [ Aeson.object - [ "type" .= ("summary_text" :: Text.Text) - , "text" .= ("High-level plan" :: Text.Text) - ] + let responsesReasoningInputTest = + HUnit.testCase "Responses - reasoning input" do + response <- + createResponse + Responses._CreateResponse + { Responses.model = reasoningModel + , Responses.input = Just (Responses.Input + [ Responses.Item_Input_Message + { Responses.role = Responses.User + , Responses.content = + [ Responses.Input_Text + { Responses.text = "In one sentence, explain why 2 + 2 = 4." } ] - :: [Aeson.Value] - ) - , "content" - .= ( [ Aeson.object - [ "type" .= ("reasoning_text" :: Text.Text) - , "text" .= ("Step 1: inspect tool output." :: Text.Text) - ] + , Responses.status = Nothing + } + ]) + , Responses.reasoning = Just Responses._Reasoning + { Responses.effort = Just Responses.ReasoningEffort_None } + } + + let Responses.ResponseObject + { Responses.output = responseOutput + , Responses.reasoning = responseReasoning + } = response + responseTexts = + [ responseText + | Responses.Item_OutputMessage{ Responses.message_content } <- toList responseOutput + , Responses.Output_Text{ Responses.text = responseText } <- toList message_content + ] + + HUnit.assertBool "Expected non-empty response text" (not (Prelude.null responseTexts)) + case responseReasoning of + Nothing -> + HUnit.assertFailure "Response missing reasoning metadata" + Just reasoningConfig -> + HUnit.assertEqual + "Reasoning effort not echoed as none" + (Just Responses.ReasoningEffort_None) + (Responses.effort reasoningConfig) + + let responsesVerbosityTest = + HUnit.testCase "Responses - verbosity" do + response <- + createResponse + Responses._CreateResponse + { Responses.model = reasoningModel + , Responses.input = Just (Responses.Input + [ Responses.Item_Input_Message + { Responses.role = Responses.User + , Responses.content = + [ Responses.Input_Text + { Responses.text = "Provide two concise sentences about why daily walking is healthy." } ] - :: [Aeson.Value] - ) - , "status" .= (Responses.statusCompleted :: Text.Text) - ] - case Aeson.decode encoded of + , Responses.status = Nothing + } + ]) + , Responses.text = Just Responses._TextConfig + { Responses.verbosity = Just Responses.Verbosity_Medium } + } + + let Responses.ResponseObject + { Responses.output = responseOutput + , Responses.text = responseTextConfig + , Responses.output_text = responseOutputText + } = response + fallbackText = listToMaybe + [ responseText + | Responses.Item_OutputMessage{ Responses.message_content } <- toList responseOutput + , Responses.Output_Text{ Responses.text = responseText } <- toList message_content + ] + + case responseTextConfig of Nothing -> - HUnit.assertFailure "Failed to decode encoded reasoning input item" - Just decodedValue -> - HUnit.assertEqual "Encoded JSON mismatch" expected decodedValue + HUnit.assertFailure "Response missing text configuration" + Just cfg -> + HUnit.assertEqual + "Verbosity not echoed in response" + (Just Responses.Verbosity_Medium) + (Responses.verbosity cfg) - case Aeson.fromJSON expected of - Aeson.Error err -> - HUnit.assertFailure ("Round-trip decode failed: " <> err) - Aeson.Success decoded -> - HUnit.assertEqual "Round-trip mismatch" reasoningItem decoded + let finalText = case responseOutputText of + Just t -> Just t + Nothing -> fallbackText + case finalText of + Nothing -> + HUnit.assertFailure "Expected non-empty output text" + Just t -> + HUnit.assertBool "Expected non-empty output text" (not (Text.null t)) + + let responsesTextJSONSchemaTest = + HUnit.testCase "Responses - text format json_schema" do + let schemaObject = + Aeson.object + [ "type" .= ("object" :: Text.Text) + , "properties" + .= Aeson.object + [ "city" .= Aeson.object [ "type" .= ("string" :: Text.Text) ] + ] + , "required" .= (["city"] :: [Text.Text]) + , "additionalProperties" .= False + ] + request = + Responses._CreateResponse + { Responses.model = chatModel + , Responses.input = + Just + (Responses.Input + [ Responses.Item_Input_Message + { Responses.role = Responses.User + , Responses.content = + [ Responses.Input_Text + { Responses.text = "Return JSON for city=Paris." } + ] + , Responses.status = Nothing + } + ]) + , Responses.text = + Just Responses._TextConfig + { Responses.format = + Responses.TextFormat_JSON_Schema + { Responses.description = Just "Weather response" + , Responses.name = "weather_response" + , Responses.schema = Just schemaObject + , Responses.strict = Just True + } + } + } + + response <- createResponse request + + let Responses.ResponseObject{ Responses.output = responseOutput } = response + responseTexts = + [ responseText + | Responses.Item_OutputMessage{ Responses.message_content } <- toList responseOutput + , Responses.Output_Text{ Responses.text = responseText } <- toList message_content + ] + + case listToMaybe responseTexts of + Nothing -> + HUnit.assertFailure "Expected at least one text output" + Just responseText -> + case Aeson.decodeStrict' (Text.Encoding.encodeUtf8 responseText) of + Nothing -> + HUnit.assertFailure "Expected JSON text output" + Just (Aeson.Object object) -> do + HUnit.assertEqual "Expected only one key (city)" 1 (KeyMap.size object) + case KeyMap.lookup "city" object of + Just (Aeson.String city) -> + HUnit.assertBool "Expected non-empty city" (not (Text.null city)) + _ -> + HUnit.assertFailure "Expected JSON object with string field \"city\"" + Just _ -> + HUnit.assertFailure "Expected JSON object output" + let tests = speechTests <> [ transcriptionTest, @@ -1124,7 +1211,9 @@ createImageVariationMaximalTest, createModerationTest, responsesMinimalTest, - responsesReasoningInputSerializationTest, + responsesReasoningInputTest, + responsesVerbosityTest, + responsesTextJSONSchemaTest, responsesStreamingHaikuTest, responsesCodeInterpreterStreamingTest, assistantsTest,