-- | @\/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{ VectorStoreFileBatchID -> Text
text :: Text }
    deriving newtype (Maybe VectorStoreFileBatchID
Value -> Parser [VectorStoreFileBatchID]
Value -> Parser VectorStoreFileBatchID
(Value -> Parser VectorStoreFileBatchID)
-> (Value -> Parser [VectorStoreFileBatchID])
-> Maybe VectorStoreFileBatchID
-> FromJSON VectorStoreFileBatchID
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser VectorStoreFileBatchID
parseJSON :: Value -> Parser VectorStoreFileBatchID
$cparseJSONList :: Value -> Parser [VectorStoreFileBatchID]
parseJSONList :: Value -> Parser [VectorStoreFileBatchID]
$comittedField :: Maybe VectorStoreFileBatchID
omittedField :: Maybe VectorStoreFileBatchID
FromJSON, String -> VectorStoreFileBatchID
(String -> VectorStoreFileBatchID)
-> IsString VectorStoreFileBatchID
forall a. (String -> a) -> IsString a
$cfromString :: String -> VectorStoreFileBatchID
fromString :: String -> VectorStoreFileBatchID
IsString, Int -> VectorStoreFileBatchID -> ShowS
[VectorStoreFileBatchID] -> ShowS
VectorStoreFileBatchID -> String
(Int -> VectorStoreFileBatchID -> ShowS)
-> (VectorStoreFileBatchID -> String)
-> ([VectorStoreFileBatchID] -> ShowS)
-> Show VectorStoreFileBatchID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VectorStoreFileBatchID -> ShowS
showsPrec :: Int -> VectorStoreFileBatchID -> ShowS
$cshow :: VectorStoreFileBatchID -> String
show :: VectorStoreFileBatchID -> String
$cshowList :: [VectorStoreFileBatchID] -> ShowS
showList :: [VectorStoreFileBatchID] -> ShowS
Show, VectorStoreFileBatchID -> Text
VectorStoreFileBatchID -> ByteString
VectorStoreFileBatchID -> Builder
(VectorStoreFileBatchID -> Text)
-> (VectorStoreFileBatchID -> Builder)
-> (VectorStoreFileBatchID -> ByteString)
-> (VectorStoreFileBatchID -> Text)
-> (VectorStoreFileBatchID -> Builder)
-> ToHttpApiData VectorStoreFileBatchID
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: VectorStoreFileBatchID -> Text
toUrlPiece :: VectorStoreFileBatchID -> Text
$ctoEncodedUrlPiece :: VectorStoreFileBatchID -> Builder
toEncodedUrlPiece :: VectorStoreFileBatchID -> Builder
$ctoHeader :: VectorStoreFileBatchID -> ByteString
toHeader :: VectorStoreFileBatchID -> ByteString
$ctoQueryParam :: VectorStoreFileBatchID -> Text
toQueryParam :: VectorStoreFileBatchID -> Text
$ctoEncodedQueryParam :: VectorStoreFileBatchID -> Builder
toEncodedQueryParam :: VectorStoreFileBatchID -> Builder
ToHttpApiData, [VectorStoreFileBatchID] -> Value
[VectorStoreFileBatchID] -> Encoding
VectorStoreFileBatchID -> Bool
VectorStoreFileBatchID -> Value
VectorStoreFileBatchID -> Encoding
(VectorStoreFileBatchID -> Value)
-> (VectorStoreFileBatchID -> Encoding)
-> ([VectorStoreFileBatchID] -> Value)
-> ([VectorStoreFileBatchID] -> Encoding)
-> (VectorStoreFileBatchID -> Bool)
-> ToJSON VectorStoreFileBatchID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: VectorStoreFileBatchID -> Value
toJSON :: VectorStoreFileBatchID -> Value
$ctoEncoding :: VectorStoreFileBatchID -> Encoding
toEncoding :: VectorStoreFileBatchID -> Encoding
$ctoJSONList :: [VectorStoreFileBatchID] -> Value
toJSONList :: [VectorStoreFileBatchID] -> Value
$ctoEncodingList :: [VectorStoreFileBatchID] -> Encoding
toEncodingList :: [VectorStoreFileBatchID] -> Encoding
$comitField :: VectorStoreFileBatchID -> Bool
omitField :: VectorStoreFileBatchID -> Bool
ToJSON)

-- | Request body for @\/v1\/vector_stores\/:vector_store_id\/file_batches@
data CreateVectorStoreFileBatch = CreateVectorStoreFileBatch
    { CreateVectorStoreFileBatch -> Vector FileID
file_ids :: Vector FileID
    , CreateVectorStoreFileBatch -> Maybe ChunkingStrategy
chunking_strategy :: Maybe ChunkingStrategy
    } deriving stock ((forall x.
 CreateVectorStoreFileBatch -> Rep CreateVectorStoreFileBatch x)
-> (forall x.
    Rep CreateVectorStoreFileBatch x -> CreateVectorStoreFileBatch)
-> Generic CreateVectorStoreFileBatch
forall x.
Rep CreateVectorStoreFileBatch x -> CreateVectorStoreFileBatch
forall x.
CreateVectorStoreFileBatch -> Rep CreateVectorStoreFileBatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateVectorStoreFileBatch -> Rep CreateVectorStoreFileBatch x
from :: forall x.
CreateVectorStoreFileBatch -> Rep CreateVectorStoreFileBatch x
$cto :: forall x.
Rep CreateVectorStoreFileBatch x -> CreateVectorStoreFileBatch
to :: forall x.
Rep CreateVectorStoreFileBatch x -> CreateVectorStoreFileBatch
Generic, Int -> CreateVectorStoreFileBatch -> ShowS
[CreateVectorStoreFileBatch] -> ShowS
CreateVectorStoreFileBatch -> String
(Int -> CreateVectorStoreFileBatch -> ShowS)
-> (CreateVectorStoreFileBatch -> String)
-> ([CreateVectorStoreFileBatch] -> ShowS)
-> Show CreateVectorStoreFileBatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateVectorStoreFileBatch -> ShowS
showsPrec :: Int -> CreateVectorStoreFileBatch -> ShowS
$cshow :: CreateVectorStoreFileBatch -> String
show :: CreateVectorStoreFileBatch -> String
$cshowList :: [CreateVectorStoreFileBatch] -> ShowS
showList :: [CreateVectorStoreFileBatch] -> ShowS
Show)
      deriving anyclass ([CreateVectorStoreFileBatch] -> Value
[CreateVectorStoreFileBatch] -> Encoding
CreateVectorStoreFileBatch -> Bool
CreateVectorStoreFileBatch -> Value
CreateVectorStoreFileBatch -> Encoding
(CreateVectorStoreFileBatch -> Value)
-> (CreateVectorStoreFileBatch -> Encoding)
-> ([CreateVectorStoreFileBatch] -> Value)
-> ([CreateVectorStoreFileBatch] -> Encoding)
-> (CreateVectorStoreFileBatch -> Bool)
-> ToJSON CreateVectorStoreFileBatch
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CreateVectorStoreFileBatch -> Value
toJSON :: CreateVectorStoreFileBatch -> Value
$ctoEncoding :: CreateVectorStoreFileBatch -> Encoding
toEncoding :: CreateVectorStoreFileBatch -> Encoding
$ctoJSONList :: [CreateVectorStoreFileBatch] -> Value
toJSONList :: [CreateVectorStoreFileBatch] -> Value
$ctoEncodingList :: [CreateVectorStoreFileBatch] -> Encoding
toEncodingList :: [CreateVectorStoreFileBatch] -> Encoding
$comitField :: CreateVectorStoreFileBatch -> Bool
omitField :: CreateVectorStoreFileBatch -> Bool
ToJSON)

-- | Default `CreateVectorStoreFileBatch`
_CreateVectorStoreFileBatch :: CreateVectorStoreFileBatch
_CreateVectorStoreFileBatch :: CreateVectorStoreFileBatch
_CreateVectorStoreFileBatch = CreateVectorStoreFileBatch
    { $sel:chunking_strategy:CreateVectorStoreFileBatch :: Maybe ChunkingStrategy
chunking_strategy = Maybe ChunkingStrategy
forall a. Maybe a
Nothing
    }

-- | A batch of files attached to a vector store
data VectorStoreFilesBatchObject = VectorStoreFilesBatchObject
    { VectorStoreFilesBatchObject -> VectorStoreFileBatchID
id :: VectorStoreFileBatchID
    , VectorStoreFilesBatchObject -> Text
object :: Text
    , VectorStoreFilesBatchObject -> POSIXTime
created_at :: POSIXTime
    , VectorStoreFilesBatchObject -> VectorStoreID
vector_store_id :: VectorStoreID
    , VectorStoreFilesBatchObject -> Status
status :: Status
    , VectorStoreFilesBatchObject -> Maybe FileCounts
file_counts :: Maybe FileCounts
    } deriving stock ((forall x.
 VectorStoreFilesBatchObject -> Rep VectorStoreFilesBatchObject x)
-> (forall x.
    Rep VectorStoreFilesBatchObject x -> VectorStoreFilesBatchObject)
-> Generic VectorStoreFilesBatchObject
forall x.
Rep VectorStoreFilesBatchObject x -> VectorStoreFilesBatchObject
forall x.
VectorStoreFilesBatchObject -> Rep VectorStoreFilesBatchObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
VectorStoreFilesBatchObject -> Rep VectorStoreFilesBatchObject x
from :: forall x.
VectorStoreFilesBatchObject -> Rep VectorStoreFilesBatchObject x
$cto :: forall x.
Rep VectorStoreFilesBatchObject x -> VectorStoreFilesBatchObject
to :: forall x.
Rep VectorStoreFilesBatchObject x -> VectorStoreFilesBatchObject
Generic, Int -> VectorStoreFilesBatchObject -> ShowS
[VectorStoreFilesBatchObject] -> ShowS
VectorStoreFilesBatchObject -> String
(Int -> VectorStoreFilesBatchObject -> ShowS)
-> (VectorStoreFilesBatchObject -> String)
-> ([VectorStoreFilesBatchObject] -> ShowS)
-> Show VectorStoreFilesBatchObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VectorStoreFilesBatchObject -> ShowS
showsPrec :: Int -> VectorStoreFilesBatchObject -> ShowS
$cshow :: VectorStoreFilesBatchObject -> String
show :: VectorStoreFilesBatchObject -> String
$cshowList :: [VectorStoreFilesBatchObject] -> ShowS
showList :: [VectorStoreFilesBatchObject] -> ShowS
Show)
      deriving anyclass (Maybe VectorStoreFilesBatchObject
Value -> Parser [VectorStoreFilesBatchObject]
Value -> Parser VectorStoreFilesBatchObject
(Value -> Parser VectorStoreFilesBatchObject)
-> (Value -> Parser [VectorStoreFilesBatchObject])
-> Maybe VectorStoreFilesBatchObject
-> FromJSON VectorStoreFilesBatchObject
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser VectorStoreFilesBatchObject
parseJSON :: Value -> Parser VectorStoreFilesBatchObject
$cparseJSONList :: Value -> Parser [VectorStoreFilesBatchObject]
parseJSONList :: Value -> Parser [VectorStoreFilesBatchObject]
$comittedField :: Maybe VectorStoreFilesBatchObject
omittedField :: Maybe VectorStoreFilesBatchObject
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)
        )