openai 2.3.0 → 2.4.0
raw patch · 6 files changed
+436/−77 lines, 6 files
Files
- CHANGELOG.md +7/−0
- README.md +50/−0
- examples/responses-example/Main.hs +37/−4
- openai.cabal +2/−1
- src/OpenAI/V1/Responses.hs +182/−3
- tasty/Main.hs +158/−69
CHANGELOG.md view
@@ -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.
README.md view
@@ -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
examples/responses-example/Main.hs view
@@ -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
openai.cabal view
@@ -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
src/OpenAI/V1/Responses.hs view
@@ -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
tasty/Main.hs view
@@ -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,