{-# 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.ResourceGroupsTagging.GetComplianceSummary
-- 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 a table that shows counts of resources that are noncompliant
-- with their tag policies.
--
-- For more information on tag policies, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_tag-policies.html Tag Policies>
-- in the /Organizations User Guide./
--
-- You can call this operation only from the organization\'s management
-- account and from the us-east-1 Region.
--
-- This operation supports pagination, where the response can be sent in
-- multiple pages. You should check the @PaginationToken@ response
-- parameter to determine if there are additional results available to
-- return. Repeat the query, passing the @PaginationToken@ response
-- parameter value as an input to the next request until you recieve a
-- @null@ value. A null value for @PaginationToken@ indicates that there
-- are no more results waiting to be returned.
--
-- This operation returns paginated results.
module Amazonka.ResourceGroupsTagging.GetComplianceSummary
  ( -- * Creating a Request
    GetComplianceSummary (..),
    newGetComplianceSummary,

    -- * Request Lenses
    getComplianceSummary_groupBy,
    getComplianceSummary_maxResults,
    getComplianceSummary_paginationToken,
    getComplianceSummary_regionFilters,
    getComplianceSummary_resourceTypeFilters,
    getComplianceSummary_tagKeyFilters,
    getComplianceSummary_targetIdFilters,

    -- * Destructuring the Response
    GetComplianceSummaryResponse (..),
    newGetComplianceSummaryResponse,

    -- * Response Lenses
    getComplianceSummaryResponse_paginationToken,
    getComplianceSummaryResponse_summaryList,
    getComplianceSummaryResponse_httpStatus,
  )
where

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 Amazonka.ResourceGroupsTagging.Types
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetComplianceSummary' smart constructor.
data GetComplianceSummary = GetComplianceSummary'
  { -- | Specifies a list of attributes to group the counts of noncompliant
    -- resources by. If supplied, the counts are sorted by those attributes.
    GetComplianceSummary -> Maybe [GroupByAttribute]
groupBy :: Prelude.Maybe [GroupByAttribute],
    -- | Specifies the maximum number of results to be returned in each page. A
    -- query can return fewer than this maximum, even if there are more results
    -- still to return. You should always check the @PaginationToken@ response
    -- value to see if there are more results. You can specify a minimum of 1
    -- and a maximum value of 100.
    GetComplianceSummary -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Specifies a @PaginationToken@ response value from a previous request to
    -- indicate that you want the next page of results. Leave this parameter
    -- empty in your initial request.
    GetComplianceSummary -> Maybe Text
paginationToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies a list of Amazon Web Services Regions to limit the output to.
    -- If you use this parameter, the count of returned noncompliant resources
    -- includes only resources in the specified Regions.
    GetComplianceSummary -> Maybe (NonEmpty Text)
regionFilters :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | Specifies that you want the response to include information for only
    -- resources of the specified types. The format of each resource type is
    -- @service[:resourceType]@. For example, specifying a resource type of
    -- @ec2@ returns all Amazon EC2 resources (which includes EC2 instances).
    -- Specifying a resource type of @ec2:instance@ returns only EC2 instances.
    --
    -- The string for each service name and resource type is the same as that
    -- embedded in a resource\'s Amazon Resource Name (ARN). Consult the
    -- /<https://docs.aws.amazon.com/general/latest/gr/ Amazon Web Services General Reference>/
    -- for the following:
    --
    -- -   For a list of service name strings, see
    --     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#genref-aws-service-namespaces Amazon Web Services Service Namespaces>.
    --
    -- -   For resource type strings, see
    --     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#arns-syntax Example ARNs>.
    --
    -- -   For more information about ARNs, see
    --     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
    --
    -- You can specify multiple resource types by using a comma separated
    -- array. The array can include up to 100 items. Note that the length
    -- constraint requirement applies to each resource type filter.
    GetComplianceSummary -> Maybe [Text]
resourceTypeFilters :: Prelude.Maybe [Prelude.Text],
    -- | Specifies that you want the response to include information for only
    -- resources that have tags with the specified tag keys. If you use this
    -- parameter, the count of returned noncompliant resources includes only
    -- resources that have the specified tag keys.
    GetComplianceSummary -> Maybe (NonEmpty Text)
tagKeyFilters :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | Specifies target identifiers (usually, specific account IDs) to limit
    -- the output by. If you use this parameter, the count of returned
    -- noncompliant resources includes only resources with the specified target
    -- IDs.
    GetComplianceSummary -> Maybe (NonEmpty Text)
targetIdFilters :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text)
  }
  deriving (GetComplianceSummary -> GetComplianceSummary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetComplianceSummary -> GetComplianceSummary -> Bool
$c/= :: GetComplianceSummary -> GetComplianceSummary -> Bool
== :: GetComplianceSummary -> GetComplianceSummary -> Bool
$c== :: GetComplianceSummary -> GetComplianceSummary -> Bool
Prelude.Eq, ReadPrec [GetComplianceSummary]
ReadPrec GetComplianceSummary
Int -> ReadS GetComplianceSummary
ReadS [GetComplianceSummary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetComplianceSummary]
$creadListPrec :: ReadPrec [GetComplianceSummary]
readPrec :: ReadPrec GetComplianceSummary
$creadPrec :: ReadPrec GetComplianceSummary
readList :: ReadS [GetComplianceSummary]
$creadList :: ReadS [GetComplianceSummary]
readsPrec :: Int -> ReadS GetComplianceSummary
$creadsPrec :: Int -> ReadS GetComplianceSummary
Prelude.Read, Int -> GetComplianceSummary -> ShowS
[GetComplianceSummary] -> ShowS
GetComplianceSummary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetComplianceSummary] -> ShowS
$cshowList :: [GetComplianceSummary] -> ShowS
show :: GetComplianceSummary -> String
$cshow :: GetComplianceSummary -> String
showsPrec :: Int -> GetComplianceSummary -> ShowS
$cshowsPrec :: Int -> GetComplianceSummary -> ShowS
Prelude.Show, forall x. Rep GetComplianceSummary x -> GetComplianceSummary
forall x. GetComplianceSummary -> Rep GetComplianceSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetComplianceSummary x -> GetComplianceSummary
$cfrom :: forall x. GetComplianceSummary -> Rep GetComplianceSummary x
Prelude.Generic)

-- |
-- Create a value of 'GetComplianceSummary' 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:
--
-- 'groupBy', 'getComplianceSummary_groupBy' - Specifies a list of attributes to group the counts of noncompliant
-- resources by. If supplied, the counts are sorted by those attributes.
--
-- 'maxResults', 'getComplianceSummary_maxResults' - Specifies the maximum number of results to be returned in each page. A
-- query can return fewer than this maximum, even if there are more results
-- still to return. You should always check the @PaginationToken@ response
-- value to see if there are more results. You can specify a minimum of 1
-- and a maximum value of 100.
--
-- 'paginationToken', 'getComplianceSummary_paginationToken' - Specifies a @PaginationToken@ response value from a previous request to
-- indicate that you want the next page of results. Leave this parameter
-- empty in your initial request.
--
-- 'regionFilters', 'getComplianceSummary_regionFilters' - Specifies a list of Amazon Web Services Regions to limit the output to.
-- If you use this parameter, the count of returned noncompliant resources
-- includes only resources in the specified Regions.
--
-- 'resourceTypeFilters', 'getComplianceSummary_resourceTypeFilters' - Specifies that you want the response to include information for only
-- resources of the specified types. The format of each resource type is
-- @service[:resourceType]@. For example, specifying a resource type of
-- @ec2@ returns all Amazon EC2 resources (which includes EC2 instances).
-- Specifying a resource type of @ec2:instance@ returns only EC2 instances.
--
-- The string for each service name and resource type is the same as that
-- embedded in a resource\'s Amazon Resource Name (ARN). Consult the
-- /<https://docs.aws.amazon.com/general/latest/gr/ Amazon Web Services General Reference>/
-- for the following:
--
-- -   For a list of service name strings, see
--     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#genref-aws-service-namespaces Amazon Web Services Service Namespaces>.
--
-- -   For resource type strings, see
--     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#arns-syntax Example ARNs>.
--
-- -   For more information about ARNs, see
--     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
--
-- You can specify multiple resource types by using a comma separated
-- array. The array can include up to 100 items. Note that the length
-- constraint requirement applies to each resource type filter.
--
-- 'tagKeyFilters', 'getComplianceSummary_tagKeyFilters' - Specifies that you want the response to include information for only
-- resources that have tags with the specified tag keys. If you use this
-- parameter, the count of returned noncompliant resources includes only
-- resources that have the specified tag keys.
--
-- 'targetIdFilters', 'getComplianceSummary_targetIdFilters' - Specifies target identifiers (usually, specific account IDs) to limit
-- the output by. If you use this parameter, the count of returned
-- noncompliant resources includes only resources with the specified target
-- IDs.
newGetComplianceSummary ::
  GetComplianceSummary
newGetComplianceSummary :: GetComplianceSummary
newGetComplianceSummary =
  GetComplianceSummary'
    { $sel:groupBy:GetComplianceSummary' :: Maybe [GroupByAttribute]
groupBy = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetComplianceSummary' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:paginationToken:GetComplianceSummary' :: Maybe Text
paginationToken = forall a. Maybe a
Prelude.Nothing,
      $sel:regionFilters:GetComplianceSummary' :: Maybe (NonEmpty Text)
regionFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceTypeFilters:GetComplianceSummary' :: Maybe [Text]
resourceTypeFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:tagKeyFilters:GetComplianceSummary' :: Maybe (NonEmpty Text)
tagKeyFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:targetIdFilters:GetComplianceSummary' :: Maybe (NonEmpty Text)
targetIdFilters = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies a list of attributes to group the counts of noncompliant
-- resources by. If supplied, the counts are sorted by those attributes.
getComplianceSummary_groupBy :: Lens.Lens' GetComplianceSummary (Prelude.Maybe [GroupByAttribute])
getComplianceSummary_groupBy :: Lens' GetComplianceSummary (Maybe [GroupByAttribute])
getComplianceSummary_groupBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComplianceSummary' {Maybe [GroupByAttribute]
groupBy :: Maybe [GroupByAttribute]
$sel:groupBy:GetComplianceSummary' :: GetComplianceSummary -> Maybe [GroupByAttribute]
groupBy} -> Maybe [GroupByAttribute]
groupBy) (\s :: GetComplianceSummary
s@GetComplianceSummary' {} Maybe [GroupByAttribute]
a -> GetComplianceSummary
s {$sel:groupBy:GetComplianceSummary' :: Maybe [GroupByAttribute]
groupBy = Maybe [GroupByAttribute]
a} :: GetComplianceSummary) 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

-- | Specifies the maximum number of results to be returned in each page. A
-- query can return fewer than this maximum, even if there are more results
-- still to return. You should always check the @PaginationToken@ response
-- value to see if there are more results. You can specify a minimum of 1
-- and a maximum value of 100.
getComplianceSummary_maxResults :: Lens.Lens' GetComplianceSummary (Prelude.Maybe Prelude.Natural)
getComplianceSummary_maxResults :: Lens' GetComplianceSummary (Maybe Natural)
getComplianceSummary_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComplianceSummary' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetComplianceSummary' :: GetComplianceSummary -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetComplianceSummary
s@GetComplianceSummary' {} Maybe Natural
a -> GetComplianceSummary
s {$sel:maxResults:GetComplianceSummary' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetComplianceSummary)

-- | Specifies a @PaginationToken@ response value from a previous request to
-- indicate that you want the next page of results. Leave this parameter
-- empty in your initial request.
getComplianceSummary_paginationToken :: Lens.Lens' GetComplianceSummary (Prelude.Maybe Prelude.Text)
getComplianceSummary_paginationToken :: Lens' GetComplianceSummary (Maybe Text)
getComplianceSummary_paginationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComplianceSummary' {Maybe Text
paginationToken :: Maybe Text
$sel:paginationToken:GetComplianceSummary' :: GetComplianceSummary -> Maybe Text
paginationToken} -> Maybe Text
paginationToken) (\s :: GetComplianceSummary
s@GetComplianceSummary' {} Maybe Text
a -> GetComplianceSummary
s {$sel:paginationToken:GetComplianceSummary' :: Maybe Text
paginationToken = Maybe Text
a} :: GetComplianceSummary)

-- | Specifies a list of Amazon Web Services Regions to limit the output to.
-- If you use this parameter, the count of returned noncompliant resources
-- includes only resources in the specified Regions.
getComplianceSummary_regionFilters :: Lens.Lens' GetComplianceSummary (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
getComplianceSummary_regionFilters :: Lens' GetComplianceSummary (Maybe (NonEmpty Text))
getComplianceSummary_regionFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComplianceSummary' {Maybe (NonEmpty Text)
regionFilters :: Maybe (NonEmpty Text)
$sel:regionFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
regionFilters} -> Maybe (NonEmpty Text)
regionFilters) (\s :: GetComplianceSummary
s@GetComplianceSummary' {} Maybe (NonEmpty Text)
a -> GetComplianceSummary
s {$sel:regionFilters:GetComplianceSummary' :: Maybe (NonEmpty Text)
regionFilters = Maybe (NonEmpty Text)
a} :: GetComplianceSummary) 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

-- | Specifies that you want the response to include information for only
-- resources of the specified types. The format of each resource type is
-- @service[:resourceType]@. For example, specifying a resource type of
-- @ec2@ returns all Amazon EC2 resources (which includes EC2 instances).
-- Specifying a resource type of @ec2:instance@ returns only EC2 instances.
--
-- The string for each service name and resource type is the same as that
-- embedded in a resource\'s Amazon Resource Name (ARN). Consult the
-- /<https://docs.aws.amazon.com/general/latest/gr/ Amazon Web Services General Reference>/
-- for the following:
--
-- -   For a list of service name strings, see
--     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#genref-aws-service-namespaces Amazon Web Services Service Namespaces>.
--
-- -   For resource type strings, see
--     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html#arns-syntax Example ARNs>.
--
-- -   For more information about ARNs, see
--     <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs) and Amazon Web Services Service Namespaces>.
--
-- You can specify multiple resource types by using a comma separated
-- array. The array can include up to 100 items. Note that the length
-- constraint requirement applies to each resource type filter.
getComplianceSummary_resourceTypeFilters :: Lens.Lens' GetComplianceSummary (Prelude.Maybe [Prelude.Text])
getComplianceSummary_resourceTypeFilters :: Lens' GetComplianceSummary (Maybe [Text])
getComplianceSummary_resourceTypeFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComplianceSummary' {Maybe [Text]
resourceTypeFilters :: Maybe [Text]
$sel:resourceTypeFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe [Text]
resourceTypeFilters} -> Maybe [Text]
resourceTypeFilters) (\s :: GetComplianceSummary
s@GetComplianceSummary' {} Maybe [Text]
a -> GetComplianceSummary
s {$sel:resourceTypeFilters:GetComplianceSummary' :: Maybe [Text]
resourceTypeFilters = Maybe [Text]
a} :: GetComplianceSummary) 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

-- | Specifies that you want the response to include information for only
-- resources that have tags with the specified tag keys. If you use this
-- parameter, the count of returned noncompliant resources includes only
-- resources that have the specified tag keys.
getComplianceSummary_tagKeyFilters :: Lens.Lens' GetComplianceSummary (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
getComplianceSummary_tagKeyFilters :: Lens' GetComplianceSummary (Maybe (NonEmpty Text))
getComplianceSummary_tagKeyFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComplianceSummary' {Maybe (NonEmpty Text)
tagKeyFilters :: Maybe (NonEmpty Text)
$sel:tagKeyFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
tagKeyFilters} -> Maybe (NonEmpty Text)
tagKeyFilters) (\s :: GetComplianceSummary
s@GetComplianceSummary' {} Maybe (NonEmpty Text)
a -> GetComplianceSummary
s {$sel:tagKeyFilters:GetComplianceSummary' :: Maybe (NonEmpty Text)
tagKeyFilters = Maybe (NonEmpty Text)
a} :: GetComplianceSummary) 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

-- | Specifies target identifiers (usually, specific account IDs) to limit
-- the output by. If you use this parameter, the count of returned
-- noncompliant resources includes only resources with the specified target
-- IDs.
getComplianceSummary_targetIdFilters :: Lens.Lens' GetComplianceSummary (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
getComplianceSummary_targetIdFilters :: Lens' GetComplianceSummary (Maybe (NonEmpty Text))
getComplianceSummary_targetIdFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComplianceSummary' {Maybe (NonEmpty Text)
targetIdFilters :: Maybe (NonEmpty Text)
$sel:targetIdFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
targetIdFilters} -> Maybe (NonEmpty Text)
targetIdFilters) (\s :: GetComplianceSummary
s@GetComplianceSummary' {} Maybe (NonEmpty Text)
a -> GetComplianceSummary
s {$sel:targetIdFilters:GetComplianceSummary' :: Maybe (NonEmpty Text)
targetIdFilters = Maybe (NonEmpty Text)
a} :: GetComplianceSummary) 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

instance Core.AWSPager GetComplianceSummary where
  page :: GetComplianceSummary
-> AWSResponse GetComplianceSummary -> Maybe GetComplianceSummary
page GetComplianceSummary
rq AWSResponse GetComplianceSummary
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetComplianceSummary
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetComplianceSummaryResponse (Maybe Text)
getComplianceSummaryResponse_paginationToken
            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 GetComplianceSummary
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetComplianceSummaryResponse (Maybe [Summary])
getComplianceSummaryResponse_summaryList
            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.$ GetComplianceSummary
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetComplianceSummary (Maybe Text)
getComplianceSummary_paginationToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetComplianceSummary
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetComplianceSummaryResponse (Maybe Text)
getComplianceSummaryResponse_paginationToken
          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 GetComplianceSummary where
  type
    AWSResponse GetComplianceSummary =
      GetComplianceSummaryResponse
  request :: (Service -> Service)
-> GetComplianceSummary -> Request GetComplianceSummary
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 GetComplianceSummary
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetComplianceSummary)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe [Summary] -> Int -> GetComplianceSummaryResponse
GetComplianceSummaryResponse'
            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
"PaginationToken")
            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
"SummaryList" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetComplianceSummary where
  hashWithSalt :: Int -> GetComplianceSummary -> Int
hashWithSalt Int
_salt GetComplianceSummary' {Maybe Natural
Maybe [Text]
Maybe [GroupByAttribute]
Maybe (NonEmpty Text)
Maybe Text
targetIdFilters :: Maybe (NonEmpty Text)
tagKeyFilters :: Maybe (NonEmpty Text)
resourceTypeFilters :: Maybe [Text]
regionFilters :: Maybe (NonEmpty Text)
paginationToken :: Maybe Text
maxResults :: Maybe Natural
groupBy :: Maybe [GroupByAttribute]
$sel:targetIdFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
$sel:tagKeyFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
$sel:resourceTypeFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe [Text]
$sel:regionFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
$sel:paginationToken:GetComplianceSummary' :: GetComplianceSummary -> Maybe Text
$sel:maxResults:GetComplianceSummary' :: GetComplianceSummary -> Maybe Natural
$sel:groupBy:GetComplianceSummary' :: GetComplianceSummary -> Maybe [GroupByAttribute]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [GroupByAttribute]
groupBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
paginationToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
regionFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
resourceTypeFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
tagKeyFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
targetIdFilters

instance Prelude.NFData GetComplianceSummary where
  rnf :: GetComplianceSummary -> ()
rnf GetComplianceSummary' {Maybe Natural
Maybe [Text]
Maybe [GroupByAttribute]
Maybe (NonEmpty Text)
Maybe Text
targetIdFilters :: Maybe (NonEmpty Text)
tagKeyFilters :: Maybe (NonEmpty Text)
resourceTypeFilters :: Maybe [Text]
regionFilters :: Maybe (NonEmpty Text)
paginationToken :: Maybe Text
maxResults :: Maybe Natural
groupBy :: Maybe [GroupByAttribute]
$sel:targetIdFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
$sel:tagKeyFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
$sel:resourceTypeFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe [Text]
$sel:regionFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
$sel:paginationToken:GetComplianceSummary' :: GetComplianceSummary -> Maybe Text
$sel:maxResults:GetComplianceSummary' :: GetComplianceSummary -> Maybe Natural
$sel:groupBy:GetComplianceSummary' :: GetComplianceSummary -> Maybe [GroupByAttribute]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [GroupByAttribute]
groupBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
paginationToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
regionFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
resourceTypeFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
tagKeyFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
targetIdFilters

instance Data.ToHeaders GetComplianceSummary where
  toHeaders :: GetComplianceSummary -> 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
"ResourceGroupsTaggingAPI_20170126.GetComplianceSummary" ::
                          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 GetComplianceSummary where
  toJSON :: GetComplianceSummary -> Value
toJSON GetComplianceSummary' {Maybe Natural
Maybe [Text]
Maybe [GroupByAttribute]
Maybe (NonEmpty Text)
Maybe Text
targetIdFilters :: Maybe (NonEmpty Text)
tagKeyFilters :: Maybe (NonEmpty Text)
resourceTypeFilters :: Maybe [Text]
regionFilters :: Maybe (NonEmpty Text)
paginationToken :: Maybe Text
maxResults :: Maybe Natural
groupBy :: Maybe [GroupByAttribute]
$sel:targetIdFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
$sel:tagKeyFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
$sel:resourceTypeFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe [Text]
$sel:regionFilters:GetComplianceSummary' :: GetComplianceSummary -> Maybe (NonEmpty Text)
$sel:paginationToken:GetComplianceSummary' :: GetComplianceSummary -> Maybe Text
$sel:maxResults:GetComplianceSummary' :: GetComplianceSummary -> Maybe Natural
$sel:groupBy:GetComplianceSummary' :: GetComplianceSummary -> Maybe [GroupByAttribute]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"GroupBy" 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 [GroupByAttribute]
groupBy,
            (Key
"MaxResults" 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
maxResults,
            (Key
"PaginationToken" 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
paginationToken,
            (Key
"RegionFilters" 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 (NonEmpty Text)
regionFilters,
            (Key
"ResourceTypeFilters" 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]
resourceTypeFilters,
            (Key
"TagKeyFilters" 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 (NonEmpty Text)
tagKeyFilters,
            (Key
"TargetIdFilters" 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 (NonEmpty Text)
targetIdFilters
          ]
      )

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

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

-- | /See:/ 'newGetComplianceSummaryResponse' smart constructor.
data GetComplianceSummaryResponse = GetComplianceSummaryResponse'
  { -- | A string that indicates that there is more data available than this
    -- response contains. To receive the next part of the response, specify
    -- this response value as the @PaginationToken@ value in the request for
    -- the next page.
    GetComplianceSummaryResponse -> Maybe Text
paginationToken :: Prelude.Maybe Prelude.Text,
    -- | A table that shows counts of noncompliant resources.
    GetComplianceSummaryResponse -> Maybe [Summary]
summaryList :: Prelude.Maybe [Summary],
    -- | The response's http status code.
    GetComplianceSummaryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetComplianceSummaryResponse
-> GetComplianceSummaryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetComplianceSummaryResponse
-> GetComplianceSummaryResponse -> Bool
$c/= :: GetComplianceSummaryResponse
-> GetComplianceSummaryResponse -> Bool
== :: GetComplianceSummaryResponse
-> GetComplianceSummaryResponse -> Bool
$c== :: GetComplianceSummaryResponse
-> GetComplianceSummaryResponse -> Bool
Prelude.Eq, ReadPrec [GetComplianceSummaryResponse]
ReadPrec GetComplianceSummaryResponse
Int -> ReadS GetComplianceSummaryResponse
ReadS [GetComplianceSummaryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetComplianceSummaryResponse]
$creadListPrec :: ReadPrec [GetComplianceSummaryResponse]
readPrec :: ReadPrec GetComplianceSummaryResponse
$creadPrec :: ReadPrec GetComplianceSummaryResponse
readList :: ReadS [GetComplianceSummaryResponse]
$creadList :: ReadS [GetComplianceSummaryResponse]
readsPrec :: Int -> ReadS GetComplianceSummaryResponse
$creadsPrec :: Int -> ReadS GetComplianceSummaryResponse
Prelude.Read, Int -> GetComplianceSummaryResponse -> ShowS
[GetComplianceSummaryResponse] -> ShowS
GetComplianceSummaryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetComplianceSummaryResponse] -> ShowS
$cshowList :: [GetComplianceSummaryResponse] -> ShowS
show :: GetComplianceSummaryResponse -> String
$cshow :: GetComplianceSummaryResponse -> String
showsPrec :: Int -> GetComplianceSummaryResponse -> ShowS
$cshowsPrec :: Int -> GetComplianceSummaryResponse -> ShowS
Prelude.Show, forall x.
Rep GetComplianceSummaryResponse x -> GetComplianceSummaryResponse
forall x.
GetComplianceSummaryResponse -> Rep GetComplianceSummaryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetComplianceSummaryResponse x -> GetComplianceSummaryResponse
$cfrom :: forall x.
GetComplianceSummaryResponse -> Rep GetComplianceSummaryResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetComplianceSummaryResponse' 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:
--
-- 'paginationToken', 'getComplianceSummaryResponse_paginationToken' - A string that indicates that there is more data available than this
-- response contains. To receive the next part of the response, specify
-- this response value as the @PaginationToken@ value in the request for
-- the next page.
--
-- 'summaryList', 'getComplianceSummaryResponse_summaryList' - A table that shows counts of noncompliant resources.
--
-- 'httpStatus', 'getComplianceSummaryResponse_httpStatus' - The response's http status code.
newGetComplianceSummaryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetComplianceSummaryResponse
newGetComplianceSummaryResponse :: Int -> GetComplianceSummaryResponse
newGetComplianceSummaryResponse Int
pHttpStatus_ =
  GetComplianceSummaryResponse'
    { $sel:paginationToken:GetComplianceSummaryResponse' :: Maybe Text
paginationToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:summaryList:GetComplianceSummaryResponse' :: Maybe [Summary]
summaryList = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetComplianceSummaryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A string that indicates that there is more data available than this
-- response contains. To receive the next part of the response, specify
-- this response value as the @PaginationToken@ value in the request for
-- the next page.
getComplianceSummaryResponse_paginationToken :: Lens.Lens' GetComplianceSummaryResponse (Prelude.Maybe Prelude.Text)
getComplianceSummaryResponse_paginationToken :: Lens' GetComplianceSummaryResponse (Maybe Text)
getComplianceSummaryResponse_paginationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComplianceSummaryResponse' {Maybe Text
paginationToken :: Maybe Text
$sel:paginationToken:GetComplianceSummaryResponse' :: GetComplianceSummaryResponse -> Maybe Text
paginationToken} -> Maybe Text
paginationToken) (\s :: GetComplianceSummaryResponse
s@GetComplianceSummaryResponse' {} Maybe Text
a -> GetComplianceSummaryResponse
s {$sel:paginationToken:GetComplianceSummaryResponse' :: Maybe Text
paginationToken = Maybe Text
a} :: GetComplianceSummaryResponse)

-- | A table that shows counts of noncompliant resources.
getComplianceSummaryResponse_summaryList :: Lens.Lens' GetComplianceSummaryResponse (Prelude.Maybe [Summary])
getComplianceSummaryResponse_summaryList :: Lens' GetComplianceSummaryResponse (Maybe [Summary])
getComplianceSummaryResponse_summaryList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComplianceSummaryResponse' {Maybe [Summary]
summaryList :: Maybe [Summary]
$sel:summaryList:GetComplianceSummaryResponse' :: GetComplianceSummaryResponse -> Maybe [Summary]
summaryList} -> Maybe [Summary]
summaryList) (\s :: GetComplianceSummaryResponse
s@GetComplianceSummaryResponse' {} Maybe [Summary]
a -> GetComplianceSummaryResponse
s {$sel:summaryList:GetComplianceSummaryResponse' :: Maybe [Summary]
summaryList = Maybe [Summary]
a} :: GetComplianceSummaryResponse) 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 response's http status code.
getComplianceSummaryResponse_httpStatus :: Lens.Lens' GetComplianceSummaryResponse Prelude.Int
getComplianceSummaryResponse_httpStatus :: Lens' GetComplianceSummaryResponse Int
getComplianceSummaryResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComplianceSummaryResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetComplianceSummaryResponse' :: GetComplianceSummaryResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetComplianceSummaryResponse
s@GetComplianceSummaryResponse' {} Int
a -> GetComplianceSummaryResponse
s {$sel:httpStatus:GetComplianceSummaryResponse' :: Int
httpStatus = Int
a} :: GetComplianceSummaryResponse)

instance Prelude.NFData GetComplianceSummaryResponse where
  rnf :: GetComplianceSummaryResponse -> ()
rnf GetComplianceSummaryResponse' {Int
Maybe [Summary]
Maybe Text
httpStatus :: Int
summaryList :: Maybe [Summary]
paginationToken :: Maybe Text
$sel:httpStatus:GetComplianceSummaryResponse' :: GetComplianceSummaryResponse -> Int
$sel:summaryList:GetComplianceSummaryResponse' :: GetComplianceSummaryResponse -> Maybe [Summary]
$sel:paginationToken:GetComplianceSummaryResponse' :: GetComplianceSummaryResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
paginationToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Summary]
summaryList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus