{-# 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.UploadServerCertificate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Uploads a server certificate entity for the Amazon Web Services account.
-- The server certificate entity includes a public key certificate, a
-- private key, and an optional certificate chain, which should all be
-- PEM-encoded.
--
-- We recommend that you use
-- <https://docs.aws.amazon.com/acm/ Certificate Manager> to provision,
-- manage, and deploy your server certificates. With ACM you can request a
-- certificate, deploy it to Amazon Web Services resources, and let ACM
-- handle certificate renewals for you. Certificates provided by ACM are
-- free. For more information about using ACM, see the
-- <https://docs.aws.amazon.com/acm/latest/userguide/ Certificate Manager User Guide>.
--
-- 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.
--
-- For information about the number of server certificates you can upload,
-- see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_iam-quotas.html IAM and STS quotas>
-- in the /IAM User Guide/.
--
-- Because the body of the public key certificate, private key, and the
-- certificate chain can be large, you should use POST rather than GET when
-- calling @UploadServerCertificate@. For information about setting up
-- signatures and authorization through the API, see
-- <https://docs.aws.amazon.com/general/latest/gr/signing_aws_api_requests.html Signing Amazon Web Services API requests>
-- in the /Amazon Web Services General Reference/. For general information
-- about using the Query API with IAM, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/programming.html Calling the API by making HTTP query requests>
-- in the /IAM User Guide/.
module Amazonka.IAM.UploadServerCertificate
  ( -- * Creating a Request
    UploadServerCertificate (..),
    newUploadServerCertificate,

    -- * Request Lenses
    uploadServerCertificate_certificateChain,
    uploadServerCertificate_path,
    uploadServerCertificate_tags,
    uploadServerCertificate_serverCertificateName,
    uploadServerCertificate_certificateBody,
    uploadServerCertificate_privateKey,

    -- * Destructuring the Response
    UploadServerCertificateResponse (..),
    newUploadServerCertificateResponse,

    -- * Response Lenses
    uploadServerCertificateResponse_serverCertificateMetadata,
    uploadServerCertificateResponse_tags,
    uploadServerCertificateResponse_httpStatus,
  )
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:/ 'newUploadServerCertificate' smart constructor.
data UploadServerCertificate = UploadServerCertificate'
  { -- | The contents of the certificate chain. This is typically a concatenation
    -- of the PEM-encoded public key certificates of the chain.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
    -- this parameter is a string of characters consisting of the following:
    --
    -- -   Any printable ASCII character ranging from the space character
    --     (@\\u0020@) through the end of the ASCII character range
    --
    -- -   The printable characters in the Basic Latin and Latin-1 Supplement
    --     character set (through @\\u00FF@)
    --
    -- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
    --     carriage return (@\\u000D@)
    UploadServerCertificate -> Maybe Text
certificateChain :: Prelude.Maybe Prelude.Text,
    -- | The path for the server certificate. For more information about paths,
    -- see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
    -- in the /IAM User Guide/.
    --
    -- This parameter is optional. If it is not included, it defaults to a
    -- slash (\/). This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of either a forward slash (\/) by itself or a string that
    -- must begin and end with forward slashes. In addition, it can contain any
    -- ASCII character from the ! (@\\u0021@) through the DEL character
    -- (@\\u007F@), including most punctuation characters, digits, and upper
    -- and lowercased letters.
    --
    -- If you are uploading a server certificate specifically for use with
    -- Amazon CloudFront distributions, you must specify a path using the
    -- @path@ parameter. The path must begin with @\/cloudfront@ and must
    -- include a trailing slash (for example, @\/cloudfront\/test\/@).
    UploadServerCertificate -> Maybe Text
path :: Prelude.Maybe Prelude.Text,
    -- | A list of tags that you want to attach to the new IAM server certificate
    -- resource. Each tag consists of a key name and an associated value. For
    -- more information about tagging, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
    -- in the /IAM User Guide/.
    --
    -- If any one of the tags is invalid or if you exceed the allowed maximum
    -- number of tags, then the entire request fails and the resource is not
    -- created.
    UploadServerCertificate -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name for the server certificate. Do not include the path in this
    -- value. The name of the certificate cannot contain any spaces.
    --
    -- 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: _+=,.\@-
    UploadServerCertificate -> Text
serverCertificateName :: Prelude.Text,
    -- | The contents of the public key certificate in PEM-encoded format.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
    -- this parameter is a string of characters consisting of the following:
    --
    -- -   Any printable ASCII character ranging from the space character
    --     (@\\u0020@) through the end of the ASCII character range
    --
    -- -   The printable characters in the Basic Latin and Latin-1 Supplement
    --     character set (through @\\u00FF@)
    --
    -- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
    --     carriage return (@\\u000D@)
    UploadServerCertificate -> Text
certificateBody :: Prelude.Text,
    -- | The contents of the private key in PEM-encoded format.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
    -- this parameter is a string of characters consisting of the following:
    --
    -- -   Any printable ASCII character ranging from the space character
    --     (@\\u0020@) through the end of the ASCII character range
    --
    -- -   The printable characters in the Basic Latin and Latin-1 Supplement
    --     character set (through @\\u00FF@)
    --
    -- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
    --     carriage return (@\\u000D@)
    UploadServerCertificate -> Sensitive Text
privateKey :: Data.Sensitive Prelude.Text
  }
  deriving (UploadServerCertificate -> UploadServerCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UploadServerCertificate -> UploadServerCertificate -> Bool
$c/= :: UploadServerCertificate -> UploadServerCertificate -> Bool
== :: UploadServerCertificate -> UploadServerCertificate -> Bool
$c== :: UploadServerCertificate -> UploadServerCertificate -> Bool
Prelude.Eq, Int -> UploadServerCertificate -> ShowS
[UploadServerCertificate] -> ShowS
UploadServerCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadServerCertificate] -> ShowS
$cshowList :: [UploadServerCertificate] -> ShowS
show :: UploadServerCertificate -> String
$cshow :: UploadServerCertificate -> String
showsPrec :: Int -> UploadServerCertificate -> ShowS
$cshowsPrec :: Int -> UploadServerCertificate -> ShowS
Prelude.Show, forall x. Rep UploadServerCertificate x -> UploadServerCertificate
forall x. UploadServerCertificate -> Rep UploadServerCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UploadServerCertificate x -> UploadServerCertificate
$cfrom :: forall x. UploadServerCertificate -> Rep UploadServerCertificate x
Prelude.Generic)

-- |
-- Create a value of 'UploadServerCertificate' 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:
--
-- 'certificateChain', 'uploadServerCertificate_certificateChain' - The contents of the certificate chain. This is typically a concatenation
-- of the PEM-encoded public key certificates of the chain.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
--
-- 'path', 'uploadServerCertificate_path' - The path for the server certificate. For more information about paths,
-- see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
--
-- This parameter is optional. If it is not included, it defaults to a
-- slash (\/). This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of either a forward slash (\/) by itself or a string that
-- must begin and end with forward slashes. In addition, it can contain any
-- ASCII character from the ! (@\\u0021@) through the DEL character
-- (@\\u007F@), including most punctuation characters, digits, and upper
-- and lowercased letters.
--
-- If you are uploading a server certificate specifically for use with
-- Amazon CloudFront distributions, you must specify a path using the
-- @path@ parameter. The path must begin with @\/cloudfront@ and must
-- include a trailing slash (for example, @\/cloudfront\/test\/@).
--
-- 'tags', 'uploadServerCertificate_tags' - A list of tags that you want to attach to the new IAM server certificate
-- resource. Each tag consists of a key name and an associated value. For
-- more information about tagging, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
-- in the /IAM User Guide/.
--
-- If any one of the tags is invalid or if you exceed the allowed maximum
-- number of tags, then the entire request fails and the resource is not
-- created.
--
-- 'serverCertificateName', 'uploadServerCertificate_serverCertificateName' - The name for the server certificate. Do not include the path in this
-- value. The name of the certificate cannot contain any spaces.
--
-- 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: _+=,.\@-
--
-- 'certificateBody', 'uploadServerCertificate_certificateBody' - The contents of the public key certificate in PEM-encoded format.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
--
-- 'privateKey', 'uploadServerCertificate_privateKey' - The contents of the private key in PEM-encoded format.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
newUploadServerCertificate ::
  -- | 'serverCertificateName'
  Prelude.Text ->
  -- | 'certificateBody'
  Prelude.Text ->
  -- | 'privateKey'
  Prelude.Text ->
  UploadServerCertificate
newUploadServerCertificate :: Text -> Text -> Text -> UploadServerCertificate
newUploadServerCertificate
  Text
pServerCertificateName_
  Text
pCertificateBody_
  Text
pPrivateKey_ =
    UploadServerCertificate'
      { $sel:certificateChain:UploadServerCertificate' :: Maybe Text
certificateChain =
          forall a. Maybe a
Prelude.Nothing,
        $sel:path:UploadServerCertificate' :: Maybe Text
path = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:UploadServerCertificate' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:serverCertificateName:UploadServerCertificate' :: Text
serverCertificateName = Text
pServerCertificateName_,
        $sel:certificateBody:UploadServerCertificate' :: Text
certificateBody = Text
pCertificateBody_,
        $sel:privateKey:UploadServerCertificate' :: Sensitive Text
privateKey = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pPrivateKey_
      }

-- | The contents of the certificate chain. This is typically a concatenation
-- of the PEM-encoded public key certificates of the chain.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
uploadServerCertificate_certificateChain :: Lens.Lens' UploadServerCertificate (Prelude.Maybe Prelude.Text)
uploadServerCertificate_certificateChain :: Lens' UploadServerCertificate (Maybe Text)
uploadServerCertificate_certificateChain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadServerCertificate' {Maybe Text
certificateChain :: Maybe Text
$sel:certificateChain:UploadServerCertificate' :: UploadServerCertificate -> Maybe Text
certificateChain} -> Maybe Text
certificateChain) (\s :: UploadServerCertificate
s@UploadServerCertificate' {} Maybe Text
a -> UploadServerCertificate
s {$sel:certificateChain:UploadServerCertificate' :: Maybe Text
certificateChain = Maybe Text
a} :: UploadServerCertificate)

-- | The path for the server certificate. For more information about paths,
-- see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
--
-- This parameter is optional. If it is not included, it defaults to a
-- slash (\/). This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of either a forward slash (\/) by itself or a string that
-- must begin and end with forward slashes. In addition, it can contain any
-- ASCII character from the ! (@\\u0021@) through the DEL character
-- (@\\u007F@), including most punctuation characters, digits, and upper
-- and lowercased letters.
--
-- If you are uploading a server certificate specifically for use with
-- Amazon CloudFront distributions, you must specify a path using the
-- @path@ parameter. The path must begin with @\/cloudfront@ and must
-- include a trailing slash (for example, @\/cloudfront\/test\/@).
uploadServerCertificate_path :: Lens.Lens' UploadServerCertificate (Prelude.Maybe Prelude.Text)
uploadServerCertificate_path :: Lens' UploadServerCertificate (Maybe Text)
uploadServerCertificate_path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadServerCertificate' {Maybe Text
path :: Maybe Text
$sel:path:UploadServerCertificate' :: UploadServerCertificate -> Maybe Text
path} -> Maybe Text
path) (\s :: UploadServerCertificate
s@UploadServerCertificate' {} Maybe Text
a -> UploadServerCertificate
s {$sel:path:UploadServerCertificate' :: Maybe Text
path = Maybe Text
a} :: UploadServerCertificate)

-- | A list of tags that you want to attach to the new IAM server certificate
-- resource. Each tag consists of a key name and an associated value. For
-- more information about tagging, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
-- in the /IAM User Guide/.
--
-- If any one of the tags is invalid or if you exceed the allowed maximum
-- number of tags, then the entire request fails and the resource is not
-- created.
uploadServerCertificate_tags :: Lens.Lens' UploadServerCertificate (Prelude.Maybe [Tag])
uploadServerCertificate_tags :: Lens' UploadServerCertificate (Maybe [Tag])
uploadServerCertificate_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadServerCertificate' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:UploadServerCertificate' :: UploadServerCertificate -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: UploadServerCertificate
s@UploadServerCertificate' {} Maybe [Tag]
a -> UploadServerCertificate
s {$sel:tags:UploadServerCertificate' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: UploadServerCertificate) 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 name for the server certificate. Do not include the path in this
-- value. The name of the certificate cannot contain any spaces.
--
-- 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: _+=,.\@-
uploadServerCertificate_serverCertificateName :: Lens.Lens' UploadServerCertificate Prelude.Text
uploadServerCertificate_serverCertificateName :: Lens' UploadServerCertificate Text
uploadServerCertificate_serverCertificateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadServerCertificate' {Text
serverCertificateName :: Text
$sel:serverCertificateName:UploadServerCertificate' :: UploadServerCertificate -> Text
serverCertificateName} -> Text
serverCertificateName) (\s :: UploadServerCertificate
s@UploadServerCertificate' {} Text
a -> UploadServerCertificate
s {$sel:serverCertificateName:UploadServerCertificate' :: Text
serverCertificateName = Text
a} :: UploadServerCertificate)

-- | The contents of the public key certificate in PEM-encoded format.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
uploadServerCertificate_certificateBody :: Lens.Lens' UploadServerCertificate Prelude.Text
uploadServerCertificate_certificateBody :: Lens' UploadServerCertificate Text
uploadServerCertificate_certificateBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadServerCertificate' {Text
certificateBody :: Text
$sel:certificateBody:UploadServerCertificate' :: UploadServerCertificate -> Text
certificateBody} -> Text
certificateBody) (\s :: UploadServerCertificate
s@UploadServerCertificate' {} Text
a -> UploadServerCertificate
s {$sel:certificateBody:UploadServerCertificate' :: Text
certificateBody = Text
a} :: UploadServerCertificate)

-- | The contents of the private key in PEM-encoded format.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
uploadServerCertificate_privateKey :: Lens.Lens' UploadServerCertificate Prelude.Text
uploadServerCertificate_privateKey :: Lens' UploadServerCertificate Text
uploadServerCertificate_privateKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadServerCertificate' {Sensitive Text
privateKey :: Sensitive Text
$sel:privateKey:UploadServerCertificate' :: UploadServerCertificate -> Sensitive Text
privateKey} -> Sensitive Text
privateKey) (\s :: UploadServerCertificate
s@UploadServerCertificate' {} Sensitive Text
a -> UploadServerCertificate
s {$sel:privateKey:UploadServerCertificate' :: Sensitive Text
privateKey = Sensitive Text
a} :: UploadServerCertificate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest UploadServerCertificate where
  type
    AWSResponse UploadServerCertificate =
      UploadServerCertificateResponse
  request :: (Service -> Service)
-> UploadServerCertificate -> Request UploadServerCertificate
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 UploadServerCertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UploadServerCertificate)))
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
"UploadServerCertificateResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ServerCertificateMetadata
-> Maybe [Tag] -> Int -> UploadServerCertificateResponse
UploadServerCertificateResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ServerCertificateMetadata")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Tags"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            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 UploadServerCertificate where
  hashWithSalt :: Int -> UploadServerCertificate -> Int
hashWithSalt Int
_salt UploadServerCertificate' {Maybe [Tag]
Maybe Text
Text
Sensitive Text
privateKey :: Sensitive Text
certificateBody :: Text
serverCertificateName :: Text
tags :: Maybe [Tag]
path :: Maybe Text
certificateChain :: Maybe Text
$sel:privateKey:UploadServerCertificate' :: UploadServerCertificate -> Sensitive Text
$sel:certificateBody:UploadServerCertificate' :: UploadServerCertificate -> Text
$sel:serverCertificateName:UploadServerCertificate' :: UploadServerCertificate -> Text
$sel:tags:UploadServerCertificate' :: UploadServerCertificate -> Maybe [Tag]
$sel:path:UploadServerCertificate' :: UploadServerCertificate -> Maybe Text
$sel:certificateChain:UploadServerCertificate' :: UploadServerCertificate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
certificateChain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
path
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serverCertificateName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
certificateBody
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
privateKey

instance Prelude.NFData UploadServerCertificate where
  rnf :: UploadServerCertificate -> ()
rnf UploadServerCertificate' {Maybe [Tag]
Maybe Text
Text
Sensitive Text
privateKey :: Sensitive Text
certificateBody :: Text
serverCertificateName :: Text
tags :: Maybe [Tag]
path :: Maybe Text
certificateChain :: Maybe Text
$sel:privateKey:UploadServerCertificate' :: UploadServerCertificate -> Sensitive Text
$sel:certificateBody:UploadServerCertificate' :: UploadServerCertificate -> Text
$sel:serverCertificateName:UploadServerCertificate' :: UploadServerCertificate -> Text
$sel:tags:UploadServerCertificate' :: UploadServerCertificate -> Maybe [Tag]
$sel:path:UploadServerCertificate' :: UploadServerCertificate -> Maybe Text
$sel:certificateChain:UploadServerCertificate' :: UploadServerCertificate -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateChain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
path
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serverCertificateName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
certificateBody
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
privateKey

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

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

instance Data.ToQuery UploadServerCertificate where
  toQuery :: UploadServerCertificate -> QueryString
toQuery UploadServerCertificate' {Maybe [Tag]
Maybe Text
Text
Sensitive Text
privateKey :: Sensitive Text
certificateBody :: Text
serverCertificateName :: Text
tags :: Maybe [Tag]
path :: Maybe Text
certificateChain :: Maybe Text
$sel:privateKey:UploadServerCertificate' :: UploadServerCertificate -> Sensitive Text
$sel:certificateBody:UploadServerCertificate' :: UploadServerCertificate -> Text
$sel:serverCertificateName:UploadServerCertificate' :: UploadServerCertificate -> Text
$sel:tags:UploadServerCertificate' :: UploadServerCertificate -> Maybe [Tag]
$sel:path:UploadServerCertificate' :: UploadServerCertificate -> Maybe Text
$sel:certificateChain:UploadServerCertificate' :: UploadServerCertificate -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"UploadServerCertificate" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"CertificateChain" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
certificateChain,
        ByteString
"Path" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
path,
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"ServerCertificateName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
serverCertificateName,
        ByteString
"CertificateBody" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
certificateBody,
        ByteString
"PrivateKey" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Sensitive Text
privateKey
      ]

-- | Contains the response to a successful UploadServerCertificate request.
--
-- /See:/ 'newUploadServerCertificateResponse' smart constructor.
data UploadServerCertificateResponse = UploadServerCertificateResponse'
  { -- | The meta information of the uploaded server certificate without its
    -- certificate body, certificate chain, and private key.
    UploadServerCertificateResponse -> Maybe ServerCertificateMetadata
serverCertificateMetadata :: Prelude.Maybe ServerCertificateMetadata,
    -- | A list of tags that are attached to the new IAM server certificate. The
    -- returned list of tags is sorted by tag key. For more information about
    -- tagging, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
    -- in the /IAM User Guide/.
    UploadServerCertificateResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    UploadServerCertificateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UploadServerCertificateResponse
-> UploadServerCertificateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UploadServerCertificateResponse
-> UploadServerCertificateResponse -> Bool
$c/= :: UploadServerCertificateResponse
-> UploadServerCertificateResponse -> Bool
== :: UploadServerCertificateResponse
-> UploadServerCertificateResponse -> Bool
$c== :: UploadServerCertificateResponse
-> UploadServerCertificateResponse -> Bool
Prelude.Eq, ReadPrec [UploadServerCertificateResponse]
ReadPrec UploadServerCertificateResponse
Int -> ReadS UploadServerCertificateResponse
ReadS [UploadServerCertificateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UploadServerCertificateResponse]
$creadListPrec :: ReadPrec [UploadServerCertificateResponse]
readPrec :: ReadPrec UploadServerCertificateResponse
$creadPrec :: ReadPrec UploadServerCertificateResponse
readList :: ReadS [UploadServerCertificateResponse]
$creadList :: ReadS [UploadServerCertificateResponse]
readsPrec :: Int -> ReadS UploadServerCertificateResponse
$creadsPrec :: Int -> ReadS UploadServerCertificateResponse
Prelude.Read, Int -> UploadServerCertificateResponse -> ShowS
[UploadServerCertificateResponse] -> ShowS
UploadServerCertificateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadServerCertificateResponse] -> ShowS
$cshowList :: [UploadServerCertificateResponse] -> ShowS
show :: UploadServerCertificateResponse -> String
$cshow :: UploadServerCertificateResponse -> String
showsPrec :: Int -> UploadServerCertificateResponse -> ShowS
$cshowsPrec :: Int -> UploadServerCertificateResponse -> ShowS
Prelude.Show, forall x.
Rep UploadServerCertificateResponse x
-> UploadServerCertificateResponse
forall x.
UploadServerCertificateResponse
-> Rep UploadServerCertificateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UploadServerCertificateResponse x
-> UploadServerCertificateResponse
$cfrom :: forall x.
UploadServerCertificateResponse
-> Rep UploadServerCertificateResponse x
Prelude.Generic)

-- |
-- Create a value of 'UploadServerCertificateResponse' 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:
--
-- 'serverCertificateMetadata', 'uploadServerCertificateResponse_serverCertificateMetadata' - The meta information of the uploaded server certificate without its
-- certificate body, certificate chain, and private key.
--
-- 'tags', 'uploadServerCertificateResponse_tags' - A list of tags that are attached to the new IAM server certificate. The
-- returned list of tags is sorted by tag key. For more information about
-- tagging, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
-- in the /IAM User Guide/.
--
-- 'httpStatus', 'uploadServerCertificateResponse_httpStatus' - The response's http status code.
newUploadServerCertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UploadServerCertificateResponse
newUploadServerCertificateResponse :: Int -> UploadServerCertificateResponse
newUploadServerCertificateResponse Int
pHttpStatus_ =
  UploadServerCertificateResponse'
    { $sel:serverCertificateMetadata:UploadServerCertificateResponse' :: Maybe ServerCertificateMetadata
serverCertificateMetadata =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:UploadServerCertificateResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UploadServerCertificateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The meta information of the uploaded server certificate without its
-- certificate body, certificate chain, and private key.
uploadServerCertificateResponse_serverCertificateMetadata :: Lens.Lens' UploadServerCertificateResponse (Prelude.Maybe ServerCertificateMetadata)
uploadServerCertificateResponse_serverCertificateMetadata :: Lens'
  UploadServerCertificateResponse (Maybe ServerCertificateMetadata)
uploadServerCertificateResponse_serverCertificateMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadServerCertificateResponse' {Maybe ServerCertificateMetadata
serverCertificateMetadata :: Maybe ServerCertificateMetadata
$sel:serverCertificateMetadata:UploadServerCertificateResponse' :: UploadServerCertificateResponse -> Maybe ServerCertificateMetadata
serverCertificateMetadata} -> Maybe ServerCertificateMetadata
serverCertificateMetadata) (\s :: UploadServerCertificateResponse
s@UploadServerCertificateResponse' {} Maybe ServerCertificateMetadata
a -> UploadServerCertificateResponse
s {$sel:serverCertificateMetadata:UploadServerCertificateResponse' :: Maybe ServerCertificateMetadata
serverCertificateMetadata = Maybe ServerCertificateMetadata
a} :: UploadServerCertificateResponse)

-- | A list of tags that are attached to the new IAM server certificate. The
-- returned list of tags is sorted by tag key. For more information about
-- tagging, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
-- in the /IAM User Guide/.
uploadServerCertificateResponse_tags :: Lens.Lens' UploadServerCertificateResponse (Prelude.Maybe [Tag])
uploadServerCertificateResponse_tags :: Lens' UploadServerCertificateResponse (Maybe [Tag])
uploadServerCertificateResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadServerCertificateResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:UploadServerCertificateResponse' :: UploadServerCertificateResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: UploadServerCertificateResponse
s@UploadServerCertificateResponse' {} Maybe [Tag]
a -> UploadServerCertificateResponse
s {$sel:tags:UploadServerCertificateResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: UploadServerCertificateResponse) 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.
uploadServerCertificateResponse_httpStatus :: Lens.Lens' UploadServerCertificateResponse Prelude.Int
uploadServerCertificateResponse_httpStatus :: Lens' UploadServerCertificateResponse Int
uploadServerCertificateResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadServerCertificateResponse' {Int
httpStatus :: Int
$sel:httpStatus:UploadServerCertificateResponse' :: UploadServerCertificateResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UploadServerCertificateResponse
s@UploadServerCertificateResponse' {} Int
a -> UploadServerCertificateResponse
s {$sel:httpStatus:UploadServerCertificateResponse' :: Int
httpStatus = Int
a} :: UploadServerCertificateResponse)

instance
  Prelude.NFData
    UploadServerCertificateResponse
  where
  rnf :: UploadServerCertificateResponse -> ()
rnf UploadServerCertificateResponse' {Int
Maybe [Tag]
Maybe ServerCertificateMetadata
httpStatus :: Int
tags :: Maybe [Tag]
serverCertificateMetadata :: Maybe ServerCertificateMetadata
$sel:httpStatus:UploadServerCertificateResponse' :: UploadServerCertificateResponse -> Int
$sel:tags:UploadServerCertificateResponse' :: UploadServerCertificateResponse -> Maybe [Tag]
$sel:serverCertificateMetadata:UploadServerCertificateResponse' :: UploadServerCertificateResponse -> Maybe ServerCertificateMetadata
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ServerCertificateMetadata
serverCertificateMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus