{-# 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.ECR.DescribeImageScanFindings
-- 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 the scan findings for the specified image.
--
-- This operation returns paginated results.
module Amazonka.ECR.DescribeImageScanFindings
  ( -- * Creating a Request
    DescribeImageScanFindings (..),
    newDescribeImageScanFindings,

    -- * Request Lenses
    describeImageScanFindings_maxResults,
    describeImageScanFindings_nextToken,
    describeImageScanFindings_registryId,
    describeImageScanFindings_repositoryName,
    describeImageScanFindings_imageId,

    -- * Destructuring the Response
    DescribeImageScanFindingsResponse (..),
    newDescribeImageScanFindingsResponse,

    -- * Response Lenses
    describeImageScanFindingsResponse_imageId,
    describeImageScanFindingsResponse_imageScanFindings,
    describeImageScanFindingsResponse_imageScanStatus,
    describeImageScanFindingsResponse_nextToken,
    describeImageScanFindingsResponse_registryId,
    describeImageScanFindingsResponse_repositoryName,
    describeImageScanFindingsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ECR.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDescribeImageScanFindings' smart constructor.
data DescribeImageScanFindings = DescribeImageScanFindings'
  { -- | The maximum number of image scan results returned by
    -- @DescribeImageScanFindings@ in paginated output. When this parameter is
    -- used, @DescribeImageScanFindings@ only returns @maxResults@ results in a
    -- single page along with a @nextToken@ response element. The remaining
    -- results of the initial request can be seen by sending another
    -- @DescribeImageScanFindings@ request with the returned @nextToken@ value.
    -- This value can be between 1 and 1000. If this parameter is not used,
    -- then @DescribeImageScanFindings@ returns up to 100 results and a
    -- @nextToken@ value, if applicable.
    DescribeImageScanFindings -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The @nextToken@ value returned from a previous paginated
    -- @DescribeImageScanFindings@ request where @maxResults@ was used and the
    -- results exceeded the value of that parameter. Pagination continues from
    -- the end of the previous results that returned the @nextToken@ value.
    -- This value is null when there are no more results to return.
    DescribeImageScanFindings -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services account ID associated with the registry that
    -- contains the repository in which to describe the image scan findings
    -- for. If you do not specify a registry, the default registry is assumed.
    DescribeImageScanFindings -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text,
    -- | The repository for the image for which to describe the scan findings.
    DescribeImageScanFindings -> Text
repositoryName :: Prelude.Text,
    DescribeImageScanFindings -> ImageIdentifier
imageId :: ImageIdentifier
  }
  deriving (DescribeImageScanFindings -> DescribeImageScanFindings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeImageScanFindings -> DescribeImageScanFindings -> Bool
$c/= :: DescribeImageScanFindings -> DescribeImageScanFindings -> Bool
== :: DescribeImageScanFindings -> DescribeImageScanFindings -> Bool
$c== :: DescribeImageScanFindings -> DescribeImageScanFindings -> Bool
Prelude.Eq, ReadPrec [DescribeImageScanFindings]
ReadPrec DescribeImageScanFindings
Int -> ReadS DescribeImageScanFindings
ReadS [DescribeImageScanFindings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeImageScanFindings]
$creadListPrec :: ReadPrec [DescribeImageScanFindings]
readPrec :: ReadPrec DescribeImageScanFindings
$creadPrec :: ReadPrec DescribeImageScanFindings
readList :: ReadS [DescribeImageScanFindings]
$creadList :: ReadS [DescribeImageScanFindings]
readsPrec :: Int -> ReadS DescribeImageScanFindings
$creadsPrec :: Int -> ReadS DescribeImageScanFindings
Prelude.Read, Int -> DescribeImageScanFindings -> ShowS
[DescribeImageScanFindings] -> ShowS
DescribeImageScanFindings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeImageScanFindings] -> ShowS
$cshowList :: [DescribeImageScanFindings] -> ShowS
show :: DescribeImageScanFindings -> String
$cshow :: DescribeImageScanFindings -> String
showsPrec :: Int -> DescribeImageScanFindings -> ShowS
$cshowsPrec :: Int -> DescribeImageScanFindings -> ShowS
Prelude.Show, forall x.
Rep DescribeImageScanFindings x -> DescribeImageScanFindings
forall x.
DescribeImageScanFindings -> Rep DescribeImageScanFindings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeImageScanFindings x -> DescribeImageScanFindings
$cfrom :: forall x.
DescribeImageScanFindings -> Rep DescribeImageScanFindings x
Prelude.Generic)

-- |
-- Create a value of 'DescribeImageScanFindings' 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:
--
-- 'maxResults', 'describeImageScanFindings_maxResults' - The maximum number of image scan results returned by
-- @DescribeImageScanFindings@ in paginated output. When this parameter is
-- used, @DescribeImageScanFindings@ only returns @maxResults@ results in a
-- single page along with a @nextToken@ response element. The remaining
-- results of the initial request can be seen by sending another
-- @DescribeImageScanFindings@ request with the returned @nextToken@ value.
-- This value can be between 1 and 1000. If this parameter is not used,
-- then @DescribeImageScanFindings@ returns up to 100 results and a
-- @nextToken@ value, if applicable.
--
-- 'nextToken', 'describeImageScanFindings_nextToken' - The @nextToken@ value returned from a previous paginated
-- @DescribeImageScanFindings@ request where @maxResults@ was used and the
-- results exceeded the value of that parameter. Pagination continues from
-- the end of the previous results that returned the @nextToken@ value.
-- This value is null when there are no more results to return.
--
-- 'registryId', 'describeImageScanFindings_registryId' - The Amazon Web Services account ID associated with the registry that
-- contains the repository in which to describe the image scan findings
-- for. If you do not specify a registry, the default registry is assumed.
--
-- 'repositoryName', 'describeImageScanFindings_repositoryName' - The repository for the image for which to describe the scan findings.
--
-- 'imageId', 'describeImageScanFindings_imageId' - Undocumented member.
newDescribeImageScanFindings ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'imageId'
  ImageIdentifier ->
  DescribeImageScanFindings
newDescribeImageScanFindings :: Text -> ImageIdentifier -> DescribeImageScanFindings
newDescribeImageScanFindings
  Text
pRepositoryName_
  ImageIdentifier
pImageId_ =
    DescribeImageScanFindings'
      { $sel:maxResults:DescribeImageScanFindings' :: Maybe Natural
maxResults =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:DescribeImageScanFindings' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:registryId:DescribeImageScanFindings' :: Maybe Text
registryId = forall a. Maybe a
Prelude.Nothing,
        $sel:repositoryName:DescribeImageScanFindings' :: Text
repositoryName = Text
pRepositoryName_,
        $sel:imageId:DescribeImageScanFindings' :: ImageIdentifier
imageId = ImageIdentifier
pImageId_
      }

-- | The maximum number of image scan results returned by
-- @DescribeImageScanFindings@ in paginated output. When this parameter is
-- used, @DescribeImageScanFindings@ only returns @maxResults@ results in a
-- single page along with a @nextToken@ response element. The remaining
-- results of the initial request can be seen by sending another
-- @DescribeImageScanFindings@ request with the returned @nextToken@ value.
-- This value can be between 1 and 1000. If this parameter is not used,
-- then @DescribeImageScanFindings@ returns up to 100 results and a
-- @nextToken@ value, if applicable.
describeImageScanFindings_maxResults :: Lens.Lens' DescribeImageScanFindings (Prelude.Maybe Prelude.Natural)
describeImageScanFindings_maxResults :: Lens' DescribeImageScanFindings (Maybe Natural)
describeImageScanFindings_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindings' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribeImageScanFindings
s@DescribeImageScanFindings' {} Maybe Natural
a -> DescribeImageScanFindings
s {$sel:maxResults:DescribeImageScanFindings' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribeImageScanFindings)

-- | The @nextToken@ value returned from a previous paginated
-- @DescribeImageScanFindings@ request where @maxResults@ was used and the
-- results exceeded the value of that parameter. Pagination continues from
-- the end of the previous results that returned the @nextToken@ value.
-- This value is null when there are no more results to return.
describeImageScanFindings_nextToken :: Lens.Lens' DescribeImageScanFindings (Prelude.Maybe Prelude.Text)
describeImageScanFindings_nextToken :: Lens' DescribeImageScanFindings (Maybe Text)
describeImageScanFindings_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindings' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeImageScanFindings
s@DescribeImageScanFindings' {} Maybe Text
a -> DescribeImageScanFindings
s {$sel:nextToken:DescribeImageScanFindings' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeImageScanFindings)

-- | The Amazon Web Services account ID associated with the registry that
-- contains the repository in which to describe the image scan findings
-- for. If you do not specify a registry, the default registry is assumed.
describeImageScanFindings_registryId :: Lens.Lens' DescribeImageScanFindings (Prelude.Maybe Prelude.Text)
describeImageScanFindings_registryId :: Lens' DescribeImageScanFindings (Maybe Text)
describeImageScanFindings_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindings' {Maybe Text
registryId :: Maybe Text
$sel:registryId:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Text
registryId} -> Maybe Text
registryId) (\s :: DescribeImageScanFindings
s@DescribeImageScanFindings' {} Maybe Text
a -> DescribeImageScanFindings
s {$sel:registryId:DescribeImageScanFindings' :: Maybe Text
registryId = Maybe Text
a} :: DescribeImageScanFindings)

-- | The repository for the image for which to describe the scan findings.
describeImageScanFindings_repositoryName :: Lens.Lens' DescribeImageScanFindings Prelude.Text
describeImageScanFindings_repositoryName :: Lens' DescribeImageScanFindings Text
describeImageScanFindings_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindings' {Text
repositoryName :: Text
$sel:repositoryName:DescribeImageScanFindings' :: DescribeImageScanFindings -> Text
repositoryName} -> Text
repositoryName) (\s :: DescribeImageScanFindings
s@DescribeImageScanFindings' {} Text
a -> DescribeImageScanFindings
s {$sel:repositoryName:DescribeImageScanFindings' :: Text
repositoryName = Text
a} :: DescribeImageScanFindings)

-- | Undocumented member.
describeImageScanFindings_imageId :: Lens.Lens' DescribeImageScanFindings ImageIdentifier
describeImageScanFindings_imageId :: Lens' DescribeImageScanFindings ImageIdentifier
describeImageScanFindings_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindings' {ImageIdentifier
imageId :: ImageIdentifier
$sel:imageId:DescribeImageScanFindings' :: DescribeImageScanFindings -> ImageIdentifier
imageId} -> ImageIdentifier
imageId) (\s :: DescribeImageScanFindings
s@DescribeImageScanFindings' {} ImageIdentifier
a -> DescribeImageScanFindings
s {$sel:imageId:DescribeImageScanFindings' :: ImageIdentifier
imageId = ImageIdentifier
a} :: DescribeImageScanFindings)

instance Core.AWSPager DescribeImageScanFindings where
  page :: DescribeImageScanFindings
-> AWSResponse DescribeImageScanFindings
-> Maybe DescribeImageScanFindings
page DescribeImageScanFindings
rq AWSResponse DescribeImageScanFindings
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeImageScanFindings
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeImageScanFindingsResponse (Maybe Text)
describeImageScanFindingsResponse_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 DescribeImageScanFindings
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeImageScanFindingsResponse (Maybe ImageScanFindings)
describeImageScanFindingsResponse_imageScanFindings
            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.. Lens' ImageScanFindings (Maybe [ImageScanFinding])
imageScanFindings_findings
            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 DescribeImageScanFindings
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeImageScanFindingsResponse (Maybe ImageScanFindings)
describeImageScanFindingsResponse_imageScanFindings
            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.. Lens' ImageScanFindings (Maybe [EnhancedImageScanFinding])
imageScanFindings_enhancedFindings
            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.$ DescribeImageScanFindings
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeImageScanFindings (Maybe Text)
describeImageScanFindings_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeImageScanFindings
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeImageScanFindingsResponse (Maybe Text)
describeImageScanFindingsResponse_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 DescribeImageScanFindings where
  type
    AWSResponse DescribeImageScanFindings =
      DescribeImageScanFindingsResponse
  request :: (Service -> Service)
-> DescribeImageScanFindings -> Request DescribeImageScanFindings
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 DescribeImageScanFindings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeImageScanFindings)))
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 ImageIdentifier
-> Maybe ImageScanFindings
-> Maybe ImageScanStatus
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> DescribeImageScanFindingsResponse
DescribeImageScanFindingsResponse'
            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
"imageId")
            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
"imageScanFindings")
            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
"imageScanStatus")
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"registryId")
            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
"repositoryName")
            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 DescribeImageScanFindings where
  hashWithSalt :: Int -> DescribeImageScanFindings -> Int
hashWithSalt Int
_salt DescribeImageScanFindings' {Maybe Natural
Maybe Text
Text
ImageIdentifier
imageId :: ImageIdentifier
repositoryName :: Text
registryId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:imageId:DescribeImageScanFindings' :: DescribeImageScanFindings -> ImageIdentifier
$sel:repositoryName:DescribeImageScanFindings' :: DescribeImageScanFindings -> Text
$sel:registryId:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Text
$sel:nextToken:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Text
$sel:maxResults:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
registryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ImageIdentifier
imageId

instance Prelude.NFData DescribeImageScanFindings where
  rnf :: DescribeImageScanFindings -> ()
rnf DescribeImageScanFindings' {Maybe Natural
Maybe Text
Text
ImageIdentifier
imageId :: ImageIdentifier
repositoryName :: Text
registryId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:imageId:DescribeImageScanFindings' :: DescribeImageScanFindings -> ImageIdentifier
$sel:repositoryName:DescribeImageScanFindings' :: DescribeImageScanFindings -> Text
$sel:registryId:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Text
$sel:nextToken:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Text
$sel:maxResults:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Natural
..} =
    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
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
registryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
repositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ImageIdentifier
imageId

instance Data.ToHeaders DescribeImageScanFindings where
  toHeaders :: DescribeImageScanFindings -> 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
"AmazonEC2ContainerRegistry_V20150921.DescribeImageScanFindings" ::
                          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 DescribeImageScanFindings where
  toJSON :: DescribeImageScanFindings -> Value
toJSON DescribeImageScanFindings' {Maybe Natural
Maybe Text
Text
ImageIdentifier
imageId :: ImageIdentifier
repositoryName :: Text
registryId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:imageId:DescribeImageScanFindings' :: DescribeImageScanFindings -> ImageIdentifier
$sel:repositoryName:DescribeImageScanFindings' :: DescribeImageScanFindings -> Text
$sel:registryId:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Text
$sel:nextToken:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Text
$sel:maxResults:DescribeImageScanFindings' :: DescribeImageScanFindings -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"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
"registryId" 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
registryId,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"repositoryName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
repositoryName),
            forall a. a -> Maybe a
Prelude.Just (Key
"imageId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ImageIdentifier
imageId)
          ]
      )

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

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

-- | /See:/ 'newDescribeImageScanFindingsResponse' smart constructor.
data DescribeImageScanFindingsResponse = DescribeImageScanFindingsResponse'
  { DescribeImageScanFindingsResponse -> Maybe ImageIdentifier
imageId :: Prelude.Maybe ImageIdentifier,
    -- | The information contained in the image scan findings.
    DescribeImageScanFindingsResponse -> Maybe ImageScanFindings
imageScanFindings :: Prelude.Maybe ImageScanFindings,
    -- | The current state of the scan.
    DescribeImageScanFindingsResponse -> Maybe ImageScanStatus
imageScanStatus :: Prelude.Maybe ImageScanStatus,
    -- | The @nextToken@ value to include in a future @DescribeImageScanFindings@
    -- request. When the results of a @DescribeImageScanFindings@ request
    -- exceed @maxResults@, this value can be used to retrieve the next page of
    -- results. This value is null when there are no more results to return.
    DescribeImageScanFindingsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The registry ID associated with the request.
    DescribeImageScanFindingsResponse -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text,
    -- | The repository name associated with the request.
    DescribeImageScanFindingsResponse -> Maybe Text
repositoryName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeImageScanFindingsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeImageScanFindingsResponse
-> DescribeImageScanFindingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeImageScanFindingsResponse
-> DescribeImageScanFindingsResponse -> Bool
$c/= :: DescribeImageScanFindingsResponse
-> DescribeImageScanFindingsResponse -> Bool
== :: DescribeImageScanFindingsResponse
-> DescribeImageScanFindingsResponse -> Bool
$c== :: DescribeImageScanFindingsResponse
-> DescribeImageScanFindingsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeImageScanFindingsResponse]
ReadPrec DescribeImageScanFindingsResponse
Int -> ReadS DescribeImageScanFindingsResponse
ReadS [DescribeImageScanFindingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeImageScanFindingsResponse]
$creadListPrec :: ReadPrec [DescribeImageScanFindingsResponse]
readPrec :: ReadPrec DescribeImageScanFindingsResponse
$creadPrec :: ReadPrec DescribeImageScanFindingsResponse
readList :: ReadS [DescribeImageScanFindingsResponse]
$creadList :: ReadS [DescribeImageScanFindingsResponse]
readsPrec :: Int -> ReadS DescribeImageScanFindingsResponse
$creadsPrec :: Int -> ReadS DescribeImageScanFindingsResponse
Prelude.Read, Int -> DescribeImageScanFindingsResponse -> ShowS
[DescribeImageScanFindingsResponse] -> ShowS
DescribeImageScanFindingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeImageScanFindingsResponse] -> ShowS
$cshowList :: [DescribeImageScanFindingsResponse] -> ShowS
show :: DescribeImageScanFindingsResponse -> String
$cshow :: DescribeImageScanFindingsResponse -> String
showsPrec :: Int -> DescribeImageScanFindingsResponse -> ShowS
$cshowsPrec :: Int -> DescribeImageScanFindingsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeImageScanFindingsResponse x
-> DescribeImageScanFindingsResponse
forall x.
DescribeImageScanFindingsResponse
-> Rep DescribeImageScanFindingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeImageScanFindingsResponse x
-> DescribeImageScanFindingsResponse
$cfrom :: forall x.
DescribeImageScanFindingsResponse
-> Rep DescribeImageScanFindingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeImageScanFindingsResponse' 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:
--
-- 'imageId', 'describeImageScanFindingsResponse_imageId' - Undocumented member.
--
-- 'imageScanFindings', 'describeImageScanFindingsResponse_imageScanFindings' - The information contained in the image scan findings.
--
-- 'imageScanStatus', 'describeImageScanFindingsResponse_imageScanStatus' - The current state of the scan.
--
-- 'nextToken', 'describeImageScanFindingsResponse_nextToken' - The @nextToken@ value to include in a future @DescribeImageScanFindings@
-- request. When the results of a @DescribeImageScanFindings@ request
-- exceed @maxResults@, this value can be used to retrieve the next page of
-- results. This value is null when there are no more results to return.
--
-- 'registryId', 'describeImageScanFindingsResponse_registryId' - The registry ID associated with the request.
--
-- 'repositoryName', 'describeImageScanFindingsResponse_repositoryName' - The repository name associated with the request.
--
-- 'httpStatus', 'describeImageScanFindingsResponse_httpStatus' - The response's http status code.
newDescribeImageScanFindingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeImageScanFindingsResponse
newDescribeImageScanFindingsResponse :: Int -> DescribeImageScanFindingsResponse
newDescribeImageScanFindingsResponse Int
pHttpStatus_ =
  DescribeImageScanFindingsResponse'
    { $sel:imageId:DescribeImageScanFindingsResponse' :: Maybe ImageIdentifier
imageId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:imageScanFindings:DescribeImageScanFindingsResponse' :: Maybe ImageScanFindings
imageScanFindings = forall a. Maybe a
Prelude.Nothing,
      $sel:imageScanStatus:DescribeImageScanFindingsResponse' :: Maybe ImageScanStatus
imageScanStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeImageScanFindingsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:registryId:DescribeImageScanFindingsResponse' :: Maybe Text
registryId = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:DescribeImageScanFindingsResponse' :: Maybe Text
repositoryName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeImageScanFindingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
describeImageScanFindingsResponse_imageId :: Lens.Lens' DescribeImageScanFindingsResponse (Prelude.Maybe ImageIdentifier)
describeImageScanFindingsResponse_imageId :: Lens' DescribeImageScanFindingsResponse (Maybe ImageIdentifier)
describeImageScanFindingsResponse_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindingsResponse' {Maybe ImageIdentifier
imageId :: Maybe ImageIdentifier
$sel:imageId:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe ImageIdentifier
imageId} -> Maybe ImageIdentifier
imageId) (\s :: DescribeImageScanFindingsResponse
s@DescribeImageScanFindingsResponse' {} Maybe ImageIdentifier
a -> DescribeImageScanFindingsResponse
s {$sel:imageId:DescribeImageScanFindingsResponse' :: Maybe ImageIdentifier
imageId = Maybe ImageIdentifier
a} :: DescribeImageScanFindingsResponse)

-- | The information contained in the image scan findings.
describeImageScanFindingsResponse_imageScanFindings :: Lens.Lens' DescribeImageScanFindingsResponse (Prelude.Maybe ImageScanFindings)
describeImageScanFindingsResponse_imageScanFindings :: Lens' DescribeImageScanFindingsResponse (Maybe ImageScanFindings)
describeImageScanFindingsResponse_imageScanFindings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindingsResponse' {Maybe ImageScanFindings
imageScanFindings :: Maybe ImageScanFindings
$sel:imageScanFindings:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe ImageScanFindings
imageScanFindings} -> Maybe ImageScanFindings
imageScanFindings) (\s :: DescribeImageScanFindingsResponse
s@DescribeImageScanFindingsResponse' {} Maybe ImageScanFindings
a -> DescribeImageScanFindingsResponse
s {$sel:imageScanFindings:DescribeImageScanFindingsResponse' :: Maybe ImageScanFindings
imageScanFindings = Maybe ImageScanFindings
a} :: DescribeImageScanFindingsResponse)

-- | The current state of the scan.
describeImageScanFindingsResponse_imageScanStatus :: Lens.Lens' DescribeImageScanFindingsResponse (Prelude.Maybe ImageScanStatus)
describeImageScanFindingsResponse_imageScanStatus :: Lens' DescribeImageScanFindingsResponse (Maybe ImageScanStatus)
describeImageScanFindingsResponse_imageScanStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindingsResponse' {Maybe ImageScanStatus
imageScanStatus :: Maybe ImageScanStatus
$sel:imageScanStatus:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe ImageScanStatus
imageScanStatus} -> Maybe ImageScanStatus
imageScanStatus) (\s :: DescribeImageScanFindingsResponse
s@DescribeImageScanFindingsResponse' {} Maybe ImageScanStatus
a -> DescribeImageScanFindingsResponse
s {$sel:imageScanStatus:DescribeImageScanFindingsResponse' :: Maybe ImageScanStatus
imageScanStatus = Maybe ImageScanStatus
a} :: DescribeImageScanFindingsResponse)

-- | The @nextToken@ value to include in a future @DescribeImageScanFindings@
-- request. When the results of a @DescribeImageScanFindings@ request
-- exceed @maxResults@, this value can be used to retrieve the next page of
-- results. This value is null when there are no more results to return.
describeImageScanFindingsResponse_nextToken :: Lens.Lens' DescribeImageScanFindingsResponse (Prelude.Maybe Prelude.Text)
describeImageScanFindingsResponse_nextToken :: Lens' DescribeImageScanFindingsResponse (Maybe Text)
describeImageScanFindingsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindingsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeImageScanFindingsResponse
s@DescribeImageScanFindingsResponse' {} Maybe Text
a -> DescribeImageScanFindingsResponse
s {$sel:nextToken:DescribeImageScanFindingsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeImageScanFindingsResponse)

-- | The registry ID associated with the request.
describeImageScanFindingsResponse_registryId :: Lens.Lens' DescribeImageScanFindingsResponse (Prelude.Maybe Prelude.Text)
describeImageScanFindingsResponse_registryId :: Lens' DescribeImageScanFindingsResponse (Maybe Text)
describeImageScanFindingsResponse_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindingsResponse' {Maybe Text
registryId :: Maybe Text
$sel:registryId:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe Text
registryId} -> Maybe Text
registryId) (\s :: DescribeImageScanFindingsResponse
s@DescribeImageScanFindingsResponse' {} Maybe Text
a -> DescribeImageScanFindingsResponse
s {$sel:registryId:DescribeImageScanFindingsResponse' :: Maybe Text
registryId = Maybe Text
a} :: DescribeImageScanFindingsResponse)

-- | The repository name associated with the request.
describeImageScanFindingsResponse_repositoryName :: Lens.Lens' DescribeImageScanFindingsResponse (Prelude.Maybe Prelude.Text)
describeImageScanFindingsResponse_repositoryName :: Lens' DescribeImageScanFindingsResponse (Maybe Text)
describeImageScanFindingsResponse_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageScanFindingsResponse' {Maybe Text
repositoryName :: Maybe Text
$sel:repositoryName:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe Text
repositoryName} -> Maybe Text
repositoryName) (\s :: DescribeImageScanFindingsResponse
s@DescribeImageScanFindingsResponse' {} Maybe Text
a -> DescribeImageScanFindingsResponse
s {$sel:repositoryName:DescribeImageScanFindingsResponse' :: Maybe Text
repositoryName = Maybe Text
a} :: DescribeImageScanFindingsResponse)

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

instance
  Prelude.NFData
    DescribeImageScanFindingsResponse
  where
  rnf :: DescribeImageScanFindingsResponse -> ()
rnf DescribeImageScanFindingsResponse' {Int
Maybe Text
Maybe ImageIdentifier
Maybe ImageScanStatus
Maybe ImageScanFindings
httpStatus :: Int
repositoryName :: Maybe Text
registryId :: Maybe Text
nextToken :: Maybe Text
imageScanStatus :: Maybe ImageScanStatus
imageScanFindings :: Maybe ImageScanFindings
imageId :: Maybe ImageIdentifier
$sel:httpStatus:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Int
$sel:repositoryName:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe Text
$sel:registryId:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe Text
$sel:nextToken:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe Text
$sel:imageScanStatus:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe ImageScanStatus
$sel:imageScanFindings:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe ImageScanFindings
$sel:imageId:DescribeImageScanFindingsResponse' :: DescribeImageScanFindingsResponse -> Maybe ImageIdentifier
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ImageIdentifier
imageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImageScanFindings
imageScanFindings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImageScanStatus
imageScanStatus
      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 Text
registryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
repositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus