{-# 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.DeleteSigningCertificate
-- 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 a signing certificate associated with the specified IAM user.
--
-- If you do not specify a user name, IAM determines the user name
-- implicitly based on the Amazon Web Services access key ID signing the
-- request. This operation works for access keys under the Amazon Web
-- Services account. Consequently, you can use this operation to manage
-- Amazon Web Services account root user credentials even if the Amazon Web
-- Services account has no associated IAM users.
module Amazonka.IAM.DeleteSigningCertificate
  ( -- * Creating a Request
    DeleteSigningCertificate (..),
    newDeleteSigningCertificate,

    -- * Request Lenses
    deleteSigningCertificate_userName,
    deleteSigningCertificate_certificateId,

    -- * Destructuring the Response
    DeleteSigningCertificateResponse (..),
    newDeleteSigningCertificateResponse,
  )
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:/ 'newDeleteSigningCertificate' smart constructor.
data DeleteSigningCertificate = DeleteSigningCertificate'
  { -- | The name of the user the signing certificate belongs to.
    --
    -- 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: _+=,.\@-
    DeleteSigningCertificate -> Maybe Text
userName :: Prelude.Maybe Prelude.Text,
    -- | The ID of the signing certificate to delete.
    --
    -- The format of this parameter, as described by its
    -- <http://wikipedia.org/wiki/regex regex> pattern, is a string of
    -- characters that can be upper- or lower-cased letters or digits.
    DeleteSigningCertificate -> Text
certificateId :: Prelude.Text
  }
  deriving (DeleteSigningCertificate -> DeleteSigningCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteSigningCertificate -> DeleteSigningCertificate -> Bool
$c/= :: DeleteSigningCertificate -> DeleteSigningCertificate -> Bool
== :: DeleteSigningCertificate -> DeleteSigningCertificate -> Bool
$c== :: DeleteSigningCertificate -> DeleteSigningCertificate -> Bool
Prelude.Eq, ReadPrec [DeleteSigningCertificate]
ReadPrec DeleteSigningCertificate
Int -> ReadS DeleteSigningCertificate
ReadS [DeleteSigningCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteSigningCertificate]
$creadListPrec :: ReadPrec [DeleteSigningCertificate]
readPrec :: ReadPrec DeleteSigningCertificate
$creadPrec :: ReadPrec DeleteSigningCertificate
readList :: ReadS [DeleteSigningCertificate]
$creadList :: ReadS [DeleteSigningCertificate]
readsPrec :: Int -> ReadS DeleteSigningCertificate
$creadsPrec :: Int -> ReadS DeleteSigningCertificate
Prelude.Read, Int -> DeleteSigningCertificate -> ShowS
[DeleteSigningCertificate] -> ShowS
DeleteSigningCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteSigningCertificate] -> ShowS
$cshowList :: [DeleteSigningCertificate] -> ShowS
show :: DeleteSigningCertificate -> String
$cshow :: DeleteSigningCertificate -> String
showsPrec :: Int -> DeleteSigningCertificate -> ShowS
$cshowsPrec :: Int -> DeleteSigningCertificate -> ShowS
Prelude.Show, forall x.
Rep DeleteSigningCertificate x -> DeleteSigningCertificate
forall x.
DeleteSigningCertificate -> Rep DeleteSigningCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteSigningCertificate x -> DeleteSigningCertificate
$cfrom :: forall x.
DeleteSigningCertificate -> Rep DeleteSigningCertificate x
Prelude.Generic)

-- |
-- Create a value of 'DeleteSigningCertificate' 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:
--
-- 'userName', 'deleteSigningCertificate_userName' - The name of the user the signing certificate belongs to.
--
-- 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: _+=,.\@-
--
-- 'certificateId', 'deleteSigningCertificate_certificateId' - The ID of the signing certificate to delete.
--
-- The format of this parameter, as described by its
-- <http://wikipedia.org/wiki/regex regex> pattern, is a string of
-- characters that can be upper- or lower-cased letters or digits.
newDeleteSigningCertificate ::
  -- | 'certificateId'
  Prelude.Text ->
  DeleteSigningCertificate
newDeleteSigningCertificate :: Text -> DeleteSigningCertificate
newDeleteSigningCertificate Text
pCertificateId_ =
  DeleteSigningCertificate'
    { $sel:userName:DeleteSigningCertificate' :: Maybe Text
userName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:certificateId:DeleteSigningCertificate' :: Text
certificateId = Text
pCertificateId_
    }

-- | The name of the user the signing certificate belongs to.
--
-- 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: _+=,.\@-
deleteSigningCertificate_userName :: Lens.Lens' DeleteSigningCertificate (Prelude.Maybe Prelude.Text)
deleteSigningCertificate_userName :: Lens' DeleteSigningCertificate (Maybe Text)
deleteSigningCertificate_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSigningCertificate' {Maybe Text
userName :: Maybe Text
$sel:userName:DeleteSigningCertificate' :: DeleteSigningCertificate -> Maybe Text
userName} -> Maybe Text
userName) (\s :: DeleteSigningCertificate
s@DeleteSigningCertificate' {} Maybe Text
a -> DeleteSigningCertificate
s {$sel:userName:DeleteSigningCertificate' :: Maybe Text
userName = Maybe Text
a} :: DeleteSigningCertificate)

-- | The ID of the signing certificate to delete.
--
-- The format of this parameter, as described by its
-- <http://wikipedia.org/wiki/regex regex> pattern, is a string of
-- characters that can be upper- or lower-cased letters or digits.
deleteSigningCertificate_certificateId :: Lens.Lens' DeleteSigningCertificate Prelude.Text
deleteSigningCertificate_certificateId :: Lens' DeleteSigningCertificate Text
deleteSigningCertificate_certificateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSigningCertificate' {Text
certificateId :: Text
$sel:certificateId:DeleteSigningCertificate' :: DeleteSigningCertificate -> Text
certificateId} -> Text
certificateId) (\s :: DeleteSigningCertificate
s@DeleteSigningCertificate' {} Text
a -> DeleteSigningCertificate
s {$sel:certificateId:DeleteSigningCertificate' :: Text
certificateId = Text
a} :: DeleteSigningCertificate)

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

instance Prelude.Hashable DeleteSigningCertificate where
  hashWithSalt :: Int -> DeleteSigningCertificate -> Int
hashWithSalt Int
_salt DeleteSigningCertificate' {Maybe Text
Text
certificateId :: Text
userName :: Maybe Text
$sel:certificateId:DeleteSigningCertificate' :: DeleteSigningCertificate -> Text
$sel:userName:DeleteSigningCertificate' :: DeleteSigningCertificate -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
certificateId

instance Prelude.NFData DeleteSigningCertificate where
  rnf :: DeleteSigningCertificate -> ()
rnf DeleteSigningCertificate' {Maybe Text
Text
certificateId :: Text
userName :: Maybe Text
$sel:certificateId:DeleteSigningCertificate' :: DeleteSigningCertificate -> Text
$sel:userName:DeleteSigningCertificate' :: DeleteSigningCertificate -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
certificateId

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

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

instance Data.ToQuery DeleteSigningCertificate where
  toQuery :: DeleteSigningCertificate -> QueryString
toQuery DeleteSigningCertificate' {Maybe Text
Text
certificateId :: Text
userName :: Maybe Text
$sel:certificateId:DeleteSigningCertificate' :: DeleteSigningCertificate -> Text
$sel:userName:DeleteSigningCertificate' :: DeleteSigningCertificate -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteSigningCertificate" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"UserName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
userName,
        ByteString
"CertificateId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
certificateId
      ]

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

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

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