-- | @\/v1\/moderations@
module OpenAI.V1.Moderations
    ( -- * Main types
      CreateModeration(..)
    , _CreateModeration
    , Moderation(..)

      -- * Other types
    , InputType(..)
    , Result(..)

      -- * Servant
    , API
    ) where

import OpenAI.Prelude
import OpenAI.V1.Models (Model)

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

-- | Default `CreateModeration`
_CreateModeration :: CreateModeration
_CreateModeration :: CreateModeration
_CreateModeration = CreateModeration
    { $sel:model:CreateModeration :: Maybe Model
model = Maybe Model
forall a. Maybe a
Nothing
    }

-- | The input type that the score applies to
data InputType = Text | Image
    deriving stock ((forall x. InputType -> Rep InputType x)
-> (forall x. Rep InputType x -> InputType) -> Generic InputType
forall x. Rep InputType x -> InputType
forall x. InputType -> Rep InputType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputType -> Rep InputType x
from :: forall x. InputType -> Rep InputType x
$cto :: forall x. Rep InputType x -> InputType
to :: forall x. Rep InputType x -> InputType
Generic, Int -> InputType -> ShowS
[InputType] -> ShowS
InputType -> String
(Int -> InputType -> ShowS)
-> (InputType -> String)
-> ([InputType] -> ShowS)
-> Show InputType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputType -> ShowS
showsPrec :: Int -> InputType -> ShowS
$cshow :: InputType -> String
show :: InputType -> String
$cshowList :: [InputType] -> ShowS
showList :: [InputType] -> ShowS
Show)

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

-- | A moderation result
data Result = Result
    { Result -> Bool
flagged :: Bool
    , Result -> Map Text Bool
categories :: Map Text Bool
    , Result -> Map Text Double
category_scores :: Map Text Double
    , Result -> Maybe (Map Text InputType)
category_applied_input_types :: Maybe (Map Text InputType)
    -- According to the OpenAPI spec the `category_applied_input_types`
    -- field is required but their actual implementation omits this field.
    } deriving stock ((forall x. Result -> Rep Result x)
-> (forall x. Rep Result x -> Result) -> Generic Result
forall x. Rep Result x -> Result
forall x. Result -> Rep Result x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Result -> Rep Result x
from :: forall x. Result -> Rep Result x
$cto :: forall x. Rep Result x -> Result
to :: forall x. Rep Result x -> Result
Generic, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Result -> ShowS
showsPrec :: Int -> Result -> ShowS
$cshow :: Result -> String
show :: Result -> String
$cshowList :: [Result] -> ShowS
showList :: [Result] -> ShowS
Show)
      deriving anyclass (Maybe Result
Value -> Parser [Result]
Value -> Parser Result
(Value -> Parser Result)
-> (Value -> Parser [Result]) -> Maybe Result -> FromJSON Result
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Result
parseJSON :: Value -> Parser Result
$cparseJSONList :: Value -> Parser [Result]
parseJSONList :: Value -> Parser [Result]
$comittedField :: Maybe Result
omittedField :: Maybe Result
FromJSON)

-- | Represents if a given text input is potentially harmful.
data Moderation = Moderation
    { Moderation -> Text
id :: Text
    , Moderation -> Model
model :: Model
    , Moderation -> Vector Result
results :: Vector Result
    } deriving stock ((forall x. Moderation -> Rep Moderation x)
-> (forall x. Rep Moderation x -> Moderation) -> Generic Moderation
forall x. Rep Moderation x -> Moderation
forall x. Moderation -> Rep Moderation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Moderation -> Rep Moderation x
from :: forall x. Moderation -> Rep Moderation x
$cto :: forall x. Rep Moderation x -> Moderation
to :: forall x. Rep Moderation x -> Moderation
Generic, Int -> Moderation -> ShowS
[Moderation] -> ShowS
Moderation -> String
(Int -> Moderation -> ShowS)
-> (Moderation -> String)
-> ([Moderation] -> ShowS)
-> Show Moderation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Moderation -> ShowS
showsPrec :: Int -> Moderation -> ShowS
$cshow :: Moderation -> String
show :: Moderation -> String
$cshowList :: [Moderation] -> ShowS
showList :: [Moderation] -> ShowS
Show)
      deriving anyclass (Maybe Moderation
Value -> Parser [Moderation]
Value -> Parser Moderation
(Value -> Parser Moderation)
-> (Value -> Parser [Moderation])
-> Maybe Moderation
-> FromJSON Moderation
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Moderation
parseJSON :: Value -> Parser Moderation
$cparseJSONList :: Value -> Parser [Moderation]
parseJSONList :: Value -> Parser [Moderation]
$comittedField :: Maybe Moderation
omittedField :: Maybe Moderation
FromJSON)

-- | Servant API
type API =
    "moderations" :> ReqBody '[JSON] CreateModeration :> Post '[JSON] Moderation