{-# 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.DescribeResourceServer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes a resource server.
module Amazonka.CognitoIdentityProvider.DescribeResourceServer
  ( -- * Creating a Request
    DescribeResourceServer (..),
    newDescribeResourceServer,

    -- * Request Lenses
    describeResourceServer_userPoolId,
    describeResourceServer_identifier,

    -- * Destructuring the Response
    DescribeResourceServerResponse (..),
    newDescribeResourceServerResponse,

    -- * Response Lenses
    describeResourceServerResponse_httpStatus,
    describeResourceServerResponse_resourceServer,
  )
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

-- | /See:/ 'newDescribeResourceServer' smart constructor.
data DescribeResourceServer = DescribeResourceServer'
  { -- | The user pool ID for the user pool that hosts the resource server.
    DescribeResourceServer -> Text
userPoolId :: Prelude.Text,
    -- | The identifier for the resource server
    DescribeResourceServer -> Text
identifier :: Prelude.Text
  }
  deriving (DescribeResourceServer -> DescribeResourceServer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeResourceServer -> DescribeResourceServer -> Bool
$c/= :: DescribeResourceServer -> DescribeResourceServer -> Bool
== :: DescribeResourceServer -> DescribeResourceServer -> Bool
$c== :: DescribeResourceServer -> DescribeResourceServer -> Bool
Prelude.Eq, ReadPrec [DescribeResourceServer]
ReadPrec DescribeResourceServer
Int -> ReadS DescribeResourceServer
ReadS [DescribeResourceServer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeResourceServer]
$creadListPrec :: ReadPrec [DescribeResourceServer]
readPrec :: ReadPrec DescribeResourceServer
$creadPrec :: ReadPrec DescribeResourceServer
readList :: ReadS [DescribeResourceServer]
$creadList :: ReadS [DescribeResourceServer]
readsPrec :: Int -> ReadS DescribeResourceServer
$creadsPrec :: Int -> ReadS DescribeResourceServer
Prelude.Read, Int -> DescribeResourceServer -> ShowS
[DescribeResourceServer] -> ShowS
DescribeResourceServer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeResourceServer] -> ShowS
$cshowList :: [DescribeResourceServer] -> ShowS
show :: DescribeResourceServer -> String
$cshow :: DescribeResourceServer -> String
showsPrec :: Int -> DescribeResourceServer -> ShowS
$cshowsPrec :: Int -> DescribeResourceServer -> ShowS
Prelude.Show, forall x. Rep DescribeResourceServer x -> DescribeResourceServer
forall x. DescribeResourceServer -> Rep DescribeResourceServer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeResourceServer x -> DescribeResourceServer
$cfrom :: forall x. DescribeResourceServer -> Rep DescribeResourceServer x
Prelude.Generic)

-- |
-- Create a value of 'DescribeResourceServer' 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', 'describeResourceServer_userPoolId' - The user pool ID for the user pool that hosts the resource server.
--
-- 'identifier', 'describeResourceServer_identifier' - The identifier for the resource server
newDescribeResourceServer ::
  -- | 'userPoolId'
  Prelude.Text ->
  -- | 'identifier'
  Prelude.Text ->
  DescribeResourceServer
newDescribeResourceServer :: Text -> Text -> DescribeResourceServer
newDescribeResourceServer Text
pUserPoolId_ Text
pIdentifier_ =
  DescribeResourceServer'
    { $sel:userPoolId:DescribeResourceServer' :: Text
userPoolId = Text
pUserPoolId_,
      $sel:identifier:DescribeResourceServer' :: Text
identifier = Text
pIdentifier_
    }

-- | The user pool ID for the user pool that hosts the resource server.
describeResourceServer_userPoolId :: Lens.Lens' DescribeResourceServer Prelude.Text
describeResourceServer_userPoolId :: Lens' DescribeResourceServer Text
describeResourceServer_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeResourceServer' {Text
userPoolId :: Text
$sel:userPoolId:DescribeResourceServer' :: DescribeResourceServer -> Text
userPoolId} -> Text
userPoolId) (\s :: DescribeResourceServer
s@DescribeResourceServer' {} Text
a -> DescribeResourceServer
s {$sel:userPoolId:DescribeResourceServer' :: Text
userPoolId = Text
a} :: DescribeResourceServer)

-- | The identifier for the resource server
describeResourceServer_identifier :: Lens.Lens' DescribeResourceServer Prelude.Text
describeResourceServer_identifier :: Lens' DescribeResourceServer Text
describeResourceServer_identifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeResourceServer' {Text
identifier :: Text
$sel:identifier:DescribeResourceServer' :: DescribeResourceServer -> Text
identifier} -> Text
identifier) (\s :: DescribeResourceServer
s@DescribeResourceServer' {} Text
a -> DescribeResourceServer
s {$sel:identifier:DescribeResourceServer' :: Text
identifier = Text
a} :: DescribeResourceServer)

instance Core.AWSRequest DescribeResourceServer where
  type
    AWSResponse DescribeResourceServer =
      DescribeResourceServerResponse
  request :: (Service -> Service)
-> DescribeResourceServer -> Request DescribeResourceServer
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 DescribeResourceServer
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeResourceServer)))
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 ->
          Int -> ResourceServerType -> DescribeResourceServerResponse
DescribeResourceServerResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ResourceServer")
      )

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

instance Prelude.NFData DescribeResourceServer where
  rnf :: DescribeResourceServer -> ()
rnf DescribeResourceServer' {Text
identifier :: Text
userPoolId :: Text
$sel:identifier:DescribeResourceServer' :: DescribeResourceServer -> Text
$sel:userPoolId:DescribeResourceServer' :: DescribeResourceServer -> 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 Text
identifier

instance Data.ToHeaders DescribeResourceServer where
  toHeaders :: DescribeResourceServer -> 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.DescribeResourceServer" ::
                          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 DescribeResourceServer where
  toJSON :: DescribeResourceServer -> Value
toJSON DescribeResourceServer' {Text
identifier :: Text
userPoolId :: Text
$sel:identifier:DescribeResourceServer' :: DescribeResourceServer -> Text
$sel:userPoolId:DescribeResourceServer' :: DescribeResourceServer -> 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
"Identifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identifier)
          ]
      )

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

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

-- | /See:/ 'newDescribeResourceServerResponse' smart constructor.
data DescribeResourceServerResponse = DescribeResourceServerResponse'
  { -- | The response's http status code.
    DescribeResourceServerResponse -> Int
httpStatus :: Prelude.Int,
    -- | The resource server.
    DescribeResourceServerResponse -> ResourceServerType
resourceServer :: ResourceServerType
  }
  deriving (DescribeResourceServerResponse
-> DescribeResourceServerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeResourceServerResponse
-> DescribeResourceServerResponse -> Bool
$c/= :: DescribeResourceServerResponse
-> DescribeResourceServerResponse -> Bool
== :: DescribeResourceServerResponse
-> DescribeResourceServerResponse -> Bool
$c== :: DescribeResourceServerResponse
-> DescribeResourceServerResponse -> Bool
Prelude.Eq, ReadPrec [DescribeResourceServerResponse]
ReadPrec DescribeResourceServerResponse
Int -> ReadS DescribeResourceServerResponse
ReadS [DescribeResourceServerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeResourceServerResponse]
$creadListPrec :: ReadPrec [DescribeResourceServerResponse]
readPrec :: ReadPrec DescribeResourceServerResponse
$creadPrec :: ReadPrec DescribeResourceServerResponse
readList :: ReadS [DescribeResourceServerResponse]
$creadList :: ReadS [DescribeResourceServerResponse]
readsPrec :: Int -> ReadS DescribeResourceServerResponse
$creadsPrec :: Int -> ReadS DescribeResourceServerResponse
Prelude.Read, Int -> DescribeResourceServerResponse -> ShowS
[DescribeResourceServerResponse] -> ShowS
DescribeResourceServerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeResourceServerResponse] -> ShowS
$cshowList :: [DescribeResourceServerResponse] -> ShowS
show :: DescribeResourceServerResponse -> String
$cshow :: DescribeResourceServerResponse -> String
showsPrec :: Int -> DescribeResourceServerResponse -> ShowS
$cshowsPrec :: Int -> DescribeResourceServerResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeResourceServerResponse x
-> DescribeResourceServerResponse
forall x.
DescribeResourceServerResponse
-> Rep DescribeResourceServerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeResourceServerResponse x
-> DescribeResourceServerResponse
$cfrom :: forall x.
DescribeResourceServerResponse
-> Rep DescribeResourceServerResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeResourceServerResponse' 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:
--
-- 'httpStatus', 'describeResourceServerResponse_httpStatus' - The response's http status code.
--
-- 'resourceServer', 'describeResourceServerResponse_resourceServer' - The resource server.
newDescribeResourceServerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'resourceServer'
  ResourceServerType ->
  DescribeResourceServerResponse
newDescribeResourceServerResponse :: Int -> ResourceServerType -> DescribeResourceServerResponse
newDescribeResourceServerResponse
  Int
pHttpStatus_
  ResourceServerType
pResourceServer_ =
    DescribeResourceServerResponse'
      { $sel:httpStatus:DescribeResourceServerResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:resourceServer:DescribeResourceServerResponse' :: ResourceServerType
resourceServer = ResourceServerType
pResourceServer_
      }

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

-- | The resource server.
describeResourceServerResponse_resourceServer :: Lens.Lens' DescribeResourceServerResponse ResourceServerType
describeResourceServerResponse_resourceServer :: Lens' DescribeResourceServerResponse ResourceServerType
describeResourceServerResponse_resourceServer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeResourceServerResponse' {ResourceServerType
resourceServer :: ResourceServerType
$sel:resourceServer:DescribeResourceServerResponse' :: DescribeResourceServerResponse -> ResourceServerType
resourceServer} -> ResourceServerType
resourceServer) (\s :: DescribeResourceServerResponse
s@DescribeResourceServerResponse' {} ResourceServerType
a -> DescribeResourceServerResponse
s {$sel:resourceServer:DescribeResourceServerResponse' :: ResourceServerType
resourceServer = ResourceServerType
a} :: DescribeResourceServerResponse)

instance
  Prelude.NFData
    DescribeResourceServerResponse
  where
  rnf :: DescribeResourceServerResponse -> ()
rnf DescribeResourceServerResponse' {Int
ResourceServerType
resourceServer :: ResourceServerType
httpStatus :: Int
$sel:resourceServer:DescribeResourceServerResponse' :: DescribeResourceServerResponse -> ResourceServerType
$sel:httpStatus:DescribeResourceServerResponse' :: DescribeResourceServerResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceServerType
resourceServer