{-# 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.ListFaces
-- 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 metadata for faces in the specified collection. This metadata
-- includes information such as the bounding box coordinates, the
-- confidence (that the bounding box contains a face), and face ID. For an
-- example, see Listing Faces in a Collection in the Amazon Rekognition
-- Developer Guide.
--
-- This operation requires permissions to perform the
-- @rekognition:ListFaces@ action.
--
-- This operation returns paginated results.
module Amazonka.Rekognition.ListFaces
  ( -- * Creating a Request
    ListFaces (..),
    newListFaces,

    -- * Request Lenses
    listFaces_maxResults,
    listFaces_nextToken,
    listFaces_collectionId,

    -- * Destructuring the Response
    ListFacesResponse (..),
    newListFacesResponse,

    -- * Response Lenses
    listFacesResponse_faceModelVersion,
    listFacesResponse_faces,
    listFacesResponse_nextToken,
    listFacesResponse_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:/ 'newListFaces' smart constructor.
data ListFaces = ListFaces'
  { -- | Maximum number of faces to return.
    ListFaces -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the previous response was incomplete (because there is more data to
    -- retrieve), Amazon Rekognition returns a pagination token in the
    -- response. You can use this pagination token to retrieve the next set of
    -- faces.
    ListFaces -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | ID of the collection from which to list the faces.
    ListFaces -> Text
collectionId :: Prelude.Text
  }
  deriving (ListFaces -> ListFaces -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFaces -> ListFaces -> Bool
$c/= :: ListFaces -> ListFaces -> Bool
== :: ListFaces -> ListFaces -> Bool
$c== :: ListFaces -> ListFaces -> Bool
Prelude.Eq, ReadPrec [ListFaces]
ReadPrec ListFaces
Int -> ReadS ListFaces
ReadS [ListFaces]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFaces]
$creadListPrec :: ReadPrec [ListFaces]
readPrec :: ReadPrec ListFaces
$creadPrec :: ReadPrec ListFaces
readList :: ReadS [ListFaces]
$creadList :: ReadS [ListFaces]
readsPrec :: Int -> ReadS ListFaces
$creadsPrec :: Int -> ReadS ListFaces
Prelude.Read, Int -> ListFaces -> ShowS
[ListFaces] -> ShowS
ListFaces -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFaces] -> ShowS
$cshowList :: [ListFaces] -> ShowS
show :: ListFaces -> String
$cshow :: ListFaces -> String
showsPrec :: Int -> ListFaces -> ShowS
$cshowsPrec :: Int -> ListFaces -> ShowS
Prelude.Show, forall x. Rep ListFaces x -> ListFaces
forall x. ListFaces -> Rep ListFaces x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFaces x -> ListFaces
$cfrom :: forall x. ListFaces -> Rep ListFaces x
Prelude.Generic)

-- |
-- Create a value of 'ListFaces' 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', 'listFaces_maxResults' - Maximum number of faces to return.
--
-- 'nextToken', 'listFaces_nextToken' - If the previous response was incomplete (because there is more data to
-- retrieve), Amazon Rekognition returns a pagination token in the
-- response. You can use this pagination token to retrieve the next set of
-- faces.
--
-- 'collectionId', 'listFaces_collectionId' - ID of the collection from which to list the faces.
newListFaces ::
  -- | 'collectionId'
  Prelude.Text ->
  ListFaces
newListFaces :: Text -> ListFaces
newListFaces Text
pCollectionId_ =
  ListFaces'
    { $sel:maxResults:ListFaces' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFaces' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:collectionId:ListFaces' :: Text
collectionId = Text
pCollectionId_
    }

-- | Maximum number of faces to return.
listFaces_maxResults :: Lens.Lens' ListFaces (Prelude.Maybe Prelude.Natural)
listFaces_maxResults :: Lens' ListFaces (Maybe Natural)
listFaces_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFaces' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListFaces' :: ListFaces -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListFaces
s@ListFaces' {} Maybe Natural
a -> ListFaces
s {$sel:maxResults:ListFaces' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListFaces)

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

-- | ID of the collection from which to list the faces.
listFaces_collectionId :: Lens.Lens' ListFaces Prelude.Text
listFaces_collectionId :: Lens' ListFaces Text
listFaces_collectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFaces' {Text
collectionId :: Text
$sel:collectionId:ListFaces' :: ListFaces -> Text
collectionId} -> Text
collectionId) (\s :: ListFaces
s@ListFaces' {} Text
a -> ListFaces
s {$sel:collectionId:ListFaces' :: Text
collectionId = Text
a} :: ListFaces)

instance Core.AWSPager ListFaces where
  page :: ListFaces -> AWSResponse ListFaces -> Maybe ListFaces
page ListFaces
rq AWSResponse ListFaces
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListFaces
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFacesResponse (Maybe Text)
listFacesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListFaces
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFacesResponse (Maybe [Face])
listFacesResponse_faces
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListFaces
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListFaces (Maybe Text)
listFaces_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListFaces
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFacesResponse (Maybe Text)
listFacesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListFaces where
  type AWSResponse ListFaces = ListFacesResponse
  request :: (Service -> Service) -> ListFaces -> Request ListFaces
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 ListFaces
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListFaces)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe [Face] -> Maybe Text -> Int -> ListFacesResponse
ListFacesResponse'
            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
"FaceModelVersion")
            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
"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
"NextToken")
            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 ListFaces where
  hashWithSalt :: Int -> ListFaces -> Int
hashWithSalt Int
_salt ListFaces' {Maybe Natural
Maybe Text
Text
collectionId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:collectionId:ListFaces' :: ListFaces -> Text
$sel:nextToken:ListFaces' :: ListFaces -> Maybe Text
$sel:maxResults:ListFaces' :: ListFaces -> 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
collectionId

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

instance Data.ToHeaders ListFaces where
  toHeaders :: ListFaces -> 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.ListFaces" ::
                          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 ListFaces where
  toJSON :: ListFaces -> Value
toJSON ListFaces' {Maybe Natural
Maybe Text
Text
collectionId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:collectionId:ListFaces' :: ListFaces -> Text
$sel:nextToken:ListFaces' :: ListFaces -> Maybe Text
$sel:maxResults:ListFaces' :: ListFaces -> 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
"CollectionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
collectionId)
          ]
      )

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

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

-- | /See:/ 'newListFacesResponse' smart constructor.
data ListFacesResponse = ListFacesResponse'
  { -- | Version number of the face detection model associated with the input
    -- collection (@CollectionId@).
    ListFacesResponse -> Maybe Text
faceModelVersion :: Prelude.Maybe Prelude.Text,
    -- | An array of @Face@ objects.
    ListFacesResponse -> Maybe [Face]
faces :: Prelude.Maybe [Face],
    -- | 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.
    ListFacesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListFacesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListFacesResponse -> ListFacesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFacesResponse -> ListFacesResponse -> Bool
$c/= :: ListFacesResponse -> ListFacesResponse -> Bool
== :: ListFacesResponse -> ListFacesResponse -> Bool
$c== :: ListFacesResponse -> ListFacesResponse -> Bool
Prelude.Eq, ReadPrec [ListFacesResponse]
ReadPrec ListFacesResponse
Int -> ReadS ListFacesResponse
ReadS [ListFacesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFacesResponse]
$creadListPrec :: ReadPrec [ListFacesResponse]
readPrec :: ReadPrec ListFacesResponse
$creadPrec :: ReadPrec ListFacesResponse
readList :: ReadS [ListFacesResponse]
$creadList :: ReadS [ListFacesResponse]
readsPrec :: Int -> ReadS ListFacesResponse
$creadsPrec :: Int -> ReadS ListFacesResponse
Prelude.Read, Int -> ListFacesResponse -> ShowS
[ListFacesResponse] -> ShowS
ListFacesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFacesResponse] -> ShowS
$cshowList :: [ListFacesResponse] -> ShowS
show :: ListFacesResponse -> String
$cshow :: ListFacesResponse -> String
showsPrec :: Int -> ListFacesResponse -> ShowS
$cshowsPrec :: Int -> ListFacesResponse -> ShowS
Prelude.Show, forall x. Rep ListFacesResponse x -> ListFacesResponse
forall x. ListFacesResponse -> Rep ListFacesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFacesResponse x -> ListFacesResponse
$cfrom :: forall x. ListFacesResponse -> Rep ListFacesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListFacesResponse' 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:
--
-- 'faceModelVersion', 'listFacesResponse_faceModelVersion' - Version number of the face detection model associated with the input
-- collection (@CollectionId@).
--
-- 'faces', 'listFacesResponse_faces' - An array of @Face@ objects.
--
-- 'nextToken', 'listFacesResponse_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.
--
-- 'httpStatus', 'listFacesResponse_httpStatus' - The response's http status code.
newListFacesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListFacesResponse
newListFacesResponse :: Int -> ListFacesResponse
newListFacesResponse Int
pHttpStatus_ =
  ListFacesResponse'
    { $sel:faceModelVersion:ListFacesResponse' :: Maybe Text
faceModelVersion =
        forall a. Maybe a
Prelude.Nothing,
      $sel:faces:ListFacesResponse' :: Maybe [Face]
faces = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFacesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListFacesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Version number of the face detection model associated with the input
-- collection (@CollectionId@).
listFacesResponse_faceModelVersion :: Lens.Lens' ListFacesResponse (Prelude.Maybe Prelude.Text)
listFacesResponse_faceModelVersion :: Lens' ListFacesResponse (Maybe Text)
listFacesResponse_faceModelVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFacesResponse' {Maybe Text
faceModelVersion :: Maybe Text
$sel:faceModelVersion:ListFacesResponse' :: ListFacesResponse -> Maybe Text
faceModelVersion} -> Maybe Text
faceModelVersion) (\s :: ListFacesResponse
s@ListFacesResponse' {} Maybe Text
a -> ListFacesResponse
s {$sel:faceModelVersion:ListFacesResponse' :: Maybe Text
faceModelVersion = Maybe Text
a} :: ListFacesResponse)

-- | An array of @Face@ objects.
listFacesResponse_faces :: Lens.Lens' ListFacesResponse (Prelude.Maybe [Face])
listFacesResponse_faces :: Lens' ListFacesResponse (Maybe [Face])
listFacesResponse_faces = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFacesResponse' {Maybe [Face]
faces :: Maybe [Face]
$sel:faces:ListFacesResponse' :: ListFacesResponse -> Maybe [Face]
faces} -> Maybe [Face]
faces) (\s :: ListFacesResponse
s@ListFacesResponse' {} Maybe [Face]
a -> ListFacesResponse
s {$sel:faces:ListFacesResponse' :: Maybe [Face]
faces = Maybe [Face]
a} :: ListFacesResponse) 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 returns this token that
-- you can use in the subsequent request to retrieve the next set of faces.
listFacesResponse_nextToken :: Lens.Lens' ListFacesResponse (Prelude.Maybe Prelude.Text)
listFacesResponse_nextToken :: Lens' ListFacesResponse (Maybe Text)
listFacesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFacesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFacesResponse' :: ListFacesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFacesResponse
s@ListFacesResponse' {} Maybe Text
a -> ListFacesResponse
s {$sel:nextToken:ListFacesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListFacesResponse)

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

instance Prelude.NFData ListFacesResponse where
  rnf :: ListFacesResponse -> ()
rnf ListFacesResponse' {Int
Maybe [Face]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
faces :: Maybe [Face]
faceModelVersion :: Maybe Text
$sel:httpStatus:ListFacesResponse' :: ListFacesResponse -> Int
$sel:nextToken:ListFacesResponse' :: ListFacesResponse -> Maybe Text
$sel:faces:ListFacesResponse' :: ListFacesResponse -> Maybe [Face]
$sel:faceModelVersion:ListFacesResponse' :: ListFacesResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
faceModelVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Face]
faces
      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 Int
httpStatus