{-# 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.CloudTrail.Types.AdvancedFieldSelector
-- 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.CloudTrail.Types.AdvancedFieldSelector where

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

-- | A single selector statement in an advanced event selector.
--
-- /See:/ 'newAdvancedFieldSelector' smart constructor.
data AdvancedFieldSelector = AdvancedFieldSelector'
  { -- | An operator that includes events that match the last few characters of
    -- the event record field specified as the value of @Field@.
    AdvancedFieldSelector -> Maybe (NonEmpty Text)
endsWith :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | An operator that includes events that match the exact value of the event
    -- record field specified as the value of @Field@. This is the only valid
    -- operator that you can use with the @readOnly@, @eventCategory@, and
    -- @resources.type@ fields.
    AdvancedFieldSelector -> Maybe (NonEmpty Text)
equals :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | An operator that excludes events that match the last few characters of
    -- the event record field specified as the value of @Field@.
    AdvancedFieldSelector -> Maybe (NonEmpty Text)
notEndsWith :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | An operator that excludes events that match the exact value of the event
    -- record field specified as the value of @Field@.
    AdvancedFieldSelector -> Maybe (NonEmpty Text)
notEquals :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | An operator that excludes events that match the first few characters of
    -- the event record field specified as the value of @Field@.
    AdvancedFieldSelector -> Maybe (NonEmpty Text)
notStartsWith :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | An operator that includes events that match the first few characters of
    -- the event record field specified as the value of @Field@.
    AdvancedFieldSelector -> Maybe (NonEmpty Text)
startsWith :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | A field in an event record on which to filter events to be logged.
    -- Supported fields include @readOnly@, @eventCategory@, @eventSource@ (for
    -- management events), @eventName@, @resources.type@, and @resources.ARN@.
    --
    -- -   __@readOnly@__ - Optional. Can be set to @Equals@ a value of @true@
    --     or @false@. If you do not add this field, CloudTrail logs both
    --     @read@ and @write@ events. A value of @true@ logs only @read@
    --     events. A value of @false@ logs only @write@ events.
    --
    -- -   __@eventSource@__ - For filtering management events only. This can
    --     be set only to @NotEquals@ @kms.amazonaws.com@.
    --
    -- -   __@eventName@__ - Can use any operator. You can use it to filter in
    --     or filter out any data event logged to CloudTrail, such as
    --     @PutBucket@ or @GetSnapshotBlock@. You can have multiple values for
    --     this field, separated by commas.
    --
    -- -   __@eventCategory@__ - This is required. It must be set to @Equals@,
    --     and the value must be @Management@ or @Data@.
    --
    -- -   __@resources.type@__ - This field is required. @resources.type@ can
    --     only use the @Equals@ operator, and the value can be one of the
    --     following:
    --
    --     -   @AWS::S3::Object@
    --
    --     -   @AWS::Lambda::Function@
    --
    --     -   @AWS::DynamoDB::Table@
    --
    --     -   @AWS::S3Outposts::Object@
    --
    --     -   @AWS::ManagedBlockchain::Node@
    --
    --     -   @AWS::S3ObjectLambda::AccessPoint@
    --
    --     -   @AWS::EC2::Snapshot@
    --
    --     -   @AWS::S3::AccessPoint@
    --
    --     -   @AWS::DynamoDB::Stream@
    --
    --     -   @AWS::Glue::Table@
    --
    --     You can have only one @resources.type@ field per selector. To log
    --     data events on more than one resource type, add another selector.
    --
    -- -   __@resources.ARN@__ - You can use any operator with @resources.ARN@,
    --     but if you use @Equals@ or @NotEquals@, the value must exactly match
    --     the ARN of a valid resource of the type you\'ve specified in the
    --     template as the value of resources.type. For example, if
    --     resources.type equals @AWS::S3::Object@, the ARN must be in one of
    --     the following formats. To log all data events for all objects in a
    --     specific S3 bucket, use the @StartsWith@ operator, and include only
    --     the bucket ARN as the matching value.
    --
    --     The trailing slash is intentional; do not exclude it. Replace the
    --     text between less than and greater than symbols (\<>) with
    --     resource-specific information.
    --
    --     -   @arn:\<partition>:s3:::\<bucket_name>\/@
    --
    --     -   @arn:\<partition>:s3:::\<bucket_name>\/\<object_path>\/@
    --
    --     When @resources.type@ equals @AWS::S3::AccessPoint@, and the
    --     operator is set to @Equals@ or @NotEquals@, the ARN must be in one
    --     of the following formats. To log events on all objects in an S3
    --     access point, we recommend that you use only the access point ARN,
    --     don’t include the object path, and use the @StartsWith@ or
    --     @NotStartsWith@ operators.
    --
    --     -   @arn:\<partition>:s3:\<region>:\<account_ID>:accesspoint\/\<access_point_name>@
    --
    --     -   @arn:\<partition>:s3:\<region>:\<account_ID>:accesspoint\/\<access_point_name>\/object\/\<object_path>@
    --
    --     When resources.type equals @AWS::Lambda::Function@, and the operator
    --     is set to @Equals@ or @NotEquals@, the ARN must be in the following
    --     format:
    --
    --     -   @arn:\<partition>:lambda:\<region>:\<account_ID>:function:\<function_name>@
    --
    --     When resources.type equals @AWS::DynamoDB::Table@, and the operator
    --     is set to @Equals@ or @NotEquals@, the ARN must be in the following
    --     format:
    --
    --     -   @arn:\<partition>:dynamodb:\<region>:\<account_ID>:table\/\<table_name>@
    --
    --     When @resources.type@ equals @AWS::S3Outposts::Object@, and the
    --     operator is set to @Equals@ or @NotEquals@, the ARN must be in the
    --     following format:
    --
    --     -   @arn:\<partition>:s3-outposts:\<region>:\<account_ID>:\<object_path>@
    --
    --     When @resources.type@ equals @AWS::ManagedBlockchain::Node@, and the
    --     operator is set to @Equals@ or @NotEquals@, the ARN must be in the
    --     following format:
    --
    --     -   @arn:\<partition>:managedblockchain:\<region>:\<account_ID>:nodes\/\<node_ID>@
    --
    --     When @resources.type@ equals @AWS::S3ObjectLambda::AccessPoint@, and
    --     the operator is set to @Equals@ or @NotEquals@, the ARN must be in
    --     the following format:
    --
    --     -   @arn:\<partition>:s3-object-lambda:\<region>:\<account_ID>:accesspoint\/\<access_point_name>@
    --
    --     When @resources.type@ equals @AWS::EC2::Snapshot@, and the operator
    --     is set to @Equals@ or @NotEquals@, the ARN must be in the following
    --     format:
    --
    --     -   @arn:\<partition>:ec2:\<region>::snapshot\/\<snapshot_ID>@
    --
    --     When @resources.type@ equals @AWS::DynamoDB::Stream@, and the
    --     operator is set to @Equals@ or @NotEquals@, the ARN must be in the
    --     following format:
    --
    --     -   @arn:\<partition>:dynamodb:\<region>:\<account_ID>:table\/\<table_name>\/stream\/\<date_time>@
    --
    --     When @resources.type@ equals @AWS::Glue::Table@, and the operator is
    --     set to @Equals@ or @NotEquals@, the ARN must be in the following
    --     format:
    --
    --     -   @arn:\<partition>:glue:\<region>:\<account_ID>:table\/\<database_name>\/\<table_name>@
    AdvancedFieldSelector -> Text
field :: Prelude.Text
  }
  deriving (AdvancedFieldSelector -> AdvancedFieldSelector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdvancedFieldSelector -> AdvancedFieldSelector -> Bool
$c/= :: AdvancedFieldSelector -> AdvancedFieldSelector -> Bool
== :: AdvancedFieldSelector -> AdvancedFieldSelector -> Bool
$c== :: AdvancedFieldSelector -> AdvancedFieldSelector -> Bool
Prelude.Eq, ReadPrec [AdvancedFieldSelector]
ReadPrec AdvancedFieldSelector
Int -> ReadS AdvancedFieldSelector
ReadS [AdvancedFieldSelector]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AdvancedFieldSelector]
$creadListPrec :: ReadPrec [AdvancedFieldSelector]
readPrec :: ReadPrec AdvancedFieldSelector
$creadPrec :: ReadPrec AdvancedFieldSelector
readList :: ReadS [AdvancedFieldSelector]
$creadList :: ReadS [AdvancedFieldSelector]
readsPrec :: Int -> ReadS AdvancedFieldSelector
$creadsPrec :: Int -> ReadS AdvancedFieldSelector
Prelude.Read, Int -> AdvancedFieldSelector -> ShowS
[AdvancedFieldSelector] -> ShowS
AdvancedFieldSelector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdvancedFieldSelector] -> ShowS
$cshowList :: [AdvancedFieldSelector] -> ShowS
show :: AdvancedFieldSelector -> String
$cshow :: AdvancedFieldSelector -> String
showsPrec :: Int -> AdvancedFieldSelector -> ShowS
$cshowsPrec :: Int -> AdvancedFieldSelector -> ShowS
Prelude.Show, forall x. Rep AdvancedFieldSelector x -> AdvancedFieldSelector
forall x. AdvancedFieldSelector -> Rep AdvancedFieldSelector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AdvancedFieldSelector x -> AdvancedFieldSelector
$cfrom :: forall x. AdvancedFieldSelector -> Rep AdvancedFieldSelector x
Prelude.Generic)

-- |
-- Create a value of 'AdvancedFieldSelector' 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:
--
-- 'endsWith', 'advancedFieldSelector_endsWith' - An operator that includes events that match the last few characters of
-- the event record field specified as the value of @Field@.
--
-- 'equals', 'advancedFieldSelector_equals' - An operator that includes events that match the exact value of the event
-- record field specified as the value of @Field@. This is the only valid
-- operator that you can use with the @readOnly@, @eventCategory@, and
-- @resources.type@ fields.
--
-- 'notEndsWith', 'advancedFieldSelector_notEndsWith' - An operator that excludes events that match the last few characters of
-- the event record field specified as the value of @Field@.
--
-- 'notEquals', 'advancedFieldSelector_notEquals' - An operator that excludes events that match the exact value of the event
-- record field specified as the value of @Field@.
--
-- 'notStartsWith', 'advancedFieldSelector_notStartsWith' - An operator that excludes events that match the first few characters of
-- the event record field specified as the value of @Field@.
--
-- 'startsWith', 'advancedFieldSelector_startsWith' - An operator that includes events that match the first few characters of
-- the event record field specified as the value of @Field@.
--
-- 'field', 'advancedFieldSelector_field' - A field in an event record on which to filter events to be logged.
-- Supported fields include @readOnly@, @eventCategory@, @eventSource@ (for
-- management events), @eventName@, @resources.type@, and @resources.ARN@.
--
-- -   __@readOnly@__ - Optional. Can be set to @Equals@ a value of @true@
--     or @false@. If you do not add this field, CloudTrail logs both
--     @read@ and @write@ events. A value of @true@ logs only @read@
--     events. A value of @false@ logs only @write@ events.
--
-- -   __@eventSource@__ - For filtering management events only. This can
--     be set only to @NotEquals@ @kms.amazonaws.com@.
--
-- -   __@eventName@__ - Can use any operator. You can use it to filter in
--     or filter out any data event logged to CloudTrail, such as
--     @PutBucket@ or @GetSnapshotBlock@. You can have multiple values for
--     this field, separated by commas.
--
-- -   __@eventCategory@__ - This is required. It must be set to @Equals@,
--     and the value must be @Management@ or @Data@.
--
-- -   __@resources.type@__ - This field is required. @resources.type@ can
--     only use the @Equals@ operator, and the value can be one of the
--     following:
--
--     -   @AWS::S3::Object@
--
--     -   @AWS::Lambda::Function@
--
--     -   @AWS::DynamoDB::Table@
--
--     -   @AWS::S3Outposts::Object@
--
--     -   @AWS::ManagedBlockchain::Node@
--
--     -   @AWS::S3ObjectLambda::AccessPoint@
--
--     -   @AWS::EC2::Snapshot@
--
--     -   @AWS::S3::AccessPoint@
--
--     -   @AWS::DynamoDB::Stream@
--
--     -   @AWS::Glue::Table@
--
--     You can have only one @resources.type@ field per selector. To log
--     data events on more than one resource type, add another selector.
--
-- -   __@resources.ARN@__ - You can use any operator with @resources.ARN@,
--     but if you use @Equals@ or @NotEquals@, the value must exactly match
--     the ARN of a valid resource of the type you\'ve specified in the
--     template as the value of resources.type. For example, if
--     resources.type equals @AWS::S3::Object@, the ARN must be in one of
--     the following formats. To log all data events for all objects in a
--     specific S3 bucket, use the @StartsWith@ operator, and include only
--     the bucket ARN as the matching value.
--
--     The trailing slash is intentional; do not exclude it. Replace the
--     text between less than and greater than symbols (\<>) with
--     resource-specific information.
--
--     -   @arn:\<partition>:s3:::\<bucket_name>\/@
--
--     -   @arn:\<partition>:s3:::\<bucket_name>\/\<object_path>\/@
--
--     When @resources.type@ equals @AWS::S3::AccessPoint@, and the
--     operator is set to @Equals@ or @NotEquals@, the ARN must be in one
--     of the following formats. To log events on all objects in an S3
--     access point, we recommend that you use only the access point ARN,
--     don’t include the object path, and use the @StartsWith@ or
--     @NotStartsWith@ operators.
--
--     -   @arn:\<partition>:s3:\<region>:\<account_ID>:accesspoint\/\<access_point_name>@
--
--     -   @arn:\<partition>:s3:\<region>:\<account_ID>:accesspoint\/\<access_point_name>\/object\/\<object_path>@
--
--     When resources.type equals @AWS::Lambda::Function@, and the operator
--     is set to @Equals@ or @NotEquals@, the ARN must be in the following
--     format:
--
--     -   @arn:\<partition>:lambda:\<region>:\<account_ID>:function:\<function_name>@
--
--     When resources.type equals @AWS::DynamoDB::Table@, and the operator
--     is set to @Equals@ or @NotEquals@, the ARN must be in the following
--     format:
--
--     -   @arn:\<partition>:dynamodb:\<region>:\<account_ID>:table\/\<table_name>@
--
--     When @resources.type@ equals @AWS::S3Outposts::Object@, and the
--     operator is set to @Equals@ or @NotEquals@, the ARN must be in the
--     following format:
--
--     -   @arn:\<partition>:s3-outposts:\<region>:\<account_ID>:\<object_path>@
--
--     When @resources.type@ equals @AWS::ManagedBlockchain::Node@, and the
--     operator is set to @Equals@ or @NotEquals@, the ARN must be in the
--     following format:
--
--     -   @arn:\<partition>:managedblockchain:\<region>:\<account_ID>:nodes\/\<node_ID>@
--
--     When @resources.type@ equals @AWS::S3ObjectLambda::AccessPoint@, and
--     the operator is set to @Equals@ or @NotEquals@, the ARN must be in
--     the following format:
--
--     -   @arn:\<partition>:s3-object-lambda:\<region>:\<account_ID>:accesspoint\/\<access_point_name>@
--
--     When @resources.type@ equals @AWS::EC2::Snapshot@, and the operator
--     is set to @Equals@ or @NotEquals@, the ARN must be in the following
--     format:
--
--     -   @arn:\<partition>:ec2:\<region>::snapshot\/\<snapshot_ID>@
--
--     When @resources.type@ equals @AWS::DynamoDB::Stream@, and the
--     operator is set to @Equals@ or @NotEquals@, the ARN must be in the
--     following format:
--
--     -   @arn:\<partition>:dynamodb:\<region>:\<account_ID>:table\/\<table_name>\/stream\/\<date_time>@
--
--     When @resources.type@ equals @AWS::Glue::Table@, and the operator is
--     set to @Equals@ or @NotEquals@, the ARN must be in the following
--     format:
--
--     -   @arn:\<partition>:glue:\<region>:\<account_ID>:table\/\<database_name>\/\<table_name>@
newAdvancedFieldSelector ::
  -- | 'field'
  Prelude.Text ->
  AdvancedFieldSelector
newAdvancedFieldSelector :: Text -> AdvancedFieldSelector
newAdvancedFieldSelector Text
pField_ =
  AdvancedFieldSelector'
    { $sel:endsWith:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
endsWith = forall a. Maybe a
Prelude.Nothing,
      $sel:equals:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
equals = forall a. Maybe a
Prelude.Nothing,
      $sel:notEndsWith:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
notEndsWith = forall a. Maybe a
Prelude.Nothing,
      $sel:notEquals:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
notEquals = forall a. Maybe a
Prelude.Nothing,
      $sel:notStartsWith:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
notStartsWith = forall a. Maybe a
Prelude.Nothing,
      $sel:startsWith:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
startsWith = forall a. Maybe a
Prelude.Nothing,
      $sel:field:AdvancedFieldSelector' :: Text
field = Text
pField_
    }

-- | An operator that includes events that match the last few characters of
-- the event record field specified as the value of @Field@.
advancedFieldSelector_endsWith :: Lens.Lens' AdvancedFieldSelector (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
advancedFieldSelector_endsWith :: Lens' AdvancedFieldSelector (Maybe (NonEmpty Text))
advancedFieldSelector_endsWith = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdvancedFieldSelector' {Maybe (NonEmpty Text)
endsWith :: Maybe (NonEmpty Text)
$sel:endsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
endsWith} -> Maybe (NonEmpty Text)
endsWith) (\s :: AdvancedFieldSelector
s@AdvancedFieldSelector' {} Maybe (NonEmpty Text)
a -> AdvancedFieldSelector
s {$sel:endsWith:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
endsWith = Maybe (NonEmpty Text)
a} :: AdvancedFieldSelector) 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 operator that includes events that match the exact value of the event
-- record field specified as the value of @Field@. This is the only valid
-- operator that you can use with the @readOnly@, @eventCategory@, and
-- @resources.type@ fields.
advancedFieldSelector_equals :: Lens.Lens' AdvancedFieldSelector (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
advancedFieldSelector_equals :: Lens' AdvancedFieldSelector (Maybe (NonEmpty Text))
advancedFieldSelector_equals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdvancedFieldSelector' {Maybe (NonEmpty Text)
equals :: Maybe (NonEmpty Text)
$sel:equals:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
equals} -> Maybe (NonEmpty Text)
equals) (\s :: AdvancedFieldSelector
s@AdvancedFieldSelector' {} Maybe (NonEmpty Text)
a -> AdvancedFieldSelector
s {$sel:equals:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
equals = Maybe (NonEmpty Text)
a} :: AdvancedFieldSelector) 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 operator that excludes events that match the last few characters of
-- the event record field specified as the value of @Field@.
advancedFieldSelector_notEndsWith :: Lens.Lens' AdvancedFieldSelector (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
advancedFieldSelector_notEndsWith :: Lens' AdvancedFieldSelector (Maybe (NonEmpty Text))
advancedFieldSelector_notEndsWith = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdvancedFieldSelector' {Maybe (NonEmpty Text)
notEndsWith :: Maybe (NonEmpty Text)
$sel:notEndsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
notEndsWith} -> Maybe (NonEmpty Text)
notEndsWith) (\s :: AdvancedFieldSelector
s@AdvancedFieldSelector' {} Maybe (NonEmpty Text)
a -> AdvancedFieldSelector
s {$sel:notEndsWith:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
notEndsWith = Maybe (NonEmpty Text)
a} :: AdvancedFieldSelector) 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 operator that excludes events that match the exact value of the event
-- record field specified as the value of @Field@.
advancedFieldSelector_notEquals :: Lens.Lens' AdvancedFieldSelector (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
advancedFieldSelector_notEquals :: Lens' AdvancedFieldSelector (Maybe (NonEmpty Text))
advancedFieldSelector_notEquals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdvancedFieldSelector' {Maybe (NonEmpty Text)
notEquals :: Maybe (NonEmpty Text)
$sel:notEquals:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
notEquals} -> Maybe (NonEmpty Text)
notEquals) (\s :: AdvancedFieldSelector
s@AdvancedFieldSelector' {} Maybe (NonEmpty Text)
a -> AdvancedFieldSelector
s {$sel:notEquals:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
notEquals = Maybe (NonEmpty Text)
a} :: AdvancedFieldSelector) 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 operator that excludes events that match the first few characters of
-- the event record field specified as the value of @Field@.
advancedFieldSelector_notStartsWith :: Lens.Lens' AdvancedFieldSelector (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
advancedFieldSelector_notStartsWith :: Lens' AdvancedFieldSelector (Maybe (NonEmpty Text))
advancedFieldSelector_notStartsWith = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdvancedFieldSelector' {Maybe (NonEmpty Text)
notStartsWith :: Maybe (NonEmpty Text)
$sel:notStartsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
notStartsWith} -> Maybe (NonEmpty Text)
notStartsWith) (\s :: AdvancedFieldSelector
s@AdvancedFieldSelector' {} Maybe (NonEmpty Text)
a -> AdvancedFieldSelector
s {$sel:notStartsWith:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
notStartsWith = Maybe (NonEmpty Text)
a} :: AdvancedFieldSelector) 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 operator that includes events that match the first few characters of
-- the event record field specified as the value of @Field@.
advancedFieldSelector_startsWith :: Lens.Lens' AdvancedFieldSelector (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
advancedFieldSelector_startsWith :: Lens' AdvancedFieldSelector (Maybe (NonEmpty Text))
advancedFieldSelector_startsWith = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdvancedFieldSelector' {Maybe (NonEmpty Text)
startsWith :: Maybe (NonEmpty Text)
$sel:startsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
startsWith} -> Maybe (NonEmpty Text)
startsWith) (\s :: AdvancedFieldSelector
s@AdvancedFieldSelector' {} Maybe (NonEmpty Text)
a -> AdvancedFieldSelector
s {$sel:startsWith:AdvancedFieldSelector' :: Maybe (NonEmpty Text)
startsWith = Maybe (NonEmpty Text)
a} :: AdvancedFieldSelector) 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

-- | A field in an event record on which to filter events to be logged.
-- Supported fields include @readOnly@, @eventCategory@, @eventSource@ (for
-- management events), @eventName@, @resources.type@, and @resources.ARN@.
--
-- -   __@readOnly@__ - Optional. Can be set to @Equals@ a value of @true@
--     or @false@. If you do not add this field, CloudTrail logs both
--     @read@ and @write@ events. A value of @true@ logs only @read@
--     events. A value of @false@ logs only @write@ events.
--
-- -   __@eventSource@__ - For filtering management events only. This can
--     be set only to @NotEquals@ @kms.amazonaws.com@.
--
-- -   __@eventName@__ - Can use any operator. You can use it to filter in
--     or filter out any data event logged to CloudTrail, such as
--     @PutBucket@ or @GetSnapshotBlock@. You can have multiple values for
--     this field, separated by commas.
--
-- -   __@eventCategory@__ - This is required. It must be set to @Equals@,
--     and the value must be @Management@ or @Data@.
--
-- -   __@resources.type@__ - This field is required. @resources.type@ can
--     only use the @Equals@ operator, and the value can be one of the
--     following:
--
--     -   @AWS::S3::Object@
--
--     -   @AWS::Lambda::Function@
--
--     -   @AWS::DynamoDB::Table@
--
--     -   @AWS::S3Outposts::Object@
--
--     -   @AWS::ManagedBlockchain::Node@
--
--     -   @AWS::S3ObjectLambda::AccessPoint@
--
--     -   @AWS::EC2::Snapshot@
--
--     -   @AWS::S3::AccessPoint@
--
--     -   @AWS::DynamoDB::Stream@
--
--     -   @AWS::Glue::Table@
--
--     You can have only one @resources.type@ field per selector. To log
--     data events on more than one resource type, add another selector.
--
-- -   __@resources.ARN@__ - You can use any operator with @resources.ARN@,
--     but if you use @Equals@ or @NotEquals@, the value must exactly match
--     the ARN of a valid resource of the type you\'ve specified in the
--     template as the value of resources.type. For example, if
--     resources.type equals @AWS::S3::Object@, the ARN must be in one of
--     the following formats. To log all data events for all objects in a
--     specific S3 bucket, use the @StartsWith@ operator, and include only
--     the bucket ARN as the matching value.
--
--     The trailing slash is intentional; do not exclude it. Replace the
--     text between less than and greater than symbols (\<>) with
--     resource-specific information.
--
--     -   @arn:\<partition>:s3:::\<bucket_name>\/@
--
--     -   @arn:\<partition>:s3:::\<bucket_name>\/\<object_path>\/@
--
--     When @resources.type@ equals @AWS::S3::AccessPoint@, and the
--     operator is set to @Equals@ or @NotEquals@, the ARN must be in one
--     of the following formats. To log events on all objects in an S3
--     access point, we recommend that you use only the access point ARN,
--     don’t include the object path, and use the @StartsWith@ or
--     @NotStartsWith@ operators.
--
--     -   @arn:\<partition>:s3:\<region>:\<account_ID>:accesspoint\/\<access_point_name>@
--
--     -   @arn:\<partition>:s3:\<region>:\<account_ID>:accesspoint\/\<access_point_name>\/object\/\<object_path>@
--
--     When resources.type equals @AWS::Lambda::Function@, and the operator
--     is set to @Equals@ or @NotEquals@, the ARN must be in the following
--     format:
--
--     -   @arn:\<partition>:lambda:\<region>:\<account_ID>:function:\<function_name>@
--
--     When resources.type equals @AWS::DynamoDB::Table@, and the operator
--     is set to @Equals@ or @NotEquals@, the ARN must be in the following
--     format:
--
--     -   @arn:\<partition>:dynamodb:\<region>:\<account_ID>:table\/\<table_name>@
--
--     When @resources.type@ equals @AWS::S3Outposts::Object@, and the
--     operator is set to @Equals@ or @NotEquals@, the ARN must be in the
--     following format:
--
--     -   @arn:\<partition>:s3-outposts:\<region>:\<account_ID>:\<object_path>@
--
--     When @resources.type@ equals @AWS::ManagedBlockchain::Node@, and the
--     operator is set to @Equals@ or @NotEquals@, the ARN must be in the
--     following format:
--
--     -   @arn:\<partition>:managedblockchain:\<region>:\<account_ID>:nodes\/\<node_ID>@
--
--     When @resources.type@ equals @AWS::S3ObjectLambda::AccessPoint@, and
--     the operator is set to @Equals@ or @NotEquals@, the ARN must be in
--     the following format:
--
--     -   @arn:\<partition>:s3-object-lambda:\<region>:\<account_ID>:accesspoint\/\<access_point_name>@
--
--     When @resources.type@ equals @AWS::EC2::Snapshot@, and the operator
--     is set to @Equals@ or @NotEquals@, the ARN must be in the following
--     format:
--
--     -   @arn:\<partition>:ec2:\<region>::snapshot\/\<snapshot_ID>@
--
--     When @resources.type@ equals @AWS::DynamoDB::Stream@, and the
--     operator is set to @Equals@ or @NotEquals@, the ARN must be in the
--     following format:
--
--     -   @arn:\<partition>:dynamodb:\<region>:\<account_ID>:table\/\<table_name>\/stream\/\<date_time>@
--
--     When @resources.type@ equals @AWS::Glue::Table@, and the operator is
--     set to @Equals@ or @NotEquals@, the ARN must be in the following
--     format:
--
--     -   @arn:\<partition>:glue:\<region>:\<account_ID>:table\/\<database_name>\/\<table_name>@
advancedFieldSelector_field :: Lens.Lens' AdvancedFieldSelector Prelude.Text
advancedFieldSelector_field :: Lens' AdvancedFieldSelector Text
advancedFieldSelector_field = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdvancedFieldSelector' {Text
field :: Text
$sel:field:AdvancedFieldSelector' :: AdvancedFieldSelector -> Text
field} -> Text
field) (\s :: AdvancedFieldSelector
s@AdvancedFieldSelector' {} Text
a -> AdvancedFieldSelector
s {$sel:field:AdvancedFieldSelector' :: Text
field = Text
a} :: AdvancedFieldSelector)

instance Data.FromJSON AdvancedFieldSelector where
  parseJSON :: Value -> Parser AdvancedFieldSelector
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"AdvancedFieldSelector"
      ( \Object
x ->
          Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Maybe (NonEmpty Text)
-> Text
-> AdvancedFieldSelector
AdvancedFieldSelector'
            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
"EndsWith")
            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
"Equals")
            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
"NotEndsWith")
            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
"NotEquals")
            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
"NotStartsWith")
            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
"StartsWith")
            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
"Field")
      )

instance Prelude.Hashable AdvancedFieldSelector where
  hashWithSalt :: Int -> AdvancedFieldSelector -> Int
hashWithSalt Int
_salt AdvancedFieldSelector' {Maybe (NonEmpty Text)
Text
field :: Text
startsWith :: Maybe (NonEmpty Text)
notStartsWith :: Maybe (NonEmpty Text)
notEquals :: Maybe (NonEmpty Text)
notEndsWith :: Maybe (NonEmpty Text)
equals :: Maybe (NonEmpty Text)
endsWith :: Maybe (NonEmpty Text)
$sel:field:AdvancedFieldSelector' :: AdvancedFieldSelector -> Text
$sel:startsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:notStartsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:notEquals:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:notEndsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:equals:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:endsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
endsWith
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
equals
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
notEndsWith
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
notEquals
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
notStartsWith
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
startsWith
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
field

instance Prelude.NFData AdvancedFieldSelector where
  rnf :: AdvancedFieldSelector -> ()
rnf AdvancedFieldSelector' {Maybe (NonEmpty Text)
Text
field :: Text
startsWith :: Maybe (NonEmpty Text)
notStartsWith :: Maybe (NonEmpty Text)
notEquals :: Maybe (NonEmpty Text)
notEndsWith :: Maybe (NonEmpty Text)
equals :: Maybe (NonEmpty Text)
endsWith :: Maybe (NonEmpty Text)
$sel:field:AdvancedFieldSelector' :: AdvancedFieldSelector -> Text
$sel:startsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:notStartsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:notEquals:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:notEndsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:equals:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:endsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
endsWith
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
equals
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
notEndsWith
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
notEquals
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
notStartsWith
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
startsWith
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
field

instance Data.ToJSON AdvancedFieldSelector where
  toJSON :: AdvancedFieldSelector -> Value
toJSON AdvancedFieldSelector' {Maybe (NonEmpty Text)
Text
field :: Text
startsWith :: Maybe (NonEmpty Text)
notStartsWith :: Maybe (NonEmpty Text)
notEquals :: Maybe (NonEmpty Text)
notEndsWith :: Maybe (NonEmpty Text)
equals :: Maybe (NonEmpty Text)
endsWith :: Maybe (NonEmpty Text)
$sel:field:AdvancedFieldSelector' :: AdvancedFieldSelector -> Text
$sel:startsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:notStartsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:notEquals:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:notEndsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:equals:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
$sel:endsWith:AdvancedFieldSelector' :: AdvancedFieldSelector -> Maybe (NonEmpty Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EndsWith" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
endsWith,
            (Key
"Equals" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
equals,
            (Key
"NotEndsWith" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
notEndsWith,
            (Key
"NotEquals" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
notEquals,
            (Key
"NotStartsWith" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
notStartsWith,
            (Key
"StartsWith" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
startsWith,
            forall a. a -> Maybe a
Prelude.Just (Key
"Field" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
field)
          ]
      )