diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +2.2.1: + +- [Add Chat Completion Streaming Support](https://github.com/MercuryTechnologies/openai/pull/78) + 2.2.0: - Add structured reasoning support to `OpenAI.V1.Responses`, including the `Reasoning`, `ReasoningEffort`, and `ReasoningSummary` types, plus the `ServiceTier` alias. diff --git a/examples/chat-completions-stream-example/Main.hs b/examples/chat-completions-stream-example/Main.hs new file mode 100644 --- /dev/null +++ b/examples/chat-completions-stream-example/Main.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import System.Environment (getEnv) +import System.IO (hFlush, hPutStrLn, stderr, stdout) + +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import qualified OpenAI.V1 as V1 +import qualified OpenAI.V1.Chat.Completions as Chat + +main :: IO () +main = do + key <- T.pack <$> getEnv "OPENAI_KEY" + env <- V1.getClientEnv "https://api.openai.com" + + let V1.Methods{ createChatCompletionStreamTyped } = V1.makeMethods env key Nothing Nothing + + let onEvent (Left err) = hPutStrLn stderr ("stream error: " <> T.unpack err) + onEvent (Right chunk) = case chunk of + -- Print content deltas as they arrive + Chat.ChatCompletionChunk{ Chat.choices = cs } -> + mapM_ printChoice cs + where + printChoice Chat.ChunkChoice{ Chat.delta = d } = case Chat.delta_content d of + Just content -> TIO.putStr content >> hFlush stdout + Nothing -> pure () + + -- 1) Simple haiku example + putStrLn "Example 1: Simple haiku" + putStrLn "========================" + let reqHaiku = Chat._CreateChatCompletion + { Chat.messages = + [ Chat.User + { Chat.content = [ Chat.Text{ Chat.text = "Write a short haiku about the sea." } ] + , Chat.name = Nothing + } + ] + , Chat.model = "gpt-5-mini" + } + + createChatCompletionStreamTyped reqHaiku onEvent + putStrLn "\n" + + putStrLn "--------------------------------" + + -- 2) Conversation example + putStrLn "Example 2: Multi-turn conversation" + putStrLn "====================================" + let reqConversation = Chat._CreateChatCompletion + { Chat.messages = + [ Chat.System + { Chat.content = [ Chat.Text{ Chat.text = "You are a helpful assistant that explains concepts simply." } ] + , Chat.name = Nothing + } + , Chat.User + { Chat.content = [ Chat.Text{ Chat.text = "What is quantum computing in simple terms?" } ] + , Chat.name = Nothing + } + ] + , Chat.model = "gpt-5-mini" + , Chat.temperature = Just 0.7 + } + + createChatCompletionStreamTyped reqConversation onEvent + putStrLn "\n" + + putStrLn "--------------------------------" + + -- 3) Code generation example + putStrLn "Example 3: Code generation" + putStrLn "==========================" + let reqCode = Chat._CreateChatCompletion + { Chat.messages = + [ Chat.User + { Chat.content = [ Chat.Text{ Chat.text = "Write a Python function that calculates fibonacci numbers recursively." } ] + , Chat.name = Nothing + } + ] + , Chat.model = "gpt-5-mini" + , Chat.temperature = Just 0.3 + } + + createChatCompletionStreamTyped reqCode onEvent + putStrLn "\n" + 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: 2.2.0 +version: 2.2.1 synopsis: Servant bindings to OpenAI description: This package provides comprehensive and type-safe bindings to OpenAI, providing both a Servant interface and @@ -125,6 +125,16 @@ hs-source-dirs: examples/openai-example main-is: Main.hs build-depends: base + , openai + , text + ghc-options: -Wall + +executable chat-completions-stream-example + default-language: Haskell2010 + hs-source-dirs: examples/chat-completions-stream-example + main-is: Main.hs + build-depends: base + , aeson , openai , text 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 @@ -338,6 +338,22 @@ Aeson.Error msg -> onEvent (Left (Text.pack msg)) Aeson.Success e -> onEvent (Right e) + -- Streaming implementation for chat completions + createChatCompletionStream req onEvent = do + let req' = req{ Chat.Completions.stream = Just True } + ssePostJSON "/v1/chat/completions" req' onEvent + + createChatCompletionStreamTyped + :: CreateChatCompletion + -> (Either Text Chat.Completions.ChatCompletionStreamEvent -> IO ()) + -> IO () + createChatCompletionStreamTyped req onEvent = + createChatCompletionStream 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 @@ -465,6 +481,14 @@ , createTranscription :: CreateTranscription -> IO TranscriptionObject , createTranslation :: CreateTranslation -> IO TranslationObject , createChatCompletion :: CreateChatCompletion -> IO ChatCompletionObject + , createChatCompletionStream + :: CreateChatCompletion + -> (Either Text Aeson.Value -> IO ()) + -> IO () + , createChatCompletionStreamTyped + :: CreateChatCompletion + -> (Either Text Chat.Completions.ChatCompletionStreamEvent -> IO ()) + -> IO () , createResponse :: CreateResponse -> IO ResponseObject , createResponseStream :: CreateResponse 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 @@ -1,6 +1,6 @@ -- | @\/v1\/chat\/completions@ -- --- Streaming results are not yet supported +-- Streaming is not implemented here; module OpenAI.V1.Chat.Completions ( -- * Main types CreateChatCompletion(..) @@ -10,6 +10,11 @@ , Message(..) , messageToContent , Content(..) + -- * Streaming types + , ChatCompletionChunk(..) + , ChunkChoice(..) + , Delta(..) + , ChatCompletionStreamEvent -- * Other types , InputAudio(..) , ImageURL(..) @@ -298,6 +303,7 @@ , seed :: Maybe Integer , service_tier :: Maybe (AutoOr ServiceTier) , stop :: Maybe (Vector Text) + , stream :: Maybe Bool , temperature :: Maybe Double , top_p :: Maybe Double , tools :: Maybe (Vector Tool) @@ -333,6 +339,7 @@ , seed = Nothing , service_tier = Nothing , stop = Nothing + , stream = Nothing , temperature = Nothing , top_p = Nothing , tools = Nothing @@ -394,6 +401,50 @@ , usage :: Usage CompletionTokensDetails PromptTokensDetails } deriving stock (Generic, Show) deriving anyclass (FromJSON, ToJSON) + +-- | Delta message content for streaming +data Delta = Delta + { delta_content :: Maybe Text + , delta_refusal :: Maybe Text + , delta_role :: Maybe Text + , delta_tool_calls :: Maybe (Vector ToolCall) + } deriving stock (Generic, Show) + +deltaOptions :: Options +deltaOptions = aesonOptions + { fieldLabelModifier = stripPrefix "delta_" + } + +instance FromJSON Delta where + parseJSON = genericParseJSON deltaOptions + +instance ToJSON Delta where + toJSON = genericToJSON deltaOptions + +-- | A streaming choice chunk +data ChunkChoice = ChunkChoice + { delta :: Delta + , finish_reason :: Maybe Text + , index :: Natural + , logprobs :: Maybe LogProbs + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Chat completion chunk (streaming response) +data ChatCompletionChunk = ChatCompletionChunk + { id :: Text + , choices :: Vector ChunkChoice + , created :: POSIXTime + , model :: Model + , service_tier :: Maybe ServiceTier + , system_fingerprint :: Maybe Text + , object :: Text + , usage :: Maybe (Usage CompletionTokensDetails PromptTokensDetails) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Type alias for streaming events (currently just chunks) +type ChatCompletionStreamEvent = ChatCompletionChunk -- | Servant API type API = diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -14,7 +14,7 @@ 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 OpenAI.V1.Chat.Completions (CreateChatCompletion(..), Modality(..), ChatCompletionChunk(..), ChunkChoice(..), delta_content) import OpenAI.V1.Embeddings (CreateEmbeddings(..), EncodingFormat(..)) import OpenAI.V1.Files (FileObject(..), Order(..), UploadFile(..)) import OpenAI.V1.Images.Edits (CreateImageEdit(..)) @@ -178,6 +178,7 @@ seed = Nothing, service_tier = Nothing, stop = Nothing, + stream = Nothing, temperature = Nothing, top_p = Nothing, tools = Nothing, @@ -218,6 +219,7 @@ seed = Nothing, service_tier = Nothing, stop = Nothing, + stream = Nothing, temperature = Nothing, top_p = Nothing, tools = Nothing, @@ -279,6 +281,7 @@ seed = Just 0, service_tier = Just Auto, stop = Just [">>>"], + stream = Nothing, temperature = Just 1, top_p = Just 1, tools = @@ -302,6 +305,65 @@ return () + let chatCompletionStreamingHaikuTest = do + HUnit.testCase "Create chat completion - streaming haiku" do + let req = + 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, + stream = Nothing, + temperature = Nothing, + top_p = Nothing, + tools = Nothing, + tool_choice = Nothing, + parallel_tool_calls = Nothing, + user = Nothing, + web_search_options = Nothing + } + + acc <- IORef.newIORef (Text.empty) + done <- Concurrent.newEmptyMVar + + let onEvent (Left _err) = Concurrent.putMVar done () + onEvent (Right ev) = case ev of + ChatCompletionChunk{ choices = cs } -> + mapM_ accChoice cs + where + accChoice ChunkChoice{ delta = d } = case delta_content d of + Just content -> IORef.modifyIORef' acc (<> content) + Nothing -> Concurrent.putMVar done () + + createChatCompletionStreamTyped req onEvent + + _ <- Concurrent.takeMVar done + text <- IORef.readIORef acc + HUnit.assertBool "Expected non-empty streamed text" (not (Text.null text)) + + return () + + let embeddingsTest = do HUnit.testCase "Create embedding" do _ <- @@ -1039,6 +1101,7 @@ completionsMinimalTest, completionsMinimalReasoningTest, completionsMaximalTest, + chatCompletionStreamingHaikuTest, embeddingsTest, fineTuningTest, batchesTest,