{-# 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.Config.DescribeComplianceByConfigRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Indicates whether the specified Config rules are compliant. If a rule is
-- noncompliant, this action returns the number of Amazon Web Services
-- resources that do not comply with the rule.
--
-- A rule is compliant if all of the evaluated resources comply with it. It
-- is noncompliant if any of these resources do not comply.
--
-- If Config has no current evaluation results for the rule, it returns
-- @INSUFFICIENT_DATA@. This result might indicate one of the following
-- conditions:
--
-- -   Config has never invoked an evaluation for the rule. To check
--     whether it has, use the @DescribeConfigRuleEvaluationStatus@ action
--     to get the @LastSuccessfulInvocationTime@ and
--     @LastFailedInvocationTime@.
--
-- -   The rule\'s Lambda function is failing to send evaluation results to
--     Config. Verify that the role you assigned to your configuration
--     recorder includes the @config:PutEvaluations@ permission. If the
--     rule is a custom rule, verify that the Lambda execution role
--     includes the @config:PutEvaluations@ permission.
--
-- -   The rule\'s Lambda function has returned @NOT_APPLICABLE@ for all
--     evaluation results. This can occur if the resources were deleted or
--     removed from the rule\'s scope.
--
-- This operation returns paginated results.
module Amazonka.Config.DescribeComplianceByConfigRule
  ( -- * Creating a Request
    DescribeComplianceByConfigRule (..),
    newDescribeComplianceByConfigRule,

    -- * Request Lenses
    describeComplianceByConfigRule_complianceTypes,
    describeComplianceByConfigRule_configRuleNames,
    describeComplianceByConfigRule_nextToken,

    -- * Destructuring the Response
    DescribeComplianceByConfigRuleResponse (..),
    newDescribeComplianceByConfigRuleResponse,

    -- * Response Lenses
    describeComplianceByConfigRuleResponse_complianceByConfigRules,
    describeComplianceByConfigRuleResponse_nextToken,
    describeComplianceByConfigRuleResponse_httpStatus,
  )
where

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

-- |
--
-- /See:/ 'newDescribeComplianceByConfigRule' smart constructor.
data DescribeComplianceByConfigRule = DescribeComplianceByConfigRule'
  { -- | Filters the results by compliance.
    --
    -- The allowed values are @COMPLIANT@ and @NON_COMPLIANT@.
    DescribeComplianceByConfigRule -> Maybe [ComplianceType]
complianceTypes :: Prelude.Maybe [ComplianceType],
    -- | Specify one or more Config rule names to filter the results by rule.
    DescribeComplianceByConfigRule -> Maybe [Text]
configRuleNames :: Prelude.Maybe [Prelude.Text],
    -- | The @nextToken@ string returned on a previous page that you use to get
    -- the next page of results in a paginated response.
    DescribeComplianceByConfigRule -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeComplianceByConfigRule
-> DescribeComplianceByConfigRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeComplianceByConfigRule
-> DescribeComplianceByConfigRule -> Bool
$c/= :: DescribeComplianceByConfigRule
-> DescribeComplianceByConfigRule -> Bool
== :: DescribeComplianceByConfigRule
-> DescribeComplianceByConfigRule -> Bool
$c== :: DescribeComplianceByConfigRule
-> DescribeComplianceByConfigRule -> Bool
Prelude.Eq, ReadPrec [DescribeComplianceByConfigRule]
ReadPrec DescribeComplianceByConfigRule
Int -> ReadS DescribeComplianceByConfigRule
ReadS [DescribeComplianceByConfigRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeComplianceByConfigRule]
$creadListPrec :: ReadPrec [DescribeComplianceByConfigRule]
readPrec :: ReadPrec DescribeComplianceByConfigRule
$creadPrec :: ReadPrec DescribeComplianceByConfigRule
readList :: ReadS [DescribeComplianceByConfigRule]
$creadList :: ReadS [DescribeComplianceByConfigRule]
readsPrec :: Int -> ReadS DescribeComplianceByConfigRule
$creadsPrec :: Int -> ReadS DescribeComplianceByConfigRule
Prelude.Read, Int -> DescribeComplianceByConfigRule -> ShowS
[DescribeComplianceByConfigRule] -> ShowS
DescribeComplianceByConfigRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeComplianceByConfigRule] -> ShowS
$cshowList :: [DescribeComplianceByConfigRule] -> ShowS
show :: DescribeComplianceByConfigRule -> String
$cshow :: DescribeComplianceByConfigRule -> String
showsPrec :: Int -> DescribeComplianceByConfigRule -> ShowS
$cshowsPrec :: Int -> DescribeComplianceByConfigRule -> ShowS
Prelude.Show, forall x.
Rep DescribeComplianceByConfigRule x
-> DescribeComplianceByConfigRule
forall x.
DescribeComplianceByConfigRule
-> Rep DescribeComplianceByConfigRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeComplianceByConfigRule x
-> DescribeComplianceByConfigRule
$cfrom :: forall x.
DescribeComplianceByConfigRule
-> Rep DescribeComplianceByConfigRule x
Prelude.Generic)

-- |
-- Create a value of 'DescribeComplianceByConfigRule' 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:
--
-- 'complianceTypes', 'describeComplianceByConfigRule_complianceTypes' - Filters the results by compliance.
--
-- The allowed values are @COMPLIANT@ and @NON_COMPLIANT@.
--
-- 'configRuleNames', 'describeComplianceByConfigRule_configRuleNames' - Specify one or more Config rule names to filter the results by rule.
--
-- 'nextToken', 'describeComplianceByConfigRule_nextToken' - The @nextToken@ string returned on a previous page that you use to get
-- the next page of results in a paginated response.
newDescribeComplianceByConfigRule ::
  DescribeComplianceByConfigRule
newDescribeComplianceByConfigRule :: DescribeComplianceByConfigRule
newDescribeComplianceByConfigRule =
  DescribeComplianceByConfigRule'
    { $sel:complianceTypes:DescribeComplianceByConfigRule' :: Maybe [ComplianceType]
complianceTypes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:configRuleNames:DescribeComplianceByConfigRule' :: Maybe [Text]
configRuleNames = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeComplianceByConfigRule' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | Filters the results by compliance.
--
-- The allowed values are @COMPLIANT@ and @NON_COMPLIANT@.
describeComplianceByConfigRule_complianceTypes :: Lens.Lens' DescribeComplianceByConfigRule (Prelude.Maybe [ComplianceType])
describeComplianceByConfigRule_complianceTypes :: Lens' DescribeComplianceByConfigRule (Maybe [ComplianceType])
describeComplianceByConfigRule_complianceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComplianceByConfigRule' {Maybe [ComplianceType]
complianceTypes :: Maybe [ComplianceType]
$sel:complianceTypes:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe [ComplianceType]
complianceTypes} -> Maybe [ComplianceType]
complianceTypes) (\s :: DescribeComplianceByConfigRule
s@DescribeComplianceByConfigRule' {} Maybe [ComplianceType]
a -> DescribeComplianceByConfigRule
s {$sel:complianceTypes:DescribeComplianceByConfigRule' :: Maybe [ComplianceType]
complianceTypes = Maybe [ComplianceType]
a} :: DescribeComplianceByConfigRule) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specify one or more Config rule names to filter the results by rule.
describeComplianceByConfigRule_configRuleNames :: Lens.Lens' DescribeComplianceByConfigRule (Prelude.Maybe [Prelude.Text])
describeComplianceByConfigRule_configRuleNames :: Lens' DescribeComplianceByConfigRule (Maybe [Text])
describeComplianceByConfigRule_configRuleNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComplianceByConfigRule' {Maybe [Text]
configRuleNames :: Maybe [Text]
$sel:configRuleNames:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe [Text]
configRuleNames} -> Maybe [Text]
configRuleNames) (\s :: DescribeComplianceByConfigRule
s@DescribeComplianceByConfigRule' {} Maybe [Text]
a -> DescribeComplianceByConfigRule
s {$sel:configRuleNames:DescribeComplianceByConfigRule' :: Maybe [Text]
configRuleNames = Maybe [Text]
a} :: DescribeComplianceByConfigRule) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The @nextToken@ string returned on a previous page that you use to get
-- the next page of results in a paginated response.
describeComplianceByConfigRule_nextToken :: Lens.Lens' DescribeComplianceByConfigRule (Prelude.Maybe Prelude.Text)
describeComplianceByConfigRule_nextToken :: Lens' DescribeComplianceByConfigRule (Maybe Text)
describeComplianceByConfigRule_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComplianceByConfigRule' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeComplianceByConfigRule
s@DescribeComplianceByConfigRule' {} Maybe Text
a -> DescribeComplianceByConfigRule
s {$sel:nextToken:DescribeComplianceByConfigRule' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeComplianceByConfigRule)

instance Core.AWSPager DescribeComplianceByConfigRule where
  page :: DescribeComplianceByConfigRule
-> AWSResponse DescribeComplianceByConfigRule
-> Maybe DescribeComplianceByConfigRule
page DescribeComplianceByConfigRule
rq AWSResponse DescribeComplianceByConfigRule
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeComplianceByConfigRule
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeComplianceByConfigRuleResponse (Maybe Text)
describeComplianceByConfigRuleResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeComplianceByConfigRule
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  DescribeComplianceByConfigRuleResponse
  (Maybe [ComplianceByConfigRule])
describeComplianceByConfigRuleResponse_complianceByConfigRules
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeComplianceByConfigRule
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeComplianceByConfigRule (Maybe Text)
describeComplianceByConfigRule_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeComplianceByConfigRule
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeComplianceByConfigRuleResponse (Maybe Text)
describeComplianceByConfigRuleResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance
  Core.AWSRequest
    DescribeComplianceByConfigRule
  where
  type
    AWSResponse DescribeComplianceByConfigRule =
      DescribeComplianceByConfigRuleResponse
  request :: (Service -> Service)
-> DescribeComplianceByConfigRule
-> Request DescribeComplianceByConfigRule
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 DescribeComplianceByConfigRule
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DescribeComplianceByConfigRule)))
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 [ComplianceByConfigRule]
-> Maybe Text -> Int -> DescribeComplianceByConfigRuleResponse
DescribeComplianceByConfigRuleResponse'
            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
"ComplianceByConfigRules"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"NextToken")
            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
    DescribeComplianceByConfigRule
  where
  hashWithSalt :: Int -> DescribeComplianceByConfigRule -> Int
hashWithSalt
    Int
_salt
    DescribeComplianceByConfigRule' {Maybe [Text]
Maybe [ComplianceType]
Maybe Text
nextToken :: Maybe Text
configRuleNames :: Maybe [Text]
complianceTypes :: Maybe [ComplianceType]
$sel:nextToken:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe Text
$sel:configRuleNames:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe [Text]
$sel:complianceTypes:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe [ComplianceType]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ComplianceType]
complianceTypes
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
configRuleNames
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance
  Prelude.NFData
    DescribeComplianceByConfigRule
  where
  rnf :: DescribeComplianceByConfigRule -> ()
rnf DescribeComplianceByConfigRule' {Maybe [Text]
Maybe [ComplianceType]
Maybe Text
nextToken :: Maybe Text
configRuleNames :: Maybe [Text]
complianceTypes :: Maybe [ComplianceType]
$sel:nextToken:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe Text
$sel:configRuleNames:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe [Text]
$sel:complianceTypes:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe [ComplianceType]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ComplianceType]
complianceTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
configRuleNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance
  Data.ToHeaders
    DescribeComplianceByConfigRule
  where
  toHeaders :: DescribeComplianceByConfigRule -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"StarlingDoveService.DescribeComplianceByConfigRule" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DescribeComplianceByConfigRule where
  toJSON :: DescribeComplianceByConfigRule -> Value
toJSON DescribeComplianceByConfigRule' {Maybe [Text]
Maybe [ComplianceType]
Maybe Text
nextToken :: Maybe Text
configRuleNames :: Maybe [Text]
complianceTypes :: Maybe [ComplianceType]
$sel:nextToken:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe Text
$sel:configRuleNames:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe [Text]
$sel:complianceTypes:DescribeComplianceByConfigRule' :: DescribeComplianceByConfigRule -> Maybe [ComplianceType]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ComplianceTypes" 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 [ComplianceType]
complianceTypes,
            (Key
"ConfigRuleNames" 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]
configRuleNames,
            (Key
"NextToken" 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
nextToken
          ]
      )

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

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

-- |
--
-- /See:/ 'newDescribeComplianceByConfigRuleResponse' smart constructor.
data DescribeComplianceByConfigRuleResponse = DescribeComplianceByConfigRuleResponse'
  { -- | Indicates whether each of the specified Config rules is compliant.
    DescribeComplianceByConfigRuleResponse
-> Maybe [ComplianceByConfigRule]
complianceByConfigRules :: Prelude.Maybe [ComplianceByConfigRule],
    -- | The string that you use in a subsequent request to get the next page of
    -- results in a paginated response.
    DescribeComplianceByConfigRuleResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeComplianceByConfigRuleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeComplianceByConfigRuleResponse
-> DescribeComplianceByConfigRuleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeComplianceByConfigRuleResponse
-> DescribeComplianceByConfigRuleResponse -> Bool
$c/= :: DescribeComplianceByConfigRuleResponse
-> DescribeComplianceByConfigRuleResponse -> Bool
== :: DescribeComplianceByConfigRuleResponse
-> DescribeComplianceByConfigRuleResponse -> Bool
$c== :: DescribeComplianceByConfigRuleResponse
-> DescribeComplianceByConfigRuleResponse -> Bool
Prelude.Eq, ReadPrec [DescribeComplianceByConfigRuleResponse]
ReadPrec DescribeComplianceByConfigRuleResponse
Int -> ReadS DescribeComplianceByConfigRuleResponse
ReadS [DescribeComplianceByConfigRuleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeComplianceByConfigRuleResponse]
$creadListPrec :: ReadPrec [DescribeComplianceByConfigRuleResponse]
readPrec :: ReadPrec DescribeComplianceByConfigRuleResponse
$creadPrec :: ReadPrec DescribeComplianceByConfigRuleResponse
readList :: ReadS [DescribeComplianceByConfigRuleResponse]
$creadList :: ReadS [DescribeComplianceByConfigRuleResponse]
readsPrec :: Int -> ReadS DescribeComplianceByConfigRuleResponse
$creadsPrec :: Int -> ReadS DescribeComplianceByConfigRuleResponse
Prelude.Read, Int -> DescribeComplianceByConfigRuleResponse -> ShowS
[DescribeComplianceByConfigRuleResponse] -> ShowS
DescribeComplianceByConfigRuleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeComplianceByConfigRuleResponse] -> ShowS
$cshowList :: [DescribeComplianceByConfigRuleResponse] -> ShowS
show :: DescribeComplianceByConfigRuleResponse -> String
$cshow :: DescribeComplianceByConfigRuleResponse -> String
showsPrec :: Int -> DescribeComplianceByConfigRuleResponse -> ShowS
$cshowsPrec :: Int -> DescribeComplianceByConfigRuleResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeComplianceByConfigRuleResponse x
-> DescribeComplianceByConfigRuleResponse
forall x.
DescribeComplianceByConfigRuleResponse
-> Rep DescribeComplianceByConfigRuleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeComplianceByConfigRuleResponse x
-> DescribeComplianceByConfigRuleResponse
$cfrom :: forall x.
DescribeComplianceByConfigRuleResponse
-> Rep DescribeComplianceByConfigRuleResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeComplianceByConfigRuleResponse' 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:
--
-- 'complianceByConfigRules', 'describeComplianceByConfigRuleResponse_complianceByConfigRules' - Indicates whether each of the specified Config rules is compliant.
--
-- 'nextToken', 'describeComplianceByConfigRuleResponse_nextToken' - The string that you use in a subsequent request to get the next page of
-- results in a paginated response.
--
-- 'httpStatus', 'describeComplianceByConfigRuleResponse_httpStatus' - The response's http status code.
newDescribeComplianceByConfigRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeComplianceByConfigRuleResponse
newDescribeComplianceByConfigRuleResponse :: Int -> DescribeComplianceByConfigRuleResponse
newDescribeComplianceByConfigRuleResponse
  Int
pHttpStatus_ =
    DescribeComplianceByConfigRuleResponse'
      { $sel:complianceByConfigRules:DescribeComplianceByConfigRuleResponse' :: Maybe [ComplianceByConfigRule]
complianceByConfigRules =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:DescribeComplianceByConfigRuleResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeComplianceByConfigRuleResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Indicates whether each of the specified Config rules is compliant.
describeComplianceByConfigRuleResponse_complianceByConfigRules :: Lens.Lens' DescribeComplianceByConfigRuleResponse (Prelude.Maybe [ComplianceByConfigRule])
describeComplianceByConfigRuleResponse_complianceByConfigRules :: Lens'
  DescribeComplianceByConfigRuleResponse
  (Maybe [ComplianceByConfigRule])
describeComplianceByConfigRuleResponse_complianceByConfigRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComplianceByConfigRuleResponse' {Maybe [ComplianceByConfigRule]
complianceByConfigRules :: Maybe [ComplianceByConfigRule]
$sel:complianceByConfigRules:DescribeComplianceByConfigRuleResponse' :: DescribeComplianceByConfigRuleResponse
-> Maybe [ComplianceByConfigRule]
complianceByConfigRules} -> Maybe [ComplianceByConfigRule]
complianceByConfigRules) (\s :: DescribeComplianceByConfigRuleResponse
s@DescribeComplianceByConfigRuleResponse' {} Maybe [ComplianceByConfigRule]
a -> DescribeComplianceByConfigRuleResponse
s {$sel:complianceByConfigRules:DescribeComplianceByConfigRuleResponse' :: Maybe [ComplianceByConfigRule]
complianceByConfigRules = Maybe [ComplianceByConfigRule]
a} :: DescribeComplianceByConfigRuleResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The string that you use in a subsequent request to get the next page of
-- results in a paginated response.
describeComplianceByConfigRuleResponse_nextToken :: Lens.Lens' DescribeComplianceByConfigRuleResponse (Prelude.Maybe Prelude.Text)
describeComplianceByConfigRuleResponse_nextToken :: Lens' DescribeComplianceByConfigRuleResponse (Maybe Text)
describeComplianceByConfigRuleResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComplianceByConfigRuleResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeComplianceByConfigRuleResponse' :: DescribeComplianceByConfigRuleResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeComplianceByConfigRuleResponse
s@DescribeComplianceByConfigRuleResponse' {} Maybe Text
a -> DescribeComplianceByConfigRuleResponse
s {$sel:nextToken:DescribeComplianceByConfigRuleResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeComplianceByConfigRuleResponse)

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

instance
  Prelude.NFData
    DescribeComplianceByConfigRuleResponse
  where
  rnf :: DescribeComplianceByConfigRuleResponse -> ()
rnf DescribeComplianceByConfigRuleResponse' {Int
Maybe [ComplianceByConfigRule]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
complianceByConfigRules :: Maybe [ComplianceByConfigRule]
$sel:httpStatus:DescribeComplianceByConfigRuleResponse' :: DescribeComplianceByConfigRuleResponse -> Int
$sel:nextToken:DescribeComplianceByConfigRuleResponse' :: DescribeComplianceByConfigRuleResponse -> Maybe Text
$sel:complianceByConfigRules:DescribeComplianceByConfigRuleResponse' :: DescribeComplianceByConfigRuleResponse
-> Maybe [ComplianceByConfigRule]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ComplianceByConfigRule]
complianceByConfigRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus