diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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) diff --git a/examples/openai-example/Main.hs b/examples/openai-example/Main.hs --- a/examples/openai-example/Main.hs +++ b/examples/openai-example/Main.hs @@ -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 diff --git a/examples/responses-example/Main.hs b/examples/responses-example/Main.hs new file mode 100644 --- /dev/null +++ b/examples/responses-example/Main.hs @@ -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 diff --git a/examples/responses-stream-example/Main.hs b/examples/responses-stream-example/Main.hs new file mode 100644 --- /dev/null +++ b/examples/responses-stream-example/Main.hs @@ -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 diff --git a/examples/weather-chatbot-example/Main.hs b/examples/weather-chatbot-example/Main.hs --- a/examples/weather-chatbot-example/Main.hs +++ b/examples/weather-chatbot-example/Main.hs @@ -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 = 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: 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 diff --git a/src/OpenAI/Prelude.hs b/src/OpenAI/Prelude.hs --- a/src/OpenAI/Prelude.hs +++ b/src/OpenAI/Prelude.hs @@ -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 diff --git a/src/OpenAI/V1.hs b/src/OpenAI/V1.hs --- a/src/OpenAI/V1.hs +++ b/src/OpenAI/V1.hs @@ -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 diff --git a/src/OpenAI/V1/Chat/Completions.hs b/src/OpenAI/V1/Chat/Completions.hs --- a/src/OpenAI/V1/Chat/Completions.hs +++ b/src/OpenAI/V1/Chat/Completions.hs @@ -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) diff --git a/src/OpenAI/V1/Responses.hs b/src/OpenAI/V1/Responses.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Responses.hs @@ -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) + ) diff --git a/src/OpenAI/V1/Tool.hs b/src/OpenAI/V1/Tool.hs --- a/src/OpenAI/V1/Tool.hs +++ b/src/OpenAI/V1/Tool.hs @@ -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 } } diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -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