diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +1.1.1: + +- [Remove timeout on default `ClientEnv`](https://github.com/MercuryTechnologies/openai/pull/55) +- [`/v1/chat/completions`: Add support for Search](https://github.com/MercuryTechnologies/openai/pull/57) +- [Fix CreateSpeech JSON instances, add new voices and optional instructions field](https://github.com/MercuryTechnologies/openai/pull/58) +- [Correct `ToJSON` of `FileSearchResources`](https://github.com/MercuryTechnologies/openai/pull/49) +- [New example app for tool-calling and chat-loop](https://github.com/MercuryTechnologies/openai/pull/60) + 1.1.0: - BREAKING CHANGE: Fix details representations for various types [[#44](https://github.com/MercuryTechnologies/openai/pull/44)] [[#45](https://github.com/MercuryTechnologies/openai/pull/45)] [[#50](https://github.com/MercuryTechnologies/openai/pull/50)] [[#51](https://github.com/MercuryTechnologies/openai/pull/51)] diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ This provides a binding to OpenAI's API using `servant` -Example usage: +## Example usage ```haskell {-# LANGUAGE DuplicateRecordFields #-} @@ -38,4 +38,87 @@ let display Choice{ message } = Text.IO.putStrLn (messageToContent message) traverse_ display choices +``` + +## Setup + +### Using Nix with Flakes (Recommended) + +This project uses Nix with flakes for development environment setup. + +1. Ensure you have Nix with flakes enabled +2. Copy the sample environment file and configure your OpenAI API key: + +```bash +# Copy the sample environment file +cp .envrc.sample .envrc +``` + +3. Edit the `.envrc` file and replace the placeholder API key with your actual key + +4. Use direnv to automatically load the development environment: + +```bash +# Install direnv if you haven't already +# macOS: brew install direnv +# Linux: your-package-manager install direnv + +# Enable direnv hook in your shell +eval "$(direnv hook bash)" # or zsh, fish, etc. + +# Clone the repository and enter the directory +git clone https://github.com/MercuryTechnologies/openai.git +cd openai + +# Allow direnv (this will automatically load the environment) +direnv allow +``` + +### Manual Setup + +Without Nix: + +```bash +# Clone the repository +git clone https://github.com/MercuryTechnologies/openai.git +cd openai + +# Build with cabal +cabal build +``` + +## Environment Variables + +Set your OpenAI API key as an environment variable: + +```bash +# Option 1: Set directly in your shell +export OPENAI_KEY="your-openai-api-key" + +# Option 2: Using .envrc with direnv (recommended) +(umask 077; cp .envrc.sample .envrc) +# Edit .envrc to add your API key +direnv allow +``` + +The API key is needed for running the test suite and example program. + +## Testing + +Run the test suite: + +```bash +cabal test +``` + +The test suite is in the `tasty/` directory with test data located in `tasty/data/`. + +## Running the Example + +```bash +# Make sure your API key is set (either via .envrc or export) +# If using direnv with proper .envrc setup, this happens automatically + +# Build and run the example +cabal run openai-example ``` diff --git a/examples/openai-example/Main.hs b/examples/openai-example/Main.hs new file mode 100644 --- /dev/null +++ b/examples/openai-example/Main.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} + +module Main where + +import Data.Foldable (traverse_) +import OpenAI.V1 +import OpenAI.V1.Chat.Completions + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified System.Environment as Environment + +main :: IO () +main = do + key <- Environment.getEnv "OPENAI_KEY" + + clientEnv <- getClientEnv "https://api.openai.com" + + let Methods{ createChatCompletion } = makeMethods clientEnv (Text.pack key) + + text <- Text.IO.getLine + + ChatCompletionObject{ choices } <- createChatCompletion _CreateChatCompletion + { messages = [ User{ content = [ Text{ text } ], name = Nothing } ] + , model = "gpt-4o-mini" + } + + let display Choice{ message } = Text.IO.putStrLn (messageToContent message) + + traverse_ display choices diff --git a/examples/weather-chatbot-example/Main.hs b/examples/weather-chatbot-example/Main.hs new file mode 100644 --- /dev/null +++ b/examples/weather-chatbot-example/Main.hs @@ -0,0 +1,226 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +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 OpenAI.V1 +import OpenAI.V1.Chat.Completions +import OpenAI.V1.Tool +import OpenAI.V1.ToolCall +import qualified System.Environment as Environment + +-- | Mock weather data for different cities +mockWeatherData :: Text -> Text +mockWeatherData city = case Text.toLower city of + "london" -> "London: 18°C, partly cloudy, 60% humidity, light rain expected" + "paris" -> "Paris: 22°C, sunny, 45% humidity, clear skies" + "tokyo" -> "Tokyo: 28°C, humid, 80% humidity, thunderstorms possible" + "new york" -> "New York: 25°C, partly sunny, 55% humidity, pleasant weather" + "san francisco" -> "San Francisco: 16°C, foggy, 70% humidity, typical coastal weather" + _ -> city <> ": Weather data not available for this location. Try London, Paris, Tokyo, New York, or San Francisco." + +-- | Process a weather tool call and return the result +processWeatherToolCall :: ToolCall -> IO (Message (Vector Content)) +processWeatherToolCall (ToolCall_Function toolCallId function) = do + let functionName = OpenAI.V1.ToolCall.name function + arguments = OpenAI.V1.ToolCall.arguments function + + putStrLn $ "🔧 Processing tool call: " <> Text.unpack functionName + putStrLn $ " Arguments: " <> Text.unpack arguments + + -- 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 (String cityName) -> mockWeatherData cityName + _ -> "Error: Could not parse city name from arguments" + _ -> "Error: Invalid arguments format" + + putStrLn $ " Result: " <> Text.unpack weatherResult + putStrLn "" + + -- Return a Tool message with the result + return $ + Tool + { content = [Text weatherResult], + tool_call_id = toolCallId + } + +-- | Define the weather tool +weatherTool :: Tool +weatherTool = + Tool_Function $ + OpenAI.V1.Tool.Function + { description = Just "Get current weather information for a city", + name = "get_weather", + parameters = + Just $ + Aeson.object + [ "type" .= ("object" :: Text), + "properties" + .= Aeson.object + [ "city" + .= Aeson.object + [ "type" .= ("string" :: Text), + "description" .= ("The city name to get weather for" :: Text) + ] + ], + "required" .= (["city"] :: [Text]), + "additionalProperties" .= False + ], + strict = Just True + } + +-- | Convert a Message Text to Message (Vector Content) +convertMessage :: Message Text -> Message (Vector Content) +convertMessage (System {content, name}) = System {content = [Text content], name = name} +convertMessage (User {content, name}) = User {content = [Text content], name = name} +convertMessage (Assistant {assistant_content, refusal, name, assistant_audio, tool_calls}) = + Assistant + { assistant_content = fmap (\c -> [Text c]) assistant_content, + refusal = refusal, + name = name, + assistant_audio = assistant_audio, + tool_calls = tool_calls + } +convertMessage (Tool {content, tool_call_id}) = Tool {content = [Text content], tool_call_id = tool_call_id} + +-- | Process all tool calls in a message and return tool response messages +processToolCalls :: Vector ToolCall -> IO (Vector (Message (Vector Content))) +processToolCalls toolCalls = do + when (not $ Vector.null toolCalls) $ do + putStrLn $ "🤖 Processing " <> show (Vector.length toolCalls) <> " tool call(s)..." + Vector.mapM processWeatherToolCall toolCalls + +-- | Main chat loop +chatLoop :: (CreateChatCompletion -> IO ChatCompletionObject) -> Vector (Message (Vector Content)) -> IO () +chatLoop createChatCompletion messages = do + Text.IO.putStr "You: " + userInput <- Text.IO.getLine + + -- Exit condition + when (Text.toLower userInput == "quit" || Text.toLower userInput == "exit") $ do + putStrLn "Goodbye! 👋" + return () + + -- Add user message to conversation + let userMessage = + User + { content = [Text userInput], + name = Nothing + } + updatedMessages = messages <> [userMessage] + + -- Make API call with tool support + response <- + createChatCompletion + _CreateChatCompletion + { messages = updatedMessages, + model = "gpt-4o-mini", + tools = Just [weatherTool], + tool_choice = Just ToolChoiceAuto + } + + let ChatCompletionObject {choices} = response + + -- Process each choice (usually just one) + newMessages <- foldM (processChoice createChatCompletion) updatedMessages choices + + -- Continue the conversation + chatLoop createChatCompletion newMessages + +-- | Process a single choice, handling potential tool calls +processChoice :: + (CreateChatCompletion -> IO ChatCompletionObject) -> + Vector (Message (Vector Content)) -> + Choice -> + IO (Vector (Message (Vector Content))) +processChoice createChatCompletion messages choice = do + let Choice {message = assistantMessage} = choice + + case assistantMessage of + Assistant {assistant_content, tool_calls = Just toolCalls} -> do + -- Display assistant's message if any + case assistant_content of + Just content -> putStrLn $ "Assistant: " <> Text.unpack content + Nothing -> return () + + -- Add assistant message to history + let messagesWithAssistant = messages <> [convertMessage assistantMessage] + + -- Process tool calls + toolResults <- processToolCalls toolCalls + let messagesWithTools = messagesWithAssistant <> toolResults + + -- Make another API call to get the final response after tool calls + finalResponse <- + createChatCompletion + _CreateChatCompletion + { messages = messagesWithTools, + model = "gpt-4o-mini", + tools = Just [weatherTool], + tool_choice = Just ToolChoiceAuto + } + + let ChatCompletionObject {choices = finalChoices} = finalResponse + + -- Process the final response (this should not have tool calls) + foldM processFinalChoice messagesWithTools finalChoices + Assistant {assistant_content = Just content} -> do + -- No tool calls, just display the response + putStrLn $ "Assistant: " <> Text.unpack content + return $ messages <> [convertMessage assistantMessage] + _ -> do + putStrLn "Assistant: (No response content)" + return messages + +-- | Process final choice after tool calls (should just be text response) +processFinalChoice :: Vector (Message (Vector Content)) -> Choice -> IO (Vector (Message (Vector Content))) +processFinalChoice messages choice = do + let Choice {message = finalMessage} = choice + case finalMessage of + Assistant {assistant_content = Just content} -> do + putStrLn $ "Assistant: " <> Text.unpack content + return $ messages <> [convertMessage finalMessage] + _ -> do + putStrLn "Assistant: (Unexpected response format)" + return messages + +main :: IO () +main = do + putStrLn "🌤️ Weather Chatbot with Tool Calling" + putStrLn "======================================" + putStrLn "Ask me about the weather in different cities!" + putStrLn "Try: 'What's the weather like in London?'" + putStrLn "Available cities: London, Paris, Tokyo, New York, San Francisco" + putStrLn "Type 'quit' or 'exit' to end the conversation." + putStrLn "" + + -- Get OpenAI API key + key <- Environment.getEnv "OPENAI_KEY" + + -- Set up client + clientEnv <- getClientEnv "https://api.openai.com" + let Methods {createChatCompletion} = makeMethods clientEnv (Text.pack key) + + -- Initial system message + let systemMessage = + System + { content = [Text "You are a helpful weather assistant. Use the get_weather tool to provide current weather information when users ask about weather in specific cities. Be conversational and helpful."], + name = Nothing + } + + -- Start the chat loop + chatLoop createChatCompletion [systemMessage] diff --git a/openai-example/Main.hs b/openai-example/Main.hs deleted file mode 100644 --- a/openai-example/Main.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE OverloadedLists #-} - -module Main where - -import Data.Foldable (traverse_) -import OpenAI.V1 -import OpenAI.V1.Chat.Completions - -import qualified Data.Text as Text -import qualified Data.Text.IO as Text.IO -import qualified System.Environment as Environment - -main :: IO () -main = do - key <- Environment.getEnv "OPENAI_KEY" - - clientEnv <- getClientEnv "https://api.openai.com" - - let Methods{ createChatCompletion } = makeMethods clientEnv (Text.pack key) - - text <- Text.IO.getLine - - ChatCompletionObject{ choices } <- createChatCompletion _CreateChatCompletion - { messages = [ User{ content = [ Text{ text } ], name = Nothing } ] - , model = "gpt-4o-mini" - } - - let display Choice{ message } = Text.IO.putStrLn (messageToContent message) - - traverse_ display choices 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.0 +version: 1.1.1 synopsis: Servant bindings to OpenAI description: This package provides comprehensive and type-safe bindings to OpenAI, providing both a Servant interface and @@ -28,6 +28,7 @@ , containers , filepath , http-api-data + , http-client , http-client-tls , servant , servant-multipart-api @@ -113,9 +114,21 @@ executable openai-example default-language: Haskell2010 - hs-source-dirs: openai-example + hs-source-dirs: examples/openai-example main-is: Main.hs build-depends: base , openai , text + ghc-options: -Wall + +executable weather-chatbot-example + default-language: Haskell2010 + hs-source-dirs: examples/weather-chatbot-example + main-is: Main.hs + build-depends: base + , aeson + , bytestring + , openai + , text + , vector ghc-options: -Wall diff --git a/src/OpenAI/V1.hs b/src/OpenAI/V1.hs --- a/src/OpenAI/V1.hs +++ b/src/OpenAI/V1.hs @@ -122,6 +122,7 @@ import qualified Control.Exception as Exception import qualified Data.Text as Text +import qualified Network.HTTP.Client as HTTP.Client import qualified Network.HTTP.Client.TLS as TLS import qualified OpenAI.V1.Assistants as Assistants import qualified OpenAI.V1.Audio as Audio @@ -151,7 +152,14 @@ -> IO ClientEnv getClientEnv baseUrlText = do baseUrl <- Client.parseBaseUrl (Text.unpack baseUrlText) - manager <- TLS.newTlsManager + + let managerSettings = TLS.tlsManagerSettings + { HTTP.Client.managerResponseTimeout = + HTTP.Client.responseTimeoutNone + } + + manager <- TLS.newTlsManagerWith managerSettings + pure (Client.mkClientEnv manager baseUrl) -- | Get a record of API methods after providing an API token diff --git a/src/OpenAI/V1/Audio/Speech.hs b/src/OpenAI/V1/Audio/Speech.hs --- a/src/OpenAI/V1/Audio/Speech.hs +++ b/src/OpenAI/V1/Audio/Speech.hs @@ -1,4 +1,4 @@ --- | @\/v1\/audio\/speech@ +-- | [@\/v1\/audio\/speech@](https://platform.openai.com/docs/api-reference/audio/createSpeech) module OpenAI.V1.Audio.Speech ( -- * Main types CreateSpeech(..) @@ -18,7 +18,7 @@ -- -- Previews of the voices are available in the -- [Text to speech guide](https://platform.openai.com/docs/guides/text-to-speech#voice-options). -data Voice = Alloy | Echo | Fable | Onyx | Nova | Shimmer +data Voice = Alloy | Ash | Ballad | Coral | Echo | Fable | Nova | Onyx | Sage | Shimmer deriving stock (Bounded, Enum, Generic, Show) instance FromJSON Voice where @@ -27,7 +27,7 @@ instance ToJSON Voice where toJSON = genericToJSON aesonOptions --- | The format to audio in +-- | The format to generate the audio in data Format = MP3 | Opus | AAC | FLAC | WAV | PCM deriving stock (Bounded, Enum, Generic, Show) @@ -39,18 +39,27 @@ -- | Request body for @\/v1\/audio\/speech@ data CreateSpeech = CreateSpeech - { model :: Model - , input :: Text + { model :: Model -- ^ Note that only [TTS models](https://platform.openai.com/docs/models#tts) support speech synthesis. + , input :: Text -- ^ The text to generate audio for. The maximum length is 4096 characters. , voice :: Voice - , response_format :: Maybe Format - , speed :: Maybe Double + , instructions :: Maybe Text -- ^ Instructions for the model to follow when generating the audio. + -- Does not work with @tts-1@ or @tts-1-hd@ models. + , response_format :: Maybe Format -- ^ Defaults to 'MP3'. + , speed :: Maybe Double -- ^ Defaults to 1.0 (normal speed). Should be between 0.25 and 4.0. + -- Does not work with @gpt-4o-mini-tts@ model. } deriving stock (Generic, Show) - deriving anyclass (FromJSON, ToJSON) +instance ToJSON CreateSpeech where + toJSON = genericToJSON aesonOptions + +instance FromJSON CreateSpeech where + parseJSON = genericParseJSON aesonOptions + -- | Default `CreateSpeech` _CreateSpeech :: CreateSpeech _CreateSpeech = CreateSpeech - { response_format = Nothing + { instructions = Nothing + , response_format = Nothing , speed = Nothing } 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 @@ -22,6 +22,9 @@ , ResponseFormat(..) , ServiceTier(..) , ReasoningEffort(..) + , SearchContextSize(..) + , UserLocation(..) + , WebSearchOptions(..) , FinishReason(..) , Token(..) , LogProbs(..) @@ -216,15 +219,73 @@ instance ToJSON ServiceTier where toJSON = genericToJSON serviceOptions -data ReasoningEffort = Low | Medium | High +-- | Constrains effort on reasoning for reasoning models +data ReasoningEffort + = ReasoningEffort_Low + | ReasoningEffort_Medium + | ReasoningEffort_High deriving stock (Generic, Show) +reasoningEffortOptions :: Options +reasoningEffortOptions = + aesonOptions + { constructorTagModifier = stripPrefix "ReasoningEffort_" } + instance FromJSON ReasoningEffort where - parseJSON = genericParseJSON aesonOptions + parseJSON = genericParseJSON reasoningEffortOptions instance ToJSON ReasoningEffort where - toJSON = genericToJSON aesonOptions + toJSON = genericToJSON reasoningEffortOptions +-- | High level guidance for the amount of context window space to use for the +-- search +data SearchContextSize + = SearchContextSize_Low + | SearchContextSize_Medium + | SearchContextSize_High + deriving stock (Generic, Show) + +instance FromJSON SearchContextSize where + parseJSON = genericParseJSON searchContextSizeOptions + +instance ToJSON SearchContextSize where + toJSON = genericToJSON searchContextSizeOptions + +-- | Approximate location parameters for the search +data UserLocation = Approximate + { city :: Maybe Text + , country :: Maybe Text + , region :: Maybe Text + , timezone :: Maybe Text + } deriving stock (Generic, Show) + +instance FromJSON UserLocation where + parseJSON = genericParseJSON userLocationOptions + +instance ToJSON UserLocation where + toJSON = genericToJSON userLocationOptions + +userLocationOptions :: Options +userLocationOptions = + aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +searchContextSizeOptions :: Options +searchContextSizeOptions = + aesonOptions + { constructorTagModifier = stripPrefix "SearchContextSize_" } + +-- | Search the web for relevant results to use in a response +data WebSearchOptions = WebSearchOptions + { search_context_size :: Maybe SearchContextSize + , user_location :: Maybe UserLocation + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + -- | Request body for @\/v1\/chat\/completions@ data CreateChatCompletion = CreateChatCompletion { messages :: Vector (Message (Vector Content)) @@ -252,6 +313,7 @@ , tool_choice :: Maybe ToolChoice , parallel_tool_calls :: Maybe Bool , user :: Maybe Text + , web_search_options :: Maybe WebSearchOptions } deriving stock (Generic, Show) instance FromJSON CreateChatCompletion where @@ -286,6 +348,7 @@ , tool_choice = Nothing , parallel_tool_calls = Nothing , user = Nothing + , web_search_options = Nothing } -- | The reason the model stopped generating tokens diff --git a/src/OpenAI/V1/ToolResources.hs b/src/OpenAI/V1/ToolResources.hs --- a/src/OpenAI/V1/ToolResources.hs +++ b/src/OpenAI/V1/ToolResources.hs @@ -34,7 +34,10 @@ { vector_store_ids :: Maybe (Vector FileID) , vector_stores :: Maybe (Vector VectorStore) } deriving stock (Generic, Show) - deriving anyclass (FromJSON, ToJSON) + deriving anyclass (FromJSON) + +instance ToJSON FileSearchResources where + toJSON = genericToJSON aesonOptions -- | A set of resources that are used by the assistant's tools data ToolResources = ToolResources diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -1,691 +1,887 @@ -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} - -{-# OPTIONS_GHC -Wno-orphans #-} - -module Main where - -import OpenAI.V1 (Methods(..)) -import OpenAI.V1.AutoOr (AutoOr(..)) -import OpenAI.V1.Audio.Transcriptions (CreateTranscription(..)) -import OpenAI.V1.Audio.Translations (CreateTranslation(..)) -import OpenAI.V1.Batches (BatchObject(..), CreateBatch(..)) -import OpenAI.V1.Embeddings (CreateEmbeddings(..), EncodingFormat(..)) -import OpenAI.V1.Files (FileObject(..), Order(..), UploadFile(..)) -import OpenAI.V1.Images.Edits (CreateImageEdit(..)) -import OpenAI.V1.Images.Variations (CreateImageVariation(..)) -import OpenAI.V1.Message (Message(..)) -import OpenAI.V1.Moderations (CreateModeration(..)) -import OpenAI.V1.Threads.Messages (MessageObject(..), ModifyMessage(..)) -import OpenAI.V1.Tool (Tool(..), ToolChoice(..)) -import OpenAI.V1.ToolCall (ToolCall(..)) -import Prelude hiding (id) - -import OpenAI.V1.Assistants - (CreateAssistant(..), ModifyAssistant(..), AssistantObject(..)) -import OpenAI.V1.Audio.Speech - (_CreateSpeech, CreateSpeech(..), Voice(..)) -import OpenAI.V1.Chat.Completions - (CreateChatCompletion(..), Modality(..)) -import OpenAI.V1.FineTuning.Jobs - (CreateFineTuningJob(..), Hyperparameters(..), JobObject(..)) -import OpenAI.V1.Images.Generations - (CreateImage(..), Quality(..), Style(..)) -import OpenAI.V1.Threads - (ModifyThread(..), Thread(..), ThreadObject(..)) -import OpenAI.V1.Threads.Runs - (CreateRun(..), ModifyRun(..), RunObject(..)) -import OpenAI.V1.Uploads - ( AddUploadPart(..) - , CompleteUpload(..) - , CreateUpload(..) - , PartObject(..) - , UploadObject(..) - ) -import OpenAI.V1.VectorStores - ( CreateVectorStore(..) - , ModifyVectorStore(..) - , VectorStoreObject(..) - ) -import OpenAI.V1.VectorStores.Files - (CreateVectorStoreFile(..), VectorStoreFileObject(..)) -import OpenAI.V1.VectorStores.FileBatches - (CreateVectorStoreFileBatch(..), VectorStoreFilesBatchObject(..)) - -import qualified Data.Text as Text -import qualified Network.HTTP.Client as HTTP.Client -import qualified Network.HTTP.Client.TLS as TLS -import qualified OpenAI.V1 as V1 -import qualified OpenAI.V1.Chat.Completions as Completions -import qualified OpenAI.V1.Files as Files -import qualified OpenAI.V1.FineTuning.Jobs as Jobs -import qualified OpenAI.V1.Images.ResponseFormat as ResponseFormat -import qualified OpenAI.V1.Tool as Tool -import qualified OpenAI.V1.ToolCall as ToolCall -import qualified Servant.Client as Client -import qualified System.Environment as Environment -import qualified Test.Tasty as Tasty -import qualified Test.Tasty.HUnit as HUnit - -main :: IO () -main = do - let managerSettings = TLS.tlsManagerSettings - { HTTP.Client.managerResponseTimeout = - HTTP.Client.responseTimeoutNone - } - - manager <- TLS.newTlsManagerWith managerSettings - - baseUrl <- Client.parseBaseUrl "https://api.openai.com" - - let clientEnv = Client.mkClientEnv manager baseUrl - - key <- Environment.getEnv "OPENAI_KEY" - - let user = "openai Haskell package" - let chatModel = "gpt-4o-mini" - let reasoningModel = "o3-mini" - let Methods{..} = V1.makeMethods clientEnv (Text.pack key) - - -- Test each format to make sure we're handling each possible content type - -- correctly - let speechTest format = - HUnit.testCase ("Create speech - " <> show format) do - _ <- createSpeech _CreateSpeech - { model = "tts-1" - , input = "Hello, world!" - , voice = Nova - , response_format = Just format - , speed = Just 1.0 - } - - return () - - let speechTests = do - format <- [ minBound .. maxBound ] - return (speechTest format) - - let transcriptionTest = - HUnit.testCase "Create transcription" do - _ <- createTranscription CreateTranscription - { file = "tasty/data/v1/audio/preamble.wav" - , model = "whisper-1" - , language = Just "en" - , prompt = Nothing - , temperature = Just 0 - } - - return () - - let translationTest = - HUnit.testCase "Create translation" do - _ <- createTranslation CreateTranslation - { file = "tasty/data/v1/audio/preamble.wav" - , model = "whisper-1" - , prompt = Nothing - , temperature = Just 0 - } - - return () - - let completionsMinimalTest = - HUnit.testCase "Create chat completion - minimal" do - _ <- createChatCompletion CreateChatCompletion - { messages = - [ Completions.User - { content = [ "Hello, world!" ], name = Nothing } - ] - , model = chatModel - , store = Nothing - , metadata = Nothing - , frequency_penalty = Nothing - , logit_bias = Nothing - , logprobs = Nothing - , top_logprobs = Nothing - , max_completion_tokens = Nothing - , n = Nothing - , modalities = Nothing - , prediction = Nothing - , audio = Nothing - , presence_penalty = Nothing - , reasoning_effort = Nothing - , response_format = Nothing - , seed = Nothing - , service_tier = Nothing - , stop = Nothing - , temperature = Nothing - , top_p = Nothing - , tools = Nothing - , tool_choice = Nothing - , parallel_tool_calls = Nothing - , user = Nothing - } - - return () - - let completionsMinimalReasoningTest = - HUnit.testCase "Create chat completion reasoning model - minimal" do - _ <- createChatCompletion CreateChatCompletion - { messages = - [ Completions.User - { content = [ "Hello, world!" ], name = Nothing } - ] - , model = reasoningModel - , store = Nothing - , metadata = Nothing - , frequency_penalty = Nothing - , logit_bias = Nothing - , logprobs = Nothing - , top_logprobs = Nothing - , max_completion_tokens = Nothing - , n = Nothing - , modalities = Nothing - , prediction = Nothing - , audio = Nothing - , presence_penalty = Nothing - , reasoning_effort = Just Completions.Low - , response_format = Nothing - , seed = Nothing - , service_tier = Nothing - , stop = Nothing - , temperature = Nothing - , top_p = Nothing - , tools = Nothing - , tool_choice = Nothing - , parallel_tool_calls = Nothing - , user = Nothing - } - - return () - - let completionsMaximalTest = - HUnit.testCase "Create chat completion - maximal" do - _ <- createChatCompletion CreateChatCompletion - { messages = - [ Completions.User - { content = [ "Hello, world!" ] - , name = Just "gabby" - } - , Completions.Assistant - { assistant_content = Nothing - , refusal = Nothing - , name = Just "Ada" - , assistant_audio = Nothing - , tool_calls = Just - [ ToolCall_Function - { id = "call_bzE95mjMMFqeanfY2sL6Sdir" - , function = ToolCall.Function - { name = "hello" - , arguments = "{}" - } - } - ] - } - , Completions.Tool - { content = [ "Hello, world!" ] - , tool_call_id = "call_bzE95mjMMFqeanfY2sL6Sdir" - } - ] - , model = chatModel - , store = Just False - , metadata = Nothing - , frequency_penalty = Just 0 - , logit_bias = Just mempty - , logprobs = Just True - , top_logprobs = Just 1 - , max_completion_tokens = Just 1024 - , n = Just 1 - , modalities = Just [ Modality_Text ] - , prediction = Nothing - , audio = Nothing - , presence_penalty = Just 0 - , reasoning_effort = Nothing - , response_format = Just Completions.ResponseFormat_Text - , seed = Just 0 - , service_tier = Just Auto - , stop = Just [ ">>>" ] - , temperature = Just 1 - , top_p = Just 1 - , tools = Just - [ Tool_Function - { function = Tool.Function - { description = - Just "Use the hello command line tool" - , name = "hello" - , parameters = Nothing - , strict = Just False - } - } - ] - , tool_choice = Just ToolChoiceAuto - , parallel_tool_calls = Just True - , user = Just user - } - - return () - - let embeddingsTest = do - HUnit.testCase "Create embedding" do - _ <- createEmbeddings CreateEmbeddings - { input = "Hello, world!" - , model = "text-embedding-3-small" - , encoding_format = Just Float - , dimensions = Just 1024 - , user = Just user - } - - return () - - let fineTuningTest = do - HUnit.testCase "Fine-tuning and File operations - maximal" do - FileObject{ id = trainingId } <- uploadFile UploadFile - { file = - "tasty/data/v1/fine_tuning/jobs/training_data.jsonl" - , purpose = Files.Fine_Tune - } - - FileObject{ id = validationId } <- uploadFile UploadFile - { file = - "tasty/data/v1/fine_tuning/jobs/validation_data.jsonl" - , purpose = Files.Fine_Tune - } - - _ <- retrieveFile trainingId - - _ <- retrieveFileContent trainingId - - _ <- listFiles (Just Files.Fine_Tune) (Just 10000) (Just Asc) Nothing - - JobObject{ id } <- createFineTuningJob CreateFineTuningJob - { model = "gpt-4o-mini-2024-07-18" - , training_file = trainingId - , hyperparameters = Just - Hyperparameters - { batch_size = Just Jobs.Auto - , learning_rate_multiplier = Just Jobs.Auto - , n_epochs = Just Jobs.Auto - } - , suffix = Just "haskell-openai" - , validation_file = Just validationId - , integrations = Just [] - , seed = Just 0 - } - - _ <- retrieveFineTuningJob id - - _ <- listFineTuningJobs Nothing (Just 20) - - _ <- listFineTuningCheckpoints id Nothing (Just 10) - - _ <- cancelFineTuning id - - _ <- listFineTuningEvents id Nothing (Just 20) - - _ <- deleteFile trainingId - _ <- deleteFile validationId - - return () - - let batchesTest = do - HUnit.testCase "Batch operations" do - FileObject{ id = requestsId } <- uploadFile UploadFile - { file = "tasty/data/v1/batches/requests.jsonl" - , purpose = Files.Batch - } - - BatchObject{ id } <- createBatch CreateBatch - { input_file_id = requestsId - , endpoint = "/v1/chat/completions" - , completion_window = "24h" - , metadata = Nothing - } - - _ <- retrieveBatch id - - _ <- listBatch Nothing (Just 20) - - _ <- cancelBatch id - - return () - - let uploadsTest = do - HUnit.testCase "Upload operations" do - UploadObject{ id = cancelledId } <- createUpload CreateUpload - { filename = "training_data.jsonl" - , purpose = Files.Fine_Tune - , bytes = 4077 - , mime_type = "text/jsonl" - } - - _ <- cancelUpload cancelledId - - UploadObject{ id } <- createUpload CreateUpload - { filename = "training_data.jsonl" - , purpose = Files.Fine_Tune - , bytes = 4077 - , mime_type = "text/jsonl" - } - - PartObject{ id = partId0 } <- addUploadPart id AddUploadPart - { data_ = "tasty/data/v1/uploads/training_data0.jsonl" } - - PartObject{ id = partId1 } <- addUploadPart id AddUploadPart - { data_ = "tasty/data/v1/uploads/training_data1.jsonl" } - - _ <- completeUpload id CompleteUpload - { part_ids = [ partId0, partId1 ] - , md5 = Nothing - } - - return () - - let createImageMinimalTest = do - HUnit.testCase "Create image - minimal" do - _ <- createImage CreateImage - { prompt = "A baby panda" - , model = Nothing - , n = Nothing - , quality = Nothing - , response_format = Nothing - , size = Nothing - , style = Nothing - , user = Nothing - } - - return () - - let createImageMaximalTest = do - HUnit.testCase "Create image - maximal" do - _ <- createImage CreateImage - { prompt = "A baby panda" - , model = Just "dall-e-2" - , n = Just 1 - , quality = Just Standard - , response_format = Just ResponseFormat.URL - , size = Just "1024x1024" - , style = Just Vivid - , user = Just user - } - - return () - - let createImageEditMinimalTest = do - HUnit.testCase "Create image edit - minimal" do - _ <- createImageEdit CreateImageEdit - { image = "tasty/data/v1/images/image.png" - , prompt = "The panda should be greener" - , mask = Nothing - , model = Nothing - , n = Nothing - , size = Nothing - , response_format = Nothing - , user = Nothing - } - - return () - - let createImageEditMaximalTest = do - HUnit.testCase "Create image edit - maximal" do - _ <- createImageEdit CreateImageEdit - { image = "tasty/data/v1/images/image.png" - , prompt = "The panda should be greener" - , mask = Nothing - , model = Just "dall-e-2" - , n = Just 1 - , size = Just "1024x1024" - , response_format = Just ResponseFormat.URL - , user = Just user - } - - return () - - let createImageVariationMinimalTest = do - HUnit.testCase "Create image variation - minimal" do - _ <- createImageVariation CreateImageVariation - { image = "tasty/data/v1/images/image.png" - , model = Nothing - , n = Nothing - , response_format = Nothing - , size = Nothing - , user = Nothing - } - - return () - - let createImageVariationMaximalTest = do - HUnit.testCase "Create image variation - maximal" do - _ <- createImageVariation CreateImageVariation - { image = "tasty/data/v1/images/image.png" - , model = Just "dall-e-2" - , n = Just 1 - , response_format = Just ResponseFormat.URL - , size = Just "1024x1024" - , user = Just user - } - - return () - - let createModerationTest = do - HUnit.testCase "Create moderation" do - _ <- createModeration CreateModeration - { input = "I am going to kill you" - , model = Nothing - } - - return () - - let assistantsTest = do - HUnit.testCase "Assistant operations" do - AssistantObject{ id } <- createAssistant CreateAssistant - { model = chatModel - , name = Nothing - , description = Nothing - , instructions = Nothing - , tools = Nothing - , tool_resources = Nothing - , metadata = Nothing - , temperature = Nothing - , top_p = Nothing - , response_format = Nothing - } - - _ <- listAssistants Nothing Nothing Nothing Nothing - - _ <- retrieveAssistant id - - _ <- modifyAssistant id ModifyAssistant - { model = chatModel - , name = Nothing - , description = Nothing - , instructions = Nothing - , tools = Nothing - , tool_resources = Nothing - , metadata = Nothing - , temperature = Nothing - , top_p = Nothing - , response_format = Nothing - } - - _ <- deleteAssistant id - - return () - - let messagesTest = do - HUnit.testCase "Message operations" do - ThreadObject{ id = threadId } <- createThread Thread - { messages = Just - [ User - { content = [ "Hi, how can I help you!" ] - , attachments = Nothing - , metadata = Nothing - } - ] - , tool_resources = Nothing - , metadata = Nothing - } - - MessageObject{ id = messageId } <- createMessage threadId User - { content = [ "What is the capital of France?" ] - , attachments = Nothing - , metadata = Nothing - } - - _ <- retrieveMessage threadId messageId - - _ <- modifyMessage threadId messageId ModifyMessage - { metadata = Nothing - } - - _ <- deleteMessage threadId messageId - - _ <- deleteThread threadId - - return () - - let threadsRunsStepsTest = do - HUnit.testCase "Thread/Run/Step operations" do - ThreadObject{ id = threadId } <- createThread Thread - { messages = Just - [ User - { content = [ "Hello, world!" ] - , attachments = Nothing - , metadata = Nothing - } - ] - , tool_resources = Nothing - , metadata = Nothing - } - - _ <- retrieveThread threadId - - _ <- modifyThread threadId ModifyThread - { tool_resources = Nothing - , metadata = Nothing - } - - AssistantObject{ id = assistantId } <- createAssistant CreateAssistant - { model = chatModel - , name = Nothing - , description = Nothing - , instructions = Nothing - , tools = Nothing - , tool_resources = Nothing - , metadata = Nothing - , temperature = Nothing - , top_p = Nothing - , response_format = Nothing - } - - RunObject{ id = runId } <- createRun threadId Nothing CreateRun - { assistant_id = assistantId - , model = Nothing - , instructions = Nothing - , additional_instructions = Nothing - , additional_messages = Nothing - , tools = Nothing - , metadata = Nothing - , temperature = Nothing - , top_p = Nothing - , max_prompt_tokens = Nothing - , max_completion_tokens = Nothing - , truncation_strategy = Nothing - , tool_choice = Nothing - , parallel_tool_calls = Nothing - , response_format = Nothing - } - - _ <- listRuns threadId Nothing Nothing Nothing Nothing - - _ <- retrieveRun threadId runId - - _ <- modifyRun threadId runId ModifyRun - { metadata = Nothing - } - - _ <- deleteThread threadId - - return () - - let vectorStoreFilesTest = do - HUnit.testCase "Vector store file and batch operations" do - FileObject{ id = fileId } <- uploadFile UploadFile - { file = "tasty/data/v1/vector_stores/index.html" - , purpose = Files.Assistants - } - - VectorStoreObject{ id = vectorStoreId } <- createVectorStore CreateVectorStore - { file_ids = [] - , name = Nothing - , expires_after = Nothing - , chunking_strategy = Nothing - , metadata = Nothing - } - - VectorStoreFileObject{ id = vectorStoreFileId } <- createVectorStoreFile vectorStoreId CreateVectorStoreFile - { file_id = fileId - , chunking_strategy = Nothing - } - - VectorStoreFilesBatchObject{ id = batchId } <- createVectorStoreFileBatch vectorStoreId CreateVectorStoreFileBatch - { file_ids = [ fileId ] - , chunking_strategy = Nothing - } - - _ <- listVectorStores Nothing Nothing Nothing Nothing - - _ <- listVectorStoreFiles vectorStoreId Nothing Nothing Nothing Nothing Nothing - - _ <- listVectorStoreFilesInABatch vectorStoreId batchId Nothing Nothing Nothing Nothing Nothing - - _ <- retrieveVectorStore vectorStoreId - - _ <- retrieveVectorStoreFile vectorStoreId vectorStoreFileId - - _ <- retrieveVectorStoreFileBatch vectorStoreId batchId - - _ <- modifyVectorStore vectorStoreId ModifyVectorStore - { name = Nothing - , expires_after = Nothing - , metadata = Nothing - } - - _ <- cancelVectorStoreFileBatch vectorStoreId batchId - - _ <- deleteVectorStoreFile vectorStoreId vectorStoreFileId - - _ <- deleteVectorStore vectorStoreId - - _ <- deleteFile fileId - - return () - - let tests = - speechTests - <> [ transcriptionTest - , translationTest - , completionsMinimalTest - , completionsMinimalReasoningTest - , completionsMaximalTest - , embeddingsTest - , fineTuningTest - , batchesTest - , uploadsTest - , createImageMinimalTest - , createImageMaximalTest - , createImageEditMinimalTest - , createImageEditMaximalTest - , createImageVariationMinimalTest - , createImageVariationMaximalTest - , createModerationTest - , assistantsTest - , messagesTest - , threadsRunsStepsTest - , vectorStoreFilesTest - ] - - Tasty.defaultMain (Tasty.testGroup "Tests" tests) +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +module Main where + +import qualified Control.Concurrent as Concurrent +import Control.Exception (SomeException, catch) +import qualified Data.Text as Text +import qualified Network.HTTP.Client as HTTP.Client +import qualified Network.HTTP.Client.TLS as TLS +import OpenAI.V1 (Methods (..)) +import qualified OpenAI.V1 as V1 +import OpenAI.V1.Assistants + ( AssistantObject (..), + CreateAssistant (..), + ModifyAssistant (..), + ) +import OpenAI.V1.Audio.Speech + ( CreateSpeech (..), + Voice (..), + _CreateSpeech, + ) +import OpenAI.V1.Audio.Transcriptions (CreateTranscription (..)) +import OpenAI.V1.Audio.Translations (CreateTranslation (..)) +import OpenAI.V1.AutoOr (AutoOr (..)) +import OpenAI.V1.Batches (BatchObject (..), CreateBatch (..)) +import OpenAI.V1.Chat.Completions + ( CreateChatCompletion (..), + Modality (..), + ) +import qualified OpenAI.V1.Chat.Completions as Completions +import OpenAI.V1.Embeddings (CreateEmbeddings (..), EncodingFormat (..)) +import OpenAI.V1.Files (FileObject (..), Order (..), UploadFile (..)) +import qualified OpenAI.V1.Files as Files +import OpenAI.V1.FineTuning.Jobs + ( CreateFineTuningJob (..), + Hyperparameters (..), + JobObject (..), + ) +import qualified OpenAI.V1.FineTuning.Jobs as Jobs +import OpenAI.V1.Images.Edits (CreateImageEdit (..)) +import OpenAI.V1.Images.Generations + ( CreateImage (..), + Quality (..), + Style (..), + ) +import qualified OpenAI.V1.Images.ResponseFormat as ResponseFormat +import OpenAI.V1.Images.Variations (CreateImageVariation (..)) +import OpenAI.V1.Message (Message (..)) +import OpenAI.V1.Moderations (CreateModeration (..)) +import OpenAI.V1.Threads + ( ModifyThread (..), + Thread (..), + ThreadID (..), + ThreadObject (..), + ) +import OpenAI.V1.Threads.Messages (MessageObject (..), ModifyMessage (..)) +import OpenAI.V1.Threads.Runs + ( CreateRun (..), + ModifyRun (..), + RunID (..), + RunObject (..), + Status (..), + ) +import OpenAI.V1.Tool (Tool (..), ToolChoice (..)) +import qualified OpenAI.V1.Tool as Tool +import OpenAI.V1.ToolCall (ToolCall (..)) +import qualified OpenAI.V1.ToolCall as ToolCall +import OpenAI.V1.Uploads + ( AddUploadPart (..), + CompleteUpload (..), + CreateUpload (..), + PartObject (..), + UploadObject (..), + ) +import OpenAI.V1.VectorStores + ( CreateVectorStore (..), + ModifyVectorStore (..), + VectorStoreObject (..), + ) +import OpenAI.V1.VectorStores.FileBatches + ( CreateVectorStoreFileBatch (..), + VectorStoreFilesBatchObject (..), + ) +import OpenAI.V1.VectorStores.Files + ( CreateVectorStoreFile (..), + VectorStoreFileObject (..), + ) +import qualified Servant.Client as Client +import qualified System.Environment as Environment +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as HUnit +import Prelude hiding (id) + +main :: IO () +main = do + let managerSettings = + TLS.tlsManagerSettings + { HTTP.Client.managerResponseTimeout = + HTTP.Client.responseTimeoutNone + } + + manager <- TLS.newTlsManagerWith managerSettings + + baseUrl <- Client.parseBaseUrl "https://api.openai.com" + + let clientEnv = Client.mkClientEnv manager baseUrl + + key <- Environment.getEnv "OPENAI_KEY" + + let user = "openai Haskell package" + let chatModel = "gpt-4o-mini" + let reasoningModel = "o3-mini" + let ttsModel = "tts-1" + let Methods {..} = V1.makeMethods clientEnv (Text.pack key) + + -- Test each format to make sure we're handling each possible content type + -- correctly + let speechTest format = + HUnit.testCase ("Create speech - " <> show format) do + _ <- + createSpeech + _CreateSpeech + { model = ttsModel, + input = "Hello, world!", + voice = Nova, + response_format = Just format, + speed = Just 1.0 + } + + return () + + let speechTestDefaults = + HUnit.testCase "Create speech - defaults" do + _ <- + createSpeech + _CreateSpeech + { model = ttsModel, + input = "Hello, world!", + voice = Alloy + } + + return () + + let speechTests = + speechTestDefaults : do + format <- [minBound .. maxBound] + return (speechTest format) + + let transcriptionTest = + HUnit.testCase "Create transcription" do + _ <- + createTranscription + CreateTranscription + { file = "tasty/data/v1/audio/preamble.wav", + model = "whisper-1", + language = Just "en", + prompt = Nothing, + temperature = Just 0 + } + + return () + + let translationTest = + HUnit.testCase "Create translation" do + _ <- + createTranslation + CreateTranslation + { file = "tasty/data/v1/audio/preamble.wav", + model = "whisper-1", + prompt = Nothing, + temperature = Just 0 + } + + return () + + let completionsMinimalTest = + HUnit.testCase "Create chat completion - minimal" do + _ <- + createChatCompletion + CreateChatCompletion + { messages = + [ Completions.User + { content = ["Hello, world!"], + name = Nothing + } + ], + model = chatModel, + store = Nothing, + metadata = Nothing, + frequency_penalty = Nothing, + logit_bias = Nothing, + logprobs = Nothing, + top_logprobs = Nothing, + max_completion_tokens = Nothing, + n = Nothing, + modalities = Nothing, + prediction = Nothing, + audio = Nothing, + presence_penalty = Nothing, + reasoning_effort = Nothing, + response_format = Nothing, + seed = Nothing, + service_tier = Nothing, + stop = Nothing, + temperature = Nothing, + top_p = Nothing, + tools = Nothing, + tool_choice = Nothing, + parallel_tool_calls = Nothing, + user = Nothing, + web_search_options = Nothing + } + + return () + + let completionsMinimalReasoningTest = + HUnit.testCase "Create chat completion reasoning model - minimal" do + _ <- + createChatCompletion + CreateChatCompletion + { messages = + [ Completions.User + { content = ["Hello, world!"], + name = Nothing + } + ], + model = reasoningModel, + store = Nothing, + metadata = Nothing, + frequency_penalty = Nothing, + logit_bias = Nothing, + logprobs = Nothing, + top_logprobs = Nothing, + max_completion_tokens = Nothing, + n = Nothing, + modalities = Nothing, + prediction = Nothing, + audio = Nothing, + presence_penalty = Nothing, + reasoning_effort = Just Completions.ReasoningEffort_Low, + response_format = Nothing, + seed = Nothing, + service_tier = Nothing, + stop = Nothing, + temperature = Nothing, + top_p = Nothing, + tools = Nothing, + tool_choice = Nothing, + parallel_tool_calls = Nothing, + user = Nothing, + web_search_options = Nothing + } + + return () + + let completionsMaximalTest = + HUnit.testCase "Create chat completion - maximal" do + _ <- + createChatCompletion + CreateChatCompletion + { messages = + [ Completions.User + { content = ["Hello, world!"], + name = Just "gabby" + }, + Completions.Assistant + { assistant_content = Nothing, + refusal = Nothing, + name = Just "Ada", + assistant_audio = Nothing, + tool_calls = + Just + [ ToolCall_Function + { id = "call_bzE95mjMMFqeanfY2sL6Sdir", + function = + ToolCall.Function + { name = "hello", + arguments = "{}" + } + } + ] + }, + Completions.Tool + { content = ["Hello, world!"], + tool_call_id = "call_bzE95mjMMFqeanfY2sL6Sdir" + } + ], + model = chatModel, + store = Just False, + metadata = Nothing, + frequency_penalty = Just 0, + logit_bias = Just mempty, + logprobs = Just True, + top_logprobs = Just 1, + max_completion_tokens = Just 1024, + n = Just 1, + modalities = Just [Modality_Text], + prediction = Nothing, + audio = Nothing, + presence_penalty = Just 0, + reasoning_effort = Nothing, + response_format = Just Completions.ResponseFormat_Text, + seed = Just 0, + service_tier = Just Auto, + stop = Just [">>>"], + temperature = Just 1, + top_p = Just 1, + tools = + Just + [ Tool_Function + { function = + Tool.Function + { description = + Just "Use the hello command line tool", + name = "hello", + parameters = Nothing, + strict = Just False + } + } + ], + tool_choice = Just ToolChoiceAuto, + parallel_tool_calls = Just True, + user = Just user, + web_search_options = Nothing + } + + return () + + let embeddingsTest = do + HUnit.testCase "Create embedding" do + _ <- + createEmbeddings + CreateEmbeddings + { input = "Hello, world!", + model = "text-embedding-3-small", + encoding_format = Just Float, + dimensions = Just 1024, + user = Just user + } + + return () + + let fineTuningTest = do + HUnit.testCase "Fine-tuning and File operations - maximal" do + FileObject {id = trainingId} <- + uploadFile + UploadFile + { file = + "tasty/data/v1/fine_tuning/jobs/training_data.jsonl", + purpose = Files.Fine_Tune + } + + FileObject {id = validationId} <- + uploadFile + UploadFile + { file = + "tasty/data/v1/fine_tuning/jobs/validation_data.jsonl", + purpose = Files.Fine_Tune + } + + _ <- retrieveFile trainingId + + _ <- retrieveFileContent trainingId + + _ <- listFiles (Just Files.Fine_Tune) (Just 10000) (Just Asc) Nothing + + JobObject {id} <- + createFineTuningJob + CreateFineTuningJob + { model = "gpt-4o-mini-2024-07-18", + training_file = trainingId, + hyperparameters = + Just + Hyperparameters + { batch_size = Just Jobs.Auto, + learning_rate_multiplier = Just Jobs.Auto, + n_epochs = Just Jobs.Auto + }, + suffix = Just "haskell-openai", + validation_file = Just validationId, + integrations = Just [], + seed = Just 0 + } + + _ <- retrieveFineTuningJob id + + _ <- listFineTuningJobs Nothing (Just 20) + + _ <- listFineTuningCheckpoints id Nothing (Just 10) + + _ <- cancelFineTuning id + + _ <- listFineTuningEvents id Nothing (Just 20) + + _ <- deleteFile trainingId + _ <- deleteFile validationId + + return () + + let batchesTest = do + HUnit.testCase "Batch operations" do + FileObject {id = requestsId} <- + uploadFile + UploadFile + { file = "tasty/data/v1/batches/requests.jsonl", + purpose = Files.Batch + } + + BatchObject {id} <- + createBatch + CreateBatch + { input_file_id = requestsId, + endpoint = "/v1/chat/completions", + completion_window = "24h", + metadata = Nothing + } + + _ <- retrieveBatch id + + _ <- listBatch Nothing (Just 20) + + _ <- cancelBatch id + + return () + + let uploadsTest = do + HUnit.testCase "Upload operations" do + UploadObject {id = cancelledId} <- + createUpload + CreateUpload + { filename = "training_data.jsonl", + purpose = Files.Fine_Tune, + bytes = 4077, + mime_type = "text/jsonl" + } + + _ <- cancelUpload cancelledId + + UploadObject {id} <- + createUpload + CreateUpload + { filename = "training_data.jsonl", + purpose = Files.Fine_Tune, + bytes = 4077, + mime_type = "text/jsonl" + } + + PartObject {id = partId0} <- + addUploadPart + id + AddUploadPart + { data_ = "tasty/data/v1/uploads/training_data0.jsonl" + } + + PartObject {id = partId1} <- + addUploadPart + id + AddUploadPart + { data_ = "tasty/data/v1/uploads/training_data1.jsonl" + } + + _ <- + completeUpload + id + CompleteUpload + { part_ids = [partId0, partId1], + md5 = Nothing + } + + return () + + let createImageMinimalTest = do + HUnit.testCase "Create image - minimal" do + _ <- + createImage + CreateImage + { prompt = "A baby panda", + model = Nothing, + n = Nothing, + quality = Nothing, + response_format = Nothing, + size = Nothing, + style = Nothing, + user = Nothing + } + + return () + + let createImageMaximalTest = do + HUnit.testCase "Create image - maximal" do + _ <- + createImage + CreateImage + { prompt = "A baby panda", + model = Just "dall-e-3", + n = Just 1, + quality = Just Standard, + response_format = Just ResponseFormat.URL, + size = Just "1024x1024", + style = Just Vivid, + user = Just user + } + + return () + + let createImageEditMinimalTest = do + HUnit.testCase "Create image edit - minimal" do + _ <- + createImageEdit + CreateImageEdit + { image = "tasty/data/v1/images/image.png", + prompt = "The panda should be greener", + mask = Nothing, + model = Nothing, + n = Nothing, + size = Nothing, + response_format = Nothing, + user = Nothing + } + + return () + + let createImageEditMaximalTest = do + HUnit.testCase "Create image edit - maximal" do + _ <- + createImageEdit + CreateImageEdit + { image = "tasty/data/v1/images/image.png", + prompt = "The panda should be greener", + mask = Nothing, + model = Just "dall-e-2", + n = Just 1, + size = Just "1024x1024", + response_format = Just ResponseFormat.URL, + user = Just user + } + + return () + + let createImageVariationMinimalTest = do + HUnit.testCase "Create image variation - minimal" do + _ <- + createImageVariation + CreateImageVariation + { image = "tasty/data/v1/images/image.png", + model = Nothing, + n = Nothing, + response_format = Nothing, + size = Nothing, + user = Nothing + } + + return () + + let createImageVariationMaximalTest = do + HUnit.testCase "Create image variation - maximal" do + _ <- + createImageVariation + CreateImageVariation + { image = "tasty/data/v1/images/image.png", + model = Just "dall-e-2", + n = Just 1, + response_format = Just ResponseFormat.URL, + size = Just "1024x1024", + user = Just user + } + + return () + + let createModerationTest = do + HUnit.testCase "Create moderation" do + _ <- + createModeration + CreateModeration + { input = "I am going to kill you", + model = Nothing + } + + return () + + let assistantsTest = do + HUnit.testCase "Assistant operations" do + AssistantObject {id} <- + createAssistant + CreateAssistant + { model = chatModel, + name = Nothing, + description = Nothing, + instructions = Nothing, + tools = Nothing, + tool_resources = Nothing, + metadata = Nothing, + temperature = Nothing, + top_p = Nothing, + response_format = Nothing + } + + _ <- listAssistants Nothing Nothing Nothing Nothing + + _ <- retrieveAssistant id + + _ <- + modifyAssistant + id + ModifyAssistant + { model = chatModel, + name = Nothing, + description = Nothing, + instructions = Nothing, + tools = Nothing, + tool_resources = Nothing, + metadata = Nothing, + temperature = Nothing, + top_p = Nothing, + response_format = Nothing + } + + _ <- deleteAssistant id + + return () + + let messagesTest = do + HUnit.testCase "Message operations" do + ThreadObject {id = threadId} <- + createThread + Thread + { messages = + Just + [ User + { content = ["Hi, how can I help you!"], + attachments = Nothing, + metadata = Nothing + } + ], + tool_resources = Nothing, + metadata = Nothing + } + + MessageObject {id = messageId} <- + createMessage + threadId + User + { content = ["What is the capital of France?"], + attachments = Nothing, + metadata = Nothing + } + + _ <- retrieveMessage threadId messageId + + _ <- + modifyMessage + threadId + messageId + ModifyMessage + { metadata = Nothing + } + + _ <- deleteMessage threadId messageId + + _ <- deleteThread threadId + + return () + + let waitForRunCompletion :: ThreadID -> RunID -> IO () + waitForRunCompletion threadId runId = do + RunObject {status} <- retrieveRun threadId runId + case status of + In_Progress -> do + Concurrent.threadDelay 1000000 -- Wait 1 second + waitForRunCompletion threadId runId + Queued -> do + Concurrent.threadDelay 1000000 -- Wait 1 second + waitForRunCompletion threadId runId + _ -> return () -- Run is completed, failed, cancelled, etc. + let threadsRunsStepsTest = do + HUnit.testCase "Thread/Run/Step operations" do + ThreadObject {id = threadId} <- + createThread + Thread + { messages = + Just + [ User + { content = ["Hello, world!"], + attachments = Nothing, + metadata = Nothing + } + ], + tool_resources = Nothing, + metadata = Nothing + } + + _ <- retrieveThread threadId + + _ <- + modifyThread + threadId + ModifyThread + { tool_resources = Nothing, + metadata = Nothing + } + + AssistantObject {id = assistantId} <- + createAssistant + CreateAssistant + { model = chatModel, + name = Nothing, + description = Nothing, + instructions = Nothing, + tools = Nothing, + tool_resources = Nothing, + metadata = Nothing, + temperature = Nothing, + top_p = Nothing, + response_format = Nothing + } + + RunObject {id = runId} <- + createRun + threadId + Nothing + CreateRun + { assistant_id = assistantId, + model = Nothing, + instructions = Nothing, + additional_instructions = Nothing, + additional_messages = Nothing, + tools = Nothing, + metadata = Nothing, + temperature = Nothing, + top_p = Nothing, + max_prompt_tokens = Nothing, + max_completion_tokens = Nothing, + truncation_strategy = Nothing, + tool_choice = Nothing, + parallel_tool_calls = Nothing, + response_format = Nothing + } + + _ <- listRuns threadId Nothing Nothing Nothing Nothing + + _ <- retrieveRun threadId runId + + -- Wait for the run to complete before trying to modify it + waitForRunCompletion threadId runId + + _ <- + modifyRun + threadId + runId + ModifyRun + { metadata = Nothing + } + + _ <- deleteThread threadId + + return () + + let vectorStoreFilesTest = do + HUnit.testCase "Vector store file and batch operations" do + FileObject {id = fileId} <- + uploadFile + UploadFile + { file = "tasty/data/v1/vector_stores/index.html", + purpose = Files.Assistants + } + + VectorStoreObject {id = vectorStoreId} <- + createVectorStore + CreateVectorStore + { file_ids = [], + name = Nothing, + expires_after = Nothing, + chunking_strategy = Nothing, + metadata = Nothing + } + + VectorStoreFileObject {id = vectorStoreFileId} <- + createVectorStoreFile + vectorStoreId + CreateVectorStoreFile + { file_id = fileId, + chunking_strategy = Nothing + } + + -- Try to create vector store file batch, but handle size limit error gracefully + batchResult <- + ( Right + <$> createVectorStoreFileBatch + vectorStoreId + CreateVectorStoreFileBatch + { file_ids = [fileId], + chunking_strategy = Nothing + } + ) + `catch` \(e :: SomeException) -> return (Left e) + + case batchResult of + Right (VectorStoreFilesBatchObject {id = batchId}) -> do + _ <- listVectorStores Nothing Nothing Nothing Nothing + + _ <- listVectorStoreFiles vectorStoreId Nothing Nothing Nothing Nothing Nothing + + _ <- listVectorStoreFilesInABatch vectorStoreId batchId Nothing Nothing Nothing Nothing Nothing + + _ <- retrieveVectorStore vectorStoreId + + _ <- retrieveVectorStoreFile vectorStoreId vectorStoreFileId + + _ <- retrieveVectorStoreFileBatch vectorStoreId batchId + + _ <- + modifyVectorStore + vectorStoreId + ModifyVectorStore + { name = Nothing, + expires_after = Nothing, + metadata = Nothing + } + + _ <- cancelVectorStoreFileBatch vectorStoreId batchId + + _ <- deleteVectorStoreFile vectorStoreId vectorStoreFileId + + _ <- deleteVectorStore vectorStoreId + + _ <- deleteFile fileId + + return () + Left _ -> do + -- If batch creation fails (likely due to size limit), still test other operations + _ <- listVectorStores Nothing Nothing Nothing Nothing + + _ <- listVectorStoreFiles vectorStoreId Nothing Nothing Nothing Nothing Nothing + + _ <- retrieveVectorStore vectorStoreId + + _ <- retrieveVectorStoreFile vectorStoreId vectorStoreFileId + + _ <- + modifyVectorStore + vectorStoreId + ModifyVectorStore + { name = Nothing, + expires_after = Nothing, + metadata = Nothing + } + + _ <- deleteVectorStoreFile vectorStoreId vectorStoreFileId + + _ <- deleteVectorStore vectorStoreId + + _ <- deleteFile fileId + + return () + + let tests = + speechTests + <> [ transcriptionTest, + translationTest, + completionsMinimalTest, + completionsMinimalReasoningTest, + completionsMaximalTest, + embeddingsTest, + fineTuningTest, + batchesTest, + uploadsTest, + createImageMinimalTest, + createImageMaximalTest, + createImageEditMinimalTest, + createImageEditMaximalTest, + createImageVariationMinimalTest, + createImageVariationMaximalTest, + createModerationTest, + assistantsTest, + messagesTest, + threadsRunsStepsTest, + vectorStoreFilesTest + ] + + Tasty.defaultMain (Tasty.testGroup "Tests" tests)