From 8025e19bacd111fd1a746163b7773da3594cbd3f Mon Sep 17 00:00:00 2001 From: James Koppel Date: Wed, 22 Mar 2023 22:07:26 -0400 Subject: [PATCH 01/18] Updating for most of the APIs as of March 2023: models, completions, chat, edits, audio, images, embeddings. Changed names of old deprecated APIs whose names conflict with new APIs. Did not touch most existing APIs, even though al are broken or deprecated by now. --- openai-hs/src/OpenAI/Client.hs | 160 +++-- openai-hs/test/ApiSpec.hs | 80 ++- openai-servant/src/OpenAI/Api.hs | 36 +- openai-servant/src/OpenAI/Internal/Aeson.hs | 2 +- openai-servant/src/OpenAI/Resources.hs | 627 +++++++++++++++++--- 5 files changed, 758 insertions(+), 147 deletions(-) diff --git a/openai-hs/src/OpenAI/Client.hs b/openai-hs/src/OpenAI/Client.hs index 7b067f0..bd4bacf 100644 --- a/openai-hs/src/OpenAI/Client.hs +++ b/openai-hs/src/OpenAI/Client.hs @@ -11,27 +11,81 @@ module OpenAI.Client -- * Helper types TimeStamp (..), OpenAIList (..), + Usage (..), + + + -- * Models + Model(..), + ModelId(..), + listModels, + getModel, + + -- * Completion + CompletionCreate (..), + CompletionChoice (..), + CompletionResponse (..), + defaultCompletionCreate, + completeText, + + -- * Chat + ChatMessage (..), + ChatCompletionRequest (..), + ChatChoice (..), + ChatResponse (..), + defaultChatCompletionRequest, + completeChat, + + -- * Edits + EditCreate (..), + EditChoice (..), + EditResponse (..), + createTextEdit, + defaultEditCreate, + + -- * Images + ImageResponse (..), + ImageResponseData (..), + ImageCreate (..), + ImageEditRequest (..), + ImageVariationRequest (..), + generateImage, + createImageEdit, + createImageVariation, - -- * Engine + -- * Embeddings + EmbeddingCreate (..), + EmbeddingResponseData (..), + EmbeddingUsage (..), + EmbeddingResponse (..), + createEmbedding, + + -- * Audio + AudioResponseData (..), + AudioTranscriptionRequest (..), + AudioTranslationRequest (..), + createTranscription, + createAudioTranslation, + + -- * Engine (deprecated) EngineId (..), Engine (..), listEngines, getEngine, - -- * Text completion + -- * Engine-based text completion (deprecated) TextCompletionId (..), TextCompletionChoice (..), TextCompletion (..), TextCompletionCreate (..), - defaultTextCompletionCreate, - completeText, + defaultEngineTextCompletionCreate, + engineCompleteText, - -- * Embeddings - EmbeddingCreate (..), - Embedding (..), - createEmbedding, + -- * Engine-based embeddings (deprecated) + EngineEmbeddingCreate (..), + EngineEmbedding (..), + engineCreateEmbedding, - -- * Fine tunes + -- * Fine tunes (out of date) FineTuneId (..), FineTuneCreate (..), defaultFineTuneCreate, @@ -43,12 +97,12 @@ module OpenAI.Client cancelFineTune, listFineTuneEvents, - -- * Searching + -- * Searching (out of date) SearchResult (..), SearchResultCreate (..), searchDocuments, - -- * File API + -- * File API (out of date) FileCreate (..), File (..), FileId (..), @@ -60,7 +114,7 @@ module OpenAI.Client createFile, deleteFile, - -- * Answer API + -- * Answer API (out of date) getAnswer, AnswerReq (..), AnswerResp (..), @@ -109,7 +163,7 @@ openaiBaseUrl = BaseUrl Https "api.openai.com" 443 "" N :: OpenAIClient -> IO (Either ClientError R);\ N sc = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc)) (mkClientEnv (scManager sc) openaiBaseUrl) -#define EP(N, ARG, R) \ +#define EP1(N, ARG, R) \ N##' :: BasicAuthData -> ARG -> ClientM R;\ N :: OpenAIClient -> ARG -> IO (Either ClientError R);\ N sc a = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a) (mkClientEnv (scManager sc) openaiBaseUrl) @@ -119,18 +173,24 @@ openaiBaseUrl = BaseUrl Https "api.openai.com" 443 "" N :: OpenAIClient -> ARG -> ARG2 -> IO (Either ClientError R);\ N sc a b = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a b) (mkClientEnv (scManager sc) openaiBaseUrl) -EP2 (completeText, EngineId, TextCompletionCreate, TextCompletion) -EP2 (searchDocuments, EngineId, SearchResultCreate, (OpenAIList SearchResult)) -EP2 (createEmbedding, EngineId, EmbeddingCreate, (OpenAIList Embedding)) -EP (createFineTune, FineTuneCreate, FineTune) -EP0 (listFineTunes, (OpenAIList FineTune)) -EP (getFineTune, FineTuneId, FineTune) -EP (cancelFineTune, FineTuneId, FineTune) -EP (listFineTuneEvents, FineTuneId, (OpenAIList FineTuneEvent)) +EP0(listModels, (OpenAIList Model)) +EP1(getModel, ModelId, Model) -EP0 (listEngines, (OpenAIList Engine)) -EP (getEngine, EngineId, Engine) +EP1(completeText, CompletionCreate, CompletionResponse) + +EP1(completeChat, ChatCompletionRequest, ChatResponse) + +EP1(createTextEdit, EditCreate, EditResponse) + +EP1(generateImage, ImageCreate, ImageResponse) +EP1(createImageEdit, ImageEditRequest, ImageResponse) +EP1(createImageVariation, ImageVariationRequest, ImageResponse) + +EP1(createEmbedding, EmbeddingCreate, EmbeddingResponse) + +EP1(createTranscription, AudioTranscriptionRequest, AudioResponseData) +EP1(createAudioTranslation, AudioTranslationRequest, AudioResponseData) createFile :: OpenAIClient -> FileCreate -> IO (Either ClientError File) createFile sc rfc = @@ -138,23 +198,47 @@ createFile sc rfc = bnd <- MP.genBoundary createFileInternal sc (bnd, rfc) -EP (createFileInternal, (BSL.ByteString, FileCreate), File) -EP (deleteFile, FileId, FileDeleteConfirmation) +EP1 (createFileInternal, (BSL.ByteString, FileCreate), File) +EP1 (deleteFile, FileId, FileDeleteConfirmation) -EP (getAnswer, AnswerReq, AnswerResp) +EP1 (getAnswer, AnswerReq, AnswerResp) -( listEngines' - :<|> getEngine' - :<|> completeText' - :<|> searchDocuments' - :<|> createEmbedding' - ) +EP1 (createFineTune, FineTuneCreate, FineTune) +EP0 (listFineTunes, (OpenAIList FineTune)) +EP1 (getFineTune, FineTuneId, FineTune) +EP1 (cancelFineTune, FineTuneId, FineTune) +EP1 (listFineTuneEvents, FineTuneId, (OpenAIList FineTuneEvent)) + + +EP0 (listEngines, (OpenAIList Engine)) +EP1 (getEngine, EngineId, Engine) +EP2 (engineCompleteText, EngineId, TextCompletionCreate, TextCompletion) +EP2 (searchDocuments, EngineId, SearchResultCreate, (OpenAIList SearchResult)) +EP2 (engineCreateEmbedding, EngineId, EngineEmbeddingCreate, (OpenAIList EngineEmbedding)) + + +( ( listModels' + :<|> getModel') + :<|> (completeText') + :<|> (completeChat') + :<|> (createTextEdit') + :<|> ( generateImage' + :<|> createImageEdit' + :<|> createImageVariation') + :<|> ( createEmbedding' ) + :<|> ( createTranscription' + :<|> createAudioTranslation') :<|> (createFileInternal' :<|> deleteFile') :<|> getAnswer' - :<|> ( createFineTune' - :<|> listFineTunes' - :<|> getFineTune' - :<|> cancelFineTune' - :<|> listFineTuneEvents' - ) = + :<|> ( createFineTune' + :<|> listFineTunes' + :<|> getFineTune' + :<|> cancelFineTune' + :<|> listFineTuneEvents' + ) + :<|> ( listEngines' + :<|> getEngine' + :<|> engineCompleteText' + :<|> searchDocuments' + :<|> engineCreateEmbedding')) = client api diff --git a/openai-hs/test/ApiSpec.hs b/openai-hs/test/ApiSpec.hs index 4007c6e..323ca1e 100644 --- a/openai-hs/test/ApiSpec.hs +++ b/openai-hs/test/ApiSpec.hs @@ -23,15 +23,76 @@ forceSuccess req = Right ok -> pure ok apiSpec :: Spec -apiSpec = - describe "core api" apiTests +apiSpec = do + describe "2022 core api" apiTests2022 + describe "March 2023 core API" apiTests2023 -apiTests :: SpecWith () -apiTests = + +--------------------------------- +------- 2023 API tests ---------- +--------------------------------- + +apiTests2023 :: SpecWith () +apiTests2023 = + beforeAll makeClient $ do + describe "models api" $ do + it "list models" $ \cli -> do + res <- forceSuccess $ listModels cli + (V.length (olData res) > 5) `shouldBe` True + let model = V.head (olData res) + mOwnedBy model `shouldBe` "openai" + + it "retrieve model" $ \cli -> do + model <- forceSuccess $ getModel cli (ModelId "text-davinci-003") + mOwnedBy model `shouldBe` "openai-internal" + + describe "completions api" $ do + it "create completion" $ \cli -> do + let completion = (defaultCompletionCreate (ModelId "text-ada-001") "The opposite of up is") + {ccrMaxTokens = Just 1, ccrTemperature = Just 0.1, ccrN = Just 1} + res <- forceSuccess $ completeText cli completion + crChoices res `shouldNotBe` [] + cchText (head (crChoices res)) `shouldBe` " down" + + describe "chat api" $ do + it "create chat completion" $ \cli -> do + let completion = defaultChatCompletionRequest (ModelId "gpt-3.5-turbo") + [ChatMessage {chmRole="user", + chmContent="What is the opposite of up? Answer in one word." + }] + res <- forceSuccess $ completeChat cli completion + chrChoices res `shouldNotBe` [] + chmContent (chchMessage (head (chrChoices res))) `shouldBe` "Down." + + describe "edits api" $ do + it "create edit" $ \cli -> do + let edit = (defaultEditCreate (ModelId "text-davinci-edit-001") "Fox" "Pluralize the word") + {edcrN = Just 1} + res <- forceSuccess $ createTextEdit cli edit + edrChoices res `shouldNotBe` [] + edchText (head $ edrChoices res) `shouldBe` "Foxes\n" + + -- TODO (2023.03.22): Create tests for images, audio APIs + + describe "embeddings api" $ do + it "create embeddings" $ \cli -> do + let embedding = EmbeddingCreate {embcModel=ModelId "text-embedding-ada-002", embcInput="Hello",embcUser=Nothing} + res <- forceSuccess $ createEmbedding cli embedding + embrData res `shouldNotBe` [] + V.length (embdEmbedding (head $ embrData res)) `shouldBe` 1536 + + +--------------------------------- +------- 2022 API tests ---------- +--------------------------------- + +apiTests2022 :: SpecWith () +apiTests2022 = beforeAll makeClient $ do describe "file api" $ do + -- TODO 2023.03.22: This test is broken on old commit. Did not investigate it "allows creating one" $ \cli -> do let file = @@ -43,6 +104,7 @@ apiTests = pure () describe "answer api" $ do + -- TODO 2023.03.22: This test is broken on old commit. Did not investigate it "works" $ \cli -> do let file = @@ -71,10 +133,10 @@ apiTests = pure () describe "embeddings" $ do it "computes embeddings" $ \cli -> do - res <- forceSuccess $ createEmbedding cli (EngineId "babbage-similarity") (EmbeddingCreate "This is nice") + res <- forceSuccess $ engineCreateEmbedding cli (EngineId "babbage-similarity") (EngineEmbeddingCreate "This is nice") V.null (olData res) `shouldBe` False let embedding = V.head (olData res) - V.length (eEmbedding embedding) `shouldBe` 2048 + V.length (eneEngineEmbedding embedding) `shouldBe` 2048 describe "fine tuning" $ do it "allows creating fine-tuning" $ \cli -> do let file = @@ -108,14 +170,15 @@ apiTests = firstEngine <- V.head . olData <$> forceSuccess (listEngines cli) completionResults <- forceSuccess $ - completeText cli (eId firstEngine) $ - (defaultTextCompletionCreate "Why is the house ") + engineCompleteText cli (eId firstEngine) $ + (defaultEngineTextCompletionCreate "Why is the house ") { tccrMaxTokens = Just 2 } V.length (tcChoices completionResults) `shouldBe` 1 T.length (tccText (V.head (tcChoices completionResults))) `shouldNotBe` 0 describe "document search" $ do + -- TODO 2023.03.22: This test is broken on old commit. Did not investigate it "works (smoke test)" $ \cli -> do firstEngine <- V.head . olData <$> forceSuccess (listEngines cli) @@ -131,6 +194,7 @@ apiTests = V.length (olData searchResults) `shouldBe` 3 describe "file based document search" $ do + -- TODO 2023.03.22: This test is broken on old commit. Did not investigate it "works" $ \cli -> do let file = diff --git a/openai-servant/src/OpenAI/Api.hs b/openai-servant/src/OpenAI/Api.hs index 76d2b3c..1bd75f4 100644 --- a/openai-servant/src/OpenAI/Api.hs +++ b/openai-servant/src/OpenAI/Api.hs @@ -11,11 +11,43 @@ type OpenAIApi = "v1" :> OpenAIApiInternal type OpenAIApiInternal = - "engines" :> EnginesApi + "models" :> ModelsApi + :<|> "completions" :> CompletionsApi + :<|> "chat" :> ChatApi + :<|> "edits" :> EditsApi + :<|> "images" :> ImagesApi + :<|> "embeddings" :> EmbeddingsApi + :<|> "audio" :> AudioApi :<|> "files" :> FilesApi :<|> AnswerApi :<|> FineTuneApi + :<|> "engines" :> EnginesApi +type ModelsApi = + OpenAIAuth :> Get '[JSON] (OpenAIList Model) + :<|> OpenAIAuth :> Capture "model_id" ModelId :> Get '[JSON] Model + +type CompletionsApi = + OpenAIAuth :> ReqBody '[JSON] CompletionCreate :> Post '[JSON] CompletionResponse + +type ChatApi = + OpenAIAuth :> "completions" :> ReqBody '[JSON] ChatCompletionRequest :> Post '[JSON] ChatResponse + +type EditsApi = + OpenAIAuth :> ReqBody '[JSON] EditCreate :> Post '[JSON] EditResponse + +type ImagesApi = + OpenAIAuth :> "generations" :> ReqBody '[JSON] ImageCreate :> Post '[JSON] ImageResponse + :<|> OpenAIAuth :> "edits" :> ReqBody '[JSON] ImageEditRequest :> Post '[JSON] ImageResponse + :<|> OpenAIAuth :> "variations" :> ReqBody '[JSON] ImageVariationRequest :> Post '[JSON] ImageResponse + +type EmbeddingsApi = + OpenAIAuth :> ReqBody '[JSON] EmbeddingCreate :> Post '[JSON] EmbeddingResponse + +type AudioApi = + OpenAIAuth :> "transcriptions" :> ReqBody '[JSON] AudioTranscriptionRequest :> Post '[JSON] AudioResponseData + :<|> OpenAIAuth :> "translations" :> ReqBody '[JSON] AudioTranslationRequest :> Post '[JSON] AudioResponseData + type FilesApi = OpenAIAuth :> MultipartForm Mem FileCreate :> Post '[JSON] File :<|> OpenAIAuth :> Capture "file_id" FileId :> Delete '[JSON] FileDeleteConfirmation @@ -35,4 +67,4 @@ type EnginesApi = :<|> OpenAIAuth :> Capture "engine_id" EngineId :> Get '[JSON] Engine :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "completions" :> ReqBody '[JSON] TextCompletionCreate :> Post '[JSON] TextCompletion :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "search" :> ReqBody '[JSON] SearchResultCreate :> Post '[JSON] (OpenAIList SearchResult) - :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "embeddings" :> ReqBody '[JSON] EmbeddingCreate :> Post '[JSON] (OpenAIList Embedding) + :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "embeddings" :> ReqBody '[JSON] EngineEmbeddingCreate :> Post '[JSON] (OpenAIList EngineEmbedding) diff --git a/openai-servant/src/OpenAI/Internal/Aeson.hs b/openai-servant/src/OpenAI/Internal/Aeson.hs index 6cf3ea5..f696dd2 100644 --- a/openai-servant/src/OpenAI/Internal/Aeson.hs +++ b/openai-servant/src/OpenAI/Internal/Aeson.hs @@ -2,7 +2,7 @@ module OpenAI.Internal.Aeson (jsonOpts, deriveJSON, ToJSON, FromJSON) where import Data.Aeson -import Data.Aeson.TH +import Data.Aeson.TH ( deriveJSON ) import Text.Casing (quietSnake) jsonOpts :: Int -> Options diff --git a/openai-servant/src/OpenAI/Resources.hs b/openai-servant/src/OpenAI/Resources.hs index 4460f4a..e062548 100644 --- a/openai-servant/src/OpenAI/Resources.hs +++ b/openai-servant/src/OpenAI/Resources.hs @@ -1,38 +1,66 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE InstanceSigs #-} module OpenAI.Resources ( -- * Core Types TimeStamp (..), OpenAIList (..), - - -- * Engine - EngineId (..), - Engine (..), - - -- * Text completion - TextCompletionId (..), - TextCompletionChoice (..), - TextCompletion (..), - TextCompletionCreate (..), - defaultTextCompletionCreate, + Usage (..), + + -- * Models + Model(..), + ModelId(..), + + -- * Completion + CompletionCreate (..), + CompletionChoice (..), + CompletionResponse (..), + defaultCompletionCreate, + + -- * Chat + ChatMessage (..), + ChatCompletionRequest (..), + ChatChoice (..), + ChatResponse (..), + defaultChatCompletionRequest, + + -- * Edits + EditCreate (..), + EditChoice (..), + EditResponse (..), + defaultEditCreate, + + -- * Images + ImageResponse (..), + ImageResponseData (..), + ImageCreate (..), + ImageEditRequest (..), + ImageVariationRequest (..), -- * Embeddings EmbeddingCreate (..), - Embedding (..), + EmbeddingResponseData (..), + EmbeddingUsage (..), + EmbeddingResponse (..), - -- * Fine tuning + -- * Audio + AudioResponseData (..), + AudioTranscriptionRequest (..), + AudioTranslationRequest (..), + + -- * Fine tuning (out of date) FineTuneId (..), FineTuneCreate (..), defaultFineTuneCreate, FineTune (..), FineTuneEvent (..), - -- * Searching + -- * Searching (out of date) SearchResult (..), SearchResultCreate (..), - -- * File API + -- * File API (out of date) FileCreate (..), FileId (..), File (..), @@ -42,9 +70,25 @@ module OpenAI.Resources FineTuneHunk (..), FileDeleteConfirmation (..), - -- * Answers API + + -- * Engine (deprecated) + EngineId (..), + Engine (..), + + -- * Engine Answers API (deprecated) AnswerReq (..), AnswerResp (..), + + -- * Engine text completion (deprecated) + TextCompletionId (..), + TextCompletionChoice (..), + TextCompletion (..), + TextCompletionCreate (..), + defaultEngineTextCompletionCreate, + + -- * Engine Embeddings (deprecated) + EngineEmbeddingCreate (..), + EngineEmbedding (..), ) where @@ -92,6 +136,443 @@ instance Applicative OpenAIList where pure = OpenAIList . pure (<*>) go x = OpenAIList (olData go <*> olData x) +$(deriveJSON (jsonOpts 2) ''OpenAIList) + +data Usage = Usage + { + usPromptTokens :: Int, + usCompletionTokens :: Int, + usTotalTokens :: Int + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 2) ''Usage) + +------------------------ +------ Model API +------------------------ + +data Model = Model + { mId :: ModelId, + mObject :: T.Text, + mOwnedBy :: T.Text, + mPermission :: [A.Object] -- TODO 2023.03.22: Docs do not say what this is + } + deriving (Show, Eq) + +newtype ModelId = ModelId {unModelId :: T.Text} + deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) + +$(deriveJSON (jsonOpts 1) ''Model) + +------------------------ +------ Completions API +------------------------ + +data CompletionCreate = CompletionCreate + { ccrModel :: ModelId, + ccrPrompt :: Maybe T.Text, + ccrSuffix :: Maybe T.Text, + ccrMaxTokens :: Maybe Int, + ccrTemperature :: Maybe Double, + ccrTopP :: Maybe Double, + ccrN :: Maybe Int, + ccrStream :: Maybe Bool, + ccrLogprobs :: Maybe Int, + ccrEcho :: Maybe Bool, + ccrStop :: Maybe (V.Vector T.Text), + ccrPresencePenalty :: Maybe Double, + ccrFrequencyPenalty :: Maybe Double, + ccrBestOf :: Maybe Int, + ccrLogitBias :: Maybe (V.Vector Double), + ccrUser :: Maybe String + } + deriving (Show, Eq) + +defaultCompletionCreate :: ModelId -> T.Text -> CompletionCreate +defaultCompletionCreate model prompt = + CompletionCreate + { ccrModel = model, + ccrPrompt = Just prompt, + ccrSuffix = Nothing, + ccrMaxTokens = Nothing, + ccrTemperature = Nothing, + ccrTopP = Nothing, + ccrN = Nothing, + ccrStream = Nothing, + ccrLogprobs = Nothing, + ccrEcho = Nothing, + ccrStop = Nothing, + ccrPresencePenalty = Nothing, + ccrFrequencyPenalty = Nothing, + ccrBestOf = Nothing, + ccrLogitBias = Nothing, + ccrUser = Nothing + } + +data CompletionChoice = CompletionChoice + { cchText :: T.Text, + cchIndex :: Int, + cchLogprobs :: Maybe (V.Vector Double), + cchFinishReason :: Maybe T.Text + } + deriving (Show, Eq) + +data CompletionResponse = CompletionResponse + { crId :: T.Text, + crObject :: T.Text, + crCreated :: Int, + crModel :: ModelId, + crChoices :: [CompletionChoice], + crUsage :: A.Object + } + deriving (Show, Eq) + + +$(deriveJSON (jsonOpts 3) ''CompletionCreate) +$(deriveJSON (jsonOpts 3) ''CompletionChoice) +$(deriveJSON (jsonOpts 2) ''CompletionResponse) + +------------------------ +------ Chat API +------------------------ + +data ChatMessage = ChatMessage + { chmContent :: T.Text, + chmRole :: T.Text + } + deriving (Show, Eq) + +data ChatCompletionRequest = ChatCompletionRequest + { chcrModel :: ModelId, + chcrMessages :: [ChatMessage], + chcrTemperature :: Maybe Double, + chcrTopP :: Maybe Double, + chcrN :: Maybe Int, + chcrStream :: Maybe Bool, + chcrStop :: Maybe (V.Vector T.Text), + chcrMaxTokens :: Maybe Int, + chcrPresencePenalty :: Maybe Double, + chcrFrequencyPenalty :: Maybe Double, + chcrLogitBias :: Maybe (V.Vector Double), + chcrUser :: Maybe String + } + deriving (Show, Eq) + +defaultChatCompletionRequest :: ModelId -> [ChatMessage] -> ChatCompletionRequest +defaultChatCompletionRequest model messages = + ChatCompletionRequest + { chcrModel = model, + chcrMessages = messages, + chcrTemperature = Nothing, + chcrTopP = Nothing, + chcrN = Nothing, + chcrStream = Nothing, + chcrStop = Nothing, + chcrMaxTokens = Nothing, + chcrPresencePenalty = Nothing, + chcrFrequencyPenalty = Nothing, + chcrLogitBias = Nothing, + chcrUser = Nothing + } + +data ChatChoice = ChatChoice + { chchIndex :: Int, + chchMessage :: ChatMessage, + chchFinishReason :: Maybe T.Text + } + deriving (Show, Eq) + +data ChatResponse = ChatResponse + { chrId :: T.Text, + chrObject :: T.Text, + chrCreated :: Int, + chrChoices :: [ChatChoice], + chrUsage :: Usage + } + +$(deriveJSON (jsonOpts 3) ''ChatMessage) +$(deriveJSON (jsonOpts 4) ''ChatCompletionRequest) +$(deriveJSON (jsonOpts 4) ''ChatChoice) +$(deriveJSON (jsonOpts 3) ''ChatResponse) + +------------------------ +------ Edits API +------------------------ + +data EditCreate = EditCreate + { edcrModel :: ModelId, + edcrInput :: Maybe T.Text, + edcrInstruction :: T.Text, + edcrN :: Maybe Int, + edcrTemperature :: Maybe Double, + edcrTopP :: Maybe Double + } + deriving (Show, Eq) + +defaultEditCreate :: ModelId -> T.Text -> T.Text -> EditCreate +defaultEditCreate model input instruction = + EditCreate + { edcrModel = model, + edcrInput = Just input, + edcrInstruction = instruction, + edcrN = Nothing, + edcrTemperature = Nothing, + edcrTopP = Nothing + } + +data EditChoice = EditChoice + { edchText :: T.Text, + edchIndex :: Int + } + deriving (Show, Eq) + +data EditResponse = EditResponse + { edrObject :: T.Text, + edrCreated :: Int, + edrChoices :: [EditChoice], + edrUsage :: Usage + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 4) ''EditCreate) +$(deriveJSON (jsonOpts 4) ''EditChoice) +$(deriveJSON (jsonOpts 3) ''EditResponse) + +------------------------ +------ Images API +------------------------ + +data ImageResponseData = ImageResponseData + { irdUrl :: T.Text + } + deriving (Show, Eq) + +data ImageResponse = ImageResponse + { irCreated :: TimeStamp, + irData :: [ImageResponseData] + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 3) ''ImageResponseData) +$(deriveJSON (jsonOpts 2) ''ImageResponse) + +-- | Image create API + +data ImageCreate = ImageCreate + { icPrompt :: T.Text, + icN :: Maybe Int, + icSize :: Maybe T.Text, + icResponseFormat :: Maybe T.Text, + icUser :: Maybe T.Text + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 2) ''ImageCreate) + +-- | Image edit API + +data ImageEditRequest = ImageEditRequest + { ierImage :: T.Text, + ierMask :: Maybe T.Text, + ierPrompt :: T.Text, + ierN :: Maybe Int, + ierSize :: Maybe T.Text, + ierResponseFormat :: Maybe T.Text, + ierUser :: Maybe T.Text + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 3) ''ImageEditRequest) + +-- | Image variation API + +data ImageVariationRequest = ImageVariationRequest + { ivrImage :: T.Text, + ivrN :: Maybe Int, + ivrSize :: Maybe T.Text, + ivrResponseFormat :: Maybe T.Text, + ivrUser :: Maybe T.Text + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 3) ''ImageVariationRequest) + +------------------------ +------ Embeddings API +------------------------ + +data EmbeddingCreate = EmbeddingCreate + { embcModel :: ModelId, + embcInput :: T.Text, -- TODO (2023.02.23): Extend to allow taking in array of strings or token arrays + embcUser :: Maybe T.Text + } + deriving (Show, Eq) + +data EmbeddingResponseData = EmbeddingResponseData + { embdObject :: T.Text, + embdEmbedding :: V.Vector Double, + embdIndex :: Int + } + deriving (Show, Eq) + +data EmbeddingUsage = EmbeddingUsage + { embuPromptTokens :: Int, + embuTotalTokens :: Int + } + deriving (Show, Eq) + +data EmbeddingResponse = EmbeddingResponse + { embrObject :: T.Text, + embrData :: [EmbeddingResponseData], + embrModel :: ModelId, + embrUsage :: EmbeddingUsage + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 4) ''EmbeddingCreate) +$(deriveJSON (jsonOpts 4) ''EmbeddingResponseData) +$(deriveJSON (jsonOpts 4) ''EmbeddingUsage) +$(deriveJSON (jsonOpts 4) ''EmbeddingResponse) + + +------------------------ +------ Audio API +------------------------ + + +data AudioResponseData = AudioResponseData + { audrdText :: T.Text + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 5) ''AudioResponseData) + +-- | Audio create API + +data AudioTranscriptionRequest = AudioTranscriptionRequest + { audtsrFile :: T.Text, + audtsrModel :: ModelId, + audtsrPrompt :: Maybe T.Text, + audtsrResponseFormat :: Maybe T.Text, + audtsrTemperature :: Maybe Double, + audtsrLanguage :: Maybe T.Text + } + deriving (Show, Eq) + + +$(deriveJSON (jsonOpts 6) ''AudioTranscriptionRequest) + +-- | Audio translation API + +data AudioTranslationRequest = AudioTranslationRequest + { audtlrFile :: T.Text, + audtlrModel :: ModelId, + audtlrPrompt :: Maybe T.Text, + audtlrResponseFormat :: Maybe T.Text, + audtlrTemperature :: Maybe Double + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 6) ''AudioTranslationRequest) + + +------------------------ +------ Files API +------------------------ + +data SearchHunk = SearchHunk + { shText :: T.Text, + shMetadata :: Maybe T.Text + } + deriving (Show, Eq) + +data ClassificationHunk = ClassificationHunk + { chText :: T.Text, + chLabel :: T.Text + } + deriving (Show, Eq) + +data FineTuneHunk = FineTuneHunk + { fthPrompt :: T.Text, + fthCompletion :: T.Text + } + deriving (Show, Eq) + +data FileHunk + = FhSearch SearchHunk + | FhClassifications ClassificationHunk + | FhFineTune FineTuneHunk + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 2) ''SearchHunk) +$(deriveJSON (jsonOpts 2) ''ClassificationHunk) +$(deriveJSON (jsonOpts 3) ''FineTuneHunk) + + +newtype FileId = FileId {unFileId :: T.Text} + deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) + +data File = File + { fId :: FileId, + fObject :: T.Text, + fBytes :: Int, + fCreatedAt :: TimeStamp, + fFilename :: T.Text, + fPurpose :: T.Text + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 1) ''File) + +-- | File upload API + +data FileCreate = FileCreate + { fcPurpose :: T.Text, + fcDocuments :: [FileHunk] + } + deriving (Show, Eq) + +packDocuments :: [FileHunk] -> BSL.ByteString +packDocuments docs = + BSL.intercalate "\n" $ + map + ( \t -> A.encode $ + case t of + FhSearch x -> A.toJSON x + FhClassifications x -> A.toJSON x + FhFineTune x -> A.toJSON x + ) + docs + +instance ToMultipart Mem FileCreate where + toMultipart rfc = + MultipartData + [ Input "purpose" (fcPurpose rfc) + ] + [ FileData "file" "data.jsonl" "application/json" (packDocuments $ fcDocuments rfc) + ] + + +-- | File delete API + +data FileDeleteConfirmation = FileDeleteConfirmation + { fdcId :: FileId + } + deriving (Show, Eq) + +$(deriveJSON (jsonOpts 3) ''FileDeleteConfirmation) + +-- | File retrieve API +-- TODO + +-- | File retrieve content API +-- TODO + +------------------------ +------ Engine API (deprecated) +------------------------ + newtype EngineId = EngineId {unEngineId :: T.Text} deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) @@ -102,6 +583,13 @@ data Engine = Engine } deriving (Show, Eq) + +$(deriveJSON (jsonOpts 1) ''Engine) + +------------------------ +------ Engine completions API (deprecated) +------------------------ + newtype TextCompletionId = TextCompletionId {unTextCompletionId :: T.Text} deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) @@ -137,8 +625,8 @@ data TextCompletionCreate = TextCompletionCreate deriving (Show, Eq) -- | Applies API defaults, only passing a prompt. -defaultTextCompletionCreate :: T.Text -> TextCompletionCreate -defaultTextCompletionCreate prompt = +defaultEngineTextCompletionCreate :: T.Text -> TextCompletionCreate +defaultEngineTextCompletionCreate prompt = TextCompletionCreate { tccrPrompt = prompt, tccrMaxTokens = Nothing, @@ -153,14 +641,31 @@ defaultTextCompletionCreate prompt = tccrBestOf = Nothing } -data EmbeddingCreate = EmbeddingCreate - {ecInput :: T.Text} +$(deriveJSON (jsonOpts 3) ''TextCompletionChoice) +$(deriveJSON (jsonOpts 2) ''TextCompletion) +$(deriveJSON (jsonOpts 4) ''TextCompletionCreate) + + +------------------------ +------ EngineEmbeddings API (deprecated) +------------------------ + +data EngineEmbeddingCreate = EngineEmbeddingCreate + {enecInput :: T.Text} deriving (Show, Eq) -data Embedding = Embedding - {eEmbedding :: V.Vector Double, eIndex :: Int} +data EngineEmbedding = EngineEmbedding + {eneEngineEmbedding :: V.Vector Double, eneIndex :: Int} deriving (Show, Eq) +$(deriveJSON (jsonOpts 4) ''EngineEmbeddingCreate) +$(deriveJSON (jsonOpts 3) ''EngineEmbedding) + +------------------------ +------ Old stuff; not touching +------ TODO 2023.03.22: Not touching this; unchanged since last year +------------------------ + newtype FineTuneId = FineTuneId {unFineTuneId :: T.Text} deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) @@ -225,51 +730,8 @@ data SearchResultCreate = SearchResultCreate } deriving (Show, Eq) -data SearchHunk = SearchHunk - { shText :: T.Text, - shMetadata :: Maybe T.Text - } - deriving (Show, Eq) - -data ClassificationHunk = ClassificationHunk - { chText :: T.Text, - chLabel :: T.Text - } - deriving (Show, Eq) -data FineTuneHunk = FineTuneHunk - { fthPrompt :: T.Text, - fthCompletion :: T.Text - } - deriving (Show, Eq) - -data FileHunk - = FhSearch SearchHunk - | FhClassifications ClassificationHunk - | FhFineTune FineTuneHunk - deriving (Show, Eq) - -data FileCreate = FileCreate - { fcPurpose :: T.Text, - fcDocuments :: [FileHunk] - } - deriving (Show, Eq) - -newtype FileId = FileId {unFileId :: T.Text} - deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) - -data File = File - { fId :: FileId, - fCreatedAt :: TimeStamp, - fStatus :: T.Text, - fPurpose :: T.Text - } - deriving (Show, Eq) - -data FileDeleteConfirmation = FileDeleteConfirmation - { fdcId :: FileId - } - deriving (Show, Eq) +-- | Answers API data AnswerReq = AnswerReq { arFile :: Maybe FileId, @@ -288,42 +750,11 @@ data AnswerResp = AnswerResp } deriving (Show, Eq) -$(deriveJSON (jsonOpts 2) ''OpenAIList) -$(deriveJSON (jsonOpts 1) ''Engine) -$(deriveJSON (jsonOpts 3) ''TextCompletionChoice) -$(deriveJSON (jsonOpts 2) ''TextCompletion) -$(deriveJSON (jsonOpts 4) ''TextCompletionCreate) + $(deriveJSON (jsonOpts 2) ''SearchResult) $(deriveJSON (jsonOpts 4) ''SearchResultCreate) -$(deriveJSON (jsonOpts 1) ''File) -$(deriveJSON (jsonOpts 3) ''FileDeleteConfirmation) $(deriveJSON (jsonOpts 2) ''AnswerReq) $(deriveJSON (jsonOpts 3) ''AnswerResp) -$(deriveJSON (jsonOpts 2) ''EmbeddingCreate) -$(deriveJSON (jsonOpts 1) ''Embedding) $(deriveJSON (jsonOpts 3) ''FineTuneCreate) $(deriveJSON (jsonOpts 3) ''FineTuneEvent) $(deriveJSON (jsonOpts 2) ''FineTune) -$(deriveJSON (jsonOpts 2) ''SearchHunk) -$(deriveJSON (jsonOpts 2) ''ClassificationHunk) -$(deriveJSON (jsonOpts 3) ''FineTuneHunk) - -packDocuments :: [FileHunk] -> BSL.ByteString -packDocuments docs = - BSL.intercalate "\n" $ - map - ( \t -> A.encode $ - case t of - FhSearch x -> A.toJSON x - FhClassifications x -> A.toJSON x - FhFineTune x -> A.toJSON x - ) - docs - -instance ToMultipart Mem FileCreate where - toMultipart rfc = - MultipartData - [ Input "purpose" (fcPurpose rfc) - ] - [ FileData "file" "data.jsonl" "application/json" (packDocuments $ fcDocuments rfc) - ] From c4c064941b0f0c5211489044d547b1c9410c400f Mon Sep 17 00:00:00 2001 From: Alexander Thiemann Date: Sat, 1 Apr 2023 18:37:10 -0700 Subject: [PATCH 02/18] some cleanup --- openai-hs/src/OpenAI/Client.hs | 98 ++++++++++------------ openai-hs/test/ApiSpec.hs | 107 +++++-------------------- openai-servant/src/OpenAI/Api.hs | 25 +++--- openai-servant/src/OpenAI/Resources.hs | 96 ++-------------------- 4 files changed, 77 insertions(+), 249 deletions(-) diff --git a/openai-hs/src/OpenAI/Client.hs b/openai-hs/src/OpenAI/Client.hs index bd4bacf..53af832 100644 --- a/openai-hs/src/OpenAI/Client.hs +++ b/openai-hs/src/OpenAI/Client.hs @@ -13,10 +13,9 @@ module OpenAI.Client OpenAIList (..), Usage (..), - -- * Models - Model(..), - ModelId(..), + Model (..), + ModelId (..), listModels, getModel, @@ -25,7 +24,7 @@ module OpenAI.Client CompletionChoice (..), CompletionResponse (..), defaultCompletionCreate, - completeText, + completeText, -- * Chat ChatMessage (..), @@ -97,27 +96,15 @@ module OpenAI.Client cancelFineTune, listFineTuneEvents, - -- * Searching (out of date) - SearchResult (..), - SearchResultCreate (..), - searchDocuments, - -- * File API (out of date) FileCreate (..), File (..), FileId (..), FileHunk (..), - SearchHunk (..), - ClassificationHunk (..), FineTuneHunk (..), FileDeleteConfirmation (..), createFile, deleteFile, - - -- * Answer API (out of date) - getAnswer, - AnswerReq (..), - AnswerResp (..), ) where @@ -173,24 +160,23 @@ openaiBaseUrl = BaseUrl Https "api.openai.com" 443 "" N :: OpenAIClient -> ARG -> ARG2 -> IO (Either ClientError R);\ N sc a b = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a b) (mkClientEnv (scManager sc) openaiBaseUrl) +EP0 (listModels, (OpenAIList Model)) +EP1 (getModel, ModelId, Model) -EP0(listModels, (OpenAIList Model)) -EP1(getModel, ModelId, Model) - -EP1(completeText, CompletionCreate, CompletionResponse) +EP1 (completeText, CompletionCreate, CompletionResponse) -EP1(completeChat, ChatCompletionRequest, ChatResponse) +EP1 (completeChat, ChatCompletionRequest, ChatResponse) -EP1(createTextEdit, EditCreate, EditResponse) +EP1 (createTextEdit, EditCreate, EditResponse) -EP1(generateImage, ImageCreate, ImageResponse) -EP1(createImageEdit, ImageEditRequest, ImageResponse) -EP1(createImageVariation, ImageVariationRequest, ImageResponse) +EP1 (generateImage, ImageCreate, ImageResponse) +EP1 (createImageEdit, ImageEditRequest, ImageResponse) +EP1 (createImageVariation, ImageVariationRequest, ImageResponse) -EP1(createEmbedding, EmbeddingCreate, EmbeddingResponse) +EP1 (createEmbedding, EmbeddingCreate, EmbeddingResponse) -EP1(createTranscription, AudioTranscriptionRequest, AudioResponseData) -EP1(createAudioTranslation, AudioTranslationRequest, AudioResponseData) +EP1 (createTranscription, AudioTranscriptionRequest, AudioResponseData) +EP1 (createAudioTranslation, AudioTranslationRequest, AudioResponseData) createFile :: OpenAIClient -> FileCreate -> IO (Either ClientError File) createFile sc rfc = @@ -201,44 +187,42 @@ createFile sc rfc = EP1 (createFileInternal, (BSL.ByteString, FileCreate), File) EP1 (deleteFile, FileId, FileDeleteConfirmation) -EP1 (getAnswer, AnswerReq, AnswerResp) - EP1 (createFineTune, FineTuneCreate, FineTune) EP0 (listFineTunes, (OpenAIList FineTune)) EP1 (getFineTune, FineTuneId, FineTune) EP1 (cancelFineTune, FineTuneId, FineTune) EP1 (listFineTuneEvents, FineTuneId, (OpenAIList FineTuneEvent)) - EP0 (listEngines, (OpenAIList Engine)) EP1 (getEngine, EngineId, Engine) EP2 (engineCompleteText, EngineId, TextCompletionCreate, TextCompletion) -EP2 (searchDocuments, EngineId, SearchResultCreate, (OpenAIList SearchResult)) EP2 (engineCreateEmbedding, EngineId, EngineEmbeddingCreate, (OpenAIList EngineEmbedding)) - -( ( listModels' - :<|> getModel') - :<|> (completeText') - :<|> (completeChat') - :<|> (createTextEdit') - :<|> ( generateImage' - :<|> createImageEdit' - :<|> createImageVariation') - :<|> ( createEmbedding' ) - :<|> ( createTranscription' - :<|> createAudioTranslation') - :<|> (createFileInternal' :<|> deleteFile') - :<|> getAnswer' - :<|> ( createFineTune' - :<|> listFineTunes' - :<|> getFineTune' - :<|> cancelFineTune' - :<|> listFineTuneEvents' - ) - :<|> ( listEngines' - :<|> getEngine' - :<|> engineCompleteText' - :<|> searchDocuments' - :<|> engineCreateEmbedding')) = +( ( listModels' + :<|> getModel' + ) + :<|> (completeText') + :<|> (completeChat') + :<|> (createTextEdit') + :<|> ( generateImage' + :<|> createImageEdit' + :<|> createImageVariation' + ) + :<|> (createEmbedding') + :<|> ( createTranscription' + :<|> createAudioTranslation' + ) + :<|> (createFileInternal' :<|> deleteFile') + :<|> ( createFineTune' + :<|> listFineTunes' + :<|> getFineTune' + :<|> cancelFineTune' + :<|> listFineTuneEvents' + ) + :<|> ( listEngines' + :<|> getEngine' + :<|> engineCompleteText' + :<|> engineCreateEmbedding' + ) + ) = client api diff --git a/openai-hs/test/ApiSpec.hs b/openai-hs/test/ApiSpec.hs index 323ca1e..c386c8c 100644 --- a/openai-hs/test/ApiSpec.hs +++ b/openai-hs/test/ApiSpec.hs @@ -27,7 +27,6 @@ apiSpec = do describe "2022 core api" apiTests2022 describe "March 2023 core API" apiTests2023 - --------------------------------- ------- 2023 API tests ---------- --------------------------------- @@ -48,26 +47,36 @@ apiTests2023 = describe "completions api" $ do it "create completion" $ \cli -> do - let completion = (defaultCompletionCreate (ModelId "text-ada-001") "The opposite of up is") - {ccrMaxTokens = Just 1, ccrTemperature = Just 0.1, ccrN = Just 1} + let completion = + (defaultCompletionCreate (ModelId "text-ada-001") "The opposite of up is") + { ccrMaxTokens = Just 1, + ccrTemperature = Just 0.1, + ccrN = Just 1 + } res <- forceSuccess $ completeText cli completion crChoices res `shouldNotBe` [] cchText (head (crChoices res)) `shouldBe` " down" describe "chat api" $ do it "create chat completion" $ \cli -> do - let completion = defaultChatCompletionRequest (ModelId "gpt-3.5-turbo") - [ChatMessage {chmRole="user", - chmContent="What is the opposite of up? Answer in one word." - }] + let completion = + defaultChatCompletionRequest + (ModelId "gpt-3.5-turbo") + [ ChatMessage + { chmRole = "user", + chmContent = "What is the opposite of up? Answer in one word." + } + ] res <- forceSuccess $ completeChat cli completion chrChoices res `shouldNotBe` [] chmContent (chchMessage (head (chrChoices res))) `shouldBe` "Down." describe "edits api" $ do it "create edit" $ \cli -> do - let edit = (defaultEditCreate (ModelId "text-davinci-edit-001") "Fox" "Pluralize the word") - {edcrN = Just 1} + let edit = + (defaultEditCreate (ModelId "text-davinci-edit-001") "Fox" "Pluralize the word") + { edcrN = Just 1 + } res <- forceSuccess $ createTextEdit cli edit edrChoices res `shouldNotBe` [] edchText (head $ edrChoices res) `shouldBe` "Foxes\n" @@ -76,12 +85,11 @@ apiTests2023 = describe "embeddings api" $ do it "create embeddings" $ \cli -> do - let embedding = EmbeddingCreate {embcModel=ModelId "text-embedding-ada-002", embcInput="Hello",embcUser=Nothing} + let embedding = EmbeddingCreate {embcModel = ModelId "text-embedding-ada-002", embcInput = "Hello", embcUser = Nothing} res <- forceSuccess $ createEmbedding cli embedding embrData res `shouldNotBe` [] V.length (embdEmbedding (head $ embrData res)) `shouldBe` 1536 - --------------------------------- ------- 2022 API tests ---------- --------------------------------- @@ -92,45 +100,15 @@ apiTests2022 = do describe "file api" $ do - -- TODO 2023.03.22: This test is broken on old commit. Did not investigate it "allows creating one" $ \cli -> do let file = FileCreate - { fcPurpose = "search", - fcDocuments = [FhSearch $ SearchHunk "Test 1" Nothing, FhSearch $ SearchHunk "text 2" (Just "foo")] + { fcPurpose = "fune-ftTunedModel FineTune", + fcDocuments = [FhFineTune $ FineTuneHunk "a" "b"] } _ <- forceSuccess $ createFile cli file pure () - describe "answer api" $ - do - -- TODO 2023.03.22: This test is broken on old commit. Did not investigate - it "works" $ \cli -> - do - let file = - FileCreate - { fcPurpose = "search", - fcDocuments = - [ FhSearch $ SearchHunk "Cities in California: San Francisco, Los Angeles" (Just "cali"), - FhSearch $ SearchHunk "Tasty fruit: Apple, Orange" (Just "fruit"), - FhSearch $ SearchHunk "Cities in Germany: Freiburg, Berlin" (Just "germany") - ] - } - res <- forceSuccess $ createFile cli file - let searchReq = - AnswerReq - { arFile = Just (fId res), - arDocuments = Nothing, - arQuestion = "Where is San Francisco?", - arSearchModel = EngineId "babbage", - arModel = EngineId "davinci", - arExamplesContext = "Good programming languages: Haskell, PureScript", - arExamples = [["Is PHP a good programming language?", "No, sorry."]], - arReturnMetadata = True - } - answerRes <- forceSuccess $ getAnswer cli searchReq - T.unpack (head (arsAnswers answerRes)) `shouldContain` ("California" :: String) - pure () describe "embeddings" $ do it "computes embeddings" $ \cli -> do res <- forceSuccess $ engineCreateEmbedding cli (EngineId "babbage-similarity") (EngineEmbeddingCreate "This is nice") @@ -176,46 +154,3 @@ apiTests2022 = } V.length (tcChoices completionResults) `shouldBe` 1 T.length (tccText (V.head (tcChoices completionResults))) `shouldNotBe` 0 - describe "document search" $ - do - -- TODO 2023.03.22: This test is broken on old commit. Did not investigate - it "works (smoke test)" $ \cli -> - do - firstEngine <- V.head . olData <$> forceSuccess (listEngines cli) - searchResults <- - forceSuccess $ - searchDocuments cli (eId firstEngine) $ - SearchResultCreate - { sccrDocuments = Just $ V.fromList ["pool", "gym", "night club"], - sccrFile = Nothing, - sccrQuery = "swimmer", - sccrReturnMetadata = False - } - V.length (olData searchResults) `shouldBe` 3 - describe "file based document search" $ - do - -- TODO 2023.03.22: This test is broken on old commit. Did not investigate - it "works" $ \cli -> - do - let file = - FileCreate - { fcPurpose = "search", - fcDocuments = - [ FhSearch $ SearchHunk "pool" (Just "pool"), - FhSearch $ SearchHunk "gym" (Just "gym"), - FhSearch $ SearchHunk "night club" (Just "nc") - ] - } - createRes <- forceSuccess $ createFile cli file - let searchReq = - SearchResultCreate - { sccrFile = Just (fId createRes), - sccrDocuments = Nothing, - sccrQuery = "pool", - sccrReturnMetadata = True - } - searchRes <- forceSuccess $ searchDocuments cli (EngineId "ada") searchReq - let res = V.head (olData searchRes) - srDocument res `shouldBe` 0 -- pool - srMetadata res `shouldBe` Just "pool" - pure () diff --git a/openai-servant/src/OpenAI/Api.hs b/openai-servant/src/OpenAI/Api.hs index 1bd75f4..b755fbd 100644 --- a/openai-servant/src/OpenAI/Api.hs +++ b/openai-servant/src/OpenAI/Api.hs @@ -11,7 +11,7 @@ type OpenAIApi = "v1" :> OpenAIApiInternal type OpenAIApiInternal = - "models" :> ModelsApi + "models" :> ModelsApi :<|> "completions" :> CompletionsApi :<|> "chat" :> ChatApi :<|> "edits" :> EditsApi @@ -19,12 +19,11 @@ type OpenAIApiInternal = :<|> "embeddings" :> EmbeddingsApi :<|> "audio" :> AudioApi :<|> "files" :> FilesApi - :<|> AnswerApi :<|> FineTuneApi - :<|> "engines" :> EnginesApi + :<|> "engines" :> EnginesApi -type ModelsApi = - OpenAIAuth :> Get '[JSON] (OpenAIList Model) +type ModelsApi = + OpenAIAuth :> Get '[JSON] (OpenAIList Model) :<|> OpenAIAuth :> Capture "model_id" ModelId :> Get '[JSON] Model type CompletionsApi = @@ -37,24 +36,21 @@ type EditsApi = OpenAIAuth :> ReqBody '[JSON] EditCreate :> Post '[JSON] EditResponse type ImagesApi = - OpenAIAuth :> "generations" :> ReqBody '[JSON] ImageCreate :> Post '[JSON] ImageResponse - :<|> OpenAIAuth :> "edits" :> ReqBody '[JSON] ImageEditRequest :> Post '[JSON] ImageResponse - :<|> OpenAIAuth :> "variations" :> ReqBody '[JSON] ImageVariationRequest :> Post '[JSON] ImageResponse + OpenAIAuth :> "generations" :> ReqBody '[JSON] ImageCreate :> Post '[JSON] ImageResponse + :<|> OpenAIAuth :> "edits" :> ReqBody '[JSON] ImageEditRequest :> Post '[JSON] ImageResponse + :<|> OpenAIAuth :> "variations" :> ReqBody '[JSON] ImageVariationRequest :> Post '[JSON] ImageResponse type EmbeddingsApi = OpenAIAuth :> ReqBody '[JSON] EmbeddingCreate :> Post '[JSON] EmbeddingResponse type AudioApi = - OpenAIAuth :> "transcriptions" :> ReqBody '[JSON] AudioTranscriptionRequest :> Post '[JSON] AudioResponseData - :<|> OpenAIAuth :> "translations" :> ReqBody '[JSON] AudioTranslationRequest :> Post '[JSON] AudioResponseData - + OpenAIAuth :> "transcriptions" :> ReqBody '[JSON] AudioTranscriptionRequest :> Post '[JSON] AudioResponseData + :<|> OpenAIAuth :> "translations" :> ReqBody '[JSON] AudioTranslationRequest :> Post '[JSON] AudioResponseData + type FilesApi = OpenAIAuth :> MultipartForm Mem FileCreate :> Post '[JSON] File :<|> OpenAIAuth :> Capture "file_id" FileId :> Delete '[JSON] FileDeleteConfirmation -type AnswerApi = - "answers" :> OpenAIAuth :> ReqBody '[JSON] AnswerReq :> Post '[JSON] AnswerResp - type FineTuneApi = OpenAIAuth :> "fine-tunes" :> ReqBody '[JSON] FineTuneCreate :> Post '[JSON] FineTune :<|> OpenAIAuth :> "fine-tunes" :> Get '[JSON] (OpenAIList FineTune) @@ -66,5 +62,4 @@ type EnginesApi = OpenAIAuth :> Get '[JSON] (OpenAIList Engine) :<|> OpenAIAuth :> Capture "engine_id" EngineId :> Get '[JSON] Engine :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "completions" :> ReqBody '[JSON] TextCompletionCreate :> Post '[JSON] TextCompletion - :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "search" :> ReqBody '[JSON] SearchResultCreate :> Post '[JSON] (OpenAIList SearchResult) :<|> OpenAIAuth :> Capture "engine_id" EngineId :> "embeddings" :> ReqBody '[JSON] EngineEmbeddingCreate :> Post '[JSON] (OpenAIList EngineEmbedding) diff --git a/openai-servant/src/OpenAI/Resources.hs b/openai-servant/src/OpenAI/Resources.hs index e062548..38e54d5 100644 --- a/openai-servant/src/OpenAI/Resources.hs +++ b/openai-servant/src/OpenAI/Resources.hs @@ -1,6 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TemplateHaskell #-} module OpenAI.Resources ( -- * Core Types @@ -9,8 +9,8 @@ module OpenAI.Resources Usage (..), -- * Models - Model(..), - ModelId(..), + Model (..), + ModelId (..), -- * Completion CompletionCreate (..), @@ -56,29 +56,18 @@ module OpenAI.Resources FineTune (..), FineTuneEvent (..), - -- * Searching (out of date) - SearchResult (..), - SearchResultCreate (..), - -- * File API (out of date) FileCreate (..), FileId (..), File (..), FileHunk (..), - SearchHunk (..), - ClassificationHunk (..), FineTuneHunk (..), FileDeleteConfirmation (..), - -- * Engine (deprecated) EngineId (..), Engine (..), - -- * Engine Answers API (deprecated) - AnswerReq (..), - AnswerResp (..), - -- * Engine text completion (deprecated) TextCompletionId (..), TextCompletionChoice (..), @@ -139,8 +128,7 @@ instance Applicative OpenAIList where $(deriveJSON (jsonOpts 2) ''OpenAIList) data Usage = Usage - { - usPromptTokens :: Int, + { usPromptTokens :: Int, usCompletionTokens :: Int, usTotalTokens :: Int } @@ -228,7 +216,6 @@ data CompletionResponse = CompletionResponse } deriving (Show, Eq) - $(deriveJSON (jsonOpts 3) ''CompletionCreate) $(deriveJSON (jsonOpts 3) ''CompletionChoice) $(deriveJSON (jsonOpts 2) ''CompletionResponse) @@ -358,7 +345,6 @@ $(deriveJSON (jsonOpts 3) ''ImageResponseData) $(deriveJSON (jsonOpts 2) ''ImageResponse) -- | Image create API - data ImageCreate = ImageCreate { icPrompt :: T.Text, icN :: Maybe Int, @@ -371,7 +357,6 @@ data ImageCreate = ImageCreate $(deriveJSON (jsonOpts 2) ''ImageCreate) -- | Image edit API - data ImageEditRequest = ImageEditRequest { ierImage :: T.Text, ierMask :: Maybe T.Text, @@ -386,7 +371,6 @@ data ImageEditRequest = ImageEditRequest $(deriveJSON (jsonOpts 3) ''ImageEditRequest) -- | Image variation API - data ImageVariationRequest = ImageVariationRequest { ivrImage :: T.Text, ivrN :: Maybe Int, @@ -435,12 +419,10 @@ $(deriveJSON (jsonOpts 4) ''EmbeddingResponseData) $(deriveJSON (jsonOpts 4) ''EmbeddingUsage) $(deriveJSON (jsonOpts 4) ''EmbeddingResponse) - ------------------------ ------ Audio API ------------------------ - data AudioResponseData = AudioResponseData { audrdText :: T.Text } @@ -449,7 +431,6 @@ data AudioResponseData = AudioResponseData $(deriveJSON (jsonOpts 5) ''AudioResponseData) -- | Audio create API - data AudioTranscriptionRequest = AudioTranscriptionRequest { audtsrFile :: T.Text, audtsrModel :: ModelId, @@ -460,11 +441,9 @@ data AudioTranscriptionRequest = AudioTranscriptionRequest } deriving (Show, Eq) - $(deriveJSON (jsonOpts 6) ''AudioTranscriptionRequest) -- | Audio translation API - data AudioTranslationRequest = AudioTranslationRequest { audtlrFile :: T.Text, audtlrModel :: ModelId, @@ -476,23 +455,10 @@ data AudioTranslationRequest = AudioTranslationRequest $(deriveJSON (jsonOpts 6) ''AudioTranslationRequest) - ------------------------ ------ Files API ------------------------ -data SearchHunk = SearchHunk - { shText :: T.Text, - shMetadata :: Maybe T.Text - } - deriving (Show, Eq) - -data ClassificationHunk = ClassificationHunk - { chText :: T.Text, - chLabel :: T.Text - } - deriving (Show, Eq) - data FineTuneHunk = FineTuneHunk { fthPrompt :: T.Text, fthCompletion :: T.Text @@ -500,16 +466,11 @@ data FineTuneHunk = FineTuneHunk deriving (Show, Eq) data FileHunk - = FhSearch SearchHunk - | FhClassifications ClassificationHunk - | FhFineTune FineTuneHunk + = FhFineTune FineTuneHunk deriving (Show, Eq) -$(deriveJSON (jsonOpts 2) ''SearchHunk) -$(deriveJSON (jsonOpts 2) ''ClassificationHunk) $(deriveJSON (jsonOpts 3) ''FineTuneHunk) - newtype FileId = FileId {unFileId :: T.Text} deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) @@ -526,7 +487,6 @@ data File = File $(deriveJSON (jsonOpts 1) ''File) -- | File upload API - data FileCreate = FileCreate { fcPurpose :: T.Text, fcDocuments :: [FileHunk] @@ -539,8 +499,6 @@ packDocuments docs = map ( \t -> A.encode $ case t of - FhSearch x -> A.toJSON x - FhClassifications x -> A.toJSON x FhFineTune x -> A.toJSON x ) docs @@ -553,9 +511,7 @@ instance ToMultipart Mem FileCreate where [ FileData "file" "data.jsonl" "application/json" (packDocuments $ fcDocuments rfc) ] - -- | File delete API - data FileDeleteConfirmation = FileDeleteConfirmation { fdcId :: FileId } @@ -583,7 +539,6 @@ data Engine = Engine } deriving (Show, Eq) - $(deriveJSON (jsonOpts 1) ''Engine) ------------------------ @@ -645,7 +600,6 @@ $(deriveJSON (jsonOpts 3) ''TextCompletionChoice) $(deriveJSON (jsonOpts 2) ''TextCompletion) $(deriveJSON (jsonOpts 4) ''TextCompletionCreate) - ------------------------ ------ EngineEmbeddings API (deprecated) ------------------------ @@ -715,46 +669,6 @@ data FineTune = FineTune } deriving (Show, Eq) -data SearchResult = SearchResult - { srDocument :: Int, - srScore :: Double, - srMetadata :: Maybe T.Text - } - deriving (Show, Eq) - -data SearchResultCreate = SearchResultCreate - { sccrFile :: Maybe FileId, - sccrDocuments :: Maybe (V.Vector T.Text), - sccrQuery :: T.Text, - sccrReturnMetadata :: Bool - } - deriving (Show, Eq) - - --- | Answers API - -data AnswerReq = AnswerReq - { arFile :: Maybe FileId, - arDocuments :: Maybe (V.Vector T.Text), - arQuestion :: T.Text, - arSearchModel :: EngineId, - arModel :: EngineId, - arExamplesContext :: T.Text, - arExamples :: [[T.Text]], - arReturnMetadata :: Bool - } - deriving (Show, Eq) - -data AnswerResp = AnswerResp - { arsAnswers :: [T.Text] - } - deriving (Show, Eq) - - -$(deriveJSON (jsonOpts 2) ''SearchResult) -$(deriveJSON (jsonOpts 4) ''SearchResultCreate) -$(deriveJSON (jsonOpts 2) ''AnswerReq) -$(deriveJSON (jsonOpts 3) ''AnswerResp) $(deriveJSON (jsonOpts 3) ''FineTuneCreate) $(deriveJSON (jsonOpts 3) ''FineTuneEvent) $(deriveJSON (jsonOpts 2) ''FineTune) From 42af7e47d3ba4ad95a1a99b3bd3db4704e227134 Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Mon, 17 Apr 2023 12:02:22 +0200 Subject: [PATCH 03/18] Fix Audio APIs The Audio APIs require a multipart/form-data upload. This changes the `audtsrFile` and `audtlrFile` fields to be of type FilePath. --- openai-hs/src/OpenAI/Client.hs | 20 ++++++++++++---- openai-servant/openai-servant.cabal | 1 + openai-servant/package.yaml | 1 + openai-servant/src/OpenAI/Api.hs | 4 ++-- openai-servant/src/OpenAI/Resources.hs | 32 ++++++++++++++++++++++++-- 5 files changed, 50 insertions(+), 8 deletions(-) diff --git a/openai-hs/src/OpenAI/Client.hs b/openai-hs/src/OpenAI/Client.hs index 53af832..b01f816 100644 --- a/openai-hs/src/OpenAI/Client.hs +++ b/openai-hs/src/OpenAI/Client.hs @@ -175,8 +175,20 @@ EP1 (createImageVariation, ImageVariationRequest, ImageResponse) EP1 (createEmbedding, EmbeddingCreate, EmbeddingResponse) -EP1 (createTranscription, AudioTranscriptionRequest, AudioResponseData) -EP1 (createAudioTranslation, AudioTranslationRequest, AudioResponseData) +createTranscription :: OpenAIClient -> AudioTranscriptionRequest -> IO (Either ClientError AudioResponseData) +createTranscription sc atr = + do + bnd <- MP.genBoundary + createTranscriptionInternal sc (bnd, atr) + +createAudioTranslation :: OpenAIClient -> AudioTranslationRequest -> IO (Either ClientError AudioResponseData) +createAudioTranslation sc atr = + do + bnd <- MP.genBoundary + createAudioTranslationInternal sc (bnd, atr) + +EP1 (createTranscriptionInternal, (BSL.ByteString, AudioTranscriptionRequest), AudioResponseData) +EP1 (createAudioTranslationInternal, (BSL.ByteString, AudioTranslationRequest), AudioResponseData) createFile :: OpenAIClient -> FileCreate -> IO (Either ClientError File) createFile sc rfc = @@ -209,8 +221,8 @@ EP2 (engineCreateEmbedding, EngineId, EngineEmbeddingCreate, (OpenAIList EngineE :<|> createImageVariation' ) :<|> (createEmbedding') - :<|> ( createTranscription' - :<|> createAudioTranslation' + :<|> ( createTranscriptionInternal' + :<|> createAudioTranslationInternal' ) :<|> (createFileInternal' :<|> deleteFile') :<|> ( createFineTune' diff --git a/openai-servant/openai-servant.cabal b/openai-servant/openai-servant.cabal index d38ed5d..4ab13b7 100644 --- a/openai-servant/openai-servant.cabal +++ b/openai-servant/openai-servant.cabal @@ -54,6 +54,7 @@ library , base >=4.7 && <5 , bytestring , casing + , mime-types , servant , servant-multipart-api , text diff --git a/openai-servant/package.yaml b/openai-servant/package.yaml index 97f851e..160bd84 100644 --- a/openai-servant/package.yaml +++ b/openai-servant/package.yaml @@ -24,6 +24,7 @@ dependencies: - bytestring - time - vector + - mime-types ghc-options: - -Wall diff --git a/openai-servant/src/OpenAI/Api.hs b/openai-servant/src/OpenAI/Api.hs index b755fbd..9014573 100644 --- a/openai-servant/src/OpenAI/Api.hs +++ b/openai-servant/src/OpenAI/Api.hs @@ -44,8 +44,8 @@ type EmbeddingsApi = OpenAIAuth :> ReqBody '[JSON] EmbeddingCreate :> Post '[JSON] EmbeddingResponse type AudioApi = - OpenAIAuth :> "transcriptions" :> ReqBody '[JSON] AudioTranscriptionRequest :> Post '[JSON] AudioResponseData - :<|> OpenAIAuth :> "translations" :> ReqBody '[JSON] AudioTranslationRequest :> Post '[JSON] AudioResponseData + OpenAIAuth :> "transcriptions" :> MultipartForm Tmp AudioTranscriptionRequest :> Post '[JSON] AudioResponseData + :<|> OpenAIAuth :> "translations" :> MultipartForm Tmp AudioTranslationRequest :> Post '[JSON] AudioResponseData type FilesApi = OpenAIAuth :> MultipartForm Mem FileCreate :> Post '[JSON] File diff --git a/openai-servant/src/OpenAI/Resources.hs b/openai-servant/src/OpenAI/Resources.hs index 38e54d5..3b8f804 100644 --- a/openai-servant/src/OpenAI/Resources.hs +++ b/openai-servant/src/OpenAI/Resources.hs @@ -83,10 +83,13 @@ where import qualified Data.Aeson as A import qualified Data.ByteString.Lazy as BSL +import Data.Maybe (catMaybes) import qualified Data.Text as T +import qualified Data.Text.Encoding as T import Data.Time import Data.Time.Clock.POSIX import qualified Data.Vector as V +import Network.Mime (defaultMimeLookup) import OpenAI.Internal.Aeson import Servant.API import Servant.Multipart.API @@ -432,7 +435,7 @@ $(deriveJSON (jsonOpts 5) ''AudioResponseData) -- | Audio create API data AudioTranscriptionRequest = AudioTranscriptionRequest - { audtsrFile :: T.Text, + { audtsrFile :: FilePath, audtsrModel :: ModelId, audtsrPrompt :: Maybe T.Text, audtsrResponseFormat :: Maybe T.Text, @@ -441,11 +444,24 @@ data AudioTranscriptionRequest = AudioTranscriptionRequest } deriving (Show, Eq) +instance ToMultipart Tmp AudioTranscriptionRequest where + toMultipart atr = + MultipartData + (catMaybes + [ Input "model" . unModelId <$> Just (audtsrModel atr) + , Input "prompt" <$> audtsrPrompt atr + , Input "response_format" <$> audtsrResponseFormat atr + , Input "temperature" . T.pack . show <$> audtsrTemperature atr + , Input "language" <$> audtsrLanguage atr + ]) + [ FileData "file" (T.pack . audtsrFile $ atr) (T.decodeUtf8 . defaultMimeLookup . T.pack $ audtsrFile atr) (audtsrFile atr) + ] + $(deriveJSON (jsonOpts 6) ''AudioTranscriptionRequest) -- | Audio translation API data AudioTranslationRequest = AudioTranslationRequest - { audtlrFile :: T.Text, + { audtlrFile :: FilePath, audtlrModel :: ModelId, audtlrPrompt :: Maybe T.Text, audtlrResponseFormat :: Maybe T.Text, @@ -453,6 +469,18 @@ data AudioTranslationRequest = AudioTranslationRequest } deriving (Show, Eq) +instance ToMultipart Tmp AudioTranslationRequest where + toMultipart atr = + MultipartData + (catMaybes + [ Input "model" . unModelId <$> Just (audtlrModel atr) + , Input "prompt" <$> audtlrPrompt atr + , Input "response_format" <$> audtlrResponseFormat atr + , Input "temperature" . T.pack . show <$> audtlrTemperature atr + ]) + [ FileData "file" (T.pack . audtlrFile $ atr) (T.decodeUtf8 . defaultMimeLookup . T.pack $ audtlrFile atr) (audtlrFile atr) + ] + $(deriveJSON (jsonOpts 6) ''AudioTranslationRequest) ------------------------ From f5ae167b6c565e9009203b3281ca826eda0c936d Mon Sep 17 00:00:00 2001 From: Andrew Lei Date: Mon, 24 Apr 2023 23:02:22 -0700 Subject: [PATCH 04/18] fix example in README --- openai-hs/README.md | 33 +++++++++++++++++++++++++-------- 1 file changed, 25 insertions(+), 8 deletions(-) diff --git a/openai-hs/README.md b/openai-hs/README.md index 3c27eee..77c7e3a 100644 --- a/openai-hs/README.md +++ b/openai-hs/README.md @@ -21,7 +21,27 @@ import OpenAI.Client import Network.HTTP.Client import Network.HTTP.Client.TLS import System.Environment (getEnv) -import qualified Data.Vector as V +import qualified Data.Text as T + +request :: ChatCompletionRequest +request = ChatCompletionRequest + { chcrModel = ModelId "gpt-3.5-turbo" + , chcrMessages = + [ChatMessage { chmContent = "Write a hello world program in Haskell" + , chmRole = "user" + } + ] + , chcrTemperature = Nothing + , chcrTopP = Nothing + , chcrN = Nothing + , chcrStream = Nothing + , chcrStop = Nothing + , chcrMaxTokens = Nothing + , chcrPresencePenalty = Nothing + , chcrFrequencyPenalty = Nothing + , chcrLogitBias = Nothing + , chcrUser = Nothing + } main :: IO () main = @@ -30,13 +50,10 @@ main = -- create a openai client that automatically retries up to 4 times on network -- errors let client = makeOpenAIClient apiKey manager 4 - result <- - searchDocuments cli (eId firstEngine) $ - SearchResultCreate - { sccrDocuments = V.fromList ["pool", "gym", "night club"] - , sccrQuery = "swimmer" - } - print result + result <- completeChat client request + case result of + Left failure -> print failure + Right success -> print $ chrChoices success ``` ## Features From db7f8f8cd07f893550a07b7b6fb7c26ccb2e3a8f Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Sat, 22 Apr 2023 00:26:27 +0200 Subject: [PATCH 05/18] Use bearer authorization --- openai-hs/openai-hs.cabal | 6 ++++-- openai-hs/package.yaml | 1 + openai-hs/src/OpenAI/Client.hs | 17 +++++++++-------- openai-servant/openai-servant.cabal | 6 ++++-- openai-servant/package.yaml | 2 ++ openai-servant/src/OpenAI/Api.hs | 4 +++- 6 files changed, 23 insertions(+), 13 deletions(-) diff --git a/openai-hs/openai-hs.cabal b/openai-hs/openai-hs.cabal index b6b612d..b1eb3b7 100644 --- a/openai-hs/openai-hs.cabal +++ b/openai-hs/openai-hs.cabal @@ -1,10 +1,10 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack -- --- hash: 8760d75e39a4a6db941c2503a8e8519a3c82b52bad91dcf39594cdd9258c7f4b +-- hash: b3b520111ed497869a84db66934450f684e12420b3ca3406cd02fb013d8b2596 name: openai-hs version: 0.2.2.0 @@ -58,6 +58,7 @@ library , http-types , openai-servant >=0.2.1 , servant + , servant-auth-client , servant-client , servant-multipart-client , text @@ -100,6 +101,7 @@ test-suite openai-hs-test , openai-hs , openai-servant >=0.2.1 , servant + , servant-auth-client , servant-client , servant-client-core , servant-multipart-client diff --git a/openai-hs/package.yaml b/openai-hs/package.yaml index ed87bcb..2c52659 100644 --- a/openai-hs/package.yaml +++ b/openai-hs/package.yaml @@ -21,6 +21,7 @@ dependencies: - casing - text - servant + - servant-auth-client - servant-client - servant-multipart-client - http-client diff --git a/openai-hs/src/OpenAI/Client.hs b/openai-hs/src/OpenAI/Client.hs index b01f816..2d768ad 100644 --- a/openai-hs/src/OpenAI/Client.hs +++ b/openai-hs/src/OpenAI/Client.hs @@ -117,6 +117,7 @@ import OpenAI.Api import OpenAI.Client.Internal.Helpers import OpenAI.Resources import Servant.API +import Servant.Auth.Client import Servant.Client import qualified Servant.Multipart.Client as MP @@ -125,7 +126,7 @@ type ApiKey = T.Text -- | Holds a 'Manager' and your API key. data OpenAIClient = OpenAIClient - { scBasicAuthData :: BasicAuthData, + { scToken :: Token, scManager :: Manager, scMaxRetries :: Int } @@ -137,7 +138,7 @@ makeOpenAIClient :: -- | Number of automatic retries the library should attempt. Int -> OpenAIClient -makeOpenAIClient k = OpenAIClient (BasicAuthData "" (T.encodeUtf8 k)) +makeOpenAIClient k = OpenAIClient (Token (T.encodeUtf8 k)) api :: Proxy OpenAIApi api = Proxy @@ -146,19 +147,19 @@ openaiBaseUrl :: BaseUrl openaiBaseUrl = BaseUrl Https "api.openai.com" 443 "" #define EP0(N, R) \ - N##' :: BasicAuthData -> ClientM R;\ + N##' :: Token -> ClientM R;\ N :: OpenAIClient -> IO (Either ClientError R);\ - N sc = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc)) (mkClientEnv (scManager sc) openaiBaseUrl) + N sc = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc)) (mkClientEnv (scManager sc) openaiBaseUrl) #define EP1(N, ARG, R) \ - N##' :: BasicAuthData -> ARG -> ClientM R;\ + N##' :: Token -> ARG -> ClientM R;\ N :: OpenAIClient -> ARG -> IO (Either ClientError R);\ - N sc a = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a) (mkClientEnv (scManager sc) openaiBaseUrl) + N sc a = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc) a) (mkClientEnv (scManager sc) openaiBaseUrl) #define EP2(N, ARG, ARG2, R) \ - N##' :: BasicAuthData -> ARG -> ARG2 -> ClientM R;\ + N##' :: Token -> ARG -> ARG2 -> ClientM R;\ N :: OpenAIClient -> ARG -> ARG2 -> IO (Either ClientError R);\ - N sc a b = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a b) (mkClientEnv (scManager sc) openaiBaseUrl) + N sc a b = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc) a b) (mkClientEnv (scManager sc) openaiBaseUrl) EP0 (listModels, (OpenAIList Model)) EP1 (getModel, ModelId, Model) diff --git a/openai-servant/openai-servant.cabal b/openai-servant/openai-servant.cabal index 4ab13b7..2b9c194 100644 --- a/openai-servant/openai-servant.cabal +++ b/openai-servant/openai-servant.cabal @@ -1,10 +1,10 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack -- --- hash: 27222b6af30e297958d20945ecd4e76ffe7b845bcf5513c5b23251ba3d290b5a +-- hash: 588e067606c40d86380fdece27ded84dbd11ebf9fbd443975bbf12a4555302f5 name: openai-servant version: 0.2.3.0 @@ -56,6 +56,8 @@ library , casing , mime-types , servant + , servant-auth + , servant-auth-client , servant-multipart-api , text , time diff --git a/openai-servant/package.yaml b/openai-servant/package.yaml index 160bd84..c445ba1 100644 --- a/openai-servant/package.yaml +++ b/openai-servant/package.yaml @@ -20,6 +20,8 @@ dependencies: - casing - text - servant + - servant-auth + - servant-auth-client - servant-multipart-api - bytestring - time diff --git a/openai-servant/src/OpenAI/Api.hs b/openai-servant/src/OpenAI/Api.hs index 9014573..a603164 100644 --- a/openai-servant/src/OpenAI/Api.hs +++ b/openai-servant/src/OpenAI/Api.hs @@ -3,9 +3,11 @@ module OpenAI.Api where import OpenAI.Resources import Servant.API +import Servant.Auth +import Servant.Auth.Client import Servant.Multipart.API -type OpenAIAuth = BasicAuth "OpenAI API" () +type OpenAIAuth = Auth '[Bearer] () type OpenAIApi = "v1" :> OpenAIApiInternal From 52f09bfe10b7357c662efba3897dad80d9e94c2f Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Fri, 19 May 2023 21:21:44 +0200 Subject: [PATCH 06/18] Use MonadIO --- openai-hs/src/OpenAI/Client.hs | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/openai-hs/src/OpenAI/Client.hs b/openai-hs/src/OpenAI/Client.hs index b01f816..06a7063 100644 --- a/openai-hs/src/OpenAI/Client.hs +++ b/openai-hs/src/OpenAI/Client.hs @@ -108,6 +108,7 @@ module OpenAI.Client ) where +import Control.Monad.IO.Class (MonadIO(..)) import qualified Data.ByteString.Lazy as BSL import Data.Proxy import qualified Data.Text as T @@ -147,18 +148,18 @@ openaiBaseUrl = BaseUrl Https "api.openai.com" 443 "" #define EP0(N, R) \ N##' :: BasicAuthData -> ClientM R;\ - N :: OpenAIClient -> IO (Either ClientError R);\ - N sc = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc)) (mkClientEnv (scManager sc) openaiBaseUrl) + N :: MonadIO m => OpenAIClient -> m (Either ClientError R);\ + N sc = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc)) (mkClientEnv (scManager sc) openaiBaseUrl) #define EP1(N, ARG, R) \ N##' :: BasicAuthData -> ARG -> ClientM R;\ - N :: OpenAIClient -> ARG -> IO (Either ClientError R);\ - N sc a = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a) (mkClientEnv (scManager sc) openaiBaseUrl) + N :: MonadIO m => OpenAIClient -> ARG -> m (Either ClientError R);\ + N sc a = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a) (mkClientEnv (scManager sc) openaiBaseUrl) #define EP2(N, ARG, ARG2, R) \ N##' :: BasicAuthData -> ARG -> ARG2 -> ClientM R;\ - N :: OpenAIClient -> ARG -> ARG2 -> IO (Either ClientError R);\ - N sc a b = runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a b) (mkClientEnv (scManager sc) openaiBaseUrl) + N :: MonadIO m => OpenAIClient -> ARG -> ARG2 -> m (Either ClientError R);\ + N sc a b = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scBasicAuthData sc) a b) (mkClientEnv (scManager sc) openaiBaseUrl) EP0 (listModels, (OpenAIList Model)) EP1 (getModel, ModelId, Model) @@ -175,25 +176,25 @@ EP1 (createImageVariation, ImageVariationRequest, ImageResponse) EP1 (createEmbedding, EmbeddingCreate, EmbeddingResponse) -createTranscription :: OpenAIClient -> AudioTranscriptionRequest -> IO (Either ClientError AudioResponseData) +createTranscription :: MonadIO m => OpenAIClient -> AudioTranscriptionRequest -> m (Either ClientError AudioResponseData) createTranscription sc atr = do - bnd <- MP.genBoundary + bnd <- liftIO MP.genBoundary createTranscriptionInternal sc (bnd, atr) -createAudioTranslation :: OpenAIClient -> AudioTranslationRequest -> IO (Either ClientError AudioResponseData) +createAudioTranslation :: MonadIO m => OpenAIClient -> AudioTranslationRequest -> m (Either ClientError AudioResponseData) createAudioTranslation sc atr = do - bnd <- MP.genBoundary + bnd <- liftIO MP.genBoundary createAudioTranslationInternal sc (bnd, atr) EP1 (createTranscriptionInternal, (BSL.ByteString, AudioTranscriptionRequest), AudioResponseData) EP1 (createAudioTranslationInternal, (BSL.ByteString, AudioTranslationRequest), AudioResponseData) -createFile :: OpenAIClient -> FileCreate -> IO (Either ClientError File) +createFile :: MonadIO m => OpenAIClient -> FileCreate -> m (Either ClientError File) createFile sc rfc = do - bnd <- MP.genBoundary + bnd <- liftIO MP.genBoundary createFileInternal sc (bnd, rfc) EP1 (createFileInternal, (BSL.ByteString, FileCreate), File) From 5ec36a5b16a416c4511c8df5c25ebe440df83548 Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Wed, 14 Jun 2023 02:11:43 +0200 Subject: [PATCH 07/18] ChatFunction and ChatFunctionCall types --- openai-servant/src/OpenAI/Resources.hs | 36 ++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/openai-servant/src/OpenAI/Resources.hs b/openai-servant/src/OpenAI/Resources.hs index 3b8f804..e84d4a3 100644 --- a/openai-servant/src/OpenAI/Resources.hs +++ b/openai-servant/src/OpenAI/Resources.hs @@ -227,15 +227,45 @@ $(deriveJSON (jsonOpts 2) ''CompletionResponse) ------ Chat API ------------------------ +data ChatFunctionCall = ChatFunctionCall + { chfcName :: T.Text, + chfcArguments :: A.Value + } + deriving (Eq, Show) + +instance A.FromJSON ChatFunctionCall where + parseJSON = A.withObject "ChatFunctionCall" $ \obj -> do + name <- obj A..: "name" + arguments <- obj A..: "arguments" >>= + A.withText "Arguments" + (either fail pure . A.eitherDecode . BSL.fromStrict . T.encodeUtf8) + pure $ ChatFunctionCall { chfcName = name, chfcArguments = arguments } + +instance A.ToJSON ChatFunctionCall where + toJSON (ChatFunctionCall { chfcName = name, chfcArguments = arguments }) = + A.object [ "name" A..= name + , "arguments" A..= T.decodeUtf8 (BSL.toStrict (A.encode arguments)) + ] + data ChatMessage = ChatMessage - { chmContent :: T.Text, - chmRole :: T.Text + { chmContent :: Maybe T.Text, + chmRole :: T.Text, + chmFunctionCall :: Maybe ChatFunctionCall, + chmName :: Maybe T.Text + } + deriving (Show, Eq) + +data ChatFunction = ChatFunction + { chfName :: T.Text, + chfDescription :: T.Text, + chfParameters :: A.Value } deriving (Show, Eq) data ChatCompletionRequest = ChatCompletionRequest { chcrModel :: ModelId, chcrMessages :: [ChatMessage], + chcrFunctions :: Maybe [ChatFunction], chcrTemperature :: Maybe Double, chcrTopP :: Maybe Double, chcrN :: Maybe Int, @@ -254,6 +284,7 @@ defaultChatCompletionRequest model messages = ChatCompletionRequest { chcrModel = model, chcrMessages = messages, + chcrFunctions = Nothing, chcrTemperature = Nothing, chcrTopP = Nothing, chcrN = Nothing, @@ -282,6 +313,7 @@ data ChatResponse = ChatResponse } $(deriveJSON (jsonOpts 3) ''ChatMessage) +$(deriveJSON (jsonOpts 3) ''ChatFunction) $(deriveJSON (jsonOpts 4) ''ChatCompletionRequest) $(deriveJSON (jsonOpts 4) ''ChatChoice) $(deriveJSON (jsonOpts 3) ''ChatResponse) From c7f76133d0fb38dcaecf1c9ce3a81ff53458e4f7 Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Wed, 14 Jun 2023 10:33:59 +0200 Subject: [PATCH 08/18] Missing exports --- openai-servant/src/OpenAI/Resources.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/openai-servant/src/OpenAI/Resources.hs b/openai-servant/src/OpenAI/Resources.hs index e84d4a3..a63c451 100644 --- a/openai-servant/src/OpenAI/Resources.hs +++ b/openai-servant/src/OpenAI/Resources.hs @@ -19,6 +19,8 @@ module OpenAI.Resources defaultCompletionCreate, -- * Chat + ChatFunction (..), + ChatFunctionCall (..), ChatMessage (..), ChatCompletionRequest (..), ChatChoice (..), From 062584c00f563a7012859620b5db160c25147a4f Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Wed, 14 Jun 2023 10:37:33 +0200 Subject: [PATCH 09/18] Missing exports --- openai-hs/src/OpenAI/Client.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/openai-hs/src/OpenAI/Client.hs b/openai-hs/src/OpenAI/Client.hs index 06a7063..2dc9662 100644 --- a/openai-hs/src/OpenAI/Client.hs +++ b/openai-hs/src/OpenAI/Client.hs @@ -27,6 +27,8 @@ module OpenAI.Client completeText, -- * Chat + ChatFunction (..), + ChatFunctionCall (..), ChatMessage (..), ChatCompletionRequest (..), ChatChoice (..), From b52936bd729e324a0334cd37b900c55ef2e70120 Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Thu, 15 Jun 2023 16:52:04 +0200 Subject: [PATCH 10/18] Use withEmbeddedJSON --- openai-servant/src/OpenAI/Resources.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/openai-servant/src/OpenAI/Resources.hs b/openai-servant/src/OpenAI/Resources.hs index a63c451..fa94cd7 100644 --- a/openai-servant/src/OpenAI/Resources.hs +++ b/openai-servant/src/OpenAI/Resources.hs @@ -238,9 +238,8 @@ data ChatFunctionCall = ChatFunctionCall instance A.FromJSON ChatFunctionCall where parseJSON = A.withObject "ChatFunctionCall" $ \obj -> do name <- obj A..: "name" - arguments <- obj A..: "arguments" >>= - A.withText "Arguments" - (either fail pure . A.eitherDecode . BSL.fromStrict . T.encodeUtf8) + arguments <- obj A..: "arguments" >>= A.withEmbeddedJSON "Arguments" pure + pure $ ChatFunctionCall { chfcName = name, chfcArguments = arguments } instance A.ToJSON ChatFunctionCall where From a0e765659bf67587155472609abb37f16ae9e302 Mon Sep 17 00:00:00 2001 From: Alexander Thiemann Date: Fri, 16 Jun 2023 21:22:16 -0700 Subject: [PATCH 11/18] fix tests --- openai-hs/package.yaml | 7 +++-- openai-hs/test/ApiSpec.hs | 24 +++++--------- openai-servant/package.yaml | 4 +-- openai-servant/src/OpenAI/Resources.hs | 43 ++++++++++++++------------ 4 files changed, 37 insertions(+), 41 deletions(-) diff --git a/openai-hs/package.yaml b/openai-hs/package.yaml index 2c52659..a3fef40 100644 --- a/openai-hs/package.yaml +++ b/openai-hs/package.yaml @@ -1,10 +1,10 @@ name: openai-hs -version: 0.2.2.0 +version: 0.3.0.0 github: "agrafix/openai-hs" license: BSD3 author: "Alexander Thiemann " maintainer: "Alexander Thiemann " -copyright: "2021-2022 Alexander Thiemann " +copyright: "2021-2023 Alexander Thiemann " extra-source-files: - README.md @@ -29,6 +29,9 @@ dependencies: - cpphs - http-types +build-tools: + - cpphs + ghc-options: - -Wall - -fwarn-tabs diff --git a/openai-hs/test/ApiSpec.hs b/openai-hs/test/ApiSpec.hs index c386c8c..0efd4f1 100644 --- a/openai-hs/test/ApiSpec.hs +++ b/openai-hs/test/ApiSpec.hs @@ -39,7 +39,7 @@ apiTests2023 = res <- forceSuccess $ listModels cli (V.length (olData res) > 5) `shouldBe` True let model = V.head (olData res) - mOwnedBy model `shouldBe` "openai" + mOwnedBy model `shouldBe` "openai-internal" it "retrieve model" $ \cli -> do model <- forceSuccess $ getModel cli (ModelId "text-davinci-003") @@ -64,12 +64,14 @@ apiTests2023 = (ModelId "gpt-3.5-turbo") [ ChatMessage { chmRole = "user", - chmContent = "What is the opposite of up? Answer in one word." + chmContent = Just "What is the opposite of up? Answer in one word.", + chmFunctionCall = Nothing, + chmName = Nothing } ] res <- forceSuccess $ completeChat cli completion chrChoices res `shouldNotBe` [] - chmContent (chchMessage (head (chrChoices res))) `shouldBe` "Down." + chmContent (chchMessage (head (chrChoices res))) `shouldBe` Just "down." describe "edits api" $ do it "create edit" $ \cli -> do @@ -98,23 +100,12 @@ apiTests2022 :: SpecWith () apiTests2022 = beforeAll makeClient $ do - describe "file api" $ - do - it "allows creating one" $ \cli -> - do - let file = - FileCreate - { fcPurpose = "fune-ftTunedModel FineTune", - fcDocuments = [FhFineTune $ FineTuneHunk "a" "b"] - } - _ <- forceSuccess $ createFile cli file - pure () describe "embeddings" $ do it "computes embeddings" $ \cli -> do res <- forceSuccess $ engineCreateEmbedding cli (EngineId "babbage-similarity") (EngineEmbeddingCreate "This is nice") V.null (olData res) `shouldBe` False let embedding = V.head (olData res) - V.length (eneEngineEmbedding embedding) `shouldBe` 2048 + V.length (eneEmbedding embedding) `shouldBe` 2048 describe "fine tuning" $ do it "allows creating fine-tuning" $ \cli -> do let file = @@ -145,10 +136,9 @@ apiTests2022 = do it "works (smoke test)" $ \cli -> do - firstEngine <- V.head . olData <$> forceSuccess (listEngines cli) completionResults <- forceSuccess $ - engineCompleteText cli (eId firstEngine) $ + engineCompleteText cli (EngineId "text-curie-001") $ (defaultEngineTextCompletionCreate "Why is the house ") { tccrMaxTokens = Just 2 } diff --git a/openai-servant/package.yaml b/openai-servant/package.yaml index c445ba1..9a04b37 100644 --- a/openai-servant/package.yaml +++ b/openai-servant/package.yaml @@ -1,10 +1,10 @@ name: openai-servant -version: 0.2.3.0 +version: 0.3.0.0 github: "agrafix/openai-hs" license: BSD3 author: "Alexander Thiemann " maintainer: "Alexander Thiemann " -copyright: "2021-2022 Alexander Thiemann " +copyright: "2021-2023 Alexander Thiemann " extra-source-files: - README.md diff --git a/openai-servant/src/OpenAI/Resources.hs b/openai-servant/src/OpenAI/Resources.hs index fa94cd7..b733ac3 100644 --- a/openai-servant/src/OpenAI/Resources.hs +++ b/openai-servant/src/OpenAI/Resources.hs @@ -239,14 +239,15 @@ instance A.FromJSON ChatFunctionCall where parseJSON = A.withObject "ChatFunctionCall" $ \obj -> do name <- obj A..: "name" arguments <- obj A..: "arguments" >>= A.withEmbeddedJSON "Arguments" pure - - pure $ ChatFunctionCall { chfcName = name, chfcArguments = arguments } + + pure $ ChatFunctionCall {chfcName = name, chfcArguments = arguments} instance A.ToJSON ChatFunctionCall where - toJSON (ChatFunctionCall { chfcName = name, chfcArguments = arguments }) = - A.object [ "name" A..= name - , "arguments" A..= T.decodeUtf8 (BSL.toStrict (A.encode arguments)) - ] + toJSON (ChatFunctionCall {chfcName = name, chfcArguments = arguments}) = + A.object + [ "name" A..= name, + "arguments" A..= T.decodeUtf8 (BSL.toStrict (A.encode arguments)) + ] data ChatMessage = ChatMessage { chmContent :: Maybe T.Text, @@ -480,13 +481,14 @@ data AudioTranscriptionRequest = AudioTranscriptionRequest instance ToMultipart Tmp AudioTranscriptionRequest where toMultipart atr = MultipartData - (catMaybes - [ Input "model" . unModelId <$> Just (audtsrModel atr) - , Input "prompt" <$> audtsrPrompt atr - , Input "response_format" <$> audtsrResponseFormat atr - , Input "temperature" . T.pack . show <$> audtsrTemperature atr - , Input "language" <$> audtsrLanguage atr - ]) + ( catMaybes + [ Input "model" . unModelId <$> Just (audtsrModel atr), + Input "prompt" <$> audtsrPrompt atr, + Input "response_format" <$> audtsrResponseFormat atr, + Input "temperature" . T.pack . show <$> audtsrTemperature atr, + Input "language" <$> audtsrLanguage atr + ] + ) [ FileData "file" (T.pack . audtsrFile $ atr) (T.decodeUtf8 . defaultMimeLookup . T.pack $ audtsrFile atr) (audtsrFile atr) ] @@ -505,12 +507,13 @@ data AudioTranslationRequest = AudioTranslationRequest instance ToMultipart Tmp AudioTranslationRequest where toMultipart atr = MultipartData - (catMaybes - [ Input "model" . unModelId <$> Just (audtlrModel atr) - , Input "prompt" <$> audtlrPrompt atr - , Input "response_format" <$> audtlrResponseFormat atr - , Input "temperature" . T.pack . show <$> audtlrTemperature atr - ]) + ( catMaybes + [ Input "model" . unModelId <$> Just (audtlrModel atr), + Input "prompt" <$> audtlrPrompt atr, + Input "response_format" <$> audtlrResponseFormat atr, + Input "temperature" . T.pack . show <$> audtlrTemperature atr + ] + ) [ FileData "file" (T.pack . audtlrFile $ atr) (T.decodeUtf8 . defaultMimeLookup . T.pack $ audtlrFile atr) (audtlrFile atr) ] @@ -670,7 +673,7 @@ data EngineEmbeddingCreate = EngineEmbeddingCreate deriving (Show, Eq) data EngineEmbedding = EngineEmbedding - {eneEngineEmbedding :: V.Vector Double, eneIndex :: Int} + {eneEmbedding :: V.Vector Double, eneIndex :: Int} deriving (Show, Eq) $(deriveJSON (jsonOpts 4) ''EngineEmbeddingCreate) From 90a256600481974d4b72a90b3fa92ff4d8d1e1c5 Mon Sep 17 00:00:00 2001 From: Alexander Thiemann Date: Fri, 16 Jun 2023 21:36:47 -0700 Subject: [PATCH 12/18] cabal files --- openai-hs/openai-hs.cabal | 12 ++++++++---- openai-servant/openai-servant.cabal | 8 +++----- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/openai-hs/openai-hs.cabal b/openai-hs/openai-hs.cabal index b1eb3b7..a994b36 100644 --- a/openai-hs/openai-hs.cabal +++ b/openai-hs/openai-hs.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack -- --- hash: b3b520111ed497869a84db66934450f684e12420b3ca3406cd02fb013d8b2596 +-- hash: 7ef8db4f28eb347b36dd01edc4bf2e52f6e66fdb9a247a17e00c311fec44ca1c name: openai-hs -version: 0.2.2.0 +version: 0.3.0.0 synopsis: Unofficial OpenAI client description: Unofficial OpenAI client category: Web @@ -15,7 +15,7 @@ homepage: https://github.com/agrafix/openai-hs#readme bug-reports: https://github.com/agrafix/openai-hs/issues author: Alexander Thiemann maintainer: Alexander Thiemann -copyright: 2021-2022 Alexander Thiemann +copyright: 2021-2023 Alexander Thiemann license: BSD3 license-file: LICENSE build-type: Simple @@ -48,6 +48,8 @@ library DeriveGeneric DeriveFunctor ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates + build-tools: + cpphs build-depends: aeson , base >=4.7 && <5 @@ -87,6 +89,8 @@ test-suite openai-hs-test DeriveGeneric DeriveFunctor ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -threaded -rtsopts -with-rtsopts=-N + build-tools: + cpphs build-depends: aeson , base >=4.7 && <5 diff --git a/openai-servant/openai-servant.cabal b/openai-servant/openai-servant.cabal index 2b9c194..cbe9435 100644 --- a/openai-servant/openai-servant.cabal +++ b/openai-servant/openai-servant.cabal @@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack --- --- hash: 588e067606c40d86380fdece27ded84dbd11ebf9fbd443975bbf12a4555302f5 name: openai-servant -version: 0.2.3.0 +version: 0.3.0.0 synopsis: Unofficial OpenAI servant types description: Unofficial description of the OpenAI API using servant types category: Web @@ -15,7 +13,7 @@ homepage: https://github.com/agrafix/openai-hs#readme bug-reports: https://github.com/agrafix/openai-hs/issues author: Alexander Thiemann maintainer: Alexander Thiemann -copyright: 2021-2022 Alexander Thiemann +copyright: 2021-2023 Alexander Thiemann license: BSD3 license-file: LICENSE build-type: Simple From 999f25bac4b54bba3a98f5fc166e75c551c827c7 Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Tue, 20 Jun 2023 22:28:39 +0200 Subject: [PATCH 13/18] 'content' must not be omitted --- openai-servant/src/OpenAI/Resources.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/openai-servant/src/OpenAI/Resources.hs b/openai-servant/src/OpenAI/Resources.hs index b733ac3..60a53aa 100644 --- a/openai-servant/src/OpenAI/Resources.hs +++ b/openai-servant/src/OpenAI/Resources.hs @@ -257,6 +257,23 @@ data ChatMessage = ChatMessage } deriving (Show, Eq) +instance A.FromJSON ChatMessage where + parseJSON = A.withObject "ChatMessage" $ \obj -> + ChatMessage <$> obj A..:? "content" + <*> obj A..: "role" + <*> obj A..:? "function_call" + <*> obj A..:? "name" + +instance A.ToJSON ChatMessage where + toJSON (ChatMessage {chmContent = content, chmRole = role, chmFunctionCall = functionCall, chmName = name}) = + A.object $ + [ "content" A..= content, + "role" A..= role + ] ++ catMaybes + [ ("function_call" A..=) <$> functionCall, + ("name" A..=) <$> name + ] + data ChatFunction = ChatFunction { chfName :: T.Text, chfDescription :: T.Text, @@ -314,7 +331,6 @@ data ChatResponse = ChatResponse chrUsage :: Usage } -$(deriveJSON (jsonOpts 3) ''ChatMessage) $(deriveJSON (jsonOpts 3) ''ChatFunction) $(deriveJSON (jsonOpts 4) ''ChatCompletionRequest) $(deriveJSON (jsonOpts 4) ''ChatChoice) From 7550e09cad488d7cae44610299bdb992618bb049 Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Sat, 24 Jun 2023 18:53:10 +0200 Subject: [PATCH 14/18] Add a test --- openai-hs/test/ApiSpec.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/openai-hs/test/ApiSpec.hs b/openai-hs/test/ApiSpec.hs index 0efd4f1..13bde43 100644 --- a/openai-hs/test/ApiSpec.hs +++ b/openai-hs/test/ApiSpec.hs @@ -72,6 +72,25 @@ apiTests2023 = res <- forceSuccess $ completeChat cli completion chrChoices res `shouldNotBe` [] chmContent (chchMessage (head (chrChoices res))) `shouldBe` Just "down." + it "'content' is a required property" $ \cli -> do + let completion = + defaultChatCompletionRequest + (ModelId "gpt-3.5-turbo") + [ ChatMessage + { chmRole = "assistant", + chmContent = Nothing, + chmFunctionCall = Just $ ChatFunctionCall { chfcName = "f", chfcArguments = "{}" }, + chmName = Nothing + }, + ChatMessage + { chmRole = "function", + chmContent = Just "x", + chmFunctionCall = Nothing, + chmName = Just "f" + } + ] + res <- forceSuccess $ completeChat cli completion + chrChoices res `shouldNotBe` [] describe "edits api" $ do it "create edit" $ \cli -> do From 34ee5977eb98d3863d0d7567dca05401629a01ed Mon Sep 17 00:00:00 2001 From: Alexander Thiemann Date: Tue, 4 Jul 2023 20:27:28 -0700 Subject: [PATCH 15/18] remove build tools since it causes a build failure --- openai-hs/openai-hs.cabal | 6 +----- openai-hs/package.yaml | 3 --- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/openai-hs/openai-hs.cabal b/openai-hs/openai-hs.cabal index a994b36..bb00e46 100644 --- a/openai-hs/openai-hs.cabal +++ b/openai-hs/openai-hs.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 7ef8db4f28eb347b36dd01edc4bf2e52f6e66fdb9a247a17e00c311fec44ca1c +-- hash: a6e8ea2b5e6dfeb26b5108f9c27ce764bb1e9cb495f616829c1a744a4f6fd4ee name: openai-hs version: 0.3.0.0 @@ -48,8 +48,6 @@ library DeriveGeneric DeriveFunctor ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates - build-tools: - cpphs build-depends: aeson , base >=4.7 && <5 @@ -89,8 +87,6 @@ test-suite openai-hs-test DeriveGeneric DeriveFunctor ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -threaded -rtsopts -with-rtsopts=-N - build-tools: - cpphs build-depends: aeson , base >=4.7 && <5 diff --git a/openai-hs/package.yaml b/openai-hs/package.yaml index a3fef40..611cd4c 100644 --- a/openai-hs/package.yaml +++ b/openai-hs/package.yaml @@ -29,9 +29,6 @@ dependencies: - cpphs - http-types -build-tools: - - cpphs - ghc-options: - -Wall - -fwarn-tabs From 6234ff35f5822ff51628add9e8e5ea906fd575f2 Mon Sep 17 00:00:00 2001 From: Alexander Thiemann Date: Tue, 4 Jul 2023 20:29:37 -0700 Subject: [PATCH 16/18] version bump --- openai-hs/openai-hs.cabal | 4 ++-- openai-hs/package.yaml | 2 +- openai-servant/openai-servant.cabal | 2 +- openai-servant/package.yaml | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/openai-hs/openai-hs.cabal b/openai-hs/openai-hs.cabal index bb00e46..4a50a74 100644 --- a/openai-hs/openai-hs.cabal +++ b/openai-hs/openai-hs.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: a6e8ea2b5e6dfeb26b5108f9c27ce764bb1e9cb495f616829c1a744a4f6fd4ee +-- hash: d37104a564e8bdbce4dfdc276b621def2716ecaad3d474f0646934fd1b1f034b name: openai-hs -version: 0.3.0.0 +version: 0.3.0.1 synopsis: Unofficial OpenAI client description: Unofficial OpenAI client category: Web diff --git a/openai-hs/package.yaml b/openai-hs/package.yaml index 611cd4c..4f08f93 100644 --- a/openai-hs/package.yaml +++ b/openai-hs/package.yaml @@ -1,5 +1,5 @@ name: openai-hs -version: 0.3.0.0 +version: 0.3.0.1 github: "agrafix/openai-hs" license: BSD3 author: "Alexander Thiemann " diff --git a/openai-servant/openai-servant.cabal b/openai-servant/openai-servant.cabal index cbe9435..3b28e96 100644 --- a/openai-servant/openai-servant.cabal +++ b/openai-servant/openai-servant.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: openai-servant -version: 0.3.0.0 +version: 0.3.0.1 synopsis: Unofficial OpenAI servant types description: Unofficial description of the OpenAI API using servant types category: Web diff --git a/openai-servant/package.yaml b/openai-servant/package.yaml index 9a04b37..39ea3ff 100644 --- a/openai-servant/package.yaml +++ b/openai-servant/package.yaml @@ -1,5 +1,5 @@ name: openai-servant -version: 0.3.0.0 +version: 0.3.0.1 github: "agrafix/openai-hs" license: BSD3 author: "Alexander Thiemann " From ecf19a1fb5f20e3b7390cae1e25c01a78b1f9254 Mon Sep 17 00:00:00 2001 From: Alfredo Di Napoli Date: Thu, 24 Aug 2023 15:30:39 +0200 Subject: [PATCH 17/18] Support 'function_call' in 'ChatCompletionRequest'. --- openai-hs/src/OpenAI/Client.hs | 1 + openai-servant/src/OpenAI/Resources.hs | 23 +++++++++++++++++++++++ 2 files changed, 24 insertions(+) diff --git a/openai-hs/src/OpenAI/Client.hs b/openai-hs/src/OpenAI/Client.hs index 3a6d1bb..8bfc2e0 100644 --- a/openai-hs/src/OpenAI/Client.hs +++ b/openai-hs/src/OpenAI/Client.hs @@ -29,6 +29,7 @@ module OpenAI.Client -- * Chat ChatFunction (..), ChatFunctionCall (..), + ChatFunctionCallStrategy (..), ChatMessage (..), ChatCompletionRequest (..), ChatChoice (..), diff --git a/openai-servant/src/OpenAI/Resources.hs b/openai-servant/src/OpenAI/Resources.hs index 60a53aa..76275c2 100644 --- a/openai-servant/src/OpenAI/Resources.hs +++ b/openai-servant/src/OpenAI/Resources.hs @@ -1,5 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} module OpenAI.Resources @@ -21,6 +22,7 @@ module OpenAI.Resources -- * Chat ChatFunction (..), ChatFunctionCall (..), + ChatFunctionCallStrategy (..), ChatMessage (..), ChatCompletionRequest (..), ChatChoice (..), @@ -281,10 +283,30 @@ data ChatFunction = ChatFunction } deriving (Show, Eq) +data ChatFunctionCallStrategy = + CFCS_auto + | CFCS_none + | CFCS_name T.Text + deriving (Show, Eq) + +instance ToJSON ChatFunctionCallStrategy where + toJSON = \case + CFCS_auto -> A.String "auto" + CFCS_none -> A.String "none" + CFCS_name functionName -> A.object [ "name" A..= A.toJSON functionName ] + +instance FromJSON ChatFunctionCallStrategy where + parseJSON (A.String "auto") = pure CFCS_auto + parseJSON (A.String "none") = pure CFCS_none + parseJSON xs = flip (A.withObject "ChatFunctionCallStrategy") xs $ \o -> do + functionName <- o A..: "name" + pure $ CFCS_name functionName + data ChatCompletionRequest = ChatCompletionRequest { chcrModel :: ModelId, chcrMessages :: [ChatMessage], chcrFunctions :: Maybe [ChatFunction], + chcrFunctionCall :: Maybe ChatFunctionCallStrategy, chcrTemperature :: Maybe Double, chcrTopP :: Maybe Double, chcrN :: Maybe Int, @@ -304,6 +326,7 @@ defaultChatCompletionRequest model messages = { chcrModel = model, chcrMessages = messages, chcrFunctions = Nothing, + chcrFunctionCall = Nothing, chcrTemperature = Nothing, chcrTopP = Nothing, chcrN = Nothing, From 008c31a188963def53d0e278c396d620590b921c Mon Sep 17 00:00:00 2001 From: Miezhiko Date: Fri, 1 Sep 2023 17:46:49 +0400 Subject: [PATCH 18/18] OpenAI/Client: allow custom base url with makeOpenAIClient' method Signed-off-by: Miezhiko --- openai-hs/src/OpenAI/Client.hs | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/openai-hs/src/OpenAI/Client.hs b/openai-hs/src/OpenAI/Client.hs index 8bfc2e0..d1a4f6b 100644 --- a/openai-hs/src/OpenAI/Client.hs +++ b/openai-hs/src/OpenAI/Client.hs @@ -6,6 +6,7 @@ module OpenAI.Client ApiKey, OpenAIClient, makeOpenAIClient, + makeOpenAIClient', ClientError (..), -- * Helper types @@ -130,19 +131,29 @@ type ApiKey = T.Text -- | Holds a 'Manager' and your API key. data OpenAIClient = OpenAIClient - { scToken :: Token, + { scBaseUrl :: BaseUrl, + scToken :: Token, scManager :: Manager, scMaxRetries :: Int } -- | Construct a 'OpenAIClient'. Note that the passed 'Manager' must support https (e.g. via @http-client-tls@) -makeOpenAIClient :: +makeOpenAIClient' :: + BaseUrl -> ApiKey -> Manager -> -- | Number of automatic retries the library should attempt. Int -> OpenAIClient -makeOpenAIClient k = OpenAIClient (Token (T.encodeUtf8 k)) +makeOpenAIClient' u k = OpenAIClient u (Token (T.encodeUtf8 k)) + +-- | method using default remote base url +makeOpenAIClient :: + ApiKey -> + Manager -> + Int -> + OpenAIClient +makeOpenAIClient = makeOpenAIClient' openaiBaseUrl api :: Proxy OpenAIApi api = Proxy @@ -153,17 +164,17 @@ openaiBaseUrl = BaseUrl Https "api.openai.com" 443 "" #define EP0(N, R) \ N##' :: Token -> ClientM R;\ N :: MonadIO m => OpenAIClient -> m (Either ClientError R);\ - N sc = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc)) (mkClientEnv (scManager sc) openaiBaseUrl) + N sc = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc)) (mkClientEnv (scManager sc) (scBaseUrl sc)) #define EP1(N, ARG, R) \ N##' :: Token -> ARG -> ClientM R;\ N :: MonadIO m => OpenAIClient -> ARG -> m (Either ClientError R);\ - N sc a = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc) a) (mkClientEnv (scManager sc) openaiBaseUrl) + N sc a = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc) a) (mkClientEnv (scManager sc) (scBaseUrl sc)) #define EP2(N, ARG, ARG2, R) \ N##' :: Token -> ARG -> ARG2 -> ClientM R;\ N :: MonadIO m => OpenAIClient -> ARG -> ARG2 -> m (Either ClientError R);\ - N sc a b = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc) a b) (mkClientEnv (scManager sc) openaiBaseUrl) + N sc a b = liftIO . runRequest (scMaxRetries sc) 0 $ runClientM (N##' (scToken sc) a b) (mkClientEnv (scManager sc) (scBaseUrl sc)) EP0 (listModels, (OpenAIList Model)) EP1 (getModel, ModelId, Model)