{-# 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.CognitoIdentity.DescribeIdentity
-- 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 related to the given identity, including when the
-- identity was created and any associated linked logins.
--
-- You must use AWS Developer credentials to call this API.
module Amazonka.CognitoIdentity.DescribeIdentity
  ( -- * Creating a Request
    DescribeIdentity (..),
    newDescribeIdentity,

    -- * Request Lenses
    describeIdentity_identityId,

    -- * Destructuring the Response
    IdentityDescription (..),
    newIdentityDescription,

    -- * Response Lenses
    identityDescription_creationDate,
    identityDescription_identityId,
    identityDescription_lastModifiedDate,
    identityDescription_logins,
  )
where

import Amazonka.CognitoIdentity.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Input to the @DescribeIdentity@ action.
--
-- /See:/ 'newDescribeIdentity' smart constructor.
data DescribeIdentity = DescribeIdentity'
  { -- | A unique identifier in the format REGION:GUID.
    DescribeIdentity -> Text
identityId :: Prelude.Text
  }
  deriving (DescribeIdentity -> DescribeIdentity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeIdentity -> DescribeIdentity -> Bool
$c/= :: DescribeIdentity -> DescribeIdentity -> Bool
== :: DescribeIdentity -> DescribeIdentity -> Bool
$c== :: DescribeIdentity -> DescribeIdentity -> Bool
Prelude.Eq, ReadPrec [DescribeIdentity]
ReadPrec DescribeIdentity
Int -> ReadS DescribeIdentity
ReadS [DescribeIdentity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeIdentity]
$creadListPrec :: ReadPrec [DescribeIdentity]
readPrec :: ReadPrec DescribeIdentity
$creadPrec :: ReadPrec DescribeIdentity
readList :: ReadS [DescribeIdentity]
$creadList :: ReadS [DescribeIdentity]
readsPrec :: Int -> ReadS DescribeIdentity
$creadsPrec :: Int -> ReadS DescribeIdentity
Prelude.Read, Int -> DescribeIdentity -> ShowS
[DescribeIdentity] -> ShowS
DescribeIdentity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeIdentity] -> ShowS
$cshowList :: [DescribeIdentity] -> ShowS
show :: DescribeIdentity -> String
$cshow :: DescribeIdentity -> String
showsPrec :: Int -> DescribeIdentity -> ShowS
$cshowsPrec :: Int -> DescribeIdentity -> ShowS
Prelude.Show, forall x. Rep DescribeIdentity x -> DescribeIdentity
forall x. DescribeIdentity -> Rep DescribeIdentity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeIdentity x -> DescribeIdentity
$cfrom :: forall x. DescribeIdentity -> Rep DescribeIdentity x
Prelude.Generic)

-- |
-- Create a value of 'DescribeIdentity' 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:
--
-- 'identityId', 'describeIdentity_identityId' - A unique identifier in the format REGION:GUID.
newDescribeIdentity ::
  -- | 'identityId'
  Prelude.Text ->
  DescribeIdentity
newDescribeIdentity :: Text -> DescribeIdentity
newDescribeIdentity Text
pIdentityId_ =
  DescribeIdentity' {$sel:identityId:DescribeIdentity' :: Text
identityId = Text
pIdentityId_}

-- | A unique identifier in the format REGION:GUID.
describeIdentity_identityId :: Lens.Lens' DescribeIdentity Prelude.Text
describeIdentity_identityId :: Lens' DescribeIdentity Text
describeIdentity_identityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeIdentity' {Text
identityId :: Text
$sel:identityId:DescribeIdentity' :: DescribeIdentity -> Text
identityId} -> Text
identityId) (\s :: DescribeIdentity
s@DescribeIdentity' {} Text
a -> DescribeIdentity
s {$sel:identityId:DescribeIdentity' :: Text
identityId = Text
a} :: DescribeIdentity)

instance Core.AWSRequest DescribeIdentity where
  type
    AWSResponse DescribeIdentity =
      IdentityDescription
  request :: (Service -> Service)
-> DescribeIdentity -> Request DescribeIdentity
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 DescribeIdentity
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeIdentity)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable DescribeIdentity where
  hashWithSalt :: Int -> DescribeIdentity -> Int
hashWithSalt Int
_salt DescribeIdentity' {Text
identityId :: Text
$sel:identityId:DescribeIdentity' :: DescribeIdentity -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityId

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

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

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

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