packages feed

openai 2.5.1 → 2.5.2

raw patch · 5 files changed

+187/−22 lines, 5 filesdep +case-insensitive

Dependencies added: case-insensitive

Files

CHANGELOG.md view
@@ -1,3 +1,10 @@+2.5.2:++- Add `ResponseWithMetadata` wrapper and `lookupHeader` helper for accessing raw HTTP response headers from API calls.+- Add `createResponseWithMetadata` for non-streaming responses with headers.+- Add `createResponseStreamWithMetadata` and `createResponseStreamTypedWithMetadata` for streaming responses with headers (delivered via callback before events flow).+- Existing `createResponse`, `createResponseStream`, and `createResponseStreamTyped` remain unchanged.+ 2.5.1:  - Add 28 missing `ResponseStreamEvent` constructors covering all event types from the OpenAPI spec (lifecycle, reasoning, refusal, audio, image generation, MCP, and custom tool call events).
openai.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               openai-version:            2.5.1+version:            2.5.2 synopsis:           Servant bindings to OpenAI description:        This package provides comprehensive and type-safe bindings                     to OpenAI, providing both a Servant interface and@@ -30,6 +30,7 @@     build-depends:      base >=4.15.0.0 && < 5                       , aeson                       , bytestring+                      , case-insensitive                       , containers                       , filepath                       , http-api-data@@ -37,10 +38,10 @@                       , http-client-tls                       , http-types                       , servant-                      , servant-multipart-api-                      , servant-client-                      , servant-multipart-client-                      , text+                        , servant-multipart-api+                        , servant-client+                        , servant-multipart-client+                        , text                       , time                       , unordered-containers                       , vector
src/OpenAI/V1.hs view
@@ -125,8 +125,10 @@ import qualified Data.Aeson as Aeson import qualified Data.ByteString as SBS import qualified Data.ByteString.Char8 as S8+import qualified Data.CaseInsensitive as CI 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 Network.HTTP.Types.Status as Status@@ -198,7 +200,7 @@             :<|>  deleteChatKitThread             :<|>  _listChatKitThreadItems             )-      :<|>  (     createResponse+      :<|>  (     createResponse_             :<|>  retrieveResponse             :<|>  cancelResponse             :<|>  listResponseInputItems_@@ -314,6 +316,9 @@      createTranscription a = createTranscription_ (boundary, a)     createTranslation a = createTranslation_ (boundary, a)+    createResponse = createResponse_+    createResponseWithMetadata =+        postJSONWithMetadata "/v1/responses"     createEmbeddings a = toVector (createEmbeddings_ a)     listFineTuningJobs a b = toVector (listFineTuningJobs_ a b)     listFineTuningEvents a b c = toVector (listFineTuningEvents_ a b c)@@ -342,15 +347,26 @@      -- Streaming implementation using http-client and SSE parsing     createResponseStream req onEvent = do+        createResponseStreamWithMetadata req (\_ -> pure ()) onEvent++    createResponseStreamWithMetadata req onMetadata onEvent = do         let req' = req{ Responses.stream = Just True }-        ssePostJSON "/v1/responses" req' onEvent+        ssePostJSON "/v1/responses" req' onMetadata onEvent      createResponseStreamTyped         :: CreateResponse         -> (Either Text Responses.ResponseStreamEvent -> IO ())         -> IO ()     createResponseStreamTyped req onEvent =-        createResponseStream req $ \ev -> case ev of+        createResponseStreamTypedWithMetadata req (\_ -> pure ()) onEvent++    createResponseStreamTypedWithMetadata+        :: CreateResponse+        -> (Responses.ResponseWithMetadata () -> IO ())+        -> (Either Text Responses.ResponseStreamEvent -> IO ())+        -> IO ()+    createResponseStreamTypedWithMetadata req onMetadata onEvent =+        createResponseStreamWithMetadata req onMetadata $ \ev -> case ev of             Left err -> onEvent (Left err)             Right val -> case Aeson.fromJSON val of                 Aeson.Error msg -> onEvent (Left (Text.pack msg))@@ -359,7 +375,7 @@     -- Streaming implementation for chat completions     createChatCompletionStream req onEvent = do         let req' = req{ Chat.Completions.stream = Just True }-        ssePostJSON "/v1/chat/completions" req' onEvent+        ssePostJSON "/v1/chat/completions" req' (\_ -> pure ()) onEvent      createChatCompletionStreamTyped         :: CreateChatCompletion@@ -372,12 +388,78 @@                 Aeson.Error msg -> onEvent (Left (Text.pack msg))                 Aeson.Success e -> onEvent (Right e) +    postJSONWithMetadata+        :: (ToJSON a, FromJSON b)+        => String+        -> a+        -> IO (Responses.ResponseWithMetadata b)+    postJSONWithMetadata path body = do+        let base = Client.baseUrl clientEnv+        let secure = case Client.baseUrlScheme base of+                Client.Http -> False+                Client.Https -> True+        let host = S8.pack (Client.baseUrlHost base)+        let port = Client.baseUrlPort base+        let basePath = Client.baseUrlPath base+        let fullPath = S8.pack (normalizePath basePath <> path)++        let headers0 =+                [ ("Authorization", S8.pack (Text.unpack authorization))+                , ("Accept", "application/json")+                , ("Content-Type", "application/json")+                ]+        let headers1 = case organizationID of+                Nothing -> headers0+                Just org -> ("OpenAI-Organization", S8.pack (Text.unpack org)) : headers0+        let headers = case projectID of+                Nothing -> headers1+                Just proj -> ("OpenAI-Project", S8.pack (Text.unpack proj)) : headers1++        let request = HTTP.Client.defaultRequest+                { HTTP.Client.secure = secure+                , HTTP.Client.host = host+                , HTTP.Client.port = port+                , HTTP.Client.method = "POST"+                , HTTP.Client.path = fullPath+                , HTTP.Client.requestHeaders = headers+                , HTTP.Client.requestBody = HTTP.Client.RequestBodyLBS (Aeson.encode body)+                , HTTP.Client.responseTimeout = HTTP.Client.responseTimeoutNone+                }++        HTTP.Client.withResponse request (Client.manager clientEnv) $ \response -> do+            let responseHeaders = adaptHeaders (HTTP.Client.responseHeaders response)+            bodyChunks <- HTTP.Client.brConsume (HTTP.Client.responseBody response)+            let responseBody = SBS.concat bodyChunks+            let st = HTTP.Client.responseStatus response+            if not (Status.statusIsSuccessful st)+                then throwClientError+                        ( "HTTP error "+                        <> renderIntegral (Status.statusCode st)+                        <> " "+                        <> (Text.pack (S8.unpack (Status.statusMessage st)))+                        <> (if SBS.null responseBody+                                then ""+                                else ": " <> decodeText responseBody)+                        )+                else case Aeson.eitherDecodeStrict responseBody of+                    Left err ->+                        throwClientError+                            ( "Failed to decode response JSON: "+                            <> Text.pack err+                            )+                    Right responseBody' ->+                        pure Responses.ResponseWithMetadata+                            { Responses.body = responseBody'+                            , Responses.response_headers = responseHeaders+                            }+     ssePostJSON :: ToJSON a                 => String                 -> a+                -> (Responses.ResponseWithMetadata () -> IO ())                 -> (Either Text Aeson.Value -> IO ())                 -> IO ()-    ssePostJSON path body onEvent = do+    ssePostJSON path body onMetadata onEvent = do         let base = Client.baseUrl clientEnv         let secure = case Client.baseUrlScheme base of                 Client.Http -> False@@ -411,6 +493,11 @@                 }          HTTP.Client.withResponse request (Client.manager clientEnv) $ \response -> do+            onMetadata+                Responses.ResponseWithMetadata+                    { Responses.body = ()+                    , Responses.response_headers = adaptHeaders (HTTP.Client.responseHeaders response)+                    }             -- Short-circuit on non-2xx HTTP statuses and surface a single error event             let st = HTTP.Client.responseStatus response             if not (Status.statusIsSuccessful st)@@ -479,10 +566,30 @@         ('/':_) -> p         _ -> '/':p +    adaptHeaders+        :: [(CI.CI SBS.ByteString, SBS.ByteString)]+        -> [(Text, Text)]+    adaptHeaders = fmap adaptHeader++    adaptHeader (headerName, headerValue) =+        ( decodeText (CI.original headerName)+        , decodeText headerValue+        )++    decodeText bytes =+        case Text.Encoding.decodeUtf8' bytes of+            Left _ -> Text.pack (S8.unpack bytes)+            Right text -> text+     stripCR bs = case S8.unsnoc bs of         Just (initBs, '\r') -> initBs         _ -> bs +    throwClientError :: Text -> IO a+    throwClientError message =+        Exception.throwIO+            (Client.ConnectionError (Exception.toException (userError (Text.unpack message))))+     unsnoc [] = Nothing     unsnoc xs = Just (init xs, last xs) @@ -535,15 +642,28 @@         -> (Either Text Chat.Completions.Stream.ChatCompletionStreamEvent -> IO ())         -> IO ()     , createResponse :: CreateResponse -> IO ResponseObject+    , createResponseWithMetadata+        :: CreateResponse+        -> IO (Responses.ResponseWithMetadata ResponseObject)     , createResponseStream         :: CreateResponse         -> (Either Text Aeson.Value -> IO ())         -> IO ()+    , createResponseStreamWithMetadata+        :: CreateResponse+        -> (Responses.ResponseWithMetadata () -> IO ())+        -> (Either Text Aeson.Value -> IO ())+        -> IO ()     , createEmbeddings :: CreateEmbeddings -> IO (Vector EmbeddingObject)     , createResponseStreamTyped         :: CreateResponse         -> (Either Text Responses.ResponseStreamEvent -> IO ())         -> IO ()+    , createResponseStreamTypedWithMetadata+        :: CreateResponse+        -> (Responses.ResponseWithMetadata () -> IO ())+        -> (Either Text Responses.ResponseStreamEvent -> IO ())+        -> IO ()     , createFineTuningJob :: CreateFineTuningJob -> IO JobObject     , listFineTuningJobs         :: Maybe Text@@ -754,14 +874,14 @@     =   Header' [ Required, Strict ] "Authorization" Text     :>  Header' [ Optional, Strict ] "OpenAI-Organization" Text     :>  Header' [ Optional, Strict ] "OpenAI-Project" Text-    :>  "v1"-    :>  (     Audio.API-        :<|>  Chat.Completions.API-        :<|>  ChatKit.API-        :<|>  Responses.API-        :<|>  Embeddings.API-        :<|>  FineTuning.Jobs.API-        :<|>  Batches.API+      :>  "v1"+      :>  (     Audio.API+            :<|>  Chat.Completions.API+            :<|>  ChatKit.API+            :<|>  Responses.API+            :<|>  Embeddings.API+            :<|>  FineTuning.Jobs.API+            :<|>  Batches.API         :<|>  Files.API         :<|>  Images.API         :<|>  Uploads.API
src/OpenAI/V1/Responses.hs view
@@ -41,6 +41,8 @@     , ResponseStreamEvent(..)     , Tool(..)     , ResponseObject(..)+    , ResponseWithMetadata(..)+    , lookupHeader     , ResponseUsage(..)     , InputTokensDetails(..)     , OutputTokensDetails(..)@@ -54,6 +56,7 @@ import Control.Applicative ((<|>)) import Data.Aeson (Object) import OpenAI.Prelude hiding (Input(..), input)+import qualified Data.Text as T import OpenAI.V1.AutoOr (AutoOr(..)) import OpenAI.V1.ListOf (ListOf) import OpenAI.V1.Models (Model)@@ -1277,3 +1280,20 @@             :>  "input_items"             :>  Get '[JSON] (ListOf InputItem)         )++-- | Body + response headers from an API call.+data ResponseWithMetadata a = ResponseWithMetadata+    { body :: a+    , response_headers :: [(Text, Text)]+    } deriving stock (Eq, Generic, Show)++-- | Case-insensitive lookup for a response header.+lookupHeader :: Text -> ResponseWithMetadata a -> Maybe Text+lookupHeader key ResponseWithMetadata{ response_headers } =+    foldr select Nothing response_headers+  where+    target = T.toLower key++    select (name, value) acc+        | T.toLower name == target = Just value+        | otherwise = acc
tasty/Main.hs view
@@ -10,7 +10,7 @@ import qualified Data.Aeson.KeyMap as KeyMap import Control.Exception (SomeException, catch) import Data.Foldable (toList)-import Data.Maybe (listToMaybe)+import Data.Maybe (isJust, listToMaybe) import OpenAI.V1 (Methods(..)) import OpenAI.V1.Audio.Speech (CreateSpeech(..), Voice(..), _CreateSpeech) import OpenAI.V1.Audio.Transcriptions (CreateTranscription(..))@@ -908,8 +908,8 @@    let responsesMinimalTest =         HUnit.testCase "Responses - minimal" do-          _ <--            createResponse+          responseWithMetadata <-+            createResponseWithMetadata               Responses._CreateResponse                 { Responses.model = chatModel,                   Responses.input = Just (Responses.Input@@ -932,6 +932,16 @@                   Responses.tool_choice = Nothing                 } +          let Responses.ResponseObject{ Responses.output = outputItems } =+                Responses.body responseWithMetadata++          HUnit.assertBool+            "Expected non-empty response output"+            (not (null (toList outputItems)))+          HUnit.assertBool+            "Expected content-type metadata header"+            (isJust (Responses.lookupHeader "content-type" responseWithMetadata))+           return ()    let responsesStreamingHaikuTest =@@ -960,8 +970,10 @@                   }            acc <- IORef.newIORef (Text.empty)+          responseMetadata <- IORef.newIORef Nothing           done <- Concurrent.newEmptyMVar +          let onMetadata metadata = IORef.writeIORef responseMetadata (Just metadata)           let onEvent (Left _err) = Concurrent.putMVar done ()               onEvent (Right ev) = case ev of                 Responses.ResponseTextDeltaEvent{ Responses.delta = d } ->@@ -970,11 +982,16 @@                   Concurrent.putMVar done ()                 _ -> pure () -          createResponseStreamTyped req onEvent+          createResponseStreamTypedWithMetadata req onMetadata onEvent            _ <- Concurrent.takeMVar done           text <- IORef.readIORef acc+          metadata <- IORef.readIORef responseMetadata           HUnit.assertBool "Expected non-empty streamed text" (not (Text.null text))+          HUnit.assertBool "Expected streaming response metadata" (isJust metadata)+          HUnit.assertBool+            "Expected content-type header in stream metadata"+            (maybe False (isJust . Responses.lookupHeader "content-type") metadata)            return ()