{-# 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.DetectCustomLabels
-- 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 custom labels in a supplied image by using an Amazon Rekognition
-- Custom Labels model.
--
-- You specify which version of a model version to use by using the
-- @ProjectVersionArn@ input parameter.
--
-- You pass the input image 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 each object that the model version detects on an image, the API
-- returns a (@CustomLabel@) object in an array (@CustomLabels@). Each
-- @CustomLabel@ object provides the label name (@Name@), the level of
-- confidence that the image contains the object (@Confidence@), and object
-- location information, if it exists, for the label on the image
-- (@Geometry@).
--
-- To filter labels that are returned, specify a value for @MinConfidence@.
-- @DetectCustomLabelsLabels@ only returns labels with a confidence that\'s
-- higher than the specified value. The value of @MinConfidence@ maps to
-- the assumed threshold values created during training. For more
-- information, see /Assumed threshold/ in the Amazon Rekognition Custom
-- Labels Developer Guide. Amazon Rekognition Custom Labels metrics
-- expresses an assumed threshold as a floating point value between 0-1.
-- The range of @MinConfidence@ normalizes the threshold value to a
-- percentage value (0-100). Confidence responses from @DetectCustomLabels@
-- are also returned as a percentage. You can use @MinConfidence@ to change
-- the precision and recall or your model. For more information, see
-- /Analyzing an image/ in the Amazon Rekognition Custom Labels Developer
-- Guide.
--
-- If you don\'t specify a value for @MinConfidence@, @DetectCustomLabels@
-- returns labels based on the assumed threshold of each label.
--
-- This is a stateless API operation. That is, the operation does not
-- persist any data.
--
-- This operation requires permissions to perform the
-- @rekognition:DetectCustomLabels@ action.
--
-- For more information, see /Analyzing an image/ in the Amazon Rekognition
-- Custom Labels Developer Guide.
module Amazonka.Rekognition.DetectCustomLabels
  ( -- * Creating a Request
    DetectCustomLabels (..),
    newDetectCustomLabels,

    -- * Request Lenses
    detectCustomLabels_maxResults,
    detectCustomLabels_minConfidence,
    detectCustomLabels_projectVersionArn,
    detectCustomLabels_image,

    -- * Destructuring the Response
    DetectCustomLabelsResponse (..),
    newDetectCustomLabelsResponse,

    -- * Response Lenses
    detectCustomLabelsResponse_customLabels,
    detectCustomLabelsResponse_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:/ 'newDetectCustomLabels' smart constructor.
data DetectCustomLabels = DetectCustomLabels'
  { -- | Maximum number of results you want the service to return in the
    -- response. The service returns the specified number of highest confidence
    -- labels ranked from highest confidence to lowest.
    DetectCustomLabels -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Specifies the minimum confidence level for the labels to return.
    -- @DetectCustomLabels@ doesn\'t return any labels with a confidence value
    -- that\'s lower than this specified value. If you specify a value of 0,
    -- @DetectCustomLabels@ returns all labels, regardless of the assumed
    -- threshold applied to each label. If you don\'t specify a value for
    -- @MinConfidence@, @DetectCustomLabels@ returns labels based on the
    -- assumed threshold of each label.
    DetectCustomLabels -> Maybe Double
minConfidence :: Prelude.Maybe Prelude.Double,
    -- | The ARN of the model version that you want to use.
    DetectCustomLabels -> Text
projectVersionArn :: Prelude.Text,
    DetectCustomLabels -> Image
image :: Image
  }
  deriving (DetectCustomLabels -> DetectCustomLabels -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectCustomLabels -> DetectCustomLabels -> Bool
$c/= :: DetectCustomLabels -> DetectCustomLabels -> Bool
== :: DetectCustomLabels -> DetectCustomLabels -> Bool
$c== :: DetectCustomLabels -> DetectCustomLabels -> Bool
Prelude.Eq, ReadPrec [DetectCustomLabels]
ReadPrec DetectCustomLabels
Int -> ReadS DetectCustomLabels
ReadS [DetectCustomLabels]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetectCustomLabels]
$creadListPrec :: ReadPrec [DetectCustomLabels]
readPrec :: ReadPrec DetectCustomLabels
$creadPrec :: ReadPrec DetectCustomLabels
readList :: ReadS [DetectCustomLabels]
$creadList :: ReadS [DetectCustomLabels]
readsPrec :: Int -> ReadS DetectCustomLabels
$creadsPrec :: Int -> ReadS DetectCustomLabels
Prelude.Read, Int -> DetectCustomLabels -> ShowS
[DetectCustomLabels] -> ShowS
DetectCustomLabels -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectCustomLabels] -> ShowS
$cshowList :: [DetectCustomLabels] -> ShowS
show :: DetectCustomLabels -> String
$cshow :: DetectCustomLabels -> String
showsPrec :: Int -> DetectCustomLabels -> ShowS
$cshowsPrec :: Int -> DetectCustomLabels -> ShowS
Prelude.Show, forall x. Rep DetectCustomLabels x -> DetectCustomLabels
forall x. DetectCustomLabels -> Rep DetectCustomLabels x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetectCustomLabels x -> DetectCustomLabels
$cfrom :: forall x. DetectCustomLabels -> Rep DetectCustomLabels x
Prelude.Generic)

-- |
-- Create a value of 'DetectCustomLabels' 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', 'detectCustomLabels_maxResults' - Maximum number of results you want the service to return in the
-- response. The service returns the specified number of highest confidence
-- labels ranked from highest confidence to lowest.
--
-- 'minConfidence', 'detectCustomLabels_minConfidence' - Specifies the minimum confidence level for the labels to return.
-- @DetectCustomLabels@ doesn\'t return any labels with a confidence value
-- that\'s lower than this specified value. If you specify a value of 0,
-- @DetectCustomLabels@ returns all labels, regardless of the assumed
-- threshold applied to each label. If you don\'t specify a value for
-- @MinConfidence@, @DetectCustomLabels@ returns labels based on the
-- assumed threshold of each label.
--
-- 'projectVersionArn', 'detectCustomLabels_projectVersionArn' - The ARN of the model version that you want to use.
--
-- 'image', 'detectCustomLabels_image' - Undocumented member.
newDetectCustomLabels ::
  -- | 'projectVersionArn'
  Prelude.Text ->
  -- | 'image'
  Image ->
  DetectCustomLabels
newDetectCustomLabels :: Text -> Image -> DetectCustomLabels
newDetectCustomLabels Text
pProjectVersionArn_ Image
pImage_ =
  DetectCustomLabels'
    { $sel:maxResults:DetectCustomLabels' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:minConfidence:DetectCustomLabels' :: Maybe Double
minConfidence = forall a. Maybe a
Prelude.Nothing,
      $sel:projectVersionArn:DetectCustomLabels' :: Text
projectVersionArn = Text
pProjectVersionArn_,
      $sel:image:DetectCustomLabels' :: Image
image = Image
pImage_
    }

-- | Maximum number of results you want the service to return in the
-- response. The service returns the specified number of highest confidence
-- labels ranked from highest confidence to lowest.
detectCustomLabels_maxResults :: Lens.Lens' DetectCustomLabels (Prelude.Maybe Prelude.Natural)
detectCustomLabels_maxResults :: Lens' DetectCustomLabels (Maybe Natural)
detectCustomLabels_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectCustomLabels' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DetectCustomLabels' :: DetectCustomLabels -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DetectCustomLabels
s@DetectCustomLabels' {} Maybe Natural
a -> DetectCustomLabels
s {$sel:maxResults:DetectCustomLabels' :: Maybe Natural
maxResults = Maybe Natural
a} :: DetectCustomLabels)

-- | Specifies the minimum confidence level for the labels to return.
-- @DetectCustomLabels@ doesn\'t return any labels with a confidence value
-- that\'s lower than this specified value. If you specify a value of 0,
-- @DetectCustomLabels@ returns all labels, regardless of the assumed
-- threshold applied to each label. If you don\'t specify a value for
-- @MinConfidence@, @DetectCustomLabels@ returns labels based on the
-- assumed threshold of each label.
detectCustomLabels_minConfidence :: Lens.Lens' DetectCustomLabels (Prelude.Maybe Prelude.Double)
detectCustomLabels_minConfidence :: Lens' DetectCustomLabels (Maybe Double)
detectCustomLabels_minConfidence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectCustomLabels' {Maybe Double
minConfidence :: Maybe Double
$sel:minConfidence:DetectCustomLabels' :: DetectCustomLabels -> Maybe Double
minConfidence} -> Maybe Double
minConfidence) (\s :: DetectCustomLabels
s@DetectCustomLabels' {} Maybe Double
a -> DetectCustomLabels
s {$sel:minConfidence:DetectCustomLabels' :: Maybe Double
minConfidence = Maybe Double
a} :: DetectCustomLabels)

-- | The ARN of the model version that you want to use.
detectCustomLabels_projectVersionArn :: Lens.Lens' DetectCustomLabels Prelude.Text
detectCustomLabels_projectVersionArn :: Lens' DetectCustomLabels Text
detectCustomLabels_projectVersionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectCustomLabels' {Text
projectVersionArn :: Text
$sel:projectVersionArn:DetectCustomLabels' :: DetectCustomLabels -> Text
projectVersionArn} -> Text
projectVersionArn) (\s :: DetectCustomLabels
s@DetectCustomLabels' {} Text
a -> DetectCustomLabels
s {$sel:projectVersionArn:DetectCustomLabels' :: Text
projectVersionArn = Text
a} :: DetectCustomLabels)

-- | Undocumented member.
detectCustomLabels_image :: Lens.Lens' DetectCustomLabels Image
detectCustomLabels_image :: Lens' DetectCustomLabels Image
detectCustomLabels_image = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectCustomLabels' {Image
image :: Image
$sel:image:DetectCustomLabels' :: DetectCustomLabels -> Image
image} -> Image
image) (\s :: DetectCustomLabels
s@DetectCustomLabels' {} Image
a -> DetectCustomLabels
s {$sel:image:DetectCustomLabels' :: Image
image = Image
a} :: DetectCustomLabels)

instance Core.AWSRequest DetectCustomLabels where
  type
    AWSResponse DetectCustomLabels =
      DetectCustomLabelsResponse
  request :: (Service -> Service)
-> DetectCustomLabels -> Request DetectCustomLabels
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 DetectCustomLabels
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DetectCustomLabels)))
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 [CustomLabel] -> Int -> DetectCustomLabelsResponse
DetectCustomLabelsResponse'
            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
"CustomLabels" 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 DetectCustomLabels where
  hashWithSalt :: Int -> DetectCustomLabels -> Int
hashWithSalt Int
_salt DetectCustomLabels' {Maybe Double
Maybe Natural
Text
Image
image :: Image
projectVersionArn :: Text
minConfidence :: Maybe Double
maxResults :: Maybe Natural
$sel:image:DetectCustomLabels' :: DetectCustomLabels -> Image
$sel:projectVersionArn:DetectCustomLabels' :: DetectCustomLabels -> Text
$sel:minConfidence:DetectCustomLabels' :: DetectCustomLabels -> Maybe Double
$sel:maxResults:DetectCustomLabels' :: DetectCustomLabels -> 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 Double
minConfidence
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
projectVersionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Image
image

instance Prelude.NFData DetectCustomLabels where
  rnf :: DetectCustomLabels -> ()
rnf DetectCustomLabels' {Maybe Double
Maybe Natural
Text
Image
image :: Image
projectVersionArn :: Text
minConfidence :: Maybe Double
maxResults :: Maybe Natural
$sel:image:DetectCustomLabels' :: DetectCustomLabels -> Image
$sel:projectVersionArn:DetectCustomLabels' :: DetectCustomLabels -> Text
$sel:minConfidence:DetectCustomLabels' :: DetectCustomLabels -> Maybe Double
$sel:maxResults:DetectCustomLabels' :: DetectCustomLabels -> 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 Double
minConfidence
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
projectVersionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Image
image

instance Data.ToHeaders DetectCustomLabels where
  toHeaders :: DetectCustomLabels -> 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.DetectCustomLabels" ::
                          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 DetectCustomLabels where
  toJSON :: DetectCustomLabels -> Value
toJSON DetectCustomLabels' {Maybe Double
Maybe Natural
Text
Image
image :: Image
projectVersionArn :: Text
minConfidence :: Maybe Double
maxResults :: Maybe Natural
$sel:image:DetectCustomLabels' :: DetectCustomLabels -> Image
$sel:projectVersionArn:DetectCustomLabels' :: DetectCustomLabels -> Text
$sel:minConfidence:DetectCustomLabels' :: DetectCustomLabels -> Maybe Double
$sel:maxResults:DetectCustomLabels' :: DetectCustomLabels -> 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
"MinConfidence" 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
minConfidence,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ProjectVersionArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
projectVersionArn),
            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 DetectCustomLabels where
  toPath :: DetectCustomLabels -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDetectCustomLabelsResponse' smart constructor.
data DetectCustomLabelsResponse = DetectCustomLabelsResponse'
  { -- | An array of custom labels detected in the input image.
    DetectCustomLabelsResponse -> Maybe [CustomLabel]
customLabels :: Prelude.Maybe [CustomLabel],
    -- | The response's http status code.
    DetectCustomLabelsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DetectCustomLabelsResponse -> DetectCustomLabelsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetectCustomLabelsResponse -> DetectCustomLabelsResponse -> Bool
$c/= :: DetectCustomLabelsResponse -> DetectCustomLabelsResponse -> Bool
== :: DetectCustomLabelsResponse -> DetectCustomLabelsResponse -> Bool
$c== :: DetectCustomLabelsResponse -> DetectCustomLabelsResponse -> Bool
Prelude.Eq, ReadPrec [DetectCustomLabelsResponse]
ReadPrec DetectCustomLabelsResponse
Int -> ReadS DetectCustomLabelsResponse
ReadS [DetectCustomLabelsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetectCustomLabelsResponse]
$creadListPrec :: ReadPrec [DetectCustomLabelsResponse]
readPrec :: ReadPrec DetectCustomLabelsResponse
$creadPrec :: ReadPrec DetectCustomLabelsResponse
readList :: ReadS [DetectCustomLabelsResponse]
$creadList :: ReadS [DetectCustomLabelsResponse]
readsPrec :: Int -> ReadS DetectCustomLabelsResponse
$creadsPrec :: Int -> ReadS DetectCustomLabelsResponse
Prelude.Read, Int -> DetectCustomLabelsResponse -> ShowS
[DetectCustomLabelsResponse] -> ShowS
DetectCustomLabelsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetectCustomLabelsResponse] -> ShowS
$cshowList :: [DetectCustomLabelsResponse] -> ShowS
show :: DetectCustomLabelsResponse -> String
$cshow :: DetectCustomLabelsResponse -> String
showsPrec :: Int -> DetectCustomLabelsResponse -> ShowS
$cshowsPrec :: Int -> DetectCustomLabelsResponse -> ShowS
Prelude.Show, forall x.
Rep DetectCustomLabelsResponse x -> DetectCustomLabelsResponse
forall x.
DetectCustomLabelsResponse -> Rep DetectCustomLabelsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DetectCustomLabelsResponse x -> DetectCustomLabelsResponse
$cfrom :: forall x.
DetectCustomLabelsResponse -> Rep DetectCustomLabelsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DetectCustomLabelsResponse' 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:
--
-- 'customLabels', 'detectCustomLabelsResponse_customLabels' - An array of custom labels detected in the input image.
--
-- 'httpStatus', 'detectCustomLabelsResponse_httpStatus' - The response's http status code.
newDetectCustomLabelsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DetectCustomLabelsResponse
newDetectCustomLabelsResponse :: Int -> DetectCustomLabelsResponse
newDetectCustomLabelsResponse Int
pHttpStatus_ =
  DetectCustomLabelsResponse'
    { $sel:customLabels:DetectCustomLabelsResponse' :: Maybe [CustomLabel]
customLabels =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DetectCustomLabelsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of custom labels detected in the input image.
detectCustomLabelsResponse_customLabels :: Lens.Lens' DetectCustomLabelsResponse (Prelude.Maybe [CustomLabel])
detectCustomLabelsResponse_customLabels :: Lens' DetectCustomLabelsResponse (Maybe [CustomLabel])
detectCustomLabelsResponse_customLabels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectCustomLabelsResponse' {Maybe [CustomLabel]
customLabels :: Maybe [CustomLabel]
$sel:customLabels:DetectCustomLabelsResponse' :: DetectCustomLabelsResponse -> Maybe [CustomLabel]
customLabels} -> Maybe [CustomLabel]
customLabels) (\s :: DetectCustomLabelsResponse
s@DetectCustomLabelsResponse' {} Maybe [CustomLabel]
a -> DetectCustomLabelsResponse
s {$sel:customLabels:DetectCustomLabelsResponse' :: Maybe [CustomLabel]
customLabels = Maybe [CustomLabel]
a} :: DetectCustomLabelsResponse) 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.
detectCustomLabelsResponse_httpStatus :: Lens.Lens' DetectCustomLabelsResponse Prelude.Int
detectCustomLabelsResponse_httpStatus :: Lens' DetectCustomLabelsResponse Int
detectCustomLabelsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetectCustomLabelsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DetectCustomLabelsResponse' :: DetectCustomLabelsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DetectCustomLabelsResponse
s@DetectCustomLabelsResponse' {} Int
a -> DetectCustomLabelsResponse
s {$sel:httpStatus:DetectCustomLabelsResponse' :: Int
httpStatus = Int
a} :: DetectCustomLabelsResponse)

instance Prelude.NFData DetectCustomLabelsResponse where
  rnf :: DetectCustomLabelsResponse -> ()
rnf DetectCustomLabelsResponse' {Int
Maybe [CustomLabel]
httpStatus :: Int
customLabels :: Maybe [CustomLabel]
$sel:httpStatus:DetectCustomLabelsResponse' :: DetectCustomLabelsResponse -> Int
$sel:customLabels:DetectCustomLabelsResponse' :: DetectCustomLabelsResponse -> Maybe [CustomLabel]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CustomLabel]
customLabels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus