{-# 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.GetLabelDetection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the label detection results of a Amazon Rekognition Video analysis
-- started by StartLabelDetection.
--
-- The label detection operation is started by a call to
-- StartLabelDetection which returns a job identifier (@JobId@). When the
-- label detection operation finishes, Amazon Rekognition publishes a
-- completion status to the Amazon Simple Notification Service topic
-- registered in the initial call to @StartlabelDetection@.
--
-- 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@.
--
-- @GetLabelDetection@ returns an array of detected labels (@Labels@)
-- sorted by the time the labels were detected. You can also sort by the
-- label name by specifying @NAME@ for the @SortBy@ input parameter. If
-- there is no @NAME@ specified, the default sort is by timestamp.
--
-- You can select how results are aggregated by using the @AggregateBy@
-- input parameter. The default aggregation method is @TIMESTAMPS@. You can
-- also aggregate by @SEGMENTS@, which aggregates all instances of labels
-- detected in a given segment.
--
-- The returned Labels array may include the following attributes:
--
-- -   Name - The name of the detected label.
--
-- -   Confidence - The level of confidence in the label assigned to a
--     detected object.
--
-- -   Parents - The ancestor labels for a detected label.
--     GetLabelDetection returns a hierarchical taxonomy of detected
--     labels. For example, a detected car might be assigned the label car.
--     The label car has two parent labels: Vehicle (its parent) and
--     Transportation (its grandparent). The response includes the all
--     ancestors for a label, where every ancestor is a unique label. In
--     the previous example, Car, Vehicle, and Transportation are returned
--     as unique labels in the response.
--
-- -   Aliases - Possible Aliases for the label.
--
-- -   Categories - The label categories that the detected label belongs
--     to.
--
-- -   BoundingBox — Bounding boxes are described for all instances of
--     detected common object labels, returned in an array of Instance
--     objects. An Instance object contains a BoundingBox object,
--     describing the location of the label on the input image. It also
--     includes the confidence for the accuracy of the detected bounding
--     box.
--
-- -   Timestamp - Time, in milliseconds from the start of the video, that
--     the label was detected. For aggregation by @SEGMENTS@, the
--     @StartTimestampMillis@, @EndTimestampMillis@, and @DurationMillis@
--     structures are what define a segment. Although the “Timestamp”
--     structure is still returned with each label, its value is set to be
--     the same as @StartTimestampMillis@.
--
-- Timestamp and Bounding box information are returned for detected
-- Instances, only if aggregation is done by @TIMESTAMPS@. If aggregating
-- by @SEGMENTS@, information about detected instances isn’t returned.
--
-- The version of the label model used for the detection is also returned.
--
-- __Note @DominantColors@ isn\'t returned for @Instances@, although it is
-- shown as part of the response in the sample seen below.__
--
-- Use @MaxResults@ parameter to limit the number of labels returned. If
-- there are more results than specified in @MaxResults@, the value of
-- @NextToken@ in the operation response contains a pagination token for
-- getting the next set of results. To get the next page of results, call
-- @GetlabelDetection@ and populate the @NextToken@ request parameter with
-- the token value returned from the previous call to @GetLabelDetection@.
module Amazonka.Rekognition.GetLabelDetection
  ( -- * Creating a Request
    GetLabelDetection (..),
    newGetLabelDetection,

    -- * Request Lenses
    getLabelDetection_aggregateBy,
    getLabelDetection_maxResults,
    getLabelDetection_nextToken,
    getLabelDetection_sortBy,
    getLabelDetection_jobId,

    -- * Destructuring the Response
    GetLabelDetectionResponse (..),
    newGetLabelDetectionResponse,

    -- * Response Lenses
    getLabelDetectionResponse_jobStatus,
    getLabelDetectionResponse_labelModelVersion,
    getLabelDetectionResponse_labels,
    getLabelDetectionResponse_nextToken,
    getLabelDetectionResponse_statusMessage,
    getLabelDetectionResponse_videoMetadata,
    getLabelDetectionResponse_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:/ 'newGetLabelDetection' smart constructor.
data GetLabelDetection = GetLabelDetection'
  { -- | Defines how to aggregate the returned results. Results can be aggregated
    -- by timestamps or segments.
    GetLabelDetection -> Maybe LabelDetectionAggregateBy
aggregateBy :: Prelude.Maybe LabelDetectionAggregateBy,
    -- | Maximum number of results to return per paginated call. The largest
    -- value you can specify is 1000. If you specify a value greater than 1000,
    -- a maximum of 1000 results is returned. The default value is 1000.
    GetLabelDetection -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the previous response was incomplete (because there are more labels
    -- to retrieve), Amazon Rekognition Video returns a pagination token in the
    -- response. You can use this pagination token to retrieve the next set of
    -- labels.
    GetLabelDetection -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Sort to use for elements in the @Labels@ array. Use @TIMESTAMP@ to sort
    -- array elements by the time labels are detected. Use @NAME@ to
    -- alphabetically group elements for a label together. Within each label
    -- group, the array element are sorted by detection confidence. The default
    -- sort is by @TIMESTAMP@.
    GetLabelDetection -> Maybe LabelDetectionSortBy
sortBy :: Prelude.Maybe LabelDetectionSortBy,
    -- | Job identifier for the label detection operation for which you want
    -- results returned. You get the job identifer from an initial call to
    -- @StartlabelDetection@.
    GetLabelDetection -> Text
jobId :: Prelude.Text
  }
  deriving (GetLabelDetection -> GetLabelDetection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLabelDetection -> GetLabelDetection -> Bool
$c/= :: GetLabelDetection -> GetLabelDetection -> Bool
== :: GetLabelDetection -> GetLabelDetection -> Bool
$c== :: GetLabelDetection -> GetLabelDetection -> Bool
Prelude.Eq, ReadPrec [GetLabelDetection]
ReadPrec GetLabelDetection
Int -> ReadS GetLabelDetection
ReadS [GetLabelDetection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLabelDetection]
$creadListPrec :: ReadPrec [GetLabelDetection]
readPrec :: ReadPrec GetLabelDetection
$creadPrec :: ReadPrec GetLabelDetection
readList :: ReadS [GetLabelDetection]
$creadList :: ReadS [GetLabelDetection]
readsPrec :: Int -> ReadS GetLabelDetection
$creadsPrec :: Int -> ReadS GetLabelDetection
Prelude.Read, Int -> GetLabelDetection -> ShowS
[GetLabelDetection] -> ShowS
GetLabelDetection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLabelDetection] -> ShowS
$cshowList :: [GetLabelDetection] -> ShowS
show :: GetLabelDetection -> String
$cshow :: GetLabelDetection -> String
showsPrec :: Int -> GetLabelDetection -> ShowS
$cshowsPrec :: Int -> GetLabelDetection -> ShowS
Prelude.Show, forall x. Rep GetLabelDetection x -> GetLabelDetection
forall x. GetLabelDetection -> Rep GetLabelDetection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLabelDetection x -> GetLabelDetection
$cfrom :: forall x. GetLabelDetection -> Rep GetLabelDetection x
Prelude.Generic)

-- |
-- Create a value of 'GetLabelDetection' 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:
--
-- 'aggregateBy', 'getLabelDetection_aggregateBy' - Defines how to aggregate the returned results. Results can be aggregated
-- by timestamps or segments.
--
-- 'maxResults', 'getLabelDetection_maxResults' - Maximum number of results to return per paginated call. The largest
-- value you can specify is 1000. If you specify a value greater than 1000,
-- a maximum of 1000 results is returned. The default value is 1000.
--
-- 'nextToken', 'getLabelDetection_nextToken' - If the previous response was incomplete (because there are more labels
-- to retrieve), Amazon Rekognition Video returns a pagination token in the
-- response. You can use this pagination token to retrieve the next set of
-- labels.
--
-- 'sortBy', 'getLabelDetection_sortBy' - Sort to use for elements in the @Labels@ array. Use @TIMESTAMP@ to sort
-- array elements by the time labels are detected. Use @NAME@ to
-- alphabetically group elements for a label together. Within each label
-- group, the array element are sorted by detection confidence. The default
-- sort is by @TIMESTAMP@.
--
-- 'jobId', 'getLabelDetection_jobId' - Job identifier for the label detection operation for which you want
-- results returned. You get the job identifer from an initial call to
-- @StartlabelDetection@.
newGetLabelDetection ::
  -- | 'jobId'
  Prelude.Text ->
  GetLabelDetection
newGetLabelDetection :: Text -> GetLabelDetection
newGetLabelDetection Text
pJobId_ =
  GetLabelDetection'
    { $sel:aggregateBy:GetLabelDetection' :: Maybe LabelDetectionAggregateBy
aggregateBy = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetLabelDetection' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetLabelDetection' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:GetLabelDetection' :: Maybe LabelDetectionSortBy
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:GetLabelDetection' :: Text
jobId = Text
pJobId_
    }

-- | Defines how to aggregate the returned results. Results can be aggregated
-- by timestamps or segments.
getLabelDetection_aggregateBy :: Lens.Lens' GetLabelDetection (Prelude.Maybe LabelDetectionAggregateBy)
getLabelDetection_aggregateBy :: Lens' GetLabelDetection (Maybe LabelDetectionAggregateBy)
getLabelDetection_aggregateBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetection' {Maybe LabelDetectionAggregateBy
aggregateBy :: Maybe LabelDetectionAggregateBy
$sel:aggregateBy:GetLabelDetection' :: GetLabelDetection -> Maybe LabelDetectionAggregateBy
aggregateBy} -> Maybe LabelDetectionAggregateBy
aggregateBy) (\s :: GetLabelDetection
s@GetLabelDetection' {} Maybe LabelDetectionAggregateBy
a -> GetLabelDetection
s {$sel:aggregateBy:GetLabelDetection' :: Maybe LabelDetectionAggregateBy
aggregateBy = Maybe LabelDetectionAggregateBy
a} :: GetLabelDetection)

-- | Maximum number of results to return per paginated call. The largest
-- value you can specify is 1000. If you specify a value greater than 1000,
-- a maximum of 1000 results is returned. The default value is 1000.
getLabelDetection_maxResults :: Lens.Lens' GetLabelDetection (Prelude.Maybe Prelude.Natural)
getLabelDetection_maxResults :: Lens' GetLabelDetection (Maybe Natural)
getLabelDetection_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetection' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetLabelDetection' :: GetLabelDetection -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetLabelDetection
s@GetLabelDetection' {} Maybe Natural
a -> GetLabelDetection
s {$sel:maxResults:GetLabelDetection' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetLabelDetection)

-- | If the previous response was incomplete (because there are more labels
-- to retrieve), Amazon Rekognition Video returns a pagination token in the
-- response. You can use this pagination token to retrieve the next set of
-- labels.
getLabelDetection_nextToken :: Lens.Lens' GetLabelDetection (Prelude.Maybe Prelude.Text)
getLabelDetection_nextToken :: Lens' GetLabelDetection (Maybe Text)
getLabelDetection_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetection' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetLabelDetection' :: GetLabelDetection -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetLabelDetection
s@GetLabelDetection' {} Maybe Text
a -> GetLabelDetection
s {$sel:nextToken:GetLabelDetection' :: Maybe Text
nextToken = Maybe Text
a} :: GetLabelDetection)

-- | Sort to use for elements in the @Labels@ array. Use @TIMESTAMP@ to sort
-- array elements by the time labels are detected. Use @NAME@ to
-- alphabetically group elements for a label together. Within each label
-- group, the array element are sorted by detection confidence. The default
-- sort is by @TIMESTAMP@.
getLabelDetection_sortBy :: Lens.Lens' GetLabelDetection (Prelude.Maybe LabelDetectionSortBy)
getLabelDetection_sortBy :: Lens' GetLabelDetection (Maybe LabelDetectionSortBy)
getLabelDetection_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetection' {Maybe LabelDetectionSortBy
sortBy :: Maybe LabelDetectionSortBy
$sel:sortBy:GetLabelDetection' :: GetLabelDetection -> Maybe LabelDetectionSortBy
sortBy} -> Maybe LabelDetectionSortBy
sortBy) (\s :: GetLabelDetection
s@GetLabelDetection' {} Maybe LabelDetectionSortBy
a -> GetLabelDetection
s {$sel:sortBy:GetLabelDetection' :: Maybe LabelDetectionSortBy
sortBy = Maybe LabelDetectionSortBy
a} :: GetLabelDetection)

-- | Job identifier for the label detection operation for which you want
-- results returned. You get the job identifer from an initial call to
-- @StartlabelDetection@.
getLabelDetection_jobId :: Lens.Lens' GetLabelDetection Prelude.Text
getLabelDetection_jobId :: Lens' GetLabelDetection Text
getLabelDetection_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetection' {Text
jobId :: Text
$sel:jobId:GetLabelDetection' :: GetLabelDetection -> Text
jobId} -> Text
jobId) (\s :: GetLabelDetection
s@GetLabelDetection' {} Text
a -> GetLabelDetection
s {$sel:jobId:GetLabelDetection' :: Text
jobId = Text
a} :: GetLabelDetection)

instance Core.AWSRequest GetLabelDetection where
  type
    AWSResponse GetLabelDetection =
      GetLabelDetectionResponse
  request :: (Service -> Service)
-> GetLabelDetection -> Request GetLabelDetection
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 GetLabelDetection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetLabelDetection)))
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 VideoJobStatus
-> Maybe Text
-> Maybe [LabelDetection]
-> Maybe Text
-> Maybe Text
-> Maybe VideoMetadata
-> Int
-> GetLabelDetectionResponse
GetLabelDetectionResponse'
            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
"JobStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LabelModelVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Labels" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StatusMessage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VideoMetadata")
            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 GetLabelDetection where
  hashWithSalt :: Int -> GetLabelDetection -> Int
hashWithSalt Int
_salt GetLabelDetection' {Maybe Natural
Maybe Text
Maybe LabelDetectionAggregateBy
Maybe LabelDetectionSortBy
Text
jobId :: Text
sortBy :: Maybe LabelDetectionSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
aggregateBy :: Maybe LabelDetectionAggregateBy
$sel:jobId:GetLabelDetection' :: GetLabelDetection -> Text
$sel:sortBy:GetLabelDetection' :: GetLabelDetection -> Maybe LabelDetectionSortBy
$sel:nextToken:GetLabelDetection' :: GetLabelDetection -> Maybe Text
$sel:maxResults:GetLabelDetection' :: GetLabelDetection -> Maybe Natural
$sel:aggregateBy:GetLabelDetection' :: GetLabelDetection -> Maybe LabelDetectionAggregateBy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LabelDetectionAggregateBy
aggregateBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LabelDetectionSortBy
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

instance Prelude.NFData GetLabelDetection where
  rnf :: GetLabelDetection -> ()
rnf GetLabelDetection' {Maybe Natural
Maybe Text
Maybe LabelDetectionAggregateBy
Maybe LabelDetectionSortBy
Text
jobId :: Text
sortBy :: Maybe LabelDetectionSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
aggregateBy :: Maybe LabelDetectionAggregateBy
$sel:jobId:GetLabelDetection' :: GetLabelDetection -> Text
$sel:sortBy:GetLabelDetection' :: GetLabelDetection -> Maybe LabelDetectionSortBy
$sel:nextToken:GetLabelDetection' :: GetLabelDetection -> Maybe Text
$sel:maxResults:GetLabelDetection' :: GetLabelDetection -> Maybe Natural
$sel:aggregateBy:GetLabelDetection' :: GetLabelDetection -> Maybe LabelDetectionAggregateBy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe LabelDetectionAggregateBy
aggregateBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LabelDetectionSortBy
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobId

instance Data.ToHeaders GetLabelDetection where
  toHeaders :: GetLabelDetection -> 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.GetLabelDetection" ::
                          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 GetLabelDetection where
  toJSON :: GetLabelDetection -> Value
toJSON GetLabelDetection' {Maybe Natural
Maybe Text
Maybe LabelDetectionAggregateBy
Maybe LabelDetectionSortBy
Text
jobId :: Text
sortBy :: Maybe LabelDetectionSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
aggregateBy :: Maybe LabelDetectionAggregateBy
$sel:jobId:GetLabelDetection' :: GetLabelDetection -> Text
$sel:sortBy:GetLabelDetection' :: GetLabelDetection -> Maybe LabelDetectionSortBy
$sel:nextToken:GetLabelDetection' :: GetLabelDetection -> Maybe Text
$sel:maxResults:GetLabelDetection' :: GetLabelDetection -> Maybe Natural
$sel:aggregateBy:GetLabelDetection' :: GetLabelDetection -> Maybe LabelDetectionAggregateBy
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AggregateBy" 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 LabelDetectionAggregateBy
aggregateBy,
            (Key
"MaxResults" 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 Natural
maxResults,
            (Key
"NextToken" 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
nextToken,
            (Key
"SortBy" 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 LabelDetectionSortBy
sortBy,
            forall a. a -> Maybe a
Prelude.Just (Key
"JobId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobId)
          ]
      )

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

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

-- | /See:/ 'newGetLabelDetectionResponse' smart constructor.
data GetLabelDetectionResponse = GetLabelDetectionResponse'
  { -- | The current status of the label detection job.
    GetLabelDetectionResponse -> Maybe VideoJobStatus
jobStatus :: Prelude.Maybe VideoJobStatus,
    -- | Version number of the label detection model that was used to detect
    -- labels.
    GetLabelDetectionResponse -> Maybe Text
labelModelVersion :: Prelude.Maybe Prelude.Text,
    -- | An array of labels detected in the video. Each element contains the
    -- detected label and the time, in milliseconds from the start of the
    -- video, that the label was detected.
    GetLabelDetectionResponse -> Maybe [LabelDetection]
labels :: Prelude.Maybe [LabelDetection],
    -- | If the response is truncated, Amazon Rekognition Video returns this
    -- token that you can use in the subsequent request to retrieve the next
    -- set of labels.
    GetLabelDetectionResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | If the job fails, @StatusMessage@ provides a descriptive error message.
    GetLabelDetectionResponse -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | Information about a video that Amazon Rekognition Video analyzed.
    -- @Videometadata@ is returned in every page of paginated responses from a
    -- Amazon Rekognition video operation.
    GetLabelDetectionResponse -> Maybe VideoMetadata
videoMetadata :: Prelude.Maybe VideoMetadata,
    -- | The response's http status code.
    GetLabelDetectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetLabelDetectionResponse -> GetLabelDetectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLabelDetectionResponse -> GetLabelDetectionResponse -> Bool
$c/= :: GetLabelDetectionResponse -> GetLabelDetectionResponse -> Bool
== :: GetLabelDetectionResponse -> GetLabelDetectionResponse -> Bool
$c== :: GetLabelDetectionResponse -> GetLabelDetectionResponse -> Bool
Prelude.Eq, ReadPrec [GetLabelDetectionResponse]
ReadPrec GetLabelDetectionResponse
Int -> ReadS GetLabelDetectionResponse
ReadS [GetLabelDetectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLabelDetectionResponse]
$creadListPrec :: ReadPrec [GetLabelDetectionResponse]
readPrec :: ReadPrec GetLabelDetectionResponse
$creadPrec :: ReadPrec GetLabelDetectionResponse
readList :: ReadS [GetLabelDetectionResponse]
$creadList :: ReadS [GetLabelDetectionResponse]
readsPrec :: Int -> ReadS GetLabelDetectionResponse
$creadsPrec :: Int -> ReadS GetLabelDetectionResponse
Prelude.Read, Int -> GetLabelDetectionResponse -> ShowS
[GetLabelDetectionResponse] -> ShowS
GetLabelDetectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLabelDetectionResponse] -> ShowS
$cshowList :: [GetLabelDetectionResponse] -> ShowS
show :: GetLabelDetectionResponse -> String
$cshow :: GetLabelDetectionResponse -> String
showsPrec :: Int -> GetLabelDetectionResponse -> ShowS
$cshowsPrec :: Int -> GetLabelDetectionResponse -> ShowS
Prelude.Show, forall x.
Rep GetLabelDetectionResponse x -> GetLabelDetectionResponse
forall x.
GetLabelDetectionResponse -> Rep GetLabelDetectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetLabelDetectionResponse x -> GetLabelDetectionResponse
$cfrom :: forall x.
GetLabelDetectionResponse -> Rep GetLabelDetectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetLabelDetectionResponse' 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:
--
-- 'jobStatus', 'getLabelDetectionResponse_jobStatus' - The current status of the label detection job.
--
-- 'labelModelVersion', 'getLabelDetectionResponse_labelModelVersion' - Version number of the label detection model that was used to detect
-- labels.
--
-- 'labels', 'getLabelDetectionResponse_labels' - An array of labels detected in the video. Each element contains the
-- detected label and the time, in milliseconds from the start of the
-- video, that the label was detected.
--
-- 'nextToken', 'getLabelDetectionResponse_nextToken' - If the response is truncated, Amazon Rekognition Video returns this
-- token that you can use in the subsequent request to retrieve the next
-- set of labels.
--
-- 'statusMessage', 'getLabelDetectionResponse_statusMessage' - If the job fails, @StatusMessage@ provides a descriptive error message.
--
-- 'videoMetadata', 'getLabelDetectionResponse_videoMetadata' - Information about a video that Amazon Rekognition Video analyzed.
-- @Videometadata@ is returned in every page of paginated responses from a
-- Amazon Rekognition video operation.
--
-- 'httpStatus', 'getLabelDetectionResponse_httpStatus' - The response's http status code.
newGetLabelDetectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetLabelDetectionResponse
newGetLabelDetectionResponse :: Int -> GetLabelDetectionResponse
newGetLabelDetectionResponse Int
pHttpStatus_ =
  GetLabelDetectionResponse'
    { $sel:jobStatus:GetLabelDetectionResponse' :: Maybe VideoJobStatus
jobStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:labelModelVersion:GetLabelDetectionResponse' :: Maybe Text
labelModelVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:labels:GetLabelDetectionResponse' :: Maybe [LabelDetection]
labels = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetLabelDetectionResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:GetLabelDetectionResponse' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:videoMetadata:GetLabelDetectionResponse' :: Maybe VideoMetadata
videoMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetLabelDetectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The current status of the label detection job.
getLabelDetectionResponse_jobStatus :: Lens.Lens' GetLabelDetectionResponse (Prelude.Maybe VideoJobStatus)
getLabelDetectionResponse_jobStatus :: Lens' GetLabelDetectionResponse (Maybe VideoJobStatus)
getLabelDetectionResponse_jobStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetectionResponse' {Maybe VideoJobStatus
jobStatus :: Maybe VideoJobStatus
$sel:jobStatus:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe VideoJobStatus
jobStatus} -> Maybe VideoJobStatus
jobStatus) (\s :: GetLabelDetectionResponse
s@GetLabelDetectionResponse' {} Maybe VideoJobStatus
a -> GetLabelDetectionResponse
s {$sel:jobStatus:GetLabelDetectionResponse' :: Maybe VideoJobStatus
jobStatus = Maybe VideoJobStatus
a} :: GetLabelDetectionResponse)

-- | Version number of the label detection model that was used to detect
-- labels.
getLabelDetectionResponse_labelModelVersion :: Lens.Lens' GetLabelDetectionResponse (Prelude.Maybe Prelude.Text)
getLabelDetectionResponse_labelModelVersion :: Lens' GetLabelDetectionResponse (Maybe Text)
getLabelDetectionResponse_labelModelVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetectionResponse' {Maybe Text
labelModelVersion :: Maybe Text
$sel:labelModelVersion:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe Text
labelModelVersion} -> Maybe Text
labelModelVersion) (\s :: GetLabelDetectionResponse
s@GetLabelDetectionResponse' {} Maybe Text
a -> GetLabelDetectionResponse
s {$sel:labelModelVersion:GetLabelDetectionResponse' :: Maybe Text
labelModelVersion = Maybe Text
a} :: GetLabelDetectionResponse)

-- | An array of labels detected in the video. Each element contains the
-- detected label and the time, in milliseconds from the start of the
-- video, that the label was detected.
getLabelDetectionResponse_labels :: Lens.Lens' GetLabelDetectionResponse (Prelude.Maybe [LabelDetection])
getLabelDetectionResponse_labels :: Lens' GetLabelDetectionResponse (Maybe [LabelDetection])
getLabelDetectionResponse_labels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetectionResponse' {Maybe [LabelDetection]
labels :: Maybe [LabelDetection]
$sel:labels:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe [LabelDetection]
labels} -> Maybe [LabelDetection]
labels) (\s :: GetLabelDetectionResponse
s@GetLabelDetectionResponse' {} Maybe [LabelDetection]
a -> GetLabelDetectionResponse
s {$sel:labels:GetLabelDetectionResponse' :: Maybe [LabelDetection]
labels = Maybe [LabelDetection]
a} :: GetLabelDetectionResponse) 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

-- | If the response is truncated, Amazon Rekognition Video returns this
-- token that you can use in the subsequent request to retrieve the next
-- set of labels.
getLabelDetectionResponse_nextToken :: Lens.Lens' GetLabelDetectionResponse (Prelude.Maybe Prelude.Text)
getLabelDetectionResponse_nextToken :: Lens' GetLabelDetectionResponse (Maybe Text)
getLabelDetectionResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetectionResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetLabelDetectionResponse
s@GetLabelDetectionResponse' {} Maybe Text
a -> GetLabelDetectionResponse
s {$sel:nextToken:GetLabelDetectionResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetLabelDetectionResponse)

-- | If the job fails, @StatusMessage@ provides a descriptive error message.
getLabelDetectionResponse_statusMessage :: Lens.Lens' GetLabelDetectionResponse (Prelude.Maybe Prelude.Text)
getLabelDetectionResponse_statusMessage :: Lens' GetLabelDetectionResponse (Maybe Text)
getLabelDetectionResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetectionResponse' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: GetLabelDetectionResponse
s@GetLabelDetectionResponse' {} Maybe Text
a -> GetLabelDetectionResponse
s {$sel:statusMessage:GetLabelDetectionResponse' :: Maybe Text
statusMessage = Maybe Text
a} :: GetLabelDetectionResponse)

-- | Information about a video that Amazon Rekognition Video analyzed.
-- @Videometadata@ is returned in every page of paginated responses from a
-- Amazon Rekognition video operation.
getLabelDetectionResponse_videoMetadata :: Lens.Lens' GetLabelDetectionResponse (Prelude.Maybe VideoMetadata)
getLabelDetectionResponse_videoMetadata :: Lens' GetLabelDetectionResponse (Maybe VideoMetadata)
getLabelDetectionResponse_videoMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLabelDetectionResponse' {Maybe VideoMetadata
videoMetadata :: Maybe VideoMetadata
$sel:videoMetadata:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe VideoMetadata
videoMetadata} -> Maybe VideoMetadata
videoMetadata) (\s :: GetLabelDetectionResponse
s@GetLabelDetectionResponse' {} Maybe VideoMetadata
a -> GetLabelDetectionResponse
s {$sel:videoMetadata:GetLabelDetectionResponse' :: Maybe VideoMetadata
videoMetadata = Maybe VideoMetadata
a} :: GetLabelDetectionResponse)

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

instance Prelude.NFData GetLabelDetectionResponse where
  rnf :: GetLabelDetectionResponse -> ()
rnf GetLabelDetectionResponse' {Int
Maybe [LabelDetection]
Maybe Text
Maybe VideoJobStatus
Maybe VideoMetadata
httpStatus :: Int
videoMetadata :: Maybe VideoMetadata
statusMessage :: Maybe Text
nextToken :: Maybe Text
labels :: Maybe [LabelDetection]
labelModelVersion :: Maybe Text
jobStatus :: Maybe VideoJobStatus
$sel:httpStatus:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Int
$sel:videoMetadata:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe VideoMetadata
$sel:statusMessage:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe Text
$sel:nextToken:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe Text
$sel:labels:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe [LabelDetection]
$sel:labelModelVersion:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe Text
$sel:jobStatus:GetLabelDetectionResponse' :: GetLabelDetectionResponse -> Maybe VideoJobStatus
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe VideoJobStatus
jobStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
labelModelVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [LabelDetection]
labels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VideoMetadata
videoMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus