{-# 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.StartLabelDetection
-- 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 labels in a stored video.
--
-- Amazon Rekognition Video can detect labels in a video. Labels are
-- instances of real-world entities. This includes objects like flower,
-- tree, and table; events like wedding, graduation, and birthday party;
-- concepts like landscape, evening, and nature; and activities like a
-- person getting out of a car or a person skiing.
--
-- The video must be stored in an Amazon S3 bucket. Use Video to specify
-- the bucket name and the filename of the video. @StartLabelDetection@
-- returns a job identifier (@JobId@) which you use to get the results of
-- the operation. When label detection 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 label detection operation, first check that
-- the status value published to the Amazon SNS topic is @SUCCEEDED@. If
-- so, call GetLabelDetection and pass the job identifier (@JobId@) from
-- the initial call to @StartLabelDetection@.
--
-- /Optional Parameters/
--
-- @StartLabelDetection@ has the @GENERAL_LABELS@ Feature applied by
-- default. This feature allows you to provide filtering criteria to the
-- @Settings@ parameter. You can filter with sets of individual labels or
-- with label categories. You can specify inclusive filters, exclusive
-- filters, or a combination of inclusive and exclusive filters. For more
-- information on filtering, see
-- <https://docs.aws.amazon.com/rekognition/latest/dg/labels-detecting-labels-video.html Detecting labels in a video>.
--
-- You can specify @MinConfidence@ to control the confidence threshold for
-- the labels returned. The default is 50.
module Amazonka.Rekognition.StartLabelDetection
  ( -- * Creating a Request
    StartLabelDetection (..),
    newStartLabelDetection,

    -- * Request Lenses
    startLabelDetection_clientRequestToken,
    startLabelDetection_features,
    startLabelDetection_jobTag,
    startLabelDetection_minConfidence,
    startLabelDetection_notificationChannel,
    startLabelDetection_settings,
    startLabelDetection_video,

    -- * Destructuring the Response
    StartLabelDetectionResponse (..),
    newStartLabelDetectionResponse,

    -- * Response Lenses
    startLabelDetectionResponse_jobId,
    startLabelDetectionResponse_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:/ 'newStartLabelDetection' smart constructor.
data StartLabelDetection = StartLabelDetection'
  { -- | Idempotent token used to identify the start request. If you use the same
    -- token with multiple @StartLabelDetection@ requests, the same @JobId@ is
    -- returned. Use @ClientRequestToken@ to prevent the same job from being
    -- accidently started more than once.
    StartLabelDetection -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The features to return after video analysis. You can specify that
    -- GENERAL_LABELS are returned.
    StartLabelDetection -> Maybe [LabelDetectionFeatureName]
features :: Prelude.Maybe [LabelDetectionFeatureName],
    -- | 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.
    StartLabelDetection -> Maybe Text
jobTag :: Prelude.Maybe Prelude.Text,
    -- | Specifies the minimum confidence that Amazon Rekognition Video must have
    -- in order to return a detected label. Confidence represents how certain
    -- Amazon Rekognition is that a label is correctly identified.0 is the
    -- lowest confidence. 100 is the highest confidence. Amazon Rekognition
    -- Video doesn\'t return any labels with a confidence level lower than this
    -- specified value.
    --
    -- If you don\'t specify @MinConfidence@, the operation returns labels and
    -- bounding boxes (if detected) with confidence values greater than or
    -- equal to 50 percent.
    StartLabelDetection -> Maybe Double
minConfidence :: Prelude.Maybe Prelude.Double,
    -- | The Amazon SNS topic ARN you want Amazon Rekognition Video to publish
    -- the completion status of the label detection operation to. The Amazon
    -- SNS topic must have a topic name that begins with /AmazonRekognition/ if
    -- you are using the AmazonRekognitionServiceRole permissions policy.
    StartLabelDetection -> Maybe NotificationChannel
notificationChannel :: Prelude.Maybe NotificationChannel,
    -- | The settings for a StartLabelDetection request.Contains the specified
    -- parameters for the label detection request of an asynchronous label
    -- analysis operation. Settings can include filters for GENERAL_LABELS.
    StartLabelDetection -> Maybe LabelDetectionSettings
settings :: Prelude.Maybe LabelDetectionSettings,
    -- | The video in which you want to detect labels. The video must be stored
    -- in an Amazon S3 bucket.
    StartLabelDetection -> Video
video :: Video
  }
  deriving (StartLabelDetection -> StartLabelDetection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartLabelDetection -> StartLabelDetection -> Bool
$c/= :: StartLabelDetection -> StartLabelDetection -> Bool
== :: StartLabelDetection -> StartLabelDetection -> Bool
$c== :: StartLabelDetection -> StartLabelDetection -> Bool
Prelude.Eq, ReadPrec [StartLabelDetection]
ReadPrec StartLabelDetection
Int -> ReadS StartLabelDetection
ReadS [StartLabelDetection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartLabelDetection]
$creadListPrec :: ReadPrec [StartLabelDetection]
readPrec :: ReadPrec StartLabelDetection
$creadPrec :: ReadPrec StartLabelDetection
readList :: ReadS [StartLabelDetection]
$creadList :: ReadS [StartLabelDetection]
readsPrec :: Int -> ReadS StartLabelDetection
$creadsPrec :: Int -> ReadS StartLabelDetection
Prelude.Read, Int -> StartLabelDetection -> ShowS
[StartLabelDetection] -> ShowS
StartLabelDetection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartLabelDetection] -> ShowS
$cshowList :: [StartLabelDetection] -> ShowS
show :: StartLabelDetection -> String
$cshow :: StartLabelDetection -> String
showsPrec :: Int -> StartLabelDetection -> ShowS
$cshowsPrec :: Int -> StartLabelDetection -> ShowS
Prelude.Show, forall x. Rep StartLabelDetection x -> StartLabelDetection
forall x. StartLabelDetection -> Rep StartLabelDetection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartLabelDetection x -> StartLabelDetection
$cfrom :: forall x. StartLabelDetection -> Rep StartLabelDetection x
Prelude.Generic)

-- |
-- Create a value of 'StartLabelDetection' 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', 'startLabelDetection_clientRequestToken' - Idempotent token used to identify the start request. If you use the same
-- token with multiple @StartLabelDetection@ requests, the same @JobId@ is
-- returned. Use @ClientRequestToken@ to prevent the same job from being
-- accidently started more than once.
--
-- 'features', 'startLabelDetection_features' - The features to return after video analysis. You can specify that
-- GENERAL_LABELS are returned.
--
-- 'jobTag', 'startLabelDetection_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', 'startLabelDetection_minConfidence' - Specifies the minimum confidence that Amazon Rekognition Video must have
-- in order to return a detected label. Confidence represents how certain
-- Amazon Rekognition is that a label is correctly identified.0 is the
-- lowest confidence. 100 is the highest confidence. Amazon Rekognition
-- Video doesn\'t return any labels with a confidence level lower than this
-- specified value.
--
-- If you don\'t specify @MinConfidence@, the operation returns labels and
-- bounding boxes (if detected) with confidence values greater than or
-- equal to 50 percent.
--
-- 'notificationChannel', 'startLabelDetection_notificationChannel' - The Amazon SNS topic ARN you want Amazon Rekognition Video to publish
-- the completion status of the label detection operation to. The Amazon
-- SNS topic must have a topic name that begins with /AmazonRekognition/ if
-- you are using the AmazonRekognitionServiceRole permissions policy.
--
-- 'settings', 'startLabelDetection_settings' - The settings for a StartLabelDetection request.Contains the specified
-- parameters for the label detection request of an asynchronous label
-- analysis operation. Settings can include filters for GENERAL_LABELS.
--
-- 'video', 'startLabelDetection_video' - The video in which you want to detect labels. The video must be stored
-- in an Amazon S3 bucket.
newStartLabelDetection ::
  -- | 'video'
  Video ->
  StartLabelDetection
newStartLabelDetection :: Video -> StartLabelDetection
newStartLabelDetection Video
pVideo_ =
  StartLabelDetection'
    { $sel:clientRequestToken:StartLabelDetection' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:features:StartLabelDetection' :: Maybe [LabelDetectionFeatureName]
features = forall a. Maybe a
Prelude.Nothing,
      $sel:jobTag:StartLabelDetection' :: Maybe Text
jobTag = forall a. Maybe a
Prelude.Nothing,
      $sel:minConfidence:StartLabelDetection' :: Maybe Double
minConfidence = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationChannel:StartLabelDetection' :: Maybe NotificationChannel
notificationChannel = forall a. Maybe a
Prelude.Nothing,
      $sel:settings:StartLabelDetection' :: Maybe LabelDetectionSettings
settings = forall a. Maybe a
Prelude.Nothing,
      $sel:video:StartLabelDetection' :: Video
video = Video
pVideo_
    }

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

-- | The features to return after video analysis. You can specify that
-- GENERAL_LABELS are returned.
startLabelDetection_features :: Lens.Lens' StartLabelDetection (Prelude.Maybe [LabelDetectionFeatureName])
startLabelDetection_features :: Lens' StartLabelDetection (Maybe [LabelDetectionFeatureName])
startLabelDetection_features = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLabelDetection' {Maybe [LabelDetectionFeatureName]
features :: Maybe [LabelDetectionFeatureName]
$sel:features:StartLabelDetection' :: StartLabelDetection -> Maybe [LabelDetectionFeatureName]
features} -> Maybe [LabelDetectionFeatureName]
features) (\s :: StartLabelDetection
s@StartLabelDetection' {} Maybe [LabelDetectionFeatureName]
a -> StartLabelDetection
s {$sel:features:StartLabelDetection' :: Maybe [LabelDetectionFeatureName]
features = Maybe [LabelDetectionFeatureName]
a} :: StartLabelDetection) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | 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.
startLabelDetection_jobTag :: Lens.Lens' StartLabelDetection (Prelude.Maybe Prelude.Text)
startLabelDetection_jobTag :: Lens' StartLabelDetection (Maybe Text)
startLabelDetection_jobTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLabelDetection' {Maybe Text
jobTag :: Maybe Text
$sel:jobTag:StartLabelDetection' :: StartLabelDetection -> Maybe Text
jobTag} -> Maybe Text
jobTag) (\s :: StartLabelDetection
s@StartLabelDetection' {} Maybe Text
a -> StartLabelDetection
s {$sel:jobTag:StartLabelDetection' :: Maybe Text
jobTag = Maybe Text
a} :: StartLabelDetection)

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

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

-- | The settings for a StartLabelDetection request.Contains the specified
-- parameters for the label detection request of an asynchronous label
-- analysis operation. Settings can include filters for GENERAL_LABELS.
startLabelDetection_settings :: Lens.Lens' StartLabelDetection (Prelude.Maybe LabelDetectionSettings)
startLabelDetection_settings :: Lens' StartLabelDetection (Maybe LabelDetectionSettings)
startLabelDetection_settings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLabelDetection' {Maybe LabelDetectionSettings
settings :: Maybe LabelDetectionSettings
$sel:settings:StartLabelDetection' :: StartLabelDetection -> Maybe LabelDetectionSettings
settings} -> Maybe LabelDetectionSettings
settings) (\s :: StartLabelDetection
s@StartLabelDetection' {} Maybe LabelDetectionSettings
a -> StartLabelDetection
s {$sel:settings:StartLabelDetection' :: Maybe LabelDetectionSettings
settings = Maybe LabelDetectionSettings
a} :: StartLabelDetection)

-- | The video in which you want to detect labels. The video must be stored
-- in an Amazon S3 bucket.
startLabelDetection_video :: Lens.Lens' StartLabelDetection Video
startLabelDetection_video :: Lens' StartLabelDetection Video
startLabelDetection_video = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLabelDetection' {Video
video :: Video
$sel:video:StartLabelDetection' :: StartLabelDetection -> Video
video} -> Video
video) (\s :: StartLabelDetection
s@StartLabelDetection' {} Video
a -> StartLabelDetection
s {$sel:video:StartLabelDetection' :: Video
video = Video
a} :: StartLabelDetection)

instance Core.AWSRequest StartLabelDetection where
  type
    AWSResponse StartLabelDetection =
      StartLabelDetectionResponse
  request :: (Service -> Service)
-> StartLabelDetection -> Request StartLabelDetection
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 StartLabelDetection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartLabelDetection)))
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 -> StartLabelDetectionResponse
StartLabelDetectionResponse'
            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 StartLabelDetection where
  hashWithSalt :: Int -> StartLabelDetection -> Int
hashWithSalt Int
_salt StartLabelDetection' {Maybe Double
Maybe [LabelDetectionFeatureName]
Maybe Text
Maybe LabelDetectionSettings
Maybe NotificationChannel
Video
video :: Video
settings :: Maybe LabelDetectionSettings
notificationChannel :: Maybe NotificationChannel
minConfidence :: Maybe Double
jobTag :: Maybe Text
features :: Maybe [LabelDetectionFeatureName]
clientRequestToken :: Maybe Text
$sel:video:StartLabelDetection' :: StartLabelDetection -> Video
$sel:settings:StartLabelDetection' :: StartLabelDetection -> Maybe LabelDetectionSettings
$sel:notificationChannel:StartLabelDetection' :: StartLabelDetection -> Maybe NotificationChannel
$sel:minConfidence:StartLabelDetection' :: StartLabelDetection -> Maybe Double
$sel:jobTag:StartLabelDetection' :: StartLabelDetection -> Maybe Text
$sel:features:StartLabelDetection' :: StartLabelDetection -> Maybe [LabelDetectionFeatureName]
$sel:clientRequestToken:StartLabelDetection' :: StartLabelDetection -> 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 [LabelDetectionFeatureName]
features
      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` Maybe LabelDetectionSettings
settings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Video
video

instance Prelude.NFData StartLabelDetection where
  rnf :: StartLabelDetection -> ()
rnf StartLabelDetection' {Maybe Double
Maybe [LabelDetectionFeatureName]
Maybe Text
Maybe LabelDetectionSettings
Maybe NotificationChannel
Video
video :: Video
settings :: Maybe LabelDetectionSettings
notificationChannel :: Maybe NotificationChannel
minConfidence :: Maybe Double
jobTag :: Maybe Text
features :: Maybe [LabelDetectionFeatureName]
clientRequestToken :: Maybe Text
$sel:video:StartLabelDetection' :: StartLabelDetection -> Video
$sel:settings:StartLabelDetection' :: StartLabelDetection -> Maybe LabelDetectionSettings
$sel:notificationChannel:StartLabelDetection' :: StartLabelDetection -> Maybe NotificationChannel
$sel:minConfidence:StartLabelDetection' :: StartLabelDetection -> Maybe Double
$sel:jobTag:StartLabelDetection' :: StartLabelDetection -> Maybe Text
$sel:features:StartLabelDetection' :: StartLabelDetection -> Maybe [LabelDetectionFeatureName]
$sel:clientRequestToken:StartLabelDetection' :: StartLabelDetection -> 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 [LabelDetectionFeatureName]
features
      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 Maybe LabelDetectionSettings
settings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Video
video

instance Data.ToHeaders StartLabelDetection where
  toHeaders :: StartLabelDetection -> 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.StartLabelDetection" ::
                          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 StartLabelDetection where
  toJSON :: StartLabelDetection -> Value
toJSON StartLabelDetection' {Maybe Double
Maybe [LabelDetectionFeatureName]
Maybe Text
Maybe LabelDetectionSettings
Maybe NotificationChannel
Video
video :: Video
settings :: Maybe LabelDetectionSettings
notificationChannel :: Maybe NotificationChannel
minConfidence :: Maybe Double
jobTag :: Maybe Text
features :: Maybe [LabelDetectionFeatureName]
clientRequestToken :: Maybe Text
$sel:video:StartLabelDetection' :: StartLabelDetection -> Video
$sel:settings:StartLabelDetection' :: StartLabelDetection -> Maybe LabelDetectionSettings
$sel:notificationChannel:StartLabelDetection' :: StartLabelDetection -> Maybe NotificationChannel
$sel:minConfidence:StartLabelDetection' :: StartLabelDetection -> Maybe Double
$sel:jobTag:StartLabelDetection' :: StartLabelDetection -> Maybe Text
$sel:features:StartLabelDetection' :: StartLabelDetection -> Maybe [LabelDetectionFeatureName]
$sel:clientRequestToken:StartLabelDetection' :: StartLabelDetection -> 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
"Features" 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 [LabelDetectionFeatureName]
features,
            (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,
            (Key
"Settings" 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 LabelDetectionSettings
settings,
            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 StartLabelDetection where
  toPath :: StartLabelDetection -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'StartLabelDetectionResponse' 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', 'startLabelDetectionResponse_jobId' - The identifier for the label detection job. Use @JobId@ to identify the
-- job in a subsequent call to @GetLabelDetection@.
--
-- 'httpStatus', 'startLabelDetectionResponse_httpStatus' - The response's http status code.
newStartLabelDetectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartLabelDetectionResponse
newStartLabelDetectionResponse :: Int -> StartLabelDetectionResponse
newStartLabelDetectionResponse Int
pHttpStatus_ =
  StartLabelDetectionResponse'
    { $sel:jobId:StartLabelDetectionResponse' :: Maybe Text
jobId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartLabelDetectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier for the label detection job. Use @JobId@ to identify the
-- job in a subsequent call to @GetLabelDetection@.
startLabelDetectionResponse_jobId :: Lens.Lens' StartLabelDetectionResponse (Prelude.Maybe Prelude.Text)
startLabelDetectionResponse_jobId :: Lens' StartLabelDetectionResponse (Maybe Text)
startLabelDetectionResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLabelDetectionResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:StartLabelDetectionResponse' :: StartLabelDetectionResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: StartLabelDetectionResponse
s@StartLabelDetectionResponse' {} Maybe Text
a -> StartLabelDetectionResponse
s {$sel:jobId:StartLabelDetectionResponse' :: Maybe Text
jobId = Maybe Text
a} :: StartLabelDetectionResponse)

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

instance Prelude.NFData StartLabelDetectionResponse where
  rnf :: StartLabelDetectionResponse -> ()
rnf StartLabelDetectionResponse' {Int
Maybe Text
httpStatus :: Int
jobId :: Maybe Text
$sel:httpStatus:StartLabelDetectionResponse' :: StartLabelDetectionResponse -> Int
$sel:jobId:StartLabelDetectionResponse' :: StartLabelDetectionResponse -> 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