{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TemplateHaskell #-}

module OpenAI.Resources
  ( -- * Core Types
    TimeStamp (..),
    OpenAIList (..),
    Usage (..),

    -- * Models
    Model (..),
    ModelId (..),

    -- * Completion
    CompletionCreate (..),
    CompletionChoice (..),
    CompletionResponse (..),
    defaultCompletionCreate,

    -- * Chat
    ChatFunction (..),
    ChatFunctionCall (..),
    ChatMessage (..),
    ChatCompletionRequest (..),
    ChatChoice (..),
    ChatResponse (..),
    defaultChatCompletionRequest,

    -- * Edits
    EditCreate (..),
    EditChoice (..),
    EditResponse (..),
    defaultEditCreate,

    -- * Images
    ImageResponse (..),
    ImageResponseData (..),
    ImageCreate (..),
    ImageEditRequest (..),
    ImageVariationRequest (..),

    -- * Embeddings
    EmbeddingCreate (..),
    EmbeddingResponseData (..),
    EmbeddingUsage (..),
    EmbeddingResponse (..),

    -- * Audio
    AudioResponseData (..),
    AudioTranscriptionRequest (..),
    AudioTranslationRequest (..),

    -- * Fine tuning (out of date)
    FineTuneId (..),
    FineTuneCreate (..),
    defaultFineTuneCreate,
    FineTune (..),
    FineTuneEvent (..),

    -- * File API (out of date)
    FileCreate (..),
    FileId (..),
    File (..),
    FileHunk (..),
    FineTuneHunk (..),
    FileDeleteConfirmation (..),

    -- * Engine (deprecated)
    EngineId (..),
    Engine (..),

    -- * Engine text completion (deprecated)
    TextCompletionId (..),
    TextCompletionChoice (..),
    TextCompletion (..),
    TextCompletionCreate (..),
    defaultEngineTextCompletionCreate,

    -- * Engine Embeddings (deprecated)
    EngineEmbeddingCreate (..),
    EngineEmbedding (..),
  )
where

import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as BSL
import Data.Maybe (catMaybes)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time
import Data.Time.Clock.POSIX
import qualified Data.Vector as V
import Network.Mime (defaultMimeLookup)
import OpenAI.Internal.Aeson
import Servant.API
import Servant.Multipart.API

-- | A 'UTCTime' wrapper that has unix timestamp JSON representation
newtype TimeStamp = TimeStamp {TimeStamp -> UTCTime
unTimeStamp :: UTCTime}
  deriving (Int -> TimeStamp -> ShowS
[TimeStamp] -> ShowS
TimeStamp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeStamp] -> ShowS
$cshowList :: [TimeStamp] -> ShowS
show :: TimeStamp -> String
$cshow :: TimeStamp -> String
showsPrec :: Int -> TimeStamp -> ShowS
$cshowsPrec :: Int -> TimeStamp -> ShowS
Show, TimeStamp -> TimeStamp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeStamp -> TimeStamp -> Bool
$c/= :: TimeStamp -> TimeStamp -> Bool
== :: TimeStamp -> TimeStamp -> Bool
$c== :: TimeStamp -> TimeStamp -> Bool
Eq)

instance A.ToJSON TimeStamp where
  toJSON :: TimeStamp -> Value
toJSON = Scientific -> Value
A.Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeStamp -> UTCTime
unTimeStamp

instance A.FromJSON TimeStamp where
  parseJSON :: Value -> Parser TimeStamp
parseJSON =
    forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
A.withScientific String
"unix timestamp" forall a b. (a -> b) -> a -> b
$ \Scientific
sci ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UTCTime -> TimeStamp
TimeStamp forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Scientific
sci)

instance ToHttpApiData TimeStamp where
  toUrlPiece :: TimeStamp -> Text
toUrlPiece TimeStamp
x =
    let unix :: Int
        unix :: Int
unix = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeStamp -> UTCTime
unTimeStamp forall a b. (a -> b) -> a -> b
$ TimeStamp
x
     in String -> Text
T.pack (forall a. Show a => a -> String
show Int
unix)

-- | A 'V.Vector' wrapper.
newtype OpenAIList a = OpenAIList
  { forall a. OpenAIList a -> Vector a
olData :: V.Vector a
  }
  deriving (Int -> OpenAIList a -> ShowS
forall a. Show a => Int -> OpenAIList a -> ShowS
forall a. Show a => [OpenAIList a] -> ShowS
forall a. Show a => OpenAIList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenAIList a] -> ShowS
$cshowList :: forall a. Show a => [OpenAIList a] -> ShowS
show :: OpenAIList a -> String
$cshow :: forall a. Show a => OpenAIList a -> String
showsPrec :: Int -> OpenAIList a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OpenAIList a -> ShowS
Show, OpenAIList a -> OpenAIList a -> Bool
forall a. Eq a => OpenAIList a -> OpenAIList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenAIList a -> OpenAIList a -> Bool
$c/= :: forall a. Eq a => OpenAIList a -> OpenAIList a -> Bool
== :: OpenAIList a -> OpenAIList a -> Bool
$c== :: forall a. Eq a => OpenAIList a -> OpenAIList a -> Bool
Eq, forall a b. a -> OpenAIList b -> OpenAIList a
forall a b. (a -> b) -> OpenAIList a -> OpenAIList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> OpenAIList b -> OpenAIList a
$c<$ :: forall a b. a -> OpenAIList b -> OpenAIList a
fmap :: forall a b. (a -> b) -> OpenAIList a -> OpenAIList b
$cfmap :: forall a b. (a -> b) -> OpenAIList a -> OpenAIList b
Functor)

instance Semigroup (OpenAIList a) where
  <> :: OpenAIList a -> OpenAIList a -> OpenAIList a
(<>) OpenAIList a
a OpenAIList a
b = forall a. Vector a -> OpenAIList a
OpenAIList (forall a. OpenAIList a -> Vector a
olData OpenAIList a
a forall a. Semigroup a => a -> a -> a
<> forall a. OpenAIList a -> Vector a
olData OpenAIList a
b)

instance Monoid (OpenAIList a) where
  mempty :: OpenAIList a
mempty = forall a. Vector a -> OpenAIList a
OpenAIList forall a. Monoid a => a
mempty

instance Applicative OpenAIList where
  pure :: forall a. a -> OpenAIList a
pure = forall a. Vector a -> OpenAIList a
OpenAIList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  <*> :: forall a b. OpenAIList (a -> b) -> OpenAIList a -> OpenAIList b
(<*>) OpenAIList (a -> b)
go OpenAIList a
x = forall a. Vector a -> OpenAIList a
OpenAIList (forall a. OpenAIList a -> Vector a
olData OpenAIList (a -> b)
go forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. OpenAIList a -> Vector a
olData OpenAIList a
x)

$(deriveJSON (jsonOpts 2) ''OpenAIList)

data Usage = Usage
  { Usage -> Int
usPromptTokens :: Int,
    Usage -> Int
usCompletionTokens :: Int,
    Usage -> Int
usTotalTokens :: Int
  }
  deriving (Int -> Usage -> ShowS
[Usage] -> ShowS
Usage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Usage] -> ShowS
$cshowList :: [Usage] -> ShowS
show :: Usage -> String
$cshow :: Usage -> String
showsPrec :: Int -> Usage -> ShowS
$cshowsPrec :: Int -> Usage -> ShowS
Show, Usage -> Usage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Usage -> Usage -> Bool
$c/= :: Usage -> Usage -> Bool
== :: Usage -> Usage -> Bool
$c== :: Usage -> Usage -> Bool
Eq)

$(deriveJSON (jsonOpts 2) ''Usage)

------------------------
------ Model API
------------------------

data Model = Model
  { Model -> ModelId
mId :: ModelId,
    Model -> Text
mObject :: T.Text,
    Model -> Text
mOwnedBy :: T.Text,
    Model -> [Object]
mPermission :: [A.Object] -- TODO 2023.03.22: Docs do not say what this is
  }
  deriving (Int -> Model -> ShowS
[Model] -> ShowS
Model -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Model] -> ShowS
$cshowList :: [Model] -> ShowS
show :: Model -> String
$cshow :: Model -> String
showsPrec :: Int -> Model -> ShowS
$cshowsPrec :: Int -> Model -> ShowS
Show, Model -> Model -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Model -> Model -> Bool
$c/= :: Model -> Model -> Bool
== :: Model -> Model -> Bool
$c== :: Model -> Model -> Bool
Eq)

newtype ModelId = ModelId {ModelId -> Text
unModelId :: T.Text}
  deriving (Int -> ModelId -> ShowS
[ModelId] -> ShowS
ModelId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelId] -> ShowS
$cshowList :: [ModelId] -> ShowS
show :: ModelId -> String
$cshow :: ModelId -> String
showsPrec :: Int -> ModelId -> ShowS
$cshowsPrec :: Int -> ModelId -> ShowS
Show, ModelId -> ModelId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelId -> ModelId -> Bool
$c/= :: ModelId -> ModelId -> Bool
== :: ModelId -> ModelId -> Bool
$c== :: ModelId -> ModelId -> Bool
Eq, [ModelId] -> Encoding
[ModelId] -> Value
ModelId -> Encoding
ModelId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ModelId] -> Encoding
$ctoEncodingList :: [ModelId] -> Encoding
toJSONList :: [ModelId] -> Value
$ctoJSONList :: [ModelId] -> Value
toEncoding :: ModelId -> Encoding
$ctoEncoding :: ModelId -> Encoding
toJSON :: ModelId -> Value
$ctoJSON :: ModelId -> Value
ToJSON, Value -> Parser [ModelId]
Value -> Parser ModelId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ModelId]
$cparseJSONList :: Value -> Parser [ModelId]
parseJSON :: Value -> Parser ModelId
$cparseJSON :: Value -> Parser ModelId
FromJSON, ModelId -> Builder
ModelId -> ByteString
ModelId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: ModelId -> Text
$ctoQueryParam :: ModelId -> Text
toHeader :: ModelId -> ByteString
$ctoHeader :: ModelId -> ByteString
toEncodedUrlPiece :: ModelId -> Builder
$ctoEncodedUrlPiece :: ModelId -> Builder
toUrlPiece :: ModelId -> Text
$ctoUrlPiece :: ModelId -> Text
ToHttpApiData)

$(deriveJSON (jsonOpts 1) ''Model)

------------------------
------ Completions API
------------------------

data CompletionCreate = CompletionCreate
  { CompletionCreate -> ModelId
ccrModel :: ModelId,
    CompletionCreate -> Maybe Text
ccrPrompt :: Maybe T.Text,
    CompletionCreate -> Maybe Text
ccrSuffix :: Maybe T.Text,
    CompletionCreate -> Maybe Int
ccrMaxTokens :: Maybe Int,
    CompletionCreate -> Maybe Double
ccrTemperature :: Maybe Double,
    CompletionCreate -> Maybe Double
ccrTopP :: Maybe Double,
    CompletionCreate -> Maybe Int
ccrN :: Maybe Int,
    CompletionCreate -> Maybe Bool
ccrStream :: Maybe Bool,
    CompletionCreate -> Maybe Int
ccrLogprobs :: Maybe Int,
    CompletionCreate -> Maybe Bool
ccrEcho :: Maybe Bool,
    CompletionCreate -> Maybe (Vector Text)
ccrStop :: Maybe (V.Vector T.Text),
    CompletionCreate -> Maybe Double
ccrPresencePenalty :: Maybe Double,
    CompletionCreate -> Maybe Double
ccrFrequencyPenalty :: Maybe Double,
    CompletionCreate -> Maybe Int
ccrBestOf :: Maybe Int,
    CompletionCreate -> Maybe (Vector Double)
ccrLogitBias :: Maybe (V.Vector Double),
    CompletionCreate -> Maybe String
ccrUser :: Maybe String
  }
  deriving (Int -> CompletionCreate -> ShowS
[CompletionCreate] -> ShowS
CompletionCreate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionCreate] -> ShowS
$cshowList :: [CompletionCreate] -> ShowS
show :: CompletionCreate -> String
$cshow :: CompletionCreate -> String
showsPrec :: Int -> CompletionCreate -> ShowS
$cshowsPrec :: Int -> CompletionCreate -> ShowS
Show, CompletionCreate -> CompletionCreate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionCreate -> CompletionCreate -> Bool
$c/= :: CompletionCreate -> CompletionCreate -> Bool
== :: CompletionCreate -> CompletionCreate -> Bool
$c== :: CompletionCreate -> CompletionCreate -> Bool
Eq)

defaultCompletionCreate :: ModelId -> T.Text -> CompletionCreate
defaultCompletionCreate :: ModelId -> Text -> CompletionCreate
defaultCompletionCreate ModelId
model Text
prompt =
  CompletionCreate
    { ccrModel :: ModelId
ccrModel = ModelId
model,
      ccrPrompt :: Maybe Text
ccrPrompt = forall a. a -> Maybe a
Just Text
prompt,
      ccrSuffix :: Maybe Text
ccrSuffix = forall a. Maybe a
Nothing,
      ccrMaxTokens :: Maybe Int
ccrMaxTokens = forall a. Maybe a
Nothing,
      ccrTemperature :: Maybe Double
ccrTemperature = forall a. Maybe a
Nothing,
      ccrTopP :: Maybe Double
ccrTopP = forall a. Maybe a
Nothing,
      ccrN :: Maybe Int
ccrN = forall a. Maybe a
Nothing,
      ccrStream :: Maybe Bool
ccrStream = forall a. Maybe a
Nothing,
      ccrLogprobs :: Maybe Int
ccrLogprobs = forall a. Maybe a
Nothing,
      ccrEcho :: Maybe Bool
ccrEcho = forall a. Maybe a
Nothing,
      ccrStop :: Maybe (Vector Text)
ccrStop = forall a. Maybe a
Nothing,
      ccrPresencePenalty :: Maybe Double
ccrPresencePenalty = forall a. Maybe a
Nothing,
      ccrFrequencyPenalty :: Maybe Double
ccrFrequencyPenalty = forall a. Maybe a
Nothing,
      ccrBestOf :: Maybe Int
ccrBestOf = forall a. Maybe a
Nothing,
      ccrLogitBias :: Maybe (Vector Double)
ccrLogitBias = forall a. Maybe a
Nothing,
      ccrUser :: Maybe String
ccrUser = forall a. Maybe a
Nothing
    }

data CompletionChoice = CompletionChoice
  { CompletionChoice -> Text
cchText :: T.Text,
    CompletionChoice -> Int
cchIndex :: Int,
    CompletionChoice -> Maybe (Vector Double)
cchLogprobs :: Maybe (V.Vector Double),
    CompletionChoice -> Maybe Text
cchFinishReason :: Maybe T.Text
  }
  deriving (Int -> CompletionChoice -> ShowS
[CompletionChoice] -> ShowS
CompletionChoice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionChoice] -> ShowS
$cshowList :: [CompletionChoice] -> ShowS
show :: CompletionChoice -> String
$cshow :: CompletionChoice -> String
showsPrec :: Int -> CompletionChoice -> ShowS
$cshowsPrec :: Int -> CompletionChoice -> ShowS
Show, CompletionChoice -> CompletionChoice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionChoice -> CompletionChoice -> Bool
$c/= :: CompletionChoice -> CompletionChoice -> Bool
== :: CompletionChoice -> CompletionChoice -> Bool
$c== :: CompletionChoice -> CompletionChoice -> Bool
Eq)

data CompletionResponse = CompletionResponse
  { CompletionResponse -> Text
crId :: T.Text,
    CompletionResponse -> Text
crObject :: T.Text,
    CompletionResponse -> Int
crCreated :: Int,
    CompletionResponse -> ModelId
crModel :: ModelId,
    CompletionResponse -> [CompletionChoice]
crChoices :: [CompletionChoice],
    CompletionResponse -> Object
crUsage :: A.Object
  }
  deriving (Int -> CompletionResponse -> ShowS
[CompletionResponse] -> ShowS
CompletionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionResponse] -> ShowS
$cshowList :: [CompletionResponse] -> ShowS
show :: CompletionResponse -> String
$cshow :: CompletionResponse -> String
showsPrec :: Int -> CompletionResponse -> ShowS
$cshowsPrec :: Int -> CompletionResponse -> ShowS
Show, CompletionResponse -> CompletionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionResponse -> CompletionResponse -> Bool
$c/= :: CompletionResponse -> CompletionResponse -> Bool
== :: CompletionResponse -> CompletionResponse -> Bool
$c== :: CompletionResponse -> CompletionResponse -> Bool
Eq)

$(deriveJSON (jsonOpts 3) ''CompletionCreate)
$(deriveJSON (jsonOpts 3) ''CompletionChoice)
$(deriveJSON (jsonOpts 2) ''CompletionResponse)

------------------------
------ Chat API
------------------------

data ChatFunctionCall = ChatFunctionCall
  { ChatFunctionCall -> Text
chfcName :: T.Text,
    ChatFunctionCall -> Value
chfcArguments :: A.Value
  }
  deriving (ChatFunctionCall -> ChatFunctionCall -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChatFunctionCall -> ChatFunctionCall -> Bool
$c/= :: ChatFunctionCall -> ChatFunctionCall -> Bool
== :: ChatFunctionCall -> ChatFunctionCall -> Bool
$c== :: ChatFunctionCall -> ChatFunctionCall -> Bool
Eq, Int -> ChatFunctionCall -> ShowS
[ChatFunctionCall] -> ShowS
ChatFunctionCall -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatFunctionCall] -> ShowS
$cshowList :: [ChatFunctionCall] -> ShowS
show :: ChatFunctionCall -> String
$cshow :: ChatFunctionCall -> String
showsPrec :: Int -> ChatFunctionCall -> ShowS
$cshowsPrec :: Int -> ChatFunctionCall -> ShowS
Show)

instance A.FromJSON ChatFunctionCall where
  parseJSON :: Value -> Parser ChatFunctionCall
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ChatFunctionCall" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Text
name <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"name"
    Value
arguments <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"arguments" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. String -> (Value -> Parser a) -> Value -> Parser a
A.withEmbeddedJSON String
"Arguments" forall (f :: * -> *) a. Applicative f => a -> f a
pure

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ChatFunctionCall {chfcName :: Text
chfcName = Text
name, chfcArguments :: Value
chfcArguments = Value
arguments}

instance A.ToJSON ChatFunctionCall where
  toJSON :: ChatFunctionCall -> Value
toJSON (ChatFunctionCall {chfcName :: ChatFunctionCall -> Text
chfcName = Text
name, chfcArguments :: ChatFunctionCall -> Value
chfcArguments = Value
arguments}) =
    [Pair] -> Value
A.object
      [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
name,
        Key
"arguments" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
BSL.toStrict (forall a. ToJSON a => a -> ByteString
A.encode Value
arguments))
      ]

data ChatMessage = ChatMessage
  { ChatMessage -> Maybe Text
chmContent :: Maybe T.Text,
    ChatMessage -> Text
chmRole :: T.Text,
    ChatMessage -> Maybe ChatFunctionCall
chmFunctionCall :: Maybe ChatFunctionCall,
    ChatMessage -> Maybe Text
chmName :: Maybe T.Text
  }
  deriving (Int -> ChatMessage -> ShowS
[ChatMessage] -> ShowS
ChatMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatMessage] -> ShowS
$cshowList :: [ChatMessage] -> ShowS
show :: ChatMessage -> String
$cshow :: ChatMessage -> String
showsPrec :: Int -> ChatMessage -> ShowS
$cshowsPrec :: Int -> ChatMessage -> ShowS
Show, ChatMessage -> ChatMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChatMessage -> ChatMessage -> Bool
$c/= :: ChatMessage -> ChatMessage -> Bool
== :: ChatMessage -> ChatMessage -> Bool
$c== :: ChatMessage -> ChatMessage -> Bool
Eq)

instance A.FromJSON ChatMessage where
  parseJSON :: Value -> Parser ChatMessage
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"ChatMessage" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Maybe Text
-> Text -> Maybe ChatFunctionCall -> Maybe Text -> ChatMessage
ChatMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"content"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"role"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"function_call"
                forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"name"

instance A.ToJSON ChatMessage where
  toJSON :: ChatMessage -> Value
toJSON (ChatMessage {chmContent :: ChatMessage -> Maybe Text
chmContent = Maybe Text
content, chmRole :: ChatMessage -> Text
chmRole = Text
role, chmFunctionCall :: ChatMessage -> Maybe ChatFunctionCall
chmFunctionCall = Maybe ChatFunctionCall
functionCall, chmName :: ChatMessage -> Maybe Text
chmName = Maybe Text
name}) =
    [Pair] -> Value
A.object forall a b. (a -> b) -> a -> b
$ 
      [ Key
"content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Maybe Text
content,
        Key
"role" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Text
role
      ] forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes
      [ (Key
"function_call" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChatFunctionCall
functionCall, 
        (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
name
      ]
      
data ChatFunction = ChatFunction
  { ChatFunction -> Text
chfName :: T.Text,
    ChatFunction -> Text
chfDescription :: T.Text,
    ChatFunction -> Value
chfParameters :: A.Value
  }
  deriving (Int -> ChatFunction -> ShowS
[ChatFunction] -> ShowS
ChatFunction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatFunction] -> ShowS
$cshowList :: [ChatFunction] -> ShowS
show :: ChatFunction -> String
$cshow :: ChatFunction -> String
showsPrec :: Int -> ChatFunction -> ShowS
$cshowsPrec :: Int -> ChatFunction -> ShowS
Show, ChatFunction -> ChatFunction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChatFunction -> ChatFunction -> Bool
$c/= :: ChatFunction -> ChatFunction -> Bool
== :: ChatFunction -> ChatFunction -> Bool
$c== :: ChatFunction -> ChatFunction -> Bool
Eq)

data ChatCompletionRequest = ChatCompletionRequest
  { ChatCompletionRequest -> ModelId
chcrModel :: ModelId,
    ChatCompletionRequest -> [ChatMessage]
chcrMessages :: [ChatMessage],
    ChatCompletionRequest -> Maybe [ChatFunction]
chcrFunctions :: Maybe [ChatFunction],
    ChatCompletionRequest -> Maybe Double
chcrTemperature :: Maybe Double,
    ChatCompletionRequest -> Maybe Double
chcrTopP :: Maybe Double,
    ChatCompletionRequest -> Maybe Int
chcrN :: Maybe Int,
    ChatCompletionRequest -> Maybe Bool
chcrStream :: Maybe Bool,
    ChatCompletionRequest -> Maybe (Vector Text)
chcrStop :: Maybe (V.Vector T.Text),
    ChatCompletionRequest -> Maybe Int
chcrMaxTokens :: Maybe Int,
    ChatCompletionRequest -> Maybe Double
chcrPresencePenalty :: Maybe Double,
    ChatCompletionRequest -> Maybe Double
chcrFrequencyPenalty :: Maybe Double,
    ChatCompletionRequest -> Maybe (Vector Double)
chcrLogitBias :: Maybe (V.Vector Double),
    ChatCompletionRequest -> Maybe String
chcrUser :: Maybe String
  }
  deriving (Int -> ChatCompletionRequest -> ShowS
[ChatCompletionRequest] -> ShowS
ChatCompletionRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatCompletionRequest] -> ShowS
$cshowList :: [ChatCompletionRequest] -> ShowS
show :: ChatCompletionRequest -> String
$cshow :: ChatCompletionRequest -> String
showsPrec :: Int -> ChatCompletionRequest -> ShowS
$cshowsPrec :: Int -> ChatCompletionRequest -> ShowS
Show, ChatCompletionRequest -> ChatCompletionRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChatCompletionRequest -> ChatCompletionRequest -> Bool
$c/= :: ChatCompletionRequest -> ChatCompletionRequest -> Bool
== :: ChatCompletionRequest -> ChatCompletionRequest -> Bool
$c== :: ChatCompletionRequest -> ChatCompletionRequest -> Bool
Eq)

defaultChatCompletionRequest :: ModelId -> [ChatMessage] -> ChatCompletionRequest
defaultChatCompletionRequest :: ModelId -> [ChatMessage] -> ChatCompletionRequest
defaultChatCompletionRequest ModelId
model [ChatMessage]
messages =
  ChatCompletionRequest
    { chcrModel :: ModelId
chcrModel = ModelId
model,
      chcrMessages :: [ChatMessage]
chcrMessages = [ChatMessage]
messages,
      chcrFunctions :: Maybe [ChatFunction]
chcrFunctions = forall a. Maybe a
Nothing,
      chcrTemperature :: Maybe Double
chcrTemperature = forall a. Maybe a
Nothing,
      chcrTopP :: Maybe Double
chcrTopP = forall a. Maybe a
Nothing,
      chcrN :: Maybe Int
chcrN = forall a. Maybe a
Nothing,
      chcrStream :: Maybe Bool
chcrStream = forall a. Maybe a
Nothing,
      chcrStop :: Maybe (Vector Text)
chcrStop = forall a. Maybe a
Nothing,
      chcrMaxTokens :: Maybe Int
chcrMaxTokens = forall a. Maybe a
Nothing,
      chcrPresencePenalty :: Maybe Double
chcrPresencePenalty = forall a. Maybe a
Nothing,
      chcrFrequencyPenalty :: Maybe Double
chcrFrequencyPenalty = forall a. Maybe a
Nothing,
      chcrLogitBias :: Maybe (Vector Double)
chcrLogitBias = forall a. Maybe a
Nothing,
      chcrUser :: Maybe String
chcrUser = forall a. Maybe a
Nothing
    }

data ChatChoice = ChatChoice
  { ChatChoice -> Int
chchIndex :: Int,
    ChatChoice -> ChatMessage
chchMessage :: ChatMessage,
    ChatChoice -> Maybe Text
chchFinishReason :: Maybe T.Text
  }
  deriving (Int -> ChatChoice -> ShowS
[ChatChoice] -> ShowS
ChatChoice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatChoice] -> ShowS
$cshowList :: [ChatChoice] -> ShowS
show :: ChatChoice -> String
$cshow :: ChatChoice -> String
showsPrec :: Int -> ChatChoice -> ShowS
$cshowsPrec :: Int -> ChatChoice -> ShowS
Show, ChatChoice -> ChatChoice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChatChoice -> ChatChoice -> Bool
$c/= :: ChatChoice -> ChatChoice -> Bool
== :: ChatChoice -> ChatChoice -> Bool
$c== :: ChatChoice -> ChatChoice -> Bool
Eq)

data ChatResponse = ChatResponse
  { ChatResponse -> Text
chrId :: T.Text,
    ChatResponse -> Text
chrObject :: T.Text,
    ChatResponse -> Int
chrCreated :: Int,
    ChatResponse -> [ChatChoice]
chrChoices :: [ChatChoice],
    ChatResponse -> Usage
chrUsage :: Usage
  }

$(deriveJSON (jsonOpts 3) ''ChatFunction)
$(deriveJSON (jsonOpts 4) ''ChatCompletionRequest)
$(deriveJSON (jsonOpts 4) ''ChatChoice)
$(deriveJSON (jsonOpts 3) ''ChatResponse)

------------------------
------ Edits API
------------------------

data EditCreate = EditCreate
  { EditCreate -> ModelId
edcrModel :: ModelId,
    EditCreate -> Maybe Text
edcrInput :: Maybe T.Text,
    EditCreate -> Text
edcrInstruction :: T.Text,
    EditCreate -> Maybe Int
edcrN :: Maybe Int,
    EditCreate -> Maybe Double
edcrTemperature :: Maybe Double,
    EditCreate -> Maybe Double
edcrTopP :: Maybe Double
  }
  deriving (Int -> EditCreate -> ShowS
[EditCreate] -> ShowS
EditCreate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditCreate] -> ShowS
$cshowList :: [EditCreate] -> ShowS
show :: EditCreate -> String
$cshow :: EditCreate -> String
showsPrec :: Int -> EditCreate -> ShowS
$cshowsPrec :: Int -> EditCreate -> ShowS
Show, EditCreate -> EditCreate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditCreate -> EditCreate -> Bool
$c/= :: EditCreate -> EditCreate -> Bool
== :: EditCreate -> EditCreate -> Bool
$c== :: EditCreate -> EditCreate -> Bool
Eq)

defaultEditCreate :: ModelId -> T.Text -> T.Text -> EditCreate
defaultEditCreate :: ModelId -> Text -> Text -> EditCreate
defaultEditCreate ModelId
model Text
input Text
instruction =
  EditCreate
    { edcrModel :: ModelId
edcrModel = ModelId
model,
      edcrInput :: Maybe Text
edcrInput = forall a. a -> Maybe a
Just Text
input,
      edcrInstruction :: Text
edcrInstruction = Text
instruction,
      edcrN :: Maybe Int
edcrN = forall a. Maybe a
Nothing,
      edcrTemperature :: Maybe Double
edcrTemperature = forall a. Maybe a
Nothing,
      edcrTopP :: Maybe Double
edcrTopP = forall a. Maybe a
Nothing
    }

data EditChoice = EditChoice
  { EditChoice -> Text
edchText :: T.Text,
    EditChoice -> Int
edchIndex :: Int
  }
  deriving (Int -> EditChoice -> ShowS
[EditChoice] -> ShowS
EditChoice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditChoice] -> ShowS
$cshowList :: [EditChoice] -> ShowS
show :: EditChoice -> String
$cshow :: EditChoice -> String
showsPrec :: Int -> EditChoice -> ShowS
$cshowsPrec :: Int -> EditChoice -> ShowS
Show, EditChoice -> EditChoice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditChoice -> EditChoice -> Bool
$c/= :: EditChoice -> EditChoice -> Bool
== :: EditChoice -> EditChoice -> Bool
$c== :: EditChoice -> EditChoice -> Bool
Eq)

data EditResponse = EditResponse
  { EditResponse -> Text
edrObject :: T.Text,
    EditResponse -> Int
edrCreated :: Int,
    EditResponse -> [EditChoice]
edrChoices :: [EditChoice],
    EditResponse -> Usage
edrUsage :: Usage
  }
  deriving (Int -> EditResponse -> ShowS
[EditResponse] -> ShowS
EditResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditResponse] -> ShowS
$cshowList :: [EditResponse] -> ShowS
show :: EditResponse -> String
$cshow :: EditResponse -> String
showsPrec :: Int -> EditResponse -> ShowS
$cshowsPrec :: Int -> EditResponse -> ShowS
Show, EditResponse -> EditResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditResponse -> EditResponse -> Bool
$c/= :: EditResponse -> EditResponse -> Bool
== :: EditResponse -> EditResponse -> Bool
$c== :: EditResponse -> EditResponse -> Bool
Eq)

$(deriveJSON (jsonOpts 4) ''EditCreate)
$(deriveJSON (jsonOpts 4) ''EditChoice)
$(deriveJSON (jsonOpts 3) ''EditResponse)

------------------------
------ Images API
------------------------

data ImageResponseData = ImageResponseData
  { ImageResponseData -> Text
irdUrl :: T.Text
  }
  deriving (Int -> ImageResponseData -> ShowS
[ImageResponseData] -> ShowS
ImageResponseData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageResponseData] -> ShowS
$cshowList :: [ImageResponseData] -> ShowS
show :: ImageResponseData -> String
$cshow :: ImageResponseData -> String
showsPrec :: Int -> ImageResponseData -> ShowS
$cshowsPrec :: Int -> ImageResponseData -> ShowS
Show, ImageResponseData -> ImageResponseData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageResponseData -> ImageResponseData -> Bool
$c/= :: ImageResponseData -> ImageResponseData -> Bool
== :: ImageResponseData -> ImageResponseData -> Bool
$c== :: ImageResponseData -> ImageResponseData -> Bool
Eq)

data ImageResponse = ImageResponse
  { ImageResponse -> TimeStamp
irCreated :: TimeStamp,
    ImageResponse -> [ImageResponseData]
irData :: [ImageResponseData]
  }
  deriving (Int -> ImageResponse -> ShowS
[ImageResponse] -> ShowS
ImageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageResponse] -> ShowS
$cshowList :: [ImageResponse] -> ShowS
show :: ImageResponse -> String
$cshow :: ImageResponse -> String
showsPrec :: Int -> ImageResponse -> ShowS
$cshowsPrec :: Int -> ImageResponse -> ShowS
Show, ImageResponse -> ImageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageResponse -> ImageResponse -> Bool
$c/= :: ImageResponse -> ImageResponse -> Bool
== :: ImageResponse -> ImageResponse -> Bool
$c== :: ImageResponse -> ImageResponse -> Bool
Eq)

$(deriveJSON (jsonOpts 3) ''ImageResponseData)
$(deriveJSON (jsonOpts 2) ''ImageResponse)

-- | Image create API
data ImageCreate = ImageCreate
  { ImageCreate -> Text
icPrompt :: T.Text,
    ImageCreate -> Maybe Int
icN :: Maybe Int,
    ImageCreate -> Maybe Text
icSize :: Maybe T.Text,
    ImageCreate -> Maybe Text
icResponseFormat :: Maybe T.Text,
    ImageCreate -> Maybe Text
icUser :: Maybe T.Text
  }
  deriving (Int -> ImageCreate -> ShowS
[ImageCreate] -> ShowS
ImageCreate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageCreate] -> ShowS
$cshowList :: [ImageCreate] -> ShowS
show :: ImageCreate -> String
$cshow :: ImageCreate -> String
showsPrec :: Int -> ImageCreate -> ShowS
$cshowsPrec :: Int -> ImageCreate -> ShowS
Show, ImageCreate -> ImageCreate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageCreate -> ImageCreate -> Bool
$c/= :: ImageCreate -> ImageCreate -> Bool
== :: ImageCreate -> ImageCreate -> Bool
$c== :: ImageCreate -> ImageCreate -> Bool
Eq)

$(deriveJSON (jsonOpts 2) ''ImageCreate)

-- | Image edit API
data ImageEditRequest = ImageEditRequest
  { ImageEditRequest -> Text
ierImage :: T.Text,
    ImageEditRequest -> Maybe Text
ierMask :: Maybe T.Text,
    ImageEditRequest -> Text
ierPrompt :: T.Text,
    ImageEditRequest -> Maybe Int
ierN :: Maybe Int,
    ImageEditRequest -> Maybe Text
ierSize :: Maybe T.Text,
    ImageEditRequest -> Maybe Text
ierResponseFormat :: Maybe T.Text,
    ImageEditRequest -> Maybe Text
ierUser :: Maybe T.Text
  }
  deriving (Int -> ImageEditRequest -> ShowS
[ImageEditRequest] -> ShowS
ImageEditRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageEditRequest] -> ShowS
$cshowList :: [ImageEditRequest] -> ShowS
show :: ImageEditRequest -> String
$cshow :: ImageEditRequest -> String
showsPrec :: Int -> ImageEditRequest -> ShowS
$cshowsPrec :: Int -> ImageEditRequest -> ShowS
Show, ImageEditRequest -> ImageEditRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageEditRequest -> ImageEditRequest -> Bool
$c/= :: ImageEditRequest -> ImageEditRequest -> Bool
== :: ImageEditRequest -> ImageEditRequest -> Bool
$c== :: ImageEditRequest -> ImageEditRequest -> Bool
Eq)

$(deriveJSON (jsonOpts 3) ''ImageEditRequest)

-- | Image variation API
data ImageVariationRequest = ImageVariationRequest
  { ImageVariationRequest -> Text
ivrImage :: T.Text,
    ImageVariationRequest -> Maybe Int
ivrN :: Maybe Int,
    ImageVariationRequest -> Maybe Text
ivrSize :: Maybe T.Text,
    ImageVariationRequest -> Maybe Text
ivrResponseFormat :: Maybe T.Text,
    ImageVariationRequest -> Maybe Text
ivrUser :: Maybe T.Text
  }
  deriving (Int -> ImageVariationRequest -> ShowS
[ImageVariationRequest] -> ShowS
ImageVariationRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageVariationRequest] -> ShowS
$cshowList :: [ImageVariationRequest] -> ShowS
show :: ImageVariationRequest -> String
$cshow :: ImageVariationRequest -> String
showsPrec :: Int -> ImageVariationRequest -> ShowS
$cshowsPrec :: Int -> ImageVariationRequest -> ShowS
Show, ImageVariationRequest -> ImageVariationRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageVariationRequest -> ImageVariationRequest -> Bool
$c/= :: ImageVariationRequest -> ImageVariationRequest -> Bool
== :: ImageVariationRequest -> ImageVariationRequest -> Bool
$c== :: ImageVariationRequest -> ImageVariationRequest -> Bool
Eq)

$(deriveJSON (jsonOpts 3) ''ImageVariationRequest)

------------------------
------ Embeddings API
------------------------

data EmbeddingCreate = EmbeddingCreate
  { EmbeddingCreate -> ModelId
embcModel :: ModelId,
    EmbeddingCreate -> Text
embcInput :: T.Text, -- TODO (2023.02.23): Extend to allow taking in array of strings or token arrays
    EmbeddingCreate -> Maybe Text
embcUser :: Maybe T.Text
  }
  deriving (Int -> EmbeddingCreate -> ShowS
[EmbeddingCreate] -> ShowS
EmbeddingCreate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmbeddingCreate] -> ShowS
$cshowList :: [EmbeddingCreate] -> ShowS
show :: EmbeddingCreate -> String
$cshow :: EmbeddingCreate -> String
showsPrec :: Int -> EmbeddingCreate -> ShowS
$cshowsPrec :: Int -> EmbeddingCreate -> ShowS
Show, EmbeddingCreate -> EmbeddingCreate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbeddingCreate -> EmbeddingCreate -> Bool
$c/= :: EmbeddingCreate -> EmbeddingCreate -> Bool
== :: EmbeddingCreate -> EmbeddingCreate -> Bool
$c== :: EmbeddingCreate -> EmbeddingCreate -> Bool
Eq)

data EmbeddingResponseData = EmbeddingResponseData
  { EmbeddingResponseData -> Text
embdObject :: T.Text,
    EmbeddingResponseData -> Vector Double
embdEmbedding :: V.Vector Double,
    EmbeddingResponseData -> Int
embdIndex :: Int
  }
  deriving (Int -> EmbeddingResponseData -> ShowS
[EmbeddingResponseData] -> ShowS
EmbeddingResponseData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmbeddingResponseData] -> ShowS
$cshowList :: [EmbeddingResponseData] -> ShowS
show :: EmbeddingResponseData -> String
$cshow :: EmbeddingResponseData -> String
showsPrec :: Int -> EmbeddingResponseData -> ShowS
$cshowsPrec :: Int -> EmbeddingResponseData -> ShowS
Show, EmbeddingResponseData -> EmbeddingResponseData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbeddingResponseData -> EmbeddingResponseData -> Bool
$c/= :: EmbeddingResponseData -> EmbeddingResponseData -> Bool
== :: EmbeddingResponseData -> EmbeddingResponseData -> Bool
$c== :: EmbeddingResponseData -> EmbeddingResponseData -> Bool
Eq)

data EmbeddingUsage = EmbeddingUsage
  { EmbeddingUsage -> Int
embuPromptTokens :: Int,
    EmbeddingUsage -> Int
embuTotalTokens :: Int
  }
  deriving (Int -> EmbeddingUsage -> ShowS
[EmbeddingUsage] -> ShowS
EmbeddingUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmbeddingUsage] -> ShowS
$cshowList :: [EmbeddingUsage] -> ShowS
show :: EmbeddingUsage -> String
$cshow :: EmbeddingUsage -> String
showsPrec :: Int -> EmbeddingUsage -> ShowS
$cshowsPrec :: Int -> EmbeddingUsage -> ShowS
Show, EmbeddingUsage -> EmbeddingUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbeddingUsage -> EmbeddingUsage -> Bool
$c/= :: EmbeddingUsage -> EmbeddingUsage -> Bool
== :: EmbeddingUsage -> EmbeddingUsage -> Bool
$c== :: EmbeddingUsage -> EmbeddingUsage -> Bool
Eq)

data EmbeddingResponse = EmbeddingResponse
  { EmbeddingResponse -> Text
embrObject :: T.Text,
    EmbeddingResponse -> [EmbeddingResponseData]
embrData :: [EmbeddingResponseData],
    EmbeddingResponse -> ModelId
embrModel :: ModelId,
    EmbeddingResponse -> EmbeddingUsage
embrUsage :: EmbeddingUsage
  }
  deriving (Int -> EmbeddingResponse -> ShowS
[EmbeddingResponse] -> ShowS
EmbeddingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmbeddingResponse] -> ShowS
$cshowList :: [EmbeddingResponse] -> ShowS
show :: EmbeddingResponse -> String
$cshow :: EmbeddingResponse -> String
showsPrec :: Int -> EmbeddingResponse -> ShowS
$cshowsPrec :: Int -> EmbeddingResponse -> ShowS
Show, EmbeddingResponse -> EmbeddingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbeddingResponse -> EmbeddingResponse -> Bool
$c/= :: EmbeddingResponse -> EmbeddingResponse -> Bool
== :: EmbeddingResponse -> EmbeddingResponse -> Bool
$c== :: EmbeddingResponse -> EmbeddingResponse -> Bool
Eq)

$(deriveJSON (jsonOpts 4) ''EmbeddingCreate)
$(deriveJSON (jsonOpts 4) ''EmbeddingResponseData)
$(deriveJSON (jsonOpts 4) ''EmbeddingUsage)
$(deriveJSON (jsonOpts 4) ''EmbeddingResponse)

------------------------
------ Audio API
------------------------

data AudioResponseData = AudioResponseData
  { AudioResponseData -> Text
audrdText :: T.Text
  }
  deriving (Int -> AudioResponseData -> ShowS
[AudioResponseData] -> ShowS
AudioResponseData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AudioResponseData] -> ShowS
$cshowList :: [AudioResponseData] -> ShowS
show :: AudioResponseData -> String
$cshow :: AudioResponseData -> String
showsPrec :: Int -> AudioResponseData -> ShowS
$cshowsPrec :: Int -> AudioResponseData -> ShowS
Show, AudioResponseData -> AudioResponseData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AudioResponseData -> AudioResponseData -> Bool
$c/= :: AudioResponseData -> AudioResponseData -> Bool
== :: AudioResponseData -> AudioResponseData -> Bool
$c== :: AudioResponseData -> AudioResponseData -> Bool
Eq)

$(deriveJSON (jsonOpts 5) ''AudioResponseData)

-- | Audio create API
data AudioTranscriptionRequest = AudioTranscriptionRequest
  { AudioTranscriptionRequest -> String
audtsrFile :: FilePath,
    AudioTranscriptionRequest -> ModelId
audtsrModel :: ModelId,
    AudioTranscriptionRequest -> Maybe Text
audtsrPrompt :: Maybe T.Text,
    AudioTranscriptionRequest -> Maybe Text
audtsrResponseFormat :: Maybe T.Text,
    AudioTranscriptionRequest -> Maybe Double
audtsrTemperature :: Maybe Double,
    AudioTranscriptionRequest -> Maybe Text
audtsrLanguage :: Maybe T.Text
  }
  deriving (Int -> AudioTranscriptionRequest -> ShowS
[AudioTranscriptionRequest] -> ShowS
AudioTranscriptionRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AudioTranscriptionRequest] -> ShowS
$cshowList :: [AudioTranscriptionRequest] -> ShowS
show :: AudioTranscriptionRequest -> String
$cshow :: AudioTranscriptionRequest -> String
showsPrec :: Int -> AudioTranscriptionRequest -> ShowS
$cshowsPrec :: Int -> AudioTranscriptionRequest -> ShowS
Show, AudioTranscriptionRequest -> AudioTranscriptionRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AudioTranscriptionRequest -> AudioTranscriptionRequest -> Bool
$c/= :: AudioTranscriptionRequest -> AudioTranscriptionRequest -> Bool
== :: AudioTranscriptionRequest -> AudioTranscriptionRequest -> Bool
$c== :: AudioTranscriptionRequest -> AudioTranscriptionRequest -> Bool
Eq)

instance ToMultipart Tmp AudioTranscriptionRequest where
  toMultipart :: AudioTranscriptionRequest -> MultipartData Tmp
toMultipart AudioTranscriptionRequest
atr =
    forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData
      ( forall a. [Maybe a] -> [a]
catMaybes
          [ Text -> Text -> Input
Input Text
"model" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelId -> Text
unModelId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a
Just (AudioTranscriptionRequest -> ModelId
audtsrModel AudioTranscriptionRequest
atr),
            Text -> Text -> Input
Input Text
"prompt" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioTranscriptionRequest -> Maybe Text
audtsrPrompt AudioTranscriptionRequest
atr,
            Text -> Text -> Input
Input Text
"response_format" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioTranscriptionRequest -> Maybe Text
audtsrResponseFormat AudioTranscriptionRequest
atr,
            Text -> Text -> Input
Input Text
"temperature" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioTranscriptionRequest -> Maybe Double
audtsrTemperature AudioTranscriptionRequest
atr,
            Text -> Text -> Input
Input Text
"language" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioTranscriptionRequest -> Maybe Text
audtsrLanguage AudioTranscriptionRequest
atr
          ]
      )
      [ forall tag.
Text -> Text -> Text -> MultipartResult tag -> FileData tag
FileData Text
"file" (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. AudioTranscriptionRequest -> String
audtsrFile forall a b. (a -> b) -> a -> b
$ AudioTranscriptionRequest
atr) (ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
defaultMimeLookup forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ AudioTranscriptionRequest -> String
audtsrFile AudioTranscriptionRequest
atr) (AudioTranscriptionRequest -> String
audtsrFile AudioTranscriptionRequest
atr)
      ]

$(deriveJSON (jsonOpts 6) ''AudioTranscriptionRequest)

-- | Audio translation API
data AudioTranslationRequest = AudioTranslationRequest
  { AudioTranslationRequest -> String
audtlrFile :: FilePath,
    AudioTranslationRequest -> ModelId
audtlrModel :: ModelId,
    AudioTranslationRequest -> Maybe Text
audtlrPrompt :: Maybe T.Text,
    AudioTranslationRequest -> Maybe Text
audtlrResponseFormat :: Maybe T.Text,
    AudioTranslationRequest -> Maybe Double
audtlrTemperature :: Maybe Double
  }
  deriving (Int -> AudioTranslationRequest -> ShowS
[AudioTranslationRequest] -> ShowS
AudioTranslationRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AudioTranslationRequest] -> ShowS
$cshowList :: [AudioTranslationRequest] -> ShowS
show :: AudioTranslationRequest -> String
$cshow :: AudioTranslationRequest -> String
showsPrec :: Int -> AudioTranslationRequest -> ShowS
$cshowsPrec :: Int -> AudioTranslationRequest -> ShowS
Show, AudioTranslationRequest -> AudioTranslationRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AudioTranslationRequest -> AudioTranslationRequest -> Bool
$c/= :: AudioTranslationRequest -> AudioTranslationRequest -> Bool
== :: AudioTranslationRequest -> AudioTranslationRequest -> Bool
$c== :: AudioTranslationRequest -> AudioTranslationRequest -> Bool
Eq)

instance ToMultipart Tmp AudioTranslationRequest where
  toMultipart :: AudioTranslationRequest -> MultipartData Tmp
toMultipart AudioTranslationRequest
atr =
    forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData
      ( forall a. [Maybe a] -> [a]
catMaybes
          [ Text -> Text -> Input
Input Text
"model" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelId -> Text
unModelId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a
Just (AudioTranslationRequest -> ModelId
audtlrModel AudioTranslationRequest
atr),
            Text -> Text -> Input
Input Text
"prompt" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioTranslationRequest -> Maybe Text
audtlrPrompt AudioTranslationRequest
atr,
            Text -> Text -> Input
Input Text
"response_format" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioTranslationRequest -> Maybe Text
audtlrResponseFormat AudioTranslationRequest
atr,
            Text -> Text -> Input
Input Text
"temperature" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AudioTranslationRequest -> Maybe Double
audtlrTemperature AudioTranslationRequest
atr
          ]
      )
      [ forall tag.
Text -> Text -> Text -> MultipartResult tag -> FileData tag
FileData Text
"file" (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. AudioTranslationRequest -> String
audtlrFile forall a b. (a -> b) -> a -> b
$ AudioTranslationRequest
atr) (ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
defaultMimeLookup forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ AudioTranslationRequest -> String
audtlrFile AudioTranslationRequest
atr) (AudioTranslationRequest -> String
audtlrFile AudioTranslationRequest
atr)
      ]

$(deriveJSON (jsonOpts 6) ''AudioTranslationRequest)

------------------------
------ Files API
------------------------

data FineTuneHunk = FineTuneHunk
  { FineTuneHunk -> Text
fthPrompt :: T.Text,
    FineTuneHunk -> Text
fthCompletion :: T.Text
  }
  deriving (Int -> FineTuneHunk -> ShowS
[FineTuneHunk] -> ShowS
FineTuneHunk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FineTuneHunk] -> ShowS
$cshowList :: [FineTuneHunk] -> ShowS
show :: FineTuneHunk -> String
$cshow :: FineTuneHunk -> String
showsPrec :: Int -> FineTuneHunk -> ShowS
$cshowsPrec :: Int -> FineTuneHunk -> ShowS
Show, FineTuneHunk -> FineTuneHunk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FineTuneHunk -> FineTuneHunk -> Bool
$c/= :: FineTuneHunk -> FineTuneHunk -> Bool
== :: FineTuneHunk -> FineTuneHunk -> Bool
$c== :: FineTuneHunk -> FineTuneHunk -> Bool
Eq)

data FileHunk
  = FhFineTune FineTuneHunk
  deriving (Int -> FileHunk -> ShowS
[FileHunk] -> ShowS
FileHunk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileHunk] -> ShowS
$cshowList :: [FileHunk] -> ShowS
show :: FileHunk -> String
$cshow :: FileHunk -> String
showsPrec :: Int -> FileHunk -> ShowS
$cshowsPrec :: Int -> FileHunk -> ShowS
Show, FileHunk -> FileHunk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileHunk -> FileHunk -> Bool
$c/= :: FileHunk -> FileHunk -> Bool
== :: FileHunk -> FileHunk -> Bool
$c== :: FileHunk -> FileHunk -> Bool
Eq)

$(deriveJSON (jsonOpts 3) ''FineTuneHunk)

newtype FileId = FileId {FileId -> Text
unFileId :: T.Text}
  deriving (Int -> FileId -> ShowS
[FileId] -> ShowS
FileId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileId] -> ShowS
$cshowList :: [FileId] -> ShowS
show :: FileId -> String
$cshow :: FileId -> String
showsPrec :: Int -> FileId -> ShowS
$cshowsPrec :: Int -> FileId -> ShowS
Show, FileId -> FileId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileId -> FileId -> Bool
$c/= :: FileId -> FileId -> Bool
== :: FileId -> FileId -> Bool
$c== :: FileId -> FileId -> Bool
Eq, [FileId] -> Encoding
[FileId] -> Value
FileId -> Encoding
FileId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FileId] -> Encoding
$ctoEncodingList :: [FileId] -> Encoding
toJSONList :: [FileId] -> Value
$ctoJSONList :: [FileId] -> Value
toEncoding :: FileId -> Encoding
$ctoEncoding :: FileId -> Encoding
toJSON :: FileId -> Value
$ctoJSON :: FileId -> Value
ToJSON, Value -> Parser [FileId]
Value -> Parser FileId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileId]
$cparseJSONList :: Value -> Parser [FileId]
parseJSON :: Value -> Parser FileId
$cparseJSON :: Value -> Parser FileId
FromJSON, FileId -> Builder
FileId -> ByteString
FileId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: FileId -> Text
$ctoQueryParam :: FileId -> Text
toHeader :: FileId -> ByteString
$ctoHeader :: FileId -> ByteString
toEncodedUrlPiece :: FileId -> Builder
$ctoEncodedUrlPiece :: FileId -> Builder
toUrlPiece :: FileId -> Text
$ctoUrlPiece :: FileId -> Text
ToHttpApiData)

data File = File
  { File -> FileId
fId :: FileId,
    File -> Text
fObject :: T.Text,
    File -> Int
fBytes :: Int,
    File -> TimeStamp
fCreatedAt :: TimeStamp,
    File -> Text
fFilename :: T.Text,
    File -> Text
fPurpose :: T.Text
  }
  deriving (Int -> File -> ShowS
[File] -> ShowS
File -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> String
$cshow :: File -> String
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
Show, File -> File -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: File -> File -> Bool
Eq)

$(deriveJSON (jsonOpts 1) ''File)

-- | File upload API
data FileCreate = FileCreate
  { FileCreate -> Text
fcPurpose :: T.Text,
    FileCreate -> [FileHunk]
fcDocuments :: [FileHunk]
  }
  deriving (Int -> FileCreate -> ShowS
[FileCreate] -> ShowS
FileCreate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileCreate] -> ShowS
$cshowList :: [FileCreate] -> ShowS
show :: FileCreate -> String
$cshow :: FileCreate -> String
showsPrec :: Int -> FileCreate -> ShowS
$cshowsPrec :: Int -> FileCreate -> ShowS
Show, FileCreate -> FileCreate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileCreate -> FileCreate -> Bool
$c/= :: FileCreate -> FileCreate -> Bool
== :: FileCreate -> FileCreate -> Bool
$c== :: FileCreate -> FileCreate -> Bool
Eq)

packDocuments :: [FileHunk] -> BSL.ByteString
packDocuments :: [FileHunk] -> ByteString
packDocuments [FileHunk]
docs =
  ByteString -> [ByteString] -> ByteString
BSL.intercalate ByteString
"\n" forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map
      ( \FileHunk
t -> forall a. ToJSON a => a -> ByteString
A.encode forall a b. (a -> b) -> a -> b
$
          case FileHunk
t of
            FhFineTune FineTuneHunk
x -> forall a. ToJSON a => a -> Value
A.toJSON FineTuneHunk
x
      )
      [FileHunk]
docs

instance ToMultipart Mem FileCreate where
  toMultipart :: FileCreate -> MultipartData Mem
toMultipart FileCreate
rfc =
    forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData
      [ Text -> Text -> Input
Input Text
"purpose" (FileCreate -> Text
fcPurpose FileCreate
rfc)
      ]
      [ forall tag.
Text -> Text -> Text -> MultipartResult tag -> FileData tag
FileData Text
"file" Text
"data.jsonl" Text
"application/json" ([FileHunk] -> ByteString
packDocuments forall a b. (a -> b) -> a -> b
$ FileCreate -> [FileHunk]
fcDocuments FileCreate
rfc)
      ]

-- | File delete API
data FileDeleteConfirmation = FileDeleteConfirmation
  { FileDeleteConfirmation -> FileId
fdcId :: FileId
  }
  deriving (Int -> FileDeleteConfirmation -> ShowS
[FileDeleteConfirmation] -> ShowS
FileDeleteConfirmation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileDeleteConfirmation] -> ShowS
$cshowList :: [FileDeleteConfirmation] -> ShowS
show :: FileDeleteConfirmation -> String
$cshow :: FileDeleteConfirmation -> String
showsPrec :: Int -> FileDeleteConfirmation -> ShowS
$cshowsPrec :: Int -> FileDeleteConfirmation -> ShowS
Show, FileDeleteConfirmation -> FileDeleteConfirmation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileDeleteConfirmation -> FileDeleteConfirmation -> Bool
$c/= :: FileDeleteConfirmation -> FileDeleteConfirmation -> Bool
== :: FileDeleteConfirmation -> FileDeleteConfirmation -> Bool
$c== :: FileDeleteConfirmation -> FileDeleteConfirmation -> Bool
Eq)

$(deriveJSON (jsonOpts 3) ''FileDeleteConfirmation)

-- | File retrieve API
-- TODO

-- | File retrieve content API
-- TODO

------------------------
------ Engine API (deprecated)
------------------------

newtype EngineId = EngineId {EngineId -> Text
unEngineId :: T.Text}
  deriving (Int -> EngineId -> ShowS
[EngineId] -> ShowS
EngineId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EngineId] -> ShowS
$cshowList :: [EngineId] -> ShowS
show :: EngineId -> String
$cshow :: EngineId -> String
showsPrec :: Int -> EngineId -> ShowS
$cshowsPrec :: Int -> EngineId -> ShowS
Show, EngineId -> EngineId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EngineId -> EngineId -> Bool
$c/= :: EngineId -> EngineId -> Bool
== :: EngineId -> EngineId -> Bool
$c== :: EngineId -> EngineId -> Bool
Eq, [EngineId] -> Encoding
[EngineId] -> Value
EngineId -> Encoding
EngineId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EngineId] -> Encoding
$ctoEncodingList :: [EngineId] -> Encoding
toJSONList :: [EngineId] -> Value
$ctoJSONList :: [EngineId] -> Value
toEncoding :: EngineId -> Encoding
$ctoEncoding :: EngineId -> Encoding
toJSON :: EngineId -> Value
$ctoJSON :: EngineId -> Value
ToJSON, Value -> Parser [EngineId]
Value -> Parser EngineId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EngineId]
$cparseJSONList :: Value -> Parser [EngineId]
parseJSON :: Value -> Parser EngineId
$cparseJSON :: Value -> Parser EngineId
FromJSON, EngineId -> Builder
EngineId -> ByteString
EngineId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: EngineId -> Text
$ctoQueryParam :: EngineId -> Text
toHeader :: EngineId -> ByteString
$ctoHeader :: EngineId -> ByteString
toEncodedUrlPiece :: EngineId -> Builder
$ctoEncodedUrlPiece :: EngineId -> Builder
toUrlPiece :: EngineId -> Text
$ctoUrlPiece :: EngineId -> Text
ToHttpApiData)

data Engine = Engine
  { Engine -> EngineId
eId :: EngineId,
    Engine -> Text
eOwner :: T.Text,
    Engine -> Bool
eReady :: Bool
  }
  deriving (Int -> Engine -> ShowS
[Engine] -> ShowS
Engine -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Engine] -> ShowS
$cshowList :: [Engine] -> ShowS
show :: Engine -> String
$cshow :: Engine -> String
showsPrec :: Int -> Engine -> ShowS
$cshowsPrec :: Int -> Engine -> ShowS
Show, Engine -> Engine -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Engine -> Engine -> Bool
$c/= :: Engine -> Engine -> Bool
== :: Engine -> Engine -> Bool
$c== :: Engine -> Engine -> Bool
Eq)

$(deriveJSON (jsonOpts 1) ''Engine)

------------------------
------ Engine completions API (deprecated)
------------------------

newtype TextCompletionId = TextCompletionId {TextCompletionId -> Text
unTextCompletionId :: T.Text}
  deriving (Int -> TextCompletionId -> ShowS
[TextCompletionId] -> ShowS
TextCompletionId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextCompletionId] -> ShowS
$cshowList :: [TextCompletionId] -> ShowS
show :: TextCompletionId -> String
$cshow :: TextCompletionId -> String
showsPrec :: Int -> TextCompletionId -> ShowS
$cshowsPrec :: Int -> TextCompletionId -> ShowS
Show, TextCompletionId -> TextCompletionId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextCompletionId -> TextCompletionId -> Bool
$c/= :: TextCompletionId -> TextCompletionId -> Bool
== :: TextCompletionId -> TextCompletionId -> Bool
$c== :: TextCompletionId -> TextCompletionId -> Bool
Eq, [TextCompletionId] -> Encoding
[TextCompletionId] -> Value
TextCompletionId -> Encoding
TextCompletionId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TextCompletionId] -> Encoding
$ctoEncodingList :: [TextCompletionId] -> Encoding
toJSONList :: [TextCompletionId] -> Value
$ctoJSONList :: [TextCompletionId] -> Value
toEncoding :: TextCompletionId -> Encoding
$ctoEncoding :: TextCompletionId -> Encoding
toJSON :: TextCompletionId -> Value
$ctoJSON :: TextCompletionId -> Value
ToJSON, Value -> Parser [TextCompletionId]
Value -> Parser TextCompletionId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TextCompletionId]
$cparseJSONList :: Value -> Parser [TextCompletionId]
parseJSON :: Value -> Parser TextCompletionId
$cparseJSON :: Value -> Parser TextCompletionId
FromJSON, TextCompletionId -> Builder
TextCompletionId -> ByteString
TextCompletionId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: TextCompletionId -> Text
$ctoQueryParam :: TextCompletionId -> Text
toHeader :: TextCompletionId -> ByteString
$ctoHeader :: TextCompletionId -> ByteString
toEncodedUrlPiece :: TextCompletionId -> Builder
$ctoEncodedUrlPiece :: TextCompletionId -> Builder
toUrlPiece :: TextCompletionId -> Text
$ctoUrlPiece :: TextCompletionId -> Text
ToHttpApiData)

data TextCompletionChoice = TextCompletionChoice
  { TextCompletionChoice -> Text
tccText :: T.Text,
    TextCompletionChoice -> Int
tccIndex :: Int,
    TextCompletionChoice -> Maybe Int
tccLogProps :: Maybe Int,
    TextCompletionChoice -> Text
tccFinishReason :: T.Text
  }
  deriving (Int -> TextCompletionChoice -> ShowS
[TextCompletionChoice] -> ShowS
TextCompletionChoice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextCompletionChoice] -> ShowS
$cshowList :: [TextCompletionChoice] -> ShowS
show :: TextCompletionChoice -> String
$cshow :: TextCompletionChoice -> String
showsPrec :: Int -> TextCompletionChoice -> ShowS
$cshowsPrec :: Int -> TextCompletionChoice -> ShowS
Show, TextCompletionChoice -> TextCompletionChoice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextCompletionChoice -> TextCompletionChoice -> Bool
$c/= :: TextCompletionChoice -> TextCompletionChoice -> Bool
== :: TextCompletionChoice -> TextCompletionChoice -> Bool
$c== :: TextCompletionChoice -> TextCompletionChoice -> Bool
Eq)

data TextCompletion = TextCompletion
  { TextCompletion -> TextCompletionId
tcId :: TextCompletionId,
    TextCompletion -> TimeStamp
tcCreated :: TimeStamp,
    TextCompletion -> Text
tcModel :: T.Text,
    TextCompletion -> Vector TextCompletionChoice
tcChoices :: V.Vector TextCompletionChoice
  }
  deriving (Int -> TextCompletion -> ShowS
[TextCompletion] -> ShowS
TextCompletion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextCompletion] -> ShowS
$cshowList :: [TextCompletion] -> ShowS
show :: TextCompletion -> String
$cshow :: TextCompletion -> String
showsPrec :: Int -> TextCompletion -> ShowS
$cshowsPrec :: Int -> TextCompletion -> ShowS
Show, TextCompletion -> TextCompletion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextCompletion -> TextCompletion -> Bool
$c/= :: TextCompletion -> TextCompletion -> Bool
== :: TextCompletion -> TextCompletion -> Bool
$c== :: TextCompletion -> TextCompletion -> Bool
Eq)

data TextCompletionCreate = TextCompletionCreate
  { TextCompletionCreate -> Text
tccrPrompt :: T.Text, -- TODO: support lists of strings
    TextCompletionCreate -> Maybe Int
tccrMaxTokens :: Maybe Int,
    TextCompletionCreate -> Maybe Double
tccrTemperature :: Maybe Double,
    TextCompletionCreate -> Maybe Double
tccrTopP :: Maybe Double,
    TextCompletionCreate -> Maybe Int
tccrN :: Maybe Int,
    TextCompletionCreate -> Maybe Int
tccrLogprobs :: Maybe Int,
    TextCompletionCreate -> Maybe Bool
tccrEcho :: Maybe Bool,
    TextCompletionCreate -> Maybe (Vector Text)
tccrStop :: Maybe (V.Vector T.Text),
    TextCompletionCreate -> Maybe Double
tccrPresencePenalty :: Maybe Double,
    TextCompletionCreate -> Maybe Double
tccrFrequencyPenalty :: Maybe Double,
    TextCompletionCreate -> Maybe Int
tccrBestOf :: Maybe Int
  }
  deriving (Int -> TextCompletionCreate -> ShowS
[TextCompletionCreate] -> ShowS
TextCompletionCreate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextCompletionCreate] -> ShowS
$cshowList :: [TextCompletionCreate] -> ShowS
show :: TextCompletionCreate -> String
$cshow :: TextCompletionCreate -> String
showsPrec :: Int -> TextCompletionCreate -> ShowS
$cshowsPrec :: Int -> TextCompletionCreate -> ShowS
Show, TextCompletionCreate -> TextCompletionCreate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextCompletionCreate -> TextCompletionCreate -> Bool
$c/= :: TextCompletionCreate -> TextCompletionCreate -> Bool
== :: TextCompletionCreate -> TextCompletionCreate -> Bool
$c== :: TextCompletionCreate -> TextCompletionCreate -> Bool
Eq)

-- | Applies API defaults, only passing a prompt.
defaultEngineTextCompletionCreate :: T.Text -> TextCompletionCreate
defaultEngineTextCompletionCreate :: Text -> TextCompletionCreate
defaultEngineTextCompletionCreate Text
prompt =
  TextCompletionCreate
    { tccrPrompt :: Text
tccrPrompt = Text
prompt,
      tccrMaxTokens :: Maybe Int
tccrMaxTokens = forall a. Maybe a
Nothing,
      tccrTemperature :: Maybe Double
tccrTemperature = forall a. Maybe a
Nothing,
      tccrTopP :: Maybe Double
tccrTopP = forall a. Maybe a
Nothing,
      tccrN :: Maybe Int
tccrN = forall a. Maybe a
Nothing,
      tccrLogprobs :: Maybe Int
tccrLogprobs = forall a. Maybe a
Nothing,
      tccrEcho :: Maybe Bool
tccrEcho = forall a. Maybe a
Nothing,
      tccrStop :: Maybe (Vector Text)
tccrStop = forall a. Maybe a
Nothing,
      tccrPresencePenalty :: Maybe Double
tccrPresencePenalty = forall a. Maybe a
Nothing,
      tccrFrequencyPenalty :: Maybe Double
tccrFrequencyPenalty = forall a. Maybe a
Nothing,
      tccrBestOf :: Maybe Int
tccrBestOf = forall a. Maybe a
Nothing
    }

$(deriveJSON (jsonOpts 3) ''TextCompletionChoice)
$(deriveJSON (jsonOpts 2) ''TextCompletion)
$(deriveJSON (jsonOpts 4) ''TextCompletionCreate)

------------------------
------ EngineEmbeddings API (deprecated)
------------------------

data EngineEmbeddingCreate = EngineEmbeddingCreate
  {EngineEmbeddingCreate -> Text
enecInput :: T.Text}
  deriving (Int -> EngineEmbeddingCreate -> ShowS
[EngineEmbeddingCreate] -> ShowS
EngineEmbeddingCreate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EngineEmbeddingCreate] -> ShowS
$cshowList :: [EngineEmbeddingCreate] -> ShowS
show :: EngineEmbeddingCreate -> String
$cshow :: EngineEmbeddingCreate -> String
showsPrec :: Int -> EngineEmbeddingCreate -> ShowS
$cshowsPrec :: Int -> EngineEmbeddingCreate -> ShowS
Show, EngineEmbeddingCreate -> EngineEmbeddingCreate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EngineEmbeddingCreate -> EngineEmbeddingCreate -> Bool
$c/= :: EngineEmbeddingCreate -> EngineEmbeddingCreate -> Bool
== :: EngineEmbeddingCreate -> EngineEmbeddingCreate -> Bool
$c== :: EngineEmbeddingCreate -> EngineEmbeddingCreate -> Bool
Eq)

data EngineEmbedding = EngineEmbedding
  {EngineEmbedding -> Vector Double
eneEmbedding :: V.Vector Double, EngineEmbedding -> Int
eneIndex :: Int}
  deriving (Int -> EngineEmbedding -> ShowS
[EngineEmbedding] -> ShowS
EngineEmbedding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EngineEmbedding] -> ShowS
$cshowList :: [EngineEmbedding] -> ShowS
show :: EngineEmbedding -> String
$cshow :: EngineEmbedding -> String
showsPrec :: Int -> EngineEmbedding -> ShowS
$cshowsPrec :: Int -> EngineEmbedding -> ShowS
Show, EngineEmbedding -> EngineEmbedding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EngineEmbedding -> EngineEmbedding -> Bool
$c/= :: EngineEmbedding -> EngineEmbedding -> Bool
== :: EngineEmbedding -> EngineEmbedding -> Bool
$c== :: EngineEmbedding -> EngineEmbedding -> Bool
Eq)

$(deriveJSON (jsonOpts 4) ''EngineEmbeddingCreate)
$(deriveJSON (jsonOpts 3) ''EngineEmbedding)

------------------------
------ Old stuff; not touching
------ TODO 2023.03.22: Not touching this; unchanged since last year
------------------------

newtype FineTuneId = FineTuneId {FineTuneId -> Text
unFineTuneId :: T.Text}
  deriving (Int -> FineTuneId -> ShowS
[FineTuneId] -> ShowS
FineTuneId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FineTuneId] -> ShowS
$cshowList :: [FineTuneId] -> ShowS
show :: FineTuneId -> String
$cshow :: FineTuneId -> String
showsPrec :: Int -> FineTuneId -> ShowS
$cshowsPrec :: Int -> FineTuneId -> ShowS
Show, FineTuneId -> FineTuneId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FineTuneId -> FineTuneId -> Bool
$c/= :: FineTuneId -> FineTuneId -> Bool
== :: FineTuneId -> FineTuneId -> Bool
$c== :: FineTuneId -> FineTuneId -> Bool
Eq, [FineTuneId] -> Encoding
[FineTuneId] -> Value
FineTuneId -> Encoding
FineTuneId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FineTuneId] -> Encoding
$ctoEncodingList :: [FineTuneId] -> Encoding
toJSONList :: [FineTuneId] -> Value
$ctoJSONList :: [FineTuneId] -> Value
toEncoding :: FineTuneId -> Encoding
$ctoEncoding :: FineTuneId -> Encoding
toJSON :: FineTuneId -> Value
$ctoJSON :: FineTuneId -> Value
ToJSON, Value -> Parser [FineTuneId]
Value -> Parser FineTuneId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FineTuneId]
$cparseJSONList :: Value -> Parser [FineTuneId]
parseJSON :: Value -> Parser FineTuneId
$cparseJSON :: Value -> Parser FineTuneId
FromJSON, FineTuneId -> Builder
FineTuneId -> ByteString
FineTuneId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: FineTuneId -> Text
$ctoQueryParam :: FineTuneId -> Text
toHeader :: FineTuneId -> ByteString
$ctoHeader :: FineTuneId -> ByteString
toEncodedUrlPiece :: FineTuneId -> Builder
$ctoEncodedUrlPiece :: FineTuneId -> Builder
toUrlPiece :: FineTuneId -> Text
$ctoUrlPiece :: FineTuneId -> Text
ToHttpApiData)

data FineTuneCreate = FineTuneCreate
  { FineTuneCreate -> FileId
ftcTrainingFile :: FileId,
    FineTuneCreate -> Maybe FileId
ftcValidationFile :: Maybe FileId,
    FineTuneCreate -> Maybe Text
ftcModel :: Maybe T.Text,
    FineTuneCreate -> Maybe Int
ftcBatchSize :: Maybe Int,
    FineTuneCreate -> Maybe Text
ftcNEpochs :: Maybe T.Text,
    FineTuneCreate -> Maybe Double
ftcLearningRateMultiplier :: Maybe Double,
    FineTuneCreate -> Maybe Double
ftcPromptLossWeight :: Maybe Double,
    FineTuneCreate -> Maybe Bool
ftcComputeClassificationMetrics :: Maybe Bool,
    FineTuneCreate -> Maybe Int
ftcClassificationNClasses :: Maybe Int,
    FineTuneCreate -> Maybe Text
ftcClassificationPositiveClass :: Maybe T.Text
  }
  deriving (Int -> FineTuneCreate -> ShowS
[FineTuneCreate] -> ShowS
FineTuneCreate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FineTuneCreate] -> ShowS
$cshowList :: [FineTuneCreate] -> ShowS
show :: FineTuneCreate -> String
$cshow :: FineTuneCreate -> String
showsPrec :: Int -> FineTuneCreate -> ShowS
$cshowsPrec :: Int -> FineTuneCreate -> ShowS
Show, FineTuneCreate -> FineTuneCreate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FineTuneCreate -> FineTuneCreate -> Bool
$c/= :: FineTuneCreate -> FineTuneCreate -> Bool
== :: FineTuneCreate -> FineTuneCreate -> Bool
$c== :: FineTuneCreate -> FineTuneCreate -> Bool
Eq)

defaultFineTuneCreate :: FileId -> FineTuneCreate
defaultFineTuneCreate :: FileId -> FineTuneCreate
defaultFineTuneCreate FileId
file =
  FineTuneCreate
    { ftcTrainingFile :: FileId
ftcTrainingFile = FileId
file,
      ftcValidationFile :: Maybe FileId
ftcValidationFile = forall a. Maybe a
Nothing,
      ftcModel :: Maybe Text
ftcModel = forall a. Maybe a
Nothing,
      ftcBatchSize :: Maybe Int
ftcBatchSize = forall a. Maybe a
Nothing,
      ftcNEpochs :: Maybe Text
ftcNEpochs = forall a. Maybe a
Nothing,
      ftcLearningRateMultiplier :: Maybe Double
ftcLearningRateMultiplier = forall a. Maybe a
Nothing,
      ftcPromptLossWeight :: Maybe Double
ftcPromptLossWeight = forall a. Maybe a
Nothing,
      ftcComputeClassificationMetrics :: Maybe Bool
ftcComputeClassificationMetrics = forall a. Maybe a
Nothing,
      ftcClassificationNClasses :: Maybe Int
ftcClassificationNClasses = forall a. Maybe a
Nothing,
      ftcClassificationPositiveClass :: Maybe Text
ftcClassificationPositiveClass = forall a. Maybe a
Nothing
    }

data FineTuneEvent = FineTuneEvent
  { FineTuneEvent -> Int
fteCreatedAt :: Int,
    FineTuneEvent -> Text
fteLevel :: T.Text,
    FineTuneEvent -> Text
fteMessage :: T.Text
  }
  deriving (Int -> FineTuneEvent -> ShowS
[FineTuneEvent] -> ShowS
FineTuneEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FineTuneEvent] -> ShowS
$cshowList :: [FineTuneEvent] -> ShowS
show :: FineTuneEvent -> String
$cshow :: FineTuneEvent -> String
showsPrec :: Int -> FineTuneEvent -> ShowS
$cshowsPrec :: Int -> FineTuneEvent -> ShowS
Show, FineTuneEvent -> FineTuneEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FineTuneEvent -> FineTuneEvent -> Bool
$c/= :: FineTuneEvent -> FineTuneEvent -> Bool
== :: FineTuneEvent -> FineTuneEvent -> Bool
$c== :: FineTuneEvent -> FineTuneEvent -> Bool
Eq)

data FineTune = FineTune
  { FineTune -> FineTuneId
ftId :: FineTuneId,
    FineTune -> Text
ftModel :: T.Text,
    FineTune -> Int
ftCreatedAt :: Int,
    FineTune -> Vector FineTuneEvent
ftEvents :: V.Vector FineTuneEvent,
    FineTune -> Maybe Text
ftTunedModel :: Maybe T.Text,
    FineTune -> Text
ftStatus :: T.Text
  }
  deriving (Int -> FineTune -> ShowS
[FineTune] -> ShowS
FineTune -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FineTune] -> ShowS
$cshowList :: [FineTune] -> ShowS
show :: FineTune -> String
$cshow :: FineTune -> String
showsPrec :: Int -> FineTune -> ShowS
$cshowsPrec :: Int -> FineTune -> ShowS
Show, FineTune -> FineTune -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FineTune -> FineTune -> Bool
$c/= :: FineTune -> FineTune -> Bool
== :: FineTune -> FineTune -> Bool
$c== :: FineTune -> FineTune -> Bool
Eq)

$(deriveJSON (jsonOpts 3) ''FineTuneCreate)
$(deriveJSON (jsonOpts 3) ''FineTuneEvent)
$(deriveJSON (jsonOpts 2) ''FineTune)