{-# 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.SearchFaces
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- For a given input face ID, searches for matching faces in the collection
-- the face belongs to. You get a face ID when you add a face to the
-- collection using the IndexFaces operation. The operation compares the
-- features of the input face with faces in the specified collection.
--
-- You can also search faces without indexing faces by using the
-- @SearchFacesByImage@ operation.
--
-- The operation response returns an array of faces that match, ordered by
-- similarity score with the highest similarity first. More specifically,
-- it is an array of metadata for each face match that is found. Along with
-- the metadata, the response also includes a @confidence@ value for each
-- face match, indicating the confidence that the specific face matches the
-- input face.
--
-- For an example, see Searching for a face using its face ID in the Amazon
-- Rekognition Developer Guide.
--
-- This operation requires permissions to perform the
-- @rekognition:SearchFaces@ action.
module Amazonka.Rekognition.SearchFaces
  ( -- * Creating a Request
    SearchFaces (..),
    newSearchFaces,

    -- * Request Lenses
    searchFaces_faceMatchThreshold,
    searchFaces_maxFaces,
    searchFaces_collectionId,
    searchFaces_faceId,

    -- * Destructuring the Response
    SearchFacesResponse (..),
    newSearchFacesResponse,

    -- * Response Lenses
    searchFacesResponse_faceMatches,
    searchFacesResponse_faceModelVersion,
    searchFacesResponse_searchedFaceId,
    searchFacesResponse_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:/ 'newSearchFaces' smart constructor.
data SearchFaces = SearchFaces'
  { -- | Optional value specifying the minimum confidence in the face match to
    -- return. For example, don\'t return any matches where confidence in
    -- matches is less than 70%. The default value is 80%.
    SearchFaces -> Maybe Double
faceMatchThreshold :: Prelude.Maybe Prelude.Double,
    -- | Maximum number of faces to return. The operation returns the maximum
    -- number of faces with the highest confidence in the match.
    SearchFaces -> Maybe Natural
maxFaces :: Prelude.Maybe Prelude.Natural,
    -- | ID of the collection the face belongs to.
    SearchFaces -> Text
collectionId :: Prelude.Text,
    -- | ID of a face to find matches for in the collection.
    SearchFaces -> Text
faceId :: Prelude.Text
  }
  deriving (SearchFaces -> SearchFaces -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchFaces -> SearchFaces -> Bool
$c/= :: SearchFaces -> SearchFaces -> Bool
== :: SearchFaces -> SearchFaces -> Bool
$c== :: SearchFaces -> SearchFaces -> Bool
Prelude.Eq, ReadPrec [SearchFaces]
ReadPrec SearchFaces
Int -> ReadS SearchFaces
ReadS [SearchFaces]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SearchFaces]
$creadListPrec :: ReadPrec [SearchFaces]
readPrec :: ReadPrec SearchFaces
$creadPrec :: ReadPrec SearchFaces
readList :: ReadS [SearchFaces]
$creadList :: ReadS [SearchFaces]
readsPrec :: Int -> ReadS SearchFaces
$creadsPrec :: Int -> ReadS SearchFaces
Prelude.Read, Int -> SearchFaces -> ShowS
[SearchFaces] -> ShowS
SearchFaces -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchFaces] -> ShowS
$cshowList :: [SearchFaces] -> ShowS
show :: SearchFaces -> String
$cshow :: SearchFaces -> String
showsPrec :: Int -> SearchFaces -> ShowS
$cshowsPrec :: Int -> SearchFaces -> ShowS
Prelude.Show, forall x. Rep SearchFaces x -> SearchFaces
forall x. SearchFaces -> Rep SearchFaces x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchFaces x -> SearchFaces
$cfrom :: forall x. SearchFaces -> Rep SearchFaces x
Prelude.Generic)

-- |
-- Create a value of 'SearchFaces' 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:
--
-- 'faceMatchThreshold', 'searchFaces_faceMatchThreshold' - Optional value specifying the minimum confidence in the face match to
-- return. For example, don\'t return any matches where confidence in
-- matches is less than 70%. The default value is 80%.
--
-- 'maxFaces', 'searchFaces_maxFaces' - Maximum number of faces to return. The operation returns the maximum
-- number of faces with the highest confidence in the match.
--
-- 'collectionId', 'searchFaces_collectionId' - ID of the collection the face belongs to.
--
-- 'faceId', 'searchFaces_faceId' - ID of a face to find matches for in the collection.
newSearchFaces ::
  -- | 'collectionId'
  Prelude.Text ->
  -- | 'faceId'
  Prelude.Text ->
  SearchFaces
newSearchFaces :: Text -> Text -> SearchFaces
newSearchFaces Text
pCollectionId_ Text
pFaceId_ =
  SearchFaces'
    { $sel:faceMatchThreshold:SearchFaces' :: Maybe Double
faceMatchThreshold = forall a. Maybe a
Prelude.Nothing,
      $sel:maxFaces:SearchFaces' :: Maybe Natural
maxFaces = forall a. Maybe a
Prelude.Nothing,
      $sel:collectionId:SearchFaces' :: Text
collectionId = Text
pCollectionId_,
      $sel:faceId:SearchFaces' :: Text
faceId = Text
pFaceId_
    }

-- | Optional value specifying the minimum confidence in the face match to
-- return. For example, don\'t return any matches where confidence in
-- matches is less than 70%. The default value is 80%.
searchFaces_faceMatchThreshold :: Lens.Lens' SearchFaces (Prelude.Maybe Prelude.Double)
searchFaces_faceMatchThreshold :: Lens' SearchFaces (Maybe Double)
searchFaces_faceMatchThreshold = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchFaces' {Maybe Double
faceMatchThreshold :: Maybe Double
$sel:faceMatchThreshold:SearchFaces' :: SearchFaces -> Maybe Double
faceMatchThreshold} -> Maybe Double
faceMatchThreshold) (\s :: SearchFaces
s@SearchFaces' {} Maybe Double
a -> SearchFaces
s {$sel:faceMatchThreshold:SearchFaces' :: Maybe Double
faceMatchThreshold = Maybe Double
a} :: SearchFaces)

-- | Maximum number of faces to return. The operation returns the maximum
-- number of faces with the highest confidence in the match.
searchFaces_maxFaces :: Lens.Lens' SearchFaces (Prelude.Maybe Prelude.Natural)
searchFaces_maxFaces :: Lens' SearchFaces (Maybe Natural)
searchFaces_maxFaces = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchFaces' {Maybe Natural
maxFaces :: Maybe Natural
$sel:maxFaces:SearchFaces' :: SearchFaces -> Maybe Natural
maxFaces} -> Maybe Natural
maxFaces) (\s :: SearchFaces
s@SearchFaces' {} Maybe Natural
a -> SearchFaces
s {$sel:maxFaces:SearchFaces' :: Maybe Natural
maxFaces = Maybe Natural
a} :: SearchFaces)

-- | ID of the collection the face belongs to.
searchFaces_collectionId :: Lens.Lens' SearchFaces Prelude.Text
searchFaces_collectionId :: Lens' SearchFaces Text
searchFaces_collectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchFaces' {Text
collectionId :: Text
$sel:collectionId:SearchFaces' :: SearchFaces -> Text
collectionId} -> Text
collectionId) (\s :: SearchFaces
s@SearchFaces' {} Text
a -> SearchFaces
s {$sel:collectionId:SearchFaces' :: Text
collectionId = Text
a} :: SearchFaces)

-- | ID of a face to find matches for in the collection.
searchFaces_faceId :: Lens.Lens' SearchFaces Prelude.Text
searchFaces_faceId :: Lens' SearchFaces Text
searchFaces_faceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchFaces' {Text
faceId :: Text
$sel:faceId:SearchFaces' :: SearchFaces -> Text
faceId} -> Text
faceId) (\s :: SearchFaces
s@SearchFaces' {} Text
a -> SearchFaces
s {$sel:faceId:SearchFaces' :: Text
faceId = Text
a} :: SearchFaces)

instance Core.AWSRequest SearchFaces where
  type AWSResponse SearchFaces = SearchFacesResponse
  request :: (Service -> Service) -> SearchFaces -> Request SearchFaces
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 SearchFaces
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SearchFaces)))
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 [FaceMatch]
-> Maybe Text -> Maybe Text -> Int -> SearchFacesResponse
SearchFacesResponse'
            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
"FaceMatches" 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
"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
"SearchedFaceId")
            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 SearchFaces where
  hashWithSalt :: Int -> SearchFaces -> Int
hashWithSalt Int
_salt SearchFaces' {Maybe Double
Maybe Natural
Text
faceId :: Text
collectionId :: Text
maxFaces :: Maybe Natural
faceMatchThreshold :: Maybe Double
$sel:faceId:SearchFaces' :: SearchFaces -> Text
$sel:collectionId:SearchFaces' :: SearchFaces -> Text
$sel:maxFaces:SearchFaces' :: SearchFaces -> Maybe Natural
$sel:faceMatchThreshold:SearchFaces' :: SearchFaces -> Maybe Double
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
faceMatchThreshold
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxFaces
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
collectionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
faceId

instance Prelude.NFData SearchFaces where
  rnf :: SearchFaces -> ()
rnf SearchFaces' {Maybe Double
Maybe Natural
Text
faceId :: Text
collectionId :: Text
maxFaces :: Maybe Natural
faceMatchThreshold :: Maybe Double
$sel:faceId:SearchFaces' :: SearchFaces -> Text
$sel:collectionId:SearchFaces' :: SearchFaces -> Text
$sel:maxFaces:SearchFaces' :: SearchFaces -> Maybe Natural
$sel:faceMatchThreshold:SearchFaces' :: SearchFaces -> Maybe Double
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
faceMatchThreshold
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxFaces
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
collectionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
faceId

instance Data.ToHeaders SearchFaces where
  toHeaders :: SearchFaces -> 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.SearchFaces" ::
                          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 SearchFaces where
  toJSON :: SearchFaces -> Value
toJSON SearchFaces' {Maybe Double
Maybe Natural
Text
faceId :: Text
collectionId :: Text
maxFaces :: Maybe Natural
faceMatchThreshold :: Maybe Double
$sel:faceId:SearchFaces' :: SearchFaces -> Text
$sel:collectionId:SearchFaces' :: SearchFaces -> Text
$sel:maxFaces:SearchFaces' :: SearchFaces -> Maybe Natural
$sel:faceMatchThreshold:SearchFaces' :: SearchFaces -> Maybe Double
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"FaceMatchThreshold" 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 Double
faceMatchThreshold,
            (Key
"MaxFaces" 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
maxFaces,
            forall a. a -> Maybe a
Prelude.Just (Key
"CollectionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
collectionId),
            forall a. a -> Maybe a
Prelude.Just (Key
"FaceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
faceId)
          ]
      )

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

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

-- | /See:/ 'newSearchFacesResponse' smart constructor.
data SearchFacesResponse = SearchFacesResponse'
  { -- | An array of faces that matched the input face, along with the confidence
    -- in the match.
    SearchFacesResponse -> Maybe [FaceMatch]
faceMatches :: Prelude.Maybe [FaceMatch],
    -- | Version number of the face detection model associated with the input
    -- collection (@CollectionId@).
    SearchFacesResponse -> Maybe Text
faceModelVersion :: Prelude.Maybe Prelude.Text,
    -- | ID of the face that was searched for matches in a collection.
    SearchFacesResponse -> Maybe Text
searchedFaceId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    SearchFacesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SearchFacesResponse -> SearchFacesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchFacesResponse -> SearchFacesResponse -> Bool
$c/= :: SearchFacesResponse -> SearchFacesResponse -> Bool
== :: SearchFacesResponse -> SearchFacesResponse -> Bool
$c== :: SearchFacesResponse -> SearchFacesResponse -> Bool
Prelude.Eq, ReadPrec [SearchFacesResponse]
ReadPrec SearchFacesResponse
Int -> ReadS SearchFacesResponse
ReadS [SearchFacesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SearchFacesResponse]
$creadListPrec :: ReadPrec [SearchFacesResponse]
readPrec :: ReadPrec SearchFacesResponse
$creadPrec :: ReadPrec SearchFacesResponse
readList :: ReadS [SearchFacesResponse]
$creadList :: ReadS [SearchFacesResponse]
readsPrec :: Int -> ReadS SearchFacesResponse
$creadsPrec :: Int -> ReadS SearchFacesResponse
Prelude.Read, Int -> SearchFacesResponse -> ShowS
[SearchFacesResponse] -> ShowS
SearchFacesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchFacesResponse] -> ShowS
$cshowList :: [SearchFacesResponse] -> ShowS
show :: SearchFacesResponse -> String
$cshow :: SearchFacesResponse -> String
showsPrec :: Int -> SearchFacesResponse -> ShowS
$cshowsPrec :: Int -> SearchFacesResponse -> ShowS
Prelude.Show, forall x. Rep SearchFacesResponse x -> SearchFacesResponse
forall x. SearchFacesResponse -> Rep SearchFacesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchFacesResponse x -> SearchFacesResponse
$cfrom :: forall x. SearchFacesResponse -> Rep SearchFacesResponse x
Prelude.Generic)

-- |
-- Create a value of 'SearchFacesResponse' 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:
--
-- 'faceMatches', 'searchFacesResponse_faceMatches' - An array of faces that matched the input face, along with the confidence
-- in the match.
--
-- 'faceModelVersion', 'searchFacesResponse_faceModelVersion' - Version number of the face detection model associated with the input
-- collection (@CollectionId@).
--
-- 'searchedFaceId', 'searchFacesResponse_searchedFaceId' - ID of the face that was searched for matches in a collection.
--
-- 'httpStatus', 'searchFacesResponse_httpStatus' - The response's http status code.
newSearchFacesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SearchFacesResponse
newSearchFacesResponse :: Int -> SearchFacesResponse
newSearchFacesResponse Int
pHttpStatus_ =
  SearchFacesResponse'
    { $sel:faceMatches:SearchFacesResponse' :: Maybe [FaceMatch]
faceMatches = forall a. Maybe a
Prelude.Nothing,
      $sel:faceModelVersion:SearchFacesResponse' :: Maybe Text
faceModelVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:searchedFaceId:SearchFacesResponse' :: Maybe Text
searchedFaceId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SearchFacesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of faces that matched the input face, along with the confidence
-- in the match.
searchFacesResponse_faceMatches :: Lens.Lens' SearchFacesResponse (Prelude.Maybe [FaceMatch])
searchFacesResponse_faceMatches :: Lens' SearchFacesResponse (Maybe [FaceMatch])
searchFacesResponse_faceMatches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchFacesResponse' {Maybe [FaceMatch]
faceMatches :: Maybe [FaceMatch]
$sel:faceMatches:SearchFacesResponse' :: SearchFacesResponse -> Maybe [FaceMatch]
faceMatches} -> Maybe [FaceMatch]
faceMatches) (\s :: SearchFacesResponse
s@SearchFacesResponse' {} Maybe [FaceMatch]
a -> SearchFacesResponse
s {$sel:faceMatches:SearchFacesResponse' :: Maybe [FaceMatch]
faceMatches = Maybe [FaceMatch]
a} :: SearchFacesResponse) 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

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

-- | ID of the face that was searched for matches in a collection.
searchFacesResponse_searchedFaceId :: Lens.Lens' SearchFacesResponse (Prelude.Maybe Prelude.Text)
searchFacesResponse_searchedFaceId :: Lens' SearchFacesResponse (Maybe Text)
searchFacesResponse_searchedFaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchFacesResponse' {Maybe Text
searchedFaceId :: Maybe Text
$sel:searchedFaceId:SearchFacesResponse' :: SearchFacesResponse -> Maybe Text
searchedFaceId} -> Maybe Text
searchedFaceId) (\s :: SearchFacesResponse
s@SearchFacesResponse' {} Maybe Text
a -> SearchFacesResponse
s {$sel:searchedFaceId:SearchFacesResponse' :: Maybe Text
searchedFaceId = Maybe Text
a} :: SearchFacesResponse)

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

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