{-# 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.IoT.DeleteCACertificate
-- 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 registered CA certificate.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions DeleteCACertificate>
-- action.
module Amazonka.IoT.DeleteCACertificate
  ( -- * Creating a Request
    DeleteCACertificate (..),
    newDeleteCACertificate,

    -- * Request Lenses
    deleteCACertificate_certificateId,

    -- * Destructuring the Response
    DeleteCACertificateResponse (..),
    newDeleteCACertificateResponse,

    -- * Response Lenses
    deleteCACertificateResponse_httpStatus,
  )
where

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

-- | Input for the DeleteCACertificate operation.
--
-- /See:/ 'newDeleteCACertificate' smart constructor.
data DeleteCACertificate = DeleteCACertificate'
  { -- | The ID of the certificate to delete. (The last part of the certificate
    -- ARN contains the certificate ID.)
    DeleteCACertificate -> Text
certificateId :: Prelude.Text
  }
  deriving (DeleteCACertificate -> DeleteCACertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteCACertificate -> DeleteCACertificate -> Bool
$c/= :: DeleteCACertificate -> DeleteCACertificate -> Bool
== :: DeleteCACertificate -> DeleteCACertificate -> Bool
$c== :: DeleteCACertificate -> DeleteCACertificate -> Bool
Prelude.Eq, ReadPrec [DeleteCACertificate]
ReadPrec DeleteCACertificate
Int -> ReadS DeleteCACertificate
ReadS [DeleteCACertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteCACertificate]
$creadListPrec :: ReadPrec [DeleteCACertificate]
readPrec :: ReadPrec DeleteCACertificate
$creadPrec :: ReadPrec DeleteCACertificate
readList :: ReadS [DeleteCACertificate]
$creadList :: ReadS [DeleteCACertificate]
readsPrec :: Int -> ReadS DeleteCACertificate
$creadsPrec :: Int -> ReadS DeleteCACertificate
Prelude.Read, Int -> DeleteCACertificate -> ShowS
[DeleteCACertificate] -> ShowS
DeleteCACertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteCACertificate] -> ShowS
$cshowList :: [DeleteCACertificate] -> ShowS
show :: DeleteCACertificate -> String
$cshow :: DeleteCACertificate -> String
showsPrec :: Int -> DeleteCACertificate -> ShowS
$cshowsPrec :: Int -> DeleteCACertificate -> ShowS
Prelude.Show, forall x. Rep DeleteCACertificate x -> DeleteCACertificate
forall x. DeleteCACertificate -> Rep DeleteCACertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteCACertificate x -> DeleteCACertificate
$cfrom :: forall x. DeleteCACertificate -> Rep DeleteCACertificate x
Prelude.Generic)

-- |
-- Create a value of 'DeleteCACertificate' 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:
--
-- 'certificateId', 'deleteCACertificate_certificateId' - The ID of the certificate to delete. (The last part of the certificate
-- ARN contains the certificate ID.)
newDeleteCACertificate ::
  -- | 'certificateId'
  Prelude.Text ->
  DeleteCACertificate
newDeleteCACertificate :: Text -> DeleteCACertificate
newDeleteCACertificate Text
pCertificateId_ =
  DeleteCACertificate'
    { $sel:certificateId:DeleteCACertificate' :: Text
certificateId =
        Text
pCertificateId_
    }

-- | The ID of the certificate to delete. (The last part of the certificate
-- ARN contains the certificate ID.)
deleteCACertificate_certificateId :: Lens.Lens' DeleteCACertificate Prelude.Text
deleteCACertificate_certificateId :: Lens' DeleteCACertificate Text
deleteCACertificate_certificateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCACertificate' {Text
certificateId :: Text
$sel:certificateId:DeleteCACertificate' :: DeleteCACertificate -> Text
certificateId} -> Text
certificateId) (\s :: DeleteCACertificate
s@DeleteCACertificate' {} Text
a -> DeleteCACertificate
s {$sel:certificateId:DeleteCACertificate' :: Text
certificateId = Text
a} :: DeleteCACertificate)

instance Core.AWSRequest DeleteCACertificate where
  type
    AWSResponse DeleteCACertificate =
      DeleteCACertificateResponse
  request :: (Service -> Service)
-> DeleteCACertificate -> Request DeleteCACertificate
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteCACertificate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteCACertificate)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> DeleteCACertificateResponse
DeleteCACertificateResponse'
            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))
      )

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

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

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

instance Data.ToPath DeleteCACertificate where
  toPath :: DeleteCACertificate -> ByteString
toPath DeleteCACertificate' {Text
certificateId :: Text
$sel:certificateId:DeleteCACertificate' :: DeleteCACertificate -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/cacertificate/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
certificateId]

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

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

-- |
-- Create a value of 'DeleteCACertificateResponse' 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', 'deleteCACertificateResponse_httpStatus' - The response's http status code.
newDeleteCACertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteCACertificateResponse
newDeleteCACertificateResponse :: Int -> DeleteCACertificateResponse
newDeleteCACertificateResponse Int
pHttpStatus_ =
  DeleteCACertificateResponse'
    { $sel:httpStatus:DeleteCACertificateResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData DeleteCACertificateResponse where
  rnf :: DeleteCACertificateResponse -> ()
rnf DeleteCACertificateResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteCACertificateResponse' :: DeleteCACertificateResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus