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

import Amazonka.AccessAnalyzer.Types.FindingSource
import Amazonka.AccessAnalyzer.Types.FindingStatus
import Amazonka.AccessAnalyzer.Types.ResourceType
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | Contains information about a finding.
--
-- /See:/ 'newFinding' smart constructor.
data Finding = Finding'
  { -- | The action in the analyzed policy statement that an external principal
    -- has permission to use.
    Finding -> Maybe [Text]
action :: Prelude.Maybe [Prelude.Text],
    -- | An error.
    Finding -> Maybe Text
error :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the policy that generated the finding allows public
    -- access to the resource.
    Finding -> Maybe Bool
isPublic :: Prelude.Maybe Prelude.Bool,
    -- | The external principal that access to a resource within the zone of
    -- trust.
    Finding -> Maybe (HashMap Text Text)
principal :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The resource that an external principal has access to.
    Finding -> Maybe Text
resource :: Prelude.Maybe Prelude.Text,
    -- | The sources of the finding. This indicates how the access that generated
    -- the finding is granted. It is populated for Amazon S3 bucket findings.
    Finding -> Maybe [FindingSource]
sources :: Prelude.Maybe [FindingSource],
    -- | The ID of the finding.
    Finding -> Text
id :: Prelude.Text,
    -- | The type of the resource identified in the finding.
    Finding -> ResourceType
resourceType :: ResourceType,
    -- | The condition in the analyzed policy statement that resulted in a
    -- finding.
    Finding -> HashMap Text Text
condition :: Prelude.HashMap Prelude.Text Prelude.Text,
    -- | The time at which the finding was generated.
    Finding -> ISO8601
createdAt :: Data.ISO8601,
    -- | The time at which the resource was analyzed.
    Finding -> ISO8601
analyzedAt :: Data.ISO8601,
    -- | The time at which the finding was updated.
    Finding -> ISO8601
updatedAt :: Data.ISO8601,
    -- | The current status of the finding.
    Finding -> FindingStatus
status :: FindingStatus,
    -- | The Amazon Web Services account ID that owns the resource.
    Finding -> Text
resourceOwnerAccount :: Prelude.Text
  }
  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:
--
-- 'action', 'finding_action' - The action in the analyzed policy statement that an external principal
-- has permission to use.
--
-- 'error', 'finding_error' - An error.
--
-- 'isPublic', 'finding_isPublic' - Indicates whether the policy that generated the finding allows public
-- access to the resource.
--
-- 'principal', 'finding_principal' - The external principal that access to a resource within the zone of
-- trust.
--
-- 'resource', 'finding_resource' - The resource that an external principal has access to.
--
-- 'sources', 'finding_sources' - The sources of the finding. This indicates how the access that generated
-- the finding is granted. It is populated for Amazon S3 bucket findings.
--
-- 'id', 'finding_id' - The ID of the finding.
--
-- 'resourceType', 'finding_resourceType' - The type of the resource identified in the finding.
--
-- 'condition', 'finding_condition' - The condition in the analyzed policy statement that resulted in a
-- finding.
--
-- 'createdAt', 'finding_createdAt' - The time at which the finding was generated.
--
-- 'analyzedAt', 'finding_analyzedAt' - The time at which the resource was analyzed.
--
-- 'updatedAt', 'finding_updatedAt' - The time at which the finding was updated.
--
-- 'status', 'finding_status' - The current status of the finding.
--
-- 'resourceOwnerAccount', 'finding_resourceOwnerAccount' - The Amazon Web Services account ID that owns the resource.
newFinding ::
  -- | 'id'
  Prelude.Text ->
  -- | 'resourceType'
  ResourceType ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'analyzedAt'
  Prelude.UTCTime ->
  -- | 'updatedAt'
  Prelude.UTCTime ->
  -- | 'status'
  FindingStatus ->
  -- | 'resourceOwnerAccount'
  Prelude.Text ->
  Finding
newFinding :: Text
-> ResourceType
-> UTCTime
-> UTCTime
-> UTCTime
-> FindingStatus
-> Text
-> Finding
newFinding
  Text
pId_
  ResourceType
pResourceType_
  UTCTime
pCreatedAt_
  UTCTime
pAnalyzedAt_
  UTCTime
pUpdatedAt_
  FindingStatus
pStatus_
  Text
pResourceOwnerAccount_ =
    Finding'
      { $sel:action:Finding' :: Maybe [Text]
action = forall a. Maybe a
Prelude.Nothing,
        $sel:error:Finding' :: Maybe Text
error = forall a. Maybe a
Prelude.Nothing,
        $sel:isPublic:Finding' :: Maybe Bool
isPublic = forall a. Maybe a
Prelude.Nothing,
        $sel:principal:Finding' :: Maybe (HashMap Text Text)
principal = forall a. Maybe a
Prelude.Nothing,
        $sel:resource:Finding' :: Maybe Text
resource = forall a. Maybe a
Prelude.Nothing,
        $sel:sources:Finding' :: Maybe [FindingSource]
sources = forall a. Maybe a
Prelude.Nothing,
        $sel:id:Finding' :: Text
id = Text
pId_,
        $sel:resourceType:Finding' :: ResourceType
resourceType = ResourceType
pResourceType_,
        $sel:condition:Finding' :: HashMap Text Text
condition = forall a. Monoid a => a
Prelude.mempty,
        $sel:createdAt:Finding' :: ISO8601
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:analyzedAt:Finding' :: ISO8601
analyzedAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pAnalyzedAt_,
        $sel:updatedAt:Finding' :: ISO8601
updatedAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdatedAt_,
        $sel:status:Finding' :: FindingStatus
status = FindingStatus
pStatus_,
        $sel:resourceOwnerAccount:Finding' :: Text
resourceOwnerAccount = Text
pResourceOwnerAccount_
      }

-- | The action in the analyzed policy statement that an external principal
-- has permission to use.
finding_action :: Lens.Lens' Finding (Prelude.Maybe [Prelude.Text])
finding_action :: Lens' Finding (Maybe [Text])
finding_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe [Text]
action :: Maybe [Text]
$sel:action:Finding' :: Finding -> Maybe [Text]
action} -> Maybe [Text]
action) (\s :: Finding
s@Finding' {} Maybe [Text]
a -> Finding
s {$sel:action:Finding' :: Maybe [Text]
action = Maybe [Text]
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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | An error.
finding_error :: Lens.Lens' Finding (Prelude.Maybe Prelude.Text)
finding_error :: Lens' Finding (Maybe Text)
finding_error = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Text
error :: Maybe Text
$sel:error:Finding' :: Finding -> Maybe Text
error} -> Maybe Text
error) (\s :: Finding
s@Finding' {} Maybe Text
a -> Finding
s {$sel:error:Finding' :: Maybe Text
error = Maybe Text
a} :: Finding)

-- | Indicates whether the policy that generated the finding allows public
-- access to the resource.
finding_isPublic :: Lens.Lens' Finding (Prelude.Maybe Prelude.Bool)
finding_isPublic :: Lens' Finding (Maybe Bool)
finding_isPublic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Bool
isPublic :: Maybe Bool
$sel:isPublic:Finding' :: Finding -> Maybe Bool
isPublic} -> Maybe Bool
isPublic) (\s :: Finding
s@Finding' {} Maybe Bool
a -> Finding
s {$sel:isPublic:Finding' :: Maybe Bool
isPublic = Maybe Bool
a} :: Finding)

-- | The external principal that access to a resource within the zone of
-- trust.
finding_principal :: Lens.Lens' Finding (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
finding_principal :: Lens' Finding (Maybe (HashMap Text Text))
finding_principal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe (HashMap Text Text)
principal :: Maybe (HashMap Text Text)
$sel:principal:Finding' :: Finding -> Maybe (HashMap Text Text)
principal} -> Maybe (HashMap Text Text)
principal) (\s :: Finding
s@Finding' {} Maybe (HashMap Text Text)
a -> Finding
s {$sel:principal:Finding' :: Maybe (HashMap Text Text)
principal = Maybe (HashMap Text Text)
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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The resource that an external principal has access to.
finding_resource :: Lens.Lens' Finding (Prelude.Maybe Prelude.Text)
finding_resource :: Lens' Finding (Maybe Text)
finding_resource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe Text
resource :: Maybe Text
$sel:resource:Finding' :: Finding -> Maybe Text
resource} -> Maybe Text
resource) (\s :: Finding
s@Finding' {} Maybe Text
a -> Finding
s {$sel:resource:Finding' :: Maybe Text
resource = Maybe Text
a} :: Finding)

-- | The sources of the finding. This indicates how the access that generated
-- the finding is granted. It is populated for Amazon S3 bucket findings.
finding_sources :: Lens.Lens' Finding (Prelude.Maybe [FindingSource])
finding_sources :: Lens' Finding (Maybe [FindingSource])
finding_sources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Maybe [FindingSource]
sources :: Maybe [FindingSource]
$sel:sources:Finding' :: Finding -> Maybe [FindingSource]
sources} -> Maybe [FindingSource]
sources) (\s :: Finding
s@Finding' {} Maybe [FindingSource]
a -> Finding
s {$sel:sources:Finding' :: Maybe [FindingSource]
sources = Maybe [FindingSource]
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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | The type of the resource identified in the finding.
finding_resourceType :: Lens.Lens' Finding ResourceType
finding_resourceType :: Lens' Finding ResourceType
finding_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {ResourceType
resourceType :: ResourceType
$sel:resourceType:Finding' :: Finding -> ResourceType
resourceType} -> ResourceType
resourceType) (\s :: Finding
s@Finding' {} ResourceType
a -> Finding
s {$sel:resourceType:Finding' :: ResourceType
resourceType = ResourceType
a} :: Finding)

-- | The condition in the analyzed policy statement that resulted in a
-- finding.
finding_condition :: Lens.Lens' Finding (Prelude.HashMap Prelude.Text Prelude.Text)
finding_condition :: Lens' Finding (HashMap Text Text)
finding_condition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {HashMap Text Text
condition :: HashMap Text Text
$sel:condition:Finding' :: Finding -> HashMap Text Text
condition} -> HashMap Text Text
condition) (\s :: Finding
s@Finding' {} HashMap Text Text
a -> Finding
s {$sel:condition:Finding' :: HashMap Text Text
condition = HashMap Text Text
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 time at which the finding was generated.
finding_createdAt :: Lens.Lens' Finding Prelude.UTCTime
finding_createdAt :: Lens' Finding UTCTime
finding_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {ISO8601
createdAt :: ISO8601
$sel:createdAt:Finding' :: Finding -> ISO8601
createdAt} -> ISO8601
createdAt) (\s :: Finding
s@Finding' {} ISO8601
a -> Finding
s {$sel:createdAt:Finding' :: ISO8601
createdAt = ISO8601
a} :: Finding) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time at which the resource was analyzed.
finding_analyzedAt :: Lens.Lens' Finding Prelude.UTCTime
finding_analyzedAt :: Lens' Finding UTCTime
finding_analyzedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {ISO8601
analyzedAt :: ISO8601
$sel:analyzedAt:Finding' :: Finding -> ISO8601
analyzedAt} -> ISO8601
analyzedAt) (\s :: Finding
s@Finding' {} ISO8601
a -> Finding
s {$sel:analyzedAt:Finding' :: ISO8601
analyzedAt = ISO8601
a} :: Finding) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time at which the finding was updated.
finding_updatedAt :: Lens.Lens' Finding Prelude.UTCTime
finding_updatedAt :: Lens' Finding UTCTime
finding_updatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {ISO8601
updatedAt :: ISO8601
$sel:updatedAt:Finding' :: Finding -> ISO8601
updatedAt} -> ISO8601
updatedAt) (\s :: Finding
s@Finding' {} ISO8601
a -> Finding
s {$sel:updatedAt:Finding' :: ISO8601
updatedAt = ISO8601
a} :: Finding) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The current 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 Amazon Web Services account ID that owns the resource.
finding_resourceOwnerAccount :: Lens.Lens' Finding Prelude.Text
finding_resourceOwnerAccount :: Lens' Finding Text
finding_resourceOwnerAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Finding' {Text
resourceOwnerAccount :: Text
$sel:resourceOwnerAccount:Finding' :: Finding -> Text
resourceOwnerAccount} -> Text
resourceOwnerAccount) (\s :: Finding
s@Finding' {} Text
a -> Finding
s {$sel:resourceOwnerAccount:Finding' :: Text
resourceOwnerAccount = Text
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 [Text]
-> Maybe Text
-> Maybe Bool
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe [FindingSource]
-> Text
-> ResourceType
-> HashMap Text Text
-> ISO8601
-> ISO8601
-> ISO8601
-> FindingStatus
-> Text
-> 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
"action" 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
"error")
            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
"isPublic")
            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
"principal" 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
"resource")
            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
"sources" 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 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 a
Data..: Key
"resourceType")
            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
"condition" 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 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 a
Data..: Key
"analyzedAt")
            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
"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
"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
"resourceOwnerAccount")
      )

instance Prelude.Hashable Finding where
  hashWithSalt :: Int -> Finding -> Int
hashWithSalt Int
_salt Finding' {Maybe Bool
Maybe [Text]
Maybe [FindingSource]
Maybe Text
Maybe (HashMap Text Text)
Text
HashMap Text Text
ISO8601
FindingStatus
ResourceType
resourceOwnerAccount :: Text
status :: FindingStatus
updatedAt :: ISO8601
analyzedAt :: ISO8601
createdAt :: ISO8601
condition :: HashMap Text Text
resourceType :: ResourceType
id :: Text
sources :: Maybe [FindingSource]
resource :: Maybe Text
principal :: Maybe (HashMap Text Text)
isPublic :: Maybe Bool
error :: Maybe Text
action :: Maybe [Text]
$sel:resourceOwnerAccount:Finding' :: Finding -> Text
$sel:status:Finding' :: Finding -> FindingStatus
$sel:updatedAt:Finding' :: Finding -> ISO8601
$sel:analyzedAt:Finding' :: Finding -> ISO8601
$sel:createdAt:Finding' :: Finding -> ISO8601
$sel:condition:Finding' :: Finding -> HashMap Text Text
$sel:resourceType:Finding' :: Finding -> ResourceType
$sel:id:Finding' :: Finding -> Text
$sel:sources:Finding' :: Finding -> Maybe [FindingSource]
$sel:resource:Finding' :: Finding -> Maybe Text
$sel:principal:Finding' :: Finding -> Maybe (HashMap Text Text)
$sel:isPublic:Finding' :: Finding -> Maybe Bool
$sel:error:Finding' :: Finding -> Maybe Text
$sel:action:Finding' :: Finding -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
error
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isPublic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
principal
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [FindingSource]
sources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceType
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Text
condition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
analyzedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
updatedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FindingStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceOwnerAccount

instance Prelude.NFData Finding where
  rnf :: Finding -> ()
rnf Finding' {Maybe Bool
Maybe [Text]
Maybe [FindingSource]
Maybe Text
Maybe (HashMap Text Text)
Text
HashMap Text Text
ISO8601
FindingStatus
ResourceType
resourceOwnerAccount :: Text
status :: FindingStatus
updatedAt :: ISO8601
analyzedAt :: ISO8601
createdAt :: ISO8601
condition :: HashMap Text Text
resourceType :: ResourceType
id :: Text
sources :: Maybe [FindingSource]
resource :: Maybe Text
principal :: Maybe (HashMap Text Text)
isPublic :: Maybe Bool
error :: Maybe Text
action :: Maybe [Text]
$sel:resourceOwnerAccount:Finding' :: Finding -> Text
$sel:status:Finding' :: Finding -> FindingStatus
$sel:updatedAt:Finding' :: Finding -> ISO8601
$sel:analyzedAt:Finding' :: Finding -> ISO8601
$sel:createdAt:Finding' :: Finding -> ISO8601
$sel:condition:Finding' :: Finding -> HashMap Text Text
$sel:resourceType:Finding' :: Finding -> ResourceType
$sel:id:Finding' :: Finding -> Text
$sel:sources:Finding' :: Finding -> Maybe [FindingSource]
$sel:resource:Finding' :: Finding -> Maybe Text
$sel:principal:Finding' :: Finding -> Maybe (HashMap Text Text)
$sel:isPublic:Finding' :: Finding -> Maybe Bool
$sel:error:Finding' :: Finding -> Maybe Text
$sel:action:Finding' :: Finding -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
error
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isPublic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
principal
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [FindingSource]
sources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text Text
condition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
analyzedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
updatedAt
      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 Text
resourceOwnerAccount