{-# 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.GetConformancePackComplianceSummary
-- 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 the conformance pack based on the
-- cumulative compliance results of all the rules in that conformance pack.
--
-- This operation returns paginated results.
module Amazonka.Config.GetConformancePackComplianceSummary
  ( -- * Creating a Request
    GetConformancePackComplianceSummary (..),
    newGetConformancePackComplianceSummary,

    -- * Request Lenses
    getConformancePackComplianceSummary_limit,
    getConformancePackComplianceSummary_nextToken,
    getConformancePackComplianceSummary_conformancePackNames,

    -- * Destructuring the Response
    GetConformancePackComplianceSummaryResponse (..),
    newGetConformancePackComplianceSummaryResponse,

    -- * Response Lenses
    getConformancePackComplianceSummaryResponse_conformancePackComplianceSummaryList,
    getConformancePackComplianceSummaryResponse_nextToken,
    getConformancePackComplianceSummaryResponse_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:/ 'newGetConformancePackComplianceSummary' smart constructor.
data GetConformancePackComplianceSummary = GetConformancePackComplianceSummary'
  { -- | The maximum number of conformance packs returned on each page.
    GetConformancePackComplianceSummary -> 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.
    GetConformancePackComplianceSummary -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Names of conformance packs.
    GetConformancePackComplianceSummary -> NonEmpty Text
conformancePackNames :: Prelude.NonEmpty Prelude.Text
  }
  deriving (GetConformancePackComplianceSummary
-> GetConformancePackComplianceSummary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetConformancePackComplianceSummary
-> GetConformancePackComplianceSummary -> Bool
$c/= :: GetConformancePackComplianceSummary
-> GetConformancePackComplianceSummary -> Bool
== :: GetConformancePackComplianceSummary
-> GetConformancePackComplianceSummary -> Bool
$c== :: GetConformancePackComplianceSummary
-> GetConformancePackComplianceSummary -> Bool
Prelude.Eq, ReadPrec [GetConformancePackComplianceSummary]
ReadPrec GetConformancePackComplianceSummary
Int -> ReadS GetConformancePackComplianceSummary
ReadS [GetConformancePackComplianceSummary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetConformancePackComplianceSummary]
$creadListPrec :: ReadPrec [GetConformancePackComplianceSummary]
readPrec :: ReadPrec GetConformancePackComplianceSummary
$creadPrec :: ReadPrec GetConformancePackComplianceSummary
readList :: ReadS [GetConformancePackComplianceSummary]
$creadList :: ReadS [GetConformancePackComplianceSummary]
readsPrec :: Int -> ReadS GetConformancePackComplianceSummary
$creadsPrec :: Int -> ReadS GetConformancePackComplianceSummary
Prelude.Read, Int -> GetConformancePackComplianceSummary -> ShowS
[GetConformancePackComplianceSummary] -> ShowS
GetConformancePackComplianceSummary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetConformancePackComplianceSummary] -> ShowS
$cshowList :: [GetConformancePackComplianceSummary] -> ShowS
show :: GetConformancePackComplianceSummary -> String
$cshow :: GetConformancePackComplianceSummary -> String
showsPrec :: Int -> GetConformancePackComplianceSummary -> ShowS
$cshowsPrec :: Int -> GetConformancePackComplianceSummary -> ShowS
Prelude.Show, forall x.
Rep GetConformancePackComplianceSummary x
-> GetConformancePackComplianceSummary
forall x.
GetConformancePackComplianceSummary
-> Rep GetConformancePackComplianceSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetConformancePackComplianceSummary x
-> GetConformancePackComplianceSummary
$cfrom :: forall x.
GetConformancePackComplianceSummary
-> Rep GetConformancePackComplianceSummary x
Prelude.Generic)

-- |
-- Create a value of 'GetConformancePackComplianceSummary' 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:
--
-- 'limit', 'getConformancePackComplianceSummary_limit' - The maximum number of conformance packs returned on each page.
--
-- 'nextToken', 'getConformancePackComplianceSummary_nextToken' - The nextToken string returned on a previous page that you use to get the
-- next page of results in a paginated response.
--
-- 'conformancePackNames', 'getConformancePackComplianceSummary_conformancePackNames' - Names of conformance packs.
newGetConformancePackComplianceSummary ::
  -- | 'conformancePackNames'
  Prelude.NonEmpty Prelude.Text ->
  GetConformancePackComplianceSummary
newGetConformancePackComplianceSummary :: NonEmpty Text -> GetConformancePackComplianceSummary
newGetConformancePackComplianceSummary
  NonEmpty Text
pConformancePackNames_ =
    GetConformancePackComplianceSummary'
      { $sel:limit:GetConformancePackComplianceSummary' :: Maybe Natural
limit =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:GetConformancePackComplianceSummary' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:conformancePackNames:GetConformancePackComplianceSummary' :: NonEmpty Text
conformancePackNames =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced
            forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pConformancePackNames_
      }

-- | The maximum number of conformance packs returned on each page.
getConformancePackComplianceSummary_limit :: Lens.Lens' GetConformancePackComplianceSummary (Prelude.Maybe Prelude.Natural)
getConformancePackComplianceSummary_limit :: Lens' GetConformancePackComplianceSummary (Maybe Natural)
getConformancePackComplianceSummary_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConformancePackComplianceSummary' {Maybe Natural
limit :: Maybe Natural
$sel:limit:GetConformancePackComplianceSummary' :: GetConformancePackComplianceSummary -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: GetConformancePackComplianceSummary
s@GetConformancePackComplianceSummary' {} Maybe Natural
a -> GetConformancePackComplianceSummary
s {$sel:limit:GetConformancePackComplianceSummary' :: Maybe Natural
limit = Maybe Natural
a} :: GetConformancePackComplianceSummary)

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

-- | Names of conformance packs.
getConformancePackComplianceSummary_conformancePackNames :: Lens.Lens' GetConformancePackComplianceSummary (Prelude.NonEmpty Prelude.Text)
getConformancePackComplianceSummary_conformancePackNames :: Lens' GetConformancePackComplianceSummary (NonEmpty Text)
getConformancePackComplianceSummary_conformancePackNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConformancePackComplianceSummary' {NonEmpty Text
conformancePackNames :: NonEmpty Text
$sel:conformancePackNames:GetConformancePackComplianceSummary' :: GetConformancePackComplianceSummary -> NonEmpty Text
conformancePackNames} -> NonEmpty Text
conformancePackNames) (\s :: GetConformancePackComplianceSummary
s@GetConformancePackComplianceSummary' {} NonEmpty Text
a -> GetConformancePackComplianceSummary
s {$sel:conformancePackNames:GetConformancePackComplianceSummary' :: NonEmpty Text
conformancePackNames = NonEmpty Text
a} :: GetConformancePackComplianceSummary) 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
  Core.AWSPager
    GetConformancePackComplianceSummary
  where
  page :: GetConformancePackComplianceSummary
-> AWSResponse GetConformancePackComplianceSummary
-> Maybe GetConformancePackComplianceSummary
page GetConformancePackComplianceSummary
rq AWSResponse GetConformancePackComplianceSummary
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetConformancePackComplianceSummary
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetConformancePackComplianceSummaryResponse (Maybe Text)
getConformancePackComplianceSummaryResponse_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 GetConformancePackComplianceSummary
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  GetConformancePackComplianceSummaryResponse
  (Maybe (NonEmpty ConformancePackComplianceSummary))
getConformancePackComplianceSummaryResponse_conformancePackComplianceSummaryList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall l. IsList l => l -> [Item l]
Prelude.toList
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ GetConformancePackComplianceSummary
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetConformancePackComplianceSummary (Maybe Text)
getConformancePackComplianceSummary_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetConformancePackComplianceSummary
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetConformancePackComplianceSummaryResponse (Maybe Text)
getConformancePackComplianceSummaryResponse_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
    GetConformancePackComplianceSummary
  where
  type
    AWSResponse GetConformancePackComplianceSummary =
      GetConformancePackComplianceSummaryResponse
  request :: (Service -> Service)
-> GetConformancePackComplianceSummary
-> Request GetConformancePackComplianceSummary
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 GetConformancePackComplianceSummary
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetConformancePackComplianceSummary)))
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 (NonEmpty ConformancePackComplianceSummary)
-> Maybe Text -> Int -> GetConformancePackComplianceSummaryResponse
GetConformancePackComplianceSummaryResponse'
            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
"ConformancePackComplianceSummaryList")
            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
    GetConformancePackComplianceSummary
  where
  hashWithSalt :: Int -> GetConformancePackComplianceSummary -> Int
hashWithSalt
    Int
_salt
    GetConformancePackComplianceSummary' {Maybe Natural
Maybe Text
NonEmpty Text
conformancePackNames :: NonEmpty Text
nextToken :: Maybe Text
limit :: Maybe Natural
$sel:conformancePackNames:GetConformancePackComplianceSummary' :: GetConformancePackComplianceSummary -> NonEmpty Text
$sel:nextToken:GetConformancePackComplianceSummary' :: GetConformancePackComplianceSummary -> Maybe Text
$sel:limit:GetConformancePackComplianceSummary' :: GetConformancePackComplianceSummary -> Maybe Natural
..} =
      Int
_salt
        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` NonEmpty Text
conformancePackNames

instance
  Prelude.NFData
    GetConformancePackComplianceSummary
  where
  rnf :: GetConformancePackComplianceSummary -> ()
rnf GetConformancePackComplianceSummary' {Maybe Natural
Maybe Text
NonEmpty Text
conformancePackNames :: NonEmpty Text
nextToken :: Maybe Text
limit :: Maybe Natural
$sel:conformancePackNames:GetConformancePackComplianceSummary' :: GetConformancePackComplianceSummary -> NonEmpty Text
$sel:nextToken:GetConformancePackComplianceSummary' :: GetConformancePackComplianceSummary -> Maybe Text
$sel:limit:GetConformancePackComplianceSummary' :: GetConformancePackComplianceSummary -> Maybe Natural
..} =
    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 NonEmpty Text
conformancePackNames

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

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

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

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

-- |
-- Create a value of 'GetConformancePackComplianceSummaryResponse' 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:
--
-- 'conformancePackComplianceSummaryList', 'getConformancePackComplianceSummaryResponse_conformancePackComplianceSummaryList' - A list of @ConformancePackComplianceSummary@ objects.
--
-- 'nextToken', 'getConformancePackComplianceSummaryResponse_nextToken' - The nextToken string returned on a previous page that you use to get the
-- next page of results in a paginated response.
--
-- 'httpStatus', 'getConformancePackComplianceSummaryResponse_httpStatus' - The response's http status code.
newGetConformancePackComplianceSummaryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetConformancePackComplianceSummaryResponse
newGetConformancePackComplianceSummaryResponse :: Int -> GetConformancePackComplianceSummaryResponse
newGetConformancePackComplianceSummaryResponse
  Int
pHttpStatus_ =
    GetConformancePackComplianceSummaryResponse'
      { $sel:conformancePackComplianceSummaryList:GetConformancePackComplianceSummaryResponse' :: Maybe (NonEmpty ConformancePackComplianceSummary)
conformancePackComplianceSummaryList =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:GetConformancePackComplianceSummaryResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetConformancePackComplianceSummaryResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | A list of @ConformancePackComplianceSummary@ objects.
getConformancePackComplianceSummaryResponse_conformancePackComplianceSummaryList :: Lens.Lens' GetConformancePackComplianceSummaryResponse (Prelude.Maybe (Prelude.NonEmpty ConformancePackComplianceSummary))
getConformancePackComplianceSummaryResponse_conformancePackComplianceSummaryList :: Lens'
  GetConformancePackComplianceSummaryResponse
  (Maybe (NonEmpty ConformancePackComplianceSummary))
getConformancePackComplianceSummaryResponse_conformancePackComplianceSummaryList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConformancePackComplianceSummaryResponse' {Maybe (NonEmpty ConformancePackComplianceSummary)
conformancePackComplianceSummaryList :: Maybe (NonEmpty ConformancePackComplianceSummary)
$sel:conformancePackComplianceSummaryList:GetConformancePackComplianceSummaryResponse' :: GetConformancePackComplianceSummaryResponse
-> Maybe (NonEmpty ConformancePackComplianceSummary)
conformancePackComplianceSummaryList} -> Maybe (NonEmpty ConformancePackComplianceSummary)
conformancePackComplianceSummaryList) (\s :: GetConformancePackComplianceSummaryResponse
s@GetConformancePackComplianceSummaryResponse' {} Maybe (NonEmpty ConformancePackComplianceSummary)
a -> GetConformancePackComplianceSummaryResponse
s {$sel:conformancePackComplianceSummaryList:GetConformancePackComplianceSummaryResponse' :: Maybe (NonEmpty ConformancePackComplianceSummary)
conformancePackComplianceSummaryList = Maybe (NonEmpty ConformancePackComplianceSummary)
a} :: GetConformancePackComplianceSummaryResponse) 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.
getConformancePackComplianceSummaryResponse_nextToken :: Lens.Lens' GetConformancePackComplianceSummaryResponse (Prelude.Maybe Prelude.Text)
getConformancePackComplianceSummaryResponse_nextToken :: Lens' GetConformancePackComplianceSummaryResponse (Maybe Text)
getConformancePackComplianceSummaryResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetConformancePackComplianceSummaryResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetConformancePackComplianceSummaryResponse' :: GetConformancePackComplianceSummaryResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetConformancePackComplianceSummaryResponse
s@GetConformancePackComplianceSummaryResponse' {} Maybe Text
a -> GetConformancePackComplianceSummaryResponse
s {$sel:nextToken:GetConformancePackComplianceSummaryResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetConformancePackComplianceSummaryResponse)

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

instance
  Prelude.NFData
    GetConformancePackComplianceSummaryResponse
  where
  rnf :: GetConformancePackComplianceSummaryResponse -> ()
rnf GetConformancePackComplianceSummaryResponse' {Int
Maybe (NonEmpty ConformancePackComplianceSummary)
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
conformancePackComplianceSummaryList :: Maybe (NonEmpty ConformancePackComplianceSummary)
$sel:httpStatus:GetConformancePackComplianceSummaryResponse' :: GetConformancePackComplianceSummaryResponse -> Int
$sel:nextToken:GetConformancePackComplianceSummaryResponse' :: GetConformancePackComplianceSummaryResponse -> Maybe Text
$sel:conformancePackComplianceSummaryList:GetConformancePackComplianceSummaryResponse' :: GetConformancePackComplianceSummaryResponse
-> Maybe (NonEmpty ConformancePackComplianceSummary)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ConformancePackComplianceSummary)
conformancePackComplianceSummaryList
      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