{-# 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.AccessPreviewFinding
-- 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.AccessPreviewFinding where

import Amazonka.AccessAnalyzer.Types.FindingChangeType
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

-- | An access preview finding generated by the access preview.
--
-- /See:/ 'newAccessPreviewFinding' smart constructor.
data AccessPreviewFinding = AccessPreviewFinding'
  { -- | The action in the analyzed policy statement that an external principal
    -- has permission to perform.
    AccessPreviewFinding -> Maybe [Text]
action :: Prelude.Maybe [Prelude.Text],
    -- | The condition in the analyzed policy statement that resulted in a
    -- finding.
    AccessPreviewFinding -> Maybe (HashMap Text Text)
condition :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | An error.
    AccessPreviewFinding -> Maybe Text
error :: Prelude.Maybe Prelude.Text,
    -- | The existing ID of the finding in IAM Access Analyzer, provided only for
    -- existing findings.
    AccessPreviewFinding -> Maybe Text
existingFindingId :: Prelude.Maybe Prelude.Text,
    -- | The existing status of the finding, provided only for existing findings.
    AccessPreviewFinding -> Maybe FindingStatus
existingFindingStatus :: Prelude.Maybe FindingStatus,
    -- | Indicates whether the policy that generated the finding allows public
    -- access to the resource.
    AccessPreviewFinding -> Maybe Bool
isPublic :: Prelude.Maybe Prelude.Bool,
    -- | The external principal that has access to a resource within the zone of
    -- trust.
    AccessPreviewFinding -> Maybe (HashMap Text Text)
principal :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The resource that an external principal has access to. This is the
    -- resource associated with the access preview.
    AccessPreviewFinding -> 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.
    AccessPreviewFinding -> Maybe [FindingSource]
sources :: Prelude.Maybe [FindingSource],
    -- | The ID of the access preview finding. This ID uniquely identifies the
    -- element in the list of access preview findings and is not related to the
    -- finding ID in Access Analyzer.
    AccessPreviewFinding -> Text
id :: Prelude.Text,
    -- | The type of the resource that can be accessed in the finding.
    AccessPreviewFinding -> ResourceType
resourceType :: ResourceType,
    -- | The time at which the access preview finding was created.
    AccessPreviewFinding -> ISO8601
createdAt :: Data.ISO8601,
    -- | Provides context on how the access preview finding compares to existing
    -- access identified in IAM Access Analyzer.
    --
    -- -   @New@ - The finding is for newly-introduced access.
    --
    -- -   @Unchanged@ - The preview finding is an existing finding that would
    --     remain unchanged.
    --
    -- -   @Changed@ - The preview finding is an existing finding with a change
    --     in status.
    --
    -- For example, a @Changed@ finding with preview status @Resolved@ and
    -- existing status @Active@ indicates the existing @Active@ finding would
    -- become @Resolved@ as a result of the proposed permissions change.
    AccessPreviewFinding -> FindingChangeType
changeType :: FindingChangeType,
    -- | The preview status of the finding. This is what the status of the
    -- finding would be after permissions deployment. For example, a @Changed@
    -- finding with preview status @Resolved@ and existing status @Active@
    -- indicates the existing @Active@ finding would become @Resolved@ as a
    -- result of the proposed permissions change.
    AccessPreviewFinding -> FindingStatus
status :: FindingStatus,
    -- | The Amazon Web Services account ID that owns the resource. For most
    -- Amazon Web Services resources, the owning account is the account in
    -- which the resource was created.
    AccessPreviewFinding -> Text
resourceOwnerAccount :: Prelude.Text
  }
  deriving (AccessPreviewFinding -> AccessPreviewFinding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccessPreviewFinding -> AccessPreviewFinding -> Bool
$c/= :: AccessPreviewFinding -> AccessPreviewFinding -> Bool
== :: AccessPreviewFinding -> AccessPreviewFinding -> Bool
$c== :: AccessPreviewFinding -> AccessPreviewFinding -> Bool
Prelude.Eq, ReadPrec [AccessPreviewFinding]
ReadPrec AccessPreviewFinding
Int -> ReadS AccessPreviewFinding
ReadS [AccessPreviewFinding]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AccessPreviewFinding]
$creadListPrec :: ReadPrec [AccessPreviewFinding]
readPrec :: ReadPrec AccessPreviewFinding
$creadPrec :: ReadPrec AccessPreviewFinding
readList :: ReadS [AccessPreviewFinding]
$creadList :: ReadS [AccessPreviewFinding]
readsPrec :: Int -> ReadS AccessPreviewFinding
$creadsPrec :: Int -> ReadS AccessPreviewFinding
Prelude.Read, Int -> AccessPreviewFinding -> ShowS
[AccessPreviewFinding] -> ShowS
AccessPreviewFinding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccessPreviewFinding] -> ShowS
$cshowList :: [AccessPreviewFinding] -> ShowS
show :: AccessPreviewFinding -> String
$cshow :: AccessPreviewFinding -> String
showsPrec :: Int -> AccessPreviewFinding -> ShowS
$cshowsPrec :: Int -> AccessPreviewFinding -> ShowS
Prelude.Show, forall x. Rep AccessPreviewFinding x -> AccessPreviewFinding
forall x. AccessPreviewFinding -> Rep AccessPreviewFinding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccessPreviewFinding x -> AccessPreviewFinding
$cfrom :: forall x. AccessPreviewFinding -> Rep AccessPreviewFinding x
Prelude.Generic)

-- |
-- Create a value of 'AccessPreviewFinding' 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', 'accessPreviewFinding_action' - The action in the analyzed policy statement that an external principal
-- has permission to perform.
--
-- 'condition', 'accessPreviewFinding_condition' - The condition in the analyzed policy statement that resulted in a
-- finding.
--
-- 'error', 'accessPreviewFinding_error' - An error.
--
-- 'existingFindingId', 'accessPreviewFinding_existingFindingId' - The existing ID of the finding in IAM Access Analyzer, provided only for
-- existing findings.
--
-- 'existingFindingStatus', 'accessPreviewFinding_existingFindingStatus' - The existing status of the finding, provided only for existing findings.
--
-- 'isPublic', 'accessPreviewFinding_isPublic' - Indicates whether the policy that generated the finding allows public
-- access to the resource.
--
-- 'principal', 'accessPreviewFinding_principal' - The external principal that has access to a resource within the zone of
-- trust.
--
-- 'resource', 'accessPreviewFinding_resource' - The resource that an external principal has access to. This is the
-- resource associated with the access preview.
--
-- 'sources', 'accessPreviewFinding_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', 'accessPreviewFinding_id' - The ID of the access preview finding. This ID uniquely identifies the
-- element in the list of access preview findings and is not related to the
-- finding ID in Access Analyzer.
--
-- 'resourceType', 'accessPreviewFinding_resourceType' - The type of the resource that can be accessed in the finding.
--
-- 'createdAt', 'accessPreviewFinding_createdAt' - The time at which the access preview finding was created.
--
-- 'changeType', 'accessPreviewFinding_changeType' - Provides context on how the access preview finding compares to existing
-- access identified in IAM Access Analyzer.
--
-- -   @New@ - The finding is for newly-introduced access.
--
-- -   @Unchanged@ - The preview finding is an existing finding that would
--     remain unchanged.
--
-- -   @Changed@ - The preview finding is an existing finding with a change
--     in status.
--
-- For example, a @Changed@ finding with preview status @Resolved@ and
-- existing status @Active@ indicates the existing @Active@ finding would
-- become @Resolved@ as a result of the proposed permissions change.
--
-- 'status', 'accessPreviewFinding_status' - The preview status of the finding. This is what the status of the
-- finding would be after permissions deployment. For example, a @Changed@
-- finding with preview status @Resolved@ and existing status @Active@
-- indicates the existing @Active@ finding would become @Resolved@ as a
-- result of the proposed permissions change.
--
-- 'resourceOwnerAccount', 'accessPreviewFinding_resourceOwnerAccount' - The Amazon Web Services account ID that owns the resource. For most
-- Amazon Web Services resources, the owning account is the account in
-- which the resource was created.
newAccessPreviewFinding ::
  -- | 'id'
  Prelude.Text ->
  -- | 'resourceType'
  ResourceType ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'changeType'
  FindingChangeType ->
  -- | 'status'
  FindingStatus ->
  -- | 'resourceOwnerAccount'
  Prelude.Text ->
  AccessPreviewFinding
newAccessPreviewFinding :: Text
-> ResourceType
-> UTCTime
-> FindingChangeType
-> FindingStatus
-> Text
-> AccessPreviewFinding
newAccessPreviewFinding
  Text
pId_
  ResourceType
pResourceType_
  UTCTime
pCreatedAt_
  FindingChangeType
pChangeType_
  FindingStatus
pStatus_
  Text
pResourceOwnerAccount_ =
    AccessPreviewFinding'
      { $sel:action:AccessPreviewFinding' :: Maybe [Text]
action = forall a. Maybe a
Prelude.Nothing,
        $sel:condition:AccessPreviewFinding' :: Maybe (HashMap Text Text)
condition = forall a. Maybe a
Prelude.Nothing,
        $sel:error:AccessPreviewFinding' :: Maybe Text
error = forall a. Maybe a
Prelude.Nothing,
        $sel:existingFindingId:AccessPreviewFinding' :: Maybe Text
existingFindingId = forall a. Maybe a
Prelude.Nothing,
        $sel:existingFindingStatus:AccessPreviewFinding' :: Maybe FindingStatus
existingFindingStatus = forall a. Maybe a
Prelude.Nothing,
        $sel:isPublic:AccessPreviewFinding' :: Maybe Bool
isPublic = forall a. Maybe a
Prelude.Nothing,
        $sel:principal:AccessPreviewFinding' :: Maybe (HashMap Text Text)
principal = forall a. Maybe a
Prelude.Nothing,
        $sel:resource:AccessPreviewFinding' :: Maybe Text
resource = forall a. Maybe a
Prelude.Nothing,
        $sel:sources:AccessPreviewFinding' :: Maybe [FindingSource]
sources = forall a. Maybe a
Prelude.Nothing,
        $sel:id:AccessPreviewFinding' :: Text
id = Text
pId_,
        $sel:resourceType:AccessPreviewFinding' :: ResourceType
resourceType = ResourceType
pResourceType_,
        $sel:createdAt:AccessPreviewFinding' :: ISO8601
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:changeType:AccessPreviewFinding' :: FindingChangeType
changeType = FindingChangeType
pChangeType_,
        $sel:status:AccessPreviewFinding' :: FindingStatus
status = FindingStatus
pStatus_,
        $sel:resourceOwnerAccount:AccessPreviewFinding' :: Text
resourceOwnerAccount = Text
pResourceOwnerAccount_
      }

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

-- | The existing ID of the finding in IAM Access Analyzer, provided only for
-- existing findings.
accessPreviewFinding_existingFindingId :: Lens.Lens' AccessPreviewFinding (Prelude.Maybe Prelude.Text)
accessPreviewFinding_existingFindingId :: Lens' AccessPreviewFinding (Maybe Text)
accessPreviewFinding_existingFindingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccessPreviewFinding' {Maybe Text
existingFindingId :: Maybe Text
$sel:existingFindingId:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe Text
existingFindingId} -> Maybe Text
existingFindingId) (\s :: AccessPreviewFinding
s@AccessPreviewFinding' {} Maybe Text
a -> AccessPreviewFinding
s {$sel:existingFindingId:AccessPreviewFinding' :: Maybe Text
existingFindingId = Maybe Text
a} :: AccessPreviewFinding)

-- | The existing status of the finding, provided only for existing findings.
accessPreviewFinding_existingFindingStatus :: Lens.Lens' AccessPreviewFinding (Prelude.Maybe FindingStatus)
accessPreviewFinding_existingFindingStatus :: Lens' AccessPreviewFinding (Maybe FindingStatus)
accessPreviewFinding_existingFindingStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccessPreviewFinding' {Maybe FindingStatus
existingFindingStatus :: Maybe FindingStatus
$sel:existingFindingStatus:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe FindingStatus
existingFindingStatus} -> Maybe FindingStatus
existingFindingStatus) (\s :: AccessPreviewFinding
s@AccessPreviewFinding' {} Maybe FindingStatus
a -> AccessPreviewFinding
s {$sel:existingFindingStatus:AccessPreviewFinding' :: Maybe FindingStatus
existingFindingStatus = Maybe FindingStatus
a} :: AccessPreviewFinding)

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

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

-- | The sources of the finding. This indicates how the access that generated
-- the finding is granted. It is populated for Amazon S3 bucket findings.
accessPreviewFinding_sources :: Lens.Lens' AccessPreviewFinding (Prelude.Maybe [FindingSource])
accessPreviewFinding_sources :: Lens' AccessPreviewFinding (Maybe [FindingSource])
accessPreviewFinding_sources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccessPreviewFinding' {Maybe [FindingSource]
sources :: Maybe [FindingSource]
$sel:sources:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe [FindingSource]
sources} -> Maybe [FindingSource]
sources) (\s :: AccessPreviewFinding
s@AccessPreviewFinding' {} Maybe [FindingSource]
a -> AccessPreviewFinding
s {$sel:sources:AccessPreviewFinding' :: Maybe [FindingSource]
sources = Maybe [FindingSource]
a} :: AccessPreviewFinding) 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 access preview finding. This ID uniquely identifies the
-- element in the list of access preview findings and is not related to the
-- finding ID in Access Analyzer.
accessPreviewFinding_id :: Lens.Lens' AccessPreviewFinding Prelude.Text
accessPreviewFinding_id :: Lens' AccessPreviewFinding Text
accessPreviewFinding_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccessPreviewFinding' {Text
id :: Text
$sel:id:AccessPreviewFinding' :: AccessPreviewFinding -> Text
id} -> Text
id) (\s :: AccessPreviewFinding
s@AccessPreviewFinding' {} Text
a -> AccessPreviewFinding
s {$sel:id:AccessPreviewFinding' :: Text
id = Text
a} :: AccessPreviewFinding)

-- | The type of the resource that can be accessed in the finding.
accessPreviewFinding_resourceType :: Lens.Lens' AccessPreviewFinding ResourceType
accessPreviewFinding_resourceType :: Lens' AccessPreviewFinding ResourceType
accessPreviewFinding_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccessPreviewFinding' {ResourceType
resourceType :: ResourceType
$sel:resourceType:AccessPreviewFinding' :: AccessPreviewFinding -> ResourceType
resourceType} -> ResourceType
resourceType) (\s :: AccessPreviewFinding
s@AccessPreviewFinding' {} ResourceType
a -> AccessPreviewFinding
s {$sel:resourceType:AccessPreviewFinding' :: ResourceType
resourceType = ResourceType
a} :: AccessPreviewFinding)

-- | The time at which the access preview finding was created.
accessPreviewFinding_createdAt :: Lens.Lens' AccessPreviewFinding Prelude.UTCTime
accessPreviewFinding_createdAt :: Lens' AccessPreviewFinding UTCTime
accessPreviewFinding_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccessPreviewFinding' {ISO8601
createdAt :: ISO8601
$sel:createdAt:AccessPreviewFinding' :: AccessPreviewFinding -> ISO8601
createdAt} -> ISO8601
createdAt) (\s :: AccessPreviewFinding
s@AccessPreviewFinding' {} ISO8601
a -> AccessPreviewFinding
s {$sel:createdAt:AccessPreviewFinding' :: ISO8601
createdAt = ISO8601
a} :: AccessPreviewFinding) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Provides context on how the access preview finding compares to existing
-- access identified in IAM Access Analyzer.
--
-- -   @New@ - The finding is for newly-introduced access.
--
-- -   @Unchanged@ - The preview finding is an existing finding that would
--     remain unchanged.
--
-- -   @Changed@ - The preview finding is an existing finding with a change
--     in status.
--
-- For example, a @Changed@ finding with preview status @Resolved@ and
-- existing status @Active@ indicates the existing @Active@ finding would
-- become @Resolved@ as a result of the proposed permissions change.
accessPreviewFinding_changeType :: Lens.Lens' AccessPreviewFinding FindingChangeType
accessPreviewFinding_changeType :: Lens' AccessPreviewFinding FindingChangeType
accessPreviewFinding_changeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccessPreviewFinding' {FindingChangeType
changeType :: FindingChangeType
$sel:changeType:AccessPreviewFinding' :: AccessPreviewFinding -> FindingChangeType
changeType} -> FindingChangeType
changeType) (\s :: AccessPreviewFinding
s@AccessPreviewFinding' {} FindingChangeType
a -> AccessPreviewFinding
s {$sel:changeType:AccessPreviewFinding' :: FindingChangeType
changeType = FindingChangeType
a} :: AccessPreviewFinding)

-- | The preview status of the finding. This is what the status of the
-- finding would be after permissions deployment. For example, a @Changed@
-- finding with preview status @Resolved@ and existing status @Active@
-- indicates the existing @Active@ finding would become @Resolved@ as a
-- result of the proposed permissions change.
accessPreviewFinding_status :: Lens.Lens' AccessPreviewFinding FindingStatus
accessPreviewFinding_status :: Lens' AccessPreviewFinding FindingStatus
accessPreviewFinding_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccessPreviewFinding' {FindingStatus
status :: FindingStatus
$sel:status:AccessPreviewFinding' :: AccessPreviewFinding -> FindingStatus
status} -> FindingStatus
status) (\s :: AccessPreviewFinding
s@AccessPreviewFinding' {} FindingStatus
a -> AccessPreviewFinding
s {$sel:status:AccessPreviewFinding' :: FindingStatus
status = FindingStatus
a} :: AccessPreviewFinding)

-- | The Amazon Web Services account ID that owns the resource. For most
-- Amazon Web Services resources, the owning account is the account in
-- which the resource was created.
accessPreviewFinding_resourceOwnerAccount :: Lens.Lens' AccessPreviewFinding Prelude.Text
accessPreviewFinding_resourceOwnerAccount :: Lens' AccessPreviewFinding Text
accessPreviewFinding_resourceOwnerAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AccessPreviewFinding' {Text
resourceOwnerAccount :: Text
$sel:resourceOwnerAccount:AccessPreviewFinding' :: AccessPreviewFinding -> Text
resourceOwnerAccount} -> Text
resourceOwnerAccount) (\s :: AccessPreviewFinding
s@AccessPreviewFinding' {} Text
a -> AccessPreviewFinding
s {$sel:resourceOwnerAccount:AccessPreviewFinding' :: Text
resourceOwnerAccount = Text
a} :: AccessPreviewFinding)

instance Data.FromJSON AccessPreviewFinding where
  parseJSON :: Value -> Parser AccessPreviewFinding
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"AccessPreviewFinding"
      ( \Object
x ->
          Maybe [Text]
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe Text
-> Maybe FindingStatus
-> Maybe Bool
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Maybe [FindingSource]
-> Text
-> ResourceType
-> ISO8601
-> FindingChangeType
-> FindingStatus
-> Text
-> AccessPreviewFinding
AccessPreviewFinding'
            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
"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 (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
"existingFindingId")
            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
"existingFindingStatus")
            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 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
"changeType")
            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 AccessPreviewFinding where
  hashWithSalt :: Int -> AccessPreviewFinding -> Int
hashWithSalt Int
_salt AccessPreviewFinding' {Maybe Bool
Maybe [Text]
Maybe [FindingSource]
Maybe Text
Maybe (HashMap Text Text)
Maybe FindingStatus
Text
ISO8601
FindingChangeType
FindingStatus
ResourceType
resourceOwnerAccount :: Text
status :: FindingStatus
changeType :: FindingChangeType
createdAt :: ISO8601
resourceType :: ResourceType
id :: Text
sources :: Maybe [FindingSource]
resource :: Maybe Text
principal :: Maybe (HashMap Text Text)
isPublic :: Maybe Bool
existingFindingStatus :: Maybe FindingStatus
existingFindingId :: Maybe Text
error :: Maybe Text
condition :: Maybe (HashMap Text Text)
action :: Maybe [Text]
$sel:resourceOwnerAccount:AccessPreviewFinding' :: AccessPreviewFinding -> Text
$sel:status:AccessPreviewFinding' :: AccessPreviewFinding -> FindingStatus
$sel:changeType:AccessPreviewFinding' :: AccessPreviewFinding -> FindingChangeType
$sel:createdAt:AccessPreviewFinding' :: AccessPreviewFinding -> ISO8601
$sel:resourceType:AccessPreviewFinding' :: AccessPreviewFinding -> ResourceType
$sel:id:AccessPreviewFinding' :: AccessPreviewFinding -> Text
$sel:sources:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe [FindingSource]
$sel:resource:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe Text
$sel:principal:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe (HashMap Text Text)
$sel:isPublic:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe Bool
$sel:existingFindingStatus:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe FindingStatus
$sel:existingFindingId:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe Text
$sel:error:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe Text
$sel:condition:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe (HashMap Text Text)
$sel:action:AccessPreviewFinding' :: AccessPreviewFinding -> 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 (HashMap Text Text)
condition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
error
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
existingFindingId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FindingStatus
existingFindingStatus
      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` ISO8601
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FindingChangeType
changeType
      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 AccessPreviewFinding where
  rnf :: AccessPreviewFinding -> ()
rnf AccessPreviewFinding' {Maybe Bool
Maybe [Text]
Maybe [FindingSource]
Maybe Text
Maybe (HashMap Text Text)
Maybe FindingStatus
Text
ISO8601
FindingChangeType
FindingStatus
ResourceType
resourceOwnerAccount :: Text
status :: FindingStatus
changeType :: FindingChangeType
createdAt :: ISO8601
resourceType :: ResourceType
id :: Text
sources :: Maybe [FindingSource]
resource :: Maybe Text
principal :: Maybe (HashMap Text Text)
isPublic :: Maybe Bool
existingFindingStatus :: Maybe FindingStatus
existingFindingId :: Maybe Text
error :: Maybe Text
condition :: Maybe (HashMap Text Text)
action :: Maybe [Text]
$sel:resourceOwnerAccount:AccessPreviewFinding' :: AccessPreviewFinding -> Text
$sel:status:AccessPreviewFinding' :: AccessPreviewFinding -> FindingStatus
$sel:changeType:AccessPreviewFinding' :: AccessPreviewFinding -> FindingChangeType
$sel:createdAt:AccessPreviewFinding' :: AccessPreviewFinding -> ISO8601
$sel:resourceType:AccessPreviewFinding' :: AccessPreviewFinding -> ResourceType
$sel:id:AccessPreviewFinding' :: AccessPreviewFinding -> Text
$sel:sources:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe [FindingSource]
$sel:resource:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe Text
$sel:principal:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe (HashMap Text Text)
$sel:isPublic:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe Bool
$sel:existingFindingStatus:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe FindingStatus
$sel:existingFindingId:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe Text
$sel:error:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe Text
$sel:condition:AccessPreviewFinding' :: AccessPreviewFinding -> Maybe (HashMap Text Text)
$sel:action:AccessPreviewFinding' :: AccessPreviewFinding -> 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 (HashMap Text Text)
condition
      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 Text
existingFindingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FindingStatus
existingFindingStatus
      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 ISO8601
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FindingChangeType
changeType
      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