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

-- | The expiration policy for a vector store.
data ExpiresAfter = ExpiresAfter
    { ExpiresAfter -> Text
anchor :: Text
    , ExpiresAfter -> Natural
days :: Natural
    } deriving stock ((forall x. ExpiresAfter -> Rep ExpiresAfter x)
-> (forall x. Rep ExpiresAfter x -> ExpiresAfter)
-> Generic ExpiresAfter
forall x. Rep ExpiresAfter x -> ExpiresAfter
forall x. ExpiresAfter -> Rep ExpiresAfter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExpiresAfter -> Rep ExpiresAfter x
from :: forall x. ExpiresAfter -> Rep ExpiresAfter x
$cto :: forall x. Rep ExpiresAfter x -> ExpiresAfter
to :: forall x. Rep ExpiresAfter x -> ExpiresAfter
Generic, Int -> ExpiresAfter -> ShowS
[ExpiresAfter] -> ShowS
ExpiresAfter -> String
(Int -> ExpiresAfter -> ShowS)
-> (ExpiresAfter -> String)
-> ([ExpiresAfter] -> ShowS)
-> Show ExpiresAfter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpiresAfter -> ShowS
showsPrec :: Int -> ExpiresAfter -> ShowS
$cshow :: ExpiresAfter -> String
show :: ExpiresAfter -> String
$cshowList :: [ExpiresAfter] -> ShowS
showList :: [ExpiresAfter] -> ShowS
Show)
      deriving anyclass (Maybe ExpiresAfter
Value -> Parser [ExpiresAfter]
Value -> Parser ExpiresAfter
(Value -> Parser ExpiresAfter)
-> (Value -> Parser [ExpiresAfter])
-> Maybe ExpiresAfter
-> FromJSON ExpiresAfter
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExpiresAfter
parseJSON :: Value -> Parser ExpiresAfter
$cparseJSONList :: Value -> Parser [ExpiresAfter]
parseJSONList :: Value -> Parser [ExpiresAfter]
$comittedField :: Maybe ExpiresAfter
omittedField :: Maybe ExpiresAfter
FromJSON, [ExpiresAfter] -> Value
[ExpiresAfter] -> Encoding
ExpiresAfter -> Bool
ExpiresAfter -> Value
ExpiresAfter -> Encoding
(ExpiresAfter -> Value)
-> (ExpiresAfter -> Encoding)
-> ([ExpiresAfter] -> Value)
-> ([ExpiresAfter] -> Encoding)
-> (ExpiresAfter -> Bool)
-> ToJSON ExpiresAfter
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExpiresAfter -> Value
toJSON :: ExpiresAfter -> Value
$ctoEncoding :: ExpiresAfter -> Encoding
toEncoding :: ExpiresAfter -> Encoding
$ctoJSONList :: [ExpiresAfter] -> Value
toJSONList :: [ExpiresAfter] -> Value
$ctoEncodingList :: [ExpiresAfter] -> Encoding
toEncodingList :: [ExpiresAfter] -> Encoding
$comitField :: ExpiresAfter -> Bool
omitField :: ExpiresAfter -> Bool
ToJSON)

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

-- | Default `CreateVectorStore`
_CreateVectorStore :: CreateVectorStore
_CreateVectorStore :: CreateVectorStore
_CreateVectorStore = CreateVectorStore
    { $sel:name:CreateVectorStore :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing
    , $sel:expires_after:CreateVectorStore :: Maybe ExpiresAfter
expires_after = Maybe ExpiresAfter
forall a. Maybe a
Nothing
    , $sel:chunking_strategy:CreateVectorStore :: Maybe (AutoOr ChunkingStrategy)
chunking_strategy = Maybe (AutoOr ChunkingStrategy)
forall a. Maybe a
Nothing
    , $sel:metadata:CreateVectorStore :: Maybe (Map Text Text)
metadata = Maybe (Map Text Text)
forall a. Maybe a
Nothing
    }

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

-- | Default `ModifyVectorStore`
_ModifyVectorStore :: ModifyVectorStore
_ModifyVectorStore :: ModifyVectorStore
_ModifyVectorStore = ModifyVectorStore
    { $sel:name:ModifyVectorStore :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing
    , $sel:expires_after:ModifyVectorStore :: Maybe ExpiresAfter
expires_after = Maybe ExpiresAfter
forall a. Maybe a
Nothing
    , $sel:metadata:ModifyVectorStore :: Maybe (Map Text Text)
metadata = Maybe (Map Text Text)
forall a. Maybe a
Nothing
    }

-- | The status of the vector store
data Status = Expired | In_Progress | Completed
    deriving stock ((forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status -> Rep Status x
from :: forall x. Status -> Rep Status x
$cto :: forall x. Rep Status x -> Status
to :: forall x. Rep Status x -> Status
Generic, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

instance FromJSON Status where
    parseJSON :: Value -> Parser Status
parseJSON = Options -> Value -> Parser Status
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

-- | A vector store is a collection of processed files can be used by the
-- @file_search@ tool.
data VectorStoreObject = VectorStoreObject
    { VectorStoreObject -> VectorStoreID
id :: VectorStoreID
    , VectorStoreObject -> Text
object :: Text
    , VectorStoreObject -> POSIXTime
created_at :: POSIXTime
    , VectorStoreObject -> Maybe Text
name :: Maybe Text
    , VectorStoreObject -> Natural
usage_bytes :: Natural
    , VectorStoreObject -> FileCounts
file_counts :: FileCounts
    , VectorStoreObject -> Status
status :: Status
    , VectorStoreObject -> Maybe ExpiresAfter
expires_after :: Maybe ExpiresAfter
    , VectorStoreObject -> Maybe POSIXTime
expires_at :: Maybe POSIXTime
    , VectorStoreObject -> Maybe POSIXTime
last_active_at :: Maybe POSIXTime
    , VectorStoreObject -> Map Text Text
metadata :: Map Text Text
    } deriving stock ((forall x. VectorStoreObject -> Rep VectorStoreObject x)
-> (forall x. Rep VectorStoreObject x -> VectorStoreObject)
-> Generic VectorStoreObject
forall x. Rep VectorStoreObject x -> VectorStoreObject
forall x. VectorStoreObject -> Rep VectorStoreObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VectorStoreObject -> Rep VectorStoreObject x
from :: forall x. VectorStoreObject -> Rep VectorStoreObject x
$cto :: forall x. Rep VectorStoreObject x -> VectorStoreObject
to :: forall x. Rep VectorStoreObject x -> VectorStoreObject
Generic, Int -> VectorStoreObject -> ShowS
[VectorStoreObject] -> ShowS
VectorStoreObject -> String
(Int -> VectorStoreObject -> ShowS)
-> (VectorStoreObject -> String)
-> ([VectorStoreObject] -> ShowS)
-> Show VectorStoreObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VectorStoreObject -> ShowS
showsPrec :: Int -> VectorStoreObject -> ShowS
$cshow :: VectorStoreObject -> String
show :: VectorStoreObject -> String
$cshowList :: [VectorStoreObject] -> ShowS
showList :: [VectorStoreObject] -> ShowS
Show)
      deriving anyclass (Maybe VectorStoreObject
Value -> Parser [VectorStoreObject]
Value -> Parser VectorStoreObject
(Value -> Parser VectorStoreObject)
-> (Value -> Parser [VectorStoreObject])
-> Maybe VectorStoreObject
-> FromJSON VectorStoreObject
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser VectorStoreObject
parseJSON :: Value -> Parser VectorStoreObject
$cparseJSONList :: Value -> Parser [VectorStoreObject]
parseJSONList :: Value -> Parser [VectorStoreObject]
$comittedField :: Maybe VectorStoreObject
omittedField :: Maybe VectorStoreObject
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
        )