{-# 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.GetFaceDetection
-- 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 face detection results for a Amazon Rekognition Video analysis
-- started by StartFaceDetection.
--
-- Face detection with Amazon Rekognition Video is an asynchronous
-- operation. You start face detection by calling StartFaceDetection which
-- returns a job identifier (@JobId@). When the face detection operation
-- finishes, Amazon Rekognition Video publishes a completion status to the
-- Amazon Simple Notification Service topic registered in the initial call
-- to @StartFaceDetection@. To get the results of the face detection
-- operation, first check that the status value published to the Amazon SNS
-- topic is @SUCCEEDED@. If so, call GetFaceDetection and pass the job
-- identifier (@JobId@) from the initial call to @StartFaceDetection@.
--
-- @GetFaceDetection@ returns an array of detected faces (@Faces@) sorted
-- by the time the faces were detected.
--
-- 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
-- @GetFaceDetection@ and populate the @NextToken@ request parameter with
-- the token value returned from the previous call to @GetFaceDetection@.
module Amazonka.Rekognition.GetFaceDetection
  ( -- * Creating a Request
    GetFaceDetection (..),
    newGetFaceDetection,

    -- * Request Lenses
    getFaceDetection_maxResults,
    getFaceDetection_nextToken,
    getFaceDetection_jobId,

    -- * Destructuring the Response
    GetFaceDetectionResponse (..),
    newGetFaceDetectionResponse,

    -- * Response Lenses
    getFaceDetectionResponse_faces,
    getFaceDetectionResponse_jobStatus,
    getFaceDetectionResponse_nextToken,
    getFaceDetectionResponse_statusMessage,
    getFaceDetectionResponse_videoMetadata,
    getFaceDetectionResponse_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:/ 'newGetFaceDetection' smart constructor.
data GetFaceDetection = GetFaceDetection'
  { -- | 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.
    GetFaceDetection -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the previous response was incomplete (because there are more faces to
    -- retrieve), Amazon Rekognition Video returns a pagination token in the
    -- response. You can use this pagination token to retrieve the next set of
    -- faces.
    GetFaceDetection -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Unique identifier for the face detection job. The @JobId@ is returned
    -- from @StartFaceDetection@.
    GetFaceDetection -> Text
jobId :: Prelude.Text
  }
  deriving (GetFaceDetection -> GetFaceDetection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFaceDetection -> GetFaceDetection -> Bool
$c/= :: GetFaceDetection -> GetFaceDetection -> Bool
== :: GetFaceDetection -> GetFaceDetection -> Bool
$c== :: GetFaceDetection -> GetFaceDetection -> Bool
Prelude.Eq, ReadPrec [GetFaceDetection]
ReadPrec GetFaceDetection
Int -> ReadS GetFaceDetection
ReadS [GetFaceDetection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFaceDetection]
$creadListPrec :: ReadPrec [GetFaceDetection]
readPrec :: ReadPrec GetFaceDetection
$creadPrec :: ReadPrec GetFaceDetection
readList :: ReadS [GetFaceDetection]
$creadList :: ReadS [GetFaceDetection]
readsPrec :: Int -> ReadS GetFaceDetection
$creadsPrec :: Int -> ReadS GetFaceDetection
Prelude.Read, Int -> GetFaceDetection -> ShowS
[GetFaceDetection] -> ShowS
GetFaceDetection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFaceDetection] -> ShowS
$cshowList :: [GetFaceDetection] -> ShowS
show :: GetFaceDetection -> String
$cshow :: GetFaceDetection -> String
showsPrec :: Int -> GetFaceDetection -> ShowS
$cshowsPrec :: Int -> GetFaceDetection -> ShowS
Prelude.Show, forall x. Rep GetFaceDetection x -> GetFaceDetection
forall x. GetFaceDetection -> Rep GetFaceDetection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetFaceDetection x -> GetFaceDetection
$cfrom :: forall x. GetFaceDetection -> Rep GetFaceDetection x
Prelude.Generic)

-- |
-- Create a value of 'GetFaceDetection' 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:
--
-- 'maxResults', 'getFaceDetection_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', 'getFaceDetection_nextToken' - If the previous response was incomplete (because there are more faces to
-- retrieve), Amazon Rekognition Video returns a pagination token in the
-- response. You can use this pagination token to retrieve the next set of
-- faces.
--
-- 'jobId', 'getFaceDetection_jobId' - Unique identifier for the face detection job. The @JobId@ is returned
-- from @StartFaceDetection@.
newGetFaceDetection ::
  -- | 'jobId'
  Prelude.Text ->
  GetFaceDetection
newGetFaceDetection :: Text -> GetFaceDetection
newGetFaceDetection Text
pJobId_ =
  GetFaceDetection'
    { $sel:maxResults:GetFaceDetection' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetFaceDetection' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:GetFaceDetection' :: Text
jobId = Text
pJobId_
    }

-- | 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.
getFaceDetection_maxResults :: Lens.Lens' GetFaceDetection (Prelude.Maybe Prelude.Natural)
getFaceDetection_maxResults :: Lens' GetFaceDetection (Maybe Natural)
getFaceDetection_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFaceDetection' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetFaceDetection' :: GetFaceDetection -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetFaceDetection
s@GetFaceDetection' {} Maybe Natural
a -> GetFaceDetection
s {$sel:maxResults:GetFaceDetection' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetFaceDetection)

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

-- | Unique identifier for the face detection job. The @JobId@ is returned
-- from @StartFaceDetection@.
getFaceDetection_jobId :: Lens.Lens' GetFaceDetection Prelude.Text
getFaceDetection_jobId :: Lens' GetFaceDetection Text
getFaceDetection_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFaceDetection' {Text
jobId :: Text
$sel:jobId:GetFaceDetection' :: GetFaceDetection -> Text
jobId} -> Text
jobId) (\s :: GetFaceDetection
s@GetFaceDetection' {} Text
a -> GetFaceDetection
s {$sel:jobId:GetFaceDetection' :: Text
jobId = Text
a} :: GetFaceDetection)

instance Core.AWSRequest GetFaceDetection where
  type
    AWSResponse GetFaceDetection =
      GetFaceDetectionResponse
  request :: (Service -> Service)
-> GetFaceDetection -> Request GetFaceDetection
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 GetFaceDetection
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetFaceDetection)))
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 [FaceDetection]
-> Maybe VideoJobStatus
-> Maybe Text
-> Maybe Text
-> Maybe VideoMetadata
-> Int
-> GetFaceDetectionResponse
GetFaceDetectionResponse'
            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
"Faces" 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
"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
"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 GetFaceDetection where
  hashWithSalt :: Int -> GetFaceDetection -> Int
hashWithSalt Int
_salt GetFaceDetection' {Maybe Natural
Maybe Text
Text
jobId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:jobId:GetFaceDetection' :: GetFaceDetection -> Text
$sel:nextToken:GetFaceDetection' :: GetFaceDetection -> Maybe Text
$sel:maxResults:GetFaceDetection' :: GetFaceDetection -> Maybe Natural
..} =
    Int
_salt
      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` Text
jobId

instance Prelude.NFData GetFaceDetection where
  rnf :: GetFaceDetection -> ()
rnf GetFaceDetection' {Maybe Natural
Maybe Text
Text
jobId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:jobId:GetFaceDetection' :: GetFaceDetection -> Text
$sel:nextToken:GetFaceDetection' :: GetFaceDetection -> Maybe Text
$sel:maxResults:GetFaceDetection' :: GetFaceDetection -> Maybe Natural
..} =
    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 Text
jobId

instance Data.ToHeaders GetFaceDetection where
  toHeaders :: GetFaceDetection -> 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.GetFaceDetection" ::
                          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 GetFaceDetection where
  toJSON :: GetFaceDetection -> Value
toJSON GetFaceDetection' {Maybe Natural
Maybe Text
Text
jobId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:jobId:GetFaceDetection' :: GetFaceDetection -> Text
$sel:nextToken:GetFaceDetection' :: GetFaceDetection -> Maybe Text
$sel:maxResults:GetFaceDetection' :: GetFaceDetection -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            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 GetFaceDetection where
  toPath :: GetFaceDetection -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newGetFaceDetectionResponse' smart constructor.
data GetFaceDetectionResponse = GetFaceDetectionResponse'
  { -- | An array of faces detected in the video. Each element contains a
    -- detected face\'s details and the time, in milliseconds from the start of
    -- the video, the face was detected.
    GetFaceDetectionResponse -> Maybe [FaceDetection]
faces :: Prelude.Maybe [FaceDetection],
    -- | The current status of the face detection job.
    GetFaceDetectionResponse -> Maybe VideoJobStatus
jobStatus :: Prelude.Maybe VideoJobStatus,
    -- | If the response is truncated, Amazon Rekognition returns this token that
    -- you can use in the subsequent request to retrieve the next set of faces.
    GetFaceDetectionResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | If the job fails, @StatusMessage@ provides a descriptive error message.
    GetFaceDetectionResponse -> 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.
    GetFaceDetectionResponse -> Maybe VideoMetadata
videoMetadata :: Prelude.Maybe VideoMetadata,
    -- | The response's http status code.
    GetFaceDetectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetFaceDetectionResponse -> GetFaceDetectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFaceDetectionResponse -> GetFaceDetectionResponse -> Bool
$c/= :: GetFaceDetectionResponse -> GetFaceDetectionResponse -> Bool
== :: GetFaceDetectionResponse -> GetFaceDetectionResponse -> Bool
$c== :: GetFaceDetectionResponse -> GetFaceDetectionResponse -> Bool
Prelude.Eq, ReadPrec [GetFaceDetectionResponse]
ReadPrec GetFaceDetectionResponse
Int -> ReadS GetFaceDetectionResponse
ReadS [GetFaceDetectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFaceDetectionResponse]
$creadListPrec :: ReadPrec [GetFaceDetectionResponse]
readPrec :: ReadPrec GetFaceDetectionResponse
$creadPrec :: ReadPrec GetFaceDetectionResponse
readList :: ReadS [GetFaceDetectionResponse]
$creadList :: ReadS [GetFaceDetectionResponse]
readsPrec :: Int -> ReadS GetFaceDetectionResponse
$creadsPrec :: Int -> ReadS GetFaceDetectionResponse
Prelude.Read, Int -> GetFaceDetectionResponse -> ShowS
[GetFaceDetectionResponse] -> ShowS
GetFaceDetectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFaceDetectionResponse] -> ShowS
$cshowList :: [GetFaceDetectionResponse] -> ShowS
show :: GetFaceDetectionResponse -> String
$cshow :: GetFaceDetectionResponse -> String
showsPrec :: Int -> GetFaceDetectionResponse -> ShowS
$cshowsPrec :: Int -> GetFaceDetectionResponse -> ShowS
Prelude.Show, forall x.
Rep GetFaceDetectionResponse x -> GetFaceDetectionResponse
forall x.
GetFaceDetectionResponse -> Rep GetFaceDetectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetFaceDetectionResponse x -> GetFaceDetectionResponse
$cfrom :: forall x.
GetFaceDetectionResponse -> Rep GetFaceDetectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetFaceDetectionResponse' 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:
--
-- 'faces', 'getFaceDetectionResponse_faces' - An array of faces detected in the video. Each element contains a
-- detected face\'s details and the time, in milliseconds from the start of
-- the video, the face was detected.
--
-- 'jobStatus', 'getFaceDetectionResponse_jobStatus' - The current status of the face detection job.
--
-- 'nextToken', 'getFaceDetectionResponse_nextToken' - If the response is truncated, Amazon Rekognition returns this token that
-- you can use in the subsequent request to retrieve the next set of faces.
--
-- 'statusMessage', 'getFaceDetectionResponse_statusMessage' - If the job fails, @StatusMessage@ provides a descriptive error message.
--
-- 'videoMetadata', 'getFaceDetectionResponse_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', 'getFaceDetectionResponse_httpStatus' - The response's http status code.
newGetFaceDetectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetFaceDetectionResponse
newGetFaceDetectionResponse :: Int -> GetFaceDetectionResponse
newGetFaceDetectionResponse Int
pHttpStatus_ =
  GetFaceDetectionResponse'
    { $sel:faces:GetFaceDetectionResponse' :: Maybe [FaceDetection]
faces = forall a. Maybe a
Prelude.Nothing,
      $sel:jobStatus:GetFaceDetectionResponse' :: Maybe VideoJobStatus
jobStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetFaceDetectionResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:GetFaceDetectionResponse' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:videoMetadata:GetFaceDetectionResponse' :: Maybe VideoMetadata
videoMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetFaceDetectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

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

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

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

instance Prelude.NFData GetFaceDetectionResponse where
  rnf :: GetFaceDetectionResponse -> ()
rnf GetFaceDetectionResponse' {Int
Maybe [FaceDetection]
Maybe Text
Maybe VideoJobStatus
Maybe VideoMetadata
httpStatus :: Int
videoMetadata :: Maybe VideoMetadata
statusMessage :: Maybe Text
nextToken :: Maybe Text
jobStatus :: Maybe VideoJobStatus
faces :: Maybe [FaceDetection]
$sel:httpStatus:GetFaceDetectionResponse' :: GetFaceDetectionResponse -> Int
$sel:videoMetadata:GetFaceDetectionResponse' :: GetFaceDetectionResponse -> Maybe VideoMetadata
$sel:statusMessage:GetFaceDetectionResponse' :: GetFaceDetectionResponse -> Maybe Text
$sel:nextToken:GetFaceDetectionResponse' :: GetFaceDetectionResponse -> Maybe Text
$sel:jobStatus:GetFaceDetectionResponse' :: GetFaceDetectionResponse -> Maybe VideoJobStatus
$sel:faces:GetFaceDetectionResponse' :: GetFaceDetectionResponse -> Maybe [FaceDetection]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FaceDetection]
faces
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
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