{-# 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.DeleteServerCertificate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes the specified server certificate.
--
-- 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 also includes a list of Amazon Web
-- Services services that can use the server certificates that you manage
-- with IAM.
--
-- If you are using a server certificate with Elastic Load Balancing,
-- deleting the certificate could have implications for your application.
-- If Elastic Load Balancing doesn\'t detect the deletion of bound
-- certificates, it may continue to use the certificates. This could cause
-- Elastic Load Balancing to stop accepting traffic. We recommend that you
-- remove the reference to the certificate from Elastic Load Balancing
-- before using this command to delete the certificate. For more
-- information, see
-- <https://docs.aws.amazon.com/ElasticLoadBalancing/latest/APIReference/API_DeleteLoadBalancerListeners.html DeleteLoadBalancerListeners>
-- in the /Elastic Load Balancing API Reference/.
module Amazonka.IAM.DeleteServerCertificate
  ( -- * Creating a Request
    DeleteServerCertificate (..),
    newDeleteServerCertificate,

    -- * Request Lenses
    deleteServerCertificate_serverCertificateName,

    -- * Destructuring the Response
    DeleteServerCertificateResponse (..),
    newDeleteServerCertificateResponse,
  )
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:/ 'newDeleteServerCertificate' smart constructor.
data DeleteServerCertificate = DeleteServerCertificate'
  { -- | The name of the server certificate you want to delete.
    --
    -- 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: _+=,.\@-
    DeleteServerCertificate -> Text
serverCertificateName :: Prelude.Text
  }
  deriving (DeleteServerCertificate -> DeleteServerCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteServerCertificate -> DeleteServerCertificate -> Bool
$c/= :: DeleteServerCertificate -> DeleteServerCertificate -> Bool
== :: DeleteServerCertificate -> DeleteServerCertificate -> Bool
$c== :: DeleteServerCertificate -> DeleteServerCertificate -> Bool
Prelude.Eq, ReadPrec [DeleteServerCertificate]
ReadPrec DeleteServerCertificate
Int -> ReadS DeleteServerCertificate
ReadS [DeleteServerCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteServerCertificate]
$creadListPrec :: ReadPrec [DeleteServerCertificate]
readPrec :: ReadPrec DeleteServerCertificate
$creadPrec :: ReadPrec DeleteServerCertificate
readList :: ReadS [DeleteServerCertificate]
$creadList :: ReadS [DeleteServerCertificate]
readsPrec :: Int -> ReadS DeleteServerCertificate
$creadsPrec :: Int -> ReadS DeleteServerCertificate
Prelude.Read, Int -> DeleteServerCertificate -> ShowS
[DeleteServerCertificate] -> ShowS
DeleteServerCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteServerCertificate] -> ShowS
$cshowList :: [DeleteServerCertificate] -> ShowS
show :: DeleteServerCertificate -> String
$cshow :: DeleteServerCertificate -> String
showsPrec :: Int -> DeleteServerCertificate -> ShowS
$cshowsPrec :: Int -> DeleteServerCertificate -> ShowS
Prelude.Show, forall x. Rep DeleteServerCertificate x -> DeleteServerCertificate
forall x. DeleteServerCertificate -> Rep DeleteServerCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteServerCertificate x -> DeleteServerCertificate
$cfrom :: forall x. DeleteServerCertificate -> Rep DeleteServerCertificate x
Prelude.Generic)

-- |
-- Create a value of 'DeleteServerCertificate' 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', 'deleteServerCertificate_serverCertificateName' - The name of the server certificate you want to delete.
--
-- 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: _+=,.\@-
newDeleteServerCertificate ::
  -- | 'serverCertificateName'
  Prelude.Text ->
  DeleteServerCertificate
newDeleteServerCertificate :: Text -> DeleteServerCertificate
newDeleteServerCertificate Text
pServerCertificateName_ =
  DeleteServerCertificate'
    { $sel:serverCertificateName:DeleteServerCertificate' :: Text
serverCertificateName =
        Text
pServerCertificateName_
    }

-- | The name of the server certificate you want to delete.
--
-- 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: _+=,.\@-
deleteServerCertificate_serverCertificateName :: Lens.Lens' DeleteServerCertificate Prelude.Text
deleteServerCertificate_serverCertificateName :: Lens' DeleteServerCertificate Text
deleteServerCertificate_serverCertificateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteServerCertificate' {Text
serverCertificateName :: Text
$sel:serverCertificateName:DeleteServerCertificate' :: DeleteServerCertificate -> Text
serverCertificateName} -> Text
serverCertificateName) (\s :: DeleteServerCertificate
s@DeleteServerCertificate' {} Text
a -> DeleteServerCertificate
s {$sel:serverCertificateName:DeleteServerCertificate' :: Text
serverCertificateName = Text
a} :: DeleteServerCertificate)

instance Core.AWSRequest DeleteServerCertificate where
  type
    AWSResponse DeleteServerCertificate =
      DeleteServerCertificateResponse
  request :: (Service -> Service)
-> DeleteServerCertificate -> Request DeleteServerCertificate
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 DeleteServerCertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteServerCertificate)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteServerCertificateResponse
DeleteServerCertificateResponse'

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

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

instance Data.ToHeaders DeleteServerCertificate where
  toHeaders :: DeleteServerCertificate -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DeleteServerCertificate where
  toQuery :: DeleteServerCertificate -> QueryString
toQuery DeleteServerCertificate' {Text
serverCertificateName :: Text
$sel:serverCertificateName:DeleteServerCertificate' :: DeleteServerCertificate -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteServerCertificate" :: 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
      ]

-- | /See:/ 'newDeleteServerCertificateResponse' smart constructor.
data DeleteServerCertificateResponse = DeleteServerCertificateResponse'
  {
  }
  deriving (DeleteServerCertificateResponse
-> DeleteServerCertificateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteServerCertificateResponse
-> DeleteServerCertificateResponse -> Bool
$c/= :: DeleteServerCertificateResponse
-> DeleteServerCertificateResponse -> Bool
== :: DeleteServerCertificateResponse
-> DeleteServerCertificateResponse -> Bool
$c== :: DeleteServerCertificateResponse
-> DeleteServerCertificateResponse -> Bool
Prelude.Eq, ReadPrec [DeleteServerCertificateResponse]
ReadPrec DeleteServerCertificateResponse
Int -> ReadS DeleteServerCertificateResponse
ReadS [DeleteServerCertificateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteServerCertificateResponse]
$creadListPrec :: ReadPrec [DeleteServerCertificateResponse]
readPrec :: ReadPrec DeleteServerCertificateResponse
$creadPrec :: ReadPrec DeleteServerCertificateResponse
readList :: ReadS [DeleteServerCertificateResponse]
$creadList :: ReadS [DeleteServerCertificateResponse]
readsPrec :: Int -> ReadS DeleteServerCertificateResponse
$creadsPrec :: Int -> ReadS DeleteServerCertificateResponse
Prelude.Read, Int -> DeleteServerCertificateResponse -> ShowS
[DeleteServerCertificateResponse] -> ShowS
DeleteServerCertificateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteServerCertificateResponse] -> ShowS
$cshowList :: [DeleteServerCertificateResponse] -> ShowS
show :: DeleteServerCertificateResponse -> String
$cshow :: DeleteServerCertificateResponse -> String
showsPrec :: Int -> DeleteServerCertificateResponse -> ShowS
$cshowsPrec :: Int -> DeleteServerCertificateResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteServerCertificateResponse x
-> DeleteServerCertificateResponse
forall x.
DeleteServerCertificateResponse
-> Rep DeleteServerCertificateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteServerCertificateResponse x
-> DeleteServerCertificateResponse
$cfrom :: forall x.
DeleteServerCertificateResponse
-> Rep DeleteServerCertificateResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteServerCertificateResponse' 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.
newDeleteServerCertificateResponse ::
  DeleteServerCertificateResponse
newDeleteServerCertificateResponse :: DeleteServerCertificateResponse
newDeleteServerCertificateResponse =
  DeleteServerCertificateResponse
DeleteServerCertificateResponse'

instance
  Prelude.NFData
    DeleteServerCertificateResponse
  where
  rnf :: DeleteServerCertificateResponse -> ()
rnf DeleteServerCertificateResponse
_ = ()