{-# 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.MacieV2.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.MacieV2.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.MacieV2.Types.ClassificationDetails
import Amazonka.MacieV2.Types.FindingCategory
import Amazonka.MacieV2.Types.FindingType
import Amazonka.MacieV2.Types.PolicyDetails
import Amazonka.MacieV2.Types.ResourcesAffected
import Amazonka.MacieV2.Types.Severity
import qualified Amazonka.Prelude as Prelude

-- | Provides the details of a finding.
--
-- /See:/ 'newFinding' smart constructor.
data Finding = Finding'
  { -- | The unique identifier for the Amazon Web Services account that the
    -- finding applies to. This is typically the account that owns the affected
    -- resource.
    Finding -> Maybe Text
accountId :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether the finding is archived (suppressed).
    Finding -> Maybe Bool
archived :: Prelude.Maybe Prelude.Bool,
    -- | The category of the finding. Possible values are: CLASSIFICATION, for a
    -- sensitive data finding; and, POLICY, for a policy finding.
    Finding -> Maybe FindingCategory
category :: Prelude.Maybe FindingCategory,
    -- | The details of a sensitive data finding. This value is null for a policy
    -- finding.
    Finding -> Maybe ClassificationDetails
classificationDetails :: Prelude.Maybe ClassificationDetails,
    -- | The total number of occurrences of the finding. For sensitive data
    -- findings, this value is always 1. All sensitive data findings are
    -- considered unique.
    Finding -> Maybe Integer
count :: Prelude.Maybe Prelude.Integer,
    -- | The date and time, in UTC and extended ISO 8601 format, when Amazon
    -- Macie created the finding.
    Finding -> Maybe ISO8601
createdAt :: Prelude.Maybe Data.ISO8601,
    -- | The description of the finding.
    Finding -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the finding. This is a random string that
    -- Amazon Macie generates and assigns to a finding when it creates the
    -- finding.
    Finding -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services partition that Amazon Macie created the finding
    -- in.
    Finding -> Maybe Text
partition :: Prelude.Maybe Prelude.Text,
    -- | The details of a policy finding. This value is null for a sensitive data
    -- finding.
    Finding -> Maybe PolicyDetails
policyDetails :: Prelude.Maybe PolicyDetails,
    -- | The Amazon Web Services Region that Amazon Macie created the finding in.
    Finding -> Maybe Text
region :: Prelude.Maybe Prelude.Text,
    -- | The resources that the finding applies to.
    Finding -> Maybe ResourcesAffected
resourcesAffected :: Prelude.Maybe ResourcesAffected,
    -- | Specifies whether the finding is a sample finding. A /sample finding/ is
    -- a finding that uses example data to demonstrate what a finding might
    -- contain.
    Finding -> Maybe Bool
sample :: Prelude.Maybe Prelude.Bool,
    -- | The version of the schema that was used to define the data structures in
    -- the finding.
    Finding -> Maybe Text
schemaVersion :: Prelude.Maybe Prelude.Text,
    -- | The severity level and score for the finding.
    Finding -> Maybe Severity
severity :: Prelude.Maybe Severity,
    -- | The brief description of the finding.
    Finding -> Maybe Text
title :: Prelude.Maybe Prelude.Text,
    -- | The type of the finding.
    Finding -> Maybe FindingType
type' :: Prelude.Maybe FindingType,
    -- | The date and time, in UTC and extended ISO 8601 format, when Amazon
    -- Macie last updated the finding. For sensitive data findings, this value
    -- is the same as the value for the createdAt property. All sensitive data
    -- findings are considered new.
    Finding -> Maybe ISO8601
updatedAt :: Prelude.Maybe Data.ISO8601
  }
  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:
--
-- 'accountId', 'finding_accountId' - The unique identifier for the Amazon Web Services account that the
-- finding applies to. This is typically the account that owns the affected
-- resource.
--
-- 'archived', 'finding_archived' - Specifies whether the finding is archived (suppressed).
--
-- 'category', 'finding_category' - The category of the finding. Possible values are: CLASSIFICATION, for a
-- sensitive data finding; and, POLICY, for a policy finding.
--
-- 'classificationDetails', 'finding_classificationDetails' - The details of a sensitive data finding. This value is null for a policy
-- finding.
--
-- 'count', 'finding_count' - The total number of occurrences of the finding. For sensitive data
-- findings, this value is always 1. All sensitive data findings are
-- considered unique.
--
-- 'createdAt', 'finding_createdAt' - The date and time, in UTC and extended ISO 8601 format, when Amazon
-- Macie created the finding.
--
-- 'description', 'finding_description' - The description of the finding.
--
-- 'id', 'finding_id' - The unique identifier for the finding. This is a random string that
-- Amazon Macie generates and assigns to a finding when it creates the
-- finding.
--
-- 'partition', 'finding_partition' - The Amazon Web Services partition that Amazon Macie created the finding
-- in.
--
-- 'policyDetails', 'finding_policyDetails' - The details of a policy finding. This value is null for a sensitive data
-- finding.
--
-- 'region', 'finding_region' - The Amazon Web Services Region that Amazon Macie created the finding in.
--
-- 'resourcesAffected', 'finding_resourcesAffected' - The resources that the finding applies to.
--
-- 'sample', 'finding_sample' - Specifies whether the finding is a sample finding. A /sample finding/ is
-- a finding that uses example data to demonstrate what a finding might
-- contain.
--
-- 'schemaVersion', 'finding_schemaVersion' - The version of the schema that was used to define the data structures in
-- the finding.
--
-- 'severity', 'finding_severity' - The severity level and score for the finding.
--
-- 'title', 'finding_title' - The brief description of the finding.
--
-- 'type'', 'finding_type' - The type of the finding.
--
-- 'updatedAt', 'finding_updatedAt' - The date and time, in UTC and extended ISO 8601 format, when Amazon
-- Macie last updated the finding. For sensitive data findings, this value
-- is the same as the value for the createdAt property. All sensitive data
-- findings are considered new.
newFinding ::
  Finding
newFinding :: Finding
newFinding =
  Finding'
    { $sel:accountId:Finding' :: Maybe Text
accountId = forall a. Maybe a
Prelude.Nothing,
      $sel:archived:Finding' :: Maybe Bool
archived = forall a. Maybe a
Prelude.Nothing,
      $sel:category:Finding' :: Maybe FindingCategory
category = forall a. Maybe a
Prelude.Nothing,
      $sel:classificationDetails:Finding' :: Maybe ClassificationDetails
classificationDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:count:Finding' :: Maybe Integer
count = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:Finding' :: Maybe ISO8601
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:description:Finding' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Finding' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:partition:Finding' :: Maybe Text
partition = forall a. Maybe a
Prelude.Nothing,
      $sel:policyDetails:Finding' :: Maybe PolicyDetails
policyDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:region:Finding' :: Maybe Text
region = forall a. Maybe a
Prelude.Nothing,
      $sel:resourcesAffected:Finding' :: Maybe ResourcesAffected
resourcesAffected = forall a. Maybe a
Prelude.Nothing,
      $sel:sample:Finding' :: Maybe Bool
sample = forall a. Maybe a
Prelude.Nothing,
      $sel:schemaVersion:Finding' :: Maybe Text
schemaVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:severity:Finding' :: Maybe Severity
severity = forall a. Maybe a
Prelude.Nothing,
      $sel:title:Finding' :: Maybe Text
title = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Finding' :: Maybe FindingType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:updatedAt:Finding' :: Maybe ISO8601
updatedAt = forall a. Maybe a
Prelude.Nothing
    }

-- | The unique identifier for the Amazon Web Services account that the
-- finding applies to. This is typically the account that owns the affected
-- resource.
finding_accountId :: Lens.Lens' Finding (Prelude.Maybe Prelude.Text)
finding_accountId :: Lens' Finding (Maybe Text)
finding_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Text
accountId :: Maybe Text
$sel:accountId:Finding' :: Finding -> Maybe Text
accountId} -> Maybe Text
accountId) (\s :: Finding
s@Finding' {} Maybe Text
a -> Finding
s {$sel:accountId:Finding' :: Maybe Text
accountId = Maybe Text
a} :: Finding)

-- | Specifies whether the finding is archived (suppressed).
finding_archived :: Lens.Lens' Finding (Prelude.Maybe Prelude.Bool)
finding_archived :: Lens' Finding (Maybe Bool)
finding_archived = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Bool
archived :: Maybe Bool
$sel:archived:Finding' :: Finding -> Maybe Bool
archived} -> Maybe Bool
archived) (\s :: Finding
s@Finding' {} Maybe Bool
a -> Finding
s {$sel:archived:Finding' :: Maybe Bool
archived = Maybe Bool
a} :: Finding)

-- | The category of the finding. Possible values are: CLASSIFICATION, for a
-- sensitive data finding; and, POLICY, for a policy finding.
finding_category :: Lens.Lens' Finding (Prelude.Maybe FindingCategory)
finding_category :: Lens' Finding (Maybe FindingCategory)
finding_category = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe FindingCategory
category :: Maybe FindingCategory
$sel:category:Finding' :: Finding -> Maybe FindingCategory
category} -> Maybe FindingCategory
category) (\s :: Finding
s@Finding' {} Maybe FindingCategory
a -> Finding
s {$sel:category:Finding' :: Maybe FindingCategory
category = Maybe FindingCategory
a} :: Finding)

-- | The details of a sensitive data finding. This value is null for a policy
-- finding.
finding_classificationDetails :: Lens.Lens' Finding (Prelude.Maybe ClassificationDetails)
finding_classificationDetails :: Lens' Finding (Maybe ClassificationDetails)
finding_classificationDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe ClassificationDetails
classificationDetails :: Maybe ClassificationDetails
$sel:classificationDetails:Finding' :: Finding -> Maybe ClassificationDetails
classificationDetails} -> Maybe ClassificationDetails
classificationDetails) (\s :: Finding
s@Finding' {} Maybe ClassificationDetails
a -> Finding
s {$sel:classificationDetails:Finding' :: Maybe ClassificationDetails
classificationDetails = Maybe ClassificationDetails
a} :: Finding)

-- | The total number of occurrences of the finding. For sensitive data
-- findings, this value is always 1. All sensitive data findings are
-- considered unique.
finding_count :: Lens.Lens' Finding (Prelude.Maybe Prelude.Integer)
finding_count :: Lens' Finding (Maybe Integer)
finding_count = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Integer
count :: Maybe Integer
$sel:count:Finding' :: Finding -> Maybe Integer
count} -> Maybe Integer
count) (\s :: Finding
s@Finding' {} Maybe Integer
a -> Finding
s {$sel:count:Finding' :: Maybe Integer
count = Maybe Integer
a} :: Finding)

-- | The date and time, in UTC and extended ISO 8601 format, when Amazon
-- Macie created the finding.
finding_createdAt :: Lens.Lens' Finding (Prelude.Maybe Prelude.UTCTime)
finding_createdAt :: Lens' Finding (Maybe UTCTime)
finding_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe ISO8601
createdAt :: Maybe ISO8601
$sel:createdAt:Finding' :: Finding -> Maybe ISO8601
createdAt} -> Maybe ISO8601
createdAt) (\s :: Finding
s@Finding' {} Maybe ISO8601
a -> Finding
s {$sel:createdAt:Finding' :: Maybe ISO8601
createdAt = Maybe ISO8601
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 description of the finding.
finding_description :: Lens.Lens' Finding (Prelude.Maybe Prelude.Text)
finding_description :: Lens' Finding (Maybe Text)
finding_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Text
description :: Maybe Text
$sel:description:Finding' :: Finding -> Maybe Text
description} -> Maybe Text
description) (\s :: Finding
s@Finding' {} Maybe Text
a -> Finding
s {$sel:description:Finding' :: Maybe Text
description = Maybe Text
a} :: Finding)

-- | The unique identifier for the finding. This is a random string that
-- Amazon Macie generates and assigns to a finding when it creates the
-- finding.
finding_id :: Lens.Lens' Finding (Prelude.Maybe Prelude.Text)
finding_id :: Lens' Finding (Maybe Text)
finding_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Text
id :: Maybe Text
$sel:id:Finding' :: Finding -> Maybe Text
id} -> Maybe Text
id) (\s :: Finding
s@Finding' {} Maybe Text
a -> Finding
s {$sel:id:Finding' :: Maybe Text
id = Maybe Text
a} :: Finding)

-- | The Amazon Web Services partition that Amazon Macie created the finding
-- in.
finding_partition :: Lens.Lens' Finding (Prelude.Maybe Prelude.Text)
finding_partition :: Lens' Finding (Maybe Text)
finding_partition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Text
partition :: Maybe Text
$sel:partition:Finding' :: Finding -> Maybe Text
partition} -> Maybe Text
partition) (\s :: Finding
s@Finding' {} Maybe Text
a -> Finding
s {$sel:partition:Finding' :: Maybe Text
partition = Maybe Text
a} :: Finding)

-- | The details of a policy finding. This value is null for a sensitive data
-- finding.
finding_policyDetails :: Lens.Lens' Finding (Prelude.Maybe PolicyDetails)
finding_policyDetails :: Lens' Finding (Maybe PolicyDetails)
finding_policyDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe PolicyDetails
policyDetails :: Maybe PolicyDetails
$sel:policyDetails:Finding' :: Finding -> Maybe PolicyDetails
policyDetails} -> Maybe PolicyDetails
policyDetails) (\s :: Finding
s@Finding' {} Maybe PolicyDetails
a -> Finding
s {$sel:policyDetails:Finding' :: Maybe PolicyDetails
policyDetails = Maybe PolicyDetails
a} :: Finding)

-- | The Amazon Web Services Region that Amazon Macie created the finding in.
finding_region :: Lens.Lens' Finding (Prelude.Maybe Prelude.Text)
finding_region :: Lens' Finding (Maybe Text)
finding_region = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Text
region :: Maybe Text
$sel:region:Finding' :: Finding -> Maybe Text
region} -> Maybe Text
region) (\s :: Finding
s@Finding' {} Maybe Text
a -> Finding
s {$sel:region:Finding' :: Maybe Text
region = Maybe Text
a} :: Finding)

-- | The resources that the finding applies to.
finding_resourcesAffected :: Lens.Lens' Finding (Prelude.Maybe ResourcesAffected)
finding_resourcesAffected :: Lens' Finding (Maybe ResourcesAffected)
finding_resourcesAffected = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe ResourcesAffected
resourcesAffected :: Maybe ResourcesAffected
$sel:resourcesAffected:Finding' :: Finding -> Maybe ResourcesAffected
resourcesAffected} -> Maybe ResourcesAffected
resourcesAffected) (\s :: Finding
s@Finding' {} Maybe ResourcesAffected
a -> Finding
s {$sel:resourcesAffected:Finding' :: Maybe ResourcesAffected
resourcesAffected = Maybe ResourcesAffected
a} :: Finding)

-- | Specifies whether the finding is a sample finding. A /sample finding/ is
-- a finding that uses example data to demonstrate what a finding might
-- contain.
finding_sample :: Lens.Lens' Finding (Prelude.Maybe Prelude.Bool)
finding_sample :: Lens' Finding (Maybe Bool)
finding_sample = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Bool
sample :: Maybe Bool
$sel:sample:Finding' :: Finding -> Maybe Bool
sample} -> Maybe Bool
sample) (\s :: Finding
s@Finding' {} Maybe Bool
a -> Finding
s {$sel:sample:Finding' :: Maybe Bool
sample = Maybe Bool
a} :: Finding)

-- | The version of the schema that was used to define the data structures in
-- the finding.
finding_schemaVersion :: Lens.Lens' Finding (Prelude.Maybe Prelude.Text)
finding_schemaVersion :: Lens' Finding (Maybe Text)
finding_schemaVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Text
schemaVersion :: Maybe Text
$sel:schemaVersion:Finding' :: Finding -> Maybe Text
schemaVersion} -> Maybe Text
schemaVersion) (\s :: Finding
s@Finding' {} Maybe Text
a -> Finding
s {$sel:schemaVersion:Finding' :: Maybe Text
schemaVersion = Maybe Text
a} :: Finding)

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

-- | The brief description 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 type of the finding.
finding_type :: Lens.Lens' Finding (Prelude.Maybe FindingType)
finding_type :: Lens' Finding (Maybe FindingType)
finding_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe FindingType
type' :: Maybe FindingType
$sel:type':Finding' :: Finding -> Maybe FindingType
type'} -> Maybe FindingType
type') (\s :: Finding
s@Finding' {} Maybe FindingType
a -> Finding
s {$sel:type':Finding' :: Maybe FindingType
type' = Maybe FindingType
a} :: Finding)

-- | The date and time, in UTC and extended ISO 8601 format, when Amazon
-- Macie last updated the finding. For sensitive data findings, this value
-- is the same as the value for the createdAt property. All sensitive data
-- findings are considered new.
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 ISO8601
updatedAt :: Maybe ISO8601
$sel:updatedAt:Finding' :: Finding -> Maybe ISO8601
updatedAt} -> Maybe ISO8601
updatedAt) (\s :: Finding
s@Finding' {} Maybe ISO8601
a -> Finding
s {$sel:updatedAt:Finding' :: Maybe ISO8601
updatedAt = Maybe ISO8601
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

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 Text
-> Maybe Bool
-> Maybe FindingCategory
-> Maybe ClassificationDetails
-> Maybe Integer
-> Maybe ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PolicyDetails
-> Maybe Text
-> Maybe ResourcesAffected
-> Maybe Bool
-> Maybe Text
-> Maybe Severity
-> Maybe Text
-> Maybe FindingType
-> Maybe ISO8601
-> 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
"accountId")
            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
"archived")
            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
"category")
            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
"classificationDetails")
            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
"count")
            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
"createdAt")
            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
"description")
            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
"id")
            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
"partition")
            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
"policyDetails")
            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
"region")
            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
"resourcesAffected")
            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
"sample")
            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
"schemaVersion")
            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
"severity")
            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
"type")
            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")
      )

instance Prelude.Hashable Finding where
  hashWithSalt :: Int -> Finding -> Int
hashWithSalt Int
_salt Finding' {Maybe Bool
Maybe Integer
Maybe Text
Maybe ISO8601
Maybe FindingCategory
Maybe FindingType
Maybe ClassificationDetails
Maybe Severity
Maybe ResourcesAffected
Maybe PolicyDetails
updatedAt :: Maybe ISO8601
type' :: Maybe FindingType
title :: Maybe Text
severity :: Maybe Severity
schemaVersion :: Maybe Text
sample :: Maybe Bool
resourcesAffected :: Maybe ResourcesAffected
region :: Maybe Text
policyDetails :: Maybe PolicyDetails
partition :: Maybe Text
id :: Maybe Text
description :: Maybe Text
createdAt :: Maybe ISO8601
count :: Maybe Integer
classificationDetails :: Maybe ClassificationDetails
category :: Maybe FindingCategory
archived :: Maybe Bool
accountId :: Maybe Text
$sel:updatedAt:Finding' :: Finding -> Maybe ISO8601
$sel:type':Finding' :: Finding -> Maybe FindingType
$sel:title:Finding' :: Finding -> Maybe Text
$sel:severity:Finding' :: Finding -> Maybe Severity
$sel:schemaVersion:Finding' :: Finding -> Maybe Text
$sel:sample:Finding' :: Finding -> Maybe Bool
$sel:resourcesAffected:Finding' :: Finding -> Maybe ResourcesAffected
$sel:region:Finding' :: Finding -> Maybe Text
$sel:policyDetails:Finding' :: Finding -> Maybe PolicyDetails
$sel:partition:Finding' :: Finding -> Maybe Text
$sel:id:Finding' :: Finding -> Maybe Text
$sel:description:Finding' :: Finding -> Maybe Text
$sel:createdAt:Finding' :: Finding -> Maybe ISO8601
$sel:count:Finding' :: Finding -> Maybe Integer
$sel:classificationDetails:Finding' :: Finding -> Maybe ClassificationDetails
$sel:category:Finding' :: Finding -> Maybe FindingCategory
$sel:archived:Finding' :: Finding -> Maybe Bool
$sel:accountId:Finding' :: Finding -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
archived
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FindingCategory
category
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClassificationDetails
classificationDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
count
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
partition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PolicyDetails
policyDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
region
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourcesAffected
resourcesAffected
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
sample
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
schemaVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Severity
severity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
title
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FindingType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
updatedAt

instance Prelude.NFData Finding where
  rnf :: Finding -> ()
rnf Finding' {Maybe Bool
Maybe Integer
Maybe Text
Maybe ISO8601
Maybe FindingCategory
Maybe FindingType
Maybe ClassificationDetails
Maybe Severity
Maybe ResourcesAffected
Maybe PolicyDetails
updatedAt :: Maybe ISO8601
type' :: Maybe FindingType
title :: Maybe Text
severity :: Maybe Severity
schemaVersion :: Maybe Text
sample :: Maybe Bool
resourcesAffected :: Maybe ResourcesAffected
region :: Maybe Text
policyDetails :: Maybe PolicyDetails
partition :: Maybe Text
id :: Maybe Text
description :: Maybe Text
createdAt :: Maybe ISO8601
count :: Maybe Integer
classificationDetails :: Maybe ClassificationDetails
category :: Maybe FindingCategory
archived :: Maybe Bool
accountId :: Maybe Text
$sel:updatedAt:Finding' :: Finding -> Maybe ISO8601
$sel:type':Finding' :: Finding -> Maybe FindingType
$sel:title:Finding' :: Finding -> Maybe Text
$sel:severity:Finding' :: Finding -> Maybe Severity
$sel:schemaVersion:Finding' :: Finding -> Maybe Text
$sel:sample:Finding' :: Finding -> Maybe Bool
$sel:resourcesAffected:Finding' :: Finding -> Maybe ResourcesAffected
$sel:region:Finding' :: Finding -> Maybe Text
$sel:policyDetails:Finding' :: Finding -> Maybe PolicyDetails
$sel:partition:Finding' :: Finding -> Maybe Text
$sel:id:Finding' :: Finding -> Maybe Text
$sel:description:Finding' :: Finding -> Maybe Text
$sel:createdAt:Finding' :: Finding -> Maybe ISO8601
$sel:count:Finding' :: Finding -> Maybe Integer
$sel:classificationDetails:Finding' :: Finding -> Maybe ClassificationDetails
$sel:category:Finding' :: Finding -> Maybe FindingCategory
$sel:archived:Finding' :: Finding -> Maybe Bool
$sel:accountId:Finding' :: Finding -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
archived
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FindingCategory
category
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClassificationDetails
classificationDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
count
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
partition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PolicyDetails
policyDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
region
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourcesAffected
resourcesAffected
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
sample
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schemaVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Severity
severity
      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 FindingType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
updatedAt