openai 1.1.1 → 1.2.0
raw patch · 13 files changed
+1318/−34 lines, 13 filesdep +http-typesdep ~basenew-component:exe:responses-examplenew-component:exe:responses-stream-example
Dependencies added: http-types
Dependency ranges changed: base
Files
- CHANGELOG.md +5/−0
- README.md +34/−0
- examples/openai-example/Main.hs +1/−1
- examples/responses-example/Main.hs +42/−0
- examples/responses-stream-example/Main.hs +79/−0
- examples/weather-chatbot-example/Main.hs +10/−9
- openai.cabal +30/−3
- src/OpenAI/Prelude.hs +3/−2
- src/OpenAI/V1.hs +170/−2
- src/OpenAI/V1/Chat/Completions.hs +4/−13
- src/OpenAI/V1/Responses.hs +732/−0
- src/OpenAI/V1/Tool.hs +51/−1
- tasty/Main.hs +157/−3
CHANGELOG.md view
@@ -1,3 +1,8 @@+1.2.0:++- [`/v1/responses`: Add support for Responses API](https://platform.openai.com/docs/api-reference/responses)+- Add `Tool_Web_Search`+ 1.1.1: - [Remove timeout on default `ClientEnv`](https://github.com/MercuryTechnologies/openai/pull/55)
README.md view
@@ -40,6 +40,40 @@ traverse_ display choices ``` +### Responses API (JSON)++```haskell+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++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 req = Responses._CreateResponse+ { Responses.model = "gpt-5"+ , Responses.input = Just (Responses.Input+ [ Responses.Item_InputMessage+ { Responses.role = Responses.User+ , Responses.content = [ Responses.Input_Text{ Responses.text = "Say hello in one sentence." } ]+ , Responses.status = Nothing+ }+ ])+ }++ res <- createResponse req+ print res+```++ ## Setup ### Using Nix with Flakes (Recommended)
examples/openai-example/Main.hs view
@@ -19,7 +19,7 @@ clientEnv <- getClientEnv "https://api.openai.com" - let Methods{ createChatCompletion } = makeMethods clientEnv (Text.pack key)+ let Methods{ createChatCompletion } = makeMethods clientEnv (Text.pack key) Nothing Nothing text <- Text.IO.getLine
+ examples/responses-example/Main.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE NamedFieldPuns #-}++module Main where++import Data.Foldable (toList)+import qualified Data.Text as Text+import qualified Data.Text.IO as TextIO+import qualified OpenAI.V1 as V1+import qualified OpenAI.V1.Responses as Responses+import System.Environment (getEnv)++main :: IO ()+main = do+ key <- Text.pack <$> getEnv "OPENAI_KEY"+ env <- V1.getClientEnv "https://api.openai.com"++ let V1.Methods{ createResponse } = V1.makeMethods env key Nothing Nothing++ let req = Responses._CreateResponse+ { Responses.model = "gpt-5"+ , Responses.input = Just (Responses.Input+ [ Responses.Item_InputMessage+ { Responses.role = Responses.User+ , Responses.content = [ Responses.Input_Text{ Responses.text = "Tell me a three sentence bedtime story about a unicorn." } ]+ , Responses.status = Nothing+ }+ ])+ }++ resp <- createResponse req++ let texts = collectText resp+ mapM_ TextIO.putStrLn texts++collectText :: Responses.ResponseObject -> [Text.Text]+collectText Responses.ResponseObject{ Responses.output } = do+ Responses.Item_OutputMessage{ Responses.message_content } <- toList output+ Responses.Output_Text{ Responses.text } <- toList message_content+ return text
+ examples/responses-stream-example/Main.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE NamedFieldPuns #-}++module Main where++import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import qualified OpenAI.V1 as V1+import qualified OpenAI.V1.Responses as Responses+import qualified OpenAI.V1.Tool as Tool+import System.Environment (getEnv)+import System.IO (hFlush, hPutStrLn, stderr, stdout)++main :: IO ()+main = do+ key <- T.pack <$> getEnv "OPENAI_KEY"+ env <- V1.getClientEnv "https://api.openai.com"++ let V1.Methods{ createResponseStreamTyped } = V1.makeMethods env key Nothing Nothing++ let onEvent (Left err) = hPutStrLn stderr ("stream error: " <> T.unpack err)+ onEvent (Right ev) = case ev of+ -- Only print model text deltas and newline on part done+ Responses.ResponseTextDeltaEvent{ Responses.delta = d } ->+ TIO.putStr d >> hFlush stdout+ Responses.ResponseTextDoneEvent{} -> putStrLn ""+ -- Ignore all other events for a clean output+ _ -> pure ()++ -- 1) Cute haiku test (no tools)+ let reqHaiku = Responses._CreateResponse+ { Responses.model = "gpt-5-mini"+ , Responses.input = Just (Responses.Input+ [ Responses.Item_InputMessage+ { Responses.role = Responses.User+ , Responses.content = [ Responses.Input_Text{ Responses.text = "Write a short haiku about the sea." } ]+ , Responses.status = Nothing+ }+ ])+ }++ createResponseStreamTyped reqHaiku onEvent+ + putStrLn "--------------------------------"++ -- 2) Web search example+ let reqSearch = Responses._CreateResponse+ { Responses.model = "gpt-5-mini"+ , Responses.input = Just (Responses.Input+ [ Responses.Item_InputMessage+ { Responses.role = Responses.User+ , Responses.content = [ Responses.Input_Text{ Responses.text = "Use web_search to find current news about France and display a concise summary. Do not include citations, references, or URLs in the output; provide only the summary text." } ]+ , Responses.status = Nothing+ }+ ])+ , Responses.tools = Just [ Tool.Tool_Web_Search ]+ }++ createResponseStreamTyped reqSearch onEvent++ putStrLn "--------------------------------"++ -- 3) Code interpreter example (per docs)+ let reqCode = Responses._CreateResponse+ { Responses.model = "gpt-5-mini"+ , Responses.instructions = Just "You are a personal math tutor. When asked a math question, write and run code using the python tool to answer the question."+ , Responses.input = Just (Responses.Input+ [ Responses.Item_InputMessage+ { Responses.role = Responses.User+ , Responses.content = [ Responses.Input_Text{ Responses.text = "I need to solve the equation 3x + 11 = 14. Can you help me?" } ]+ , Responses.status = Nothing+ }+ ])+ , Responses.tools = Just [ Tool.codeInterpreterAuto ]+ }++ createResponseStreamTyped reqCode onEvent
examples/weather-chatbot-example/Main.hs view
@@ -7,19 +7,20 @@ import Control.Monad (foldM, when) import Data.Aeson (Value (..), (.=))-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.KeyMap as KeyMap-import qualified Data.ByteString.Lazy as ByteString.Lazy import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text.Encoding-import qualified Data.Text.IO as Text.IO import Data.Vector (Vector)-import qualified Data.Vector as Vector+import GHC.Exts (toList) import OpenAI.V1 import OpenAI.V1.Chat.Completions import OpenAI.V1.Tool import OpenAI.V1.ToolCall++import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy as ByteString.Lazy+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text.Encoding+import qualified Data.Text.IO as Text.IO+import qualified Data.Vector as Vector import qualified System.Environment as Environment -- | Mock weather data for different cities@@ -43,7 +44,7 @@ -- Parse arguments to extract city name let weatherResult = case Aeson.decode (ByteString.Lazy.fromStrict $ Text.Encoding.encodeUtf8 arguments) of- Just (Object obj) -> case KeyMap.lookup "city" obj of+ Just (Object obj) -> case lookup "city" (toList obj) of Just (String cityName) -> mockWeatherData cityName _ -> "Error: Could not parse city name from arguments" _ -> "Error: Invalid arguments format"@@ -213,7 +214,7 @@ -- Set up client clientEnv <- getClientEnv "https://api.openai.com"- let Methods {createChatCompletion} = makeMethods clientEnv (Text.pack key)+ let Methods {createChatCompletion} = makeMethods clientEnv (Text.pack key) Nothing Nothing -- Initial system message let systemMessage =
openai.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: openai-version: 1.1.1+version: 1.2.0 synopsis: Servant bindings to OpenAI description: This package provides comprehensive and type-safe bindings to OpenAI, providing both a Servant interface and@@ -14,11 +14,16 @@ license-file: LICENSE author: Gabriella Gonzalez maintainer: GenuineGabriella@gmail.com+category: AI, API, Web copyright: 2024 Gabriella Gonzalez build-type: Simple-extra-source-files: CHANGELOG.md- README.md+extra-doc-files: CHANGELOG.md+extra-source-files: README.md +source-repository head+ type: git+ location: https://github.com/MercuryTechnologies/openai+ library default-language: Haskell2010 hs-source-dirs: src@@ -30,6 +35,7 @@ , http-api-data , http-client , http-client-tls+ , http-types , servant , servant-multipart-api , servant-client@@ -64,6 +70,7 @@ OpenAI.V1.Moderations OpenAI.V1.Order OpenAI.V1.ResponseFormat+ OpenAI.V1.Responses OpenAI.V1.Threads OpenAI.V1.Threads.Messages OpenAI.V1.Threads.Runs@@ -131,4 +138,24 @@ , openai , text , vector+ ghc-options: -Wall++executable responses-example+ default-language: Haskell2010+ hs-source-dirs: examples/responses-example+ main-is: Main.hs+ build-depends: base+ , openai+ , text+ , vector+ ghc-options: -Wall++executable responses-stream-example+ default-language: Haskell2010+ hs-source-dirs: examples/responses-stream-example+ main-is: Main.hs+ build-depends: base+ , aeson+ , openai+ , text ghc-options: -Wall
src/OpenAI/Prelude.hs view
@@ -31,13 +31,13 @@ import Data.ByteString.Lazy (ByteString) import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map)+import Data.String (IsString(..)) import Data.Text (Text) import Data.Time.Clock.POSIX (POSIXTime) import Data.Vector (Vector) import Data.Void (Void)-import GHC.Generics (Generic)-import Data.String (IsString(..)) import Data.Word (Word8)+import GHC.Generics (Generic) import Numeric.Natural (Natural) import Web.HttpApiData (ToHttpApiData(..)) @@ -59,6 +59,7 @@ , JSON , MimeUnrender(..) , OctetStream+ , Optional , Post , QueryParam , ReqBody
src/OpenAI/V1.hs view
@@ -78,6 +78,12 @@ (CreateTranslation, TranslationObject) import OpenAI.V1.Chat.Completions (ChatCompletionObject, CreateChatCompletion)+import OpenAI.V1.Responses+ ( CreateResponse+ , ResponseObject+ , InputItem+ )+import qualified OpenAI.V1.Responses as Responses import OpenAI.V1.FineTuning.Jobs ( CheckpointObject , CreateFineTuningJob@@ -124,6 +130,12 @@ import qualified Data.Text as Text import qualified Network.HTTP.Client as HTTP.Client import qualified Network.HTTP.Client.TLS as TLS+import qualified Network.HTTP.Types.Status as Status+import qualified Data.Aeson as Aeson+import qualified Data.ByteString as SBS+import qualified Data.ByteString.Char8 as S8+import Control.Monad (foldM)+import qualified Data.IORef as IORef import qualified OpenAI.V1.Assistants as Assistants import qualified OpenAI.V1.Audio as Audio import qualified OpenAI.V1.Batches as Batches@@ -168,8 +180,12 @@ -- ^ -> Text -- ^ API token+ -> Maybe Text+ -- ^ Organization ID+ -> Maybe Text+ -- ^ Project ID -> Methods-makeMethods clientEnv token = Methods{..}+makeMethods clientEnv token organizationID projectID = Methods{..} where authorization = "Bearer " <> token @@ -178,6 +194,11 @@ :<|> createTranslation_ ) :<|> createChatCompletion+ :<|> ( createResponse+ :<|> retrieveResponse+ :<|> cancelResponse+ :<|> listResponseInputItems_+ ) :<|> createEmbeddings_ :<|> ( createFineTuningJob :<|> listFineTuningJobs_@@ -250,6 +271,7 @@ :<|> retrieveRunStep ) )+ :<|> ( (\x -> x "assistants=v2") -> ( createVectorStore :<|> listVectorStores_@@ -272,7 +294,7 @@ :<|> listVectorStoreFilesInABatch_ ) )- ) = Client.hoistClient @API Proxy run (Client.client @API Proxy) authorization+ ) = Client.hoistClient @API Proxy run (Client.client @API Proxy) authorization organizationID projectID run :: Client.ClientM a -> IO a run clientM = do@@ -310,7 +332,138 @@ toVector (listVectorStoreFiles_ a b c d e f) listVectorStoreFilesInABatch a b c d e f g = toVector (listVectorStoreFilesInABatch_ a b c d e f g)+ listResponseInputItems a = toVector (listResponseInputItems_ a) + -- Streaming implementation using http-client and SSE parsing+ createResponseStream req onEvent = do+ let req' = req{ Responses.stream = Just True }+ ssePostJSON "/v1/responses" req' onEvent++ createResponseStreamTyped+ :: CreateResponse+ -> (Either Text Responses.ResponseStreamEvent -> IO ())+ -> IO ()+ createResponseStreamTyped req onEvent =+ createResponseStream req $ \ev -> case ev of+ Left err -> onEvent (Left err)+ Right val -> case Aeson.fromJSON val of+ Aeson.Error msg -> onEvent (Left (Text.pack msg))+ Aeson.Success e -> onEvent (Right e)++ ssePostJSON :: ToJSON a+ => String+ -> a+ -> (Either Text Aeson.Value -> IO ())+ -> IO ()+ ssePostJSON path body onEvent = 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", "text/event-stream")+ , ("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+ -- Short-circuit on non-2xx HTTP statuses and surface a single error event+ let st = HTTP.Client.responseStatus response+ if not (Status.statusIsSuccessful st)+ then do+ bodyChunks <- HTTP.Client.brConsume (HTTP.Client.responseBody response)+ let errBody = SBS.concat bodyChunks+ let msg =+ "HTTP error "+ <> renderIntegral (Status.statusCode st)+ <> " "+ <> (Text.pack (S8.unpack (Status.statusMessage st)))+ <> (if SBS.null errBody then "" else ": " <> Text.pack (S8.unpack errBody))+ onEvent (Left msg)+ else do+ let br = HTTP.Client.responseBody response+ lineBufRef <- IORef.newIORef SBS.empty+ eventBufRef <- IORef.newIORef ([] :: [SBS.ByteString])+ let flushEvent = do+ es <- IORef.atomicModifyIORef eventBufRef (\buf -> ([], reverse buf))+ if null es+ then pure False+ else do+ let payload = S8.concat es+ if payload == "[DONE]"+ then pure True+ else case (Aeson.eitherDecodeStrict payload :: Either String Aeson.Value) of+ Left err -> onEvent (Left (Text.pack err)) >> pure False+ Right val -> onEvent (Right val) >> pure False++ -- Note: SSE frames can include fields like "event:" and others.+ -- We currently ignore all non-"data:" fields and only buffer+ -- "data:" lines; an empty line flushes a complete event.+ let handleLine line = do+ let l = stripCR line+ if S8.null l+ then flushEvent+ else if "data:" `S8.isPrefixOf` l+ then do+ let d = S8.dropWhile (==' ') (S8.drop 5 l)+ IORef.modifyIORef' eventBufRef (d:)+ pure False+ else pure False++ let loop = do+ chunk <- HTTP.Client.brRead br+ if SBS.null chunk+ then do+ -- flush any pending event at EOF+ _ <- flushEvent+ pure ()+ else do+ prev <- IORef.readIORef lineBufRef+ let combined = prev <> chunk+ let ls = S8.split '\n' combined+ case unsnoc ls of+ Nothing -> loop+ Just (completeLines, lastLine) -> do+ IORef.writeIORef lineBufRef lastLine+ stop <- foldM (\acc ln -> if acc then pure True else handleLine ln) False completeLines+ if stop then pure () else loop++ loop++ normalizePath p = case p of+ "" -> ""+ ('/':_) -> p+ _ -> '/':p++ stripCR bs = case S8.unsnoc bs of+ Just (initBs, '\r') -> initBs+ _ -> bs++ unsnoc [] = Nothing+ unsnoc xs = Just (init xs, last xs)+ -- | Hard-coded boundary to simplify the user-experience -- -- I don't understand why `multipart-servant-client` insists on generating a@@ -324,7 +477,16 @@ , createTranscription :: CreateTranscription -> IO TranscriptionObject , createTranslation :: CreateTranslation -> IO TranslationObject , createChatCompletion :: CreateChatCompletion -> IO ChatCompletionObject+ , createResponse :: CreateResponse -> IO ResponseObject+ , createResponseStream+ :: CreateResponse+ -> (Either Text Aeson.Value -> IO ())+ -> IO () , createEmbeddings :: CreateEmbeddings -> IO (Vector EmbeddingObject)+ , createResponseStreamTyped+ :: CreateResponse+ -> (Either Text Responses.ResponseStreamEvent -> IO ())+ -> IO () , createFineTuningJob :: CreateFineTuningJob -> IO JobObject , listFineTuningJobs :: Maybe Text@@ -462,6 +624,9 @@ -> Maybe Text -- ^ include[] -> IO RunStepObject+ , retrieveResponse :: Text -> IO ResponseObject+ , cancelResponse :: Text -> IO ResponseObject+ , listResponseInputItems :: Text -> IO (Vector InputItem) , createVectorStore :: CreateVectorStore -> IO VectorStoreObject , listVectorStores :: Maybe Natural@@ -530,9 +695,12 @@ -- | Servant API type API = Header' [ Required, Strict ] "Authorization" Text+ :> Header' [ Optional, Strict ] "OpenAI-Organization" Text+ :> Header' [ Optional, Strict ] "OpenAI-Project" Text :> "v1" :> ( Audio.API :<|> Chat.Completions.API+ :<|> Responses.API :<|> Embeddings.API :<|> FineTuning.Jobs.API :<|> Batches.API
src/OpenAI/V1/Chat/Completions.hs view
@@ -20,7 +20,7 @@ , AudioFormat(..) , AudioParameters(..) , ResponseFormat(..)- , ServiceTier(..)+ , ServiceTier , ReasoningEffort(..) , SearchContextSize(..) , UserLocation(..)@@ -207,21 +207,12 @@ deriving anyclass (FromJSON, ToJSON) -- | Specifies the latency tier to use for processing the request-data ServiceTier = Default- deriving stock (Generic, Show)--serviceOptions :: Options-serviceOptions = aesonOptions{ tagSingleConstructors = True }--instance FromJSON ServiceTier where- parseJSON = genericParseJSON serviceOptions--instance ToJSON ServiceTier where- toJSON = genericToJSON serviceOptions+type ServiceTier = Text -- | Constrains effort on reasoning for reasoning models data ReasoningEffort- = ReasoningEffort_Low+ = ReasoningEffort_Minimal+ | ReasoningEffort_Low | ReasoningEffort_Medium | ReasoningEffort_High deriving stock (Generic, Show)
+ src/OpenAI/V1/Responses.hs view
@@ -0,0 +1,732 @@+-- | /v1/responses+--+-- Streaming is not implemented here; this covers JSON responses only.+module OpenAI.V1.Responses+ ( -- * Main types+ CreateResponse(..)+ , _CreateResponse+ , Input(..)+ , InputItem(..)+ , InputRole(..)+ , InputContent(..)+ , OutputItem(..)+ , OutputMessage(..)+ , OutputContent(..)+ , FunctionToolCall(..)+ , FunctionToolCallOutput(..)+ , WebSearchToolCall(..)+ , FileSearchToolCall(..)+ , FileSearchResult(..)+ , CodeInterpreterToolCall(..)+ , CodeInterpreterOutput(..)+ , WebSearchAction(..)+ , WebSearchSource(..)+ , Annotation(..)+ , ReasoningItem(..)+ , SummaryPart(..)+ , ReasoningText(..)+ , ResponseStreamEvent(..)+ , ResponseObject(..)+ , ResponseUsage(..)+ , InputTokensDetails(..)+ , OutputTokensDetails(..)++ -- * Servant+ , API+ ) where++import OpenAI.Prelude hiding (Input(..))+import Data.Aeson (Object)+-- no TH; inline JSON instances for payloads+import OpenAI.V1.ListOf (ListOf)+import OpenAI.V1.Models (Model)+import OpenAI.V1.Tool (Tool, ToolChoice)++-- | Input for the Responses API: a list of input items+newtype Input = Input (Vector InputItem)+ deriving stock (Generic, Show)++instance ToJSON Input where+ toJSON (Input xs) = toJSON xs++instance FromJSON Input where+ parseJSON v = Input <$> parseJSON v++-- | Role of an input message+data InputRole = User | System | Developer+ deriving stock (Generic, Show)++instance FromJSON InputRole where+ parseJSON = genericParseJSON aesonOptions++instance ToJSON InputRole where+ toJSON = genericToJSON aesonOptions++-- | Content parts for input messages+data InputContent+ = Input_Text { text :: Text }+ | Input_Image { image_url :: Maybe Text, file_id :: Maybe Text, detail :: Maybe Text }+ | Input_File { file_id :: Maybe Text, filename :: Maybe Text, file_url :: Maybe Text, file_data :: Maybe Text }+ | Input_Audio { input_audio :: Object }+ deriving stock (Generic, Show)++inputContentOptions :: Options+inputContentOptions =+ aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ -- Keep constructor names like "Input_Text" -> "input_text"+ , constructorTagModifier = labelModifier+ }++instance FromJSON InputContent where+ parseJSON = genericParseJSON inputContentOptions++instance ToJSON InputContent where+ toJSON = genericToJSON inputContentOptions++-- | An input item+data InputItem+ = Item_InputMessage+ { role :: InputRole+ , content :: Vector InputContent+ , status :: Maybe Text+ }+ deriving stock (Generic, Show)++inputItemOptions :: Options+inputItemOptions =+ aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ , constructorTagModifier = stripPrefix "Item_Input"+ }++instance FromJSON InputItem where+ parseJSON = genericParseJSON inputItemOptions++instance ToJSON InputItem where+ toJSON = genericToJSON inputItemOptions++-- | Output content from the model+data OutputContent+ = Output_Text+ { text :: Text+ , annotations :: Vector Value+ , logprobs :: Maybe (Vector Value)+ }+ | Refusal+ { refusal :: Text }+ deriving stock (Generic, Show)++outputContentOptions :: Options+outputContentOptions =+ aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ }++instance FromJSON OutputContent where+ parseJSON = genericParseJSON outputContentOptions++instance ToJSON OutputContent where+ toJSON = genericToJSON outputContentOptions++-- | An output message item+data OutputMessage = OutputMessage+ { id :: Text+ , role :: Text+ , content :: Vector OutputContent+ , status :: Text+ } deriving stock (Generic, Show)++instance FromJSON OutputMessage where+ parseJSON = genericParseJSON aesonOptions++instance ToJSON OutputMessage where+ toJSON = genericToJSON aesonOptions++-- | A generated output item.+data OutputItem+ = Item_OutputMessage+ { message_id :: Text+ , message_role :: Text+ , message_content :: Vector OutputContent+ , message_status :: Text+ }+ | Item_FunctionToolCall+ { function_id :: Maybe Text+ , function_call_id :: Text+ , function_name :: Text+ , function_arguments :: Text+ , function_status :: Maybe Text+ }+ | Item_WebSearchToolCall+ { web_search_id :: Text+ , web_search_status :: Text+ , web_search_action :: Maybe WebSearchAction+ }+ | Item_FunctionToolCallOutput+ { function_output_id :: Maybe Text+ , function_output_call_id :: Text+ , function_output_output :: Text+ , function_output_status :: Maybe Text+ }+ | Item_FileSearchToolCall+ { file_search_id :: Text+ , file_search_status :: Text+ , file_search_queries :: Vector Text+ , file_search_results :: Maybe (Vector FileSearchResult)+ }+ | Item_CodeInterpreterToolCall+ { code_interpreter_id :: Text+ , code_interpreter_status :: Text+ , code_interpreter_container_id :: Maybe Text+ , code_interpreter_code :: Maybe Text+ , code_interpreter_outputs :: Maybe (Vector CodeInterpreterOutput)+ }+ | Item_Reasoning+ { reasoning_id :: Text+ , reasoning_encrypted_content :: Maybe Text+ , reasoning_summary :: Maybe (Vector SummaryPart)+ , reasoning_content :: Maybe (Vector ReasoningText)+ , reasoning_status :: Maybe Text+ }+ deriving stock (Generic, Show)++outputItemOptions :: Options+outputItemOptions = aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ , fieldLabelModifier = \s -> case s of+ "message_id" -> "id"+ "message_role" -> "role"+ "message_content" -> "content"+ "message_status" -> "status"+ "function_id" -> "id"+ "function_call_id" -> "call_id"+ "function_name" -> "name"+ "function_arguments" -> "arguments"+ "function_status" -> "status"+ "web_search_id" -> "id"+ "web_search_status" -> "status"+ "web_search_action" -> "action"+ "function_output_id" -> "id"+ "function_output_call_id" -> "call_id"+ "function_output_output" -> "output"+ "function_output_status" -> "status"+ "file_search_id" -> "id"+ "file_search_status" -> "status"+ "file_search_queries" -> "queries"+ "file_search_results" -> "results"+ "code_interpreter_id" -> "id"+ "code_interpreter_status" -> "status"+ "code_interpreter_container_id" -> "container_id"+ "code_interpreter_code" -> "code"+ "code_interpreter_outputs" -> "outputs"+ "reasoning_id" -> "id"+ "reasoning_encrypted_content" -> "encrypted_content"+ "reasoning_summary" -> "summary"+ "reasoning_content" -> "content"+ "reasoning_status" -> "status"+ other -> other+ , constructorTagModifier = \s -> case s of+ "Item_OutputMessage" -> "message"+ "Item_FunctionToolCall" -> "function_call"+ "Item_WebSearchToolCall" -> "web_search_call"+ "Item_FunctionToolCallOutput" -> "function_call_output"+ "Item_FileSearchToolCall" -> "file_search_call"+ "Item_CodeInterpreterToolCall" -> "code_interpreter_call"+ "Item_Reasoning" -> "reasoning"+ _ -> Prelude.error "Unknown OutputItem constructor"+ }++instance FromJSON OutputItem where+ parseJSON = genericParseJSON outputItemOptions++instance ToJSON OutputItem where+ toJSON = genericToJSON outputItemOptions++-- | Function tool call output item+data FunctionToolCall = FunctionToolCall+ { id :: Maybe Text+ , call_id :: Text+ , name :: Text+ , arguments :: Text+ , status :: Maybe Text+ } deriving stock (Generic, Show)+ deriving anyclass (FromJSON, ToJSON)++-- | Function tool call output item+data FunctionToolCallOutput = FunctionToolCallOutput+ { id :: Maybe Text+ , call_id :: Text+ , output :: Text+ , status :: Maybe Text+ } deriving stock (Generic, Show)+ deriving anyclass (FromJSON, ToJSON)++-- | Web search tool call output item (action is left generic for now)+data WebSearchToolCall = WebSearchToolCall+ { id :: Text+ , status :: Text+ , action :: Maybe WebSearchAction+ } deriving stock (Generic, Show)++instance FromJSON WebSearchToolCall where+ parseJSON = genericParseJSON aesonOptions++instance ToJSON WebSearchToolCall where+ toJSON = genericToJSON aesonOptions++-- | File search result entry+data FileSearchResult = FileSearchResult+ { file_id :: Text+ , text :: Text+ , filename :: Text+ , score :: Maybe Double+ } deriving stock (Generic, Show)+ deriving anyclass (FromJSON, ToJSON)++-- | File search tool call output item+data FileSearchToolCall = FileSearchToolCall+ { id :: Text+ , status :: Text+ , queries :: Vector Text+ , results :: Maybe (Vector FileSearchResult)+ } deriving stock (Generic, Show)+ deriving anyclass (FromJSON, ToJSON)++-- | Code interpreter tool call outputs+data CodeInterpreterOutput+ = CodeInterpreterOutput_Logs{ logs :: Text }+ | CodeInterpreterOutput_Image{ url :: Text }+ deriving stock (Generic, Show)++codeInterpreterOutputOptions :: Options+codeInterpreterOutputOptions = aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ , constructorTagModifier = stripPrefix "CodeInterpreterOutput_"+ }++instance FromJSON CodeInterpreterOutput where+ parseJSON = genericParseJSON codeInterpreterOutputOptions++instance ToJSON CodeInterpreterOutput where+ toJSON = genericToJSON codeInterpreterOutputOptions++-- | Code interpreter tool call output item+data CodeInterpreterToolCall = CodeInterpreterToolCall+ { id :: Text+ , status :: Text+ , container_id :: Maybe Text+ , code :: Maybe Text+ , outputs :: Maybe (Vector CodeInterpreterOutput)+ } deriving stock (Generic, Show)+ deriving anyclass (FromJSON, ToJSON)++-- | Web search action sources+data WebSearchSource = WebSearchSource_URL{ url :: Text }+ deriving stock (Generic, Show)++webSearchSourceOptions :: Options+webSearchSourceOptions = aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ , constructorTagModifier = stripPrefix "WebSearchSource_"+ }++instance FromJSON WebSearchSource where+ parseJSON = genericParseJSON webSearchSourceOptions++instance ToJSON WebSearchSource where+ toJSON = genericToJSON webSearchSourceOptions++-- | Web search action+data WebSearchAction+ = WebSearchAction_Search+ { query :: Maybe Text+ , sources :: Maybe (Vector WebSearchSource)+ }+ | WebSearchAction_Open_Page+ { url :: Maybe Text }+ | WebSearchAction_Find+ { url :: Maybe Text+ , pattern :: Maybe Text+ }+ deriving stock (Generic, Show)++webSearchActionOptions :: Options+webSearchActionOptions = aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ , constructorTagModifier = stripPrefix "WebSearchAction_"+ }++instance FromJSON WebSearchAction where+ parseJSON = genericParseJSON webSearchActionOptions++instance ToJSON WebSearchAction where+ toJSON = genericToJSON webSearchActionOptions++-- | Output text annotation+data Annotation+ = Annotation_File_Citation+ { file_id :: Text+ , index :: Natural+ , filename :: Text+ }+ | Annotation_Url_Citation+ { url :: Text+ , start_index :: Natural+ , end_index :: Natural+ , title :: Text+ }+ | Annotation_Container_File_Citation+ { container_id :: Text+ , file_id :: Text+ , start_index :: Natural+ , end_index :: Natural+ , filename :: Text+ }+ | Annotation_File_Path+ { file_id :: Text+ , index :: Natural+ }+ deriving stock (Generic, Show)++annotationOptions :: Options+annotationOptions = aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ , constructorTagModifier = stripPrefix "Annotation_"+ }++instance FromJSON Annotation where+ parseJSON = genericParseJSON annotationOptions++instance ToJSON Annotation where+ toJSON = genericToJSON annotationOptions++-- | Reasoning summary part+data SummaryPart = Summary_Text{ text :: Text }+ deriving stock (Generic, Show)++summaryPartOptions :: Options+summaryPartOptions = aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ }++instance FromJSON SummaryPart where+ parseJSON = genericParseJSON summaryPartOptions++instance ToJSON SummaryPart where+ toJSON = genericToJSON summaryPartOptions++-- | Reasoning text part+data ReasoningText = Reasoning_Text{ text :: Text }+ deriving stock (Generic, Show)++reasoningTextOptions :: Options+reasoningTextOptions = aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ }++instance FromJSON ReasoningText where+ parseJSON = genericParseJSON reasoningTextOptions++instance ToJSON ReasoningText where+ toJSON = genericToJSON reasoningTextOptions++-- | Reasoning item produced by reasoning models+data ReasoningItem = ReasoningItem+ { id :: Text+ , encrypted_content :: Maybe Text+ , summary :: Maybe (Vector SummaryPart)+ , content :: Maybe (Vector ReasoningText)+ , status :: Maybe Text+ } deriving stock (Generic, Show)++instance FromJSON ReasoningItem where+ parseJSON = genericParseJSON aesonOptions++instance ToJSON ReasoningItem where+ toJSON = genericToJSON aesonOptions++-- | Streaming events for /v1/responses+data ResponseStreamEvent+ = ResponseCreatedEvent+ { response :: ResponseObject+ , sequence_number :: Natural+ }+ | ResponseInProgressEvent+ { response :: ResponseObject+ , sequence_number :: Natural+ }+ | ResponseCompletedEvent+ { response :: ResponseObject+ , sequence_number :: Natural+ }+ | ResponseFailedEvent+ { response :: ResponseObject+ , sequence_number :: Natural+ }+ | ResponseOutputItemAddedEvent+ { output_index :: Natural+ , item :: OutputItem+ , sequence_number :: Natural+ }+ | ResponseOutputItemDoneEvent+ { output_index :: Natural+ , sequence_number :: Natural+ }+ | ResponseContentPartAddedEvent+ { item_id :: Text+ , output_index :: Natural+ , content_index :: Natural+ , part :: OutputContent+ , sequence_number :: Natural+ }+ | ResponseContentPartDoneEvent+ { item_id :: Text+ , output_index :: Natural+ , content_index :: Natural+ , part :: OutputContent+ , sequence_number :: Natural+ }+ | ResponseTextDeltaEvent+ { item_id :: Text+ , output_index :: Natural+ , content_index :: Natural+ , delta :: Text+ , sequence_number :: Natural+ }+ | ResponseTextDoneEvent+ { item_id :: Text+ , output_index :: Natural+ , content_index :: Natural+ , text :: Text+ , sequence_number :: Natural+ }+ | ResponseOutputTextAnnotationAddedEvent+ { item_id :: Text+ , output_index :: Natural+ , content_index :: Natural+ , annotation_index :: Natural+ , annotation :: Annotation+ , sequence_number :: Natural+ }+ | ResponseWebSearchCallInProgressEvent+ { output_index :: Natural+ , item_id :: Text+ , sequence_number :: Natural+ }+ | ResponseWebSearchCallSearchingEvent+ { output_index :: Natural+ , item_id :: Text+ , sequence_number :: Natural+ }+ | ResponseWebSearchCallCompletedEvent+ { output_index :: Natural+ , item_id :: Text+ , sequence_number :: Natural+ }+ | ResponseFileSearchCallInProgressEvent+ { output_index :: Natural+ , item_id :: Text+ , sequence_number :: Natural+ }+ | ResponseFileSearchCallSearchingEvent+ { output_index :: Natural+ , item_id :: Text+ , sequence_number :: Natural+ }+ | ResponseFileSearchCallCompletedEvent+ { output_index :: Natural+ , item_id :: Text+ , sequence_number :: Natural+ }+ | ResponseCodeInterpreterCallInProgressEvent+ { output_index :: Natural+ , item_id :: Text+ , sequence_number :: Natural+ }+ | ResponseCodeInterpreterCallInterpretingEvent+ { output_index :: Natural+ , item_id :: Text+ , sequence_number :: Natural+ }+ | ResponseCodeInterpreterCallCompletedEvent+ { output_index :: Natural+ , item_id :: Text+ , sequence_number :: Natural+ }+ | ResponseCodeInterpreterCallCodeDeltaEvent+ { output_index :: Natural+ , item_id :: Text+ , delta :: Text+ , sequence_number :: Natural+ }+ | ResponseCodeInterpreterCallCodeDoneEvent+ { output_index :: Natural+ , item_id :: Text+ , code :: Text+ , sequence_number :: Natural+ }+ | ErrorEvent+ { error_code :: Maybe Text+ , error_message :: Text+ , error_param :: Maybe Text+ , error_sequence_number :: Natural+ }+ deriving stock (Generic, Show)++responseStreamEventOptions :: Options+responseStreamEventOptions = aesonOptions+ { sumEncoding = TaggedObject{ tagFieldName = "type", contentsFieldName = "" }+ , tagSingleConstructors = True+ , fieldLabelModifier = \s -> case s of+ -- Strip "error_" prefix from ErrorEvent fields+ "error_code" -> "code"+ "error_message" -> "message"+ "error_param" -> "param"+ "error_sequence_number" -> "sequence_number"+ -- Keep all other fields as-is+ other -> other+ , constructorTagModifier = \s -> case s of+ "ResponseCreatedEvent" -> "response.created"+ "ResponseInProgressEvent" -> "response.in_progress"+ "ResponseCompletedEvent" -> "response.completed"+ "ResponseFailedEvent" -> "response.failed"+ "ResponseOutputItemAddedEvent" -> "response.output_item.added"+ "ResponseOutputItemDoneEvent" -> "response.output_item.done"+ "ResponseContentPartAddedEvent" -> "response.content_part.added"+ "ResponseContentPartDoneEvent" -> "response.content_part.done"+ "ResponseTextDeltaEvent" -> "response.output_text.delta"+ "ResponseTextDoneEvent" -> "response.output_text.done"+ "ResponseOutputTextAnnotationAddedEvent" -> "response.output_text.annotation.added"+ "ResponseWebSearchCallInProgressEvent" -> "response.web_search_call.in_progress"+ "ResponseWebSearchCallSearchingEvent" -> "response.web_search_call.searching"+ "ResponseWebSearchCallCompletedEvent" -> "response.web_search_call.completed"+ "ResponseFileSearchCallInProgressEvent" -> "response.file_search_call.in_progress"+ "ResponseFileSearchCallSearchingEvent" -> "response.file_search_call.searching"+ "ResponseFileSearchCallCompletedEvent" -> "response.file_search_call.completed"+ "ResponseCodeInterpreterCallInProgressEvent" -> "response.code_interpreter_call.in_progress"+ "ResponseCodeInterpreterCallInterpretingEvent" -> "response.code_interpreter_call.interpreting"+ "ResponseCodeInterpreterCallCompletedEvent" -> "response.code_interpreter_call.completed"+ "ResponseCodeInterpreterCallCodeDeltaEvent" -> "response.code_interpreter_call_code.delta"+ "ResponseCodeInterpreterCallCodeDoneEvent" -> "response.code_interpreter_call_code.done"+ "ErrorEvent" -> "error"+ _ -> Prelude.error "Unknown ResponseStreamEvent constructor"+ }++instance FromJSON ResponseStreamEvent where+ parseJSON = genericParseJSON responseStreamEventOptions++instance ToJSON ResponseStreamEvent where+ toJSON = genericToJSON responseStreamEventOptions+++-- | Usage statistics for the response request+data ResponseUsage = ResponseUsage+ { input_tokens :: Natural+ , input_tokens_details :: InputTokensDetails+ , output_tokens :: Natural+ , output_tokens_details :: OutputTokensDetails+ , total_tokens :: Natural+ } deriving stock (Generic, Show)+ deriving anyclass (FromJSON, ToJSON)++data InputTokensDetails = InputTokensDetails+ { cached_tokens :: Natural+ } deriving stock (Generic, Show)+ deriving anyclass (FromJSON, ToJSON)++data OutputTokensDetails = OutputTokensDetails+ { reasoning_tokens :: Natural+ } deriving stock (Generic, Show)+ deriving anyclass (FromJSON, ToJSON)++-- | Response object+data ResponseObject = ResponseObject+ { id :: Text+ , object :: Text+ , created_at :: POSIXTime+ , status :: Text+ , error :: Maybe Value+ , incomplete_details :: Maybe Value+ , instructions :: Maybe Value+ , model :: Model+ , output :: Vector OutputItem+ , parallel_tool_calls :: Bool+ , previous_response_id :: Maybe Text+ , reasoning :: Maybe Value+ , store :: Maybe Bool+ , temperature :: Maybe Double+ , tool_choice :: Maybe ToolChoice+ , tools :: Maybe (Vector Tool)+ , top_p :: Maybe Double+ , truncation :: Maybe Text+ , usage :: Maybe ResponseUsage+ , user :: Maybe Text+ , metadata :: Maybe (Map Text Text)+ } deriving stock (Generic, Show)+ deriving anyclass (FromJSON, ToJSON)++-- | Request body for /v1/responses+data CreateResponse = CreateResponse+ { model :: Model+ , input :: Maybe Input+ , include :: Maybe (Vector Text)+ , parallel_tool_calls :: Maybe Bool+ , store :: Maybe Bool+ , instructions :: Maybe Text+ , stream :: Maybe Bool+ , stream_options :: Maybe Value+ , metadata :: Maybe (Map Text Text)+ , temperature :: Maybe Double+ , top_p :: Maybe Double+ , tools :: Maybe (Vector Tool)+ , tool_choice :: Maybe ToolChoice+ } deriving stock (Generic, Show)++instance FromJSON CreateResponse where+ parseJSON = genericParseJSON aesonOptions++instance ToJSON CreateResponse where+ toJSON = genericToJSON aesonOptions++-- | Default CreateResponse+_CreateResponse :: CreateResponse+_CreateResponse = CreateResponse+ { input = Nothing+ , include = Nothing+ , parallel_tool_calls = Nothing+ , store = Nothing+ , instructions = Nothing+ , stream = Nothing+ , stream_options = Nothing+ , metadata = Nothing+ , temperature = Nothing+ , top_p = Nothing+ , tools = Nothing+ , tool_choice = Nothing+ }++-- | Servant API for /v1/responses+type API =+ "responses"+ :> ( ReqBody '[JSON] CreateResponse+ :> Post '[JSON] ResponseObject+ :<|> Capture "response_id" Text+ :> Get '[JSON] ResponseObject+ :<|> Capture "response_id" Text+ :> "cancel"+ :> Post '[JSON] ResponseObject+ :<|> Capture "response_id" Text+ :> "input_items"+ :> Get '[JSON] (ListOf InputItem)+ )
src/OpenAI/V1/Tool.hs view
@@ -6,9 +6,17 @@ , FileSearch(..) , Function(..) , ToolChoice(..)+ , CodeInterpreterContainer(..)+ -- * Helpers+ , codeInterpreter+ , codeInterpreterAuto+ , codeInterpreterWithFiles ) where import OpenAI.Prelude+import Data.Aeson ((.:), (.:?), (.=))+import qualified Data.Aeson as Aeson+import qualified Data.Vector as V -- | The ranking options for the file search data RankingOptions = RankingOptions@@ -35,9 +43,10 @@ -- | A tool enabled on the assistant data Tool- = Tool_Code_Interpreter+ = Tool_Code_Interpreter{ container :: Maybe CodeInterpreterContainer } | Tool_File_Search{ file_search :: FileSearch } | Tool_Function{ function :: Function }+ | Tool_Web_Search deriving stock (Generic, Show) toolOptions :: Options@@ -75,3 +84,44 @@ toJSON ToolChoiceAuto = "auto" toJSON ToolChoiceRequired = "required" toJSON (ToolChoiceTool tool) = toJSON tool++-- | Code Interpreter container reference+data CodeInterpreterContainer+ = CodeInterpreterContainer_Auto{ file_ids :: Maybe (Vector Text) }+ | CodeInterpreterContainer_ID{ container_id :: Text }+ deriving stock (Generic, Show)++instance ToJSON CodeInterpreterContainer where+ toJSON (CodeInterpreterContainer_ID container_id) = toJSON container_id+ toJSON (CodeInterpreterContainer_Auto file_ids) =+ Aeson.object $ "type" .= String "auto" : + maybe [] (\ids -> ["file_ids" .= ids]) file_ids++instance FromJSON CodeInterpreterContainer where+ parseJSON (String s) = pure $ CodeInterpreterContainer_ID s+ parseJSON (Object o) = do+ t <- o .: "type"+ case (t :: Text) of+ "auto" -> CodeInterpreterContainer_Auto <$> o .:? "file_ids"+ _ -> fail "Unknown code interpreter container object"+ parseJSON _ = fail "Invalid code interpreter container value"++-- | Convenience: Code Interpreter without an explicit container (for Assistants API)+codeInterpreter :: Tool+codeInterpreter =+ Tool_Code_Interpreter { container = Nothing }++-- | Convenience: Code Interpreter with automatic new container and no files+codeInterpreterAuto :: Tool+codeInterpreterAuto =+ Tool_Code_Interpreter+ { container = Just CodeInterpreterContainer_Auto{ file_ids = Nothing }+ }++-- | Convenience: Code Interpreter with automatic new container seeded with files+codeInterpreterWithFiles :: [Text] -> Tool+codeInterpreterWithFiles xs =+ let mFiles = case xs of+ [] -> Nothing+ _ -> Just (V.fromList xs)+ in Tool_Code_Interpreter { container = Just CodeInterpreterContainer_Auto{ file_ids = mFiles } }
tasty/Main.hs view
@@ -16,6 +16,7 @@ import qualified Network.HTTP.Client.TLS as TLS import OpenAI.V1 (Methods (..)) import qualified OpenAI.V1 as V1+import qualified OpenAI.V1.Responses as Responses import OpenAI.V1.Assistants ( AssistantObject (..), CreateAssistant (..),@@ -97,6 +98,7 @@ import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as HUnit import Prelude hiding (id)+import qualified Data.IORef as IORef main :: IO () main = do@@ -118,7 +120,7 @@ let chatModel = "gpt-4o-mini" let reasoningModel = "o3-mini" let ttsModel = "tts-1"- let Methods {..} = V1.makeMethods clientEnv (Text.pack key)+ let Methods {..} = V1.makeMethods clientEnv (Text.pack key) Nothing Nothing -- Test each format to make sure we're handling each possible content type -- correctly@@ -626,6 +628,29 @@ return () + let assistantsWithCodeInterpreterTest = do+ HUnit.testCase "Assistant with code interpreter tool" do+ -- Create an assistant enabling the code interpreter tool (no explicit container)+ AssistantObject {id = aid} <-+ createAssistant+ CreateAssistant+ { model = chatModel,+ name = Nothing,+ description = Nothing,+ instructions = Nothing,+ tools = Just [Tool.codeInterpreter],+ tool_resources = Nothing,+ metadata = Nothing,+ temperature = Nothing,+ top_p = Nothing,+ response_format = Nothing+ }++ -- Fetch and then delete to ensure the round trip works+ _ <- retrieveAssistant aid+ _ <- deleteAssistant aid+ return ()+ let messagesTest = do HUnit.testCase "Message operations" do ThreadObject {id = threadId} <-@@ -860,9 +885,134 @@ return () + let responsesMinimalTest =+ HUnit.testCase "Responses - minimal" do+ _ <-+ createResponse+ Responses._CreateResponse+ { Responses.model = chatModel,+ Responses.input = Just (Responses.Input+ [ Responses.Item_InputMessage+ { Responses.role = Responses.User+ , Responses.content = [ Responses.Input_Text{ Responses.text = "Say hello in one sentence." } ]+ , Responses.status = Nothing+ }+ ]),+ Responses.include = Nothing,+ Responses.parallel_tool_calls = Nothing,+ Responses.store = Nothing,+ Responses.instructions = Nothing,+ Responses.stream = Nothing,+ Responses.stream_options = Nothing,+ Responses.metadata = Nothing,+ Responses.temperature = Nothing,+ Responses.top_p = Nothing,+ Responses.tools = Nothing,+ Responses.tool_choice = Nothing+ }++ return ()++ let responsesStreamingHaikuTest =+ HUnit.testCase "Responses - streaming haiku" do+ let req =+ Responses._CreateResponse+ { Responses.model = chatModel,+ Responses.input = Just (Responses.Input+ [ Responses.Item_InputMessage+ { Responses.role = Responses.User+ , Responses.content = [ Responses.Input_Text{ Responses.text = "Stream a short haiku about the sea." } ]+ , Responses.status = Nothing+ }+ ]),+ Responses.include = Nothing,+ Responses.parallel_tool_calls = Nothing,+ Responses.store = Nothing,+ Responses.instructions = Nothing,+ Responses.stream = Nothing,+ Responses.stream_options = Nothing,+ Responses.metadata = Nothing,+ Responses.temperature = Nothing,+ Responses.top_p = Nothing,+ Responses.tools = Nothing,+ Responses.tool_choice = Nothing+ }++ acc <- IORef.newIORef (Text.empty)+ done <- Concurrent.newEmptyMVar++ let onEvent (Left _err) = Concurrent.putMVar done ()+ onEvent (Right ev) = case ev of+ Responses.ResponseTextDeltaEvent{ Responses.delta = d } ->+ IORef.modifyIORef' acc (<> d)+ Responses.ResponseCompletedEvent{} ->+ Concurrent.putMVar done ()+ _ -> pure ()++ createResponseStreamTyped req onEvent++ _ <- Concurrent.takeMVar done+ text <- IORef.readIORef acc+ HUnit.assertBool "Expected non-empty streamed text" (not (Text.null text))++ return ()++ let responsesCodeInterpreterStreamingTest =+ HUnit.testCase "Responses - streaming with code interpreter" do+ let req =+ Responses._CreateResponse+ { Responses.model = chatModel,+ Responses.input = Just (Responses.Input+ [ Responses.Item_InputMessage+ { Responses.role = Responses.User+ , Responses.content = [ Responses.Input_Text{ Responses.text = "Solve 3x + 11 = 14 and provide x as a number. Use the code interpreter." } ]+ , Responses.status = Nothing+ }+ ]),+ Responses.include = Nothing,+ Responses.parallel_tool_calls = Nothing,+ Responses.store = Nothing,+ Responses.instructions = Just "You are a math tutor. Use the code interpreter (python) tool to calculate answers when asked about math.",+ Responses.stream = Nothing,+ Responses.stream_options = Nothing,+ Responses.metadata = Nothing,+ Responses.temperature = Nothing,+ Responses.top_p = Nothing,+ Responses.tools = Just [Tool.codeInterpreterAuto],+ Responses.tool_choice = Just Tool.ToolChoiceRequired+ }++ acc <- IORef.newIORef (Text.empty)+ sawCI <- IORef.newIORef False+ done <- Concurrent.newEmptyMVar++ let onEvent (Left _err) = Concurrent.putMVar done ()+ onEvent (Right ev) = case ev of+ Responses.ResponseTextDeltaEvent{ Responses.delta = d } ->+ IORef.modifyIORef' acc (<> d)+ Responses.ResponseCodeInterpreterCallInProgressEvent{} ->+ IORef.writeIORef sawCI True+ Responses.ResponseCodeInterpreterCallInterpretingEvent{} ->+ IORef.writeIORef sawCI True+ Responses.ResponseCodeInterpreterCallCompletedEvent{} -> do+ IORef.writeIORef sawCI True+ Responses.ResponseCompletedEvent{} ->+ Concurrent.putMVar done ()+ _ -> pure ()++ createResponseStreamTyped req onEvent++ _ <- Concurrent.takeMVar done+ text <- IORef.readIORef acc+ usedCI <- IORef.readIORef sawCI+ HUnit.assertBool "Expected some streamed text" (not (Text.null text))+ HUnit.assertBool "Expected code interpreter activity in stream" usedCI++ return ()+ let tests =- speechTests- <> [ transcriptionTest,+ speechTests+ <> [ transcriptionTest, translationTest, completionsMinimalTest, completionsMinimalReasoningTest,@@ -878,7 +1028,11 @@ createImageVariationMinimalTest, createImageVariationMaximalTest, createModerationTest,+ responsesMinimalTest,+ responsesStreamingHaikuTest,+ responsesCodeInterpreterStreamingTest, assistantsTest,+ assistantsWithCodeInterpreterTest, messagesTest, threadsRunsStepsTest, vectorStoreFilesTest