{-# 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.DetectFaces
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Detects faces within an image that is provided as input.
--
-- @DetectFaces@ detects the 100 largest faces in the image. For each face
-- detected, the operation returns face details. These details include a
-- bounding box of the face, a confidence value (that the bounding box
-- contains a face), and a fixed set of attributes such as facial landmarks
-- (for example, coordinates of eye and mouth), presence of beard,
-- sunglasses, and so on.
--
-- The face-detection algorithm is most effective on frontal faces. For
-- non-frontal or obscured faces, the algorithm might not detect the faces
-- or might detect faces with lower confidence.
--
-- 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.
--
-- This is a stateless API operation. That is, the operation does not
-- persist any data.
--
-- This operation requires permissions to perform the
-- @rekognition:DetectFaces@ action.
module Amazonka.Rekognition.DetectFaces
  ( -- * Creating a Request
    DetectFaces (..),
    newDetectFaces,

    -- * Request Lenses
    detectFaces_attributes,
    detectFaces_image,

    -- * Destructuring the Response
    DetectFacesResponse (..),
    newDetectFacesResponse,

    -- * Response Lenses
    detectFacesResponse_faceDetails,
    detectFacesResponse_orientationCorrection,
    detectFacesResponse_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:/ 'newDetectFaces' smart constructor.
data DetectFaces = DetectFaces'
  { -- | An array of facial attributes you want to be returned. This can be the
    -- default list of attributes or all attributes. If you don\'t specify a
    -- value for @Attributes@ or if you specify @[\"DEFAULT\"]@, the API
    -- returns the following subset of facial attributes: @BoundingBox@,
    -- @Confidence@, @Pose@, @Quality@, and @Landmarks@. If you provide
    -- @[\"ALL\"]@, all facial attributes are returned, but the operation takes
    -- longer to complete.
    --
    -- If you provide both, @[\"ALL\", \"DEFAULT\"]@, the service uses a
    -- logical AND operator to determine which attributes to return (in this
    -- case, all attributes).
    DetectFaces -> Maybe [Attribute]
attributes :: Prelude.Maybe [Attribute],
    -- | 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.
    DetectFaces -> Image
image :: Image
  }
  deriving (DetectFaces -> DetectFaces -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectFaces -> DetectFaces -> Bool
$c/= :: DetectFaces -> DetectFaces -> Bool
== :: DetectFaces -> DetectFaces -> Bool
$c== :: DetectFaces -> DetectFaces -> Bool
Prelude.Eq, ReadPrec [DetectFaces]
ReadPrec DetectFaces
Int -> ReadS DetectFaces
ReadS [DetectFaces]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetectFaces]
$creadListPrec :: ReadPrec [DetectFaces]
readPrec :: ReadPrec DetectFaces
$creadPrec :: ReadPrec DetectFaces
readList :: ReadS [DetectFaces]
$creadList :: ReadS [DetectFaces]
readsPrec :: Int -> ReadS DetectFaces
$creadsPrec :: Int -> ReadS DetectFaces
Prelude.Read, Int -> DetectFaces -> ShowS
[DetectFaces] -> ShowS
DetectFaces -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectFaces] -> ShowS
$cshowList :: [DetectFaces] -> ShowS
show :: DetectFaces -> String
$cshow :: DetectFaces -> String
showsPrec :: Int -> DetectFaces -> ShowS
$cshowsPrec :: Int -> DetectFaces -> ShowS
Prelude.Show, forall x. Rep DetectFaces x -> DetectFaces
forall x. DetectFaces -> Rep DetectFaces x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectFaces x -> DetectFaces
$cfrom :: forall x. DetectFaces -> Rep DetectFaces x
Prelude.Generic)

-- |
-- Create a value of 'DetectFaces' 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:
--
-- 'attributes', 'detectFaces_attributes' - An array of facial attributes you want to be returned. This can be the
-- default list of attributes or all attributes. If you don\'t specify a
-- value for @Attributes@ or if you specify @[\"DEFAULT\"]@, the API
-- returns the following subset of facial attributes: @BoundingBox@,
-- @Confidence@, @Pose@, @Quality@, and @Landmarks@. If you provide
-- @[\"ALL\"]@, all facial attributes are returned, but the operation takes
-- longer to complete.
--
-- If you provide both, @[\"ALL\", \"DEFAULT\"]@, the service uses a
-- logical AND operator to determine which attributes to return (in this
-- case, all attributes).
--
-- 'image', 'detectFaces_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.
newDetectFaces ::
  -- | 'image'
  Image ->
  DetectFaces
newDetectFaces :: Image -> DetectFaces
newDetectFaces Image
pImage_ =
  DetectFaces'
    { $sel:attributes:DetectFaces' :: Maybe [Attribute]
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:image:DetectFaces' :: Image
image = Image
pImage_
    }

-- | An array of facial attributes you want to be returned. This can be the
-- default list of attributes or all attributes. If you don\'t specify a
-- value for @Attributes@ or if you specify @[\"DEFAULT\"]@, the API
-- returns the following subset of facial attributes: @BoundingBox@,
-- @Confidence@, @Pose@, @Quality@, and @Landmarks@. If you provide
-- @[\"ALL\"]@, all facial attributes are returned, but the operation takes
-- longer to complete.
--
-- If you provide both, @[\"ALL\", \"DEFAULT\"]@, the service uses a
-- logical AND operator to determine which attributes to return (in this
-- case, all attributes).
detectFaces_attributes :: Lens.Lens' DetectFaces (Prelude.Maybe [Attribute])
detectFaces_attributes :: Lens' DetectFaces (Maybe [Attribute])
detectFaces_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectFaces' {Maybe [Attribute]
attributes :: Maybe [Attribute]
$sel:attributes:DetectFaces' :: DetectFaces -> Maybe [Attribute]
attributes} -> Maybe [Attribute]
attributes) (\s :: DetectFaces
s@DetectFaces' {} Maybe [Attribute]
a -> DetectFaces
s {$sel:attributes:DetectFaces' :: Maybe [Attribute]
attributes = Maybe [Attribute]
a} :: DetectFaces) 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 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.
detectFaces_image :: Lens.Lens' DetectFaces Image
detectFaces_image :: Lens' DetectFaces Image
detectFaces_image = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectFaces' {Image
image :: Image
$sel:image:DetectFaces' :: DetectFaces -> Image
image} -> Image
image) (\s :: DetectFaces
s@DetectFaces' {} Image
a -> DetectFaces
s {$sel:image:DetectFaces' :: Image
image = Image
a} :: DetectFaces)

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

instance Prelude.Hashable DetectFaces where
  hashWithSalt :: Int -> DetectFaces -> Int
hashWithSalt Int
_salt DetectFaces' {Maybe [Attribute]
Image
image :: Image
attributes :: Maybe [Attribute]
$sel:image:DetectFaces' :: DetectFaces -> Image
$sel:attributes:DetectFaces' :: DetectFaces -> Maybe [Attribute]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Attribute]
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Image
image

instance Prelude.NFData DetectFaces where
  rnf :: DetectFaces -> ()
rnf DetectFaces' {Maybe [Attribute]
Image
image :: Image
attributes :: Maybe [Attribute]
$sel:image:DetectFaces' :: DetectFaces -> Image
$sel:attributes:DetectFaces' :: DetectFaces -> Maybe [Attribute]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Attribute]
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Image
image

instance Data.ToHeaders DetectFaces where
  toHeaders :: DetectFaces -> 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.DetectFaces" ::
                          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 DetectFaces where
  toJSON :: DetectFaces -> Value
toJSON DetectFaces' {Maybe [Attribute]
Image
image :: Image
attributes :: Maybe [Attribute]
$sel:image:DetectFaces' :: DetectFaces -> Image
$sel:attributes:DetectFaces' :: DetectFaces -> Maybe [Attribute]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Attributes" 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 [Attribute]
attributes,
            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 DetectFaces where
  toPath :: DetectFaces -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDetectFacesResponse' smart constructor.
data DetectFacesResponse = DetectFacesResponse'
  { -- | Details of each face found in the image.
    DetectFacesResponse -> Maybe [FaceDetail]
faceDetails :: Prelude.Maybe [FaceDetail],
    -- | The value of @OrientationCorrection@ is always null.
    --
    -- If the input image is in .jpeg format, it might contain exchangeable
    -- image file format (Exif) metadata that includes the image\'s
    -- orientation. Amazon Rekognition uses this orientation information to
    -- perform image correction. The bounding box coordinates are translated to
    -- represent object locations after the orientation information in the Exif
    -- metadata is used to correct the image orientation. Images in .png format
    -- don\'t contain Exif metadata.
    --
    -- Amazon Rekognition doesn’t perform image correction for images in .png
    -- format and .jpeg images without orientation information in the image
    -- Exif metadata. The bounding box coordinates aren\'t translated and
    -- represent the object locations before the image is rotated.
    DetectFacesResponse -> Maybe OrientationCorrection
orientationCorrection :: Prelude.Maybe OrientationCorrection,
    -- | The response's http status code.
    DetectFacesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DetectFacesResponse -> DetectFacesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectFacesResponse -> DetectFacesResponse -> Bool
$c/= :: DetectFacesResponse -> DetectFacesResponse -> Bool
== :: DetectFacesResponse -> DetectFacesResponse -> Bool
$c== :: DetectFacesResponse -> DetectFacesResponse -> Bool
Prelude.Eq, ReadPrec [DetectFacesResponse]
ReadPrec DetectFacesResponse
Int -> ReadS DetectFacesResponse
ReadS [DetectFacesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetectFacesResponse]
$creadListPrec :: ReadPrec [DetectFacesResponse]
readPrec :: ReadPrec DetectFacesResponse
$creadPrec :: ReadPrec DetectFacesResponse
readList :: ReadS [DetectFacesResponse]
$creadList :: ReadS [DetectFacesResponse]
readsPrec :: Int -> ReadS DetectFacesResponse
$creadsPrec :: Int -> ReadS DetectFacesResponse
Prelude.Read, Int -> DetectFacesResponse -> ShowS
[DetectFacesResponse] -> ShowS
DetectFacesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectFacesResponse] -> ShowS
$cshowList :: [DetectFacesResponse] -> ShowS
show :: DetectFacesResponse -> String
$cshow :: DetectFacesResponse -> String
showsPrec :: Int -> DetectFacesResponse -> ShowS
$cshowsPrec :: Int -> DetectFacesResponse -> ShowS
Prelude.Show, forall x. Rep DetectFacesResponse x -> DetectFacesResponse
forall x. DetectFacesResponse -> Rep DetectFacesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectFacesResponse x -> DetectFacesResponse
$cfrom :: forall x. DetectFacesResponse -> Rep DetectFacesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DetectFacesResponse' 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:
--
-- 'faceDetails', 'detectFacesResponse_faceDetails' - Details of each face found in the image.
--
-- 'orientationCorrection', 'detectFacesResponse_orientationCorrection' - The value of @OrientationCorrection@ is always null.
--
-- If the input image is in .jpeg format, it might contain exchangeable
-- image file format (Exif) metadata that includes the image\'s
-- orientation. Amazon Rekognition uses this orientation information to
-- perform image correction. The bounding box coordinates are translated to
-- represent object locations after the orientation information in the Exif
-- metadata is used to correct the image orientation. Images in .png format
-- don\'t contain Exif metadata.
--
-- Amazon Rekognition doesn’t perform image correction for images in .png
-- format and .jpeg images without orientation information in the image
-- Exif metadata. The bounding box coordinates aren\'t translated and
-- represent the object locations before the image is rotated.
--
-- 'httpStatus', 'detectFacesResponse_httpStatus' - The response's http status code.
newDetectFacesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DetectFacesResponse
newDetectFacesResponse :: Int -> DetectFacesResponse
newDetectFacesResponse Int
pHttpStatus_ =
  DetectFacesResponse'
    { $sel:faceDetails:DetectFacesResponse' :: Maybe [FaceDetail]
faceDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:orientationCorrection:DetectFacesResponse' :: Maybe OrientationCorrection
orientationCorrection = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DetectFacesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Details of each face found in the image.
detectFacesResponse_faceDetails :: Lens.Lens' DetectFacesResponse (Prelude.Maybe [FaceDetail])
detectFacesResponse_faceDetails :: Lens' DetectFacesResponse (Maybe [FaceDetail])
detectFacesResponse_faceDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectFacesResponse' {Maybe [FaceDetail]
faceDetails :: Maybe [FaceDetail]
$sel:faceDetails:DetectFacesResponse' :: DetectFacesResponse -> Maybe [FaceDetail]
faceDetails} -> Maybe [FaceDetail]
faceDetails) (\s :: DetectFacesResponse
s@DetectFacesResponse' {} Maybe [FaceDetail]
a -> DetectFacesResponse
s {$sel:faceDetails:DetectFacesResponse' :: Maybe [FaceDetail]
faceDetails = Maybe [FaceDetail]
a} :: DetectFacesResponse) 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 value of @OrientationCorrection@ is always null.
--
-- If the input image is in .jpeg format, it might contain exchangeable
-- image file format (Exif) metadata that includes the image\'s
-- orientation. Amazon Rekognition uses this orientation information to
-- perform image correction. The bounding box coordinates are translated to
-- represent object locations after the orientation information in the Exif
-- metadata is used to correct the image orientation. Images in .png format
-- don\'t contain Exif metadata.
--
-- Amazon Rekognition doesn’t perform image correction for images in .png
-- format and .jpeg images without orientation information in the image
-- Exif metadata. The bounding box coordinates aren\'t translated and
-- represent the object locations before the image is rotated.
detectFacesResponse_orientationCorrection :: Lens.Lens' DetectFacesResponse (Prelude.Maybe OrientationCorrection)
detectFacesResponse_orientationCorrection :: Lens' DetectFacesResponse (Maybe OrientationCorrection)
detectFacesResponse_orientationCorrection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectFacesResponse' {Maybe OrientationCorrection
orientationCorrection :: Maybe OrientationCorrection
$sel:orientationCorrection:DetectFacesResponse' :: DetectFacesResponse -> Maybe OrientationCorrection
orientationCorrection} -> Maybe OrientationCorrection
orientationCorrection) (\s :: DetectFacesResponse
s@DetectFacesResponse' {} Maybe OrientationCorrection
a -> DetectFacesResponse
s {$sel:orientationCorrection:DetectFacesResponse' :: Maybe OrientationCorrection
orientationCorrection = Maybe OrientationCorrection
a} :: DetectFacesResponse)

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

instance Prelude.NFData DetectFacesResponse where
  rnf :: DetectFacesResponse -> ()
rnf DetectFacesResponse' {Int
Maybe [FaceDetail]
Maybe OrientationCorrection
httpStatus :: Int
orientationCorrection :: Maybe OrientationCorrection
faceDetails :: Maybe [FaceDetail]
$sel:httpStatus:DetectFacesResponse' :: DetectFacesResponse -> Int
$sel:orientationCorrection:DetectFacesResponse' :: DetectFacesResponse -> Maybe OrientationCorrection
$sel:faceDetails:DetectFacesResponse' :: DetectFacesResponse -> Maybe [FaceDetail]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FaceDetail]
faceDetails
      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 Int
httpStatus