{-# 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.CognitoIdentityProvider.DescribeUserPoolClient
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Client method for returning the configuration information and metadata
-- of the specified user pool app client.
module Amazonka.CognitoIdentityProvider.DescribeUserPoolClient
  ( -- * Creating a Request
    DescribeUserPoolClient (..),
    newDescribeUserPoolClient,

    -- * Request Lenses
    describeUserPoolClient_userPoolId,
    describeUserPoolClient_clientId,

    -- * Destructuring the Response
    DescribeUserPoolClientResponse (..),
    newDescribeUserPoolClientResponse,

    -- * Response Lenses
    describeUserPoolClientResponse_userPoolClient,
    describeUserPoolClientResponse_httpStatus,
  )
where

import Amazonka.CognitoIdentityProvider.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

-- | Represents the request to describe a user pool client.
--
-- /See:/ 'newDescribeUserPoolClient' smart constructor.
data DescribeUserPoolClient = DescribeUserPoolClient'
  { -- | The user pool ID for the user pool you want to describe.
    DescribeUserPoolClient -> Text
userPoolId :: Prelude.Text,
    -- | The app client ID of the app associated with the user pool.
    DescribeUserPoolClient -> Sensitive Text
clientId :: Data.Sensitive Prelude.Text
  }
  deriving (DescribeUserPoolClient -> DescribeUserPoolClient -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeUserPoolClient -> DescribeUserPoolClient -> Bool
$c/= :: DescribeUserPoolClient -> DescribeUserPoolClient -> Bool
== :: DescribeUserPoolClient -> DescribeUserPoolClient -> Bool
$c== :: DescribeUserPoolClient -> DescribeUserPoolClient -> Bool
Prelude.Eq, Int -> DescribeUserPoolClient -> ShowS
[DescribeUserPoolClient] -> ShowS
DescribeUserPoolClient -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeUserPoolClient] -> ShowS
$cshowList :: [DescribeUserPoolClient] -> ShowS
show :: DescribeUserPoolClient -> String
$cshow :: DescribeUserPoolClient -> String
showsPrec :: Int -> DescribeUserPoolClient -> ShowS
$cshowsPrec :: Int -> DescribeUserPoolClient -> ShowS
Prelude.Show, forall x. Rep DescribeUserPoolClient x -> DescribeUserPoolClient
forall x. DescribeUserPoolClient -> Rep DescribeUserPoolClient x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeUserPoolClient x -> DescribeUserPoolClient
$cfrom :: forall x. DescribeUserPoolClient -> Rep DescribeUserPoolClient x
Prelude.Generic)

-- |
-- Create a value of 'DescribeUserPoolClient' 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:
--
-- 'userPoolId', 'describeUserPoolClient_userPoolId' - The user pool ID for the user pool you want to describe.
--
-- 'clientId', 'describeUserPoolClient_clientId' - The app client ID of the app associated with the user pool.
newDescribeUserPoolClient ::
  -- | 'userPoolId'
  Prelude.Text ->
  -- | 'clientId'
  Prelude.Text ->
  DescribeUserPoolClient
newDescribeUserPoolClient :: Text -> Text -> DescribeUserPoolClient
newDescribeUserPoolClient Text
pUserPoolId_ Text
pClientId_ =
  DescribeUserPoolClient'
    { $sel:userPoolId:DescribeUserPoolClient' :: Text
userPoolId = Text
pUserPoolId_,
      $sel:clientId:DescribeUserPoolClient' :: Sensitive Text
clientId = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pClientId_
    }

-- | The user pool ID for the user pool you want to describe.
describeUserPoolClient_userPoolId :: Lens.Lens' DescribeUserPoolClient Prelude.Text
describeUserPoolClient_userPoolId :: Lens' DescribeUserPoolClient Text
describeUserPoolClient_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserPoolClient' {Text
userPoolId :: Text
$sel:userPoolId:DescribeUserPoolClient' :: DescribeUserPoolClient -> Text
userPoolId} -> Text
userPoolId) (\s :: DescribeUserPoolClient
s@DescribeUserPoolClient' {} Text
a -> DescribeUserPoolClient
s {$sel:userPoolId:DescribeUserPoolClient' :: Text
userPoolId = Text
a} :: DescribeUserPoolClient)

-- | The app client ID of the app associated with the user pool.
describeUserPoolClient_clientId :: Lens.Lens' DescribeUserPoolClient Prelude.Text
describeUserPoolClient_clientId :: Lens' DescribeUserPoolClient Text
describeUserPoolClient_clientId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserPoolClient' {Sensitive Text
clientId :: Sensitive Text
$sel:clientId:DescribeUserPoolClient' :: DescribeUserPoolClient -> Sensitive Text
clientId} -> Sensitive Text
clientId) (\s :: DescribeUserPoolClient
s@DescribeUserPoolClient' {} Sensitive Text
a -> DescribeUserPoolClient
s {$sel:clientId:DescribeUserPoolClient' :: Sensitive Text
clientId = Sensitive Text
a} :: DescribeUserPoolClient) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest DescribeUserPoolClient where
  type
    AWSResponse DescribeUserPoolClient =
      DescribeUserPoolClientResponse
  request :: (Service -> Service)
-> DescribeUserPoolClient -> Request DescribeUserPoolClient
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 DescribeUserPoolClient
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeUserPoolClient)))
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 UserPoolClientType -> Int -> DescribeUserPoolClientResponse
DescribeUserPoolClientResponse'
            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
"UserPoolClient")
            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 DescribeUserPoolClient where
  hashWithSalt :: Int -> DescribeUserPoolClient -> Int
hashWithSalt Int
_salt DescribeUserPoolClient' {Text
Sensitive Text
clientId :: Sensitive Text
userPoolId :: Text
$sel:clientId:DescribeUserPoolClient' :: DescribeUserPoolClient -> Sensitive Text
$sel:userPoolId:DescribeUserPoolClient' :: DescribeUserPoolClient -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
clientId

instance Prelude.NFData DescribeUserPoolClient where
  rnf :: DescribeUserPoolClient -> ()
rnf DescribeUserPoolClient' {Text
Sensitive Text
clientId :: Sensitive Text
userPoolId :: Text
$sel:clientId:DescribeUserPoolClient' :: DescribeUserPoolClient -> Sensitive Text
$sel:userPoolId:DescribeUserPoolClient' :: DescribeUserPoolClient -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
clientId

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

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

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

-- | Represents the response from the server from a request to describe the
-- user pool client.
--
-- /See:/ 'newDescribeUserPoolClientResponse' smart constructor.
data DescribeUserPoolClientResponse = DescribeUserPoolClientResponse'
  { -- | The user pool client from a server response to describe the user pool
    -- client.
    DescribeUserPoolClientResponse -> Maybe UserPoolClientType
userPoolClient :: Prelude.Maybe UserPoolClientType,
    -- | The response's http status code.
    DescribeUserPoolClientResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeUserPoolClientResponse
-> DescribeUserPoolClientResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeUserPoolClientResponse
-> DescribeUserPoolClientResponse -> Bool
$c/= :: DescribeUserPoolClientResponse
-> DescribeUserPoolClientResponse -> Bool
== :: DescribeUserPoolClientResponse
-> DescribeUserPoolClientResponse -> Bool
$c== :: DescribeUserPoolClientResponse
-> DescribeUserPoolClientResponse -> Bool
Prelude.Eq, Int -> DescribeUserPoolClientResponse -> ShowS
[DescribeUserPoolClientResponse] -> ShowS
DescribeUserPoolClientResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeUserPoolClientResponse] -> ShowS
$cshowList :: [DescribeUserPoolClientResponse] -> ShowS
show :: DescribeUserPoolClientResponse -> String
$cshow :: DescribeUserPoolClientResponse -> String
showsPrec :: Int -> DescribeUserPoolClientResponse -> ShowS
$cshowsPrec :: Int -> DescribeUserPoolClientResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeUserPoolClientResponse x
-> DescribeUserPoolClientResponse
forall x.
DescribeUserPoolClientResponse
-> Rep DescribeUserPoolClientResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeUserPoolClientResponse x
-> DescribeUserPoolClientResponse
$cfrom :: forall x.
DescribeUserPoolClientResponse
-> Rep DescribeUserPoolClientResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeUserPoolClientResponse' 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:
--
-- 'userPoolClient', 'describeUserPoolClientResponse_userPoolClient' - The user pool client from a server response to describe the user pool
-- client.
--
-- 'httpStatus', 'describeUserPoolClientResponse_httpStatus' - The response's http status code.
newDescribeUserPoolClientResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeUserPoolClientResponse
newDescribeUserPoolClientResponse :: Int -> DescribeUserPoolClientResponse
newDescribeUserPoolClientResponse Int
pHttpStatus_ =
  DescribeUserPoolClientResponse'
    { $sel:userPoolClient:DescribeUserPoolClientResponse' :: Maybe UserPoolClientType
userPoolClient =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeUserPoolClientResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The user pool client from a server response to describe the user pool
-- client.
describeUserPoolClientResponse_userPoolClient :: Lens.Lens' DescribeUserPoolClientResponse (Prelude.Maybe UserPoolClientType)
describeUserPoolClientResponse_userPoolClient :: Lens' DescribeUserPoolClientResponse (Maybe UserPoolClientType)
describeUserPoolClientResponse_userPoolClient = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeUserPoolClientResponse' {Maybe UserPoolClientType
userPoolClient :: Maybe UserPoolClientType
$sel:userPoolClient:DescribeUserPoolClientResponse' :: DescribeUserPoolClientResponse -> Maybe UserPoolClientType
userPoolClient} -> Maybe UserPoolClientType
userPoolClient) (\s :: DescribeUserPoolClientResponse
s@DescribeUserPoolClientResponse' {} Maybe UserPoolClientType
a -> DescribeUserPoolClientResponse
s {$sel:userPoolClient:DescribeUserPoolClientResponse' :: Maybe UserPoolClientType
userPoolClient = Maybe UserPoolClientType
a} :: DescribeUserPoolClientResponse)

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

instance
  Prelude.NFData
    DescribeUserPoolClientResponse
  where
  rnf :: DescribeUserPoolClientResponse -> ()
rnf DescribeUserPoolClientResponse' {Int
Maybe UserPoolClientType
httpStatus :: Int
userPoolClient :: Maybe UserPoolClientType
$sel:httpStatus:DescribeUserPoolClientResponse' :: DescribeUserPoolClientResponse -> Int
$sel:userPoolClient:DescribeUserPoolClientResponse' :: DescribeUserPoolClientResponse -> Maybe UserPoolClientType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe UserPoolClientType
userPoolClient
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus