{-# 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.RecognizeCelebrities
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns an array of celebrities recognized in the input image. For more
-- information, see Recognizing celebrities in the Amazon Rekognition
-- Developer Guide.
--
-- @RecognizeCelebrities@ returns the 64 largest faces in the image. It
-- lists the recognized celebrities in the @CelebrityFaces@ array and any
-- unrecognized faces in the @UnrecognizedFaces@ array.
-- @RecognizeCelebrities@ doesn\'t return celebrities whose faces aren\'t
-- among the largest 64 faces in the image.
--
-- For each celebrity recognized, @RecognizeCelebrities@ returns a
-- @Celebrity@ object. The @Celebrity@ object contains the celebrity name,
-- ID, URL links to additional information, match confidence, and a
-- @ComparedFace@ object that you can use to locate the celebrity\'s face
-- on the image.
--
-- Amazon Rekognition doesn\'t retain information about which images a
-- celebrity has been recognized in. Your application must store this
-- information and use the @Celebrity@ ID property as a unique identifier
-- for the celebrity. If you don\'t store the celebrity name or additional
-- information URLs returned by @RecognizeCelebrities@, you will need the
-- ID to identify the celebrity in a call to the GetCelebrityInfo
-- operation.
--
-- You pass the input image either as base64-encoded image bytes or as a
-- reference to an image in an Amazon S3 bucket. If you use the AWS CLI to
-- call Amazon Rekognition operations, passing image bytes is not
-- supported. The image must be either a PNG or JPEG formatted file.
--
-- For an example, see Recognizing celebrities in an image in the Amazon
-- Rekognition Developer Guide.
--
-- This operation requires permissions to perform the
-- @rekognition:RecognizeCelebrities@ operation.
module Amazonka.Rekognition.RecognizeCelebrities
  ( -- * Creating a Request
    RecognizeCelebrities (..),
    newRecognizeCelebrities,

    -- * Request Lenses
    recognizeCelebrities_image,

    -- * Destructuring the Response
    RecognizeCelebritiesResponse (..),
    newRecognizeCelebritiesResponse,

    -- * Response Lenses
    recognizeCelebritiesResponse_celebrityFaces,
    recognizeCelebritiesResponse_orientationCorrection,
    recognizeCelebritiesResponse_unrecognizedFaces,
    recognizeCelebritiesResponse_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:/ 'newRecognizeCelebrities' smart constructor.
data RecognizeCelebrities = RecognizeCelebrities'
  { -- | The input image as base64-encoded bytes or an S3 object. If you use the
    -- AWS CLI to call Amazon Rekognition operations, passing base64-encoded
    -- image bytes is not supported.
    --
    -- If you are using an AWS SDK to call Amazon Rekognition, you might not
    -- need to base64-encode image bytes passed using the @Bytes@ field. For
    -- more information, see Images in the Amazon Rekognition developer guide.
    RecognizeCelebrities -> Image
image :: Image
  }
  deriving (RecognizeCelebrities -> RecognizeCelebrities -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecognizeCelebrities -> RecognizeCelebrities -> Bool
$c/= :: RecognizeCelebrities -> RecognizeCelebrities -> Bool
== :: RecognizeCelebrities -> RecognizeCelebrities -> Bool
$c== :: RecognizeCelebrities -> RecognizeCelebrities -> Bool
Prelude.Eq, ReadPrec [RecognizeCelebrities]
ReadPrec RecognizeCelebrities
Int -> ReadS RecognizeCelebrities
ReadS [RecognizeCelebrities]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecognizeCelebrities]
$creadListPrec :: ReadPrec [RecognizeCelebrities]
readPrec :: ReadPrec RecognizeCelebrities
$creadPrec :: ReadPrec RecognizeCelebrities
readList :: ReadS [RecognizeCelebrities]
$creadList :: ReadS [RecognizeCelebrities]
readsPrec :: Int -> ReadS RecognizeCelebrities
$creadsPrec :: Int -> ReadS RecognizeCelebrities
Prelude.Read, Int -> RecognizeCelebrities -> ShowS
[RecognizeCelebrities] -> ShowS
RecognizeCelebrities -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecognizeCelebrities] -> ShowS
$cshowList :: [RecognizeCelebrities] -> ShowS
show :: RecognizeCelebrities -> String
$cshow :: RecognizeCelebrities -> String
showsPrec :: Int -> RecognizeCelebrities -> ShowS
$cshowsPrec :: Int -> RecognizeCelebrities -> ShowS
Prelude.Show, forall x. Rep RecognizeCelebrities x -> RecognizeCelebrities
forall x. RecognizeCelebrities -> Rep RecognizeCelebrities x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RecognizeCelebrities x -> RecognizeCelebrities
$cfrom :: forall x. RecognizeCelebrities -> Rep RecognizeCelebrities x
Prelude.Generic)

-- |
-- Create a value of 'RecognizeCelebrities' 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:
--
-- 'image', 'recognizeCelebrities_image' - The input image as base64-encoded bytes or an S3 object. If you use the
-- AWS CLI to call Amazon Rekognition operations, passing base64-encoded
-- image bytes is not supported.
--
-- If you are using an AWS SDK to call Amazon Rekognition, you might not
-- need to base64-encode image bytes passed using the @Bytes@ field. For
-- more information, see Images in the Amazon Rekognition developer guide.
newRecognizeCelebrities ::
  -- | 'image'
  Image ->
  RecognizeCelebrities
newRecognizeCelebrities :: Image -> RecognizeCelebrities
newRecognizeCelebrities Image
pImage_ =
  RecognizeCelebrities' {$sel:image:RecognizeCelebrities' :: Image
image = Image
pImage_}

-- | The input image as base64-encoded bytes or an S3 object. If you use the
-- AWS CLI to call Amazon Rekognition operations, passing base64-encoded
-- image bytes is not supported.
--
-- If you are using an AWS SDK to call Amazon Rekognition, you might not
-- need to base64-encode image bytes passed using the @Bytes@ field. For
-- more information, see Images in the Amazon Rekognition developer guide.
recognizeCelebrities_image :: Lens.Lens' RecognizeCelebrities Image
recognizeCelebrities_image :: Lens' RecognizeCelebrities Image
recognizeCelebrities_image = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecognizeCelebrities' {Image
image :: Image
$sel:image:RecognizeCelebrities' :: RecognizeCelebrities -> Image
image} -> Image
image) (\s :: RecognizeCelebrities
s@RecognizeCelebrities' {} Image
a -> RecognizeCelebrities
s {$sel:image:RecognizeCelebrities' :: Image
image = Image
a} :: RecognizeCelebrities)

instance Core.AWSRequest RecognizeCelebrities where
  type
    AWSResponse RecognizeCelebrities =
      RecognizeCelebritiesResponse
  request :: (Service -> Service)
-> RecognizeCelebrities -> Request RecognizeCelebrities
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 RecognizeCelebrities
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RecognizeCelebrities)))
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 [Celebrity]
-> Maybe OrientationCorrection
-> Maybe [ComparedFace]
-> Int
-> RecognizeCelebritiesResponse
RecognizeCelebritiesResponse'
            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
"CelebrityFaces" 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
"OrientationCorrection")
            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
"UnrecognizedFaces"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable RecognizeCelebrities where
  hashWithSalt :: Int -> RecognizeCelebrities -> Int
hashWithSalt Int
_salt RecognizeCelebrities' {Image
image :: Image
$sel:image:RecognizeCelebrities' :: RecognizeCelebrities -> Image
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Image
image

instance Prelude.NFData RecognizeCelebrities where
  rnf :: RecognizeCelebrities -> ()
rnf RecognizeCelebrities' {Image
image :: Image
$sel:image:RecognizeCelebrities' :: RecognizeCelebrities -> Image
..} = forall a. NFData a => a -> ()
Prelude.rnf Image
image

instance Data.ToHeaders RecognizeCelebrities where
  toHeaders :: RecognizeCelebrities -> 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.RecognizeCelebrities" ::
                          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 RecognizeCelebrities where
  toJSON :: RecognizeCelebrities -> Value
toJSON RecognizeCelebrities' {Image
image :: Image
$sel:image:RecognizeCelebrities' :: RecognizeCelebrities -> Image
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Image" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Image
image)]
      )

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

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

-- | /See:/ 'newRecognizeCelebritiesResponse' smart constructor.
data RecognizeCelebritiesResponse = RecognizeCelebritiesResponse'
  { -- | Details about each celebrity found in the image. Amazon Rekognition can
    -- detect a maximum of 64 celebrities in an image. Each celebrity object
    -- includes the following attributes: @Face@, @Confidence@, @Emotions@,
    -- @Landmarks@, @Pose@, @Quality@, @Smile@, @Id@, @KnownGender@,
    -- @MatchConfidence@, @Name@, @Urls@.
    RecognizeCelebritiesResponse -> Maybe [Celebrity]
celebrityFaces :: Prelude.Maybe [Celebrity],
    -- | Support for estimating image orientation using the the
    -- OrientationCorrection field has ceased as of August 2021. Any returned
    -- values for this field included in an API response will always be NULL.
    --
    -- The orientation of the input image (counterclockwise direction). If your
    -- application displays the image, you can use this value to correct the
    -- orientation. The bounding box coordinates returned in @CelebrityFaces@
    -- and @UnrecognizedFaces@ represent face locations before the image
    -- orientation is corrected.
    --
    -- If the input image is in .jpeg format, it might contain exchangeable
    -- image (Exif) metadata that includes the image\'s orientation. If so, and
    -- the Exif metadata for the input image populates the orientation field,
    -- the value of @OrientationCorrection@ is null. The @CelebrityFaces@ and
    -- @UnrecognizedFaces@ bounding box coordinates represent face locations
    -- after Exif metadata is used to correct the image orientation. Images in
    -- .png format don\'t contain Exif metadata.
    RecognizeCelebritiesResponse -> Maybe OrientationCorrection
orientationCorrection :: Prelude.Maybe OrientationCorrection,
    -- | Details about each unrecognized face in the image.
    RecognizeCelebritiesResponse -> Maybe [ComparedFace]
unrecognizedFaces :: Prelude.Maybe [ComparedFace],
    -- | The response's http status code.
    RecognizeCelebritiesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RecognizeCelebritiesResponse
-> RecognizeCelebritiesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecognizeCelebritiesResponse
-> RecognizeCelebritiesResponse -> Bool
$c/= :: RecognizeCelebritiesResponse
-> RecognizeCelebritiesResponse -> Bool
== :: RecognizeCelebritiesResponse
-> RecognizeCelebritiesResponse -> Bool
$c== :: RecognizeCelebritiesResponse
-> RecognizeCelebritiesResponse -> Bool
Prelude.Eq, ReadPrec [RecognizeCelebritiesResponse]
ReadPrec RecognizeCelebritiesResponse
Int -> ReadS RecognizeCelebritiesResponse
ReadS [RecognizeCelebritiesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecognizeCelebritiesResponse]
$creadListPrec :: ReadPrec [RecognizeCelebritiesResponse]
readPrec :: ReadPrec RecognizeCelebritiesResponse
$creadPrec :: ReadPrec RecognizeCelebritiesResponse
readList :: ReadS [RecognizeCelebritiesResponse]
$creadList :: ReadS [RecognizeCelebritiesResponse]
readsPrec :: Int -> ReadS RecognizeCelebritiesResponse
$creadsPrec :: Int -> ReadS RecognizeCelebritiesResponse
Prelude.Read, Int -> RecognizeCelebritiesResponse -> ShowS
[RecognizeCelebritiesResponse] -> ShowS
RecognizeCelebritiesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecognizeCelebritiesResponse] -> ShowS
$cshowList :: [RecognizeCelebritiesResponse] -> ShowS
show :: RecognizeCelebritiesResponse -> String
$cshow :: RecognizeCelebritiesResponse -> String
showsPrec :: Int -> RecognizeCelebritiesResponse -> ShowS
$cshowsPrec :: Int -> RecognizeCelebritiesResponse -> ShowS
Prelude.Show, forall x.
Rep RecognizeCelebritiesResponse x -> RecognizeCelebritiesResponse
forall x.
RecognizeCelebritiesResponse -> Rep RecognizeCelebritiesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RecognizeCelebritiesResponse x -> RecognizeCelebritiesResponse
$cfrom :: forall x.
RecognizeCelebritiesResponse -> Rep RecognizeCelebritiesResponse x
Prelude.Generic)

-- |
-- Create a value of 'RecognizeCelebritiesResponse' 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:
--
-- 'celebrityFaces', 'recognizeCelebritiesResponse_celebrityFaces' - Details about each celebrity found in the image. Amazon Rekognition can
-- detect a maximum of 64 celebrities in an image. Each celebrity object
-- includes the following attributes: @Face@, @Confidence@, @Emotions@,
-- @Landmarks@, @Pose@, @Quality@, @Smile@, @Id@, @KnownGender@,
-- @MatchConfidence@, @Name@, @Urls@.
--
-- 'orientationCorrection', 'recognizeCelebritiesResponse_orientationCorrection' - Support for estimating image orientation using the the
-- OrientationCorrection field has ceased as of August 2021. Any returned
-- values for this field included in an API response will always be NULL.
--
-- The orientation of the input image (counterclockwise direction). If your
-- application displays the image, you can use this value to correct the
-- orientation. The bounding box coordinates returned in @CelebrityFaces@
-- and @UnrecognizedFaces@ represent face locations before the image
-- orientation is corrected.
--
-- If the input image is in .jpeg format, it might contain exchangeable
-- image (Exif) metadata that includes the image\'s orientation. If so, and
-- the Exif metadata for the input image populates the orientation field,
-- the value of @OrientationCorrection@ is null. The @CelebrityFaces@ and
-- @UnrecognizedFaces@ bounding box coordinates represent face locations
-- after Exif metadata is used to correct the image orientation. Images in
-- .png format don\'t contain Exif metadata.
--
-- 'unrecognizedFaces', 'recognizeCelebritiesResponse_unrecognizedFaces' - Details about each unrecognized face in the image.
--
-- 'httpStatus', 'recognizeCelebritiesResponse_httpStatus' - The response's http status code.
newRecognizeCelebritiesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RecognizeCelebritiesResponse
newRecognizeCelebritiesResponse :: Int -> RecognizeCelebritiesResponse
newRecognizeCelebritiesResponse Int
pHttpStatus_ =
  RecognizeCelebritiesResponse'
    { $sel:celebrityFaces:RecognizeCelebritiesResponse' :: Maybe [Celebrity]
celebrityFaces =
        forall a. Maybe a
Prelude.Nothing,
      $sel:orientationCorrection:RecognizeCelebritiesResponse' :: Maybe OrientationCorrection
orientationCorrection = forall a. Maybe a
Prelude.Nothing,
      $sel:unrecognizedFaces:RecognizeCelebritiesResponse' :: Maybe [ComparedFace]
unrecognizedFaces = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RecognizeCelebritiesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Details about each celebrity found in the image. Amazon Rekognition can
-- detect a maximum of 64 celebrities in an image. Each celebrity object
-- includes the following attributes: @Face@, @Confidence@, @Emotions@,
-- @Landmarks@, @Pose@, @Quality@, @Smile@, @Id@, @KnownGender@,
-- @MatchConfidence@, @Name@, @Urls@.
recognizeCelebritiesResponse_celebrityFaces :: Lens.Lens' RecognizeCelebritiesResponse (Prelude.Maybe [Celebrity])
recognizeCelebritiesResponse_celebrityFaces :: Lens' RecognizeCelebritiesResponse (Maybe [Celebrity])
recognizeCelebritiesResponse_celebrityFaces = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecognizeCelebritiesResponse' {Maybe [Celebrity]
celebrityFaces :: Maybe [Celebrity]
$sel:celebrityFaces:RecognizeCelebritiesResponse' :: RecognizeCelebritiesResponse -> Maybe [Celebrity]
celebrityFaces} -> Maybe [Celebrity]
celebrityFaces) (\s :: RecognizeCelebritiesResponse
s@RecognizeCelebritiesResponse' {} Maybe [Celebrity]
a -> RecognizeCelebritiesResponse
s {$sel:celebrityFaces:RecognizeCelebritiesResponse' :: Maybe [Celebrity]
celebrityFaces = Maybe [Celebrity]
a} :: RecognizeCelebritiesResponse) 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

-- | Support for estimating image orientation using the the
-- OrientationCorrection field has ceased as of August 2021. Any returned
-- values for this field included in an API response will always be NULL.
--
-- The orientation of the input image (counterclockwise direction). If your
-- application displays the image, you can use this value to correct the
-- orientation. The bounding box coordinates returned in @CelebrityFaces@
-- and @UnrecognizedFaces@ represent face locations before the image
-- orientation is corrected.
--
-- If the input image is in .jpeg format, it might contain exchangeable
-- image (Exif) metadata that includes the image\'s orientation. If so, and
-- the Exif metadata for the input image populates the orientation field,
-- the value of @OrientationCorrection@ is null. The @CelebrityFaces@ and
-- @UnrecognizedFaces@ bounding box coordinates represent face locations
-- after Exif metadata is used to correct the image orientation. Images in
-- .png format don\'t contain Exif metadata.
recognizeCelebritiesResponse_orientationCorrection :: Lens.Lens' RecognizeCelebritiesResponse (Prelude.Maybe OrientationCorrection)
recognizeCelebritiesResponse_orientationCorrection :: Lens' RecognizeCelebritiesResponse (Maybe OrientationCorrection)
recognizeCelebritiesResponse_orientationCorrection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecognizeCelebritiesResponse' {Maybe OrientationCorrection
orientationCorrection :: Maybe OrientationCorrection
$sel:orientationCorrection:RecognizeCelebritiesResponse' :: RecognizeCelebritiesResponse -> Maybe OrientationCorrection
orientationCorrection} -> Maybe OrientationCorrection
orientationCorrection) (\s :: RecognizeCelebritiesResponse
s@RecognizeCelebritiesResponse' {} Maybe OrientationCorrection
a -> RecognizeCelebritiesResponse
s {$sel:orientationCorrection:RecognizeCelebritiesResponse' :: Maybe OrientationCorrection
orientationCorrection = Maybe OrientationCorrection
a} :: RecognizeCelebritiesResponse)

-- | Details about each unrecognized face in the image.
recognizeCelebritiesResponse_unrecognizedFaces :: Lens.Lens' RecognizeCelebritiesResponse (Prelude.Maybe [ComparedFace])
recognizeCelebritiesResponse_unrecognizedFaces :: Lens' RecognizeCelebritiesResponse (Maybe [ComparedFace])
recognizeCelebritiesResponse_unrecognizedFaces = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecognizeCelebritiesResponse' {Maybe [ComparedFace]
unrecognizedFaces :: Maybe [ComparedFace]
$sel:unrecognizedFaces:RecognizeCelebritiesResponse' :: RecognizeCelebritiesResponse -> Maybe [ComparedFace]
unrecognizedFaces} -> Maybe [ComparedFace]
unrecognizedFaces) (\s :: RecognizeCelebritiesResponse
s@RecognizeCelebritiesResponse' {} Maybe [ComparedFace]
a -> RecognizeCelebritiesResponse
s {$sel:unrecognizedFaces:RecognizeCelebritiesResponse' :: Maybe [ComparedFace]
unrecognizedFaces = Maybe [ComparedFace]
a} :: RecognizeCelebritiesResponse) 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 response's http status code.
recognizeCelebritiesResponse_httpStatus :: Lens.Lens' RecognizeCelebritiesResponse Prelude.Int
recognizeCelebritiesResponse_httpStatus :: Lens' RecognizeCelebritiesResponse Int
recognizeCelebritiesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecognizeCelebritiesResponse' {Int
httpStatus :: Int
$sel:httpStatus:RecognizeCelebritiesResponse' :: RecognizeCelebritiesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: RecognizeCelebritiesResponse
s@RecognizeCelebritiesResponse' {} Int
a -> RecognizeCelebritiesResponse
s {$sel:httpStatus:RecognizeCelebritiesResponse' :: Int
httpStatus = Int
a} :: RecognizeCelebritiesResponse)

instance Prelude.NFData RecognizeCelebritiesResponse where
  rnf :: RecognizeCelebritiesResponse -> ()
rnf RecognizeCelebritiesResponse' {Int
Maybe [ComparedFace]
Maybe [Celebrity]
Maybe OrientationCorrection
httpStatus :: Int
unrecognizedFaces :: Maybe [ComparedFace]
orientationCorrection :: Maybe OrientationCorrection
celebrityFaces :: Maybe [Celebrity]
$sel:httpStatus:RecognizeCelebritiesResponse' :: RecognizeCelebritiesResponse -> Int
$sel:unrecognizedFaces:RecognizeCelebritiesResponse' :: RecognizeCelebritiesResponse -> Maybe [ComparedFace]
$sel:orientationCorrection:RecognizeCelebritiesResponse' :: RecognizeCelebritiesResponse -> Maybe OrientationCorrection
$sel:celebrityFaces:RecognizeCelebritiesResponse' :: RecognizeCelebritiesResponse -> Maybe [Celebrity]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Celebrity]
celebrityFaces
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OrientationCorrection
orientationCorrection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ComparedFace]
unrecognizedFaces
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus