{-# 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.GetCelebrityInfo
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the name and additional information about a celebrity based on
-- their Amazon Rekognition ID. The additional information is returned as
-- an array of URLs. If there is no additional information about the
-- celebrity, this list is empty.
--
-- For more information, see Getting information about a celebrity in the
-- Amazon Rekognition Developer Guide.
--
-- This operation requires permissions to perform the
-- @rekognition:GetCelebrityInfo@ action.
module Amazonka.Rekognition.GetCelebrityInfo
  ( -- * Creating a Request
    GetCelebrityInfo (..),
    newGetCelebrityInfo,

    -- * Request Lenses
    getCelebrityInfo_id,

    -- * Destructuring the Response
    GetCelebrityInfoResponse (..),
    newGetCelebrityInfoResponse,

    -- * Response Lenses
    getCelebrityInfoResponse_knownGender,
    getCelebrityInfoResponse_name,
    getCelebrityInfoResponse_urls,
    getCelebrityInfoResponse_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:/ 'newGetCelebrityInfo' smart constructor.
data GetCelebrityInfo = GetCelebrityInfo'
  { -- | The ID for the celebrity. You get the celebrity ID from a call to the
    -- RecognizeCelebrities operation, which recognizes celebrities in an
    -- image.
    GetCelebrityInfo -> Text
id :: Prelude.Text
  }
  deriving (GetCelebrityInfo -> GetCelebrityInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCelebrityInfo -> GetCelebrityInfo -> Bool
$c/= :: GetCelebrityInfo -> GetCelebrityInfo -> Bool
== :: GetCelebrityInfo -> GetCelebrityInfo -> Bool
$c== :: GetCelebrityInfo -> GetCelebrityInfo -> Bool
Prelude.Eq, ReadPrec [GetCelebrityInfo]
ReadPrec GetCelebrityInfo
Int -> ReadS GetCelebrityInfo
ReadS [GetCelebrityInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCelebrityInfo]
$creadListPrec :: ReadPrec [GetCelebrityInfo]
readPrec :: ReadPrec GetCelebrityInfo
$creadPrec :: ReadPrec GetCelebrityInfo
readList :: ReadS [GetCelebrityInfo]
$creadList :: ReadS [GetCelebrityInfo]
readsPrec :: Int -> ReadS GetCelebrityInfo
$creadsPrec :: Int -> ReadS GetCelebrityInfo
Prelude.Read, Int -> GetCelebrityInfo -> ShowS
[GetCelebrityInfo] -> ShowS
GetCelebrityInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCelebrityInfo] -> ShowS
$cshowList :: [GetCelebrityInfo] -> ShowS
show :: GetCelebrityInfo -> String
$cshow :: GetCelebrityInfo -> String
showsPrec :: Int -> GetCelebrityInfo -> ShowS
$cshowsPrec :: Int -> GetCelebrityInfo -> ShowS
Prelude.Show, forall x. Rep GetCelebrityInfo x -> GetCelebrityInfo
forall x. GetCelebrityInfo -> Rep GetCelebrityInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCelebrityInfo x -> GetCelebrityInfo
$cfrom :: forall x. GetCelebrityInfo -> Rep GetCelebrityInfo x
Prelude.Generic)

-- |
-- Create a value of 'GetCelebrityInfo' 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:
--
-- 'id', 'getCelebrityInfo_id' - The ID for the celebrity. You get the celebrity ID from a call to the
-- RecognizeCelebrities operation, which recognizes celebrities in an
-- image.
newGetCelebrityInfo ::
  -- | 'id'
  Prelude.Text ->
  GetCelebrityInfo
newGetCelebrityInfo :: Text -> GetCelebrityInfo
newGetCelebrityInfo Text
pId_ =
  GetCelebrityInfo' {$sel:id:GetCelebrityInfo' :: Text
id = Text
pId_}

-- | The ID for the celebrity. You get the celebrity ID from a call to the
-- RecognizeCelebrities operation, which recognizes celebrities in an
-- image.
getCelebrityInfo_id :: Lens.Lens' GetCelebrityInfo Prelude.Text
getCelebrityInfo_id :: Lens' GetCelebrityInfo Text
getCelebrityInfo_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCelebrityInfo' {Text
id :: Text
$sel:id:GetCelebrityInfo' :: GetCelebrityInfo -> Text
id} -> Text
id) (\s :: GetCelebrityInfo
s@GetCelebrityInfo' {} Text
a -> GetCelebrityInfo
s {$sel:id:GetCelebrityInfo' :: Text
id = Text
a} :: GetCelebrityInfo)

instance Core.AWSRequest GetCelebrityInfo where
  type
    AWSResponse GetCelebrityInfo =
      GetCelebrityInfoResponse
  request :: (Service -> Service)
-> GetCelebrityInfo -> Request GetCelebrityInfo
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 GetCelebrityInfo
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetCelebrityInfo)))
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 KnownGender
-> Maybe Text -> Maybe [Text] -> Int -> GetCelebrityInfoResponse
GetCelebrityInfoResponse'
            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
"KnownGender")
            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
"Name")
            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
"Urls" 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 GetCelebrityInfo where
  hashWithSalt :: Int -> GetCelebrityInfo -> Int
hashWithSalt Int
_salt GetCelebrityInfo' {Text
id :: Text
$sel:id:GetCelebrityInfo' :: GetCelebrityInfo -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData GetCelebrityInfo where
  rnf :: GetCelebrityInfo -> ()
rnf GetCelebrityInfo' {Text
id :: Text
$sel:id:GetCelebrityInfo' :: GetCelebrityInfo -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
id

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

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

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

-- | /See:/ 'newGetCelebrityInfoResponse' smart constructor.
data GetCelebrityInfoResponse = GetCelebrityInfoResponse'
  { -- | Retrieves the known gender for the celebrity.
    GetCelebrityInfoResponse -> Maybe KnownGender
knownGender :: Prelude.Maybe KnownGender,
    -- | The name of the celebrity.
    GetCelebrityInfoResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | An array of URLs pointing to additional celebrity information.
    GetCelebrityInfoResponse -> Maybe [Text]
urls :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    GetCelebrityInfoResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCelebrityInfoResponse -> GetCelebrityInfoResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCelebrityInfoResponse -> GetCelebrityInfoResponse -> Bool
$c/= :: GetCelebrityInfoResponse -> GetCelebrityInfoResponse -> Bool
== :: GetCelebrityInfoResponse -> GetCelebrityInfoResponse -> Bool
$c== :: GetCelebrityInfoResponse -> GetCelebrityInfoResponse -> Bool
Prelude.Eq, ReadPrec [GetCelebrityInfoResponse]
ReadPrec GetCelebrityInfoResponse
Int -> ReadS GetCelebrityInfoResponse
ReadS [GetCelebrityInfoResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCelebrityInfoResponse]
$creadListPrec :: ReadPrec [GetCelebrityInfoResponse]
readPrec :: ReadPrec GetCelebrityInfoResponse
$creadPrec :: ReadPrec GetCelebrityInfoResponse
readList :: ReadS [GetCelebrityInfoResponse]
$creadList :: ReadS [GetCelebrityInfoResponse]
readsPrec :: Int -> ReadS GetCelebrityInfoResponse
$creadsPrec :: Int -> ReadS GetCelebrityInfoResponse
Prelude.Read, Int -> GetCelebrityInfoResponse -> ShowS
[GetCelebrityInfoResponse] -> ShowS
GetCelebrityInfoResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCelebrityInfoResponse] -> ShowS
$cshowList :: [GetCelebrityInfoResponse] -> ShowS
show :: GetCelebrityInfoResponse -> String
$cshow :: GetCelebrityInfoResponse -> String
showsPrec :: Int -> GetCelebrityInfoResponse -> ShowS
$cshowsPrec :: Int -> GetCelebrityInfoResponse -> ShowS
Prelude.Show, forall x.
Rep GetCelebrityInfoResponse x -> GetCelebrityInfoResponse
forall x.
GetCelebrityInfoResponse -> Rep GetCelebrityInfoResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCelebrityInfoResponse x -> GetCelebrityInfoResponse
$cfrom :: forall x.
GetCelebrityInfoResponse -> Rep GetCelebrityInfoResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCelebrityInfoResponse' 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:
--
-- 'knownGender', 'getCelebrityInfoResponse_knownGender' - Retrieves the known gender for the celebrity.
--
-- 'name', 'getCelebrityInfoResponse_name' - The name of the celebrity.
--
-- 'urls', 'getCelebrityInfoResponse_urls' - An array of URLs pointing to additional celebrity information.
--
-- 'httpStatus', 'getCelebrityInfoResponse_httpStatus' - The response's http status code.
newGetCelebrityInfoResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCelebrityInfoResponse
newGetCelebrityInfoResponse :: Int -> GetCelebrityInfoResponse
newGetCelebrityInfoResponse Int
pHttpStatus_ =
  GetCelebrityInfoResponse'
    { $sel:knownGender:GetCelebrityInfoResponse' :: Maybe KnownGender
knownGender =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetCelebrityInfoResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:urls:GetCelebrityInfoResponse' :: Maybe [Text]
urls = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCelebrityInfoResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Retrieves the known gender for the celebrity.
getCelebrityInfoResponse_knownGender :: Lens.Lens' GetCelebrityInfoResponse (Prelude.Maybe KnownGender)
getCelebrityInfoResponse_knownGender :: Lens' GetCelebrityInfoResponse (Maybe KnownGender)
getCelebrityInfoResponse_knownGender = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCelebrityInfoResponse' {Maybe KnownGender
knownGender :: Maybe KnownGender
$sel:knownGender:GetCelebrityInfoResponse' :: GetCelebrityInfoResponse -> Maybe KnownGender
knownGender} -> Maybe KnownGender
knownGender) (\s :: GetCelebrityInfoResponse
s@GetCelebrityInfoResponse' {} Maybe KnownGender
a -> GetCelebrityInfoResponse
s {$sel:knownGender:GetCelebrityInfoResponse' :: Maybe KnownGender
knownGender = Maybe KnownGender
a} :: GetCelebrityInfoResponse)

-- | The name of the celebrity.
getCelebrityInfoResponse_name :: Lens.Lens' GetCelebrityInfoResponse (Prelude.Maybe Prelude.Text)
getCelebrityInfoResponse_name :: Lens' GetCelebrityInfoResponse (Maybe Text)
getCelebrityInfoResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCelebrityInfoResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetCelebrityInfoResponse' :: GetCelebrityInfoResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetCelebrityInfoResponse
s@GetCelebrityInfoResponse' {} Maybe Text
a -> GetCelebrityInfoResponse
s {$sel:name:GetCelebrityInfoResponse' :: Maybe Text
name = Maybe Text
a} :: GetCelebrityInfoResponse)

-- | An array of URLs pointing to additional celebrity information.
getCelebrityInfoResponse_urls :: Lens.Lens' GetCelebrityInfoResponse (Prelude.Maybe [Prelude.Text])
getCelebrityInfoResponse_urls :: Lens' GetCelebrityInfoResponse (Maybe [Text])
getCelebrityInfoResponse_urls = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCelebrityInfoResponse' {Maybe [Text]
urls :: Maybe [Text]
$sel:urls:GetCelebrityInfoResponse' :: GetCelebrityInfoResponse -> Maybe [Text]
urls} -> Maybe [Text]
urls) (\s :: GetCelebrityInfoResponse
s@GetCelebrityInfoResponse' {} Maybe [Text]
a -> GetCelebrityInfoResponse
s {$sel:urls:GetCelebrityInfoResponse' :: Maybe [Text]
urls = Maybe [Text]
a} :: GetCelebrityInfoResponse) 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.
getCelebrityInfoResponse_httpStatus :: Lens.Lens' GetCelebrityInfoResponse Prelude.Int
getCelebrityInfoResponse_httpStatus :: Lens' GetCelebrityInfoResponse Int
getCelebrityInfoResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCelebrityInfoResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetCelebrityInfoResponse' :: GetCelebrityInfoResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetCelebrityInfoResponse
s@GetCelebrityInfoResponse' {} Int
a -> GetCelebrityInfoResponse
s {$sel:httpStatus:GetCelebrityInfoResponse' :: Int
httpStatus = Int
a} :: GetCelebrityInfoResponse)

instance Prelude.NFData GetCelebrityInfoResponse where
  rnf :: GetCelebrityInfoResponse -> ()
rnf GetCelebrityInfoResponse' {Int
Maybe [Text]
Maybe Text
Maybe KnownGender
httpStatus :: Int
urls :: Maybe [Text]
name :: Maybe Text
knownGender :: Maybe KnownGender
$sel:httpStatus:GetCelebrityInfoResponse' :: GetCelebrityInfoResponse -> Int
$sel:urls:GetCelebrityInfoResponse' :: GetCelebrityInfoResponse -> Maybe [Text]
$sel:name:GetCelebrityInfoResponse' :: GetCelebrityInfoResponse -> Maybe Text
$sel:knownGender:GetCelebrityInfoResponse' :: GetCelebrityInfoResponse -> Maybe KnownGender
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe KnownGender
knownGender
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
urls
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus