diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +1.0.0: + +- Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2024, Gabriella Gonzalez + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Gabriella Gonzalez nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/openai-example/Main.hs b/openai-example/Main.hs new file mode 100644 --- /dev/null +++ b/openai-example/Main.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} + +module Main where + +import Data.Foldable (traverse_) +import OpenAI.V1 +import OpenAI.V1.Chat.Completions + +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified System.Environment as Environment + +main :: IO () +main = do + key <- Environment.getEnv "OPENAI_KEY" + + clientEnv <- getClientEnv "https://api.openai.com" + + let Methods{ createChatCompletion } = makeMethods clientEnv (Text.pack key) + + text <- Text.IO.getLine + + ChatCompletionObject{ choices } <- createChatCompletion _CreateChatCompletion + { messages = [ User{ content = [ Text{ text } ], name = Nothing } ] + , model = "gpt-4o-mini" + } + + let display Choice{ message } = Text.IO.putStrLn (messageToContent message) + + traverse_ display choices diff --git a/openai.cabal b/openai.cabal new file mode 100644 --- /dev/null +++ b/openai.cabal @@ -0,0 +1,114 @@ +cabal-version: 2.4 +name: openai +version: 1.0.0 +synopsis: Servant bindings to OpenAI +description: This package provides comprehensive and type-safe bindings + to OpenAI using Servant +license: BSD-3-Clause +license-file: LICENSE +author: Gabriella Gonzalez +maintainer: GenuineGabriella@gmail.com +copyright: 2024 Gabriella Gonzalez +build-type: Simple +extra-source-files: CHANGELOG.md + +library + default-language: Haskell2010 + hs-source-dirs: src + build-depends: base >=4.15.0.0 && < 5 + , aeson + , bytestring + , containers + , filepath + , http-api-data + , http-client-tls + , servant + , servant-multipart-api + , servant-client + , servant-multipart-client + , text + , time + , vector + exposed-modules: OpenAI.V1 + OpenAI.V1.Assistants + OpenAI.V1.Audio + OpenAI.V1.Audio.Speech + OpenAI.V1.Audio.Transcriptions + OpenAI.V1.Audio.Translations + OpenAI.V1.AutoOr + OpenAI.V1.Batches + OpenAI.V1.Chat.Completions + OpenAI.V1.ChunkingStrategy + OpenAI.V1.DeletionStatus + OpenAI.V1.Embeddings + OpenAI.V1.Error + OpenAI.V1.Files + OpenAI.V1.FineTuning.Jobs + OpenAI.V1.Images + OpenAI.V1.Images.Edits + OpenAI.V1.Images.Generations + OpenAI.V1.Images.Image + OpenAI.V1.Images.ResponseFormat + OpenAI.V1.Images.Variations + OpenAI.V1.ListOf + OpenAI.V1.Message + OpenAI.V1.Models + OpenAI.V1.Moderations + OpenAI.V1.Order + OpenAI.V1.ResponseFormat + OpenAI.V1.Threads + OpenAI.V1.Threads.Messages + OpenAI.V1.Threads.Runs + OpenAI.V1.Threads.Runs.Steps + OpenAI.V1.Tool + OpenAI.V1.ToolCall + OpenAI.V1.ToolResources + OpenAI.V1.Uploads + OpenAI.V1.Usage + OpenAI.V1.VectorStores + OpenAI.V1.VectorStores.FileCounts + OpenAI.V1.VectorStores.Files + OpenAI.V1.VectorStores.FileBatches + OpenAI.V1.VectorStores.Status + other-modules: OpenAI.Prelude + default-extensions: DataKinds + , DeriveAnyClass + , DeriveGeneric + , DerivingStrategies + , DuplicateRecordFields + , FlexibleInstances + , GeneralizedNewtypeDeriving + , OverloadedLists + , OverloadedStrings + , RecordWildCards + , MultiParamTypeClasses + , NamedFieldPuns + , TypeApplications + , TypeOperators + , ViewPatterns + ghc-options: -Wall -Wno-missing-fields + +test-suite tasty + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: tasty + main-is: Main.hs + build-depends: base + , aeson + , http-client + , http-client-tls + , openai + , servant-client + , tasty + , tasty-hunit + , text + ghc-options: -Wall + +executable openai-example + default-language: Haskell2010 + hs-source-dirs: openai-example + main-is: Main.hs + build-depends: base + , openai + , text + ghc-options: -Wall diff --git a/src/OpenAI/Prelude.hs b/src/OpenAI/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/Prelude.hs @@ -0,0 +1,125 @@ +module OpenAI.Prelude + ( -- * JSON + aesonOptions + , stripPrefix + , labelModifier + + -- * Multipart Form Data + , input + , renderIntegral + , renderRealFloat + , getExtension + + -- * Re-exports + , module Data.Aeson + , module Data.ByteString.Lazy + , module Data.List.NonEmpty + , module Data.Map + , module Data.String + , module Data.Text + , module Data.Time.Clock.POSIX + , module Data.Vector + , module Data.Void + , module Data.Word + , module GHC.Generics + , module Numeric.Natural + , module Servant.API + , module Servant.Multipart.API + , module Web.HttpApiData + ) where + +import Data.ByteString.Lazy (ByteString) +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Map (Map) +import Data.Text (Text) +import Data.Time.Clock.POSIX (POSIXTime) +import Data.Vector (Vector) +import Data.Void (Void) +import GHC.Generics (Generic) +import Data.String (IsString(..)) +import Data.Word (Word8) +import Numeric.Natural (Natural) +import Web.HttpApiData (ToHttpApiData(..)) + +import Data.Aeson + ( FromJSON(..) + , ToJSON(..) + , Options(..) + , SumEncoding(..) + , Value(..) + , genericParseJSON + , genericToJSON + ) +import Servant.API + ( Accept(..) + , Capture + , Delete + , Get + , Header' + , JSON + , MimeUnrender(..) + , OctetStream + , Post + , QueryParam + , ReqBody + , Required + , Strict + , (:<|>)(..) + , (:>) + ) +import Servant.Multipart.API + ( FileData(..) + , Input(..) + , MultipartData(..) + , MultipartForm + , ToMultipart(..) + , Tmp + ) + +import qualified Data.Aeson as Aeson +import qualified Data.Char as Char +import qualified Data.List as List +import qualified Data.Text as Text +import qualified Data.Text.Lazy as Text.Lazy +import qualified Data.Text.Lazy.Builder as Builder +import qualified Data.Text.Lazy.Builder.RealFloat as RealFloat +import qualified Data.Text.Lazy.Builder.Int as Int +import qualified System.FilePath as FilePath + +dropTrailingUnderscore :: String -> String +dropTrailingUnderscore "_" = "" +dropTrailingUnderscore "" = "" +dropTrailingUnderscore (c : cs) = c : dropTrailingUnderscore cs + +labelModifier :: String -> String +labelModifier = map Char.toLower . dropTrailingUnderscore + +stripPrefix :: String -> String -> String +stripPrefix prefix string = labelModifier suffix + where + suffix = case List.stripPrefix prefix string of + Nothing -> string + Just x -> x + +aesonOptions :: Options +aesonOptions = Aeson.defaultOptions + { fieldLabelModifier = labelModifier + , constructorTagModifier = labelModifier + , omitNothingFields = True + } + +input :: Text -> Text -> [ Input ] +input iName iValue = [ Input{..} ] + +renderIntegral :: Integral number => number -> Text +renderIntegral number = Text.Lazy.toStrict (Builder.toLazyText builder) + where + builder = Int.decimal number + +renderRealFloat :: RealFloat number => number -> Text +renderRealFloat number = Text.Lazy.toStrict (Builder.toLazyText builder) + where + builder = RealFloat.formatRealFloat RealFloat.Fixed Nothing number + +getExtension :: FilePath -> Text +getExtension file = Text.pack (drop 1 (FilePath.takeExtension file)) diff --git a/src/OpenAI/V1.hs b/src/OpenAI/V1.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1.hs @@ -0,0 +1,505 @@ +-- | @\/v1@ +module OpenAI.V1 + ( -- * Methods + getClientEnv + , makeMethods + , Methods(..) + + -- * Servant + , API + ) where + +import Data.ByteString.Char8 () +import Data.Proxy (Proxy(..)) +import OpenAI.Prelude +import OpenAI.V1.Audio.Speech (CreateSpeech) +import OpenAI.V1.Embeddings (CreateEmbeddings, EmbeddingObject) +import OpenAI.V1.Batches (BatchID, BatchObject, CreateBatch) +import OpenAI.V1.DeletionStatus (DeletionStatus) +import OpenAI.V1.Files (FileID, FileObject, UploadFile) +import OpenAI.V1.Images.Image (ImageObject) +import OpenAI.V1.Images.Generations (CreateImage) +import OpenAI.V1.Images.Edits (CreateImageEdit) +import OpenAI.V1.Images.Variations (CreateImageVariation) +import OpenAI.V1.ListOf (ListOf(..)) +import OpenAI.V1.Message (Message) +import OpenAI.V1.Models (Model, ModelObject) +import OpenAI.V1.Moderations (CreateModeration, Moderation) +import OpenAI.V1.Order (Order) +import OpenAI.V1.Threads (Thread, ThreadID, ModifyThread, ThreadObject) +import OpenAI.V1.Threads.Runs.Steps (RunStepObject(..), StepID) +import Servant.Client (ClientEnv) +import Servant.Multipart.Client () + +import OpenAI.V1.Assistants + (AssistantID, AssistantObject, CreateAssistant, ModifyAssistant) +import OpenAI.V1.Audio.Transcriptions + (CreateTranscription, TranscriptionObject) +import OpenAI.V1.Audio.Translations + (CreateTranslation, TranslationObject) +import OpenAI.V1.Chat.Completions + (ChatCompletionObject, CreateChatCompletion) +import OpenAI.V1.FineTuning.Jobs + ( CheckpointObject + , CreateFineTuningJob + , EventObject + , FineTuningJobID + , JobObject + ) +import OpenAI.V1.Threads.Messages + (MessageID, MessageObject, ModifyMessage) +import OpenAI.V1.Threads.Runs + ( CreateRun + , CreateThreadAndRun + , ModifyRun + , RunID + , RunObject + , SubmitToolOutputsToRun + ) +import OpenAI.V1.Uploads + ( AddUploadPart + , CompleteUpload + , CreateUpload + , PartObject + , UploadID + , UploadObject + ) +import OpenAI.V1.VectorStores + ( CreateVectorStore(..) + , ModifyVectorStore(..) + , VectorStoreID + , VectorStoreObject(..) + ) +import OpenAI.V1.VectorStores.Files + ( CreateVectorStoreFile(..) + , VectorStoreFileID + , VectorStoreFileObject(..) + ) +import OpenAI.V1.VectorStores.FileBatches + ( CreateVectorStoreFileBatch(..) + , VectorStoreFilesBatchObject(..) + , VectorStoreFileBatchID + ) + +import qualified Control.Exception as Exception +import qualified Data.Text as Text +import qualified Network.HTTP.Client.TLS as TLS +import qualified OpenAI.V1.Assistants as Assistants +import qualified OpenAI.V1.Audio as Audio +import qualified OpenAI.V1.Batches as Batches +import qualified OpenAI.V1.Chat.Completions as Chat.Completions +import qualified OpenAI.V1.Embeddings as Embeddings +import qualified OpenAI.V1.FineTuning.Jobs as FineTuning.Jobs +import qualified OpenAI.V1.Files as Files +import qualified OpenAI.V1.Images as Images +import qualified OpenAI.V1.Models as Models +import qualified OpenAI.V1.Moderations as Moderations +import qualified OpenAI.V1.Threads.Runs as Threads.Runs +import qualified OpenAI.V1.Threads.Runs.Steps as Threads.Runs.Steps +import qualified OpenAI.V1.Threads as Threads +import qualified OpenAI.V1.Threads.Messages as Messages +import qualified OpenAI.V1.Uploads as Uploads +import qualified OpenAI.V1.VectorStores as VectorStores +import qualified OpenAI.V1.VectorStores.Files as VectorStores.Files +import qualified OpenAI.V1.VectorStores.FileBatches as VectorStores.FileBatches +import qualified OpenAI.V1.VectorStores.Status as VectorStores.Status +import qualified Servant.Client as Client + +-- | Convenient utility to get a `ClientEnv` for the most common use case +getClientEnv + :: Text + -- ^ Base URL for API + -> IO ClientEnv +getClientEnv baseUrlText = do + baseUrl <- Client.parseBaseUrl (Text.unpack baseUrlText) + manager <- TLS.newTlsManager + pure (Client.mkClientEnv manager baseUrl) + +-- | Get a record of API methods after providing an API token +makeMethods + :: ClientEnv + -- ^ + -> Text + -- ^ API token + -> Methods +makeMethods clientEnv token = Methods{..} + where + authorization = "Bearer " <> token + + ( ( createSpeech + :<|> createTranscription_ + :<|> createTranslation_ + ) + :<|> createChatCompletion + :<|> createEmbeddings_ + :<|> ( createFineTuningJob + :<|> listFineTuningJobs_ + :<|> listFineTuningEvents_ + :<|> listFineTuningCheckpoints_ + :<|> retrieveFineTuningJob + :<|> cancelFineTuning + ) + :<|> ( createBatch + :<|> retrieveBatch + :<|> cancelBatch + :<|> listBatch_ + ) + :<|> ( uploadFile_ + :<|> listFiles_ + :<|> retrieveFile + :<|> deleteFile + :<|> retrieveFileContent + ) + :<|> ( createImage_ + :<|> createImageEdit_ + :<|> createImageVariation_ + ) + :<|> ( createUpload + :<|> addUploadPart_ + :<|> completeUpload + :<|> cancelUpload + ) + :<|> ( listModels_ + :<|> retrieveModel + :<|> deleteModel + ) + :<|> ( createModeration + ) + :<|> ( (\x -> x "assistants=v2") + -> ( createAssistant + :<|> listAssistants_ + :<|> retrieveAssistant + :<|> modifyAssistant + :<|> deleteAssistant + ) + ) + :<|> ( (\x -> x "assistants=v2") + -> ( createThread + :<|> retrieveThread + :<|> modifyThread + :<|> deleteThread + ) + ) + :<|> ( (\x -> x "assistants=v2") + -> ( createMessage + :<|> listMessages_ + :<|> retrieveMessage + :<|> modifyMessage + :<|> deleteMessage + ) + ) + :<|> ( (\x -> x "assistants=v2") + -> ( createRun + :<|> createThreadAndRun + :<|> listRuns_ + :<|> retrieveRun + :<|> modifyRun + :<|> submitToolOutputsToRun + :<|> cancelRun + ) + ) + :<|> ( (\x -> x "assistants=v2") + -> ( listRunSteps_ + :<|> retrieveRunStep + ) + ) + :<|> ( (\x -> x "assistants=v2") + -> ( createVectorStore + :<|> listVectorStores_ + :<|> retrieveVectorStore + :<|> modifyVectorStore + :<|> deleteVectorStore + ) + ) + :<|> ( (\x -> x "assistants=v2") + -> ( createVectorStoreFile + :<|> listVectorStoreFiles_ + :<|> retrieveVectorStoreFile + :<|> deleteVectorStoreFile + ) + ) + :<|> ( (\x -> x "assistants=v2") + -> ( createVectorStoreFileBatch + :<|> retrieveVectorStoreFileBatch + :<|> cancelVectorStoreFileBatch + :<|> listVectorStoreFilesInABatch_ + ) + ) + ) = Client.hoistClient @API Proxy run (Client.client @API Proxy) authorization + + run :: Client.ClientM a -> IO a + run clientM = do + result <- Client.runClientM clientM clientEnv + case result of + Left exception -> Exception.throwIO exception + Right a -> return a + + toVector :: IO (ListOf a) -> IO (Vector a) + toVector = fmap adapt + where + adapt List{ data_ } = data_ + + createTranscription a = createTranscription_ (boundary, a) + createTranslation a = createTranslation_ (boundary, a) + createEmbeddings a = toVector (createEmbeddings_ a) + listFineTuningJobs a b = toVector (listFineTuningJobs_ a b) + listFineTuningEvents a b c = toVector (listFineTuningEvents_ a b c) + listFineTuningCheckpoints a b c = + toVector (listFineTuningCheckpoints_ a b c) + listBatch a b = toVector (listBatch_ a b) + uploadFile a = uploadFile_ (boundary, a) + listFiles a b c d = toVector (listFiles_ a b c d) + addUploadPart a b = addUploadPart_ a (boundary, b) + createImage a = toVector (createImage_ a) + createImageEdit a = toVector (createImageEdit_ (boundary, a)) + createImageVariation a = toVector (createImageVariation_ (boundary, a)) + listModels = toVector listModels_ + listAssistants a b c d = toVector (listAssistants_ a b c d) + listMessages a = toVector (listMessages_ a) + listRuns a b c d e = toVector (listRuns_ a b c d e) + listRunSteps a b c d e f g = toVector (listRunSteps_ a b c d e f g) + listVectorStores a b c d = toVector (listVectorStores_ a b c d) + listVectorStoreFiles a b c d e f = + toVector (listVectorStoreFiles_ a b c d e f) + listVectorStoreFilesInABatch a b c d e f g = + toVector (listVectorStoreFilesInABatch_ a b c d e f g) + +-- | Hard-coded boundary to simplify the user-experience +-- +-- I don't understand why `multipart-servant-client` insists on generating a +-- fresh boundary for each request (or why it doesn't handle that for you) +boundary :: ByteString +boundary = "j3qdD3XtDVjvva8IIqoBzHQAYwCenObtPMkxAFnylwFyU5xffWKoYrY" + +-- | API methods +data Methods = Methods + { createSpeech :: CreateSpeech -> IO ByteString + , createTranscription :: CreateTranscription -> IO TranscriptionObject + , createTranslation :: CreateTranslation -> IO TranslationObject + , createChatCompletion :: CreateChatCompletion -> IO ChatCompletionObject + , createEmbeddings :: CreateEmbeddings -> IO (Vector EmbeddingObject) + , createFineTuningJob :: CreateFineTuningJob -> IO JobObject + , listFineTuningJobs + :: Maybe Text + -- ^ after + -> Maybe Natural + -- ^ limit + -> IO (Vector JobObject) + , listFineTuningEvents + :: FineTuningJobID + -- ^ + -> Maybe Text + -- ^ after + -> Maybe Natural + -- ^ limit + -> IO (Vector EventObject) + , listFineTuningCheckpoints + :: FineTuningJobID + -- ^ + -> Maybe Text + -- ^ after + -> Maybe Natural + -- ^ limit + -> IO (Vector CheckpointObject) + , retrieveFineTuningJob :: FineTuningJobID -> IO JobObject + , cancelFineTuning :: FineTuningJobID -> IO JobObject + , createBatch :: CreateBatch -> IO BatchObject + , retrieveBatch :: BatchID -> IO BatchObject + , cancelBatch :: BatchID -> IO BatchObject + , listBatch + :: Maybe Text + -- ^ after + -> Maybe Natural + -- ^ limit + -> IO (Vector BatchObject) + , uploadFile :: UploadFile -> IO FileObject + , listFiles + :: Maybe Files.Purpose + -- ^ purpose + -> Maybe Natural + -- ^ limit + -> Maybe Order + -- ^ order + -> Maybe Text + -- ^ after + -> IO (Vector FileObject) + , retrieveFile :: FileID -> IO FileObject + , deleteFile :: FileID -> IO DeletionStatus + , retrieveFileContent :: FileID -> IO ByteString + , createUpload + :: CreateUpload -> IO (UploadObject (Maybe Void)) + , addUploadPart :: UploadID -> AddUploadPart -> IO PartObject + , completeUpload + :: UploadID -> CompleteUpload -> IO (UploadObject FileObject) + , cancelUpload :: UploadID -> IO (UploadObject (Maybe Void)) + , createImage :: CreateImage -> IO (Vector ImageObject) + , createImageEdit :: CreateImageEdit -> IO (Vector ImageObject) + , createImageVariation :: CreateImageVariation -> IO (Vector ImageObject) + , listModels :: IO (Vector ModelObject) + , retrieveModel :: Model -> IO ModelObject + , deleteModel :: Model -> IO DeletionStatus + , createModeration :: CreateModeration -> IO Moderation + , createAssistant :: CreateAssistant -> IO AssistantObject + , listAssistants + :: Maybe Natural + -- ^ limit + -> Maybe Order + -- ^ order + -> Maybe Text + -- ^ after + -> Maybe Text + -- ^ before + -> IO (Vector AssistantObject) + , retrieveAssistant :: AssistantID -> IO AssistantObject + , modifyAssistant :: AssistantID -> ModifyAssistant -> IO AssistantObject + , deleteAssistant :: AssistantID -> IO DeletionStatus + , createThread :: Thread -> IO ThreadObject + , retrieveThread :: ThreadID -> IO ThreadObject + , modifyThread :: ThreadID -> ModifyThread -> IO ThreadObject + , deleteThread :: ThreadID -> IO DeletionStatus + , createMessage :: ThreadID -> Message -> IO MessageObject + , listMessages :: ThreadID -> IO (Vector MessageObject) + , retrieveMessage :: ThreadID -> MessageID -> IO MessageObject + , modifyMessage + :: ThreadID -> MessageID -> ModifyMessage -> IO MessageObject + , deleteMessage :: ThreadID -> MessageID -> IO DeletionStatus + , createRun + :: ThreadID + -- ^ + -> Maybe Text + -- ^ include[] + -> CreateRun + -- ^ + -> IO RunObject + , createThreadAndRun :: CreateThreadAndRun -> IO RunObject + , listRuns + :: ThreadID + -- ^ + -> Maybe Natural + -- ^ limit + -> Maybe Order + -- ^ order + -> Maybe Text + -- ^ after + -> Maybe Text + -- ^ before + -> IO (Vector RunObject) + , retrieveRun :: ThreadID -> RunID -> IO RunObject + , modifyRun :: ThreadID -> RunID -> ModifyRun -> IO RunObject + , submitToolOutputsToRun + :: ThreadID -> RunID -> SubmitToolOutputsToRun -> IO RunObject + , cancelRun :: ThreadID -> RunID -> IO RunObject + , listRunSteps + :: ThreadID + -- ^ + -> RunID + -- ^ + -> Maybe Natural + -- ^ limit + -> Maybe Order + -- ^ order + -> Maybe Text + -- ^ after + -> Maybe Text + -- ^ before + -> Maybe Text + -- ^ include[] + -> IO (Vector RunStepObject) + , retrieveRunStep + :: ThreadID + -- ^ + -> RunID + -- ^ + -> StepID + -- ^ + -> Maybe Text + -- ^ include[] + -> IO RunStepObject + , createVectorStore :: CreateVectorStore -> IO VectorStoreObject + , listVectorStores + :: Maybe Natural + -- ^ limit + -> Maybe Order + -- ^ order + -> Maybe Text + -- ^ after + -> Maybe Text + -- ^ before + -> IO (Vector VectorStoreObject) + , retrieveVectorStore :: VectorStoreID -> IO VectorStoreObject + , modifyVectorStore + :: VectorStoreID -> ModifyVectorStore -> IO VectorStoreObject + , deleteVectorStore :: VectorStoreID -> IO DeletionStatus + , createVectorStoreFile + :: VectorStoreID -> CreateVectorStoreFile -> IO VectorStoreFileObject + , listVectorStoreFiles + :: VectorStoreID + -- ^ + -> Maybe Natural + -- ^ limit + -> Maybe Order + -- ^ order + -> Maybe Text + -- ^ after + -> Maybe Text + -- ^ before + -> Maybe VectorStores.Status.Status + -- ^ filter + -> IO (Vector VectorStoreFileObject) + , retrieveVectorStoreFile + :: VectorStoreID -> VectorStoreFileID -> IO VectorStoreFileObject + , deleteVectorStoreFile + :: VectorStoreID -> VectorStoreFileID -> IO DeletionStatus + , createVectorStoreFileBatch + :: VectorStoreID + -> CreateVectorStoreFileBatch + -> IO VectorStoreFilesBatchObject + , retrieveVectorStoreFileBatch + :: VectorStoreID + -> VectorStoreFileBatchID + -> IO VectorStoreFilesBatchObject + , cancelVectorStoreFileBatch + :: VectorStoreID + -> VectorStoreFileBatchID + -> IO VectorStoreFilesBatchObject + , listVectorStoreFilesInABatch + :: VectorStoreID + -- ^ + -> VectorStoreFileBatchID + -- ^ + -> Maybe Natural + -- ^ limit + -> Maybe Order + -- ^ order + -> Maybe Text + -- ^ after + -> Maybe Text + -- ^ before + -> Maybe VectorStores.Status.Status + -- ^ filter + -> IO (Vector VectorStoreFilesBatchObject) + } + +-- | Servant API +type API + = Header' [ Required, Strict ] "Authorization" Text + :> "v1" + :> ( Audio.API + :<|> Chat.Completions.API + :<|> Embeddings.API + :<|> FineTuning.Jobs.API + :<|> Batches.API + :<|> Files.API + :<|> Images.API + :<|> Uploads.API + :<|> Models.API + :<|> Moderations.API + :<|> Assistants.API + :<|> Threads.API + :<|> Messages.API + :<|> Threads.Runs.API + :<|> Threads.Runs.Steps.API + :<|> VectorStores.API + :<|> VectorStores.Files.API + :<|> VectorStores.FileBatches.API + ) diff --git a/src/OpenAI/V1/Assistants.hs b/src/OpenAI/V1/Assistants.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Assistants.hs @@ -0,0 +1,136 @@ +-- | @\/v1\/assistants@ +module OpenAI.V1.Assistants + ( -- * Main types + AssistantID(..) + , CreateAssistant(..) + , _CreateAssistant + , ModifyAssistant(..) + , _ModifyAssistant + , AssistantObject(..) + + -- * Other types + , RankingOptions + , FileSearch(..) + , Function(..) + , Tool(..) + , CodeInterpreterResources(..) + , FileSearchResources(..) + , ToolResources(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.AutoOr +import OpenAI.V1.DeletionStatus +import OpenAI.V1.ListOf +import OpenAI.V1.Models (Model) +import OpenAI.V1.Order +import OpenAI.V1.ResponseFormat +import OpenAI.V1.Tool +import OpenAI.V1.ToolResources + +-- | AssistantID +newtype AssistantID = AssistantID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Request body for @\/v1\/assistants@ +data CreateAssistant = CreateAssistant + { model :: Model + , name :: Maybe Text + , description :: Maybe Text + , instructions :: Maybe Text + , tools :: Maybe (Vector Tool) + , tool_resources :: Maybe ToolResources + , metadata :: Maybe (Map Text Text) + , temperature :: Maybe Double + , top_p :: Maybe Double + , response_format :: Maybe (AutoOr ResponseFormat) + } deriving stock (Generic, Show) + +instance ToJSON CreateAssistant where + toJSON = genericToJSON aesonOptions + +-- | Default `CreateAssistant` +_CreateAssistant :: CreateAssistant +_CreateAssistant = CreateAssistant + { name = Nothing + , description = Nothing + , instructions = Nothing + , tools = Nothing + , tool_resources = Nothing + , metadata = Nothing + , temperature = Nothing + , top_p = Nothing + , response_format = Nothing + } + +-- | Request body for @\/v1\/assistants/:assistant_id@ +data ModifyAssistant = ModifyAssistant + { model :: Model + , name :: Maybe Text + , description :: Maybe Text + , instructions :: Maybe Text + , tools :: Maybe (Vector Tool) + , tool_resources :: Maybe ToolResources + , metadata :: Maybe (Map Text Text) + , temperature :: Maybe Double + , top_p :: Maybe Double + , response_format :: Maybe (AutoOr ResponseFormat) + } deriving stock (Generic, Show) + +instance ToJSON ModifyAssistant where + toJSON = genericToJSON aesonOptions + +-- | Default `ModifyAssistant` +_ModifyAssistant :: ModifyAssistant +_ModifyAssistant = ModifyAssistant + { name = Nothing + , description = Nothing + , instructions = Nothing + , tools = Nothing + , tool_resources = Nothing + , metadata = Nothing + , temperature = Nothing + , top_p = Nothing + , response_format = Nothing + } + +-- | Represents an assistant that can call the model and use tools. +data AssistantObject = AssistantObject + { id :: AssistantID + , object :: Text + , created_at :: POSIXTime + , name :: Maybe Text + , description :: Maybe Text + , model :: Model + , instructions :: Maybe Text + , tools :: Maybe (Vector Tool) + , tool_resources :: Maybe ToolResources + , metadata :: Map Text Text + , temperature :: Maybe Double + , top_p :: Maybe Double + , response_format :: AutoOr ResponseFormat + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + Header' '[Required, Strict] "OpenAI-Beta" Text + :> "assistants" + :> ( ReqBody '[JSON] CreateAssistant + :> Post '[JSON] AssistantObject + :<|> QueryParam "limit" Natural + :> QueryParam "order" Order + :> QueryParam "after" Text + :> QueryParam "before" Text + :> Get '[JSON] (ListOf AssistantObject) + :<|> Capture "assistant_id" AssistantID + :> Get '[JSON] AssistantObject + :<|> Capture "assistant_id" AssistantID + :> ReqBody '[JSON] ModifyAssistant + :> Post '[JSON] AssistantObject + :<|> Capture "assistant_id" AssistantID + :> Delete '[JSON] DeletionStatus + ) diff --git a/src/OpenAI/V1/Audio.hs b/src/OpenAI/V1/Audio.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Audio.hs @@ -0,0 +1,14 @@ +-- | @\/v1\/audio@ +module OpenAI.V1.Audio + ( -- * Servant + API + ) where + +import OpenAI.Prelude +import qualified OpenAI.V1.Audio.Speech as Speech +import qualified OpenAI.V1.Audio.Transcriptions as Transcriptions +import qualified OpenAI.V1.Audio.Translations as Translations + +-- | Servant API +type API = + "audio" :> (Speech.API :<|> Transcriptions.API :<|> Translations.API) diff --git a/src/OpenAI/V1/Audio/Speech.hs b/src/OpenAI/V1/Audio/Speech.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Audio/Speech.hs @@ -0,0 +1,69 @@ +-- | @\/v1\/audio\/speech@ +module OpenAI.V1.Audio.Speech + ( -- * Main types + CreateSpeech(..) + , _CreateSpeech + -- * Other types + , Voice(..) + , Format(..) + -- * Servant + , ContentType(..) + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.Models (Model) + +-- | The voice to use when generating the audio +-- +-- Previews of the voices are available in the +-- [Text to speech guide](https://platform.openai.com/docs/guides/text-to-speech#voice-options). +data Voice = Alloy | Echo | Fable | Onyx | Nova | Shimmer + deriving stock (Bounded, Enum, Generic, Show) + +instance ToJSON Voice where + toJSON = genericToJSON aesonOptions + +-- | The format to audio in +data Format = MP3 | Opus | AAC | FLAC | WAV | PCM + deriving stock (Bounded, Enum, Generic, Show) + +instance ToJSON Format where + toJSON = genericToJSON aesonOptions + +-- | Request body for @\/v1\/audio\/speech@ +data CreateSpeech = CreateSpeech + { model :: Model + , input :: Text + , voice :: Voice + , response_format :: Maybe Format + , speed :: Maybe Double + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Default `CreateSpeech` +_CreateSpeech :: CreateSpeech +_CreateSpeech = CreateSpeech + { response_format = Nothing + , speed = Nothing + } + +-- | Content type +data ContentType = ContentType + +instance Accept ContentType where + contentTypes _ = + "audio/mpeg" + :| [ "audio/flac" + , "audio/wav" + , "audio/aac" + , "audio/opus" + , "audio/pcm" + ] + +instance MimeUnrender ContentType ByteString where + mimeUnrender _ bytes = Right bytes + +-- | Servant API +type API = + "speech" :> ReqBody '[JSON] CreateSpeech :> Post '[ContentType] ByteString diff --git a/src/OpenAI/V1/Audio/Transcriptions.hs b/src/OpenAI/V1/Audio/Transcriptions.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Audio/Transcriptions.hs @@ -0,0 +1,86 @@ +-- | @\/v1\/audio\/transcriptions@ +-- +-- To simplify things, this only supports the @verbose_json@ response format +-- and also only supports the @segment@ granularity +module OpenAI.V1.Audio.Transcriptions + ( -- * Main types + CreateTranscription(..) + , _CreateTranscription + , TranscriptionObject(..) + -- * Other types + , Segment(..) + -- * Servant + , API + ) where + +import OpenAI.Prelude as OpenAI.Prelude +import OpenAI.V1.Models (Model(..)) + +import qualified Data.Text as Text + +-- | Request body for @\/v1\/audio\/transcriptions@ +data CreateTranscription = CreateTranscription + { file :: FilePath + , model :: Model + , language :: Maybe Text + , prompt :: Maybe Text + , temperature :: Maybe Double + } deriving stock (Generic, Show) + +instance ToMultipart Tmp CreateTranscription where + toMultipart CreateTranscription{ model = Model model, ..} = + MultipartData{..} + where + inputs = + input "model" model + <> foldMap (input "language") language + <> foldMap (input "prompt") prompt + <> input "response_format" "verbose_json" + <> foldMap (input "temperature" . renderRealFloat) temperature + <> input "timestamp_granularities[]" "segment" + + files = [ FileData{..} ] + where + fdInputName = "file" + fdFileName = Text.pack file + fdFileCType = "audio/" <> getExtension file + fdPayload = file + +-- | Default `CreateTranscription` +_CreateTranscription :: CreateTranscription +_CreateTranscription = CreateTranscription + { language = Nothing + , prompt = Nothing + , temperature = Nothing + } + +-- | Segment of the transcribed text and its corresponding details +data Segment = Segment + { id :: Integer + , seek :: Integer + , start :: Double + , end :: Double + , text :: Text + , tokens :: Vector Prelude.Word + , temperature :: Double + , avg_logprob :: Double + , compression_ratio :: Double + , no_speech_prob :: Double + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Represents a verbose json transcription response returned by model, based +-- on the provided input. +data TranscriptionObject = TranscriptionObject + { language :: Maybe Text + , duration :: Maybe Double + , text :: Text + , segments :: Vector Segment + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "transcriptions" + :> MultipartForm Tmp CreateTranscription + :> Post '[JSON] TranscriptionObject diff --git a/src/OpenAI/V1/Audio/Translations.hs b/src/OpenAI/V1/Audio/Translations.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Audio/Translations.hs @@ -0,0 +1,60 @@ +-- | @\/v1\/audio\/translations@ +-- +-- To simplify things, this only supports the @verbose_json@ response format +module OpenAI.V1.Audio.Translations + ( -- * Main types + CreateTranslation(..) + , _CreateTranslation + , TranslationObject(..) + -- * Servant + , API + ) where + +import OpenAI.Prelude as OpenAI.Prelude +import OpenAI.V1.Models (Model(..)) + +import qualified Data.Text as Text + +-- | Request body for @\/v1\/audio\/translations@ +data CreateTranslation = CreateTranslation + { file :: FilePath + , model :: Model + , prompt :: Maybe Text + , temperature :: Maybe Double + } deriving stock (Generic, Show) + +instance ToMultipart Tmp CreateTranslation where + toMultipart CreateTranslation{ model = Model model, ..} = MultipartData{..} + where + inputs = + input "model" model + <> foldMap (input "prompt") prompt + <> input "response_format" "verbose_json" + <> foldMap (input "temperature" . renderRealFloat) temperature + + files = [ FileData{..} ] + where + fdInputName = "file" + fdFileName = Text.pack file + fdFileCType = "audio/" <> getExtension file + fdPayload = file + +-- | Default `CreateTranslation` +_CreateTranslation :: CreateTranslation +_CreateTranslation = CreateTranslation + { prompt = Nothing + , temperature = Nothing + } + +-- | Represents a transcription response returned by model, based on the +-- provided input. +data TranslationObject = TranslationObject + { text :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "translations" + :> MultipartForm Tmp CreateTranslation + :> Post '[JSON] TranslationObject diff --git a/src/OpenAI/V1/AutoOr.hs b/src/OpenAI/V1/AutoOr.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/AutoOr.hs @@ -0,0 +1,22 @@ +-- | The `AutoOr` type constructor +module OpenAI.V1.AutoOr + ( -- * Types + AutoOr(..) + ) where + +import OpenAI.Prelude + +-- | A type that can also be the string @\"auto\"@ +data AutoOr a = Auto | Specific a + deriving stock (Generic, Show) + +instance FromJSON a => FromJSON (AutoOr a) where + parseJSON "auto" = pure Auto + parseJSON value = fmap Specific (parseJSON value) + +instance ToJSON a => ToJSON (AutoOr a) where + toJSON Auto = "auto" + toJSON (Specific a) = toJSON a + +instance IsString a => IsString (AutoOr a) where + fromString string = Specific (fromString string) diff --git a/src/OpenAI/V1/Batches.hs b/src/OpenAI/V1/Batches.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Batches.hs @@ -0,0 +1,102 @@ +-- | @\/v1\/batches@ +module OpenAI.V1.Batches + ( -- * Main types + BatchID(..) + , CreateBatch(..) + , _CreateBatch + , BatchObject(..) + -- * Other types + , Status(..) + , Counts(..) + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.Error +import OpenAI.V1.Files (FileID) +import OpenAI.V1.ListOf + +-- | Batch ID +newtype BatchID = BatchID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Request body for @\/v1\/batches@ +data CreateBatch = CreateBatch + { input_file_id :: FileID + , endpoint :: Text + , completion_window :: Text + , metadata :: Maybe (Map Text Text) + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Default `CreateBatch` +_CreateBatch :: CreateBatch +_CreateBatch = CreateBatch + { metadata = Nothing + } + +-- | The current status of the batch. +data Status + = Validating + | Failed + | In_Progress + | Finalizing + | Completed + | Expired + | Cancelling + | Cancelled + deriving stock (Generic, Show) + +instance FromJSON Status where + parseJSON = genericParseJSON aesonOptions + +-- | The request counts for different statuses within the batch. +data Counts = Counts + { total :: Natural + , completed :: Natural + , failed :: Natural + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | The batch object +data BatchObject = BatchObject + { id :: BatchID + , object :: Text + , endpoint :: Text + , errors :: Maybe (ListOf Error) + , input_file_id :: FileID + , completion_window :: Text + , status :: Status + , output_file_id :: Maybe FileID + , error_file_id :: Maybe FileID + , created_at :: POSIXTime + , in_progress_at :: Maybe POSIXTime + , expires_at :: Maybe POSIXTime + , finalizing_at :: Maybe POSIXTime + , completed_at :: Maybe POSIXTime + , failed_at :: Maybe POSIXTime + , expired_at :: Maybe POSIXTime + , cancelling_at :: Maybe POSIXTime + , cancelled_at :: Maybe POSIXTime + , request_counts :: Maybe Counts + , metadata :: Maybe (Map Text Text) + } deriving stock (Generic, Show) + +instance FromJSON BatchObject where + parseJSON = genericParseJSON aesonOptions + +-- | Servant API +type API = + "batches" + :> ( ReqBody '[JSON] CreateBatch + :> Post '[JSON] BatchObject + :<|> Capture "batch_id" BatchID + :> Get '[JSON] BatchObject + :<|> Capture "batch_id" BatchID + :> "cancel" + :> Post '[JSON] BatchObject + :<|> QueryParam "after" Text + :> QueryParam "limit" Natural + :> Get '[JSON] (ListOf BatchObject) + ) diff --git a/src/OpenAI/V1/Chat/Completions.hs b/src/OpenAI/V1/Chat/Completions.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Chat/Completions.hs @@ -0,0 +1,297 @@ +-- | @\/v1\/chat\/completions@ +-- +-- Streaming results are not yet supported +module OpenAI.V1.Chat.Completions + ( -- * Main types + CreateChatCompletion(..) + , _CreateChatCompletion + , ChatCompletionObject(..) + , Choice(..) + , Message(..) + , messageToContent + , Content(..) + -- * Other types + , InputAudio(..) + , ImageURL(..) + , AudioData(..) + , Modality(..) + , Prediction(..) + , Voice(..) + , AudioFormat(..) + , AudioParameters(..) + , ResponseFormat(..) + , ServiceTier(..) + , FinishReason(..) + , Token(..) + , LogProbs(..) + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.AutoOr +import OpenAI.V1.Models (Model) +import OpenAI.V1.ResponseFormat +import OpenAI.V1.Tool +import OpenAI.V1.ToolCall +import OpenAI.V1.Usage +import Prelude hiding (id) + +-- | Audio content part +data InputAudio = InputAudio{ data_ :: Text, format :: AudioFormat } + deriving stock (Generic, Show) + +instance ToJSON InputAudio where + toJSON = genericToJSON aesonOptions + +-- | Image content part +data ImageURL = ImageURL{ url :: Text, detail :: Maybe (AutoOr Text) } + deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | A content part +data Content + = Text{ text :: Text } + | Image_URL{ image_url :: ImageURL } + | Input_Audio{ input_audio :: InputAudio } + deriving (Generic, Show) + +instance IsString Content where + fromString string = Text{ text = fromString string } + +instance ToJSON Content where + toJSON = genericToJSON aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +-- | Data about a previous audio response from the model. +-- [Learn more](https://platform.openai.com/docs/guides/audio) +data AudioData = AudioData{ id :: Text } + deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | A message from the conversation so far +data Message content + = System + { content :: content + , name :: Maybe Text + } + | User + { content :: content + , name :: Maybe Text + } + | Assistant + { assistant_content :: Maybe content + , refusal :: Maybe Text + , name :: Maybe Text + , assistant_audio :: Maybe AudioData + , tool_calls :: Maybe (Vector ToolCall) + } + | Tool + { content :: content + , tool_call_id :: Text + } + deriving stock (Generic, Show) + +messageOptions :: Options +messageOptions = aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "role", contentsFieldName = "" } + + , tagSingleConstructors = True + + , fieldLabelModifier = stripPrefix "assistant_" + } + +instance FromJSON content => FromJSON (Message content) where + parseJSON = genericParseJSON messageOptions + +instance ToJSON content => ToJSON (Message content) where + toJSON = genericToJSON messageOptions + +-- | Extract the message body from a `Message` +-- +-- Normally this would just be the @content@ field selector, but the problem +-- is that the content field for the `Assistant` constructor is not required +-- to be present, so we provide a utility function to default to extract the +-- @content@ field for all constructors, defaulting to `mempty` for the special +-- case where the `Message` is an `Assistant` constructor with a missing +-- @content@ field +messageToContent :: Monoid content => Message content -> content +messageToContent System{ content } = content +messageToContent User{ content } = content +messageToContent Assistant{ assistant_content = Just content } = content +messageToContent Assistant{ assistant_content = Nothing } = mempty +messageToContent Tool{ content } = content + +-- | Output types that you would like the model to generate for this request +data Modality = Modality_Text | Modality_Audio + deriving stock (Generic, Show) + +instance ToJSON Modality where + toJSON = genericToJSON aesonOptions + { constructorTagModifier = stripPrefix "Modality_" } + +-- | Configuration for a +-- [Predicted Output](https://platform.openai.com/docs/guides/predicted-outputs), +-- which can greatly improve response times when large parts of the model +-- response are known ahead of time. This is most common when you are +-- regenerating a file with only minor changes to most of the content +data Prediction = Content{ content :: Text } + deriving stock (Generic, Show) + +instance ToJSON Prediction where + toJSON = genericToJSON aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +-- | The voice the model uses to respond +data Voice = Ash | Ballad | Coral | Sage | Verse + deriving stock (Generic, Show) + +instance ToJSON Voice where + toJSON = genericToJSON aesonOptions + +-- | Specifies the output audio format +data AudioFormat = WAV | MP3 | FLAC | Opus | PCM16 + deriving stock (Generic, Show) + +instance ToJSON AudioFormat where + toJSON = genericToJSON aesonOptions + +-- | Parameters for audio output +data AudioParameters = AudioParameters + { voice :: Voice + , format :: AudioFormat + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Specifies the latency tier to use for processing the request +data ServiceTier = Default + deriving stock (Generic, Show) + +instance FromJSON ServiceTier where + parseJSON = genericParseJSON aesonOptions{ tagSingleConstructors = True } + +instance ToJSON ServiceTier where + toJSON = genericToJSON aesonOptions + +-- | Request body for @\/v1\/chat\/completions@ +data CreateChatCompletion = CreateChatCompletion + { messages :: Vector (Message (Vector Content)) + , model :: Model + , store :: Maybe Bool + , metadata :: Maybe (Map Text Text) + , frequency_penalty :: Maybe Double + , logit_bias :: Maybe (Map Word Int) + , logprobs :: Maybe Bool + , top_logprobs :: Maybe Word + , max_completion_tokens :: Maybe Natural + , n :: Maybe Natural + , modalities :: Maybe (Vector Modality) + , prediction :: Maybe Prediction + , audio :: Maybe AudioParameters + , presence_penalty :: Maybe Double + , response_format :: Maybe ResponseFormat + , seed :: Maybe Integer + , service_tier :: Maybe (AutoOr ServiceTier) + , stop :: Maybe (Vector Text) + , temperature :: Maybe Double + , top_p :: Maybe Double + , tools :: Maybe (Vector Tool) + , tool_choice :: Maybe ToolChoice + , parallel_tool_calls :: Maybe Bool + , user :: Maybe Text + } deriving stock (Generic, Show) + +instance ToJSON CreateChatCompletion where + toJSON = genericToJSON aesonOptions + +-- | Default `CreateChatCompletion` +_CreateChatCompletion :: CreateChatCompletion +_CreateChatCompletion = CreateChatCompletion + { store = Nothing + , metadata = Nothing + , frequency_penalty = Nothing + , logit_bias = Nothing + , logprobs = Nothing + , top_logprobs = Nothing + , max_completion_tokens = Nothing + , n = Nothing + , modalities = Nothing + , prediction = Nothing + , audio = Nothing + , presence_penalty = Nothing + , response_format = Nothing + , seed = Nothing + , service_tier = Nothing + , stop = Nothing + , temperature = Nothing + , top_p = Nothing + , tools = Nothing + , tool_choice = Nothing + , parallel_tool_calls = Nothing + , user = Nothing + } + +-- | The reason the model stopped generating tokens +data FinishReason + = Stop + | Length + | Content_Filter + | Tool_Calls + deriving stock (Generic, Show) + +instance FromJSON FinishReason where + parseJSON = genericParseJSON messageOptions + +-- | Message tokens with log probability information +data Token = Token + { token :: Text + , logprob :: Double + , bytes :: Maybe (Vector Word8) + , top_logprobs :: Maybe (Vector Token) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Log probability information for the choice +data LogProbs = LogProbs + { content :: Maybe (Vector Token) + , refusal :: Maybe (Vector Token) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | A chat completion choice +data Choice = Choice + { finish_reason :: Text + , index :: Natural + , message :: Message Text + , logprobs :: Maybe LogProbs + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | ChatCompletion body +data ChatCompletionObject = ChatCompletionObject + { id :: Text + , choices :: Vector Choice + , created :: POSIXTime + , model :: Model + , service_tier :: Maybe ServiceTier + , system_fingerprint :: Text + , object :: Text + , usage :: Usage CompletionTokensDetails PromptTokensDetails + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "chat" + :> "completions" + :> ReqBody '[JSON] CreateChatCompletion + :> Post '[JSON] ChatCompletionObject diff --git a/src/OpenAI/V1/ChunkingStrategy.hs b/src/OpenAI/V1/ChunkingStrategy.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/ChunkingStrategy.hs @@ -0,0 +1,39 @@ +-- | The `ChunkingStrategy` type +module OpenAI.V1.ChunkingStrategy + ( -- * Main types + ChunkingStrategy(..) + + -- * Other types + , Static(..) + ) where + +import OpenAI.Prelude + +-- | Static chunking strategy +data Static = Static + { max_chunk_size_tokens :: Natural + , chunk_overlap_tokens :: Natural + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | The chunking strategy used to chunk the file(s) +data ChunkingStrategy = ChunkingStrategy_Static{ static :: Static } + deriving stock (Generic, Show) + +chunkingStrategyOptions :: Options +chunkingStrategyOptions = aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + + , constructorTagModifier = stripPrefix "ChunkingStrategy_" + } + +instance ToJSON ChunkingStrategy where + toJSON = genericToJSON chunkingStrategyOptions + +instance FromJSON ChunkingStrategy where + parseJSON = genericParseJSON chunkingStrategyOptions + + diff --git a/src/OpenAI/V1/DeletionStatus.hs b/src/OpenAI/V1/DeletionStatus.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/DeletionStatus.hs @@ -0,0 +1,15 @@ +-- | The `DeletionStatus` type +module OpenAI.V1.DeletionStatus + ( -- * Types + DeletionStatus(..) + ) where + +import OpenAI.Prelude + +-- | Deletion status +data DeletionStatus = DeletionStatus + { id :: Text + , object :: Text + , deleted :: Bool + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) diff --git a/src/OpenAI/V1/Embeddings.hs b/src/OpenAI/V1/Embeddings.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Embeddings.hs @@ -0,0 +1,54 @@ +-- | @\/v1\/embeddings@ +module OpenAI.V1.Embeddings + ( -- * Main types + CreateEmbeddings(..) + , _CreateEmbeddings + , EmbeddingObject(..) + -- * Other types + , EncodingFormat(..) + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.ListOf +import OpenAI.V1.Models (Model) + +-- | The format to return the embeddings in +data EncodingFormat = Float | Base64 + deriving stock (Generic, Show) + +instance ToJSON EncodingFormat where + toJSON = genericToJSON aesonOptions + +-- | Request body for @\/v1\/embeddings@ +data CreateEmbeddings = CreateEmbeddings + { input :: Text + , model :: Model + , encoding_format :: Maybe EncodingFormat + , dimensions :: Maybe Natural + , user :: Maybe Text + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Default `CreateEmbeddings` +_CreateEmbeddings :: CreateEmbeddings +_CreateEmbeddings = CreateEmbeddings + { encoding_format = Nothing + , dimensions = Nothing + , user = Nothing + } + +-- | The embedding object +data EmbeddingObject = EmbbeddingObject + { index :: Natural + , embedding :: Vector Double + , object :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "embeddings" + :> ReqBody '[JSON] CreateEmbeddings + :> Post '[JSON] (ListOf EmbeddingObject) diff --git a/src/OpenAI/V1/Error.hs b/src/OpenAI/V1/Error.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Error.hs @@ -0,0 +1,20 @@ +-- | Error information +module OpenAI.V1.Error + ( -- * Types + Error(..) + ) where + +import OpenAI.Prelude + +-- | More information on the cause of the failure. +-- +-- NOTE: OpenAPI API's says that the `code` and `message` fields are required, +-- but in practice the `Error` record can be present with all fields omitted, +-- so they are all marked optional (`Maybe`) here +data Error = Error + { code :: Maybe Text + , message :: Maybe Text + , param :: Maybe Text + , line :: Maybe Natural + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) diff --git a/src/OpenAI/V1/Files.hs b/src/OpenAI/V1/Files.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Files.hs @@ -0,0 +1,111 @@ +-- | @\/v1\/files@ +module OpenAI.V1.Files + ( -- * Main types + FileID(..) + , UploadFile(..) + , _UploadFile + , FileObject(..) + -- * Other types + , Order(..) + , Purpose(..) + , DeletionStatus(..) + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.DeletionStatus +import OpenAI.V1.ListOf +import OpenAI.V1.Order + +import qualified Data.Text as Text + +-- | File ID +newtype FileID = FileID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | UploadFile body +data UploadFile = UploadFile + { file :: FilePath + , purpose :: Purpose + } deriving stock (Generic, Show) + +-- | Default `UploadFile` +_UploadFile :: UploadFile +_UploadFile = UploadFile{ } + +instance ToMultipart Tmp UploadFile where + toMultipart UploadFile{..} = MultipartData{..} + where + inputs = input "purpose" (toUrlPiece purpose) + + files = [ FileData{..} ] + where + fdInputName = "file" + fdFileName = Text.pack file + fdFileCType = "application/json" + fdPayload = file + +-- | The File object represents a document that has been uploaded to OpenAI +data FileObject = FileObject + { id :: FileID + , bytes :: Natural + , created_at :: POSIXTime + , filename :: Text + , object :: Text + , purpose :: Purpose + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | The intended purpose of the uploaded file. +data Purpose + = Assistants + | Assistants_Output + | Batch + | Batch_Output + | Fine_Tune + | Fine_Tune_Results + | Vision + deriving stock (Generic, Show) + +purposeOptions :: Options +purposeOptions = aesonOptions + { constructorTagModifier = fix . labelModifier } + where + fix "fine_tune" = "fine-tune" + fix "fine_tune_results" = "fine-tune-results" + fix string = string + +instance FromJSON Purpose where + parseJSON = genericParseJSON purposeOptions + +instance ToJSON Purpose where + toJSON = genericToJSON purposeOptions + +instance ToHttpApiData Purpose where + toUrlPiece Assistants = "assistants" + toUrlPiece Assistants_Output = "assistants" + toUrlPiece Batch = "batch" + toUrlPiece Batch_Output = "batch_output" + toUrlPiece Fine_Tune = "fine-tune" + toUrlPiece Fine_Tune_Results = "fine-tune-results" + toUrlPiece Vision = "vision" + +-- | Servant API +type API = + "files" + :> ( MultipartForm Tmp UploadFile + :> Post '[JSON] FileObject + :<|> QueryParam "purpose" Purpose + :> QueryParam "limit" Natural + :> QueryParam "order" Order + :> QueryParam "after" Text + :> Get '[JSON] (ListOf FileObject) + :<|> Capture "file_id" FileID + :> Get '[JSON] FileObject + :<|> Capture "file_id" FileID + :> Delete '[JSON] DeletionStatus + :<|> Capture "file_id" FileID + :> "content" + :> Get '[OctetStream] ByteString + ) diff --git a/src/OpenAI/V1/FineTuning/Jobs.hs b/src/OpenAI/V1/FineTuning/Jobs.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/FineTuning/Jobs.hs @@ -0,0 +1,196 @@ +-- | @\/v1\/fine_tuning/jobs@ +module OpenAI.V1.FineTuning.Jobs + ( -- * Main types + FineTuningJobID(..) + , CreateFineTuningJob(..) + , _CreateFineTuningJob + , JobObject(..) + , EventObject(..) + , CheckpointObject(..) + + -- * Other types + , AutoOr(..) + , Hyperparameters(..) + , WAndB(..) + , Integration(..) + , Status(..) + , Level(..) + , Metrics(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.AutoOr +import OpenAI.V1.Error +import OpenAI.V1.Files (FileID) +import OpenAI.V1.Models (Model) +import OpenAI.V1.ListOf + +-- | Fine tuning job ID +newtype FineTuningJobID = FineTuningJobID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | The hyperparameters used for the fine-tuning job +data Hyperparameters = Hyperparameters + { batch_size :: Maybe (AutoOr Natural) + , learning_rate_multiplier :: Maybe (AutoOr Double) + , n_epochs :: Maybe (AutoOr Natural) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | The settings for your integration with Weights and +data WAndB = WAndB + { project :: Text + , name :: Maybe Text + , entity :: Maybe Text + , tags :: Maybe (Vector Text) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | An integration to enable for your fine-tuning job +data Integration = Integration_WAndB{ wandb :: WAndB } + deriving stock (Generic, Show) + +integrationOptions :: Options +integrationOptions = aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + + , constructorTagModifier = stripPrefix "Integration_" + } + +instance FromJSON Integration where + parseJSON = genericParseJSON integrationOptions + +instance ToJSON Integration where + toJSON = genericToJSON integrationOptions-- | CreateFineTuningJob body + +-- | Request body for @\/v1\/fine_tuning\/jobs@ +data CreateFineTuningJob = CreateFineTuningJob + { model :: Model + , training_file :: FileID + , hyperparameters :: Maybe Hyperparameters + , suffix :: Maybe Text + , validation_file :: Maybe FileID + , integrations :: Maybe (Vector Integration) + , seed :: Maybe Integer + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Default `CreateFineTuningJob` +_CreateFineTuningJob :: CreateFineTuningJob +_CreateFineTuningJob = CreateFineTuningJob + { hyperparameters = Nothing + , suffix = Nothing + , validation_file = Nothing + , integrations = Nothing + , seed = Nothing + } + +-- | The current status of the fine-tuning job +data Status + = Validating_Files + | Queued + | Running + | Succeeded + | Failed + | Cancelled + deriving stock (Generic, Show) + +instance FromJSON Status where + parseJSON = genericParseJSON aesonOptions + +-- | The fine_tuning.job object represents a fine-tuning job that has been +-- created through the API. +data JobObject = JobObject + { id :: FineTuningJobID + , created_at :: POSIXTime + , error :: Maybe Error + , fine_tuned_model :: Maybe Model + , finished_at :: Maybe POSIXTime + , hyperparameters :: Hyperparameters + , model :: Model + , object :: Text + , organization_id :: Text + , result_files :: Vector FileID + , status :: Status + , trained_tokens :: Maybe Natural + , training_file :: FileID + , validation_file :: Maybe FileID + , integrations :: Maybe (Vector Integration) + , seed :: Integer + , estimated_finish :: Maybe POSIXTime + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Log level +data Level = Info | Warn | Error + deriving stock (Generic, Show) + +instance FromJSON Level where + parseJSON = genericParseJSON aesonOptions + +-- | Fine-tuning job event object +data EventObject = EventObject + { id :: Text + , created_at :: POSIXTime + , level :: Level + , message :: Text + , object :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Metrics at the step number during the fine-tuning job. +data Metrics = Metrics + { step :: Double + , train_loss :: Double + , train_mean_token_accuracy :: Double + , valid_loss :: Double + , valid_mean_token_accuracy :: Double + , full_valid_loss :: Double + , full_valid_mean_token_accuracy :: Double + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | The @fine_tuning.job.checkpoint@ object represents a model checkpoint for +-- a fine-tuning job that is ready to use +data CheckpointObject = CheckpointObject + { id :: Text + , created_at :: POSIXTime + , fine_tuned_model_checkpoint :: Text + , step_number :: Natural + , metrics :: Metrics + , fine_tuning_job_id :: FineTuningJobID + , object :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "fine_tuning" + :> "jobs" + :> ( ReqBody '[JSON] CreateFineTuningJob + :> Post '[JSON] JobObject + :<|> QueryParam "after" Text + :> QueryParam "limit" Natural + :> Get '[JSON] (ListOf JobObject) + :<|> Capture "fine_tuning_job_id" FineTuningJobID + :> "events" + :> QueryParam "after" Text + :> QueryParam "limit" Natural + :> Get '[JSON] (ListOf EventObject) + :<|> Capture "fine_tuning_job_id" FineTuningJobID + :> "checkpoints" + :> QueryParam "after" Text + :> QueryParam "limit" Natural + :> Get '[JSON] (ListOf CheckpointObject) + :<|> Capture "fine_tuning_job_id" FineTuningJobID + :> Get '[JSON] JobObject + :<|> Capture "fine_tuning_job_id" FineTuningJobID + :> "cancel" + :> Post '[JSON] JobObject + ) diff --git a/src/OpenAI/V1/Images.hs b/src/OpenAI/V1/Images.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Images.hs @@ -0,0 +1,14 @@ +-- | @\/v1\/images@ +module OpenAI.V1.Images + ( -- * Servant + API + ) where + +import OpenAI.Prelude + +import qualified OpenAI.V1.Images.Generations as Generations +import qualified OpenAI.V1.Images.Edits as Edits +import qualified OpenAI.V1.Images.Variations as Variations + +-- | Servant API +type API = "images" :> (Generations.API :<|> Edits.API :<|> Variations.API) diff --git a/src/OpenAI/V1/Images/Edits.hs b/src/OpenAI/V1/Images/Edits.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Images/Edits.hs @@ -0,0 +1,76 @@ +-- | @\/v1\/images\/edits@ +module OpenAI.V1.Images.Edits + ( -- * Main types + CreateImageEdit(..) + , _CreateImageEdit + -- * Other types + , ResponseFormat(..) + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.Images.Image +import OpenAI.V1.Images.ResponseFormat +import OpenAI.V1.ListOf +import OpenAI.V1.Models (Model(..)) + +import qualified Data.Text as Text + +-- | Request body for @\/v1\/images\/edits@ +data CreateImageEdit = CreateImageEdit + { image :: FilePath + , prompt :: Text + , mask :: Maybe FilePath + , model :: Maybe Model + , n :: Maybe Natural + , size :: Maybe Text + , response_format :: Maybe ResponseFormat + , user :: Maybe Text + } deriving stock (Generic, Show) + +-- | Default `CreateImageEdit` +_CreateImageEdit :: CreateImageEdit +_CreateImageEdit = CreateImageEdit + { mask = Nothing + , model = Nothing + , n = Nothing + , size = Nothing + , response_format = Nothing + , user = Nothing + } + +instance ToMultipart Tmp CreateImageEdit where + toMultipart CreateImageEdit{ ..} = MultipartData{..} + where + inputs = + input "prompt" prompt + <> foldMap (input "model" . text) model + <> foldMap (input "n" . renderIntegral) n + <> foldMap (input "size") size + <> foldMap (input "response_format" . toUrlPiece) response_format + <> foldMap (input "user") user + + files = file0 : files1 + where + file0 = FileData{..} + where + fdInputName = "image" + fdFileName = Text.pack image + fdFileCType = "image/" <> getExtension image + fdPayload = image + + files1 = case mask of + Nothing -> [ ] + Just m -> [ FileData{..} ] + where + fdInputName = "mask" + fdFileName = Text.pack m + fdFileCType = "image/" <> getExtension m + fdPayload = m + +-- | Servant API +type API = + "edits" + :> MultipartForm Tmp CreateImageEdit + :> Post '[JSON] (ListOf ImageObject) diff --git a/src/OpenAI/V1/Images/Generations.hs b/src/OpenAI/V1/Images/Generations.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Images/Generations.hs @@ -0,0 +1,64 @@ +-- | @\/v1\/images\/generations@ +module OpenAI.V1.Images.Generations + ( -- * Main types + CreateImage(..) + , _CreateImage + -- * Other types + , Quality(..) + , Style(..) + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.Images.Image +import OpenAI.V1.Images.ResponseFormat +import OpenAI.V1.ListOf +import OpenAI.V1.Models (Model) + +-- | The quality of the image that will be generated +data Quality = Standard | HD + deriving stock (Generic, Show) + +instance ToJSON Quality where + toJSON = genericToJSON aesonOptions + +-- | The style of the generated images +data Style = Vivid | Natural + deriving stock (Generic, Show) + +instance ToJSON Style where + toJSON = genericToJSON aesonOptions + +-- | Requesty body for @\/v1/images/generations@ +data CreateImage = CreateImage + { prompt :: Text + , model :: Maybe Model + , n :: Maybe Natural + , quality :: Maybe Quality + , response_format :: Maybe ResponseFormat + , size :: Maybe Text + , style :: Maybe Style + , user :: Maybe Text + } deriving stock (Generic, Show) + +-- | Default `CreateImage` +_CreateImage :: CreateImage +_CreateImage = CreateImage + { model = Nothing + , n = Nothing + , quality = Nothing + , response_format = Nothing + , size = Nothing + , style = Nothing + , user = Nothing + } + +instance ToJSON CreateImage where + toJSON = genericToJSON aesonOptions + +-- | Servant API +type API = + "generations" + :> ReqBody '[JSON] CreateImage + :> Post '[JSON] (ListOf ImageObject) diff --git a/src/OpenAI/V1/Images/Image.hs b/src/OpenAI/V1/Images/Image.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Images/Image.hs @@ -0,0 +1,15 @@ +-- | The image object +module OpenAI.V1.Images.Image + ( -- * Types + ImageObject(..) + ) where + +import OpenAI.Prelude + +-- | Represents the url or the content of an image generated by the OpenAI API +data ImageObject = ImageObject + { b64_json :: Maybe Text + , url :: Maybe Text + , revised_prompt :: Maybe Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) diff --git a/src/OpenAI/V1/Images/ResponseFormat.hs b/src/OpenAI/V1/Images/ResponseFormat.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Images/ResponseFormat.hs @@ -0,0 +1,18 @@ +-- | The response format +module OpenAI.V1.Images.ResponseFormat + ( -- * Types + ResponseFormat(..) + ) where + +import OpenAI.Prelude + +-- | The format in which the generated images are returned +data ResponseFormat = URL | B64_JSON + deriving stock (Generic, Show) + +instance ToJSON ResponseFormat where + toJSON = genericToJSON aesonOptions + +instance ToHttpApiData ResponseFormat where + toUrlPiece URL = "url" + toUrlPiece B64_JSON = "b64_json" diff --git a/src/OpenAI/V1/Images/Variations.hs b/src/OpenAI/V1/Images/Variations.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Images/Variations.hs @@ -0,0 +1,59 @@ +-- | @\/v1\/images\/variations@ +module OpenAI.V1.Images.Variations + ( -- * Main types + CreateImageVariation(..) + , _CreateImageVariation + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.Images.Image +import OpenAI.V1.Images.ResponseFormat +import OpenAI.V1.ListOf +import OpenAI.V1.Models (Model(..)) + +import qualified Data.Text as Text + +-- | Request body for @\/v1\/images\/variations@ +data CreateImageVariation = CreateImageVariation + { image :: FilePath + , model :: Maybe Model + , n :: Maybe Natural + , response_format :: Maybe ResponseFormat + , size :: Maybe Text + , user :: Maybe Text + } deriving stock (Generic, Show) + +-- | Default `CreateImageVariation` +_CreateImageVariation :: CreateImageVariation +_CreateImageVariation = CreateImageVariation + { model = Nothing + , n = Nothing + , response_format = Nothing + , size = Nothing + , user = Nothing + } + +instance ToMultipart Tmp CreateImageVariation where + toMultipart CreateImageVariation{..} = MultipartData{..} + where + inputs = + foldMap (input "model" . text) model + <> foldMap (input "n" . renderIntegral) n + <> foldMap (input "response_format" . toUrlPiece) response_format + <> foldMap (input "size") size + <> foldMap (input "user") user + + files = [ FileData{..} ] + where + fdInputName = "image" + fdFileName = Text.pack image + fdFileCType = "image/" <> getExtension image + fdPayload = image + +-- | Servant API +type API = + "variations" + :> MultipartForm Tmp CreateImageVariation + :> Post '[JSON] (ListOf ImageObject) diff --git a/src/OpenAI/V1/ListOf.hs b/src/OpenAI/V1/ListOf.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/ListOf.hs @@ -0,0 +1,16 @@ +-- | The `ListOf` type constructor +module OpenAI.V1.ListOf + ( -- * Types + ListOf(..) + ) where + +import OpenAI.Prelude + +-- | Whenever OpenAI says that an API endpoint returns a list of items, what +-- they actually mean is that it returns that list wrapped inside of the +-- following object +data ListOf a = List{ data_ :: Vector a } + deriving stock (Generic, Show) + +instance FromJSON a => FromJSON (ListOf a) where + parseJSON = genericParseJSON aesonOptions diff --git a/src/OpenAI/V1/Message.hs b/src/OpenAI/V1/Message.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Message.hs @@ -0,0 +1,78 @@ +-- | The `Message` type +module OpenAI.V1.Message + ( -- * Main types + Message(..) + + -- * Other types + , ImageFile(..) + , ImageURL(..) + , Content(..) + , Attachment(..) + ) where + +import OpenAI.Prelude +import OpenAI.V1.AutoOr +import OpenAI.V1.Files (FileID) +import OpenAI.V1.Tool + +-- | References an image File in the content of a message +data ImageFile = ImageFile{ file_id :: FileID, detail :: Maybe (AutoOr Text) } + deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | References an image URL in the content of a message +data ImageURL = ImageURL + { image_url :: Text + , detail :: Maybe (AutoOr Text) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Message content +data Content text + = Image_File{ image_file :: ImageFile } + | Image_URL{ image_url :: ImageURL } + | Text{ text :: text } + deriving stock (Generic, Show) + +contentOptions :: Options +contentOptions = aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +instance FromJSON text => FromJSON (Content text) where + parseJSON = genericParseJSON contentOptions + +instance ToJSON text => ToJSON (Content text) where + toJSON = genericToJSON contentOptions + +instance IsString text => IsString (Content text) where + fromString string = Text{ text = fromString string } + +-- | A file attached to the message, and the tools it should be added to +data Attachment = Attachment{ file_id :: FileID, tools :: Maybe (Vector Tool) } + deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | A message +data Message + = User + { content :: Vector (Content Text) + , attachments :: Maybe (Vector Attachment) + , metadata :: Maybe (Map Text Text) + } + | Assistant + { content :: Vector (Content Text) + , attachments :: Maybe (Vector Attachment) + , metadata :: Maybe (Map Text Text) + } + deriving stock (Generic, Show) + +instance ToJSON Message where + toJSON = genericToJSON aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "role", contentsFieldName = "" } + , tagSingleConstructors = True + } diff --git a/src/OpenAI/V1/Models.hs b/src/OpenAI/V1/Models.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Models.hs @@ -0,0 +1,36 @@ +-- | @\/v1\/models@ +module OpenAI.V1.Models + ( -- * Main types + Model(..) + , ModelObject(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.DeletionStatus +import OpenAI.V1.ListOf + +-- | Model +newtype Model = Model{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Describes an OpenAI model offering that can be used with the API +data ModelObject = ModelObject + { id :: Model + , created :: POSIXTime + , object :: Text + , owned_by :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "models" + :> ( Get '[JSON] (ListOf ModelObject) + :<|> Capture "model" Model + :> Get '[JSON] ModelObject + :<|> Capture "model" Model + :> Delete '[JSON] DeletionStatus + ) diff --git a/src/OpenAI/V1/Moderations.hs b/src/OpenAI/V1/Moderations.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Moderations.hs @@ -0,0 +1,60 @@ +-- | @\/v1\/moderations@ +module OpenAI.V1.Moderations + ( -- * Main types + CreateModeration(..) + , _CreateModeration + , Moderation(..) + + -- * Other types + , InputType(..) + , Result(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.Models (Model) + +-- | Request body for @\/v1\/moderations@ +data CreateModeration = CreateModeration + { input :: Text + , model :: Maybe Model + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Default `CreateModeration` +_CreateModeration :: CreateModeration +_CreateModeration = CreateModeration + { model = Nothing + } + +-- | The input type that the score applies to +data InputType = Text | Image + deriving stock (Generic, Show) + +instance FromJSON InputType where + parseJSON = genericParseJSON aesonOptions + +-- | A moderation result +data Result = Result + { flagged :: Bool + , categories :: Map Text Bool + , category_scores :: Map Text Double + , category_applied_input_types :: Maybe (Map Text InputType) + -- According to the OpenAPI spec the `category_applied_input_types` + -- field is required but their actual implementation omits this field. + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Represents if a given text input is potentially harmful. +data Moderation = Moderation + { id :: Text + , model :: Model + , results :: Vector Result + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "moderations" :> ReqBody '[JSON] CreateModeration :> Post '[JSON] Moderation diff --git a/src/OpenAI/V1/Order.hs b/src/OpenAI/V1/Order.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Order.hs @@ -0,0 +1,14 @@ +-- | The `Order` type +module OpenAI.V1.Order + ( -- * Types + Order(..) + ) where + +import OpenAI.Prelude + +-- | Sort order by the @created_at@ timestamp of the objects +data Order = Desc | Asc + +instance ToHttpApiData Order where + toUrlPiece Desc = "desc" + toUrlPiece Asc = "asc" diff --git a/src/OpenAI/V1/ResponseFormat.hs b/src/OpenAI/V1/ResponseFormat.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/ResponseFormat.hs @@ -0,0 +1,43 @@ +-- | The `ResponseFormat` type +module OpenAI.V1.ResponseFormat + ( -- * Types + ResponseFormat(..) + , JSONSchema(..) + ) where + +import OpenAI.Prelude + +-- | An object specifying the format that the model must output +data ResponseFormat + = ResponseFormat_Text + | JSON_Object + | JSON_Schema{ json_schema :: JSONSchema } + deriving stock (Generic, Show) + +responseFormatOptions :: Options +responseFormatOptions = aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + + , constructorTagModifier = stripPrefix "ResponseFormat_" + } + +instance FromJSON ResponseFormat where + parseJSON = genericParseJSON responseFormatOptions + +instance ToJSON ResponseFormat where + toJSON = genericToJSON responseFormatOptions + +-- | Setting to { "type": "json_schema", "json_schema": {...} } enables +-- Structured Outputs which ensures the model will match your supplied JSON +-- schema. Learn more in the +-- [Structured Outputs](https://platform.openai.com/docs/guides/structured-outputs) guide +data JSONSchema = JSONSchema + { description :: Maybe Text + , name :: Text + , schema :: Maybe Value + , strict :: Maybe Bool + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) diff --git a/src/OpenAI/V1/Threads.hs b/src/OpenAI/V1/Threads.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Threads.hs @@ -0,0 +1,86 @@ +-- | @\/v1\/threads@ +module OpenAI.V1.Threads + ( -- Main types + ThreadID(..) + , Thread(..) + , _Thread + , ModifyThread(..) + , _ModifyThread + , Message(..) + , Content(..) + , ThreadObject(..) + + -- * Other types + , ImageURL(..) + , ImageFile(..) + , Attachment(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.DeletionStatus +import OpenAI.V1.Message +import OpenAI.V1.ToolResources + +-- | Thread ID +newtype ThreadID = ThreadID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Request body for @\/v1\/threads@ +data Thread = Thread + { messages :: Maybe (Vector Message) + , tool_resources :: Maybe ToolResources + , metadata :: Maybe (Map Text Text) + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Default `Thread` +_Thread :: Thread +_Thread = Thread + { messages = Nothing + , tool_resources = Nothing + , metadata = Nothing + } + +-- | Request body for @\/v1\/threads\/:thread_id@ +data ModifyThread = ModifyThread + { tool_resources :: Maybe ToolResources + , metadata :: Maybe (Map Text Text) + } deriving stock (Generic, Show) + +instance ToJSON ModifyThread where + toJSON = genericToJSON aesonOptions + +-- | Default `ModifyThread` +_ModifyThread :: ModifyThread +_ModifyThread = ModifyThread + { tool_resources = Nothing + , metadata = Nothing + } + +-- | Represents a thread that contains messages +data ThreadObject = ThreadObject + { id :: ThreadID + , object :: Text + , created_at :: POSIXTime + , tool_resources :: Maybe ToolResources + , metadata :: Maybe (Map Text Text) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "threads" + :> Header' '[Required, Strict] "OpenAI-Beta" Text + :> ( ReqBody '[JSON] Thread + :> Post '[JSON] ThreadObject + :<|> Capture "thread_id" ThreadID + :> Get '[JSON] ThreadObject + :<|> Capture "thread_id" ThreadID + :> ReqBody '[JSON] ModifyThread + :> Post '[JSON] ThreadObject + :<|> Capture "thread_id" ThreadID + :> Delete '[JSON] DeletionStatus + ) diff --git a/src/OpenAI/V1/Threads/Messages.hs b/src/OpenAI/V1/Threads/Messages.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Threads/Messages.hs @@ -0,0 +1,145 @@ +-- | @\/v1\/threads/:thread_id/messages@ +module OpenAI.V1.Threads.Messages + ( -- * Main types + MessageID(..) + , Message(..) + , ModifyMessage(..) + , _ModifyMessage + , MessageObject(..) + + -- * Other types + , Status(..) + , IncompleteDetails(..) + , File(..) + , Annotation(..) + , TextObject(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.Assistants (AssistantID) +import OpenAI.V1.DeletionStatus +import OpenAI.V1.Files (FileID) +import OpenAI.V1.ListOf +import OpenAI.V1.Message +import OpenAI.V1.Threads (ThreadID) +import OpenAI.V1.Threads.Runs (RunID) + +-- | Message ID +newtype MessageID = MessageID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Request body for @\/v1\/threads\/:thread_id\/messages\/:message_id@ +data ModifyMessage = ModifyMessage + { metadata :: Maybe (Map Text Text) + } deriving stock (Generic, Show) + +instance ToJSON ModifyMessage where + toJSON = genericToJSON aesonOptions + +-- | Default `ModifyMessage` +_ModifyMessage :: ModifyMessage +_ModifyMessage = ModifyMessage + { metadata = Nothing + } + +-- | The status of the message +data Status = In_Progress | Incomplete | Completed + deriving stock (Generic, Show) + +instance FromJSON Status where + parseJSON = genericParseJSON aesonOptions + +-- | On an incomplete message, details about why the message is incomplete. +data IncompleteDetails = IncompleteDetails + { reason :: Text + } deriving (Generic, Show) + deriving anyclass (FromJSON) + +-- | File +data File = File + { file_id :: FileID + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | An annotation +data Annotation + = File_Citation + { text :: Text + , file_citation :: File + , start_index :: Natural + , end_index :: Natural + } + | File_Path + { text :: Text + , file_path :: File + , start_index :: Natural + , end_index :: Natural + } + deriving stock (Generic, Show) + +instance FromJSON Annotation where + parseJSON = genericParseJSON aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +-- | The text content that is part of a message. +data TextObject = TextObject + { value :: Text + , annotations :: Vector Annotation + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +instance IsString TextObject where + fromString string = + TextObject{ value = fromString string, annotations = [] } + +-- | Represents a message within a thread. +data MessageObject = MessageObject + { id :: MessageID + , object :: Text + , created_at :: POSIXTime + , thread_id :: ThreadID + , status :: Maybe Status + , incomplete_details :: Maybe IncompleteDetails + , completed_at :: Maybe POSIXTime + , incomplete_at :: Maybe POSIXTime + , role :: Text + , content :: Vector (Content TextObject) + , assistant_id :: Maybe AssistantID + , run_id :: Maybe RunID + , attachments :: Maybe (Vector Attachment) + , metadata :: Map Text Text + } deriving (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + Header' '[Required, Strict] "OpenAI-Beta" Text + :> "threads" + :> ( Capture "thread_id" ThreadID + :> "messages" + :> ReqBody '[JSON] Message + :> Post '[JSON] MessageObject + :<|> Capture "thread_id" ThreadID + :> "messages" + :> Get '[JSON] (ListOf MessageObject) + :<|> Capture "thread_id" ThreadID + :> "messages" + :> Capture "message_id" MessageID + :> Get '[JSON] MessageObject + :<|> Capture "thread_id" ThreadID + :> "messages" + :> Capture "message_id" MessageID + :> ReqBody '[JSON] ModifyMessage + :> Post '[JSON] MessageObject + :<|> Capture "thread_id" ThreadID + :> "messages" + :> Capture "message_id" MessageID + :> Delete '[JSON] DeletionStatus + ) diff --git a/src/OpenAI/V1/Threads/Runs.hs b/src/OpenAI/V1/Threads/Runs.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Threads/Runs.hs @@ -0,0 +1,294 @@ +-- | @\/v1\/threads\/:thread_id\/runs@ +module OpenAI.V1.Threads.Runs + ( -- * Main types + RunID(..) + , CreateRun(..) + , _CreateRun + , CreateThreadAndRun(..) + , _CreateThreadAndRun + , ModifyRun(..) + , _ModifyRun + , SubmitToolOutputsToRun(..) + , _SubmitToolOutputsToRun + , RunObject(..) + + -- * Other types + , TruncationStrategy(..) + , SubmitToolOutputs(..) + , RequiredAction(..) + , IncompleteDetails(..) + , ToolOutput(..) + , Status(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.Assistants (AssistantID) +import OpenAI.V1.AutoOr +import OpenAI.V1.Error +import OpenAI.V1.ListOf +import OpenAI.V1.Message +import OpenAI.V1.Models (Model) +import OpenAI.V1.Order +import OpenAI.V1.ResponseFormat +import OpenAI.V1.Threads (Thread) +import OpenAI.V1.Tool +import OpenAI.V1.ToolCall +import OpenAI.V1.ToolResources +import OpenAI.V1.Threads (ThreadID) +import OpenAI.V1.Usage + +-- | Run ID +newtype RunID = RunID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Controls for how a thread will be truncated prior to the run +data TruncationStrategy + = Auto + | Last_Messages{ last_messages :: Maybe Natural } + deriving stock (Generic, Show) + +truncationStrategyOptions :: Options +truncationStrategyOptions = aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +instance FromJSON TruncationStrategy where + parseJSON = genericParseJSON truncationStrategyOptions + +instance ToJSON TruncationStrategy where + toJSON = genericToJSON truncationStrategyOptions + +-- | Request body for @\/v1\/threads\/:thread_id\/runs@ +data CreateRun = CreateRun + { assistant_id :: AssistantID + , model :: Maybe Model + , instructions :: Maybe Text + , additional_instructions :: Maybe Text + , additional_messages :: Maybe (Vector Message) + , tools :: Maybe (Vector Tool) + , metadata :: Maybe (Map Text Text) + , temperature :: Maybe Double + , top_p :: Maybe Double + , max_prompt_tokens :: Maybe Natural + , max_completion_tokens :: Maybe Natural + , truncation_strategy :: Maybe TruncationStrategy + , tool_choice :: Maybe ToolChoice + , parallel_tool_calls :: Maybe Bool + , response_format :: Maybe (AutoOr ResponseFormat) + } deriving stock (Generic, Show) + +instance ToJSON CreateRun where + toJSON = genericToJSON aesonOptions + +-- | Default `CreateRun` +_CreateRun :: CreateRun +_CreateRun = CreateRun + { model = Nothing + , instructions = Nothing + , additional_instructions = Nothing + , additional_messages = Nothing + , tools = Nothing + , metadata = Nothing + , temperature = Nothing + , top_p = Nothing + , max_prompt_tokens = Nothing + , max_completion_tokens = Nothing + , truncation_strategy = Nothing + , tool_choice = Nothing + , parallel_tool_calls = Nothing + , response_format = Nothing + } + +-- | Request body for @\/v1\/threads\/runs@ +data CreateThreadAndRun = CreateThreadAndRun + { assistant_id :: AssistantID + , thread :: Maybe Thread + , model :: Maybe Model + , instructions :: Maybe Text + , tools :: Maybe (Vector Tool) + , toolResources :: Maybe ToolResources + , metadata :: Maybe (Map Text Text) + , temperature :: Maybe Double + , top_p :: Maybe Double + , max_prompt_tokens :: Maybe Natural + , max_completion_tokens :: Maybe Natural + , truncation_strategy :: Maybe TruncationStrategy + , tool_choice :: Maybe ToolChoice + , parallel_tool_calls :: Maybe Bool + , response_format :: Maybe (AutoOr ResponseFormat) + } deriving stock (Generic, Show) + +instance ToJSON CreateThreadAndRun where + toJSON = genericToJSON aesonOptions + +-- | Default `CreateThreadAndRun` +_CreateThreadAndRun :: CreateThreadAndRun +_CreateThreadAndRun = CreateThreadAndRun + { thread = Nothing + , model = Nothing + , instructions = Nothing + , tools = Nothing + , toolResources = Nothing + , metadata = Nothing + , temperature = Nothing + , top_p = Nothing + , max_prompt_tokens = Nothing + , max_completion_tokens = Nothing + , truncation_strategy = Nothing + , tool_choice = Nothing + , parallel_tool_calls = Nothing + , response_format = Nothing + } + +-- | Details on the tool outputs needed for this run to continue. +data SubmitToolOutputs = SubmitToolOutputs + { tool_calls :: Vector ToolCall + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | The status of the run +data Status + = Queued + | In_Progress + | Requires_Action + | Cancelling + | Cancelled + | Failed + | Completed + | Incomplete + | Expired + deriving stock (Generic, Show) + +instance FromJSON Status where + parseJSON = genericParseJSON aesonOptions + +-- | Details on the action required to continue the run +data RequiredAction = RequiredAction_Submit_Tool_Outputs + { submit_tool_outputs :: SubmitToolOutputs + } deriving stock (Generic, Show) + +instance FromJSON RequiredAction where + parseJSON = genericParseJSON aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type" } + + , tagSingleConstructors = True + + , constructorTagModifier = stripPrefix "RequiredAction_" + } + +-- | Details on why the run is incomplete +data IncompleteDetails = IncompleteDetails + { reason :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Represents an execution run on a thread. +data RunObject = RunObject + { id :: RunID + , object :: Text + , created_at :: POSIXTime + , thread_id :: ThreadID + , assistant_id :: AssistantID + , status :: Status + , required_action :: Maybe RequiredAction + , last_error :: Maybe Error + , expires_at :: Maybe POSIXTime + , started_at :: Maybe POSIXTime + , cancelled_at :: Maybe POSIXTime + , failed_at :: Maybe POSIXTime + , completed_at :: Maybe POSIXTime + , incomplete_details :: Maybe IncompleteDetails + , model :: Model + , instructions :: Maybe Text + , tools :: Vector Tool + , metadata :: Map Text Text + , usage :: Maybe (Usage (Maybe Void) (Maybe Void)) + , temperature :: Maybe Double + , top_p :: Maybe Double + , max_prompt_tokens :: Maybe Natural + , max_completion_tokens :: Maybe Natural + , truncation_strategy :: Maybe TruncationStrategy + , tool_choice :: ToolChoice + , parallel_tool_calls :: Bool + , response_format :: AutoOr ResponseFormat + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Request body for @\/v1\/threads\/:thread_id\/runs\/:run_id@ +data ModifyRun = ModifyRun + { metadata :: Maybe (Map Text Text) + } deriving stock (Generic, Show) + +instance ToJSON ModifyRun where + toJSON = genericToJSON aesonOptions + +-- | Default `ModifyRun` +_ModifyRun :: ModifyRun +_ModifyRun = ModifyRun{ } + +-- | A tool for which the output is being submitted +data ToolOutput = ToolOutput + { tool_call_id :: Maybe Text + , output :: Text + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Request body for @\/v1\/threads\/:thread_id\/runs\/:run_id\/submit_tool_outputs@ +data SubmitToolOutputsToRun = SubmitToolOutputsToRun + { tool_outputs :: Vector ToolOutput + } deriving stock (Generic, Show) + +instance ToJSON SubmitToolOutputsToRun where + toJSON = genericToJSON aesonOptions + +-- | Default implementation of `SubmitToolOutputsToRun` +_SubmitToolOutputsToRun :: SubmitToolOutputsToRun +_SubmitToolOutputsToRun = SubmitToolOutputsToRun{ } + +-- | Servant API +type API = + "threads" + :> Header' '[Required, Strict] "OpenAI-Beta" Text + :> ( Capture "thread_id" ThreadID + :> "runs" + :> QueryParam "include[]" Text + :> ReqBody '[JSON] CreateRun + :> Post '[JSON] RunObject + :<|> "runs" + :> ReqBody '[JSON] CreateThreadAndRun + :> Post '[JSON] RunObject + :<|> Capture "thread_id" ThreadID + :> "runs" + :> QueryParam "limit" Natural + :> QueryParam "order" Order + :> QueryParam "after" Text + :> QueryParam "before" Text + :> Get '[JSON] (ListOf RunObject) + :<|> Capture "thread_id" ThreadID + :> "runs" + :> Capture "run_id" RunID + :> Get '[JSON] RunObject + :<|> Capture "thread_id" ThreadID + :> "runs" + :> Capture "run_id" RunID + :> ReqBody '[JSON] ModifyRun + :> Post '[JSON] RunObject + :<|> Capture "thread_id" ThreadID + :> "runs" + :> Capture "run_id" RunID + :> "submit_tool_outputs" + :> ReqBody '[JSON] SubmitToolOutputsToRun + :> Post '[JSON] RunObject + :<|> Capture "thread_id" ThreadID + :> "runs" + :> Capture "run_id" RunID + :> "cancel" + :> Post '[JSON] RunObject + ) diff --git a/src/OpenAI/V1/Threads/Runs/Steps.hs b/src/OpenAI/V1/Threads/Runs/Steps.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Threads/Runs/Steps.hs @@ -0,0 +1,184 @@ +-- | @\/v1\/threads\/:thread_id\/runs\/:run_id\/steps@ +module OpenAI.V1.Threads.Runs.Steps + ( -- * Main types + StepID(..) + , RunStepObject(..) + + -- * Other types + , Status(..) + , Image(..) + , Output(..) + , CodeInterpreter(..) + , RankingOptions(..) + , Content(..) + , Result(..) + , FileSearch(..) + , Function(..) + , ToolCall(..) + , StepDetails(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.Assistants (AssistantID) +import OpenAI.V1.Error +import OpenAI.V1.Files (FileID) +import OpenAI.V1.ListOf +import OpenAI.V1.Threads.Messages (MessageID) +import OpenAI.V1.Order +import OpenAI.V1.Threads (ThreadID) +import OpenAI.V1.Threads.Runs (RunID) +import OpenAI.V1.Usage + +-- | Step ID +newtype StepID = StepID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | The status of the run step +data Status = In_Progress | Cancelled | Failed | Completed | Expired + deriving stock (Generic, Show) + +instance FromJSON Status where + parseJSON = genericParseJSON aesonOptions + +-- | Code Interpreter image output +data Image = Image{ file_id :: FileID } + deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | An output from the Code Interpreter tool call +data Output = Output_Logs{ logs :: Text } | Output_Image{ image :: Image } + deriving stock (Generic, Show) + +instance FromJSON Output where + parseJSON = genericParseJSON aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + + , constructorTagModifier = stripPrefix "Output_" + } + +-- | A Code Interpreter tool call +data CodeInterpreter = CodeInterpreter + { input :: Text + , outputs :: Vector Output + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | The ranking options for the file search. +data RankingOptions = RankingOptions + { ranker :: Text + , score_threshold :: Double + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | The content of the result that was found +data Content = Content + { type_ :: Text + , text :: Text + } deriving stock (Generic, Show) + +instance FromJSON Content where + parseJSON = genericParseJSON aesonOptions + +-- | Result of the file search +data Result = Result + { file_id :: FileID + , file_name :: Text + , score :: Double + , content :: Vector Content + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | A File Search tool call +data FileSearch = FileSearch + { ranking_options :: RankingOptions + , results :: Vector Result + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | The definition of the function that was called +data Function = Function + { name :: Text + , arguments :: Text + , output :: Maybe Text + } deriving (Generic, Show) + deriving anyclass (FromJSON) + +-- | A tool call the run step was involved in +data ToolCall + = ToolCall_Code_Interpreter { id :: Text, code_interpreter :: CodeInterpreter } + | ToolCall_File_Search { id :: Text, file_search :: Map Text FileSearch } + | ToolCall_Function { id :: Text, function :: Function } + deriving stock (Generic, Show) + +instance FromJSON ToolCall where + parseJSON = genericParseJSON aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + + , constructorTagModifier = stripPrefix "ToolCall_" + } + +-- | The details of the run step +data StepDetails + = Message_Creation{ message_id :: MessageID } + | Tool_Calls{ tool_calls :: Vector ToolCall } + deriving stock (Generic, Show) + +instance FromJSON StepDetails where + parseJSON = genericParseJSON aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + } + +-- | Represents a step in execution of a run. +data RunStepObject = RunStepObject + { id :: StepID + , object :: Text + , created_at :: POSIXTime + , assistant_id :: AssistantID + , thread_id :: ThreadID + , run_id :: RunID + , status :: Status + , step_details :: StepDetails + , last_error :: Maybe Error + , expired_at :: Maybe POSIXTime + , cancelled_at :: Maybe POSIXTime + , failed_at :: Maybe POSIXTime + , completed_at :: Maybe POSIXTime + , metadata :: Map Text Text + , usage :: Maybe (Usage CompletionTokensDetails PromptTokensDetails) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "threads" + :> Header' '[Required, Strict] "OpenAI-Beta" Text + :> ( Capture "thread_id" ThreadID + :> "runs" + :> Capture "run_id" RunID + :> "steps" + :> QueryParam "limit" Natural + :> QueryParam "order" Order + :> QueryParam "after" Text + :> QueryParam "before" Text + :> QueryParam "include[]" Text + :> Get '[JSON] (ListOf RunStepObject) + :<|> Capture "thread_id" ThreadID + :> "runs" + :> Capture "run_id" RunID + :> "steps" + :> Capture "step_id" StepID + :> QueryParam "include[]" Text + :> Get '[JSON] RunStepObject + ) diff --git a/src/OpenAI/V1/Tool.hs b/src/OpenAI/V1/Tool.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Tool.hs @@ -0,0 +1,77 @@ +-- | The `Tool` type +module OpenAI.V1.Tool + ( -- * Types + Tool(..) + , RankingOptions(..) + , FileSearch(..) + , Function(..) + , ToolChoice(..) + ) where + +import OpenAI.Prelude + +-- | The ranking options for the file search +data RankingOptions = RankingOptions + { ranker :: Maybe Text + , score_threshold :: Double + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Overrides for the file search tool +data FileSearch = FileSearch + { max_num_results :: Maybe Natural + , ranking_options :: Maybe RankingOptions + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | The Function tool +data Function = Function + { description :: Maybe Text + , name :: Text + , parameters :: Maybe Value + , strict :: Maybe Bool + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | A tool enabled on the assistant +data Tool + = Tool_Code_Interpreter + | Tool_File_Search{ file_search :: FileSearch } + | Tool_Function{ function :: Function } + deriving stock (Generic, Show) + +toolOptions :: Options +toolOptions = aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + + , constructorTagModifier = stripPrefix "Tool_" + } + +instance FromJSON Tool where + parseJSON = genericParseJSON toolOptions + +instance ToJSON Tool where + toJSON = genericToJSON toolOptions + +-- | Controls which (if any) tool is called by the model +data ToolChoice + = ToolChoiceNone + | ToolChoiceAuto + | ToolChoiceRequired + | ToolChoiceTool Tool + deriving stock (Generic, Show) + +instance FromJSON ToolChoice where + parseJSON "none" = pure ToolChoiceNone + parseJSON "auto" = pure ToolChoiceAuto + parseJSON "required" = pure ToolChoiceRequired + parseJSON other = fmap ToolChoiceTool (parseJSON other) + +instance ToJSON ToolChoice where + toJSON ToolChoiceNone = "none" + toJSON ToolChoiceAuto = "auto" + toJSON ToolChoiceRequired = "required" + toJSON (ToolChoiceTool tool) = toJSON tool diff --git a/src/OpenAI/V1/ToolCall.hs b/src/OpenAI/V1/ToolCall.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/ToolCall.hs @@ -0,0 +1,35 @@ +-- | The `ToolCall` type +module OpenAI.V1.ToolCall + ( -- * Types + ToolCall(..) + , Function(..) + ) where + +import OpenAI.Prelude + +-- | A called function +data Function = Function{ name :: Text, arguments :: Text } + deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Tools called by the model +data ToolCall = ToolCall_Function + { id :: Text + , function :: Function + } deriving stock (Generic, Show) + +toolCallOptions :: Options +toolCallOptions = aesonOptions + { sumEncoding = + TaggedObject{ tagFieldName = "type", contentsFieldName = "" } + + , tagSingleConstructors = True + + , constructorTagModifier = stripPrefix "ToolCall_" + } + +instance ToJSON ToolCall where + toJSON = genericToJSON toolCallOptions + +instance FromJSON ToolCall where + parseJSON = genericParseJSON toolCallOptions diff --git a/src/OpenAI/V1/ToolResources.hs b/src/OpenAI/V1/ToolResources.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/ToolResources.hs @@ -0,0 +1,44 @@ +-- | The `ToolResources` type +module OpenAI.V1.ToolResources + ( -- * Main types + ToolResources(..) + + -- * Other types + , CodeInterpreterResources(..) + , Static(..) + , VectorStore(..) + , FileSearchResources(..) + ) where + +import OpenAI.Prelude +import OpenAI.V1.AutoOr +import OpenAI.V1.ChunkingStrategy +import OpenAI.V1.Files (FileID) + +-- | Resources for the code search tool +data CodeInterpreterResources = CodeInterpreterResources + { file_ids :: Maybe (Vector FileID) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | A helper to create a vector store with file_ids and attach it to this +-- assistant +data VectorStore = VectorStore + { file_ids :: Maybe (Vector FileID) + , chunking_strategy :: Maybe (AutoOr ChunkingStrategy) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Resources for the file search tool +data FileSearchResources = FileSearchResources + { vector_store_ids :: Maybe (Vector FileID) + , vector_stores :: Maybe (Vector VectorStore) + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | A set of resources that are used by the assistant's tools +data ToolResources = ToolResources + { code_interpreter :: Maybe CodeInterpreterResources + , file_search :: Maybe FileSearchResources + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) diff --git a/src/OpenAI/V1/Uploads.hs b/src/OpenAI/V1/Uploads.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Uploads.hs @@ -0,0 +1,136 @@ +-- | @\/v1\/uploads@ +{-# LANGUAGE InstanceSigs #-} +module OpenAI.V1.Uploads + ( -- * Main types + UploadID(..) + , CreateUpload(..) + , _CreateUpload + , AddUploadPart(..) + , _AddUploadPart + , CompleteUpload(..) + , _CompleteUpload + , UploadObject(..) + , PartObject(..) + -- * Other types + , Status(..) + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.Files (FileObject, Purpose) + +import qualified Data.Text as Text + +-- | Upload ID +newtype UploadID = UploadID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Request body for @\/v1\/uploads@ +data CreateUpload = CreateUpload + { filename :: Text + , purpose :: Purpose + , bytes :: Natural + , mime_type :: Text + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Default `CreateUpload` +_CreateUpload :: CreateUpload +_CreateUpload = CreateUpload{ } + +-- | Request body for @\/v1\/uploads\/:upload_id\/parts@ +data AddUploadPart = AddUploadPart{ data_ :: FilePath } + +-- | Default `AddUploadPart` +_AddUploadPart :: AddUploadPart +_AddUploadPart = AddUploadPart{ } + +instance ToMultipart Tmp AddUploadPart where + toMultipart AddUploadPart{..} = MultipartData{..} + where + inputs = mempty + + files = [ FileData{..} ] + where + fdInputName = "data" + fdFileName = Text.pack data_ + fdFileCType = "application/octet-stream" + fdPayload = data_ + +-- | Request body for @\/v1\/uploads\/:upload_id\/complete@ +data CompleteUpload = CompleteUpload + { part_ids :: Vector Text + , md5 :: Maybe Text + } deriving stock (Generic, Show) + +-- | Default `CompleteUpload` +_CompleteUpload :: CompleteUpload +_CompleteUpload = CompleteUpload + { md5 = Nothing + } + +-- OpenAI says that the `md5` field is optional, but what they really mean is +-- that it can be set to the empty string. We still model it as `Maybe Text`, +-- but convert `Nothing` to an empty string at encoding time. +instance ToJSON CompleteUpload where + toJSON completeUpload = genericToJSON aesonOptions (fix completeUpload) + where + fix CompleteUpload{ md5 = Nothing, .. } = + CompleteUpload{ md5 = Just "", .. } + fix x = x + +-- | The status of the Upload +data Status + = Pending + | Completed + | Cancelled + | Expired + deriving stock (Generic, Show) + +instance FromJSON Status where + parseJSON = genericParseJSON aesonOptions + +-- | The Upload object can accept byte chunks in the form of Parts. +data UploadObject file = UploadObject + { id :: UploadID + , created_at :: POSIXTime + , filename :: Text + , bytes :: Natural + , purpose :: Purpose + , status :: Status + , expires_at :: POSIXTime + , object :: Text + , file :: file + } deriving stock (Generic, Show) + +instance FromJSON (UploadObject (Maybe Void)) +instance FromJSON (UploadObject FileObject) + +-- | The upload part represents a chunk of bytes we can add to an upload +-- object +data PartObject = PartObject + { id :: Text + , created_at :: POSIXTime + , upload_id :: UploadID + , object :: Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API + = "uploads" + :> ( ReqBody '[JSON] CreateUpload + :> Post '[JSON] (UploadObject (Maybe Void)) + :<|> Capture "upload_id" UploadID + :> "parts" + :> MultipartForm Tmp AddUploadPart + :> Post '[JSON] PartObject + :<|> Capture "upload_id" UploadID + :> "complete" + :> ReqBody '[JSON] CompleteUpload + :> Post '[JSON] (UploadObject FileObject) + :<|> Capture "upload_id" UploadID + :> "cancel" + :> Post '[JSON] (UploadObject (Maybe Void)) + ) diff --git a/src/OpenAI/V1/Usage.hs b/src/OpenAI/V1/Usage.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/Usage.hs @@ -0,0 +1,39 @@ +-- | The `Usage` type +module OpenAI.V1.Usage + ( -- * Main types + Usage(..) + + -- * Other types + , CompletionTokensDetails(..) + , PromptTokensDetails(..) + ) where + +import OpenAI.Prelude + +-- | Breakdown of tokens used in a completion +data CompletionTokensDetails = CompletionTokensDetails + { accepted_prediction_tokens :: Natural + , audio_tokens :: Natural + , reasoning_tokens :: Natural + , rejected_prediction_tokens :: Natural + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Breakdown of tokens used in the prompt +data PromptTokensDetails = PromptTokensDetails + { audio_tokens :: Natural + , cached_tokens :: Natural + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Usage statistics for the completion request +data Usage completionTokensDetails promptTokensDetails = Usage + { completion_tokens :: Natural + , prompt_tokens :: Natural + , total_tokens :: Natural + , completion_tokens_details :: completionTokensDetails + , prompt_tokens_details :: promptTokensDetails + } deriving stock (Generic, Show) + +instance FromJSON (Usage CompletionTokensDetails PromptTokensDetails) +instance FromJSON (Usage (Maybe Void) (Maybe Void)) diff --git a/src/OpenAI/V1/VectorStores.hs b/src/OpenAI/V1/VectorStores.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/VectorStores.hs @@ -0,0 +1,116 @@ +-- | @\/v1\/vector_stores@ +module OpenAI.V1.VectorStores + ( -- * Main types + VectorStoreID(..) + , CreateVectorStore(..) + , _CreateVectorStore + , ModifyVectorStore(..) + , _ModifyVectorStore + , VectorStoreObject(..) + + -- * Other types + , ExpiresAfter(..) + , Status(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.AutoOr +import OpenAI.V1.ChunkingStrategy +import OpenAI.V1.DeletionStatus +import OpenAI.V1.Files (FileID) +import OpenAI.V1.Order +import OpenAI.V1.ListOf +import OpenAI.V1.VectorStores.FileCounts + +-- | Vector store ID +newtype VectorStoreID = VectorStoreID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | The expiration policy for a vector store. +data ExpiresAfter = ExpiresAfter + { anchor :: Text + , days :: Natural + } deriving stock (Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +-- | Request body for @\/v1\/vector_stores@ +data CreateVectorStore = CreateVectorStore + { file_ids :: Vector FileID + , name :: Maybe Text + , expires_after :: Maybe ExpiresAfter + , chunking_strategy :: Maybe (AutoOr ChunkingStrategy) + , metadata :: Maybe (Map Text Text) + } deriving stock (Generic, Show) + deriving (ToJSON) + +-- | Default `CreateVectorStore` +_CreateVectorStore :: CreateVectorStore +_CreateVectorStore = CreateVectorStore + { name = Nothing + , expires_after = Nothing + , chunking_strategy = Nothing + , metadata = Nothing + } + +-- | Request body for @\/v1\/vector_stores\/:vector_store_id@ +data ModifyVectorStore = ModifyVectorStore + { name :: Maybe Text + , expires_after :: Maybe ExpiresAfter + , metadata :: Maybe (Map Text Text) + } deriving stock (Generic, Show) + deriving (ToJSON) + +-- | Default `ModifyVectorStore` +_ModifyVectorStore :: ModifyVectorStore +_ModifyVectorStore = ModifyVectorStore + { name = Nothing + , expires_after = Nothing + , metadata = Nothing + } + +-- | The status of the vector store +data Status = Expired | In_Progress | Completed + deriving stock (Generic, Show) + +instance FromJSON Status where + parseJSON = genericParseJSON aesonOptions + +-- | A vector store is a collection of processed files can be used by the +-- @file_search@ tool. +data VectorStoreObject = VectorStoreObject + { id :: VectorStoreID + , object :: Text + , created_at :: POSIXTime + , name :: Maybe Text + , usage_bytes :: Natural + , file_counts :: FileCounts + , status :: Status + , expires_after :: Maybe ExpiresAfter + , expires_at :: Maybe POSIXTime + , last_active_at :: Maybe POSIXTime + , metadata :: Map Text Text + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "vector_stores" + :> Header' '[Required, Strict] "OpenAI-Beta" Text + :> ( ReqBody '[JSON] CreateVectorStore + :> Post '[JSON] VectorStoreObject + :<|> QueryParam "limit" Natural + :> QueryParam "order" Order + :> QueryParam "after" Text + :> QueryParam "before" Text + :> Get '[JSON] (ListOf VectorStoreObject) + :<|> Capture "vector_store_id" VectorStoreID + :> Get '[JSON] VectorStoreObject + :<|> Capture "vector_store_id" VectorStoreID + :> ReqBody '[JSON] ModifyVectorStore + :> Post '[JSON] VectorStoreObject + :<|> Capture "vector_store_id" VectorStoreID + :> Delete '[JSON] DeletionStatus + ) diff --git a/src/OpenAI/V1/VectorStores/FileBatches.hs b/src/OpenAI/V1/VectorStores/FileBatches.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/VectorStores/FileBatches.hs @@ -0,0 +1,77 @@ +-- | @\/v1\/vector_stores\/:vector_store_id\/file_batches@ +module OpenAI.V1.VectorStores.FileBatches + ( -- * Main types + VectorStoreFileBatchID(..) + , CreateVectorStoreFileBatch(..) + , _CreateVectorStoreFileBatch + , VectorStoreFilesBatchObject(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.ChunkingStrategy +import OpenAI.V1.Files (FileID) +import OpenAI.V1.ListOf +import OpenAI.V1.Order +import OpenAI.V1.VectorStores (VectorStoreID) +import OpenAI.V1.VectorStores.FileCounts +import OpenAI.V1.VectorStores.Status + +-- | Vector store file batch ID +newtype VectorStoreFileBatchID = VectorStoreFileBatchID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Request body for @\/v1\/vector_stores\/:vector_store_id\/file_batches@ +data CreateVectorStoreFileBatch = CreateVectorStoreFileBatch + { file_ids :: Vector FileID + , chunking_strategy :: Maybe ChunkingStrategy + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Default `CreateVectorStoreFileBatch` +_CreateVectorStoreFileBatch :: CreateVectorStoreFileBatch +_CreateVectorStoreFileBatch = CreateVectorStoreFileBatch + { chunking_strategy = Nothing + } + +-- | A batch of files attached to a vector store +data VectorStoreFilesBatchObject = VectorStoreFilesBatchObject + { id :: VectorStoreFileBatchID + , object :: Text + , created_at :: POSIXTime + , vector_store_id :: VectorStoreID + , status :: Status + , file_counts :: Maybe FileCounts + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "vector_stores" + :> Header' '[Required, Strict] "OpenAI-Beta" Text + :> ( Capture "vector_store_id" VectorStoreID + :> "file_batches" + :> ReqBody '[JSON] CreateVectorStoreFileBatch + :> Post '[JSON] VectorStoreFilesBatchObject + :<|> Capture "vector_store_id" VectorStoreID + :> "file_batches" + :> Capture "batch_id" VectorStoreFileBatchID + :> Get '[JSON] VectorStoreFilesBatchObject + :<|> Capture "vector_store_id" VectorStoreID + :> "file_batches" + :> Capture "batch_id" VectorStoreFileBatchID + :> "cancel" + :> Post '[JSON] VectorStoreFilesBatchObject + :<|> Capture "vector_store_id" VectorStoreID + :> "file_batches" + :> Capture "batch_id" VectorStoreFileBatchID + :> "files" + :> QueryParam "limit" Natural + :> QueryParam "order" Order + :> QueryParam "after" Text + :> QueryParam "before" Text + :> QueryParam "filter" Status + :> Get '[JSON] (ListOf VectorStoreFilesBatchObject) + ) diff --git a/src/OpenAI/V1/VectorStores/FileCounts.hs b/src/OpenAI/V1/VectorStores/FileCounts.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/VectorStores/FileCounts.hs @@ -0,0 +1,17 @@ +-- | The `FileCounts` type +module OpenAI.V1.VectorStores.FileCounts + ( -- * Main types + FileCounts(..) + ) where + +import OpenAI.Prelude + +-- | File counts +data FileCounts = FileCounts + { in_progress :: Natural + , completed :: Natural + , failed :: Natural + , cancelled :: Natural + , total :: Natural + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) diff --git a/src/OpenAI/V1/VectorStores/Files.hs b/src/OpenAI/V1/VectorStores/Files.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/VectorStores/Files.hs @@ -0,0 +1,77 @@ +-- | @\/v1\/vector_stores\/:vector_store_id\/files@ +module OpenAI.V1.VectorStores.Files + ( -- * Main types + VectorStoreFileID(..) + , CreateVectorStoreFile(..) + , _CreateVectorStoreFile + , VectorStoreFileObject(..) + + -- * Servant + , API + ) where + +import OpenAI.Prelude +import OpenAI.V1.ChunkingStrategy +import OpenAI.V1.DeletionStatus +import OpenAI.V1.Files (FileID) +import OpenAI.V1.Error +import OpenAI.V1.ListOf +import OpenAI.V1.Order +import OpenAI.V1.VectorStores (VectorStoreID) +import OpenAI.V1.VectorStores.Status + +-- | Vector store file ID +newtype VectorStoreFileID = VectorStoreFileID{ text :: Text } + deriving newtype (FromJSON, IsString, Show, ToHttpApiData, ToJSON) + +-- | Request body for @\/v1\/vector_stores\/:vector_store_id\/files@ +data CreateVectorStoreFile = CreateVectorStoreFile + { file_id :: FileID + , chunking_strategy :: Maybe ChunkingStrategy + } deriving stock (Generic, Show) + deriving anyclass (ToJSON) + +-- | Default `CreateVectorStoreFile` +_CreateVectorStoreFile :: CreateVectorStoreFile +_CreateVectorStoreFile = CreateVectorStoreFile + { chunking_strategy = Nothing + } + +-- | A list of files attached to a vector store +data VectorStoreFileObject = VectorStoreFileObject + { id :: VectorStoreFileID + , object :: Text + , usage_bytes :: Natural + , created_at :: POSIXTime + , vector_store_id :: VectorStoreID + , status :: Status + , last_error :: Maybe Error + , chunking_strategy :: ChunkingStrategy + } deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +-- | Servant API +type API = + "vector_stores" + :> Header' '[Required, Strict] "OpenAI-Beta" Text + :> ( Capture "vector_store_id" VectorStoreID + :> "files" + :> ReqBody '[JSON] CreateVectorStoreFile + :> Post '[JSON] VectorStoreFileObject + :<|> Capture "vector_store_id" VectorStoreID + :> "files" + :> QueryParam "limit" Natural + :> QueryParam "order" Order + :> QueryParam "after" Text + :> QueryParam "before" Text + :> QueryParam "filter" Status + :> Get '[JSON] (ListOf VectorStoreFileObject) + :<|> Capture "vector_store_id" VectorStoreID + :> "files" + :> Capture "file_id" VectorStoreFileID + :> Get '[JSON] VectorStoreFileObject + :<|> Capture "vector_store_id" VectorStoreID + :> "files" + :> Capture "file_id" VectorStoreFileID + :> Delete '[JSON] DeletionStatus + ) diff --git a/src/OpenAI/V1/VectorStores/Status.hs b/src/OpenAI/V1/VectorStores/Status.hs new file mode 100644 --- /dev/null +++ b/src/OpenAI/V1/VectorStores/Status.hs @@ -0,0 +1,20 @@ +-- | The `Status` type +module OpenAI.V1.VectorStores.Status + ( -- * Main types + Status(..) + ) where + +import OpenAI.Prelude + +-- | The status of the vector store file +data Status = In_Progress | Completed | Cancelled | Failed + deriving stock (Generic, Show) + +instance FromJSON Status where + parseJSON = genericParseJSON aesonOptions + +instance ToHttpApiData Status where + toUrlPiece In_Progress = "in_progress" + toUrlPiece Completed = "completed" + toUrlPiece Cancelled = "cancelled" + toUrlPiece Failed = "failed" diff --git a/tasty/Main.hs b/tasty/Main.hs new file mode 100644 --- /dev/null +++ b/tasty/Main.hs @@ -0,0 +1,653 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Main where + +import OpenAI.V1 (Methods(..)) +import OpenAI.V1.AutoOr (AutoOr(..)) +import OpenAI.V1.Audio.Transcriptions (CreateTranscription(..)) +import OpenAI.V1.Audio.Translations (CreateTranslation(..)) +import OpenAI.V1.Batches (BatchObject(..), CreateBatch(..)) +import OpenAI.V1.Embeddings (CreateEmbeddings(..), EncodingFormat(..)) +import OpenAI.V1.Files (FileObject(..), Order(..), UploadFile(..)) +import OpenAI.V1.Images.Edits (CreateImageEdit(..)) +import OpenAI.V1.Images.Variations (CreateImageVariation(..)) +import OpenAI.V1.Message (Message(..)) +import OpenAI.V1.Moderations (CreateModeration(..)) +import OpenAI.V1.Threads.Messages (MessageObject(..), ModifyMessage(..)) +import OpenAI.V1.Tool (Tool(..), ToolChoice(..)) +import OpenAI.V1.ToolCall (ToolCall(..)) +import Prelude hiding (id) + +import OpenAI.V1.Assistants + (CreateAssistant(..), ModifyAssistant(..), AssistantObject(..)) +import OpenAI.V1.Audio.Speech + (_CreateSpeech, CreateSpeech(..), Voice(..)) +import OpenAI.V1.Chat.Completions + (CreateChatCompletion(..), Modality(..)) +import OpenAI.V1.FineTuning.Jobs + (CreateFineTuningJob(..), Hyperparameters(..), JobObject(..)) +import OpenAI.V1.Images.Generations + (CreateImage(..), Quality(..), Style(..)) +import OpenAI.V1.Threads + (ModifyThread(..), Thread(..), ThreadObject(..)) +import OpenAI.V1.Threads.Runs + (CreateRun(..), ModifyRun(..), RunObject(..)) +import OpenAI.V1.Uploads + ( AddUploadPart(..) + , CompleteUpload(..) + , CreateUpload(..) + , PartObject(..) + , UploadObject(..) + ) +import OpenAI.V1.VectorStores + ( CreateVectorStore(..) + , ModifyVectorStore(..) + , VectorStoreObject(..) + ) +import OpenAI.V1.VectorStores.Files + (CreateVectorStoreFile(..), VectorStoreFileObject(..)) +import OpenAI.V1.VectorStores.FileBatches + (CreateVectorStoreFileBatch(..), VectorStoreFilesBatchObject(..)) + +import qualified Data.Text as Text +import qualified Network.HTTP.Client as HTTP.Client +import qualified Network.HTTP.Client.TLS as TLS +import qualified OpenAI.V1 as V1 +import qualified OpenAI.V1.Chat.Completions as Completions +import qualified OpenAI.V1.Files as Files +import qualified OpenAI.V1.FineTuning.Jobs as Jobs +import qualified OpenAI.V1.Images.ResponseFormat as ResponseFormat +import qualified OpenAI.V1.Tool as Tool +import qualified OpenAI.V1.ToolCall as ToolCall +import qualified Servant.Client as Client +import qualified System.Environment as Environment +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as HUnit + +main :: IO () +main = do + let managerSettings = TLS.tlsManagerSettings + { HTTP.Client.managerResponseTimeout = + HTTP.Client.responseTimeoutNone + } + + manager <- TLS.newTlsManagerWith managerSettings + + baseUrl <- Client.parseBaseUrl "https://api.openai.com" + + let clientEnv = Client.mkClientEnv manager baseUrl + + key <- Environment.getEnv "OPENAI_KEY" + + let user = "openai Haskell package" + let chatModel = "gpt-4o-mini" + + let Methods{..} = V1.makeMethods clientEnv (Text.pack key) + + -- Test each format to make sure we're handling each possible content type + -- correctly + let speechTest format = + HUnit.testCase ("Create speech - " <> show format) do + _ <- createSpeech _CreateSpeech + { model = "tts-1" + , input = "Hello, world!" + , voice = Nova + , response_format = Just format + , speed = Just 1.0 + } + + return () + + let speechTests = do + format <- [ minBound .. maxBound ] + return (speechTest format) + + let transcriptionTest = + HUnit.testCase "Create transcription" do + _ <- createTranscription CreateTranscription + { file = "tasty/data/v1/audio/preamble.wav" + , model = "whisper-1" + , language = Just "en" + , prompt = Nothing + , temperature = Just 0 + } + + return () + + let translationTest = + HUnit.testCase "Create translation" do + _ <- createTranslation CreateTranslation + { file = "tasty/data/v1/audio/preamble.wav" + , model = "whisper-1" + , prompt = Nothing + , temperature = Just 0 + } + + return () + + let completionsMinimalTest = + HUnit.testCase "Create chat completion - minimal" do + _ <- createChatCompletion CreateChatCompletion + { messages = + [ Completions.User + { content = [ "Hello, world!" ], name = Nothing } + ] + , model = chatModel + , store = Nothing + , metadata = Nothing + , frequency_penalty = Nothing + , logit_bias = Nothing + , logprobs = Nothing + , top_logprobs = Nothing + , max_completion_tokens = Nothing + , n = Nothing + , modalities = Nothing + , prediction = Nothing + , audio = Nothing + , presence_penalty = Nothing + , response_format = Nothing + , seed = Nothing + , service_tier = Nothing + , stop = Nothing + , temperature = Nothing + , top_p = Nothing + , tools = Nothing + , tool_choice = Nothing + , parallel_tool_calls = Nothing + , user = Nothing + } + + return () + + let completionsMaximalTest = + HUnit.testCase "Create chat completion - maximal" do + _ <- createChatCompletion CreateChatCompletion + { messages = + [ Completions.User + { content = [ "Hello, world!" ] + , name = Just "gabby" + } + , Completions.Assistant + { assistant_content = Nothing + , refusal = Nothing + , name = Just "Ada" + , assistant_audio = Nothing + , tool_calls = Just + [ ToolCall_Function + { id = "call_bzE95mjMMFqeanfY2sL6Sdir" + , function = ToolCall.Function + { name = "hello" + , arguments = "{}" + } + } + ] + } + , Completions.Tool + { content = [ "Hello, world!" ] + , tool_call_id = "call_bzE95mjMMFqeanfY2sL6Sdir" + } + ] + , model = chatModel + , store = Just False + , metadata = Nothing + , frequency_penalty = Just 0 + , logit_bias = Just mempty + , logprobs = Just True + , top_logprobs = Just 1 + , max_completion_tokens = Just 1024 + , n = Just 1 + , modalities = Just [ Modality_Text ] + , prediction = Nothing + , audio = Nothing + , presence_penalty = Just 0 + , response_format = Just Completions.ResponseFormat_Text + , seed = Just 0 + , service_tier = Just Auto + , stop = Just [ ">>>" ] + , temperature = Just 1 + , top_p = Just 1 + , tools = Just + [ Tool_Function + { function = Tool.Function + { description = + Just "Use the hello command line tool" + , name = "hello" + , parameters = Nothing + , strict = Just False + } + } + ] + , tool_choice = Just ToolChoiceAuto + , parallel_tool_calls = Just True + , user = Just user + } + + return () + + let embeddingsTest = do + HUnit.testCase "Create embedding" do + _ <- createEmbeddings CreateEmbeddings + { input = "Hello, world!" + , model = "text-embedding-3-small" + , encoding_format = Just Float + , dimensions = Just 1024 + , user = Just user + } + + return () + + let fineTuningTest = do + HUnit.testCase "Fine-tuning and File operations - maximal" do + FileObject{ id = trainingId } <- uploadFile UploadFile + { file = + "tasty/data/v1/fine_tuning/jobs/training_data.jsonl" + , purpose = Files.Fine_Tune + } + + FileObject{ id = validationId } <- uploadFile UploadFile + { file = + "tasty/data/v1/fine_tuning/jobs/validation_data.jsonl" + , purpose = Files.Fine_Tune + } + + _ <- retrieveFile trainingId + + _ <- retrieveFileContent trainingId + + _ <- listFiles (Just Files.Fine_Tune) (Just 10000) (Just Asc) Nothing + + JobObject{ id } <- createFineTuningJob CreateFineTuningJob + { model = "gpt-4o-mini-2024-07-18" + , training_file = trainingId + , hyperparameters = Just + Hyperparameters + { batch_size = Just Jobs.Auto + , learning_rate_multiplier = Just Jobs.Auto + , n_epochs = Just Jobs.Auto + } + , suffix = Just "haskell-openai" + , validation_file = Just validationId + , integrations = Just [] + , seed = Just 0 + } + + _ <- retrieveFineTuningJob id + + _ <- listFineTuningJobs Nothing (Just 20) + + _ <- listFineTuningCheckpoints id Nothing (Just 10) + + _ <- cancelFineTuning id + + _ <- listFineTuningEvents id Nothing (Just 20) + + _ <- deleteFile trainingId + _ <- deleteFile validationId + + return () + + let batchesTest = do + HUnit.testCase "Batch operations" do + FileObject{ id = requestsId } <- uploadFile UploadFile + { file = "tasty/data/v1/batches/requests.jsonl" + , purpose = Files.Batch + } + + BatchObject{ id } <- createBatch CreateBatch + { input_file_id = requestsId + , endpoint = "/v1/chat/completions" + , completion_window = "24h" + , metadata = Nothing + } + + _ <- retrieveBatch id + + _ <- listBatch Nothing (Just 20) + + _ <- cancelBatch id + + return () + + let uploadsTest = do + HUnit.testCase "Upload operations" do + UploadObject{ id = cancelledId } <- createUpload CreateUpload + { filename = "training_data.jsonl" + , purpose = Files.Fine_Tune + , bytes = 4077 + , mime_type = "text/jsonl" + } + + _ <- cancelUpload cancelledId + + UploadObject{ id } <- createUpload CreateUpload + { filename = "training_data.jsonl" + , purpose = Files.Fine_Tune + , bytes = 4077 + , mime_type = "text/jsonl" + } + + PartObject{ id = partId0 } <- addUploadPart id AddUploadPart + { data_ = "tasty/data/v1/uploads/training_data0.jsonl" } + + PartObject{ id = partId1 } <- addUploadPart id AddUploadPart + { data_ = "tasty/data/v1/uploads/training_data1.jsonl" } + + _ <- completeUpload id CompleteUpload + { part_ids = [ partId0, partId1 ] + , md5 = Nothing + } + + return () + + let createImageMinimalTest = do + HUnit.testCase "Create image - minimal" do + _ <- createImage CreateImage + { prompt = "A baby panda" + , model = Nothing + , n = Nothing + , quality = Nothing + , response_format = Nothing + , size = Nothing + , style = Nothing + , user = Nothing + } + + return () + + let createImageMaximalTest = do + HUnit.testCase "Create image - maximal" do + _ <- createImage CreateImage + { prompt = "A baby panda" + , model = Just "dall-e-2" + , n = Just 1 + , quality = Just Standard + , response_format = Just ResponseFormat.URL + , size = Just "1024x1024" + , style = Just Vivid + , user = Just user + } + + return () + + let createImageEditMinimalTest = do + HUnit.testCase "Create image edit - minimal" do + _ <- createImageEdit CreateImageEdit + { image = "tasty/data/v1/images/image.png" + , prompt = "The panda should be greener" + , mask = Nothing + , model = Nothing + , n = Nothing + , size = Nothing + , response_format = Nothing + , user = Nothing + } + + return () + + let createImageEditMaximalTest = do + HUnit.testCase "Create image edit - maximal" do + _ <- createImageEdit CreateImageEdit + { image = "tasty/data/v1/images/image.png" + , prompt = "The panda should be greener" + , mask = Nothing + , model = Just "dall-e-2" + , n = Just 1 + , size = Just "1024x1024" + , response_format = Just ResponseFormat.URL + , user = Just user + } + + return () + + let createImageVariationMinimalTest = do + HUnit.testCase "Create image variation - minimal" do + _ <- createImageVariation CreateImageVariation + { image = "tasty/data/v1/images/image.png" + , model = Nothing + , n = Nothing + , response_format = Nothing + , size = Nothing + , user = Nothing + } + + return () + + let createImageVariationMaximalTest = do + HUnit.testCase "Create image variation - maximal" do + _ <- createImageVariation CreateImageVariation + { image = "tasty/data/v1/images/image.png" + , model = Just "dall-e-2" + , n = Just 1 + , response_format = Just ResponseFormat.URL + , size = Just "1024x1024" + , user = Just user + } + + return () + + let createModerationTest = do + HUnit.testCase "Create moderation" do + _ <- createModeration CreateModeration + { input = "I am going to kill you" + , model = Nothing + } + + return () + + let assistantsTest = do + HUnit.testCase "Assistant operations" do + AssistantObject{ id } <- createAssistant CreateAssistant + { model = chatModel + , name = Nothing + , description = Nothing + , instructions = Nothing + , tools = Nothing + , tool_resources = Nothing + , metadata = Nothing + , temperature = Nothing + , top_p = Nothing + , response_format = Nothing + } + + _ <- listAssistants Nothing Nothing Nothing Nothing + + _ <- retrieveAssistant id + + _ <- modifyAssistant id ModifyAssistant + { model = chatModel + , name = Nothing + , description = Nothing + , instructions = Nothing + , tools = Nothing + , tool_resources = Nothing + , metadata = Nothing + , temperature = Nothing + , top_p = Nothing + , response_format = Nothing + } + + _ <- deleteAssistant id + + return () + + let messagesTest = do + HUnit.testCase "Message operations" do + ThreadObject{ id = threadId } <- createThread Thread + { messages = Just + [ User + { content = [ "Hi, how can I help you!" ] + , attachments = Nothing + , metadata = Nothing + } + ] + , tool_resources = Nothing + , metadata = Nothing + } + + MessageObject{ id = messageId } <- createMessage threadId User + { content = [ "What is the capital of France?" ] + , attachments = Nothing + , metadata = Nothing + } + + _ <- retrieveMessage threadId messageId + + _ <- modifyMessage threadId messageId ModifyMessage + { metadata = Nothing + } + + _ <- deleteMessage threadId messageId + + _ <- deleteThread threadId + + return () + + let threadsRunsStepsTest = do + HUnit.testCase "Thread/Run/Step operations" do + ThreadObject{ id = threadId } <- createThread Thread + { messages = Just + [ User + { content = [ "Hello, world!" ] + , attachments = Nothing + , metadata = Nothing + } + ] + , tool_resources = Nothing + , metadata = Nothing + } + + _ <- retrieveThread threadId + + _ <- modifyThread threadId ModifyThread + { tool_resources = Nothing + , metadata = Nothing + } + + AssistantObject{ id = assistantId } <- createAssistant CreateAssistant + { model = chatModel + , name = Nothing + , description = Nothing + , instructions = Nothing + , tools = Nothing + , tool_resources = Nothing + , metadata = Nothing + , temperature = Nothing + , top_p = Nothing + , response_format = Nothing + } + + RunObject{ id = runId } <- createRun threadId Nothing CreateRun + { assistant_id = assistantId + , model = Nothing + , instructions = Nothing + , additional_instructions = Nothing + , additional_messages = Nothing + , tools = Nothing + , metadata = Nothing + , temperature = Nothing + , top_p = Nothing + , max_prompt_tokens = Nothing + , max_completion_tokens = Nothing + , truncation_strategy = Nothing + , tool_choice = Nothing + , parallel_tool_calls = Nothing + , response_format = Nothing + } + + _ <- listRuns threadId Nothing Nothing Nothing Nothing + + _ <- retrieveRun threadId runId + + _ <- modifyRun threadId runId ModifyRun + { metadata = Nothing + } + + _ <- deleteThread threadId + + return () + + let vectorStoreFilesTest = do + HUnit.testCase "Vector store file and batch operations" do + FileObject{ id = fileId } <- uploadFile UploadFile + { file = "tasty/data/v1/vector_stores/index.html" + , purpose = Files.Assistants + } + + VectorStoreObject{ id = vectorStoreId } <- createVectorStore CreateVectorStore + { file_ids = [] + , name = Nothing + , expires_after = Nothing + , chunking_strategy = Nothing + , metadata = Nothing + } + + VectorStoreFileObject{ id = vectorStoreFileId } <- createVectorStoreFile vectorStoreId CreateVectorStoreFile + { file_id = fileId + , chunking_strategy = Nothing + } + + VectorStoreFilesBatchObject{ id = batchId } <- createVectorStoreFileBatch vectorStoreId CreateVectorStoreFileBatch + { file_ids = [ fileId ] + , chunking_strategy = Nothing + } + + _ <- listVectorStores Nothing Nothing Nothing Nothing + + _ <- listVectorStoreFiles vectorStoreId Nothing Nothing Nothing Nothing Nothing + + _ <- listVectorStoreFilesInABatch vectorStoreId batchId Nothing Nothing Nothing Nothing Nothing + + _ <- retrieveVectorStore vectorStoreId + + _ <- retrieveVectorStoreFile vectorStoreId vectorStoreFileId + + _ <- retrieveVectorStoreFileBatch vectorStoreId batchId + + _ <- modifyVectorStore vectorStoreId ModifyVectorStore + { name = Nothing + , expires_after = Nothing + , metadata = Nothing + } + + _ <- cancelVectorStoreFileBatch vectorStoreId batchId + + _ <- deleteVectorStoreFile vectorStoreId vectorStoreFileId + + _ <- deleteVectorStore vectorStoreId + + _ <- deleteFile fileId + + return () + + let tests = + speechTests + <> [ transcriptionTest + , translationTest + , completionsMinimalTest + , completionsMaximalTest + , embeddingsTest + , fineTuningTest + , batchesTest + , uploadsTest + , createImageMinimalTest + , createImageMaximalTest + , createImageEditMinimalTest + , createImageEditMaximalTest + , createImageVariationMinimalTest + , createImageVariationMaximalTest + , createModerationTest + , assistantsTest + , messagesTest + , threadsRunsStepsTest + , vectorStoreFilesTest + ] + + Tasty.defaultMain (Tasty.testGroup "Tests" tests)