{-# 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.FindingSummary
-- 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.FindingSummary 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:/ 'newFindingSummary' smart constructor.
data FindingSummary = FindingSummary'
  { -- | The action in the analyzed policy statement that an external principal
    -- has permission to use.
    FindingSummary -> Maybe [Text]
action :: Prelude.Maybe [Prelude.Text],
    -- | The error that resulted in an Error finding.
    FindingSummary -> Maybe Text
error :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the finding reports a resource that has a policy that
    -- allows public access.
    FindingSummary -> Maybe Bool
isPublic :: Prelude.Maybe Prelude.Bool,
    -- | The external principal that has access to a resource within the zone of
    -- trust.
    FindingSummary -> Maybe (HashMap Text Text)
principal :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The resource that the external principal has access to.
    FindingSummary -> 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.
    FindingSummary -> Maybe [FindingSource]
sources :: Prelude.Maybe [FindingSource],
    -- | The ID of the finding.
    FindingSummary -> Text
id :: Prelude.Text,
    -- | The type of the resource that the external principal has access to.
    FindingSummary -> ResourceType
resourceType :: ResourceType,
    -- | The condition in the analyzed policy statement that resulted in a
    -- finding.
    FindingSummary -> HashMap Text Text
condition :: Prelude.HashMap Prelude.Text Prelude.Text,
    -- | The time at which the finding was created.
    FindingSummary -> ISO8601
createdAt :: Data.ISO8601,
    -- | The time at which the resource-based policy that generated the finding
    -- was analyzed.
    FindingSummary -> ISO8601
analyzedAt :: Data.ISO8601,
    -- | The time at which the finding was most recently updated.
    FindingSummary -> ISO8601
updatedAt :: Data.ISO8601,
    -- | The status of the finding.
    FindingSummary -> FindingStatus
status :: FindingStatus,
    -- | The Amazon Web Services account ID that owns the resource.
    FindingSummary -> Text
resourceOwnerAccount :: Prelude.Text
  }
  deriving (FindingSummary -> FindingSummary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FindingSummary -> FindingSummary -> Bool
$c/= :: FindingSummary -> FindingSummary -> Bool
== :: FindingSummary -> FindingSummary -> Bool
$c== :: FindingSummary -> FindingSummary -> Bool
Prelude.Eq, ReadPrec [FindingSummary]
ReadPrec FindingSummary
Int -> ReadS FindingSummary
ReadS [FindingSummary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FindingSummary]
$creadListPrec :: ReadPrec [FindingSummary]
readPrec :: ReadPrec FindingSummary
$creadPrec :: ReadPrec FindingSummary
readList :: ReadS [FindingSummary]
$creadList :: ReadS [FindingSummary]
readsPrec :: Int -> ReadS FindingSummary
$creadsPrec :: Int -> ReadS FindingSummary
Prelude.Read, Int -> FindingSummary -> ShowS
[FindingSummary] -> ShowS
FindingSummary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FindingSummary] -> ShowS
$cshowList :: [FindingSummary] -> ShowS
show :: FindingSummary -> String
$cshow :: FindingSummary -> String
showsPrec :: Int -> FindingSummary -> ShowS
$cshowsPrec :: Int -> FindingSummary -> ShowS
Prelude.Show, forall x. Rep FindingSummary x -> FindingSummary
forall x. FindingSummary -> Rep FindingSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FindingSummary x -> FindingSummary
$cfrom :: forall x. FindingSummary -> Rep FindingSummary x
Prelude.Generic)

-- |
-- Create a value of 'FindingSummary' 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', 'findingSummary_action' - The action in the analyzed policy statement that an external principal
-- has permission to use.
--
-- 'error', 'findingSummary_error' - The error that resulted in an Error finding.
--
-- 'isPublic', 'findingSummary_isPublic' - Indicates whether the finding reports a resource that has a policy that
-- allows public access.
--
-- 'principal', 'findingSummary_principal' - The external principal that has access to a resource within the zone of
-- trust.
--
-- 'resource', 'findingSummary_resource' - The resource that the external principal has access to.
--
-- 'sources', 'findingSummary_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', 'findingSummary_id' - The ID of the finding.
--
-- 'resourceType', 'findingSummary_resourceType' - The type of the resource that the external principal has access to.
--
-- 'condition', 'findingSummary_condition' - The condition in the analyzed policy statement that resulted in a
-- finding.
--
-- 'createdAt', 'findingSummary_createdAt' - The time at which the finding was created.
--
-- 'analyzedAt', 'findingSummary_analyzedAt' - The time at which the resource-based policy that generated the finding
-- was analyzed.
--
-- 'updatedAt', 'findingSummary_updatedAt' - The time at which the finding was most recently updated.
--
-- 'status', 'findingSummary_status' - The status of the finding.
--
-- 'resourceOwnerAccount', 'findingSummary_resourceOwnerAccount' - The Amazon Web Services account ID that owns the resource.
newFindingSummary ::
  -- | 'id'
  Prelude.Text ->
  -- | 'resourceType'
  ResourceType ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'analyzedAt'
  Prelude.UTCTime ->
  -- | 'updatedAt'
  Prelude.UTCTime ->
  -- | 'status'
  FindingStatus ->
  -- | 'resourceOwnerAccount'
  Prelude.Text ->
  FindingSummary
newFindingSummary :: Text
-> ResourceType
-> UTCTime
-> UTCTime
-> UTCTime
-> FindingStatus
-> Text
-> FindingSummary
newFindingSummary
  Text
pId_
  ResourceType
pResourceType_
  UTCTime
pCreatedAt_
  UTCTime
pAnalyzedAt_
  UTCTime
pUpdatedAt_
  FindingStatus
pStatus_
  Text
pResourceOwnerAccount_ =
    FindingSummary'
      { $sel:action:FindingSummary' :: Maybe [Text]
action = forall a. Maybe a
Prelude.Nothing,
        $sel:error:FindingSummary' :: Maybe Text
error = forall a. Maybe a
Prelude.Nothing,
        $sel:isPublic:FindingSummary' :: Maybe Bool
isPublic = forall a. Maybe a
Prelude.Nothing,
        $sel:principal:FindingSummary' :: Maybe (HashMap Text Text)
principal = forall a. Maybe a
Prelude.Nothing,
        $sel:resource:FindingSummary' :: Maybe Text
resource = forall a. Maybe a
Prelude.Nothing,
        $sel:sources:FindingSummary' :: Maybe [FindingSource]
sources = forall a. Maybe a
Prelude.Nothing,
        $sel:id:FindingSummary' :: Text
id = Text
pId_,
        $sel:resourceType:FindingSummary' :: ResourceType
resourceType = ResourceType
pResourceType_,
        $sel:condition:FindingSummary' :: HashMap Text Text
condition = forall a. Monoid a => a
Prelude.mempty,
        $sel:createdAt:FindingSummary' :: ISO8601
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:analyzedAt:FindingSummary' :: ISO8601
analyzedAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pAnalyzedAt_,
        $sel:updatedAt:FindingSummary' :: ISO8601
updatedAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdatedAt_,
        $sel:status:FindingSummary' :: FindingStatus
status = FindingStatus
pStatus_,
        $sel:resourceOwnerAccount:FindingSummary' :: Text
resourceOwnerAccount = Text
pResourceOwnerAccount_
      }

-- | The action in the analyzed policy statement that an external principal
-- has permission to use.
findingSummary_action :: Lens.Lens' FindingSummary (Prelude.Maybe [Prelude.Text])
findingSummary_action :: Lens' FindingSummary (Maybe [Text])
findingSummary_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingSummary' {Maybe [Text]
action :: Maybe [Text]
$sel:action:FindingSummary' :: FindingSummary -> Maybe [Text]
action} -> Maybe [Text]
action) (\s :: FindingSummary
s@FindingSummary' {} Maybe [Text]
a -> FindingSummary
s {$sel:action:FindingSummary' :: Maybe [Text]
action = Maybe [Text]
a} :: FindingSummary) 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 error that resulted in an Error finding.
findingSummary_error :: Lens.Lens' FindingSummary (Prelude.Maybe Prelude.Text)
findingSummary_error :: Lens' FindingSummary (Maybe Text)
findingSummary_error = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingSummary' {Maybe Text
error :: Maybe Text
$sel:error:FindingSummary' :: FindingSummary -> Maybe Text
error} -> Maybe Text
error) (\s :: FindingSummary
s@FindingSummary' {} Maybe Text
a -> FindingSummary
s {$sel:error:FindingSummary' :: Maybe Text
error = Maybe Text
a} :: FindingSummary)

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

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

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

-- | The type of the resource that the external principal has access to.
findingSummary_resourceType :: Lens.Lens' FindingSummary ResourceType
findingSummary_resourceType :: Lens' FindingSummary ResourceType
findingSummary_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingSummary' {ResourceType
resourceType :: ResourceType
$sel:resourceType:FindingSummary' :: FindingSummary -> ResourceType
resourceType} -> ResourceType
resourceType) (\s :: FindingSummary
s@FindingSummary' {} ResourceType
a -> FindingSummary
s {$sel:resourceType:FindingSummary' :: ResourceType
resourceType = ResourceType
a} :: FindingSummary)

-- | The condition in the analyzed policy statement that resulted in a
-- finding.
findingSummary_condition :: Lens.Lens' FindingSummary (Prelude.HashMap Prelude.Text Prelude.Text)
findingSummary_condition :: Lens' FindingSummary (HashMap Text Text)
findingSummary_condition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingSummary' {HashMap Text Text
condition :: HashMap Text Text
$sel:condition:FindingSummary' :: FindingSummary -> HashMap Text Text
condition} -> HashMap Text Text
condition) (\s :: FindingSummary
s@FindingSummary' {} HashMap Text Text
a -> FindingSummary
s {$sel:condition:FindingSummary' :: HashMap Text Text
condition = HashMap Text Text
a} :: FindingSummary) 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 created.
findingSummary_createdAt :: Lens.Lens' FindingSummary Prelude.UTCTime
findingSummary_createdAt :: Lens' FindingSummary UTCTime
findingSummary_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingSummary' {ISO8601
createdAt :: ISO8601
$sel:createdAt:FindingSummary' :: FindingSummary -> ISO8601
createdAt} -> ISO8601
createdAt) (\s :: FindingSummary
s@FindingSummary' {} ISO8601
a -> FindingSummary
s {$sel:createdAt:FindingSummary' :: ISO8601
createdAt = ISO8601
a} :: FindingSummary) 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-based policy that generated the finding
-- was analyzed.
findingSummary_analyzedAt :: Lens.Lens' FindingSummary Prelude.UTCTime
findingSummary_analyzedAt :: Lens' FindingSummary UTCTime
findingSummary_analyzedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingSummary' {ISO8601
analyzedAt :: ISO8601
$sel:analyzedAt:FindingSummary' :: FindingSummary -> ISO8601
analyzedAt} -> ISO8601
analyzedAt) (\s :: FindingSummary
s@FindingSummary' {} ISO8601
a -> FindingSummary
s {$sel:analyzedAt:FindingSummary' :: ISO8601
analyzedAt = ISO8601
a} :: FindingSummary) 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 most recently updated.
findingSummary_updatedAt :: Lens.Lens' FindingSummary Prelude.UTCTime
findingSummary_updatedAt :: Lens' FindingSummary UTCTime
findingSummary_updatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingSummary' {ISO8601
updatedAt :: ISO8601
$sel:updatedAt:FindingSummary' :: FindingSummary -> ISO8601
updatedAt} -> ISO8601
updatedAt) (\s :: FindingSummary
s@FindingSummary' {} ISO8601
a -> FindingSummary
s {$sel:updatedAt:FindingSummary' :: ISO8601
updatedAt = ISO8601
a} :: FindingSummary) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

-- | The Amazon Web Services account ID that owns the resource.
findingSummary_resourceOwnerAccount :: Lens.Lens' FindingSummary Prelude.Text
findingSummary_resourceOwnerAccount :: Lens' FindingSummary Text
findingSummary_resourceOwnerAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FindingSummary' {Text
resourceOwnerAccount :: Text
$sel:resourceOwnerAccount:FindingSummary' :: FindingSummary -> Text
resourceOwnerAccount} -> Text
resourceOwnerAccount) (\s :: FindingSummary
s@FindingSummary' {} Text
a -> FindingSummary
s {$sel:resourceOwnerAccount:FindingSummary' :: Text
resourceOwnerAccount = Text
a} :: FindingSummary)

instance Data.FromJSON FindingSummary where
  parseJSON :: Value -> Parser FindingSummary
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"FindingSummary"
      ( \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
-> FindingSummary
FindingSummary'
            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 FindingSummary where
  hashWithSalt :: Int -> FindingSummary -> Int
hashWithSalt Int
_salt FindingSummary' {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:FindingSummary' :: FindingSummary -> Text
$sel:status:FindingSummary' :: FindingSummary -> FindingStatus
$sel:updatedAt:FindingSummary' :: FindingSummary -> ISO8601
$sel:analyzedAt:FindingSummary' :: FindingSummary -> ISO8601
$sel:createdAt:FindingSummary' :: FindingSummary -> ISO8601
$sel:condition:FindingSummary' :: FindingSummary -> HashMap Text Text
$sel:resourceType:FindingSummary' :: FindingSummary -> ResourceType
$sel:id:FindingSummary' :: FindingSummary -> Text
$sel:sources:FindingSummary' :: FindingSummary -> Maybe [FindingSource]
$sel:resource:FindingSummary' :: FindingSummary -> Maybe Text
$sel:principal:FindingSummary' :: FindingSummary -> Maybe (HashMap Text Text)
$sel:isPublic:FindingSummary' :: FindingSummary -> Maybe Bool
$sel:error:FindingSummary' :: FindingSummary -> Maybe Text
$sel:action:FindingSummary' :: FindingSummary -> 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 FindingSummary where
  rnf :: FindingSummary -> ()
rnf FindingSummary' {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:FindingSummary' :: FindingSummary -> Text
$sel:status:FindingSummary' :: FindingSummary -> FindingStatus
$sel:updatedAt:FindingSummary' :: FindingSummary -> ISO8601
$sel:analyzedAt:FindingSummary' :: FindingSummary -> ISO8601
$sel:createdAt:FindingSummary' :: FindingSummary -> ISO8601
$sel:condition:FindingSummary' :: FindingSummary -> HashMap Text Text
$sel:resourceType:FindingSummary' :: FindingSummary -> ResourceType
$sel:id:FindingSummary' :: FindingSummary -> Text
$sel:sources:FindingSummary' :: FindingSummary -> Maybe [FindingSource]
$sel:resource:FindingSummary' :: FindingSummary -> Maybe Text
$sel:principal:FindingSummary' :: FindingSummary -> Maybe (HashMap Text Text)
$sel:isPublic:FindingSummary' :: FindingSummary -> Maybe Bool
$sel:error:FindingSummary' :: FindingSummary -> Maybe Text
$sel:action:FindingSummary' :: FindingSummary -> 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