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

    -- * Request Lenses
    deleteAuditSuppression_checkName,
    deleteAuditSuppression_resourceIdentifier,

    -- * Destructuring the Response
    DeleteAuditSuppressionResponse (..),
    newDeleteAuditSuppressionResponse,

    -- * Response Lenses
    deleteAuditSuppressionResponse_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

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

-- |
-- Create a value of 'DeleteAuditSuppression' 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:
--
-- 'checkName', 'deleteAuditSuppression_checkName' - Undocumented member.
--
-- 'resourceIdentifier', 'deleteAuditSuppression_resourceIdentifier' - Undocumented member.
newDeleteAuditSuppression ::
  -- | 'checkName'
  Prelude.Text ->
  -- | 'resourceIdentifier'
  ResourceIdentifier ->
  DeleteAuditSuppression
newDeleteAuditSuppression :: Text -> ResourceIdentifier -> DeleteAuditSuppression
newDeleteAuditSuppression
  Text
pCheckName_
  ResourceIdentifier
pResourceIdentifier_ =
    DeleteAuditSuppression'
      { $sel:checkName:DeleteAuditSuppression' :: Text
checkName = Text
pCheckName_,
        $sel:resourceIdentifier:DeleteAuditSuppression' :: ResourceIdentifier
resourceIdentifier = ResourceIdentifier
pResourceIdentifier_
      }

-- | Undocumented member.
deleteAuditSuppression_checkName :: Lens.Lens' DeleteAuditSuppression Prelude.Text
deleteAuditSuppression_checkName :: Lens' DeleteAuditSuppression Text
deleteAuditSuppression_checkName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAuditSuppression' {Text
checkName :: Text
$sel:checkName:DeleteAuditSuppression' :: DeleteAuditSuppression -> Text
checkName} -> Text
checkName) (\s :: DeleteAuditSuppression
s@DeleteAuditSuppression' {} Text
a -> DeleteAuditSuppression
s {$sel:checkName:DeleteAuditSuppression' :: Text
checkName = Text
a} :: DeleteAuditSuppression)

-- | Undocumented member.
deleteAuditSuppression_resourceIdentifier :: Lens.Lens' DeleteAuditSuppression ResourceIdentifier
deleteAuditSuppression_resourceIdentifier :: Lens' DeleteAuditSuppression ResourceIdentifier
deleteAuditSuppression_resourceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAuditSuppression' {ResourceIdentifier
resourceIdentifier :: ResourceIdentifier
$sel:resourceIdentifier:DeleteAuditSuppression' :: DeleteAuditSuppression -> ResourceIdentifier
resourceIdentifier} -> ResourceIdentifier
resourceIdentifier) (\s :: DeleteAuditSuppression
s@DeleteAuditSuppression' {} ResourceIdentifier
a -> DeleteAuditSuppression
s {$sel:resourceIdentifier:DeleteAuditSuppression' :: ResourceIdentifier
resourceIdentifier = ResourceIdentifier
a} :: DeleteAuditSuppression)

instance Core.AWSRequest DeleteAuditSuppression where
  type
    AWSResponse DeleteAuditSuppression =
      DeleteAuditSuppressionResponse
  request :: (Service -> Service)
-> DeleteAuditSuppression -> Request DeleteAuditSuppression
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteAuditSuppression
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteAuditSuppression)))
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 -> DeleteAuditSuppressionResponse
DeleteAuditSuppressionResponse'
            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 DeleteAuditSuppression where
  hashWithSalt :: Int -> DeleteAuditSuppression -> Int
hashWithSalt Int
_salt DeleteAuditSuppression' {Text
ResourceIdentifier
resourceIdentifier :: ResourceIdentifier
checkName :: Text
$sel:resourceIdentifier:DeleteAuditSuppression' :: DeleteAuditSuppression -> ResourceIdentifier
$sel:checkName:DeleteAuditSuppression' :: DeleteAuditSuppression -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
checkName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceIdentifier
resourceIdentifier

instance Prelude.NFData DeleteAuditSuppression where
  rnf :: DeleteAuditSuppression -> ()
rnf DeleteAuditSuppression' {Text
ResourceIdentifier
resourceIdentifier :: ResourceIdentifier
checkName :: Text
$sel:resourceIdentifier:DeleteAuditSuppression' :: DeleteAuditSuppression -> ResourceIdentifier
$sel:checkName:DeleteAuditSuppression' :: DeleteAuditSuppression -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
checkName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceIdentifier
resourceIdentifier

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

instance Data.ToJSON DeleteAuditSuppression where
  toJSON :: DeleteAuditSuppression -> Value
toJSON DeleteAuditSuppression' {Text
ResourceIdentifier
resourceIdentifier :: ResourceIdentifier
checkName :: Text
$sel:resourceIdentifier:DeleteAuditSuppression' :: DeleteAuditSuppression -> ResourceIdentifier
$sel:checkName:DeleteAuditSuppression' :: DeleteAuditSuppression -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"checkName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
checkName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"resourceIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ResourceIdentifier
resourceIdentifier)
          ]
      )

instance Data.ToPath DeleteAuditSuppression where
  toPath :: DeleteAuditSuppression -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/audit/suppressions/delete"

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

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

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

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

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