{-# 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.Inspector2.Types.Finding
-- 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.Inspector2.Types.Finding where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Inspector2.Types.ExploitAvailable
import Amazonka.Inspector2.Types.ExploitabilityDetails
import Amazonka.Inspector2.Types.FindingStatus
import Amazonka.Inspector2.Types.FindingType
import Amazonka.Inspector2.Types.FixAvailable
import Amazonka.Inspector2.Types.InspectorScoreDetails
import Amazonka.Inspector2.Types.NetworkReachabilityDetails
import Amazonka.Inspector2.Types.PackageVulnerabilityDetails
import Amazonka.Inspector2.Types.Remediation
import Amazonka.Inspector2.Types.Resource
import Amazonka.Inspector2.Types.Severity
import qualified Amazonka.Prelude as Prelude

-- | Details about an Amazon Inspector finding.
--
-- /See:/ 'newFinding' smart constructor.
data Finding = Finding'
  { -- | If a finding discovered in your environment has an exploit available.
    Finding -> Maybe ExploitAvailable
exploitAvailable :: Prelude.Maybe ExploitAvailable,
    -- | The details of an exploit available for a finding discovered in your
    -- environment.
    Finding -> Maybe ExploitabilityDetails
exploitabilityDetails :: Prelude.Maybe ExploitabilityDetails,
    -- | Details on whether a fix is available through a version update. This
    -- value can be @YES@, @NO@, or @PARTIAL@. A @PARTIAL@ fix means that some,
    -- but not all, of the packages identified in the finding have fixes
    -- available through updated versions.
    Finding -> Maybe FixAvailable
fixAvailable :: Prelude.Maybe FixAvailable,
    -- | The Amazon Inspector score given to the finding.
    Finding -> Maybe Double
inspectorScore :: Prelude.Maybe Prelude.Double,
    -- | An object that contains details of the Amazon Inspector score.
    Finding -> Maybe InspectorScoreDetails
inspectorScoreDetails :: Prelude.Maybe InspectorScoreDetails,
    -- | An object that contains the details of a network reachability finding.
    Finding -> Maybe NetworkReachabilityDetails
networkReachabilityDetails :: Prelude.Maybe NetworkReachabilityDetails,
    -- | An object that contains the details of a package vulnerability finding.
    Finding -> Maybe PackageVulnerabilityDetails
packageVulnerabilityDetails :: Prelude.Maybe PackageVulnerabilityDetails,
    -- | The title of the finding.
    Finding -> Maybe Text
title :: Prelude.Maybe Prelude.Text,
    -- | The date and time the finding was last updated at.
    Finding -> Maybe POSIX
updatedAt :: Prelude.Maybe Data.POSIX,
    -- | The Amazon Web Services account ID associated with the finding.
    Finding -> Text
awsAccountId :: Prelude.Text,
    -- | The description of the finding.
    Finding -> Text
description :: Prelude.Text,
    -- | The Amazon Resource Number (ARN) of the finding.
    Finding -> Text
findingArn :: Prelude.Text,
    -- | The date and time that the finding was first observed.
    Finding -> POSIX
firstObservedAt :: Data.POSIX,
    -- | The date and time that the finding was last observed.
    Finding -> POSIX
lastObservedAt :: Data.POSIX,
    -- | An object that contains the details about how to remediate a finding.
    Finding -> Remediation
remediation :: Remediation,
    -- | Contains information on the resources involved in a finding.
    Finding -> NonEmpty Resource
resources :: Prelude.NonEmpty Resource,
    -- | The severity of the finding.
    Finding -> Severity
severity :: Severity,
    -- | The status of the finding.
    Finding -> FindingStatus
status :: FindingStatus,
    -- | The type of the finding.
    Finding -> FindingType
type' :: FindingType
  }
  deriving (Finding -> Finding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Finding -> Finding -> Bool
$c/= :: Finding -> Finding -> Bool
== :: Finding -> Finding -> Bool
$c== :: Finding -> Finding -> Bool
Prelude.Eq, ReadPrec [Finding]
ReadPrec Finding
Int -> ReadS Finding
ReadS [Finding]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Finding]
$creadListPrec :: ReadPrec [Finding]
readPrec :: ReadPrec Finding
$creadPrec :: ReadPrec Finding
readList :: ReadS [Finding]
$creadList :: ReadS [Finding]
readsPrec :: Int -> ReadS Finding
$creadsPrec :: Int -> ReadS Finding
Prelude.Read, Int -> Finding -> ShowS
[Finding] -> ShowS
Finding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Finding] -> ShowS
$cshowList :: [Finding] -> ShowS
show :: Finding -> String
$cshow :: Finding -> String
showsPrec :: Int -> Finding -> ShowS
$cshowsPrec :: Int -> Finding -> ShowS
Prelude.Show, forall x. Rep Finding x -> Finding
forall x. Finding -> Rep Finding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Finding x -> Finding
$cfrom :: forall x. Finding -> Rep Finding x
Prelude.Generic)

-- |
-- Create a value of 'Finding' 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:
--
-- 'exploitAvailable', 'finding_exploitAvailable' - If a finding discovered in your environment has an exploit available.
--
-- 'exploitabilityDetails', 'finding_exploitabilityDetails' - The details of an exploit available for a finding discovered in your
-- environment.
--
-- 'fixAvailable', 'finding_fixAvailable' - Details on whether a fix is available through a version update. This
-- value can be @YES@, @NO@, or @PARTIAL@. A @PARTIAL@ fix means that some,
-- but not all, of the packages identified in the finding have fixes
-- available through updated versions.
--
-- 'inspectorScore', 'finding_inspectorScore' - The Amazon Inspector score given to the finding.
--
-- 'inspectorScoreDetails', 'finding_inspectorScoreDetails' - An object that contains details of the Amazon Inspector score.
--
-- 'networkReachabilityDetails', 'finding_networkReachabilityDetails' - An object that contains the details of a network reachability finding.
--
-- 'packageVulnerabilityDetails', 'finding_packageVulnerabilityDetails' - An object that contains the details of a package vulnerability finding.
--
-- 'title', 'finding_title' - The title of the finding.
--
-- 'updatedAt', 'finding_updatedAt' - The date and time the finding was last updated at.
--
-- 'awsAccountId', 'finding_awsAccountId' - The Amazon Web Services account ID associated with the finding.
--
-- 'description', 'finding_description' - The description of the finding.
--
-- 'findingArn', 'finding_findingArn' - The Amazon Resource Number (ARN) of the finding.
--
-- 'firstObservedAt', 'finding_firstObservedAt' - The date and time that the finding was first observed.
--
-- 'lastObservedAt', 'finding_lastObservedAt' - The date and time that the finding was last observed.
--
-- 'remediation', 'finding_remediation' - An object that contains the details about how to remediate a finding.
--
-- 'resources', 'finding_resources' - Contains information on the resources involved in a finding.
--
-- 'severity', 'finding_severity' - The severity of the finding.
--
-- 'status', 'finding_status' - The status of the finding.
--
-- 'type'', 'finding_type' - The type of the finding.
newFinding ::
  -- | 'awsAccountId'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  -- | 'findingArn'
  Prelude.Text ->
  -- | 'firstObservedAt'
  Prelude.UTCTime ->
  -- | 'lastObservedAt'
  Prelude.UTCTime ->
  -- | 'remediation'
  Remediation ->
  -- | 'resources'
  Prelude.NonEmpty Resource ->
  -- | 'severity'
  Severity ->
  -- | 'status'
  FindingStatus ->
  -- | 'type''
  FindingType ->
  Finding
newFinding :: Text
-> Text
-> Text
-> UTCTime
-> UTCTime
-> Remediation
-> NonEmpty Resource
-> Severity
-> FindingStatus
-> FindingType
-> Finding
newFinding
  Text
pAwsAccountId_
  Text
pDescription_
  Text
pFindingArn_
  UTCTime
pFirstObservedAt_
  UTCTime
pLastObservedAt_
  Remediation
pRemediation_
  NonEmpty Resource
pResources_
  Severity
pSeverity_
  FindingStatus
pStatus_
  FindingType
pType_ =
    Finding'
      { $sel:exploitAvailable:Finding' :: Maybe ExploitAvailable
exploitAvailable = forall a. Maybe a
Prelude.Nothing,
        $sel:exploitabilityDetails:Finding' :: Maybe ExploitabilityDetails
exploitabilityDetails = forall a. Maybe a
Prelude.Nothing,
        $sel:fixAvailable:Finding' :: Maybe FixAvailable
fixAvailable = forall a. Maybe a
Prelude.Nothing,
        $sel:inspectorScore:Finding' :: Maybe Double
inspectorScore = forall a. Maybe a
Prelude.Nothing,
        $sel:inspectorScoreDetails:Finding' :: Maybe InspectorScoreDetails
inspectorScoreDetails = forall a. Maybe a
Prelude.Nothing,
        $sel:networkReachabilityDetails:Finding' :: Maybe NetworkReachabilityDetails
networkReachabilityDetails = forall a. Maybe a
Prelude.Nothing,
        $sel:packageVulnerabilityDetails:Finding' :: Maybe PackageVulnerabilityDetails
packageVulnerabilityDetails = forall a. Maybe a
Prelude.Nothing,
        $sel:title:Finding' :: Maybe Text
title = forall a. Maybe a
Prelude.Nothing,
        $sel:updatedAt:Finding' :: Maybe POSIX
updatedAt = forall a. Maybe a
Prelude.Nothing,
        $sel:awsAccountId:Finding' :: Text
awsAccountId = Text
pAwsAccountId_,
        $sel:description:Finding' :: Text
description = Text
pDescription_,
        $sel:findingArn:Finding' :: Text
findingArn = Text
pFindingArn_,
        $sel:firstObservedAt:Finding' :: POSIX
firstObservedAt =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pFirstObservedAt_,
        $sel:lastObservedAt:Finding' :: POSIX
lastObservedAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastObservedAt_,
        $sel:remediation:Finding' :: Remediation
remediation = Remediation
pRemediation_,
        $sel:resources:Finding' :: NonEmpty Resource
resources = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Resource
pResources_,
        $sel:severity:Finding' :: Severity
severity = Severity
pSeverity_,
        $sel:status:Finding' :: FindingStatus
status = FindingStatus
pStatus_,
        $sel:type':Finding' :: FindingType
type' = FindingType
pType_
      }

-- | If a finding discovered in your environment has an exploit available.
finding_exploitAvailable :: Lens.Lens' Finding (Prelude.Maybe ExploitAvailable)
finding_exploitAvailable :: Lens' Finding (Maybe ExploitAvailable)
finding_exploitAvailable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe ExploitAvailable
exploitAvailable :: Maybe ExploitAvailable
$sel:exploitAvailable:Finding' :: Finding -> Maybe ExploitAvailable
exploitAvailable} -> Maybe ExploitAvailable
exploitAvailable) (\s :: Finding
s@Finding' {} Maybe ExploitAvailable
a -> Finding
s {$sel:exploitAvailable:Finding' :: Maybe ExploitAvailable
exploitAvailable = Maybe ExploitAvailable
a} :: Finding)

-- | The details of an exploit available for a finding discovered in your
-- environment.
finding_exploitabilityDetails :: Lens.Lens' Finding (Prelude.Maybe ExploitabilityDetails)
finding_exploitabilityDetails :: Lens' Finding (Maybe ExploitabilityDetails)
finding_exploitabilityDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe ExploitabilityDetails
exploitabilityDetails :: Maybe ExploitabilityDetails
$sel:exploitabilityDetails:Finding' :: Finding -> Maybe ExploitabilityDetails
exploitabilityDetails} -> Maybe ExploitabilityDetails
exploitabilityDetails) (\s :: Finding
s@Finding' {} Maybe ExploitabilityDetails
a -> Finding
s {$sel:exploitabilityDetails:Finding' :: Maybe ExploitabilityDetails
exploitabilityDetails = Maybe ExploitabilityDetails
a} :: Finding)

-- | Details on whether a fix is available through a version update. This
-- value can be @YES@, @NO@, or @PARTIAL@. A @PARTIAL@ fix means that some,
-- but not all, of the packages identified in the finding have fixes
-- available through updated versions.
finding_fixAvailable :: Lens.Lens' Finding (Prelude.Maybe FixAvailable)
finding_fixAvailable :: Lens' Finding (Maybe FixAvailable)
finding_fixAvailable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe FixAvailable
fixAvailable :: Maybe FixAvailable
$sel:fixAvailable:Finding' :: Finding -> Maybe FixAvailable
fixAvailable} -> Maybe FixAvailable
fixAvailable) (\s :: Finding
s@Finding' {} Maybe FixAvailable
a -> Finding
s {$sel:fixAvailable:Finding' :: Maybe FixAvailable
fixAvailable = Maybe FixAvailable
a} :: Finding)

-- | The Amazon Inspector score given to the finding.
finding_inspectorScore :: Lens.Lens' Finding (Prelude.Maybe Prelude.Double)
finding_inspectorScore :: Lens' Finding (Maybe Double)
finding_inspectorScore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Double
inspectorScore :: Maybe Double
$sel:inspectorScore:Finding' :: Finding -> Maybe Double
inspectorScore} -> Maybe Double
inspectorScore) (\s :: Finding
s@Finding' {} Maybe Double
a -> Finding
s {$sel:inspectorScore:Finding' :: Maybe Double
inspectorScore = Maybe Double
a} :: Finding)

-- | An object that contains details of the Amazon Inspector score.
finding_inspectorScoreDetails :: Lens.Lens' Finding (Prelude.Maybe InspectorScoreDetails)
finding_inspectorScoreDetails :: Lens' Finding (Maybe InspectorScoreDetails)
finding_inspectorScoreDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe InspectorScoreDetails
inspectorScoreDetails :: Maybe InspectorScoreDetails
$sel:inspectorScoreDetails:Finding' :: Finding -> Maybe InspectorScoreDetails
inspectorScoreDetails} -> Maybe InspectorScoreDetails
inspectorScoreDetails) (\s :: Finding
s@Finding' {} Maybe InspectorScoreDetails
a -> Finding
s {$sel:inspectorScoreDetails:Finding' :: Maybe InspectorScoreDetails
inspectorScoreDetails = Maybe InspectorScoreDetails
a} :: Finding)

-- | An object that contains the details of a network reachability finding.
finding_networkReachabilityDetails :: Lens.Lens' Finding (Prelude.Maybe NetworkReachabilityDetails)
finding_networkReachabilityDetails :: Lens' Finding (Maybe NetworkReachabilityDetails)
finding_networkReachabilityDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe NetworkReachabilityDetails
networkReachabilityDetails :: Maybe NetworkReachabilityDetails
$sel:networkReachabilityDetails:Finding' :: Finding -> Maybe NetworkReachabilityDetails
networkReachabilityDetails} -> Maybe NetworkReachabilityDetails
networkReachabilityDetails) (\s :: Finding
s@Finding' {} Maybe NetworkReachabilityDetails
a -> Finding
s {$sel:networkReachabilityDetails:Finding' :: Maybe NetworkReachabilityDetails
networkReachabilityDetails = Maybe NetworkReachabilityDetails
a} :: Finding)

-- | An object that contains the details of a package vulnerability finding.
finding_packageVulnerabilityDetails :: Lens.Lens' Finding (Prelude.Maybe PackageVulnerabilityDetails)
finding_packageVulnerabilityDetails :: Lens' Finding (Maybe PackageVulnerabilityDetails)
finding_packageVulnerabilityDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe PackageVulnerabilityDetails
packageVulnerabilityDetails :: Maybe PackageVulnerabilityDetails
$sel:packageVulnerabilityDetails:Finding' :: Finding -> Maybe PackageVulnerabilityDetails
packageVulnerabilityDetails} -> Maybe PackageVulnerabilityDetails
packageVulnerabilityDetails) (\s :: Finding
s@Finding' {} Maybe PackageVulnerabilityDetails
a -> Finding
s {$sel:packageVulnerabilityDetails:Finding' :: Maybe PackageVulnerabilityDetails
packageVulnerabilityDetails = Maybe PackageVulnerabilityDetails
a} :: Finding)

-- | The title of the finding.
finding_title :: Lens.Lens' Finding (Prelude.Maybe Prelude.Text)
finding_title :: Lens' Finding (Maybe Text)
finding_title = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Text
title :: Maybe Text
$sel:title:Finding' :: Finding -> Maybe Text
title} -> Maybe Text
title) (\s :: Finding
s@Finding' {} Maybe Text
a -> Finding
s {$sel:title:Finding' :: Maybe Text
title = Maybe Text
a} :: Finding)

-- | The date and time the finding was last updated at.
finding_updatedAt :: Lens.Lens' Finding (Prelude.Maybe Prelude.UTCTime)
finding_updatedAt :: Lens' Finding (Maybe UTCTime)
finding_updatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe POSIX
updatedAt :: Maybe POSIX
$sel:updatedAt:Finding' :: Finding -> Maybe POSIX
updatedAt} -> Maybe POSIX
updatedAt) (\s :: Finding
s@Finding' {} Maybe POSIX
a -> Finding
s {$sel:updatedAt:Finding' :: Maybe POSIX
updatedAt = Maybe POSIX
a} :: Finding) 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 Amazon Web Services account ID associated with the finding.
finding_awsAccountId :: Lens.Lens' Finding Prelude.Text
finding_awsAccountId :: Lens' Finding Text
finding_awsAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Text
awsAccountId :: Text
$sel:awsAccountId:Finding' :: Finding -> Text
awsAccountId} -> Text
awsAccountId) (\s :: Finding
s@Finding' {} Text
a -> Finding
s {$sel:awsAccountId:Finding' :: Text
awsAccountId = Text
a} :: Finding)

-- | The description of the finding.
finding_description :: Lens.Lens' Finding Prelude.Text
finding_description :: Lens' Finding Text
finding_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Text
description :: Text
$sel:description:Finding' :: Finding -> Text
description} -> Text
description) (\s :: Finding
s@Finding' {} Text
a -> Finding
s {$sel:description:Finding' :: Text
description = Text
a} :: Finding)

-- | The Amazon Resource Number (ARN) of the finding.
finding_findingArn :: Lens.Lens' Finding Prelude.Text
finding_findingArn :: Lens' Finding Text
finding_findingArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Text
findingArn :: Text
$sel:findingArn:Finding' :: Finding -> Text
findingArn} -> Text
findingArn) (\s :: Finding
s@Finding' {} Text
a -> Finding
s {$sel:findingArn:Finding' :: Text
findingArn = Text
a} :: Finding)

-- | The date and time that the finding was first observed.
finding_firstObservedAt :: Lens.Lens' Finding Prelude.UTCTime
finding_firstObservedAt :: Lens' Finding UTCTime
finding_firstObservedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {POSIX
firstObservedAt :: POSIX
$sel:firstObservedAt:Finding' :: Finding -> POSIX
firstObservedAt} -> POSIX
firstObservedAt) (\s :: Finding
s@Finding' {} POSIX
a -> Finding
s {$sel:firstObservedAt:Finding' :: POSIX
firstObservedAt = POSIX
a} :: Finding) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The date and time that the finding was last observed.
finding_lastObservedAt :: Lens.Lens' Finding Prelude.UTCTime
finding_lastObservedAt :: Lens' Finding UTCTime
finding_lastObservedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {POSIX
lastObservedAt :: POSIX
$sel:lastObservedAt:Finding' :: Finding -> POSIX
lastObservedAt} -> POSIX
lastObservedAt) (\s :: Finding
s@Finding' {} POSIX
a -> Finding
s {$sel:lastObservedAt:Finding' :: POSIX
lastObservedAt = POSIX
a} :: Finding) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | An object that contains the details about how to remediate a finding.
finding_remediation :: Lens.Lens' Finding Remediation
finding_remediation :: Lens' Finding Remediation
finding_remediation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Remediation
remediation :: Remediation
$sel:remediation:Finding' :: Finding -> Remediation
remediation} -> Remediation
remediation) (\s :: Finding
s@Finding' {} Remediation
a -> Finding
s {$sel:remediation:Finding' :: Remediation
remediation = Remediation
a} :: Finding)

-- | Contains information on the resources involved in a finding.
finding_resources :: Lens.Lens' Finding (Prelude.NonEmpty Resource)
finding_resources :: Lens' Finding (NonEmpty Resource)
finding_resources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {NonEmpty Resource
resources :: NonEmpty Resource
$sel:resources:Finding' :: Finding -> NonEmpty Resource
resources} -> NonEmpty Resource
resources) (\s :: Finding
s@Finding' {} NonEmpty Resource
a -> Finding
s {$sel:resources:Finding' :: NonEmpty Resource
resources = NonEmpty Resource
a} :: Finding) 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

-- | The severity of the finding.
finding_severity :: Lens.Lens' Finding Severity
finding_severity :: Lens' Finding Severity
finding_severity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Severity
severity :: Severity
$sel:severity:Finding' :: Finding -> Severity
severity} -> Severity
severity) (\s :: Finding
s@Finding' {} Severity
a -> Finding
s {$sel:severity:Finding' :: Severity
severity = Severity
a} :: Finding)

-- | The status of the finding.
finding_status :: Lens.Lens' Finding FindingStatus
finding_status :: Lens' Finding FindingStatus
finding_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {FindingStatus
status :: FindingStatus
$sel:status:Finding' :: Finding -> FindingStatus
status} -> FindingStatus
status) (\s :: Finding
s@Finding' {} FindingStatus
a -> Finding
s {$sel:status:Finding' :: FindingStatus
status = FindingStatus
a} :: Finding)

-- | The type of the finding.
finding_type :: Lens.Lens' Finding FindingType
finding_type :: Lens' Finding FindingType
finding_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {FindingType
type' :: FindingType
$sel:type':Finding' :: Finding -> FindingType
type'} -> FindingType
type') (\s :: Finding
s@Finding' {} FindingType
a -> Finding
s {$sel:type':Finding' :: FindingType
type' = FindingType
a} :: Finding)

instance Data.FromJSON Finding where
  parseJSON :: Value -> Parser Finding
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Finding"
      ( \Object
x ->
          Maybe ExploitAvailable
-> Maybe ExploitabilityDetails
-> Maybe FixAvailable
-> Maybe Double
-> Maybe InspectorScoreDetails
-> Maybe NetworkReachabilityDetails
-> Maybe PackageVulnerabilityDetails
-> Maybe Text
-> Maybe POSIX
-> Text
-> Text
-> Text
-> POSIX
-> POSIX
-> Remediation
-> NonEmpty Resource
-> Severity
-> FindingStatus
-> FindingType
-> Finding
Finding'
            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
"exploitAvailable")
            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
"exploitabilityDetails")
            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
"fixAvailable")
            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
"inspectorScore")
            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
"inspectorScoreDetails")
            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
"networkReachabilityDetails")
            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
"packageVulnerabilityDetails")
            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
"title")
            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
"updatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"awsAccountId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"findingArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"firstObservedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"lastObservedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"remediation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"resources")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"severity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"type")
      )

instance Prelude.Hashable Finding where
  hashWithSalt :: Int -> Finding -> Int
hashWithSalt Int
_salt Finding' {Maybe Double
Maybe Text
Maybe POSIX
Maybe ExploitAvailable
Maybe ExploitabilityDetails
Maybe FixAvailable
Maybe InspectorScoreDetails
Maybe NetworkReachabilityDetails
Maybe PackageVulnerabilityDetails
NonEmpty Resource
Text
POSIX
FindingStatus
FindingType
Remediation
Severity
type' :: FindingType
status :: FindingStatus
severity :: Severity
resources :: NonEmpty Resource
remediation :: Remediation
lastObservedAt :: POSIX
firstObservedAt :: POSIX
findingArn :: Text
description :: Text
awsAccountId :: Text
updatedAt :: Maybe POSIX
title :: Maybe Text
packageVulnerabilityDetails :: Maybe PackageVulnerabilityDetails
networkReachabilityDetails :: Maybe NetworkReachabilityDetails
inspectorScoreDetails :: Maybe InspectorScoreDetails
inspectorScore :: Maybe Double
fixAvailable :: Maybe FixAvailable
exploitabilityDetails :: Maybe ExploitabilityDetails
exploitAvailable :: Maybe ExploitAvailable
$sel:type':Finding' :: Finding -> FindingType
$sel:status:Finding' :: Finding -> FindingStatus
$sel:severity:Finding' :: Finding -> Severity
$sel:resources:Finding' :: Finding -> NonEmpty Resource
$sel:remediation:Finding' :: Finding -> Remediation
$sel:lastObservedAt:Finding' :: Finding -> POSIX
$sel:firstObservedAt:Finding' :: Finding -> POSIX
$sel:findingArn:Finding' :: Finding -> Text
$sel:description:Finding' :: Finding -> Text
$sel:awsAccountId:Finding' :: Finding -> Text
$sel:updatedAt:Finding' :: Finding -> Maybe POSIX
$sel:title:Finding' :: Finding -> Maybe Text
$sel:packageVulnerabilityDetails:Finding' :: Finding -> Maybe PackageVulnerabilityDetails
$sel:networkReachabilityDetails:Finding' :: Finding -> Maybe NetworkReachabilityDetails
$sel:inspectorScoreDetails:Finding' :: Finding -> Maybe InspectorScoreDetails
$sel:inspectorScore:Finding' :: Finding -> Maybe Double
$sel:fixAvailable:Finding' :: Finding -> Maybe FixAvailable
$sel:exploitabilityDetails:Finding' :: Finding -> Maybe ExploitabilityDetails
$sel:exploitAvailable:Finding' :: Finding -> Maybe ExploitAvailable
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExploitAvailable
exploitAvailable
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExploitabilityDetails
exploitabilityDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FixAvailable
fixAvailable
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
inspectorScore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InspectorScoreDetails
inspectorScoreDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NetworkReachabilityDetails
networkReachabilityDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PackageVulnerabilityDetails
packageVulnerabilityDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
title
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
updatedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awsAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
findingArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
firstObservedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
lastObservedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Remediation
remediation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Resource
resources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Severity
severity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FindingStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FindingType
type'

instance Prelude.NFData Finding where
  rnf :: Finding -> ()
rnf Finding' {Maybe Double
Maybe Text
Maybe POSIX
Maybe ExploitAvailable
Maybe ExploitabilityDetails
Maybe FixAvailable
Maybe InspectorScoreDetails
Maybe NetworkReachabilityDetails
Maybe PackageVulnerabilityDetails
NonEmpty Resource
Text
POSIX
FindingStatus
FindingType
Remediation
Severity
type' :: FindingType
status :: FindingStatus
severity :: Severity
resources :: NonEmpty Resource
remediation :: Remediation
lastObservedAt :: POSIX
firstObservedAt :: POSIX
findingArn :: Text
description :: Text
awsAccountId :: Text
updatedAt :: Maybe POSIX
title :: Maybe Text
packageVulnerabilityDetails :: Maybe PackageVulnerabilityDetails
networkReachabilityDetails :: Maybe NetworkReachabilityDetails
inspectorScoreDetails :: Maybe InspectorScoreDetails
inspectorScore :: Maybe Double
fixAvailable :: Maybe FixAvailable
exploitabilityDetails :: Maybe ExploitabilityDetails
exploitAvailable :: Maybe ExploitAvailable
$sel:type':Finding' :: Finding -> FindingType
$sel:status:Finding' :: Finding -> FindingStatus
$sel:severity:Finding' :: Finding -> Severity
$sel:resources:Finding' :: Finding -> NonEmpty Resource
$sel:remediation:Finding' :: Finding -> Remediation
$sel:lastObservedAt:Finding' :: Finding -> POSIX
$sel:firstObservedAt:Finding' :: Finding -> POSIX
$sel:findingArn:Finding' :: Finding -> Text
$sel:description:Finding' :: Finding -> Text
$sel:awsAccountId:Finding' :: Finding -> Text
$sel:updatedAt:Finding' :: Finding -> Maybe POSIX
$sel:title:Finding' :: Finding -> Maybe Text
$sel:packageVulnerabilityDetails:Finding' :: Finding -> Maybe PackageVulnerabilityDetails
$sel:networkReachabilityDetails:Finding' :: Finding -> Maybe NetworkReachabilityDetails
$sel:inspectorScoreDetails:Finding' :: Finding -> Maybe InspectorScoreDetails
$sel:inspectorScore:Finding' :: Finding -> Maybe Double
$sel:fixAvailable:Finding' :: Finding -> Maybe FixAvailable
$sel:exploitabilityDetails:Finding' :: Finding -> Maybe ExploitabilityDetails
$sel:exploitAvailable:Finding' :: Finding -> Maybe ExploitAvailable
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ExploitAvailable
exploitAvailable
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExploitabilityDetails
exploitabilityDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FixAvailable
fixAvailable
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
inspectorScore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InspectorScoreDetails
inspectorScoreDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkReachabilityDetails
networkReachabilityDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PackageVulnerabilityDetails
packageVulnerabilityDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
title
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
updatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
awsAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
findingArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
firstObservedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastObservedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Remediation
remediation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Resource
resources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Severity
severity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FindingStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FindingType
type'