{-# 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.DescribeConfigRuleEvaluationStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns status information for each of your Config managed rules. The
-- status includes information such as the last time Config invoked the
-- rule, the last time Config failed to invoke the rule, and the related
-- error for the last failure.
--
-- This operation returns paginated results.
module Amazonka.Config.DescribeConfigRuleEvaluationStatus
  ( -- * Creating a Request
    DescribeConfigRuleEvaluationStatus (..),
    newDescribeConfigRuleEvaluationStatus,

    -- * Request Lenses
    describeConfigRuleEvaluationStatus_configRuleNames,
    describeConfigRuleEvaluationStatus_limit,
    describeConfigRuleEvaluationStatus_nextToken,

    -- * Destructuring the Response
    DescribeConfigRuleEvaluationStatusResponse (..),
    newDescribeConfigRuleEvaluationStatusResponse,

    -- * Response Lenses
    describeConfigRuleEvaluationStatusResponse_configRulesEvaluationStatus,
    describeConfigRuleEvaluationStatusResponse_nextToken,
    describeConfigRuleEvaluationStatusResponse_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:/ 'newDescribeConfigRuleEvaluationStatus' smart constructor.
data DescribeConfigRuleEvaluationStatus = DescribeConfigRuleEvaluationStatus'
  { -- | The name of the Config managed rules for which you want status
    -- information. If you do not specify any names, Config returns status
    -- information for all Config managed rules that you use.
    DescribeConfigRuleEvaluationStatus -> Maybe [Text]
configRuleNames :: Prelude.Maybe [Prelude.Text],
    -- | The number of rule evaluation results that you want returned.
    --
    -- This parameter is required if the rule limit for your account is more
    -- than the default of 150 rules.
    --
    -- For information about requesting a rule limit increase, see
    -- <http://docs.aws.amazon.com/general/latest/gr/aws_service_limits.html#limits_config Config Limits>
    -- in the /Amazon Web Services General Reference Guide/.
    DescribeConfigRuleEvaluationStatus -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | The @nextToken@ string returned on a previous page that you use to get
    -- the next page of results in a paginated response.
    DescribeConfigRuleEvaluationStatus -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeConfigRuleEvaluationStatus
-> DescribeConfigRuleEvaluationStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeConfigRuleEvaluationStatus
-> DescribeConfigRuleEvaluationStatus -> Bool
$c/= :: DescribeConfigRuleEvaluationStatus
-> DescribeConfigRuleEvaluationStatus -> Bool
== :: DescribeConfigRuleEvaluationStatus
-> DescribeConfigRuleEvaluationStatus -> Bool
$c== :: DescribeConfigRuleEvaluationStatus
-> DescribeConfigRuleEvaluationStatus -> Bool
Prelude.Eq, ReadPrec [DescribeConfigRuleEvaluationStatus]
ReadPrec DescribeConfigRuleEvaluationStatus
Int -> ReadS DescribeConfigRuleEvaluationStatus
ReadS [DescribeConfigRuleEvaluationStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeConfigRuleEvaluationStatus]
$creadListPrec :: ReadPrec [DescribeConfigRuleEvaluationStatus]
readPrec :: ReadPrec DescribeConfigRuleEvaluationStatus
$creadPrec :: ReadPrec DescribeConfigRuleEvaluationStatus
readList :: ReadS [DescribeConfigRuleEvaluationStatus]
$creadList :: ReadS [DescribeConfigRuleEvaluationStatus]
readsPrec :: Int -> ReadS DescribeConfigRuleEvaluationStatus
$creadsPrec :: Int -> ReadS DescribeConfigRuleEvaluationStatus
Prelude.Read, Int -> DescribeConfigRuleEvaluationStatus -> ShowS
[DescribeConfigRuleEvaluationStatus] -> ShowS
DescribeConfigRuleEvaluationStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeConfigRuleEvaluationStatus] -> ShowS
$cshowList :: [DescribeConfigRuleEvaluationStatus] -> ShowS
show :: DescribeConfigRuleEvaluationStatus -> String
$cshow :: DescribeConfigRuleEvaluationStatus -> String
showsPrec :: Int -> DescribeConfigRuleEvaluationStatus -> ShowS
$cshowsPrec :: Int -> DescribeConfigRuleEvaluationStatus -> ShowS
Prelude.Show, forall x.
Rep DescribeConfigRuleEvaluationStatus x
-> DescribeConfigRuleEvaluationStatus
forall x.
DescribeConfigRuleEvaluationStatus
-> Rep DescribeConfigRuleEvaluationStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeConfigRuleEvaluationStatus x
-> DescribeConfigRuleEvaluationStatus
$cfrom :: forall x.
DescribeConfigRuleEvaluationStatus
-> Rep DescribeConfigRuleEvaluationStatus x
Prelude.Generic)

-- |
-- Create a value of 'DescribeConfigRuleEvaluationStatus' 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:
--
-- 'configRuleNames', 'describeConfigRuleEvaluationStatus_configRuleNames' - The name of the Config managed rules for which you want status
-- information. If you do not specify any names, Config returns status
-- information for all Config managed rules that you use.
--
-- 'limit', 'describeConfigRuleEvaluationStatus_limit' - The number of rule evaluation results that you want returned.
--
-- This parameter is required if the rule limit for your account is more
-- than the default of 150 rules.
--
-- For information about requesting a rule limit increase, see
-- <http://docs.aws.amazon.com/general/latest/gr/aws_service_limits.html#limits_config Config Limits>
-- in the /Amazon Web Services General Reference Guide/.
--
-- 'nextToken', 'describeConfigRuleEvaluationStatus_nextToken' - The @nextToken@ string returned on a previous page that you use to get
-- the next page of results in a paginated response.
newDescribeConfigRuleEvaluationStatus ::
  DescribeConfigRuleEvaluationStatus
newDescribeConfigRuleEvaluationStatus :: DescribeConfigRuleEvaluationStatus
newDescribeConfigRuleEvaluationStatus =
  DescribeConfigRuleEvaluationStatus'
    { $sel:configRuleNames:DescribeConfigRuleEvaluationStatus' :: Maybe [Text]
configRuleNames =
        forall a. Maybe a
Prelude.Nothing,
      $sel:limit:DescribeConfigRuleEvaluationStatus' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeConfigRuleEvaluationStatus' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the Config managed rules for which you want status
-- information. If you do not specify any names, Config returns status
-- information for all Config managed rules that you use.
describeConfigRuleEvaluationStatus_configRuleNames :: Lens.Lens' DescribeConfigRuleEvaluationStatus (Prelude.Maybe [Prelude.Text])
describeConfigRuleEvaluationStatus_configRuleNames :: Lens' DescribeConfigRuleEvaluationStatus (Maybe [Text])
describeConfigRuleEvaluationStatus_configRuleNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigRuleEvaluationStatus' {Maybe [Text]
configRuleNames :: Maybe [Text]
$sel:configRuleNames:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe [Text]
configRuleNames} -> Maybe [Text]
configRuleNames) (\s :: DescribeConfigRuleEvaluationStatus
s@DescribeConfigRuleEvaluationStatus' {} Maybe [Text]
a -> DescribeConfigRuleEvaluationStatus
s {$sel:configRuleNames:DescribeConfigRuleEvaluationStatus' :: Maybe [Text]
configRuleNames = Maybe [Text]
a} :: DescribeConfigRuleEvaluationStatus) 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 number of rule evaluation results that you want returned.
--
-- This parameter is required if the rule limit for your account is more
-- than the default of 150 rules.
--
-- For information about requesting a rule limit increase, see
-- <http://docs.aws.amazon.com/general/latest/gr/aws_service_limits.html#limits_config Config Limits>
-- in the /Amazon Web Services General Reference Guide/.
describeConfigRuleEvaluationStatus_limit :: Lens.Lens' DescribeConfigRuleEvaluationStatus (Prelude.Maybe Prelude.Natural)
describeConfigRuleEvaluationStatus_limit :: Lens' DescribeConfigRuleEvaluationStatus (Maybe Natural)
describeConfigRuleEvaluationStatus_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigRuleEvaluationStatus' {Maybe Natural
limit :: Maybe Natural
$sel:limit:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: DescribeConfigRuleEvaluationStatus
s@DescribeConfigRuleEvaluationStatus' {} Maybe Natural
a -> DescribeConfigRuleEvaluationStatus
s {$sel:limit:DescribeConfigRuleEvaluationStatus' :: Maybe Natural
limit = Maybe Natural
a} :: DescribeConfigRuleEvaluationStatus)

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

instance
  Core.AWSPager
    DescribeConfigRuleEvaluationStatus
  where
  page :: DescribeConfigRuleEvaluationStatus
-> AWSResponse DescribeConfigRuleEvaluationStatus
-> Maybe DescribeConfigRuleEvaluationStatus
page DescribeConfigRuleEvaluationStatus
rq AWSResponse DescribeConfigRuleEvaluationStatus
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeConfigRuleEvaluationStatus
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeConfigRuleEvaluationStatusResponse (Maybe Text)
describeConfigRuleEvaluationStatusResponse_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 DescribeConfigRuleEvaluationStatus
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  DescribeConfigRuleEvaluationStatusResponse
  (Maybe [ConfigRuleEvaluationStatus])
describeConfigRuleEvaluationStatusResponse_configRulesEvaluationStatus
            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.$ DescribeConfigRuleEvaluationStatus
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeConfigRuleEvaluationStatus (Maybe Text)
describeConfigRuleEvaluationStatus_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeConfigRuleEvaluationStatus
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeConfigRuleEvaluationStatusResponse (Maybe Text)
describeConfigRuleEvaluationStatusResponse_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
    DescribeConfigRuleEvaluationStatus
  where
  type
    AWSResponse DescribeConfigRuleEvaluationStatus =
      DescribeConfigRuleEvaluationStatusResponse
  request :: (Service -> Service)
-> DescribeConfigRuleEvaluationStatus
-> Request DescribeConfigRuleEvaluationStatus
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 DescribeConfigRuleEvaluationStatus
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DescribeConfigRuleEvaluationStatus)))
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 [ConfigRuleEvaluationStatus]
-> Maybe Text -> Int -> DescribeConfigRuleEvaluationStatusResponse
DescribeConfigRuleEvaluationStatusResponse'
            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
"ConfigRulesEvaluationStatus"
                            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
    DescribeConfigRuleEvaluationStatus
  where
  hashWithSalt :: Int -> DescribeConfigRuleEvaluationStatus -> Int
hashWithSalt
    Int
_salt
    DescribeConfigRuleEvaluationStatus' {Maybe Natural
Maybe [Text]
Maybe Text
nextToken :: Maybe Text
limit :: Maybe Natural
configRuleNames :: Maybe [Text]
$sel:nextToken:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe Text
$sel:limit:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe Natural
$sel:configRuleNames:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe [Text]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
configRuleNames
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance
  Prelude.NFData
    DescribeConfigRuleEvaluationStatus
  where
  rnf :: DescribeConfigRuleEvaluationStatus -> ()
rnf DescribeConfigRuleEvaluationStatus' {Maybe Natural
Maybe [Text]
Maybe Text
nextToken :: Maybe Text
limit :: Maybe Natural
configRuleNames :: Maybe [Text]
$sel:nextToken:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe Text
$sel:limit:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe Natural
$sel:configRuleNames:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe [Text]
..} =
    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 Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance
  Data.ToHeaders
    DescribeConfigRuleEvaluationStatus
  where
  toHeaders :: DescribeConfigRuleEvaluationStatus -> 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.DescribeConfigRuleEvaluationStatus" ::
                          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
    DescribeConfigRuleEvaluationStatus
  where
  toJSON :: DescribeConfigRuleEvaluationStatus -> Value
toJSON DescribeConfigRuleEvaluationStatus' {Maybe Natural
Maybe [Text]
Maybe Text
nextToken :: Maybe Text
limit :: Maybe Natural
configRuleNames :: Maybe [Text]
$sel:nextToken:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe Text
$sel:limit:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe Natural
$sel:configRuleNames:DescribeConfigRuleEvaluationStatus' :: DescribeConfigRuleEvaluationStatus -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"Limit" 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 Natural
limit,
            (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
    DescribeConfigRuleEvaluationStatus
  where
  toPath :: DescribeConfigRuleEvaluationStatus -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'DescribeConfigRuleEvaluationStatusResponse' 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:
--
-- 'configRulesEvaluationStatus', 'describeConfigRuleEvaluationStatusResponse_configRulesEvaluationStatus' - Status information about your Config managed rules.
--
-- 'nextToken', 'describeConfigRuleEvaluationStatusResponse_nextToken' - The string that you use in a subsequent request to get the next page of
-- results in a paginated response.
--
-- 'httpStatus', 'describeConfigRuleEvaluationStatusResponse_httpStatus' - The response's http status code.
newDescribeConfigRuleEvaluationStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeConfigRuleEvaluationStatusResponse
newDescribeConfigRuleEvaluationStatusResponse :: Int -> DescribeConfigRuleEvaluationStatusResponse
newDescribeConfigRuleEvaluationStatusResponse
  Int
pHttpStatus_ =
    DescribeConfigRuleEvaluationStatusResponse'
      { $sel:configRulesEvaluationStatus:DescribeConfigRuleEvaluationStatusResponse' :: Maybe [ConfigRuleEvaluationStatus]
configRulesEvaluationStatus =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:DescribeConfigRuleEvaluationStatusResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeConfigRuleEvaluationStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Status information about your Config managed rules.
describeConfigRuleEvaluationStatusResponse_configRulesEvaluationStatus :: Lens.Lens' DescribeConfigRuleEvaluationStatusResponse (Prelude.Maybe [ConfigRuleEvaluationStatus])
describeConfigRuleEvaluationStatusResponse_configRulesEvaluationStatus :: Lens'
  DescribeConfigRuleEvaluationStatusResponse
  (Maybe [ConfigRuleEvaluationStatus])
describeConfigRuleEvaluationStatusResponse_configRulesEvaluationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigRuleEvaluationStatusResponse' {Maybe [ConfigRuleEvaluationStatus]
configRulesEvaluationStatus :: Maybe [ConfigRuleEvaluationStatus]
$sel:configRulesEvaluationStatus:DescribeConfigRuleEvaluationStatusResponse' :: DescribeConfigRuleEvaluationStatusResponse
-> Maybe [ConfigRuleEvaluationStatus]
configRulesEvaluationStatus} -> Maybe [ConfigRuleEvaluationStatus]
configRulesEvaluationStatus) (\s :: DescribeConfigRuleEvaluationStatusResponse
s@DescribeConfigRuleEvaluationStatusResponse' {} Maybe [ConfigRuleEvaluationStatus]
a -> DescribeConfigRuleEvaluationStatusResponse
s {$sel:configRulesEvaluationStatus:DescribeConfigRuleEvaluationStatusResponse' :: Maybe [ConfigRuleEvaluationStatus]
configRulesEvaluationStatus = Maybe [ConfigRuleEvaluationStatus]
a} :: DescribeConfigRuleEvaluationStatusResponse) 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.
describeConfigRuleEvaluationStatusResponse_nextToken :: Lens.Lens' DescribeConfigRuleEvaluationStatusResponse (Prelude.Maybe Prelude.Text)
describeConfigRuleEvaluationStatusResponse_nextToken :: Lens' DescribeConfigRuleEvaluationStatusResponse (Maybe Text)
describeConfigRuleEvaluationStatusResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConfigRuleEvaluationStatusResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeConfigRuleEvaluationStatusResponse' :: DescribeConfigRuleEvaluationStatusResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeConfigRuleEvaluationStatusResponse
s@DescribeConfigRuleEvaluationStatusResponse' {} Maybe Text
a -> DescribeConfigRuleEvaluationStatusResponse
s {$sel:nextToken:DescribeConfigRuleEvaluationStatusResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeConfigRuleEvaluationStatusResponse)

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

instance
  Prelude.NFData
    DescribeConfigRuleEvaluationStatusResponse
  where
  rnf :: DescribeConfigRuleEvaluationStatusResponse -> ()
rnf DescribeConfigRuleEvaluationStatusResponse' {Int
Maybe [ConfigRuleEvaluationStatus]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
configRulesEvaluationStatus :: Maybe [ConfigRuleEvaluationStatus]
$sel:httpStatus:DescribeConfigRuleEvaluationStatusResponse' :: DescribeConfigRuleEvaluationStatusResponse -> Int
$sel:nextToken:DescribeConfigRuleEvaluationStatusResponse' :: DescribeConfigRuleEvaluationStatusResponse -> Maybe Text
$sel:configRulesEvaluationStatus:DescribeConfigRuleEvaluationStatusResponse' :: DescribeConfigRuleEvaluationStatusResponse
-> Maybe [ConfigRuleEvaluationStatus]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ConfigRuleEvaluationStatus]
configRulesEvaluationStatus
      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