{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Rekognition.StartContentModeration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts asynchronous detection of inappropriate, unwanted, or offensive
-- content in a stored video. For a list of moderation labels in Amazon
-- Rekognition, see
-- <https://docs.aws.amazon.com/rekognition/latest/dg/moderation.html#moderation-api Using the image and video moderation APIs>.
--
-- Amazon Rekognition Video can moderate content in a video stored in an
-- Amazon S3 bucket. Use Video to specify the bucket name and the filename
-- of the video. @StartContentModeration@ returns a job identifier
-- (@JobId@) which you use to get the results of the analysis. When content
-- analysis is finished, Amazon Rekognition Video publishes a completion
-- status to the Amazon Simple Notification Service topic that you specify
-- in @NotificationChannel@.
--
-- To get the results of the content analysis, first check that the status
-- value published to the Amazon SNS topic is @SUCCEEDED@. If so, call
-- GetContentModeration and pass the job identifier (@JobId@) from the
-- initial call to @StartContentModeration@.
--
-- For more information, see Moderating content in the Amazon Rekognition
-- Developer Guide.
module Amazonka.Rekognition.StartContentModeration
  ( -- * Creating a Request
    StartContentModeration (..),
    newStartContentModeration,

    -- * Request Lenses
    startContentModeration_clientRequestToken,
    startContentModeration_jobTag,
    startContentModeration_minConfidence,
    startContentModeration_notificationChannel,
    startContentModeration_video,

    -- * Destructuring the Response
    StartContentModerationResponse (..),
    newStartContentModerationResponse,

    -- * Response Lenses
    startContentModerationResponse_jobId,
    startContentModerationResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.Rekognition.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newStartContentModeration' smart constructor.
data StartContentModeration = StartContentModeration'
  { -- | Idempotent token used to identify the start request. If you use the same
    -- token with multiple @StartContentModeration@ requests, the same @JobId@
    -- is returned. Use @ClientRequestToken@ to prevent the same job from being
    -- accidently started more than once.
    StartContentModeration -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | An identifier you specify that\'s returned in the completion
    -- notification that\'s published to your Amazon Simple Notification
    -- Service topic. For example, you can use @JobTag@ to group related jobs
    -- and identify them in the completion notification.
    StartContentModeration -> Maybe Text
jobTag :: Prelude.Maybe Prelude.Text,
    -- | Specifies the minimum confidence that Amazon Rekognition must have in
    -- order to return a moderated content label. Confidence represents how
    -- certain Amazon Rekognition is that the moderated content is correctly
    -- identified. 0 is the lowest confidence. 100 is the highest confidence.
    -- Amazon Rekognition doesn\'t return any moderated content labels with a
    -- confidence level lower than this specified value. If you don\'t specify
    -- @MinConfidence@, @GetContentModeration@ returns labels with confidence
    -- values greater than or equal to 50 percent.
    StartContentModeration -> Maybe Double
minConfidence :: Prelude.Maybe Prelude.Double,
    -- | The Amazon SNS topic ARN that you want Amazon Rekognition Video to
    -- publish the completion status of the content analysis to. The Amazon SNS
    -- topic must have a topic name that begins with /AmazonRekognition/ if you
    -- are using the AmazonRekognitionServiceRole permissions policy to access
    -- the topic.
    StartContentModeration -> Maybe NotificationChannel
notificationChannel :: Prelude.Maybe NotificationChannel,
    -- | The video in which you want to detect inappropriate, unwanted, or
    -- offensive content. The video must be stored in an Amazon S3 bucket.
    StartContentModeration -> Video
video :: Video
  }
  deriving (StartContentModeration -> StartContentModeration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartContentModeration -> StartContentModeration -> Bool
$c/= :: StartContentModeration -> StartContentModeration -> Bool
== :: StartContentModeration -> StartContentModeration -> Bool
$c== :: StartContentModeration -> StartContentModeration -> Bool
Prelude.Eq, ReadPrec [StartContentModeration]
ReadPrec StartContentModeration
Int -> ReadS StartContentModeration
ReadS [StartContentModeration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartContentModeration]
$creadListPrec :: ReadPrec [StartContentModeration]
readPrec :: ReadPrec StartContentModeration
$creadPrec :: ReadPrec StartContentModeration
readList :: ReadS [StartContentModeration]
$creadList :: ReadS [StartContentModeration]
readsPrec :: Int -> ReadS StartContentModeration
$creadsPrec :: Int -> ReadS StartContentModeration
Prelude.Read, Int -> StartContentModeration -> ShowS
[StartContentModeration] -> ShowS
StartContentModeration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartContentModeration] -> ShowS
$cshowList :: [StartContentModeration] -> ShowS
show :: StartContentModeration -> String
$cshow :: StartContentModeration -> String
showsPrec :: Int -> StartContentModeration -> ShowS
$cshowsPrec :: Int -> StartContentModeration -> ShowS
Prelude.Show, forall x. Rep StartContentModeration x -> StartContentModeration
forall x. StartContentModeration -> Rep StartContentModeration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartContentModeration x -> StartContentModeration
$cfrom :: forall x. StartContentModeration -> Rep StartContentModeration x
Prelude.Generic)

-- |
-- Create a value of 'StartContentModeration' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'clientRequestToken', 'startContentModeration_clientRequestToken' - Idempotent token used to identify the start request. If you use the same
-- token with multiple @StartContentModeration@ requests, the same @JobId@
-- is returned. Use @ClientRequestToken@ to prevent the same job from being
-- accidently started more than once.
--
-- 'jobTag', 'startContentModeration_jobTag' - An identifier you specify that\'s returned in the completion
-- notification that\'s published to your Amazon Simple Notification
-- Service topic. For example, you can use @JobTag@ to group related jobs
-- and identify them in the completion notification.
--
-- 'minConfidence', 'startContentModeration_minConfidence' - Specifies the minimum confidence that Amazon Rekognition must have in
-- order to return a moderated content label. Confidence represents how
-- certain Amazon Rekognition is that the moderated content is correctly
-- identified. 0 is the lowest confidence. 100 is the highest confidence.
-- Amazon Rekognition doesn\'t return any moderated content labels with a
-- confidence level lower than this specified value. If you don\'t specify
-- @MinConfidence@, @GetContentModeration@ returns labels with confidence
-- values greater than or equal to 50 percent.
--
-- 'notificationChannel', 'startContentModeration_notificationChannel' - The Amazon SNS topic ARN that you want Amazon Rekognition Video to
-- publish the completion status of the content analysis to. The Amazon SNS
-- topic must have a topic name that begins with /AmazonRekognition/ if you
-- are using the AmazonRekognitionServiceRole permissions policy to access
-- the topic.
--
-- 'video', 'startContentModeration_video' - The video in which you want to detect inappropriate, unwanted, or
-- offensive content. The video must be stored in an Amazon S3 bucket.
newStartContentModeration ::
  -- | 'video'
  Video ->
  StartContentModeration
newStartContentModeration :: Video -> StartContentModeration
newStartContentModeration Video
pVideo_ =
  StartContentModeration'
    { $sel:clientRequestToken:StartContentModeration' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:jobTag:StartContentModeration' :: Maybe Text
jobTag = forall a. Maybe a
Prelude.Nothing,
      $sel:minConfidence:StartContentModeration' :: Maybe Double
minConfidence = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationChannel:StartContentModeration' :: Maybe NotificationChannel
notificationChannel = forall a. Maybe a
Prelude.Nothing,
      $sel:video:StartContentModeration' :: Video
video = Video
pVideo_
    }

-- | Idempotent token used to identify the start request. If you use the same
-- token with multiple @StartContentModeration@ requests, the same @JobId@
-- is returned. Use @ClientRequestToken@ to prevent the same job from being
-- accidently started more than once.
startContentModeration_clientRequestToken :: Lens.Lens' StartContentModeration (Prelude.Maybe Prelude.Text)
startContentModeration_clientRequestToken :: Lens' StartContentModeration (Maybe Text)
startContentModeration_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentModeration' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:StartContentModeration' :: StartContentModeration -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: StartContentModeration
s@StartContentModeration' {} Maybe Text
a -> StartContentModeration
s {$sel:clientRequestToken:StartContentModeration' :: Maybe Text
clientRequestToken = Maybe Text
a} :: StartContentModeration)

-- | An identifier you specify that\'s returned in the completion
-- notification that\'s published to your Amazon Simple Notification
-- Service topic. For example, you can use @JobTag@ to group related jobs
-- and identify them in the completion notification.
startContentModeration_jobTag :: Lens.Lens' StartContentModeration (Prelude.Maybe Prelude.Text)
startContentModeration_jobTag :: Lens' StartContentModeration (Maybe Text)
startContentModeration_jobTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentModeration' {Maybe Text
jobTag :: Maybe Text
$sel:jobTag:StartContentModeration' :: StartContentModeration -> Maybe Text
jobTag} -> Maybe Text
jobTag) (\s :: StartContentModeration
s@StartContentModeration' {} Maybe Text
a -> StartContentModeration
s {$sel:jobTag:StartContentModeration' :: Maybe Text
jobTag = Maybe Text
a} :: StartContentModeration)

-- | Specifies the minimum confidence that Amazon Rekognition must have in
-- order to return a moderated content label. Confidence represents how
-- certain Amazon Rekognition is that the moderated content is correctly
-- identified. 0 is the lowest confidence. 100 is the highest confidence.
-- Amazon Rekognition doesn\'t return any moderated content labels with a
-- confidence level lower than this specified value. If you don\'t specify
-- @MinConfidence@, @GetContentModeration@ returns labels with confidence
-- values greater than or equal to 50 percent.
startContentModeration_minConfidence :: Lens.Lens' StartContentModeration (Prelude.Maybe Prelude.Double)
startContentModeration_minConfidence :: Lens' StartContentModeration (Maybe Double)
startContentModeration_minConfidence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentModeration' {Maybe Double
minConfidence :: Maybe Double
$sel:minConfidence:StartContentModeration' :: StartContentModeration -> Maybe Double
minConfidence} -> Maybe Double
minConfidence) (\s :: StartContentModeration
s@StartContentModeration' {} Maybe Double
a -> StartContentModeration
s {$sel:minConfidence:StartContentModeration' :: Maybe Double
minConfidence = Maybe Double
a} :: StartContentModeration)

-- | The Amazon SNS topic ARN that you want Amazon Rekognition Video to
-- publish the completion status of the content analysis to. The Amazon SNS
-- topic must have a topic name that begins with /AmazonRekognition/ if you
-- are using the AmazonRekognitionServiceRole permissions policy to access
-- the topic.
startContentModeration_notificationChannel :: Lens.Lens' StartContentModeration (Prelude.Maybe NotificationChannel)
startContentModeration_notificationChannel :: Lens' StartContentModeration (Maybe NotificationChannel)
startContentModeration_notificationChannel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentModeration' {Maybe NotificationChannel
notificationChannel :: Maybe NotificationChannel
$sel:notificationChannel:StartContentModeration' :: StartContentModeration -> Maybe NotificationChannel
notificationChannel} -> Maybe NotificationChannel
notificationChannel) (\s :: StartContentModeration
s@StartContentModeration' {} Maybe NotificationChannel
a -> StartContentModeration
s {$sel:notificationChannel:StartContentModeration' :: Maybe NotificationChannel
notificationChannel = Maybe NotificationChannel
a} :: StartContentModeration)

-- | The video in which you want to detect inappropriate, unwanted, or
-- offensive content. The video must be stored in an Amazon S3 bucket.
startContentModeration_video :: Lens.Lens' StartContentModeration Video
startContentModeration_video :: Lens' StartContentModeration Video
startContentModeration_video = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentModeration' {Video
video :: Video
$sel:video:StartContentModeration' :: StartContentModeration -> Video
video} -> Video
video) (\s :: StartContentModeration
s@StartContentModeration' {} Video
a -> StartContentModeration
s {$sel:video:StartContentModeration' :: Video
video = Video
a} :: StartContentModeration)

instance Core.AWSRequest StartContentModeration where
  type
    AWSResponse StartContentModeration =
      StartContentModerationResponse
  request :: (Service -> Service)
-> StartContentModeration -> Request StartContentModeration
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartContentModeration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartContentModeration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> StartContentModerationResponse
StartContentModerationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"JobId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable StartContentModeration where
  hashWithSalt :: Int -> StartContentModeration -> Int
hashWithSalt Int
_salt StartContentModeration' {Maybe Double
Maybe Text
Maybe NotificationChannel
Video
video :: Video
notificationChannel :: Maybe NotificationChannel
minConfidence :: Maybe Double
jobTag :: Maybe Text
clientRequestToken :: Maybe Text
$sel:video:StartContentModeration' :: StartContentModeration -> Video
$sel:notificationChannel:StartContentModeration' :: StartContentModeration -> Maybe NotificationChannel
$sel:minConfidence:StartContentModeration' :: StartContentModeration -> Maybe Double
$sel:jobTag:StartContentModeration' :: StartContentModeration -> Maybe Text
$sel:clientRequestToken:StartContentModeration' :: StartContentModeration -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobTag
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
minConfidence
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NotificationChannel
notificationChannel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Video
video

instance Prelude.NFData StartContentModeration where
  rnf :: StartContentModeration -> ()
rnf StartContentModeration' {Maybe Double
Maybe Text
Maybe NotificationChannel
Video
video :: Video
notificationChannel :: Maybe NotificationChannel
minConfidence :: Maybe Double
jobTag :: Maybe Text
clientRequestToken :: Maybe Text
$sel:video:StartContentModeration' :: StartContentModeration -> Video
$sel:notificationChannel:StartContentModeration' :: StartContentModeration -> Maybe NotificationChannel
$sel:minConfidence:StartContentModeration' :: StartContentModeration -> Maybe Double
$sel:jobTag:StartContentModeration' :: StartContentModeration -> Maybe Text
$sel:clientRequestToken:StartContentModeration' :: StartContentModeration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobTag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
minConfidence
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NotificationChannel
notificationChannel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Video
video

instance Data.ToHeaders StartContentModeration where
  toHeaders :: StartContentModeration -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"RekognitionService.StartContentModeration" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartContentModeration where
  toJSON :: StartContentModeration -> Value
toJSON StartContentModeration' {Maybe Double
Maybe Text
Maybe NotificationChannel
Video
video :: Video
notificationChannel :: Maybe NotificationChannel
minConfidence :: Maybe Double
jobTag :: Maybe Text
clientRequestToken :: Maybe Text
$sel:video:StartContentModeration' :: StartContentModeration -> Video
$sel:notificationChannel:StartContentModeration' :: StartContentModeration -> Maybe NotificationChannel
$sel:minConfidence:StartContentModeration' :: StartContentModeration -> Maybe Double
$sel:jobTag:StartContentModeration' :: StartContentModeration -> Maybe Text
$sel:clientRequestToken:StartContentModeration' :: StartContentModeration -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientRequestToken,
            (Key
"JobTag" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
jobTag,
            (Key
"MinConfidence" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Double
minConfidence,
            (Key
"NotificationChannel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe NotificationChannel
notificationChannel,
            forall a. a -> Maybe a
Prelude.Just (Key
"Video" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Video
video)
          ]
      )

instance Data.ToPath StartContentModeration where
  toPath :: StartContentModeration -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery StartContentModeration where
  toQuery :: StartContentModeration -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newStartContentModerationResponse' smart constructor.
data StartContentModerationResponse = StartContentModerationResponse'
  { -- | The identifier for the content analysis job. Use @JobId@ to identify the
    -- job in a subsequent call to @GetContentModeration@.
    StartContentModerationResponse -> Maybe Text
jobId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartContentModerationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartContentModerationResponse
-> StartContentModerationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartContentModerationResponse
-> StartContentModerationResponse -> Bool
$c/= :: StartContentModerationResponse
-> StartContentModerationResponse -> Bool
== :: StartContentModerationResponse
-> StartContentModerationResponse -> Bool
$c== :: StartContentModerationResponse
-> StartContentModerationResponse -> Bool
Prelude.Eq, ReadPrec [StartContentModerationResponse]
ReadPrec StartContentModerationResponse
Int -> ReadS StartContentModerationResponse
ReadS [StartContentModerationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartContentModerationResponse]
$creadListPrec :: ReadPrec [StartContentModerationResponse]
readPrec :: ReadPrec StartContentModerationResponse
$creadPrec :: ReadPrec StartContentModerationResponse
readList :: ReadS [StartContentModerationResponse]
$creadList :: ReadS [StartContentModerationResponse]
readsPrec :: Int -> ReadS StartContentModerationResponse
$creadsPrec :: Int -> ReadS StartContentModerationResponse
Prelude.Read, Int -> StartContentModerationResponse -> ShowS
[StartContentModerationResponse] -> ShowS
StartContentModerationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartContentModerationResponse] -> ShowS
$cshowList :: [StartContentModerationResponse] -> ShowS
show :: StartContentModerationResponse -> String
$cshow :: StartContentModerationResponse -> String
showsPrec :: Int -> StartContentModerationResponse -> ShowS
$cshowsPrec :: Int -> StartContentModerationResponse -> ShowS
Prelude.Show, forall x.
Rep StartContentModerationResponse x
-> StartContentModerationResponse
forall x.
StartContentModerationResponse
-> Rep StartContentModerationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartContentModerationResponse x
-> StartContentModerationResponse
$cfrom :: forall x.
StartContentModerationResponse
-> Rep StartContentModerationResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartContentModerationResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'jobId', 'startContentModerationResponse_jobId' - The identifier for the content analysis job. Use @JobId@ to identify the
-- job in a subsequent call to @GetContentModeration@.
--
-- 'httpStatus', 'startContentModerationResponse_httpStatus' - The response's http status code.
newStartContentModerationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartContentModerationResponse
newStartContentModerationResponse :: Int -> StartContentModerationResponse
newStartContentModerationResponse Int
pHttpStatus_ =
  StartContentModerationResponse'
    { $sel:jobId:StartContentModerationResponse' :: Maybe Text
jobId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartContentModerationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier for the content analysis job. Use @JobId@ to identify the
-- job in a subsequent call to @GetContentModeration@.
startContentModerationResponse_jobId :: Lens.Lens' StartContentModerationResponse (Prelude.Maybe Prelude.Text)
startContentModerationResponse_jobId :: Lens' StartContentModerationResponse (Maybe Text)
startContentModerationResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentModerationResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:StartContentModerationResponse' :: StartContentModerationResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: StartContentModerationResponse
s@StartContentModerationResponse' {} Maybe Text
a -> StartContentModerationResponse
s {$sel:jobId:StartContentModerationResponse' :: Maybe Text
jobId = Maybe Text
a} :: StartContentModerationResponse)

-- | The response's http status code.
startContentModerationResponse_httpStatus :: Lens.Lens' StartContentModerationResponse Prelude.Int
startContentModerationResponse_httpStatus :: Lens' StartContentModerationResponse Int
startContentModerationResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentModerationResponse' {Int
httpStatus :: Int
$sel:httpStatus:StartContentModerationResponse' :: StartContentModerationResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: StartContentModerationResponse
s@StartContentModerationResponse' {} Int
a -> StartContentModerationResponse
s {$sel:httpStatus:StartContentModerationResponse' :: Int
httpStatus = Int
a} :: StartContentModerationResponse)

instance
  Prelude.NFData
    StartContentModerationResponse
  where
  rnf :: StartContentModerationResponse -> ()
rnf StartContentModerationResponse' {Int
Maybe Text
httpStatus :: Int
jobId :: Maybe Text
$sel:httpStatus:StartContentModerationResponse' :: StartContentModerationResponse -> Int
$sel:jobId:StartContentModerationResponse' :: StartContentModerationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus