diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Alexander Thiemann (c) 2020 +Copyright Alexander Thiemann (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-servant.cabal b/openai-servant.cabal --- a/openai-servant.cabal +++ b/openai-servant.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: d66854fa4f05fdb20cfe30829902f9bdd793c39e6b314aabbcb6568b637db03e +-- hash: fa6a579e19b730c3c7362a8966f384ff312aaceb6cf8cdceff036ed2ec48f90b name: openai-servant -version: 0.2.1.0 +version: 0.2.2.0 synopsis: Unofficial OpenAI servant types description: Unofficial description of the OpenAI API using servant types 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/Api.hs b/src/OpenAI/Api.hs --- a/src/OpenAI/Api.hs +++ b/src/OpenAI/Api.hs @@ -1,31 +1,38 @@ -- | The API - module OpenAI.Api where import OpenAI.Resources - import Servant.API import Servant.Multipart.API type OpenAIAuth = BasicAuth "OpenAI API" () -type OpenAIApi - = "v1" :> OpenAIApiInternal +type OpenAIApi = + "v1" :> OpenAIApiInternal -type OpenAIApiInternal - = "engines" :> EnginesApi - :<|> "files" :> FilesApi - :<|> AnswerApi +type OpenAIApiInternal = + "engines" :> EnginesApi + :<|> "files" :> FilesApi + :<|> AnswerApi + :<|> FineTuneApi -type FilesApi - = OpenAIAuth :> MultipartForm Mem FileCreate :> Post '[JSON] File - :<|> OpenAIAuth :> Capture "file_id" FileId :> Delete '[JSON] FileDeleteConfirmation +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 AnswerApi = + "answers" :> OpenAIAuth :> ReqBody '[JSON] AnswerReq :> Post '[JSON] AnswerResp -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) +type FineTuneApi = + OpenAIAuth :> "fine-tunes" :> ReqBody '[JSON] FineTuneCreate :> Post '[JSON] FineTune + :<|> OpenAIAuth :> "fine-tunes" :> Get '[JSON] (OpenAIList FineTune) + :<|> OpenAIAuth :> "fine-tunes" :> Capture "fine_tune_id" FineTuneId :> Get '[JSON] FineTune + :<|> OpenAIAuth :> "fine-tunes" :> Capture "fine_tune_id" FineTuneId :> "cancel" :> Post '[JSON] FineTune + :<|> OpenAIAuth :> "fine-tunes" :> Capture "fine_tune_id" FineTuneId :> "events" :> Get '[JSON] (OpenAIList FineTuneEvent) + +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] EmbeddingCreate :> Post '[JSON] (OpenAIList Embedding) diff --git a/src/OpenAI/Internal/Aeson.hs b/src/OpenAI/Internal/Aeson.hs --- a/src/OpenAI/Internal/Aeson.hs +++ b/src/OpenAI/Internal/Aeson.hs @@ -1,8 +1,5 @@ -- | - -module OpenAI.Internal.Aeson - ( jsonOpts, deriveJSON, ToJSON, FromJSON ) -where +module OpenAI.Internal.Aeson (jsonOpts, deriveJSON, ToJSON, FromJSON) where import Data.Aeson import Data.Aeson.TH @@ -11,7 +8,7 @@ jsonOpts :: Int -> Options jsonOpts x = defaultOptions - { fieldLabelModifier = quietSnake . drop x - , constructorTagModifier = quietSnake - , omitNothingFields = True - } + { fieldLabelModifier = quietSnake . drop x, + constructorTagModifier = quietSnake, + omitNothingFields = True + } diff --git a/src/OpenAI/Resources.hs b/src/OpenAI/Resources.hs --- a/src/OpenAI/Resources.hs +++ b/src/OpenAI/Resources.hs @@ -1,37 +1,65 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} + module OpenAI.Resources ( -- * Core Types - TimeStamp(..), OpenAIList(..) + TimeStamp (..), + OpenAIList (..), + -- * Engine - , EngineId(..), Engine(..) + EngineId (..), + Engine (..), + -- * Text completion - , TextCompletionId(..), TextCompletionChoice(..), TextCompletion(..), TextCompletionCreate(..) - , defaultTextCompletionCreate + TextCompletionId (..), + TextCompletionChoice (..), + TextCompletion (..), + TextCompletionCreate (..), + defaultTextCompletionCreate, + + -- * Embeddings + EmbeddingCreate (..), + Embedding (..), + + -- * Fine tuning + FineTuneId (..), + FineTuneCreate (..), + defaultFineTuneCreate, + FineTune (..), + FineTuneEvent (..), + -- * Searching - , SearchResult(..), SearchResultCreate(..) + SearchResult (..), + SearchResultCreate (..), + -- * File API - , FileCreate(..), FileId(..), File(..), FileHunk(..) - , FileDeleteConfirmation(..) + FileCreate (..), + FileId (..), + File (..), + FileHunk (..), + SearchHunk (..), + ClassificationHunk (..), + FineTuneHunk (..), + FileDeleteConfirmation (..), + -- * Answers API - , AnswerReq(..), AnswerResp(..) + AnswerReq (..), + AnswerResp (..), ) where -import OpenAI.Internal.Aeson - -import Data.Time -import Data.Time.Clock.POSIX -import Servant.API -import Servant.Multipart.API import qualified Data.Aeson as A import qualified Data.ByteString.Lazy as BSL import qualified Data.Text as T +import Data.Time +import Data.Time.Clock.POSIX import qualified Data.Vector as V +import OpenAI.Internal.Aeson +import Servant.API +import Servant.Multipart.API -- | A 'UTCTime' wrapper that has unix timestamp JSON representation -newtype TimeStamp - = TimeStamp { unTimeStamp :: UTCTime } +newtype TimeStamp = TimeStamp {unTimeStamp :: UTCTime} deriving (Show, Eq) instance A.ToJSON TimeStamp where @@ -40,22 +68,22 @@ instance A.FromJSON TimeStamp where parseJSON = A.withScientific "unix timestamp" $ \sci -> - pure $ TimeStamp $ posixSecondsToUTCTime (fromRational $ toRational sci) + pure $ TimeStamp $ posixSecondsToUTCTime (fromRational $ toRational sci) instance ToHttpApiData TimeStamp where toUrlPiece x = let unix :: Int unix = round . utcTimeToPOSIXSeconds . unTimeStamp $ x - in T.pack (show unix) + in T.pack (show unix) -- | A 'V.Vector' wrapper. -newtype OpenAIList a - = OpenAIList +newtype OpenAIList a = OpenAIList { olData :: V.Vector a - } deriving (Show, Eq, Functor) + } + deriving (Show, Eq, Functor) instance Semigroup (OpenAIList a) where - (<>) a b = OpenAIList (olData a <> olData b) + (<>) a b = OpenAIList (olData a <> olData b) instance Monoid (OpenAIList a) where mempty = OpenAIList mempty @@ -64,142 +92,220 @@ pure = OpenAIList . pure (<*>) go x = OpenAIList (olData go <*> olData x) -newtype EngineId - = EngineId { unEngineId :: T.Text } +newtype EngineId = EngineId {unEngineId :: T.Text} deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) -data Engine - = Engine - { eId :: EngineId - , eOwner :: T.Text - , eReady :: Bool - } deriving (Show, Eq) - +data Engine = Engine + { eId :: EngineId, + eOwner :: T.Text, + eReady :: Bool + } + deriving (Show, Eq) -newtype TextCompletionId - = TextCompletionId { unTextCompletionId :: T.Text } +newtype TextCompletionId = TextCompletionId {unTextCompletionId :: T.Text} deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) -data TextCompletionChoice - = TextCompletionChoice - { tccText :: T.Text - , tccIndex :: Int - , tccLogProps :: Maybe Int - , tccFinishReason :: T.Text - } deriving (Show, Eq) +data TextCompletionChoice = TextCompletionChoice + { tccText :: T.Text, + tccIndex :: Int, + tccLogProps :: Maybe Int, + tccFinishReason :: T.Text + } + deriving (Show, Eq) -data TextCompletion - = TextCompletion - { tcId :: TextCompletionId - , tcCreated :: TimeStamp - , tcModel :: T.Text - , tcChoices :: V.Vector TextCompletionChoice - } deriving (Show, Eq) +data TextCompletion = TextCompletion + { tcId :: TextCompletionId, + tcCreated :: TimeStamp, + tcModel :: T.Text, + tcChoices :: V.Vector TextCompletionChoice + } + deriving (Show, Eq) -data TextCompletionCreate - = TextCompletionCreate - { tccrPrompt :: T.Text -- TODO: support lists of strings - , tccrMaxTokens :: Maybe Int - , tccrTemperature :: Maybe Double - , tccrTopP :: Maybe Double - , tccrN :: Maybe Int - , tccrLogprobs :: Maybe Int - , tccrEcho :: Maybe Bool - , tccrStop :: Maybe (V.Vector T.Text) - , tccrPresencePenalty :: Maybe Double - , tccrFrequencyPenalty :: Maybe Double - , tccrBestOf :: Maybe Int - } deriving (Show, Eq) +data TextCompletionCreate = TextCompletionCreate + { tccrPrompt :: T.Text, -- TODO: support lists of strings + tccrMaxTokens :: Maybe Int, + tccrTemperature :: Maybe Double, + tccrTopP :: Maybe Double, + tccrN :: Maybe Int, + tccrLogprobs :: Maybe Int, + tccrEcho :: Maybe Bool, + tccrStop :: Maybe (V.Vector T.Text), + tccrPresencePenalty :: Maybe Double, + tccrFrequencyPenalty :: Maybe Double, + tccrBestOf :: Maybe Int + } + deriving (Show, Eq) -- | Applies API defaults, only passing a prompt. defaultTextCompletionCreate :: T.Text -> TextCompletionCreate defaultTextCompletionCreate prompt = TextCompletionCreate - { tccrPrompt = prompt - , tccrMaxTokens = Nothing - , tccrTemperature = Nothing - , tccrTopP = Nothing - , tccrN = Nothing - , tccrLogprobs = Nothing - , tccrEcho = Nothing - , tccrStop = Nothing - , tccrPresencePenalty = Nothing - , tccrFrequencyPenalty = Nothing - , tccrBestOf = Nothing + { tccrPrompt = prompt, + tccrMaxTokens = Nothing, + tccrTemperature = Nothing, + tccrTopP = Nothing, + tccrN = Nothing, + tccrLogprobs = Nothing, + tccrEcho = Nothing, + tccrStop = Nothing, + tccrPresencePenalty = Nothing, + tccrFrequencyPenalty = Nothing, + tccrBestOf = Nothing + } + +data EmbeddingCreate = EmbeddingCreate + {ecInput :: T.Text} + deriving (Show, Eq) + +data Embedding = Embedding + {eEmbedding :: V.Vector Double, eIndex :: Int} + deriving (Show, Eq) + +newtype FineTuneId = FineTuneId {unFineTuneId :: T.Text} + deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) + +data FineTuneCreate = FineTuneCreate + { ftcTrainingFile :: FileId, + ftcValidationFile :: Maybe FileId, + ftcModel :: Maybe T.Text, + ftcBatchSize :: Maybe Int, + ftcNEpochs :: Maybe T.Text, + ftcLearningRateMultiplier :: Maybe Double, + ftcPromptLossWeight :: Maybe Double, + ftcComputeClassificationMetrics :: Maybe Bool, + ftcClassificationNClasses :: Maybe Int, + ftcClassificationPositiveClass :: Maybe T.Text } + deriving (Show, Eq) -data SearchResult - = SearchResult - { srDocument :: Int - , srScore :: Double - , srMetadata :: Maybe T.Text - } deriving (Show, Eq) +defaultFineTuneCreate :: FileId -> FineTuneCreate +defaultFineTuneCreate file = + FineTuneCreate + { ftcTrainingFile = file, + ftcValidationFile = Nothing, + ftcModel = Nothing, + ftcBatchSize = Nothing, + ftcNEpochs = Nothing, + ftcLearningRateMultiplier = Nothing, + ftcPromptLossWeight = Nothing, + ftcComputeClassificationMetrics = Nothing, + ftcClassificationNClasses = Nothing, + ftcClassificationPositiveClass = Nothing + } -data SearchResultCreate - = SearchResultCreate - { sccrFile :: Maybe FileId - , sccrDocuments :: Maybe (V.Vector T.Text) - , sccrQuery :: T.Text - , sccrReturnMetadata :: Bool - } deriving (Show, Eq) +data FineTuneEvent = FineTuneEvent + { fteCreatedAt :: Int, + fteLevel :: T.Text, + fteMessage :: T.Text + } + deriving (Show, Eq) +data FineTune = FineTune + { ftId :: FineTuneId, + ftModel :: T.Text, + ftCreatedAt :: Int, + ftEvents :: V.Vector FineTuneEvent, + ftTunedModel :: Maybe T.Text, + ftStatus :: T.Text + } + 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) + +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 - = FileHunk - { fhContent :: T.Text - , fhMetadata :: Maybe T.Text - } deriving (Show, Eq) + = FhSearch SearchHunk + | FhClassifications ClassificationHunk + | FhFineTune FineTuneHunk + deriving (Show, Eq) -data FileCreate - = FileCreate - { fcPurpose :: T.Text - , fcDocuments :: [FileHunk] - } deriving (Show, Eq) +data FileCreate = FileCreate + { fcPurpose :: T.Text, + fcDocuments :: [FileHunk] + } + deriving (Show, Eq) packDocuments :: [FileHunk] -> BSL.ByteString packDocuments docs = BSL.intercalate "\n" $ - map (\t -> A.encode $ A.object ["text" A..= fhContent t, "metadata" A..= fhMetadata t]) docs + 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) - ] + [ Input "purpose" (fcPurpose rfc) + ] + [ FileData "file" "data.jsonl" "application/json" (packDocuments $ fcDocuments rfc) + ] -newtype FileId - = FileId { unFileId :: T.Text } +newtype FileId = FileId {unFileId :: T.Text} deriving (Show, Eq, ToJSON, FromJSON, ToHttpApiData) -data File - = File - { fId :: FileId - , fCreatedAt :: TimeStamp - , fPurpose :: T.Text - } deriving (Show, Eq) +data File = File + { fId :: FileId, + fCreatedAt :: TimeStamp, + fPurpose :: T.Text + } + deriving (Show, Eq) -data FileDeleteConfirmation - = FileDeleteConfirmation +data FileDeleteConfirmation = FileDeleteConfirmation { fdcId :: FileId - } deriving (Show, Eq) + } + deriving (Show, Eq) -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 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 +data AnswerResp = AnswerResp { arsAnswers :: [T.Text] - } deriving (Show, Eq) + } + deriving (Show, Eq) $(deriveJSON (jsonOpts 2) ''OpenAIList) $(deriveJSON (jsonOpts 1) ''Engine) @@ -212,3 +318,11 @@ $(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)