{-# 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.DescribeConformancePackCompliance
-- 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 compliance details for each rule in that conformance pack.
--
-- You must provide exact rule names.
module Amazonka.Config.DescribeConformancePackCompliance
  ( -- * Creating a Request
    DescribeConformancePackCompliance (..),
    newDescribeConformancePackCompliance,

    -- * Request Lenses
    describeConformancePackCompliance_filters,
    describeConformancePackCompliance_limit,
    describeConformancePackCompliance_nextToken,
    describeConformancePackCompliance_conformancePackName,

    -- * Destructuring the Response
    DescribeConformancePackComplianceResponse (..),
    newDescribeConformancePackComplianceResponse,

    -- * Response Lenses
    describeConformancePackComplianceResponse_nextToken,
    describeConformancePackComplianceResponse_httpStatus,
    describeConformancePackComplianceResponse_conformancePackName,
    describeConformancePackComplianceResponse_conformancePackRuleComplianceList,
  )
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:/ 'newDescribeConformancePackCompliance' smart constructor.
data DescribeConformancePackCompliance = DescribeConformancePackCompliance'
  { -- | A @ConformancePackComplianceFilters@ object.
    DescribeConformancePackCompliance
-> Maybe ConformancePackComplianceFilters
filters :: Prelude.Maybe ConformancePackComplianceFilters,
    -- | The maximum number of Config rules within a conformance pack are
    -- returned on each page.
    DescribeConformancePackCompliance -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | The @nextToken@ string returned in a previous request that you use to
    -- request the next page of results in a paginated response.
    DescribeConformancePackCompliance -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Name of the conformance pack.
    DescribeConformancePackCompliance -> Text
conformancePackName :: Prelude.Text
  }
  deriving (DescribeConformancePackCompliance
-> DescribeConformancePackCompliance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeConformancePackCompliance
-> DescribeConformancePackCompliance -> Bool
$c/= :: DescribeConformancePackCompliance
-> DescribeConformancePackCompliance -> Bool
== :: DescribeConformancePackCompliance
-> DescribeConformancePackCompliance -> Bool
$c== :: DescribeConformancePackCompliance
-> DescribeConformancePackCompliance -> Bool
Prelude.Eq, ReadPrec [DescribeConformancePackCompliance]
ReadPrec DescribeConformancePackCompliance
Int -> ReadS DescribeConformancePackCompliance
ReadS [DescribeConformancePackCompliance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeConformancePackCompliance]
$creadListPrec :: ReadPrec [DescribeConformancePackCompliance]
readPrec :: ReadPrec DescribeConformancePackCompliance
$creadPrec :: ReadPrec DescribeConformancePackCompliance
readList :: ReadS [DescribeConformancePackCompliance]
$creadList :: ReadS [DescribeConformancePackCompliance]
readsPrec :: Int -> ReadS DescribeConformancePackCompliance
$creadsPrec :: Int -> ReadS DescribeConformancePackCompliance
Prelude.Read, Int -> DescribeConformancePackCompliance -> ShowS
[DescribeConformancePackCompliance] -> ShowS
DescribeConformancePackCompliance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeConformancePackCompliance] -> ShowS
$cshowList :: [DescribeConformancePackCompliance] -> ShowS
show :: DescribeConformancePackCompliance -> String
$cshow :: DescribeConformancePackCompliance -> String
showsPrec :: Int -> DescribeConformancePackCompliance -> ShowS
$cshowsPrec :: Int -> DescribeConformancePackCompliance -> ShowS
Prelude.Show, forall x.
Rep DescribeConformancePackCompliance x
-> DescribeConformancePackCompliance
forall x.
DescribeConformancePackCompliance
-> Rep DescribeConformancePackCompliance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeConformancePackCompliance x
-> DescribeConformancePackCompliance
$cfrom :: forall x.
DescribeConformancePackCompliance
-> Rep DescribeConformancePackCompliance x
Prelude.Generic)

-- |
-- Create a value of 'DescribeConformancePackCompliance' 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:
--
-- 'filters', 'describeConformancePackCompliance_filters' - A @ConformancePackComplianceFilters@ object.
--
-- 'limit', 'describeConformancePackCompliance_limit' - The maximum number of Config rules within a conformance pack are
-- returned on each page.
--
-- 'nextToken', 'describeConformancePackCompliance_nextToken' - The @nextToken@ string returned in a previous request that you use to
-- request the next page of results in a paginated response.
--
-- 'conformancePackName', 'describeConformancePackCompliance_conformancePackName' - Name of the conformance pack.
newDescribeConformancePackCompliance ::
  -- | 'conformancePackName'
  Prelude.Text ->
  DescribeConformancePackCompliance
newDescribeConformancePackCompliance :: Text -> DescribeConformancePackCompliance
newDescribeConformancePackCompliance
  Text
pConformancePackName_ =
    DescribeConformancePackCompliance'
      { $sel:filters:DescribeConformancePackCompliance' :: Maybe ConformancePackComplianceFilters
filters =
          forall a. Maybe a
Prelude.Nothing,
        $sel:limit:DescribeConformancePackCompliance' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:DescribeConformancePackCompliance' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:conformancePackName:DescribeConformancePackCompliance' :: Text
conformancePackName =
          Text
pConformancePackName_
      }

-- | A @ConformancePackComplianceFilters@ object.
describeConformancePackCompliance_filters :: Lens.Lens' DescribeConformancePackCompliance (Prelude.Maybe ConformancePackComplianceFilters)
describeConformancePackCompliance_filters :: Lens'
  DescribeConformancePackCompliance
  (Maybe ConformancePackComplianceFilters)
describeConformancePackCompliance_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConformancePackCompliance' {Maybe ConformancePackComplianceFilters
filters :: Maybe ConformancePackComplianceFilters
$sel:filters:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance
-> Maybe ConformancePackComplianceFilters
filters} -> Maybe ConformancePackComplianceFilters
filters) (\s :: DescribeConformancePackCompliance
s@DescribeConformancePackCompliance' {} Maybe ConformancePackComplianceFilters
a -> DescribeConformancePackCompliance
s {$sel:filters:DescribeConformancePackCompliance' :: Maybe ConformancePackComplianceFilters
filters = Maybe ConformancePackComplianceFilters
a} :: DescribeConformancePackCompliance)

-- | The maximum number of Config rules within a conformance pack are
-- returned on each page.
describeConformancePackCompliance_limit :: Lens.Lens' DescribeConformancePackCompliance (Prelude.Maybe Prelude.Natural)
describeConformancePackCompliance_limit :: Lens' DescribeConformancePackCompliance (Maybe Natural)
describeConformancePackCompliance_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConformancePackCompliance' {Maybe Natural
limit :: Maybe Natural
$sel:limit:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: DescribeConformancePackCompliance
s@DescribeConformancePackCompliance' {} Maybe Natural
a -> DescribeConformancePackCompliance
s {$sel:limit:DescribeConformancePackCompliance' :: Maybe Natural
limit = Maybe Natural
a} :: DescribeConformancePackCompliance)

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

-- | Name of the conformance pack.
describeConformancePackCompliance_conformancePackName :: Lens.Lens' DescribeConformancePackCompliance Prelude.Text
describeConformancePackCompliance_conformancePackName :: Lens' DescribeConformancePackCompliance Text
describeConformancePackCompliance_conformancePackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConformancePackCompliance' {Text
conformancePackName :: Text
$sel:conformancePackName:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance -> Text
conformancePackName} -> Text
conformancePackName) (\s :: DescribeConformancePackCompliance
s@DescribeConformancePackCompliance' {} Text
a -> DescribeConformancePackCompliance
s {$sel:conformancePackName:DescribeConformancePackCompliance' :: Text
conformancePackName = Text
a} :: DescribeConformancePackCompliance)

instance
  Core.AWSRequest
    DescribeConformancePackCompliance
  where
  type
    AWSResponse DescribeConformancePackCompliance =
      DescribeConformancePackComplianceResponse
  request :: (Service -> Service)
-> DescribeConformancePackCompliance
-> Request DescribeConformancePackCompliance
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 DescribeConformancePackCompliance
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DescribeConformancePackCompliance)))
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
-> Int
-> Text
-> [ConformancePackRuleCompliance]
-> DescribeConformancePackComplianceResponse
DescribeConformancePackComplianceResponse'
            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
"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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ConformancePackName")
            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
"ConformancePackRuleComplianceList"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance
  Prelude.Hashable
    DescribeConformancePackCompliance
  where
  hashWithSalt :: Int -> DescribeConformancePackCompliance -> Int
hashWithSalt
    Int
_salt
    DescribeConformancePackCompliance' {Maybe Natural
Maybe Text
Maybe ConformancePackComplianceFilters
Text
conformancePackName :: Text
nextToken :: Maybe Text
limit :: Maybe Natural
filters :: Maybe ConformancePackComplianceFilters
$sel:conformancePackName:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance -> Text
$sel:nextToken:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance -> Maybe Text
$sel:limit:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance -> Maybe Natural
$sel:filters:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance
-> Maybe ConformancePackComplianceFilters
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConformancePackComplianceFilters
filters
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
conformancePackName

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

instance
  Data.ToHeaders
    DescribeConformancePackCompliance
  where
  toHeaders :: DescribeConformancePackCompliance -> 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.DescribeConformancePackCompliance" ::
                          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
    DescribeConformancePackCompliance
  where
  toJSON :: DescribeConformancePackCompliance -> Value
toJSON DescribeConformancePackCompliance' {Maybe Natural
Maybe Text
Maybe ConformancePackComplianceFilters
Text
conformancePackName :: Text
nextToken :: Maybe Text
limit :: Maybe Natural
filters :: Maybe ConformancePackComplianceFilters
$sel:conformancePackName:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance -> Text
$sel:nextToken:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance -> Maybe Text
$sel:limit:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance -> Maybe Natural
$sel:filters:DescribeConformancePackCompliance' :: DescribeConformancePackCompliance
-> Maybe ConformancePackComplianceFilters
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Filters" 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 ConformancePackComplianceFilters
filters,
            (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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ConformancePackName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
conformancePackName)
          ]
      )

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

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

-- | /See:/ 'newDescribeConformancePackComplianceResponse' smart constructor.
data DescribeConformancePackComplianceResponse = DescribeConformancePackComplianceResponse'
  { -- | The @nextToken@ string returned in a previous request that you use to
    -- request the next page of results in a paginated response.
    DescribeConformancePackComplianceResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeConformancePackComplianceResponse -> Int
httpStatus :: Prelude.Int,
    -- | Name of the conformance pack.
    DescribeConformancePackComplianceResponse -> Text
conformancePackName :: Prelude.Text,
    -- | Returns a list of @ConformancePackRuleCompliance@ objects.
    DescribeConformancePackComplianceResponse
-> [ConformancePackRuleCompliance]
conformancePackRuleComplianceList :: [ConformancePackRuleCompliance]
  }
  deriving (DescribeConformancePackComplianceResponse
-> DescribeConformancePackComplianceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeConformancePackComplianceResponse
-> DescribeConformancePackComplianceResponse -> Bool
$c/= :: DescribeConformancePackComplianceResponse
-> DescribeConformancePackComplianceResponse -> Bool
== :: DescribeConformancePackComplianceResponse
-> DescribeConformancePackComplianceResponse -> Bool
$c== :: DescribeConformancePackComplianceResponse
-> DescribeConformancePackComplianceResponse -> Bool
Prelude.Eq, ReadPrec [DescribeConformancePackComplianceResponse]
ReadPrec DescribeConformancePackComplianceResponse
Int -> ReadS DescribeConformancePackComplianceResponse
ReadS [DescribeConformancePackComplianceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeConformancePackComplianceResponse]
$creadListPrec :: ReadPrec [DescribeConformancePackComplianceResponse]
readPrec :: ReadPrec DescribeConformancePackComplianceResponse
$creadPrec :: ReadPrec DescribeConformancePackComplianceResponse
readList :: ReadS [DescribeConformancePackComplianceResponse]
$creadList :: ReadS [DescribeConformancePackComplianceResponse]
readsPrec :: Int -> ReadS DescribeConformancePackComplianceResponse
$creadsPrec :: Int -> ReadS DescribeConformancePackComplianceResponse
Prelude.Read, Int -> DescribeConformancePackComplianceResponse -> ShowS
[DescribeConformancePackComplianceResponse] -> ShowS
DescribeConformancePackComplianceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeConformancePackComplianceResponse] -> ShowS
$cshowList :: [DescribeConformancePackComplianceResponse] -> ShowS
show :: DescribeConformancePackComplianceResponse -> String
$cshow :: DescribeConformancePackComplianceResponse -> String
showsPrec :: Int -> DescribeConformancePackComplianceResponse -> ShowS
$cshowsPrec :: Int -> DescribeConformancePackComplianceResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeConformancePackComplianceResponse x
-> DescribeConformancePackComplianceResponse
forall x.
DescribeConformancePackComplianceResponse
-> Rep DescribeConformancePackComplianceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeConformancePackComplianceResponse x
-> DescribeConformancePackComplianceResponse
$cfrom :: forall x.
DescribeConformancePackComplianceResponse
-> Rep DescribeConformancePackComplianceResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeConformancePackComplianceResponse' 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:
--
-- 'nextToken', 'describeConformancePackComplianceResponse_nextToken' - The @nextToken@ string returned in a previous request that you use to
-- request the next page of results in a paginated response.
--
-- 'httpStatus', 'describeConformancePackComplianceResponse_httpStatus' - The response's http status code.
--
-- 'conformancePackName', 'describeConformancePackComplianceResponse_conformancePackName' - Name of the conformance pack.
--
-- 'conformancePackRuleComplianceList', 'describeConformancePackComplianceResponse_conformancePackRuleComplianceList' - Returns a list of @ConformancePackRuleCompliance@ objects.
newDescribeConformancePackComplianceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'conformancePackName'
  Prelude.Text ->
  DescribeConformancePackComplianceResponse
newDescribeConformancePackComplianceResponse :: Int -> Text -> DescribeConformancePackComplianceResponse
newDescribeConformancePackComplianceResponse
  Int
pHttpStatus_
  Text
pConformancePackName_ =
    DescribeConformancePackComplianceResponse'
      { $sel:nextToken:DescribeConformancePackComplianceResponse' :: Maybe Text
nextToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeConformancePackComplianceResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:conformancePackName:DescribeConformancePackComplianceResponse' :: Text
conformancePackName =
          Text
pConformancePackName_,
        $sel:conformancePackRuleComplianceList:DescribeConformancePackComplianceResponse' :: [ConformancePackRuleCompliance]
conformancePackRuleComplianceList =
          forall a. Monoid a => a
Prelude.mempty
      }

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

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

-- | Name of the conformance pack.
describeConformancePackComplianceResponse_conformancePackName :: Lens.Lens' DescribeConformancePackComplianceResponse Prelude.Text
describeConformancePackComplianceResponse_conformancePackName :: Lens' DescribeConformancePackComplianceResponse Text
describeConformancePackComplianceResponse_conformancePackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConformancePackComplianceResponse' {Text
conformancePackName :: Text
$sel:conformancePackName:DescribeConformancePackComplianceResponse' :: DescribeConformancePackComplianceResponse -> Text
conformancePackName} -> Text
conformancePackName) (\s :: DescribeConformancePackComplianceResponse
s@DescribeConformancePackComplianceResponse' {} Text
a -> DescribeConformancePackComplianceResponse
s {$sel:conformancePackName:DescribeConformancePackComplianceResponse' :: Text
conformancePackName = Text
a} :: DescribeConformancePackComplianceResponse)

-- | Returns a list of @ConformancePackRuleCompliance@ objects.
describeConformancePackComplianceResponse_conformancePackRuleComplianceList :: Lens.Lens' DescribeConformancePackComplianceResponse [ConformancePackRuleCompliance]
describeConformancePackComplianceResponse_conformancePackRuleComplianceList :: Lens'
  DescribeConformancePackComplianceResponse
  [ConformancePackRuleCompliance]
describeConformancePackComplianceResponse_conformancePackRuleComplianceList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeConformancePackComplianceResponse' {[ConformancePackRuleCompliance]
conformancePackRuleComplianceList :: [ConformancePackRuleCompliance]
$sel:conformancePackRuleComplianceList:DescribeConformancePackComplianceResponse' :: DescribeConformancePackComplianceResponse
-> [ConformancePackRuleCompliance]
conformancePackRuleComplianceList} -> [ConformancePackRuleCompliance]
conformancePackRuleComplianceList) (\s :: DescribeConformancePackComplianceResponse
s@DescribeConformancePackComplianceResponse' {} [ConformancePackRuleCompliance]
a -> DescribeConformancePackComplianceResponse
s {$sel:conformancePackRuleComplianceList:DescribeConformancePackComplianceResponse' :: [ConformancePackRuleCompliance]
conformancePackRuleComplianceList = [ConformancePackRuleCompliance]
a} :: DescribeConformancePackComplianceResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Prelude.NFData
    DescribeConformancePackComplianceResponse
  where
  rnf :: DescribeConformancePackComplianceResponse -> ()
rnf DescribeConformancePackComplianceResponse' {Int
[ConformancePackRuleCompliance]
Maybe Text
Text
conformancePackRuleComplianceList :: [ConformancePackRuleCompliance]
conformancePackName :: Text
httpStatus :: Int
nextToken :: Maybe Text
$sel:conformancePackRuleComplianceList:DescribeConformancePackComplianceResponse' :: DescribeConformancePackComplianceResponse
-> [ConformancePackRuleCompliance]
$sel:conformancePackName:DescribeConformancePackComplianceResponse' :: DescribeConformancePackComplianceResponse -> Text
$sel:httpStatus:DescribeConformancePackComplianceResponse' :: DescribeConformancePackComplianceResponse -> Int
$sel:nextToken:DescribeConformancePackComplianceResponse' :: DescribeConformancePackComplianceResponse -> Maybe Text
..} =
    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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
conformancePackName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ConformancePackRuleCompliance]
conformancePackRuleComplianceList