{-# 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.AccessAnalyzer.ListFindings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a list of findings generated by the specified analyzer.
--
-- To learn about filter keys that you can use to retrieve a list of
-- findings, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-reference-filter-keys.html IAM Access Analyzer filter keys>
-- in the __IAM User Guide__.
--
-- This operation returns paginated results.
module Amazonka.AccessAnalyzer.ListFindings
  ( -- * Creating a Request
    ListFindings (..),
    newListFindings,

    -- * Request Lenses
    listFindings_filter,
    listFindings_maxResults,
    listFindings_nextToken,
    listFindings_sort,
    listFindings_analyzerArn,

    -- * Destructuring the Response
    ListFindingsResponse (..),
    newListFindingsResponse,

    -- * Response Lenses
    listFindingsResponse_nextToken,
    listFindingsResponse_httpStatus,
    listFindingsResponse_findings,
  )
where

import Amazonka.AccessAnalyzer.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

-- | Retrieves a list of findings generated by the specified analyzer.
--
-- /See:/ 'newListFindings' smart constructor.
data ListFindings = ListFindings'
  { -- | A filter to match for the findings to return.
    ListFindings -> Maybe (HashMap Text Criterion)
filter' :: Prelude.Maybe (Prelude.HashMap Prelude.Text Criterion),
    -- | The maximum number of results to return in the response.
    ListFindings -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | A token used for pagination of results returned.
    ListFindings -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The sort order for the findings returned.
    ListFindings -> Maybe SortCriteria
sort :: Prelude.Maybe SortCriteria,
    -- | The
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
    -- to retrieve findings from.
    ListFindings -> Text
analyzerArn :: Prelude.Text
  }
  deriving (ListFindings -> ListFindings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFindings -> ListFindings -> Bool
$c/= :: ListFindings -> ListFindings -> Bool
== :: ListFindings -> ListFindings -> Bool
$c== :: ListFindings -> ListFindings -> Bool
Prelude.Eq, ReadPrec [ListFindings]
ReadPrec ListFindings
Int -> ReadS ListFindings
ReadS [ListFindings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFindings]
$creadListPrec :: ReadPrec [ListFindings]
readPrec :: ReadPrec ListFindings
$creadPrec :: ReadPrec ListFindings
readList :: ReadS [ListFindings]
$creadList :: ReadS [ListFindings]
readsPrec :: Int -> ReadS ListFindings
$creadsPrec :: Int -> ReadS ListFindings
Prelude.Read, Int -> ListFindings -> ShowS
[ListFindings] -> ShowS
ListFindings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFindings] -> ShowS
$cshowList :: [ListFindings] -> ShowS
show :: ListFindings -> String
$cshow :: ListFindings -> String
showsPrec :: Int -> ListFindings -> ShowS
$cshowsPrec :: Int -> ListFindings -> ShowS
Prelude.Show, forall x. Rep ListFindings x -> ListFindings
forall x. ListFindings -> Rep ListFindings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFindings x -> ListFindings
$cfrom :: forall x. ListFindings -> Rep ListFindings x
Prelude.Generic)

-- |
-- Create a value of 'ListFindings' 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:
--
-- 'filter'', 'listFindings_filter' - A filter to match for the findings to return.
--
-- 'maxResults', 'listFindings_maxResults' - The maximum number of results to return in the response.
--
-- 'nextToken', 'listFindings_nextToken' - A token used for pagination of results returned.
--
-- 'sort', 'listFindings_sort' - The sort order for the findings returned.
--
-- 'analyzerArn', 'listFindings_analyzerArn' - The
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
-- to retrieve findings from.
newListFindings ::
  -- | 'analyzerArn'
  Prelude.Text ->
  ListFindings
newListFindings :: Text -> ListFindings
newListFindings Text
pAnalyzerArn_ =
  ListFindings'
    { $sel:filter':ListFindings' :: Maybe (HashMap Text Criterion)
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListFindings' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFindings' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sort:ListFindings' :: Maybe SortCriteria
sort = forall a. Maybe a
Prelude.Nothing,
      $sel:analyzerArn:ListFindings' :: Text
analyzerArn = Text
pAnalyzerArn_
    }

-- | A filter to match for the findings to return.
listFindings_filter :: Lens.Lens' ListFindings (Prelude.Maybe (Prelude.HashMap Prelude.Text Criterion))
listFindings_filter :: Lens' ListFindings (Maybe (HashMap Text Criterion))
listFindings_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFindings' {Maybe (HashMap Text Criterion)
filter' :: Maybe (HashMap Text Criterion)
$sel:filter':ListFindings' :: ListFindings -> Maybe (HashMap Text Criterion)
filter'} -> Maybe (HashMap Text Criterion)
filter') (\s :: ListFindings
s@ListFindings' {} Maybe (HashMap Text Criterion)
a -> ListFindings
s {$sel:filter':ListFindings' :: Maybe (HashMap Text Criterion)
filter' = Maybe (HashMap Text Criterion)
a} :: ListFindings) 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 maximum number of results to return in the response.
listFindings_maxResults :: Lens.Lens' ListFindings (Prelude.Maybe Prelude.Int)
listFindings_maxResults :: Lens' ListFindings (Maybe Int)
listFindings_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFindings' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListFindings' :: ListFindings -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListFindings
s@ListFindings' {} Maybe Int
a -> ListFindings
s {$sel:maxResults:ListFindings' :: Maybe Int
maxResults = Maybe Int
a} :: ListFindings)

-- | A token used for pagination of results returned.
listFindings_nextToken :: Lens.Lens' ListFindings (Prelude.Maybe Prelude.Text)
listFindings_nextToken :: Lens' ListFindings (Maybe Text)
listFindings_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFindings' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFindings' :: ListFindings -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFindings
s@ListFindings' {} Maybe Text
a -> ListFindings
s {$sel:nextToken:ListFindings' :: Maybe Text
nextToken = Maybe Text
a} :: ListFindings)

-- | The sort order for the findings returned.
listFindings_sort :: Lens.Lens' ListFindings (Prelude.Maybe SortCriteria)
listFindings_sort :: Lens' ListFindings (Maybe SortCriteria)
listFindings_sort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFindings' {Maybe SortCriteria
sort :: Maybe SortCriteria
$sel:sort:ListFindings' :: ListFindings -> Maybe SortCriteria
sort} -> Maybe SortCriteria
sort) (\s :: ListFindings
s@ListFindings' {} Maybe SortCriteria
a -> ListFindings
s {$sel:sort:ListFindings' :: Maybe SortCriteria
sort = Maybe SortCriteria
a} :: ListFindings)

-- | The
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access-analyzer-getting-started.html#permission-resources ARN of the analyzer>
-- to retrieve findings from.
listFindings_analyzerArn :: Lens.Lens' ListFindings Prelude.Text
listFindings_analyzerArn :: Lens' ListFindings Text
listFindings_analyzerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFindings' {Text
analyzerArn :: Text
$sel:analyzerArn:ListFindings' :: ListFindings -> Text
analyzerArn} -> Text
analyzerArn) (\s :: ListFindings
s@ListFindings' {} Text
a -> ListFindings
s {$sel:analyzerArn:ListFindings' :: Text
analyzerArn = Text
a} :: ListFindings)

instance Core.AWSPager ListFindings where
  page :: ListFindings -> AWSResponse ListFindings -> Maybe ListFindings
page ListFindings
rq AWSResponse ListFindings
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListFindings
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFindingsResponse (Maybe Text)
listFindingsResponse_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 ListFindings
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListFindingsResponse [FindingSummary]
listFindingsResponse_findings) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListFindings
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListFindings (Maybe Text)
listFindings_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListFindings
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListFindingsResponse (Maybe Text)
listFindingsResponse_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 ListFindings where
  type AWSResponse ListFindings = ListFindingsResponse
  request :: (Service -> Service) -> ListFindings -> Request ListFindings
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 ListFindings
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListFindings)))
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 -> [FindingSummary] -> ListFindingsResponse
ListFindingsResponse'
            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 (Maybe a)
Data..?> Key
"findings" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ListFindings where
  hashWithSalt :: Int -> ListFindings -> Int
hashWithSalt Int
_salt ListFindings' {Maybe Int
Maybe Text
Maybe (HashMap Text Criterion)
Maybe SortCriteria
Text
analyzerArn :: Text
sort :: Maybe SortCriteria
nextToken :: Maybe Text
maxResults :: Maybe Int
filter' :: Maybe (HashMap Text Criterion)
$sel:analyzerArn:ListFindings' :: ListFindings -> Text
$sel:sort:ListFindings' :: ListFindings -> Maybe SortCriteria
$sel:nextToken:ListFindings' :: ListFindings -> Maybe Text
$sel:maxResults:ListFindings' :: ListFindings -> Maybe Int
$sel:filter':ListFindings' :: ListFindings -> Maybe (HashMap Text Criterion)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Criterion)
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SortCriteria
sort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
analyzerArn

instance Prelude.NFData ListFindings where
  rnf :: ListFindings -> ()
rnf ListFindings' {Maybe Int
Maybe Text
Maybe (HashMap Text Criterion)
Maybe SortCriteria
Text
analyzerArn :: Text
sort :: Maybe SortCriteria
nextToken :: Maybe Text
maxResults :: Maybe Int
filter' :: Maybe (HashMap Text Criterion)
$sel:analyzerArn:ListFindings' :: ListFindings -> Text
$sel:sort:ListFindings' :: ListFindings -> Maybe SortCriteria
$sel:nextToken:ListFindings' :: ListFindings -> Maybe Text
$sel:maxResults:ListFindings' :: ListFindings -> Maybe Int
$sel:filter':ListFindings' :: ListFindings -> Maybe (HashMap Text Criterion)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Criterion)
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      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 Maybe SortCriteria
sort
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
analyzerArn

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

instance Data.ToJSON ListFindings where
  toJSON :: ListFindings -> Value
toJSON ListFindings' {Maybe Int
Maybe Text
Maybe (HashMap Text Criterion)
Maybe SortCriteria
Text
analyzerArn :: Text
sort :: Maybe SortCriteria
nextToken :: Maybe Text
maxResults :: Maybe Int
filter' :: Maybe (HashMap Text Criterion)
$sel:analyzerArn:ListFindings' :: ListFindings -> Text
$sel:sort:ListFindings' :: ListFindings -> Maybe SortCriteria
$sel:nextToken:ListFindings' :: ListFindings -> Maybe Text
$sel:maxResults:ListFindings' :: ListFindings -> Maybe Int
$sel:filter':ListFindings' :: ListFindings -> Maybe (HashMap Text Criterion)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"filter" 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 (HashMap Text Criterion)
filter',
            (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 Int
maxResults,
            (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,
            (Key
"sort" 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 SortCriteria
sort,
            forall a. a -> Maybe a
Prelude.Just (Key
"analyzerArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
analyzerArn)
          ]
      )

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

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

-- | The response to the request.
--
-- /See:/ 'newListFindingsResponse' smart constructor.
data ListFindingsResponse = ListFindingsResponse'
  { -- | A token used for pagination of results returned.
    ListFindingsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListFindingsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of findings retrieved from the analyzer that match the filter
    -- criteria specified, if any.
    ListFindingsResponse -> [FindingSummary]
findings :: [FindingSummary]
  }
  deriving (ListFindingsResponse -> ListFindingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFindingsResponse -> ListFindingsResponse -> Bool
$c/= :: ListFindingsResponse -> ListFindingsResponse -> Bool
== :: ListFindingsResponse -> ListFindingsResponse -> Bool
$c== :: ListFindingsResponse -> ListFindingsResponse -> Bool
Prelude.Eq, ReadPrec [ListFindingsResponse]
ReadPrec ListFindingsResponse
Int -> ReadS ListFindingsResponse
ReadS [ListFindingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFindingsResponse]
$creadListPrec :: ReadPrec [ListFindingsResponse]
readPrec :: ReadPrec ListFindingsResponse
$creadPrec :: ReadPrec ListFindingsResponse
readList :: ReadS [ListFindingsResponse]
$creadList :: ReadS [ListFindingsResponse]
readsPrec :: Int -> ReadS ListFindingsResponse
$creadsPrec :: Int -> ReadS ListFindingsResponse
Prelude.Read, Int -> ListFindingsResponse -> ShowS
[ListFindingsResponse] -> ShowS
ListFindingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFindingsResponse] -> ShowS
$cshowList :: [ListFindingsResponse] -> ShowS
show :: ListFindingsResponse -> String
$cshow :: ListFindingsResponse -> String
showsPrec :: Int -> ListFindingsResponse -> ShowS
$cshowsPrec :: Int -> ListFindingsResponse -> ShowS
Prelude.Show, forall x. Rep ListFindingsResponse x -> ListFindingsResponse
forall x. ListFindingsResponse -> Rep ListFindingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFindingsResponse x -> ListFindingsResponse
$cfrom :: forall x. ListFindingsResponse -> Rep ListFindingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListFindingsResponse' 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', 'listFindingsResponse_nextToken' - A token used for pagination of results returned.
--
-- 'httpStatus', 'listFindingsResponse_httpStatus' - The response's http status code.
--
-- 'findings', 'listFindingsResponse_findings' - A list of findings retrieved from the analyzer that match the filter
-- criteria specified, if any.
newListFindingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListFindingsResponse
newListFindingsResponse :: Int -> ListFindingsResponse
newListFindingsResponse Int
pHttpStatus_ =
  ListFindingsResponse'
    { $sel:nextToken:ListFindingsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListFindingsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:findings:ListFindingsResponse' :: [FindingSummary]
findings = forall a. Monoid a => a
Prelude.mempty
    }

-- | A token used for pagination of results returned.
listFindingsResponse_nextToken :: Lens.Lens' ListFindingsResponse (Prelude.Maybe Prelude.Text)
listFindingsResponse_nextToken :: Lens' ListFindingsResponse (Maybe Text)
listFindingsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFindingsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFindingsResponse' :: ListFindingsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFindingsResponse
s@ListFindingsResponse' {} Maybe Text
a -> ListFindingsResponse
s {$sel:nextToken:ListFindingsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListFindingsResponse)

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

-- | A list of findings retrieved from the analyzer that match the filter
-- criteria specified, if any.
listFindingsResponse_findings :: Lens.Lens' ListFindingsResponse [FindingSummary]
listFindingsResponse_findings :: Lens' ListFindingsResponse [FindingSummary]
listFindingsResponse_findings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFindingsResponse' {[FindingSummary]
findings :: [FindingSummary]
$sel:findings:ListFindingsResponse' :: ListFindingsResponse -> [FindingSummary]
findings} -> [FindingSummary]
findings) (\s :: ListFindingsResponse
s@ListFindingsResponse' {} [FindingSummary]
a -> ListFindingsResponse
s {$sel:findings:ListFindingsResponse' :: [FindingSummary]
findings = [FindingSummary]
a} :: ListFindingsResponse) 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 ListFindingsResponse where
  rnf :: ListFindingsResponse -> ()
rnf ListFindingsResponse' {Int
[FindingSummary]
Maybe Text
findings :: [FindingSummary]
httpStatus :: Int
nextToken :: Maybe Text
$sel:findings:ListFindingsResponse' :: ListFindingsResponse -> [FindingSummary]
$sel:httpStatus:ListFindingsResponse' :: ListFindingsResponse -> Int
$sel:nextToken:ListFindingsResponse' :: ListFindingsResponse -> 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 [FindingSummary]
findings