{-# 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.IAM.GetServerCertificate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about the specified server certificate stored in
-- IAM.
--
-- For more information about working with server certificates, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_server-certs.html Working with server certificates>
-- in the /IAM User Guide/. This topic includes a list of Amazon Web
-- Services services that can use the server certificates that you manage
-- with IAM.
module Amazonka.IAM.GetServerCertificate
  ( -- * Creating a Request
    GetServerCertificate (..),
    newGetServerCertificate,

    -- * Request Lenses
    getServerCertificate_serverCertificateName,

    -- * Destructuring the Response
    GetServerCertificateResponse (..),
    newGetServerCertificateResponse,

    -- * Response Lenses
    getServerCertificateResponse_httpStatus,
    getServerCertificateResponse_serverCertificate,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IAM.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetServerCertificate' smart constructor.
data GetServerCertificate = GetServerCertificate'
  { -- | The name of the server certificate you want to retrieve information
    -- about.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of upper and lowercase alphanumeric characters with no
    -- spaces. You can also include any of the following characters: _+=,.\@-
    GetServerCertificate -> Text
serverCertificateName :: Prelude.Text
  }
  deriving (GetServerCertificate -> GetServerCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetServerCertificate -> GetServerCertificate -> Bool
$c/= :: GetServerCertificate -> GetServerCertificate -> Bool
== :: GetServerCertificate -> GetServerCertificate -> Bool
$c== :: GetServerCertificate -> GetServerCertificate -> Bool
Prelude.Eq, ReadPrec [GetServerCertificate]
ReadPrec GetServerCertificate
Int -> ReadS GetServerCertificate
ReadS [GetServerCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetServerCertificate]
$creadListPrec :: ReadPrec [GetServerCertificate]
readPrec :: ReadPrec GetServerCertificate
$creadPrec :: ReadPrec GetServerCertificate
readList :: ReadS [GetServerCertificate]
$creadList :: ReadS [GetServerCertificate]
readsPrec :: Int -> ReadS GetServerCertificate
$creadsPrec :: Int -> ReadS GetServerCertificate
Prelude.Read, Int -> GetServerCertificate -> ShowS
[GetServerCertificate] -> ShowS
GetServerCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetServerCertificate] -> ShowS
$cshowList :: [GetServerCertificate] -> ShowS
show :: GetServerCertificate -> String
$cshow :: GetServerCertificate -> String
showsPrec :: Int -> GetServerCertificate -> ShowS
$cshowsPrec :: Int -> GetServerCertificate -> ShowS
Prelude.Show, forall x. Rep GetServerCertificate x -> GetServerCertificate
forall x. GetServerCertificate -> Rep GetServerCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetServerCertificate x -> GetServerCertificate
$cfrom :: forall x. GetServerCertificate -> Rep GetServerCertificate x
Prelude.Generic)

-- |
-- Create a value of 'GetServerCertificate' 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:
--
-- 'serverCertificateName', 'getServerCertificate_serverCertificateName' - The name of the server certificate you want to retrieve information
-- about.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
newGetServerCertificate ::
  -- | 'serverCertificateName'
  Prelude.Text ->
  GetServerCertificate
newGetServerCertificate :: Text -> GetServerCertificate
newGetServerCertificate Text
pServerCertificateName_ =
  GetServerCertificate'
    { $sel:serverCertificateName:GetServerCertificate' :: Text
serverCertificateName =
        Text
pServerCertificateName_
    }

-- | The name of the server certificate you want to retrieve information
-- about.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
getServerCertificate_serverCertificateName :: Lens.Lens' GetServerCertificate Prelude.Text
getServerCertificate_serverCertificateName :: Lens' GetServerCertificate Text
getServerCertificate_serverCertificateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServerCertificate' {Text
serverCertificateName :: Text
$sel:serverCertificateName:GetServerCertificate' :: GetServerCertificate -> Text
serverCertificateName} -> Text
serverCertificateName) (\s :: GetServerCertificate
s@GetServerCertificate' {} Text
a -> GetServerCertificate
s {$sel:serverCertificateName:GetServerCertificate' :: Text
serverCertificateName = Text
a} :: GetServerCertificate)

instance Core.AWSRequest GetServerCertificate where
  type
    AWSResponse GetServerCertificate =
      GetServerCertificateResponse
  request :: (Service -> Service)
-> GetServerCertificate -> Request GetServerCertificate
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetServerCertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetServerCertificate)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetServerCertificateResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> ServerCertificate -> GetServerCertificateResponse
GetServerCertificateResponse'
            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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"ServerCertificate")
      )

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

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

instance Data.ToHeaders GetServerCertificate where
  toHeaders :: GetServerCertificate -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery GetServerCertificate where
  toQuery :: GetServerCertificate -> QueryString
toQuery GetServerCertificate' {Text
serverCertificateName :: Text
$sel:serverCertificateName:GetServerCertificate' :: GetServerCertificate -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetServerCertificate" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"ServerCertificateName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
serverCertificateName
      ]

-- | Contains the response to a successful GetServerCertificate request.
--
-- /See:/ 'newGetServerCertificateResponse' smart constructor.
data GetServerCertificateResponse = GetServerCertificateResponse'
  { -- | The response's http status code.
    GetServerCertificateResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure containing details about the server certificate.
    GetServerCertificateResponse -> ServerCertificate
serverCertificate :: ServerCertificate
  }
  deriving (GetServerCertificateResponse
-> GetServerCertificateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetServerCertificateResponse
-> GetServerCertificateResponse -> Bool
$c/= :: GetServerCertificateResponse
-> GetServerCertificateResponse -> Bool
== :: GetServerCertificateResponse
-> GetServerCertificateResponse -> Bool
$c== :: GetServerCertificateResponse
-> GetServerCertificateResponse -> Bool
Prelude.Eq, ReadPrec [GetServerCertificateResponse]
ReadPrec GetServerCertificateResponse
Int -> ReadS GetServerCertificateResponse
ReadS [GetServerCertificateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetServerCertificateResponse]
$creadListPrec :: ReadPrec [GetServerCertificateResponse]
readPrec :: ReadPrec GetServerCertificateResponse
$creadPrec :: ReadPrec GetServerCertificateResponse
readList :: ReadS [GetServerCertificateResponse]
$creadList :: ReadS [GetServerCertificateResponse]
readsPrec :: Int -> ReadS GetServerCertificateResponse
$creadsPrec :: Int -> ReadS GetServerCertificateResponse
Prelude.Read, Int -> GetServerCertificateResponse -> ShowS
[GetServerCertificateResponse] -> ShowS
GetServerCertificateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetServerCertificateResponse] -> ShowS
$cshowList :: [GetServerCertificateResponse] -> ShowS
show :: GetServerCertificateResponse -> String
$cshow :: GetServerCertificateResponse -> String
showsPrec :: Int -> GetServerCertificateResponse -> ShowS
$cshowsPrec :: Int -> GetServerCertificateResponse -> ShowS
Prelude.Show, forall x.
Rep GetServerCertificateResponse x -> GetServerCertificateResponse
forall x.
GetServerCertificateResponse -> Rep GetServerCertificateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetServerCertificateResponse x -> GetServerCertificateResponse
$cfrom :: forall x.
GetServerCertificateResponse -> Rep GetServerCertificateResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetServerCertificateResponse' 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', 'getServerCertificateResponse_httpStatus' - The response's http status code.
--
-- 'serverCertificate', 'getServerCertificateResponse_serverCertificate' - A structure containing details about the server certificate.
newGetServerCertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'serverCertificate'
  ServerCertificate ->
  GetServerCertificateResponse
newGetServerCertificateResponse :: Int -> ServerCertificate -> GetServerCertificateResponse
newGetServerCertificateResponse
  Int
pHttpStatus_
  ServerCertificate
pServerCertificate_ =
    GetServerCertificateResponse'
      { $sel:httpStatus:GetServerCertificateResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:serverCertificate:GetServerCertificateResponse' :: ServerCertificate
serverCertificate = ServerCertificate
pServerCertificate_
      }

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

-- | A structure containing details about the server certificate.
getServerCertificateResponse_serverCertificate :: Lens.Lens' GetServerCertificateResponse ServerCertificate
getServerCertificateResponse_serverCertificate :: Lens' GetServerCertificateResponse ServerCertificate
getServerCertificateResponse_serverCertificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServerCertificateResponse' {ServerCertificate
serverCertificate :: ServerCertificate
$sel:serverCertificate:GetServerCertificateResponse' :: GetServerCertificateResponse -> ServerCertificate
serverCertificate} -> ServerCertificate
serverCertificate) (\s :: GetServerCertificateResponse
s@GetServerCertificateResponse' {} ServerCertificate
a -> GetServerCertificateResponse
s {$sel:serverCertificate:GetServerCertificateResponse' :: ServerCertificate
serverCertificate = ServerCertificate
a} :: GetServerCertificateResponse)

instance Prelude.NFData GetServerCertificateResponse where
  rnf :: GetServerCertificateResponse -> ()
rnf GetServerCertificateResponse' {Int
ServerCertificate
serverCertificate :: ServerCertificate
httpStatus :: Int
$sel:serverCertificate:GetServerCertificateResponse' :: GetServerCertificateResponse -> ServerCertificate
$sel:httpStatus:GetServerCertificateResponse' :: GetServerCertificateResponse -> 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 ServerCertificate
serverCertificate