packages feed

openai-hs 0.2.2.0 → 0.3.0.0

raw patch · 5 files changed

+262/−165 lines, 5 filesdep +servant-auth-client

Dependencies added: servant-auth-client

Files

README.md view
@@ -21,8 +21,28 @@ 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 =   do manager <- newManager tlsManagerSettings@@ -30,13 +50,10 @@      -- 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
openai-hs.cabal view
@@ -1,13 +1,13 @@ 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.2. -- -- see: https://github.com/sol/hpack ----- hash: 8760d75e39a4a6db941c2503a8e8519a3c82b52bad91dcf39594cdd9258c7f4b+-- 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 @@ bug-reports:    https://github.com/agrafix/openai-hs/issues author:         Alexander Thiemann <mail@thiemann.at> maintainer:     Alexander Thiemann <mail@thiemann.at>-copyright:      2021-2022 Alexander Thiemann <mail@thiemann.at>+copyright:      2021-2023 Alexander Thiemann <mail@thiemann.at> license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -48,6 +48,8 @@       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@@ -58,6 +60,7 @@     , http-types     , openai-servant >=0.2.1     , servant+    , servant-auth-client     , servant-client     , servant-multipart-client     , text@@ -86,6 +89,8 @@       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@@ -100,6 +105,7 @@     , openai-hs     , openai-servant >=0.2.1     , servant+    , servant-auth-client     , servant-client     , servant-client-core     , servant-multipart-client
src/OpenAI/Client.hs view
@@ -11,27 +11,82 @@     -- * Helper types     TimeStamp (..),     OpenAIList (..),+    Usage (..), -    -- * Engine+    -- * Models+    Model (..),+    ModelId (..),+    listModels,+    getModel,++    -- * Completion+    CompletionCreate (..),+    CompletionChoice (..),+    CompletionResponse (..),+    defaultCompletionCreate,+    completeText,++    -- * Chat+    ChatFunction (..),+    ChatFunctionCall (..),+    ChatMessage (..),+    ChatCompletionRequest (..),+    ChatChoice (..),+    ChatResponse (..),+    defaultChatCompletionRequest,+    completeChat,++    -- * Edits+    EditCreate (..),+    EditChoice (..),+    EditResponse (..),+    createTextEdit,+    defaultEditCreate,++    -- * Images+    ImageResponse (..),+    ImageResponseData (..),+    ImageCreate (..),+    ImageEditRequest (..),+    ImageVariationRequest (..),+    generateImage,+    createImageEdit,+    createImageVariation,++    -- * 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,30 +98,19 @@     cancelFineTune,     listFineTuneEvents, -    -- * Searching-    SearchResult (..),-    SearchResultCreate (..),-    searchDocuments,--    -- * File API+    -- * File API (out of date)     FileCreate (..),     File (..),     FileId (..),     FileHunk (..),-    SearchHunk (..),-    ClassificationHunk (..),     FineTuneHunk (..),     FileDeleteConfirmation (..),     createFile,     deleteFile,--    -- * Answer API-    getAnswer,-    AnswerReq (..),-    AnswerResp (..),   ) where +import Control.Monad.IO.Class (MonadIO(..)) import qualified Data.ByteString.Lazy as BSL import Data.Proxy import qualified Data.Text as T@@ -76,6 +120,7 @@ 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 @@ -84,7 +129,7 @@  -- | Holds a 'Manager' and your API key. data OpenAIClient = OpenAIClient-  { scBasicAuthData :: BasicAuthData,+  { scToken :: Token,     scManager :: Manager,     scMaxRetries :: Int   }@@ -96,7 +141,7 @@   -- | 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@@ -105,56 +150,95 @@ 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##' :: 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) -#define EP(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)+#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)  #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##' :: 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) -EP2 (completeText, EngineId, TextCompletionCreate, TextCompletion)-EP2 (searchDocuments, EngineId, SearchResultCreate, (OpenAIList SearchResult))-EP2 (createEmbedding, EngineId, EmbeddingCreate, (OpenAIList Embedding))+EP0 (listModels, (OpenAIList Model))+EP1 (getModel, ModelId, Model) -EP (createFineTune, FineTuneCreate, FineTune)-EP0 (listFineTunes, (OpenAIList FineTune))-EP (getFineTune, FineTuneId, FineTune)-EP (cancelFineTune, FineTuneId, FineTune)-EP (listFineTuneEvents, FineTuneId, (OpenAIList FineTuneEvent))+EP1 (completeText, CompletionCreate, CompletionResponse) -EP0 (listEngines, (OpenAIList Engine))-EP (getEngine, EngineId, Engine)+EP1 (completeChat, ChatCompletionRequest, ChatResponse) -createFile :: OpenAIClient -> FileCreate -> IO (Either ClientError File)+EP1 (createTextEdit, EditCreate, EditResponse)++EP1 (generateImage, ImageCreate, ImageResponse)+EP1 (createImageEdit, ImageEditRequest, ImageResponse)+EP1 (createImageVariation, ImageVariationRequest, ImageResponse)++EP1 (createEmbedding, EmbeddingCreate, EmbeddingResponse)++createTranscription :: MonadIO m => OpenAIClient -> AudioTranscriptionRequest -> m (Either ClientError AudioResponseData)+createTranscription sc atr =+  do+    bnd <- liftIO MP.genBoundary+    createTranscriptionInternal sc (bnd, atr)++createAudioTranslation :: MonadIO m => OpenAIClient -> AudioTranslationRequest -> m (Either ClientError AudioResponseData)+createAudioTranslation sc atr =+  do+    bnd <- liftIO MP.genBoundary+    createAudioTranslationInternal sc (bnd, atr)++EP1 (createTranscriptionInternal, (BSL.ByteString, AudioTranscriptionRequest), AudioResponseData)+EP1 (createAudioTranslationInternal, (BSL.ByteString, AudioTranslationRequest), AudioResponseData)++createFile :: MonadIO m => OpenAIClient -> FileCreate -> m (Either ClientError File) createFile sc rfc =   do-    bnd <- MP.genBoundary+    bnd <- liftIO 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 (createFineTune, FineTuneCreate, FineTune)+EP0 (listFineTunes, (OpenAIList FineTune))+EP1 (getFineTune, FineTuneId, FineTune)+EP1 (cancelFineTune, FineTuneId, FineTune)+EP1 (listFineTuneEvents, FineTuneId, (OpenAIList FineTuneEvent)) -( listEngines'-    :<|> getEngine'-    :<|> completeText'-    :<|> searchDocuments'-    :<|> createEmbedding'-  )-  :<|> (createFileInternal' :<|> deleteFile')-  :<|> getAnswer'-  :<|> ( createFineTune'-           :<|> listFineTunes'-           :<|> getFineTune'-           :<|> cancelFineTune'-           :<|> listFineTuneEvents'-         ) =+EP0 (listEngines, (OpenAIList Engine))+EP1 (getEngine, EngineId, Engine)+EP2 (engineCompleteText, EngineId, TextCompletionCreate, TextCompletion)+EP2 (engineCreateEmbedding, EngineId, EngineEmbeddingCreate, (OpenAIList EngineEmbedding))++( ( listModels'+      :<|> getModel'+    )+    :<|> (completeText')+    :<|> (completeChat')+    :<|> (createTextEdit')+    :<|> ( generateImage'+             :<|> createImageEdit'+             :<|> createImageVariation'+           )+    :<|> (createEmbedding')+    :<|> ( createTranscriptionInternal'+             :<|> createAudioTranslationInternal'+           )+    :<|> (createFileInternal' :<|> deleteFile')+    :<|> ( createFineTune'+             :<|> listFineTunes'+             :<|> getFineTune'+             :<|> cancelFineTune'+             :<|> listFineTuneEvents'+           )+    :<|> ( listEngines'+             :<|> getEngine'+             :<|> engineCompleteText'+             :<|> engineCreateEmbedding'+           )+  ) =     client api
src/OpenAI/Client/Internal/Helpers.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} --- | Private helper functions. Note that all contents of this module are excluded from the versioning scheme.+-- | Private helper functions. Note that all contents of this module are excluded+-- from the versioning scheme. module OpenAI.Client.Internal.Helpers where  import Network.HTTP.Types.Status
test/ApiSpec.hs view
@@ -23,58 +23,89 @@       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-internal"++      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 = 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` Just "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-          it "allows creating one" $ \cli ->-            do-              let file =-                    FileCreate-                      { fcPurpose = "search",-                        fcDocuments = [FhSearch $ SearchHunk "Test 1" Nothing, FhSearch $ SearchHunk "text 2" (Just "foo")]-                      }-              _ <- forceSuccess $ createFile cli file-              pure ()-      describe "answer api" $-        do-          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 $ createEmbedding cli (EngineId "ada-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` 1024+          V.length (eneEmbedding embedding) `shouldBe` 2048       describe "fine tuning" $ do         it "allows creating fine-tuning" $ \cli -> do           let file =@@ -105,53 +136,11 @@         do           it "works (smoke test)" $ \cli ->             do-              firstEngine <- V.head . olData <$> forceSuccess (listEngines cli)               completionResults <-                 forceSuccess $-                  completeText cli (eId firstEngine) $-                    (defaultTextCompletionCreate "Why is the house ")+                  engineCompleteText cli (EngineId "text-curie-001") $+                    (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-          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-          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 ()