{-# 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.CreateAuditSuppression
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates 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 CreateAuditSuppression>
-- action.
module Amazonka.IoT.CreateAuditSuppression
  ( -- * Creating a Request
    CreateAuditSuppression (..),
    newCreateAuditSuppression,

    -- * Request Lenses
    createAuditSuppression_description,
    createAuditSuppression_expirationDate,
    createAuditSuppression_suppressIndefinitely,
    createAuditSuppression_checkName,
    createAuditSuppression_resourceIdentifier,
    createAuditSuppression_clientRequestToken,

    -- * Destructuring the Response
    CreateAuditSuppressionResponse (..),
    newCreateAuditSuppressionResponse,

    -- * Response Lenses
    createAuditSuppressionResponse_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:/ 'newCreateAuditSuppression' smart constructor.
data CreateAuditSuppression = CreateAuditSuppression'
  { -- | The description of the audit suppression.
    CreateAuditSuppression -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The epoch timestamp in seconds at which this suppression expires.
    CreateAuditSuppression -> Maybe POSIX
expirationDate :: Prelude.Maybe Data.POSIX,
    -- | Indicates whether a suppression should exist indefinitely or not.
    CreateAuditSuppression -> Maybe Bool
suppressIndefinitely :: Prelude.Maybe Prelude.Bool,
    CreateAuditSuppression -> Text
checkName :: Prelude.Text,
    CreateAuditSuppression -> ResourceIdentifier
resourceIdentifier :: ResourceIdentifier,
    -- | Each audit supression must have a unique client request token. If you
    -- try to create a new audit suppression with the same token as one that
    -- already exists, an exception occurs. If you omit this value, Amazon Web
    -- Services SDKs will automatically generate a unique client request.
    CreateAuditSuppression -> Text
clientRequestToken :: Prelude.Text
  }
  deriving (CreateAuditSuppression -> CreateAuditSuppression -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAuditSuppression -> CreateAuditSuppression -> Bool
$c/= :: CreateAuditSuppression -> CreateAuditSuppression -> Bool
== :: CreateAuditSuppression -> CreateAuditSuppression -> Bool
$c== :: CreateAuditSuppression -> CreateAuditSuppression -> Bool
Prelude.Eq, ReadPrec [CreateAuditSuppression]
ReadPrec CreateAuditSuppression
Int -> ReadS CreateAuditSuppression
ReadS [CreateAuditSuppression]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAuditSuppression]
$creadListPrec :: ReadPrec [CreateAuditSuppression]
readPrec :: ReadPrec CreateAuditSuppression
$creadPrec :: ReadPrec CreateAuditSuppression
readList :: ReadS [CreateAuditSuppression]
$creadList :: ReadS [CreateAuditSuppression]
readsPrec :: Int -> ReadS CreateAuditSuppression
$creadsPrec :: Int -> ReadS CreateAuditSuppression
Prelude.Read, Int -> CreateAuditSuppression -> ShowS
[CreateAuditSuppression] -> ShowS
CreateAuditSuppression -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAuditSuppression] -> ShowS
$cshowList :: [CreateAuditSuppression] -> ShowS
show :: CreateAuditSuppression -> String
$cshow :: CreateAuditSuppression -> String
showsPrec :: Int -> CreateAuditSuppression -> ShowS
$cshowsPrec :: Int -> CreateAuditSuppression -> ShowS
Prelude.Show, forall x. Rep CreateAuditSuppression x -> CreateAuditSuppression
forall x. CreateAuditSuppression -> Rep CreateAuditSuppression x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAuditSuppression x -> CreateAuditSuppression
$cfrom :: forall x. CreateAuditSuppression -> Rep CreateAuditSuppression x
Prelude.Generic)

-- |
-- Create a value of 'CreateAuditSuppression' 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:
--
-- 'description', 'createAuditSuppression_description' - The description of the audit suppression.
--
-- 'expirationDate', 'createAuditSuppression_expirationDate' - The epoch timestamp in seconds at which this suppression expires.
--
-- 'suppressIndefinitely', 'createAuditSuppression_suppressIndefinitely' - Indicates whether a suppression should exist indefinitely or not.
--
-- 'checkName', 'createAuditSuppression_checkName' - Undocumented member.
--
-- 'resourceIdentifier', 'createAuditSuppression_resourceIdentifier' - Undocumented member.
--
-- 'clientRequestToken', 'createAuditSuppression_clientRequestToken' - Each audit supression must have a unique client request token. If you
-- try to create a new audit suppression with the same token as one that
-- already exists, an exception occurs. If you omit this value, Amazon Web
-- Services SDKs will automatically generate a unique client request.
newCreateAuditSuppression ::
  -- | 'checkName'
  Prelude.Text ->
  -- | 'resourceIdentifier'
  ResourceIdentifier ->
  -- | 'clientRequestToken'
  Prelude.Text ->
  CreateAuditSuppression
newCreateAuditSuppression :: Text -> ResourceIdentifier -> Text -> CreateAuditSuppression
newCreateAuditSuppression
  Text
pCheckName_
  ResourceIdentifier
pResourceIdentifier_
  Text
pClientRequestToken_ =
    CreateAuditSuppression'
      { $sel:description:CreateAuditSuppression' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:expirationDate:CreateAuditSuppression' :: Maybe POSIX
expirationDate = forall a. Maybe a
Prelude.Nothing,
        $sel:suppressIndefinitely:CreateAuditSuppression' :: Maybe Bool
suppressIndefinitely = forall a. Maybe a
Prelude.Nothing,
        $sel:checkName:CreateAuditSuppression' :: Text
checkName = Text
pCheckName_,
        $sel:resourceIdentifier:CreateAuditSuppression' :: ResourceIdentifier
resourceIdentifier = ResourceIdentifier
pResourceIdentifier_,
        $sel:clientRequestToken:CreateAuditSuppression' :: Text
clientRequestToken = Text
pClientRequestToken_
      }

-- | The description of the audit suppression.
createAuditSuppression_description :: Lens.Lens' CreateAuditSuppression (Prelude.Maybe Prelude.Text)
createAuditSuppression_description :: Lens' CreateAuditSuppression (Maybe Text)
createAuditSuppression_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuditSuppression' {Maybe Text
description :: Maybe Text
$sel:description:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateAuditSuppression
s@CreateAuditSuppression' {} Maybe Text
a -> CreateAuditSuppression
s {$sel:description:CreateAuditSuppression' :: Maybe Text
description = Maybe Text
a} :: CreateAuditSuppression)

-- | The epoch timestamp in seconds at which this suppression expires.
createAuditSuppression_expirationDate :: Lens.Lens' CreateAuditSuppression (Prelude.Maybe Prelude.UTCTime)
createAuditSuppression_expirationDate :: Lens' CreateAuditSuppression (Maybe UTCTime)
createAuditSuppression_expirationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuditSuppression' {Maybe POSIX
expirationDate :: Maybe POSIX
$sel:expirationDate:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe POSIX
expirationDate} -> Maybe POSIX
expirationDate) (\s :: CreateAuditSuppression
s@CreateAuditSuppression' {} Maybe POSIX
a -> CreateAuditSuppression
s {$sel:expirationDate:CreateAuditSuppression' :: Maybe POSIX
expirationDate = Maybe POSIX
a} :: CreateAuditSuppression) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Indicates whether a suppression should exist indefinitely or not.
createAuditSuppression_suppressIndefinitely :: Lens.Lens' CreateAuditSuppression (Prelude.Maybe Prelude.Bool)
createAuditSuppression_suppressIndefinitely :: Lens' CreateAuditSuppression (Maybe Bool)
createAuditSuppression_suppressIndefinitely = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuditSuppression' {Maybe Bool
suppressIndefinitely :: Maybe Bool
$sel:suppressIndefinitely:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe Bool
suppressIndefinitely} -> Maybe Bool
suppressIndefinitely) (\s :: CreateAuditSuppression
s@CreateAuditSuppression' {} Maybe Bool
a -> CreateAuditSuppression
s {$sel:suppressIndefinitely:CreateAuditSuppression' :: Maybe Bool
suppressIndefinitely = Maybe Bool
a} :: CreateAuditSuppression)

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

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

-- | Each audit supression must have a unique client request token. If you
-- try to create a new audit suppression with the same token as one that
-- already exists, an exception occurs. If you omit this value, Amazon Web
-- Services SDKs will automatically generate a unique client request.
createAuditSuppression_clientRequestToken :: Lens.Lens' CreateAuditSuppression Prelude.Text
createAuditSuppression_clientRequestToken :: Lens' CreateAuditSuppression Text
createAuditSuppression_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuditSuppression' {Text
clientRequestToken :: Text
$sel:clientRequestToken:CreateAuditSuppression' :: CreateAuditSuppression -> Text
clientRequestToken} -> Text
clientRequestToken) (\s :: CreateAuditSuppression
s@CreateAuditSuppression' {} Text
a -> CreateAuditSuppression
s {$sel:clientRequestToken:CreateAuditSuppression' :: Text
clientRequestToken = Text
a} :: CreateAuditSuppression)

instance Core.AWSRequest CreateAuditSuppression where
  type
    AWSResponse CreateAuditSuppression =
      CreateAuditSuppressionResponse
  request :: (Service -> Service)
-> CreateAuditSuppression -> Request CreateAuditSuppression
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 CreateAuditSuppression
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateAuditSuppression)))
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 -> CreateAuditSuppressionResponse
CreateAuditSuppressionResponse'
            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 CreateAuditSuppression where
  hashWithSalt :: Int -> CreateAuditSuppression -> Int
hashWithSalt Int
_salt CreateAuditSuppression' {Maybe Bool
Maybe Text
Maybe POSIX
Text
ResourceIdentifier
clientRequestToken :: Text
resourceIdentifier :: ResourceIdentifier
checkName :: Text
suppressIndefinitely :: Maybe Bool
expirationDate :: Maybe POSIX
description :: Maybe Text
$sel:clientRequestToken:CreateAuditSuppression' :: CreateAuditSuppression -> Text
$sel:resourceIdentifier:CreateAuditSuppression' :: CreateAuditSuppression -> ResourceIdentifier
$sel:checkName:CreateAuditSuppression' :: CreateAuditSuppression -> Text
$sel:suppressIndefinitely:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe Bool
$sel:expirationDate:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe POSIX
$sel:description:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
expirationDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
suppressIndefinitely
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
checkName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceIdentifier
resourceIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientRequestToken

instance Prelude.NFData CreateAuditSuppression where
  rnf :: CreateAuditSuppression -> ()
rnf CreateAuditSuppression' {Maybe Bool
Maybe Text
Maybe POSIX
Text
ResourceIdentifier
clientRequestToken :: Text
resourceIdentifier :: ResourceIdentifier
checkName :: Text
suppressIndefinitely :: Maybe Bool
expirationDate :: Maybe POSIX
description :: Maybe Text
$sel:clientRequestToken:CreateAuditSuppression' :: CreateAuditSuppression -> Text
$sel:resourceIdentifier:CreateAuditSuppression' :: CreateAuditSuppression -> ResourceIdentifier
$sel:checkName:CreateAuditSuppression' :: CreateAuditSuppression -> Text
$sel:suppressIndefinitely:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe Bool
$sel:expirationDate:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe POSIX
$sel:description:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
expirationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
suppressIndefinitely
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientRequestToken

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

instance Data.ToJSON CreateAuditSuppression where
  toJSON :: CreateAuditSuppression -> Value
toJSON CreateAuditSuppression' {Maybe Bool
Maybe Text
Maybe POSIX
Text
ResourceIdentifier
clientRequestToken :: Text
resourceIdentifier :: ResourceIdentifier
checkName :: Text
suppressIndefinitely :: Maybe Bool
expirationDate :: Maybe POSIX
description :: Maybe Text
$sel:clientRequestToken:CreateAuditSuppression' :: CreateAuditSuppression -> Text
$sel:resourceIdentifier:CreateAuditSuppression' :: CreateAuditSuppression -> ResourceIdentifier
$sel:checkName:CreateAuditSuppression' :: CreateAuditSuppression -> Text
$sel:suppressIndefinitely:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe Bool
$sel:expirationDate:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe POSIX
$sel:description:CreateAuditSuppression' :: CreateAuditSuppression -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"expirationDate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe POSIX
expirationDate,
            (Key
"suppressIndefinitely" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
suppressIndefinitely,
            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),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"clientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientRequestToken)
          ]
      )

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

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

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

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

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

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