{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.ImageScanFindings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.ECR.Types.ImageScanFindings 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.EnhancedImageScanFinding
import Amazonka.ECR.Types.FindingSeverity
import Amazonka.ECR.Types.ImageScanFinding
import qualified Amazonka.Prelude as Prelude

-- | The details of an image scan.
--
-- /See:/ 'newImageScanFindings' smart constructor.
data ImageScanFindings = ImageScanFindings'
  { -- | Details about the enhanced scan findings from Amazon Inspector.
    ImageScanFindings -> Maybe [EnhancedImageScanFinding]
enhancedFindings :: Prelude.Maybe [EnhancedImageScanFinding],
    -- | The image vulnerability counts, sorted by severity.
    ImageScanFindings -> Maybe (HashMap FindingSeverity Natural)
findingSeverityCounts :: Prelude.Maybe (Prelude.HashMap FindingSeverity Prelude.Natural),
    -- | The findings from the image scan.
    ImageScanFindings -> Maybe [ImageScanFinding]
findings :: Prelude.Maybe [ImageScanFinding],
    -- | The time of the last completed image scan.
    ImageScanFindings -> Maybe POSIX
imageScanCompletedAt :: Prelude.Maybe Data.POSIX,
    -- | The time when the vulnerability data was last scanned.
    ImageScanFindings -> Maybe POSIX
vulnerabilitySourceUpdatedAt :: Prelude.Maybe Data.POSIX
  }
  deriving (ImageScanFindings -> ImageScanFindings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageScanFindings -> ImageScanFindings -> Bool
$c/= :: ImageScanFindings -> ImageScanFindings -> Bool
== :: ImageScanFindings -> ImageScanFindings -> Bool
$c== :: ImageScanFindings -> ImageScanFindings -> Bool
Prelude.Eq, ReadPrec [ImageScanFindings]
ReadPrec ImageScanFindings
Int -> ReadS ImageScanFindings
ReadS [ImageScanFindings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImageScanFindings]
$creadListPrec :: ReadPrec [ImageScanFindings]
readPrec :: ReadPrec ImageScanFindings
$creadPrec :: ReadPrec ImageScanFindings
readList :: ReadS [ImageScanFindings]
$creadList :: ReadS [ImageScanFindings]
readsPrec :: Int -> ReadS ImageScanFindings
$creadsPrec :: Int -> ReadS ImageScanFindings
Prelude.Read, Int -> ImageScanFindings -> ShowS
[ImageScanFindings] -> ShowS
ImageScanFindings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImageScanFindings] -> ShowS
$cshowList :: [ImageScanFindings] -> ShowS
show :: ImageScanFindings -> String
$cshow :: ImageScanFindings -> String
showsPrec :: Int -> ImageScanFindings -> ShowS
$cshowsPrec :: Int -> ImageScanFindings -> ShowS
Prelude.Show, forall x. Rep ImageScanFindings x -> ImageScanFindings
forall x. ImageScanFindings -> Rep ImageScanFindings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageScanFindings x -> ImageScanFindings
$cfrom :: forall x. ImageScanFindings -> Rep ImageScanFindings x
Prelude.Generic)

-- |
-- Create a value of 'ImageScanFindings' 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:
--
-- 'enhancedFindings', 'imageScanFindings_enhancedFindings' - Details about the enhanced scan findings from Amazon Inspector.
--
-- 'findingSeverityCounts', 'imageScanFindings_findingSeverityCounts' - The image vulnerability counts, sorted by severity.
--
-- 'findings', 'imageScanFindings_findings' - The findings from the image scan.
--
-- 'imageScanCompletedAt', 'imageScanFindings_imageScanCompletedAt' - The time of the last completed image scan.
--
-- 'vulnerabilitySourceUpdatedAt', 'imageScanFindings_vulnerabilitySourceUpdatedAt' - The time when the vulnerability data was last scanned.
newImageScanFindings ::
  ImageScanFindings
newImageScanFindings :: ImageScanFindings
newImageScanFindings =
  ImageScanFindings'
    { $sel:enhancedFindings:ImageScanFindings' :: Maybe [EnhancedImageScanFinding]
enhancedFindings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:findingSeverityCounts:ImageScanFindings' :: Maybe (HashMap FindingSeverity Natural)
findingSeverityCounts = forall a. Maybe a
Prelude.Nothing,
      $sel:findings:ImageScanFindings' :: Maybe [ImageScanFinding]
findings = forall a. Maybe a
Prelude.Nothing,
      $sel:imageScanCompletedAt:ImageScanFindings' :: Maybe POSIX
imageScanCompletedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:vulnerabilitySourceUpdatedAt:ImageScanFindings' :: Maybe POSIX
vulnerabilitySourceUpdatedAt = forall a. Maybe a
Prelude.Nothing
    }

-- | Details about the enhanced scan findings from Amazon Inspector.
imageScanFindings_enhancedFindings :: Lens.Lens' ImageScanFindings (Prelude.Maybe [EnhancedImageScanFinding])
imageScanFindings_enhancedFindings :: Lens' ImageScanFindings (Maybe [EnhancedImageScanFinding])
imageScanFindings_enhancedFindings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImageScanFindings' {Maybe [EnhancedImageScanFinding]
enhancedFindings :: Maybe [EnhancedImageScanFinding]
$sel:enhancedFindings:ImageScanFindings' :: ImageScanFindings -> Maybe [EnhancedImageScanFinding]
enhancedFindings} -> Maybe [EnhancedImageScanFinding]
enhancedFindings) (\s :: ImageScanFindings
s@ImageScanFindings' {} Maybe [EnhancedImageScanFinding]
a -> ImageScanFindings
s {$sel:enhancedFindings:ImageScanFindings' :: Maybe [EnhancedImageScanFinding]
enhancedFindings = Maybe [EnhancedImageScanFinding]
a} :: ImageScanFindings) 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 image vulnerability counts, sorted by severity.
imageScanFindings_findingSeverityCounts :: Lens.Lens' ImageScanFindings (Prelude.Maybe (Prelude.HashMap FindingSeverity Prelude.Natural))
imageScanFindings_findingSeverityCounts :: Lens' ImageScanFindings (Maybe (HashMap FindingSeverity Natural))
imageScanFindings_findingSeverityCounts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImageScanFindings' {Maybe (HashMap FindingSeverity Natural)
findingSeverityCounts :: Maybe (HashMap FindingSeverity Natural)
$sel:findingSeverityCounts:ImageScanFindings' :: ImageScanFindings -> Maybe (HashMap FindingSeverity Natural)
findingSeverityCounts} -> Maybe (HashMap FindingSeverity Natural)
findingSeverityCounts) (\s :: ImageScanFindings
s@ImageScanFindings' {} Maybe (HashMap FindingSeverity Natural)
a -> ImageScanFindings
s {$sel:findingSeverityCounts:ImageScanFindings' :: Maybe (HashMap FindingSeverity Natural)
findingSeverityCounts = Maybe (HashMap FindingSeverity Natural)
a} :: ImageScanFindings) 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 findings from the image scan.
imageScanFindings_findings :: Lens.Lens' ImageScanFindings (Prelude.Maybe [ImageScanFinding])
imageScanFindings_findings :: Lens' ImageScanFindings (Maybe [ImageScanFinding])
imageScanFindings_findings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImageScanFindings' {Maybe [ImageScanFinding]
findings :: Maybe [ImageScanFinding]
$sel:findings:ImageScanFindings' :: ImageScanFindings -> Maybe [ImageScanFinding]
findings} -> Maybe [ImageScanFinding]
findings) (\s :: ImageScanFindings
s@ImageScanFindings' {} Maybe [ImageScanFinding]
a -> ImageScanFindings
s {$sel:findings:ImageScanFindings' :: Maybe [ImageScanFinding]
findings = Maybe [ImageScanFinding]
a} :: ImageScanFindings) 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 time of the last completed image scan.
imageScanFindings_imageScanCompletedAt :: Lens.Lens' ImageScanFindings (Prelude.Maybe Prelude.UTCTime)
imageScanFindings_imageScanCompletedAt :: Lens' ImageScanFindings (Maybe UTCTime)
imageScanFindings_imageScanCompletedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImageScanFindings' {Maybe POSIX
imageScanCompletedAt :: Maybe POSIX
$sel:imageScanCompletedAt:ImageScanFindings' :: ImageScanFindings -> Maybe POSIX
imageScanCompletedAt} -> Maybe POSIX
imageScanCompletedAt) (\s :: ImageScanFindings
s@ImageScanFindings' {} Maybe POSIX
a -> ImageScanFindings
s {$sel:imageScanCompletedAt:ImageScanFindings' :: Maybe POSIX
imageScanCompletedAt = Maybe POSIX
a} :: ImageScanFindings) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time when the vulnerability data was last scanned.
imageScanFindings_vulnerabilitySourceUpdatedAt :: Lens.Lens' ImageScanFindings (Prelude.Maybe Prelude.UTCTime)
imageScanFindings_vulnerabilitySourceUpdatedAt :: Lens' ImageScanFindings (Maybe UTCTime)
imageScanFindings_vulnerabilitySourceUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImageScanFindings' {Maybe POSIX
vulnerabilitySourceUpdatedAt :: Maybe POSIX
$sel:vulnerabilitySourceUpdatedAt:ImageScanFindings' :: ImageScanFindings -> Maybe POSIX
vulnerabilitySourceUpdatedAt} -> Maybe POSIX
vulnerabilitySourceUpdatedAt) (\s :: ImageScanFindings
s@ImageScanFindings' {} Maybe POSIX
a -> ImageScanFindings
s {$sel:vulnerabilitySourceUpdatedAt:ImageScanFindings' :: Maybe POSIX
vulnerabilitySourceUpdatedAt = Maybe POSIX
a} :: ImageScanFindings) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Data.FromJSON ImageScanFindings where
  parseJSON :: Value -> Parser ImageScanFindings
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ImageScanFindings"
      ( \Object
x ->
          Maybe [EnhancedImageScanFinding]
-> Maybe (HashMap FindingSeverity Natural)
-> Maybe [ImageScanFinding]
-> Maybe POSIX
-> Maybe POSIX
-> ImageScanFindings
ImageScanFindings'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"enhancedFindings"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"findingSeverityCounts"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"findings" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"imageScanCompletedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"vulnerabilitySourceUpdatedAt")
      )

instance Prelude.Hashable ImageScanFindings where
  hashWithSalt :: Int -> ImageScanFindings -> Int
hashWithSalt Int
_salt ImageScanFindings' {Maybe [ImageScanFinding]
Maybe [EnhancedImageScanFinding]
Maybe (HashMap FindingSeverity Natural)
Maybe POSIX
vulnerabilitySourceUpdatedAt :: Maybe POSIX
imageScanCompletedAt :: Maybe POSIX
findings :: Maybe [ImageScanFinding]
findingSeverityCounts :: Maybe (HashMap FindingSeverity Natural)
enhancedFindings :: Maybe [EnhancedImageScanFinding]
$sel:vulnerabilitySourceUpdatedAt:ImageScanFindings' :: ImageScanFindings -> Maybe POSIX
$sel:imageScanCompletedAt:ImageScanFindings' :: ImageScanFindings -> Maybe POSIX
$sel:findings:ImageScanFindings' :: ImageScanFindings -> Maybe [ImageScanFinding]
$sel:findingSeverityCounts:ImageScanFindings' :: ImageScanFindings -> Maybe (HashMap FindingSeverity Natural)
$sel:enhancedFindings:ImageScanFindings' :: ImageScanFindings -> Maybe [EnhancedImageScanFinding]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EnhancedImageScanFinding]
enhancedFindings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap FindingSeverity Natural)
findingSeverityCounts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ImageScanFinding]
findings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
imageScanCompletedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
vulnerabilitySourceUpdatedAt

instance Prelude.NFData ImageScanFindings where
  rnf :: ImageScanFindings -> ()
rnf ImageScanFindings' {Maybe [ImageScanFinding]
Maybe [EnhancedImageScanFinding]
Maybe (HashMap FindingSeverity Natural)
Maybe POSIX
vulnerabilitySourceUpdatedAt :: Maybe POSIX
imageScanCompletedAt :: Maybe POSIX
findings :: Maybe [ImageScanFinding]
findingSeverityCounts :: Maybe (HashMap FindingSeverity Natural)
enhancedFindings :: Maybe [EnhancedImageScanFinding]
$sel:vulnerabilitySourceUpdatedAt:ImageScanFindings' :: ImageScanFindings -> Maybe POSIX
$sel:imageScanCompletedAt:ImageScanFindings' :: ImageScanFindings -> Maybe POSIX
$sel:findings:ImageScanFindings' :: ImageScanFindings -> Maybe [ImageScanFinding]
$sel:findingSeverityCounts:ImageScanFindings' :: ImageScanFindings -> Maybe (HashMap FindingSeverity Natural)
$sel:enhancedFindings:ImageScanFindings' :: ImageScanFindings -> Maybe [EnhancedImageScanFinding]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EnhancedImageScanFinding]
enhancedFindings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap FindingSeverity Natural)
findingSeverityCounts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ImageScanFinding]
findings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
imageScanCompletedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
vulnerabilitySourceUpdatedAt