openai-hs 0.2.1.0 → 0.2.2.0

raw patch · 8 files changed

+325/−226 lines, 8 filessetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• Setup.hs +1/−0
• openai-hs.cabal +3/−3
• src/OpenAI/Client.hs +101/−45
• src/OpenAI/Client/Internal/Helpers.hs +14/−12
• test/ApiSpec.hs +135/−103
• test/HelperSpec.hs +66/−58
• test/Spec.hs +4/−4

@@ -1,4 +1,4 @@-Copyright Author name here (c) 2020+Copyright Author name here (c) 2021-2022  All rights reserved. 

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 1dde99a185b23e2392f6b88ffc6c086ea7240054bcf59d9848a2bd6f36ecfabc+-- hash: 8760d75e39a4a6db941c2503a8e8519a3c82b52bad91dcf39594cdd9258c7f4b  name:           openai-hs-version:        0.2.1.0+version:        0.2.2.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 Alexander Thiemann <mail@thiemann.at>+copyright:      2021-2022 Alexander Thiemann <mail@thiemann.at> license:        BSD3 license-file:   LICENSE build-type:     Simple

@@ -1,61 +1,101 @@-{-# OPTIONS_GHC -cpp -pgmPcpphs -optP--cpp #-} {-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -cpp -pgmPcpphs -optP--cpp #-}+ module OpenAI.Client   ( -- * Basics-    ApiKey, OpenAIClient, makeOpenAIClient, ClientError(..)+    ApiKey,+    OpenAIClient,+    makeOpenAIClient,+    ClientError (..),+     -- * Helper types-  , TimeStamp(..), OpenAIList(..)+    TimeStamp (..),+    OpenAIList (..),+     -- * Engine-  , EngineId(..), Engine(..)-  , listEngines-  , getEngine+    EngineId (..),+    Engine (..),+    listEngines,+    getEngine,+     -- * Text completion-  , TextCompletionId(..), TextCompletionChoice(..), TextCompletion(..), TextCompletionCreate(..)-  , defaultTextCompletionCreate-  , completeText+    TextCompletionId (..),+    TextCompletionChoice (..),+    TextCompletion (..),+    TextCompletionCreate (..),+    defaultTextCompletionCreate,+    completeText,++    -- * Embeddings+    EmbeddingCreate (..),+    Embedding (..),+    createEmbedding,++    -- * Fine tunes+    FineTuneId (..),+    FineTuneCreate (..),+    defaultFineTuneCreate,+    FineTune (..),+    FineTuneEvent (..),+    createFineTune,+    listFineTunes,+    getFineTune,+    cancelFineTune,+    listFineTuneEvents,+     -- * Searching-  , SearchResult(..), SearchResultCreate(..)-  , searchDocuments+    SearchResult (..),+    SearchResultCreate (..),+    searchDocuments,+     -- * File API-  , FileCreate(..), File(..), FileId(..), FileHunk(..)-  , FileDeleteConfirmation(..)-  , createFile, deleteFile+    FileCreate (..),+    File (..),+    FileId (..),+    FileHunk (..),+    SearchHunk (..),+    ClassificationHunk (..),+    FineTuneHunk (..),+    FileDeleteConfirmation (..),+    createFile,+    deleteFile,+     -- * Answer API-  , getAnswer, AnswerReq(..), AnswerResp(..)+    getAnswer,+    AnswerReq (..),+    AnswerResp (..),   ) where +import qualified Data.ByteString.Lazy as BSL+import Data.Proxy+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Network.HTTP.Client (Manager) import OpenAI.Api import OpenAI.Client.Internal.Helpers import OpenAI.Resources--import Data.Proxy-import Network.HTTP.Client (Manager) import Servant.API import Servant.Client-import qualified Data.ByteString.Lazy as BSL-import qualified Data.Text as T-import qualified Data.Text.Encoding as T import qualified Servant.Multipart.Client as MP  -- | Your OpenAI API key. Can be obtained from the OpenAI dashboard. Format: @sk-<redacted>@ type ApiKey = T.Text  -- | Holds a 'Manager' and your API key.-data OpenAIClient-  = OpenAIClient-  { scBasicAuthData :: BasicAuthData-  , scManager :: Manager-  , scMaxRetries :: Int+data OpenAIClient = OpenAIClient+  { scBasicAuthData :: BasicAuthData,+    scManager :: Manager,+    scMaxRetries :: Int   }  -- | Construct a 'OpenAIClient'. Note that the passed 'Manager' must support https (e.g. via @http-client-tls@) makeOpenAIClient ::-  ApiKey-  -> Manager-  -> Int-  -- ^ Number of automatic retries the library should attempt.-  -> OpenAIClient+  ApiKey ->+  Manager ->+  -- | Number of automatic retries the library should attempt.+  Int ->+  OpenAIClient makeOpenAIClient k = OpenAIClient (BasicAuthData "" (T.encodeUtf8 k))  api :: Proxy OpenAIApi@@ -79,26 +119,42 @@     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 (completeText, EngineId, TextCompletionCreate, TextCompletion)+EP2 (searchDocuments, EngineId, SearchResultCreate, (OpenAIList SearchResult))+EP2 (createEmbedding, EngineId, EmbeddingCreate, (OpenAIList Embedding)) -EP0(listEngines, (OpenAIList Engine))-EP(getEngine, EngineId, Engine)+EP (createFineTune, FineTuneCreate, FineTune)+EP0 (listFineTunes, (OpenAIList FineTune))+EP (getFineTune, FineTuneId, FineTune)+EP (cancelFineTune, FineTuneId, FineTune)+EP (listFineTuneEvents, FineTuneId, (OpenAIList FineTuneEvent)) +EP0 (listEngines, (OpenAIList Engine))+EP (getEngine, EngineId, Engine)+ createFile :: OpenAIClient -> FileCreate -> IO (Either ClientError File) createFile sc rfc =-  do bnd <- MP.genBoundary-     createFileInternal sc (bnd, rfc)+  do+    bnd <- MP.genBoundary+    createFileInternal sc (bnd, rfc) -EP(createFileInternal, (BSL.ByteString, FileCreate), File)-EP(deleteFile, FileId, FileDeleteConfirmation)+EP (createFileInternal, (BSL.ByteString, FileCreate), File)+EP (deleteFile, FileId, FileDeleteConfirmation) -EP(getAnswer, AnswerReq, AnswerResp)+EP (getAnswer, AnswerReq, AnswerResp) -(listEngines'-  :<|> getEngine'-  :<|> completeText'-  :<|> searchDocuments')+( listEngines'+    :<|> getEngine'+    :<|> completeText'+    :<|> searchDocuments'+    :<|> createEmbedding'+  )   :<|> (createFileInternal' :<|> deleteFile')   :<|> getAnswer'-  = client api+  :<|> ( createFineTune'+           :<|> listFineTunes'+           :<|> getFineTune'+           :<|> cancelFineTune'+           :<|> listFineTuneEvents'+         ) =+    client api

@@ -1,5 +1,6 @@--- | Private helper functions. Note that all contents of this module are excluded from the versioning scheme. {-# LANGUAGE BangPatterns #-}++-- | 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@@ -7,17 +8,18 @@  runRequest :: Int -> Int -> IO (Either ClientError a) -> IO (Either ClientError a) runRequest maxRetries !retryCount makeRequest =-  do res <- makeRequest-     case res of-       Right ok -> pure (Right ok)-       Left err@(ConnectionError _) -> maybeRetry err-       Left err@(FailureResponse _ resp)-         | responseStatusCode resp == conflict409 -> maybeRetry err-         | statusCode (responseStatusCode resp) >= 500 -> maybeRetry err-         | otherwise -> pure (Left err)-       Left err -> pure (Left err)+  do+    res <- makeRequest+    case res of+      Right ok -> pure (Right ok)+      Left err@(ConnectionError _) -> maybeRetry err+      Left err@(FailureResponse _ resp)+        | responseStatusCode resp == conflict409 -> maybeRetry err+        | statusCode (responseStatusCode resp) >= 500 -> maybeRetry err+        | otherwise -> pure (Left err)+      Left err -> pure (Left err)   where     maybeRetry err =       if retryCount + 1 >= maxRetries-      then pure (Left err)-      else runRequest maxRetries (retryCount + 1) makeRequest+        then pure (Left err)+        else runRequest maxRetries (retryCount + 1) makeRequest

@@ -1,26 +1,26 @@ module ApiSpec (apiSpec) where +import qualified Data.Text as T+import qualified Data.Vector as V import Network.HTTP.Client import Network.HTTP.Client.TLS+import OpenAI.Client import System.Environment (getEnv) import Test.Hspec-import qualified Data.Text as T-import qualified Data.Vector as V -import OpenAI.Client- makeClient :: IO OpenAIClient makeClient =-  do manager <- newManager tlsManagerSettings-     apiKey <- T.pack <$> getEnv "OPENAI_KEY"-     pure (makeOpenAIClient apiKey manager 2)+  do+    manager <- newManager tlsManagerSettings+    apiKey <- T.pack <$> getEnv "OPENAI_KEY"+    pure (makeOpenAIClient apiKey manager 2)  forceSuccess :: (MonadFail m, Show a) => m (Either a b) -> m b forceSuccess req =   req >>= \res ->-  case res of-    Left err -> fail (show err)-    Right ok -> pure ok+    case res of+      Left err -> fail (show err)+      Right ok -> pure ok  apiSpec :: Spec apiSpec =@@ -29,97 +29,129 @@ apiTests :: SpecWith () apiTests =   beforeAll makeClient $-  do describe "file api" $-       do it "allows creating one" $ \cli ->-            do let file =-                     FileCreate-                     { fcPurpose = "search"-                     , fcDocuments = [FileHunk "Test 1" Nothing, FileHunk "text 2" (Just "foo")]-                     }-               res <- forceSuccess $ createFile cli file-               _ <- forceSuccess $ deleteFile cli (fId res)-               pure ()-     describe "answer api" $-       do it "works" $ \cli ->-            do let file =-                     FileCreate-                     { fcPurpose = "search"-                     , fcDocuments =-                         [ FileHunk "Cities in California: San Francisco, Los Angeles" (Just "cali")-                         , FileHunk "Tasty fruit: Apple, Orange" (Just "fruit")-                         , FileHunk "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)-               _ <- forceSuccess $ deleteFile cli (fId res)-               pure ()-     describe "engines" $-       do it "lists engines" $ \cli ->-            do res <- forceSuccess $ listEngines cli-               V.null (olData res) `shouldBe` False+    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")+          V.null (olData res) `shouldBe` False+          let embedding = V.head (olData res)+          V.length (eEmbedding embedding) `shouldBe` 1024+      describe "fine tuning" $ do+        it "allows creating fine-tuning" $ \cli -> do+          let file =+                FileCreate+                  { fcPurpose = "fine-tune",+                    fcDocuments =+                      [ FhFineTune $ FineTuneHunk "So sad. Label:" "sad",+                        FhFineTune $ FineTuneHunk "So happy. Label:" "happy"+                      ]+                  }+          createRes <- forceSuccess $ createFile cli file+          let ftc = defaultFineTuneCreate (fId createRes)+          res <- forceSuccess $ createFineTune cli ftc+          ftStatus res `shouldBe` "pending"+      describe "engines" $+        do+          it "lists engines" $ \cli ->+            do+              res <- forceSuccess $ listEngines cli+              V.null (olData res) `shouldBe` False           it "retrieve engine" $ \cli ->-            do engineList <- forceSuccess $ listEngines cli-               let firstEngine = V.head (olData engineList)-               engine <- forceSuccess $ getEngine cli (eId firstEngine)-               engine `shouldBe` firstEngine-     describe "text completion" $-       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 ")-                 { 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 =-                         [ FileHunk "pool" (Just "pool")-                         , FileHunk "gym" (Just "gym")-                         , FileHunk "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"-               _ <- forceSuccess $ deleteFile cli (fId createRes)-               pure ()+            do+              engineList <- forceSuccess $ listEngines cli+              let firstEngine = V.head (olData engineList)+              engine <- forceSuccess $ getEngine cli (eId firstEngine)+              engine `shouldBe` firstEngine+      describe "text completion" $+        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 ")+                      { 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 ()

@@ -1,88 +1,96 @@ module HelperSpec (helperSpec) where  import Control.Exception.Base+import qualified Data.ByteString as BS import Data.IORef import Data.Maybe+import qualified Data.Sequence as Seq import Network.HTTP.Types.Header import Network.HTTP.Types.Status import Network.HTTP.Types.Version+import OpenAI.Client.Internal.Helpers import Servant.Client import Servant.Client.Core.Request import System.Exit import Test.Hspec-import qualified Data.ByteString as BS-import qualified Data.Sequence as Seq -import OpenAI.Client.Internal.Helpers- helperSpec :: Spec helperSpec =   do describe "retries" retryTests  makeFakeAction ::-  (Int -> Either ClientError a)-  -> IO (IO Int, IO (Either ClientError a))+  (Int -> Either ClientError a) ->+  IO (IO Int, IO (Either ClientError a)) makeFakeAction makeResult =-  do calls <- newIORef 0-     let action =-           do call <- atomicModifyIORef calls $ \i -> (i + 1, i)-              pure (makeResult call)-     pure (readIORef calls, action)+  do+    calls <- newIORef 0+    let action =+          do+            call <- atomicModifyIORef calls $ \i -> (i + 1, i)+            pure (makeResult call)+    pure (readIORef calls, action)  dummyReq :: RequestF () (BaseUrl, BS.ByteString) dummyReq =   defaultRequest-  { requestBody = Nothing-  , requestPath = (fromJust $ parseBaseUrl "api.example.com", "")-  }+    { requestBody = Nothing,+      requestPath = (fromJust $ parseBaseUrl "api.example.com", "")+    }  retryAction ::-  Int-  -> Status-  -> Seq.Seq Header-  -> IO (ClientError, IO Int, IO (Either ClientError Bool))+  Int ->+  Status ->+  Seq.Seq Header ->+  IO (ClientError, IO Int, IO (Either ClientError Bool)) retryAction n status headers =-  do let errResp =-           Response-           { responseStatusCode = status-           , responseHeaders = headers-           , responseHttpVersion = http11-           , responseBody = mempty-           }-         err = FailureResponse dummyReq errResp-     (getCalls, action) <--       makeFakeAction $ \call ->-       if call < n-       then Left $ err-       else Right True-     pure (err, getCalls, action)+  do+    let errResp =+          Response+            { responseStatusCode = status,+              responseHeaders = headers,+              responseHttpVersion = http11,+              responseBody = mempty+            }+        err = FailureResponse dummyReq errResp+    (getCalls, action) <-+      makeFakeAction $ \call ->+        if call < n+          then Left $ err+          else Right True+    pure (err, getCalls, action)  retryTests :: SpecWith () retryTests =-  do it "does not retry on success" $-       do (getCalls, action) <- makeFakeAction (const $ Right True)-          runRequest 10 0 action `shouldReturn` Right True-          getCalls `shouldReturn` 1-     it "retries on connection errors" $-       do (getCalls, action) <--            makeFakeAction $ \call ->+  do+    it "does not retry on success" $+      do+        (getCalls, action) <- makeFakeAction (const $ Right True)+        runRequest 10 0 action `shouldReturn` Right True+        getCalls `shouldReturn` 1+    it "retries on connection errors" $+      do+        (getCalls, action) <-+          makeFakeAction $ \call ->             if call == 0-            then Left (ConnectionError $ toException ExitSuccess)-            else Right True-          runRequest 10 0 action `shouldReturn` Right True-          getCalls `shouldReturn` 2-     it "retries on 409 status code" $-       do (_, getCalls, action) <--            retryAction 1 status409 mempty-          runRequest 10 0 action `shouldReturn` Right True-          getCalls `shouldReturn` 2-     it "retries on 500 status code" $-       do (_, getCalls, action) <--            retryAction 1 status500 mempty-          runRequest 10 0 action `shouldReturn` Right True-          getCalls `shouldReturn` 2-     it "does not retry on status 500 if limit exceeded" $-       do (err, getCalls, action) <--            retryAction 11 status500 mempty-          runRequest 10 0 action `shouldReturn` Left err-          getCalls `shouldReturn` 10+              then Left (ConnectionError $ toException ExitSuccess)+              else Right True+        runRequest 10 0 action `shouldReturn` Right True+        getCalls `shouldReturn` 2+    it "retries on 409 status code" $+      do+        (_, getCalls, action) <-+          retryAction 1 status409 mempty+        runRequest 10 0 action `shouldReturn` Right True+        getCalls `shouldReturn` 2+    it "retries on 500 status code" $+      do+        (_, getCalls, action) <-+          retryAction 1 status500 mempty+        runRequest 10 0 action `shouldReturn` Right True+        getCalls `shouldReturn` 2+    it "does not retry on status 500 if limit exceeded" $+      do+        (err, getCalls, action) <-+          retryAction 11 status500 mempty+        runRequest 10 0 action `shouldReturn` Left err+        getCalls `shouldReturn` 10

@@ -1,10 +1,10 @@-import Test.Hspec- import ApiSpec import HelperSpec+import Test.Hspec  main :: IO () main =   hspec $-  do apiSpec-     helperSpec+    do+      apiSpec+      helperSpec