{-# 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.DescribeAuditSuppression
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about a Device Defender audit suppression.
module Amazonka.IoT.DescribeAuditSuppression
  ( -- * Creating a Request
    DescribeAuditSuppression (..),
    newDescribeAuditSuppression,

    -- * Request Lenses
    describeAuditSuppression_checkName,
    describeAuditSuppression_resourceIdentifier,

    -- * Destructuring the Response
    DescribeAuditSuppressionResponse (..),
    newDescribeAuditSuppressionResponse,

    -- * Response Lenses
    describeAuditSuppressionResponse_checkName,
    describeAuditSuppressionResponse_description,
    describeAuditSuppressionResponse_expirationDate,
    describeAuditSuppressionResponse_resourceIdentifier,
    describeAuditSuppressionResponse_suppressIndefinitely,
    describeAuditSuppressionResponse_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:/ 'newDescribeAuditSuppression' smart constructor.
data DescribeAuditSuppression = DescribeAuditSuppression'
  { DescribeAuditSuppression -> Text
checkName :: Prelude.Text,
    DescribeAuditSuppression -> ResourceIdentifier
resourceIdentifier :: ResourceIdentifier
  }
  deriving (DescribeAuditSuppression -> DescribeAuditSuppression -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAuditSuppression -> DescribeAuditSuppression -> Bool
$c/= :: DescribeAuditSuppression -> DescribeAuditSuppression -> Bool
== :: DescribeAuditSuppression -> DescribeAuditSuppression -> Bool
$c== :: DescribeAuditSuppression -> DescribeAuditSuppression -> Bool
Prelude.Eq, ReadPrec [DescribeAuditSuppression]
ReadPrec DescribeAuditSuppression
Int -> ReadS DescribeAuditSuppression
ReadS [DescribeAuditSuppression]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAuditSuppression]
$creadListPrec :: ReadPrec [DescribeAuditSuppression]
readPrec :: ReadPrec DescribeAuditSuppression
$creadPrec :: ReadPrec DescribeAuditSuppression
readList :: ReadS [DescribeAuditSuppression]
$creadList :: ReadS [DescribeAuditSuppression]
readsPrec :: Int -> ReadS DescribeAuditSuppression
$creadsPrec :: Int -> ReadS DescribeAuditSuppression
Prelude.Read, Int -> DescribeAuditSuppression -> ShowS
[DescribeAuditSuppression] -> ShowS
DescribeAuditSuppression -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAuditSuppression] -> ShowS
$cshowList :: [DescribeAuditSuppression] -> ShowS
show :: DescribeAuditSuppression -> String
$cshow :: DescribeAuditSuppression -> String
showsPrec :: Int -> DescribeAuditSuppression -> ShowS
$cshowsPrec :: Int -> DescribeAuditSuppression -> ShowS
Prelude.Show, forall x.
Rep DescribeAuditSuppression x -> DescribeAuditSuppression
forall x.
DescribeAuditSuppression -> Rep DescribeAuditSuppression x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeAuditSuppression x -> DescribeAuditSuppression
$cfrom :: forall x.
DescribeAuditSuppression -> Rep DescribeAuditSuppression x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAuditSuppression' 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', 'describeAuditSuppression_checkName' - Undocumented member.
--
-- 'resourceIdentifier', 'describeAuditSuppression_resourceIdentifier' - Undocumented member.
newDescribeAuditSuppression ::
  -- | 'checkName'
  Prelude.Text ->
  -- | 'resourceIdentifier'
  ResourceIdentifier ->
  DescribeAuditSuppression
newDescribeAuditSuppression :: Text -> ResourceIdentifier -> DescribeAuditSuppression
newDescribeAuditSuppression
  Text
pCheckName_
  ResourceIdentifier
pResourceIdentifier_ =
    DescribeAuditSuppression'
      { $sel:checkName:DescribeAuditSuppression' :: Text
checkName = Text
pCheckName_,
        $sel:resourceIdentifier:DescribeAuditSuppression' :: ResourceIdentifier
resourceIdentifier = ResourceIdentifier
pResourceIdentifier_
      }

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

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

instance Core.AWSRequest DescribeAuditSuppression where
  type
    AWSResponse DescribeAuditSuppression =
      DescribeAuditSuppressionResponse
  request :: (Service -> Service)
-> DescribeAuditSuppression -> Request DescribeAuditSuppression
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 DescribeAuditSuppression
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeAuditSuppression)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe ResourceIdentifier
-> Maybe Bool
-> Int
-> DescribeAuditSuppressionResponse
DescribeAuditSuppressionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"checkName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"expirationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"resourceIdentifier")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"suppressIndefinitely")
            forall (f :: * -> *) a b. Applicative f => 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 DescribeAuditSuppression where
  hashWithSalt :: Int -> DescribeAuditSuppression -> Int
hashWithSalt Int
_salt DescribeAuditSuppression' {Text
ResourceIdentifier
resourceIdentifier :: ResourceIdentifier
checkName :: Text
$sel:resourceIdentifier:DescribeAuditSuppression' :: DescribeAuditSuppression -> ResourceIdentifier
$sel:checkName:DescribeAuditSuppression' :: DescribeAuditSuppression -> 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 DescribeAuditSuppression where
  rnf :: DescribeAuditSuppression -> ()
rnf DescribeAuditSuppression' {Text
ResourceIdentifier
resourceIdentifier :: ResourceIdentifier
checkName :: Text
$sel:resourceIdentifier:DescribeAuditSuppression' :: DescribeAuditSuppression -> ResourceIdentifier
$sel:checkName:DescribeAuditSuppression' :: DescribeAuditSuppression -> 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 DescribeAuditSuppression where
  toHeaders :: DescribeAuditSuppression -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON DescribeAuditSuppression where
  toJSON :: DescribeAuditSuppression -> Value
toJSON DescribeAuditSuppression' {Text
ResourceIdentifier
resourceIdentifier :: ResourceIdentifier
checkName :: Text
$sel:resourceIdentifier:DescribeAuditSuppression' :: DescribeAuditSuppression -> ResourceIdentifier
$sel:checkName:DescribeAuditSuppression' :: DescribeAuditSuppression -> 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 DescribeAuditSuppression where
  toPath :: DescribeAuditSuppression -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/audit/suppressions/describe"

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

-- | /See:/ 'newDescribeAuditSuppressionResponse' smart constructor.
data DescribeAuditSuppressionResponse = DescribeAuditSuppressionResponse'
  { DescribeAuditSuppressionResponse -> Maybe Text
checkName :: Prelude.Maybe Prelude.Text,
    -- | The description of the audit suppression.
    DescribeAuditSuppressionResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The epoch timestamp in seconds at which this suppression expires.
    DescribeAuditSuppressionResponse -> Maybe POSIX
expirationDate :: Prelude.Maybe Data.POSIX,
    DescribeAuditSuppressionResponse -> Maybe ResourceIdentifier
resourceIdentifier :: Prelude.Maybe ResourceIdentifier,
    -- | Indicates whether a suppression should exist indefinitely or not.
    DescribeAuditSuppressionResponse -> Maybe Bool
suppressIndefinitely :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    DescribeAuditSuppressionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeAuditSuppressionResponse
-> DescribeAuditSuppressionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAuditSuppressionResponse
-> DescribeAuditSuppressionResponse -> Bool
$c/= :: DescribeAuditSuppressionResponse
-> DescribeAuditSuppressionResponse -> Bool
== :: DescribeAuditSuppressionResponse
-> DescribeAuditSuppressionResponse -> Bool
$c== :: DescribeAuditSuppressionResponse
-> DescribeAuditSuppressionResponse -> Bool
Prelude.Eq, ReadPrec [DescribeAuditSuppressionResponse]
ReadPrec DescribeAuditSuppressionResponse
Int -> ReadS DescribeAuditSuppressionResponse
ReadS [DescribeAuditSuppressionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAuditSuppressionResponse]
$creadListPrec :: ReadPrec [DescribeAuditSuppressionResponse]
readPrec :: ReadPrec DescribeAuditSuppressionResponse
$creadPrec :: ReadPrec DescribeAuditSuppressionResponse
readList :: ReadS [DescribeAuditSuppressionResponse]
$creadList :: ReadS [DescribeAuditSuppressionResponse]
readsPrec :: Int -> ReadS DescribeAuditSuppressionResponse
$creadsPrec :: Int -> ReadS DescribeAuditSuppressionResponse
Prelude.Read, Int -> DescribeAuditSuppressionResponse -> ShowS
[DescribeAuditSuppressionResponse] -> ShowS
DescribeAuditSuppressionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAuditSuppressionResponse] -> ShowS
$cshowList :: [DescribeAuditSuppressionResponse] -> ShowS
show :: DescribeAuditSuppressionResponse -> String
$cshow :: DescribeAuditSuppressionResponse -> String
showsPrec :: Int -> DescribeAuditSuppressionResponse -> ShowS
$cshowsPrec :: Int -> DescribeAuditSuppressionResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeAuditSuppressionResponse x
-> DescribeAuditSuppressionResponse
forall x.
DescribeAuditSuppressionResponse
-> Rep DescribeAuditSuppressionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeAuditSuppressionResponse x
-> DescribeAuditSuppressionResponse
$cfrom :: forall x.
DescribeAuditSuppressionResponse
-> Rep DescribeAuditSuppressionResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAuditSuppressionResponse' 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', 'describeAuditSuppressionResponse_checkName' - Undocumented member.
--
-- 'description', 'describeAuditSuppressionResponse_description' - The description of the audit suppression.
--
-- 'expirationDate', 'describeAuditSuppressionResponse_expirationDate' - The epoch timestamp in seconds at which this suppression expires.
--
-- 'resourceIdentifier', 'describeAuditSuppressionResponse_resourceIdentifier' - Undocumented member.
--
-- 'suppressIndefinitely', 'describeAuditSuppressionResponse_suppressIndefinitely' - Indicates whether a suppression should exist indefinitely or not.
--
-- 'httpStatus', 'describeAuditSuppressionResponse_httpStatus' - The response's http status code.
newDescribeAuditSuppressionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeAuditSuppressionResponse
newDescribeAuditSuppressionResponse :: Int -> DescribeAuditSuppressionResponse
newDescribeAuditSuppressionResponse Int
pHttpStatus_ =
  DescribeAuditSuppressionResponse'
    { $sel:checkName:DescribeAuditSuppressionResponse' :: Maybe Text
checkName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:DescribeAuditSuppressionResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:expirationDate:DescribeAuditSuppressionResponse' :: Maybe POSIX
expirationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceIdentifier:DescribeAuditSuppressionResponse' :: Maybe ResourceIdentifier
resourceIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:suppressIndefinitely:DescribeAuditSuppressionResponse' :: Maybe Bool
suppressIndefinitely = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeAuditSuppressionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

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

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

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

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