diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Author name here (c) 2020 +Copyright Author name here (c) 2021-2022 All rights reserved. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/openai-hs.cabal b/openai-hs.cabal --- a/openai-hs.cabal +++ b/openai-hs.cabal @@ -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 maintainer: Alexander Thiemann -copyright: 2021 Alexander Thiemann +copyright: 2021-2022 Alexander Thiemann license: BSD3 license-file: LICENSE build-type: Simple diff --git a/src/OpenAI/Client.hs b/src/OpenAI/Client.hs --- a/src/OpenAI/Client.hs +++ b/src/OpenAI/Client.hs @@ -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-@ 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 diff --git a/src/OpenAI/Client/Internal/Helpers.hs b/src/OpenAI/Client/Internal/Helpers.hs --- a/src/OpenAI/Client/Internal/Helpers.hs +++ b/src/OpenAI/Client/Internal/Helpers.hs @@ -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 diff --git a/test/ApiSpec.hs b/test/ApiSpec.hs --- a/test/ApiSpec.hs +++ b/test/ApiSpec.hs @@ -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 () diff --git a/test/HelperSpec.hs b/test/HelperSpec.hs --- a/test/HelperSpec.hs +++ b/test/HelperSpec.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,10 +1,10 @@ -import Test.Hspec - import ApiSpec import HelperSpec +import Test.Hspec main :: IO () main = hspec $ - do apiSpec - helperSpec + do + apiSpec + helperSpec