diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +2.3.0: + +- Add `ChatCompletionStreamOptions` support for including usage in chat completion streams. +- Simplify Responses tool JSON encoding/decoding. +- Add support for `/v1/chatkit/*`. +- Add missing arguments in `makeMethods` in the create chat example. + 2.2.1: - [Add Chat Completion Streaming Support](https://github.com/MercuryTechnologies/openai/pull/78) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -26,7 +26,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-stream-example/Main.hs b/examples/responses-stream-example/Main.hs --- a/examples/responses-stream-example/Main.hs +++ b/examples/responses-stream-example/Main.hs @@ -5,6 +5,8 @@ module Main where +import OpenAI.V1.Responses (Tool(..)) +import OpenAI.V1.Tool (CodeInterpreterContainer(..)) import System.Environment (getEnv) import System.IO (hFlush, hPutStrLn, stderr, stdout) @@ -12,7 +14,6 @@ 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 main :: IO () main = do @@ -56,7 +57,7 @@ , Responses.status = Nothing } ]) - , Responses.tools = Just [ Tool.Tool_Web_Search ] + , Responses.tools = Just [ Tool_Web_Search ] } createResponseStreamTyped reqSearch onEvent @@ -74,7 +75,13 @@ , Responses.status = Nothing } ]) - , Responses.tools = Just [ Tool.codeInterpreterAuto ] + , Responses.tools = Just + [ Responses.Tool_Code_Interpreter + { container = Just CodeInterpreterContainer_Auto + { file_ids = Nothing + } + } + ] } createResponseStreamTyped reqCode onEvent diff --git a/examples/responses-tool-call-example/Main.hs b/examples/responses-tool-call-example/Main.hs --- a/examples/responses-tool-call-example/Main.hs +++ b/examples/responses-tool-call-example/Main.hs @@ -6,19 +6,20 @@ module Main where import Data.Aeson (FromJSON (..), (.:), (.=), withObject) -import qualified Data.Aeson as Aeson -import qualified Data.ByteString.Lazy as LBS import Data.Foldable (toList) import Data.Text (Text) +import OpenAI.V1 (Methods (..)) +import OpenAI.V1.Responses (Tool(..)) +import System.Environment (getEnv) + +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as Text import qualified Data.Text.Encoding as Text.Encoding import qualified Data.Text.IO as TextIO import qualified Data.Vector as Vector -import OpenAI.V1 (Methods (..)) import qualified OpenAI.V1 as V1 import qualified OpenAI.V1.Responses as Responses -import OpenAI.V1.Tool (Function (..), Tool (..)) -import System.Environment (getEnv) -- | Simple JSON payload for parsing function arguments newtype HoroscopeArgs = HoroscopeArgs { sign :: Text } @@ -34,25 +35,24 @@ horoscopeTool :: Tool horoscopeTool = Tool_Function - Function - { description = Just "Get today's horoscope for an astrological sign." - , name = "get_horoscope" - , parameters = - Just . Aeson.object $ - [ "type" .= ("object" :: Text) - , "properties" - .= Aeson.object - [ "sign" - .= Aeson.object - [ "type" .= ("string" :: Text) - , "description" .= ("An astrological sign like Taurus or Aquarius" :: Text) - ] - ] - , "required" .= (["sign"] :: [Text]) - , "additionalProperties" .= False - ] - , strict = Just True - } + { description = Just "Get today's horoscope for an astrological sign." + , name = "get_horoscope" + , parameters = + Just . Aeson.object $ + [ "type" .= ("object" :: Text) + , "properties" + .= Aeson.object + [ "sign" + .= Aeson.object + [ "type" .= ("string" :: Text) + , "description" .= ("An astrological sign like Taurus or Aquarius" :: Text) + ] + ] + , "required" .= (["sign"] :: [Text]) + , "additionalProperties" .= False + ] + , strict = Just True + } main :: IO () main = do 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.1 +version: 2.3.0 synopsis: Servant bindings to OpenAI description: This package provides comprehensive and type-safe bindings to OpenAI, providing both a Servant interface and @@ -53,6 +53,7 @@ OpenAI.V1.AutoOr OpenAI.V1.Batches OpenAI.V1.Chat.Completions + OpenAI.V1.ChatKit OpenAI.V1.ChunkingStrategy OpenAI.V1.DeletionStatus OpenAI.V1.Embeddings diff --git a/src/OpenAI/Prelude.hs b/src/OpenAI/Prelude.hs --- a/src/OpenAI/Prelude.hs +++ b/src/OpenAI/Prelude.hs @@ -15,6 +15,7 @@ , module Data.Map , module Data.String , module Data.Text + , module Data.Time , module Data.Time.Clock.POSIX , module Data.Vector , module Data.Void @@ -31,6 +32,7 @@ import Data.Map (Map) import Data.String (IsString(..)) import Data.Text (Text) +import Data.Time (NominalDiffTime) import Data.Time.Clock.POSIX (POSIXTime) import Data.Vector (Vector) import Data.Void (Void) diff --git a/src/OpenAI/V1.hs b/src/OpenAI/V1.hs --- a/src/OpenAI/V1.hs +++ b/src/OpenAI/V1.hs @@ -24,7 +24,7 @@ -- -- clientEnv <- `OpenAI.V1.getClientEnv` \"https://api.openai.com\" -- --- let `OpenAI.V1.Methods`{ createChatCompletion } = `OpenAI.V1.makeMethods` clientEnv (Text.`Data.Text.pack` key) +-- let `OpenAI.V1.Methods`{ createChatCompletion } = `OpenAI.V1.makeMethods` clientEnv (Text.`Data.Text.pack` key) Nothing Nothing -- -- text <- Text.IO.`Data.Text.IO.getLine` -- @@ -77,6 +77,13 @@ import OpenAI.V1.Assistants (AssistantID, AssistantObject, CreateAssistant, ModifyAssistant) +import OpenAI.V1.ChatKit + ( CancelChatSession + , CreateChatKitSession + , ChatSessionObject + , SessionID + , ThreadItem + ) import OpenAI.V1.FineTuning.Jobs ( CheckpointObject , CreateFineTuningJob @@ -127,6 +134,7 @@ import qualified OpenAI.V1.Audio as Audio import qualified OpenAI.V1.Batches as Batches import qualified OpenAI.V1.Chat.Completions as Chat.Completions +import qualified OpenAI.V1.ChatKit as ChatKit import qualified OpenAI.V1.Embeddings as Embeddings import qualified OpenAI.V1.Files as Files import qualified OpenAI.V1.FineTuning.Jobs as FineTuning.Jobs @@ -180,8 +188,15 @@ ( ( createSpeech :<|> createTranscription_ :<|> createTranslation_ - ) + ) :<|> createChatCompletion + :<|> ( createChatKitSession + :<|> cancelChatSession + :<|> _listChatKitThreads + :<|> retrieveChatKitThread + :<|> deleteChatKitThread + :<|> _listChatKitThreadItems + ) :<|> ( createResponse :<|> retrieveResponse :<|> cancelResponse @@ -321,6 +336,8 @@ listVectorStoreFilesInABatch a b c d e f g = toVector (listVectorStoreFilesInABatch_ a b c d e f g) listResponseInputItems a = toVector (listResponseInputItems_ a) + listChatKitThreads a b c d e = toVector (_listChatKitThreads a b c d e) + listChatKitThreadItems a b c d e = toVector (_listChatKitThreadItems a b c d e) -- Streaming implementation using http-client and SSE parsing createResponseStream req onEvent = do @@ -481,6 +498,33 @@ , createTranscription :: CreateTranscription -> IO TranscriptionObject , createTranslation :: CreateTranslation -> IO TranslationObject , createChatCompletion :: CreateChatCompletion -> IO ChatCompletionObject + , createChatKitSession :: CreateChatKitSession -> IO ChatSessionObject + , cancelChatSession :: SessionID -> IO CancelChatSession + , listChatKitThreads + :: Maybe Text + -- ^ after + -> Maybe Text + -- ^ before + -> Maybe Natural + -- ^ limit + -> Maybe Order + -- ^ order + -> Maybe Text + -- ^ user + -> IO (Vector ChatKit.ThreadObject) + , retrieveChatKitThread :: ChatKit.ThreadID -> IO ChatKit.ThreadObject + , deleteChatKitThread :: ChatKit.ThreadID -> IO DeletionStatus + , listChatKitThreadItems + :: ChatKit.ThreadID + -> Maybe Text + -- ^ after + -> Maybe Text + -- ^ before + -> Maybe Natural + -- ^ limit + -> Maybe Order + -- ^ order + -> IO (Vector ThreadItem) , createChatCompletionStream :: CreateChatCompletion -> (Either Text Aeson.Value -> IO ()) @@ -712,6 +756,7 @@ :> "v1" :> ( Audio.API :<|> Chat.Completions.API + :<|> ChatKit.API :<|> Responses.API :<|> Embeddings.API :<|> FineTuning.Jobs.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 @@ -15,6 +15,9 @@ , ChunkChoice(..) , Delta(..) , ChatCompletionStreamEvent + -- * Stream options + , ChatCompletionStreamOptions(..) + , _ChatCompletionStreamOptions -- * Other types , InputAudio(..) , ImageURL(..) @@ -282,6 +285,29 @@ } deriving stock (Generic, Show) deriving anyclass (FromJSON, ToJSON) +-- | Options for streaming response. Only set this when you set @stream: true@. +data ChatCompletionStreamOptions = ChatCompletionStreamOptions + { -- | If set, an additional chunk will be streamed before @data: [DONE]@ + -- with total usage in @usage@ and an empty @choices@ array. Other + -- chunks include @usage: null@. If the stream is interrupted, you may + -- not receive this final usage chunk. + include_usage :: Maybe Bool + -- | When @True@, stream obfuscation is enabled. This adds random + -- characters to an obfuscation field on delta events to normalize + -- payload sizes. Obfuscation is included by default; set this to + -- @False@ to reduce bandwidth overhead when your network links are + -- trusted. + , include_obfuscation :: Maybe Bool + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Default `ChatCompletionStreamOptions` +_ChatCompletionStreamOptions :: ChatCompletionStreamOptions +_ChatCompletionStreamOptions = ChatCompletionStreamOptions + { include_usage = Nothing + , include_obfuscation = Nothing + } + -- | Request body for @\/v1\/chat\/completions@ data CreateChatCompletion = CreateChatCompletion { messages :: Vector (Message (Vector Content)) @@ -304,6 +330,7 @@ , service_tier :: Maybe (AutoOr ServiceTier) , stop :: Maybe (Vector Text) , stream :: Maybe Bool + , stream_options :: Maybe ChatCompletionStreamOptions , temperature :: Maybe Double , top_p :: Maybe Double , tools :: Maybe (Vector Tool) @@ -340,6 +367,7 @@ , service_tier = Nothing , stop = Nothing , stream = Nothing + , stream_options = Nothing , temperature = Nothing , top_p = Nothing , tools = Nothing diff --git a/src/OpenAI/V1/ChatKit.hs b/src/OpenAI/V1/ChatKit.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/ChatKit.hs @@ -0,0 +1,454 @@ +-- | @\/v1\/chatkit@ +module OpenAI.V1.ChatKit + ( -- * Main types + SessionID(..) + , ThreadID(..) + , CreateChatKitSession(..) + , _CreateChatKitSession + , ChatSessionObject(..) + , CancelChatSession(..) + , ThreadObject(..) + , ThreadItem(..) + -- * Other types + , Workflow(..) + , ChatKitConfiguration(..) + , ExpiresAfter(..) + , RateLimits(..) + , Tracing(..) + , AutomaticThreadTitling(..) + , FileUpload(..) + , History(..) + , Scope(..) + , Attachment(..) + , UserContent(..) + , InferenceOptions(..) + , ToolChoice(..) + , AssistantContent(..) + , Annotation(..) + , FileSource(..) + , URLSource(..) + , Task(..) + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.DeletionStatus (DeletionStatus(..)) +import OpenAI.V1.ListOf (ListOf(..)) +import OpenAI.V1.Order (Order(..)) + +-- | Session ID +newtype SessionID = SessionID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Thread ID +newtype ThreadID = ThreadID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Request body for @\/v1\/chatkit\/sessions@ +data CreateChatKitSession = CreateChatKitSession + { user :: Text + , workflow :: Workflow + , chatkit_configuration :: Maybe ChatKitConfiguration + , expires_after :: Maybe ExpiresAfter + , rate_limits :: Maybe RateLimits + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Default `CreateChatKitSession` +_CreateChatKitSession :: CreateChatKitSession +_CreateChatKitSession = CreateChatKitSession + { chatkit_configuration = Nothing + , expires_after = Nothing + , rate_limits = Nothing + } + +-- | Workflow that powers the session +data Workflow = Workflow + { id :: Text + , state_variables :: Maybe (Map Text Value) + , tracing :: Maybe Tracing + , version :: Maybe Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Tracing overrides for the workflow invocation +data Tracing = Tracing + { enabled :: Maybe Bool + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Overrides for ChatKit runtime configuration features +data ChatKitConfiguration = ChatKitConfiguration + { automatic_thread_titling :: Maybe AutomaticThreadTitling + , file_upload :: Maybe FileUpload + , history :: Maybe History + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Configuration for automatic thread titling +data AutomaticThreadTitling = AutomaticThreadTitling + { enabled :: Maybe Bool + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Configuration for file upload enablement and limits +data FileUpload = FileUpload + { enabled :: Maybe Bool + , max_file_size :: Maybe Natural + , max_files :: Maybe Natural + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Configuration for chat history retention +data History = History + { enabled :: Maybe Bool + , recent_threads :: Maybe Natural + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Override for session expiration timing +data ExpiresAfter = Created_At + { seconds :: NominalDiffTime + } deriving stock (Generic, Show) + +expiresAfterOptions :: Options +expiresAfterOptions = + aesonOptions + { sumEncoding = + TaggedObject + { tagFieldName = "expires_after", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +instance FromJSON ExpiresAfter where + parseJSON = genericParseJSON expiresAfterOptions + +instance ToJSON ExpiresAfter where + toJSON = genericToJSON expiresAfterOptions + +-- | Override for per-minute request limits +data RateLimits = RateLimits + { max_requests_per_1_minute :: Maybe Natural + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | A ChatKit session +data ChatSessionObject = ChatSessionObject + { chatkit_configuration :: ChatKitConfiguration + , client_secret :: Text + , expires_at :: POSIXTime + , id :: SessionID + , max_requests_per_1_minute :: Natural + , object :: Text + , rate_limits :: RateLimits + , status :: Text + , user :: Text + , workflow :: Workflow + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Response body for @\/v1\/chatkit\/sessions\/{session_id}\/cancel@ +data CancelChatSession = CancelChatSession + { id :: SessionID + , workflow :: Workflow + , scope :: Scope + , max_requests_per_1_minute :: Natural + , ttl_seconds :: NominalDiffTime + , status :: Text + , cancelled_at :: POSIXTime + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Scope +data Scope = Scope + { customer_id :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | A ChatKit thread +data ThreadObject = ThreadObject + { created_at :: POSIXTime + , id :: ThreadID + , object :: Text + , status :: Status + , title :: Maybe Text + , user :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Current status for the thread +data Status = Active + deriving stock (Generic, Show) + +statusOptions :: Options +statusOptions = + aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +instance FromJSON Status where + parseJSON = genericParseJSON statusOptions + +instance ToJSON Status where + toJSON = genericToJSON statusOptions + +-- | A thread item +data ThreadItem + = User_Message + { attachments :: Vector Attachment + , content :: Vector UserContent + , created_at :: POSIXTime + , id :: Text + , inference_options :: InferenceOptions + , object :: Text + , thread_id :: Text + } + | Assistant_Message + { assistant_content :: Vector AssistantContent + , created_at :: POSIXTime + , id :: Text + , object :: Text + , thread_id :: Text + } + | Widget_Message + { created_at :: POSIXTime + , id :: Text + , object :: Text + , thread_id :: Text + , widget :: Text + } + | Client_Tool_Call + { arguments :: Text + , call_id :: Text + , created_at :: POSIXTime + , id :: Text + , name :: Text + , object :: Text + , output :: Text + , status :: Text + , thread_id :: Text + } + | Task_Item + { created_at :: POSIXTime + , heading :: Text + , id :: Text + , object :: Text + , summary :: Text + , task_type + , thread_id :: Text + } + | Task_Group + { created_at :: POSIXTime + , id :: Text + , object :: Text + , tasks :: Vector Task + , thread_id :: Text + } deriving stock (Generic, Show) + +threadItemOptions :: Options +threadItemOptions = + aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + + , fieldLabelModifier = stripPrefix "assistant_" + } + +instance FromJSON ThreadItem where + parseJSON = genericParseJSON threadItemOptions + +instance ToJSON ThreadItem where + toJSON = genericToJSON threadItemOptions + +-- | Attachment associated with the user message +data Attachment = Attachment + { id :: Text + , mime_type :: Text + , name :: Text + , preview_url :: Text + } deriving stock (Generic, Show) + +instance FromJSON Attachment where + parseJSON = genericParseJSON aesonOptions + +instance ToJSON Attachment where + toJSON = genericToJSON aesonOptions + +-- | Content element supplied by the user +data UserContent + = Input_Text{ text :: Text } + | Quoted_Text{ text :: Text } + deriving stock (Generic, Show) + +userContentOptions :: Options +userContentOptions = + aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +instance FromJSON UserContent where + parseJSON = genericParseJSON userContentOptions + +instance ToJSON UserContent where + toJSON = genericToJSON userContentOptions + +-- | Inference overrides applies to the message +data InferenceOptions = InferenceOptions + { model :: Text + , tool_choice :: ToolChoice + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Preferred tool to invoke +data ToolChoice = ToolChoice + { id :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Assistant response segment +data AssistantContent = Output_Text + { annotations :: Vector Annotation + , text :: Text + } deriving stock (Generic, Show) + +assistantContentOptions :: Options +assistantContentOptions = + aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +instance FromJSON AssistantContent where + parseJSON = genericParseJSON assistantContentOptions + +instance ToJSON AssistantContent where + toJSON = genericToJSON assistantContentOptions + +-- | Annotation +data Annotation + = File + { source :: FileSource + } + | Url + { url_source :: URLSource + } + deriving stock (Generic, Show) + +annotationOptions :: Options +annotationOptions = + aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + + , fieldLabelModifier = stripPrefix "url_" + } + +instance FromJSON Annotation where + parseJSON = genericParseJSON annotationOptions + +instance ToJSON Annotation where + toJSON = genericToJSON annotationOptions + +-- | File attachment +data FileSource = FileSource_File + { filename :: Text + } deriving stock (Generic, Show) + +fileSourceOptions :: Options +fileSourceOptions = + aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , constructorTagModifier = stripPrefix "FileSource_" + + , tagSingleConstructors = True + } + +instance FromJSON FileSource where + parseJSON = genericParseJSON fileSourceOptions + +instance ToJSON FileSource where + toJSON = genericToJSON fileSourceOptions + +-- | URL +data URLSource = URLSource_Url + { url :: Text + } deriving stock (Generic, Show) + +urlSourceOptions :: Options +urlSourceOptions = + aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , constructorTagModifier = stripPrefix "URLSource_" + + , tagSingleConstructors = True + } + +instance FromJSON URLSource where + parseJSON = genericParseJSON urlSourceOptions + +instance ToJSON URLSource where + toJSON = genericToJSON urlSourceOptions + +-- | Task +data Task = Task + { heading :: Text + , summary :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Servant API +type API = + "chatkit" + :> ( ( "sessions" + :> ReqBody '[JSON] CreateChatKitSession + :> Post '[JSON] ChatSessionObject + ) + :<|> ( "sessions" + :> Capture "session_id" SessionID + :> "cancel" + :> Post '[JSON] CancelChatSession + ) + :<|> ( "threads" + :> QueryParam "after" Text + :> QueryParam "before" Text + :> QueryParam "limit" Natural + :> QueryParam "order" Order + :> QueryParam "user" Text + :> Get '[JSON] (ListOf ThreadObject) + ) + :<|> ( "threads" + :> Capture "thread_id" ThreadID + :> Get '[JSON] ThreadObject + ) + :<|> ( "threads" + :> Capture "thread_id" ThreadID + :> Delete '[JSON] DeletionStatus + ) + :<|> ( "threads" + :> Capture "thread_id" ThreadID + :> "items" + :> QueryParam "after" Text + :> QueryParam "before" Text + :> QueryParam "limit" Natural + :> QueryParam "order" Order + :> Get '[JSON] (ListOf ThreadItem) + ) + ) diff --git a/src/OpenAI/V1/Responses.hs b/src/OpenAI/V1/Responses.hs --- a/src/OpenAI/V1/Responses.hs +++ b/src/OpenAI/V1/Responses.hs @@ -31,6 +31,7 @@ , ReasoningEffort(..) , ServiceTier , ResponseStreamEvent(..) + , Tool(..) , ResponseObject(..) , ResponseUsage(..) , InputTokensDetails(..) @@ -43,25 +44,13 @@ ) where import Data.Aeson (Object) -import qualified Data.Aeson as Aeson import OpenAI.Prelude hiding (Input(..)) --- no TH; inline JSON instances for payloads import OpenAI.V1.AutoOr (AutoOr(..)) import OpenAI.V1.ListOf (ListOf) import OpenAI.V1.Models (Model) -import qualified Data.Aeson.Key as Key -import qualified Data.Aeson.KeyMap as KeyMap -import qualified Data.Vector as Vector + import OpenAI.V1.Tool - ( Tool - , ToolChoice - , toolChoiceAutoText - , toolChoiceNoneText - , toolChoiceRequiredText - , toolChoiceToResponsesValue - , toolToResponsesValue - , unflattenToolValue - ) + (CodeInterpreterContainer, RankingOptions, ToolChoice(..)) -- | Status constants for function call outputs statusIncomplete, statusCompleted :: Text @@ -233,50 +222,6 @@ instance ToJSON InputItem where toJSON = genericToJSON inputItemOptions -keyTools :: Key.Key -keyTools = Key.fromText "tools" - -keyToolChoice :: Key.Key -keyToolChoice = Key.fromText "tool_choice" - -flattenResponseToolFields - :: Maybe (Vector Tool) - -> Maybe ToolChoice - -> KeyMap.KeyMap Value - -> KeyMap.KeyMap Value -flattenResponseToolFields mTools mChoice o = - let oWithTools = case mTools of - Nothing -> o - Just ts -> KeyMap.insert keyTools (Aeson.Array (Vector.map toolToResponsesValue ts)) o - oWithChoice = case mChoice of - Nothing -> oWithTools - Just choice -> KeyMap.insert keyToolChoice (toolChoiceToResponsesValue choice) oWithTools - in oWithChoice - -unflattenResponseToolFields :: KeyMap.KeyMap Value -> KeyMap.KeyMap Value -unflattenResponseToolFields = adjustChoice . adjustTools - where - adjustTools = adjustKey keyTools (mapArrayValues unflattenToolValue) - adjustChoice = adjustKey keyToolChoice unflattenChoice - - unflattenChoice (String s) - | s `elem` ([toolChoiceNoneText, toolChoiceAutoText, toolChoiceRequiredText] :: [Text]) = String s - unflattenChoice other = unflattenToolValue other - -mapArrayValues :: (Value -> Value) -> Value -> Value -mapArrayValues f (Aeson.Array arr) = Aeson.Array (Vector.map f arr) -mapArrayValues _ other = other - -adjustKey - :: Key.Key - -> (Value -> Value) - -> KeyMap.KeyMap Value - -> KeyMap.KeyMap Value -adjustKey key f obj = - case KeyMap.lookup key obj of - Nothing -> obj - Just v -> KeyMap.insert key (f v) obj - -- | Output content from the model data OutputContent = Output_Text @@ -798,7 +743,6 @@ instance ToJSON ResponseStreamEvent where toJSON = genericToJSON responseStreamEventOptions - -- | Usage statistics for the response request data ResponseUsage = ResponseUsage { input_tokens :: Natural @@ -819,6 +763,40 @@ } deriving stock (Generic, Show) deriving anyclass (FromJSON, ToJSON) +-- | A tool enabled on the assistant +data Tool + = Tool_Code_Interpreter + { container :: Maybe CodeInterpreterContainer + } + | Tool_File_Search + { max_num_results :: Maybe Natural + , ranking_options :: Maybe RankingOptions + } + | Tool_Function + { description :: Maybe Text + , name :: Text + , parameters :: Maybe Value + , strict :: Maybe Bool + } + | Tool_Web_Search + deriving stock (Generic, Show) + +toolOptions :: Options +toolOptions = aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + + , constructorTagModifier = stripPrefix "Tool_" + } + +instance FromJSON Tool where + parseJSON = genericParseJSON toolOptions + +instance ToJSON Tool where + toJSON = genericToJSON toolOptions + -- | Response object data ResponseObject = ResponseObject { id :: Text @@ -844,19 +822,7 @@ , user :: Maybe Text , metadata :: Maybe (Map Text Text) } deriving stock (Generic, Show) - -instance FromJSON ResponseObject where - parseJSON (Aeson.Object o) = - genericParseJSON aesonOptions (Aeson.Object (unflattenResponseToolFields o)) - parseJSON other = genericParseJSON aesonOptions other - -instance ToJSON ResponseObject where - toJSON response@ResponseObject{ tools = mTools, tool_choice = mChoice } = - case genericToJSON aesonOptions response of - Aeson.Object o -> - Aeson.Object - (flattenResponseToolFields mTools mChoice o) - other -> other + deriving anyclass (FromJSON, ToJSON) -- | Request body for \/v1/responses data CreateResponse = CreateResponse @@ -876,19 +842,7 @@ , tools :: Maybe (Vector Tool) , tool_choice :: Maybe ToolChoice } deriving stock (Generic, Show) - -instance FromJSON CreateResponse where - parseJSON (Aeson.Object o) = - genericParseJSON aesonOptions (Aeson.Object (unflattenResponseToolFields o)) - parseJSON other = genericParseJSON aesonOptions other - -instance ToJSON CreateResponse where - toJSON request@CreateResponse{ tools = mTools, tool_choice = mChoice } = - case genericToJSON aesonOptions request of - Aeson.Object o -> - Aeson.Object - (flattenResponseToolFields mTools mChoice o) - other -> other + deriving anyclass (FromJSON, ToJSON) -- | Default CreateResponse _CreateResponse :: CreateResponse 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 @@ -7,39 +7,18 @@ , Function(..) , ToolChoice(..) , CodeInterpreterContainer(..) - -- * Constants - , toolChoiceNoneText - , toolChoiceAutoText - , toolChoiceRequiredText -- * Helpers , codeInterpreter , codeInterpreterAuto , codeInterpreterWithFiles - , toolToResponsesValue - , parseResponsesToolValue - , toolChoiceToResponsesValue - , parseResponsesToolChoiceValue - , flattenToolValue - , unflattenToolValue ) where import Data.Aeson ((.:), (.:?), (.=)) -import Data.Aeson.Types (Parser) import OpenAI.Prelude + import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Key as Key -import qualified Data.Aeson.KeyMap as KeyMap -import qualified Data.HashSet as HashSet -import Data.HashSet (HashSet) -import Data.List (partition) import qualified Data.Vector as V --- | Tool choice string constants -toolChoiceNoneText, toolChoiceAutoText, toolChoiceRequiredText :: Text -toolChoiceNoneText = "none" -toolChoiceAutoText = "auto" -toolChoiceRequiredText = "required" - -- | The ranking options for the file search data RankingOptions = RankingOptions { ranker :: Maybe Text @@ -86,60 +65,6 @@ instance ToJSON Tool where toJSON = genericToJSON toolOptions - -toolToResponsesValue :: Tool -> Value -toolToResponsesValue = flattenToolValue . toJSON - -parseResponsesToolValue :: Value -> Parser Tool -parseResponsesToolValue = parseJSON . unflattenToolValue - -toolChoiceToResponsesValue :: ToolChoice -> Value -toolChoiceToResponsesValue ToolChoiceNone = String toolChoiceNoneText -toolChoiceToResponsesValue ToolChoiceAuto = String toolChoiceAutoText -toolChoiceToResponsesValue ToolChoiceRequired = String toolChoiceRequiredText -toolChoiceToResponsesValue (ToolChoiceTool tool) = toolToResponsesValue tool - -parseResponsesToolChoiceValue :: Value -> Parser ToolChoice -parseResponsesToolChoiceValue (String s) - | s == toolChoiceNoneText = pure ToolChoiceNone - | s == toolChoiceAutoText = pure ToolChoiceAuto - | s == toolChoiceRequiredText = pure ToolChoiceRequired -parseResponsesToolChoiceValue other = ToolChoiceTool <$> parseResponsesToolValue other - -keyFunction, keyType :: Key.Key -keyFunction = Key.fromText "function" -keyType = Key.fromText "type" - -functionFieldKeys :: HashSet Key.Key -functionFieldKeys = HashSet.fromList $ Key.fromText <$> ["description", "name", "parameters", "strict"] - -isFunctionField :: Key.Key -> Bool -isFunctionField = (`HashSet.member` functionFieldKeys) - -partitionFunctionFields - :: KeyMap.KeyMap Value - -> (KeyMap.KeyMap Value, KeyMap.KeyMap Value) -partitionFunctionFields obj = - let (fnPairs, restPairs) = partition (isFunctionField . fst) (KeyMap.toList obj) - in (KeyMap.fromList fnPairs, KeyMap.fromList restPairs) - -flattenToolValue :: Value -> Value -flattenToolValue value@(Aeson.Object o) = - maybe value flattenFunction (KeyMap.lookup keyFunction o) - where - flattenFunction (Aeson.Object fnFields) = - Aeson.Object (KeyMap.delete keyFunction o <> fnFields) - flattenFunction _ = value -flattenToolValue value = value - -unflattenToolValue :: Value -> Value -unflattenToolValue value@(Aeson.Object o) - | KeyMap.lookup keyType o == Just (String "function") - , not (KeyMap.member keyFunction o) = - let (fnFields, rest) = partitionFunctionFields o - in Aeson.Object (KeyMap.insert keyFunction (Aeson.Object fnFields) rest) - | otherwise = value -unflattenToolValue value = value -- | Controls which (if any) tool is called by the model data ToolChoice diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -23,7 +23,7 @@ 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.Tool (CodeInterpreterContainer(..), Tool(..), ToolChoice(..)) import OpenAI.V1.ToolCall (ToolCall(..)) import Prelude hiding (id) @@ -179,6 +179,7 @@ service_tier = Nothing, stop = Nothing, stream = Nothing, + stream_options = Nothing, temperature = Nothing, top_p = Nothing, tools = Nothing, @@ -220,6 +221,7 @@ service_tier = Nothing, stop = Nothing, stream = Nothing, + stream_options = Nothing, temperature = Nothing, top_p = Nothing, tools = Nothing, @@ -282,6 +284,7 @@ service_tier = Just Auto, stop = Just [">>>"], stream = Nothing, + stream_options = Nothing, temperature = Just 1, top_p = Just 1, tools = @@ -334,6 +337,7 @@ service_tier = Nothing, stop = Nothing, stream = Nothing, + stream_options = Nothing, temperature = Nothing, top_p = Nothing, tools = Nothing, @@ -1007,7 +1011,13 @@ Responses.metadata = Nothing, Responses.temperature = Nothing, Responses.top_p = Nothing, - Responses.tools = Just [Tool.codeInterpreterAuto], + Responses.tools = Just + [ Responses.Tool_Code_Interpreter + { container = Just CodeInterpreterContainer_Auto + { file_ids = Nothing + } + } + ], Responses.tool_choice = Just Tool.ToolChoiceRequired }