{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.MacieV2.Types.TagScopeTerm
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.MacieV2.Types.TagScopeTerm where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MacieV2.Types.JobComparator
import Amazonka.MacieV2.Types.TagTarget
import Amazonka.MacieV2.Types.TagValuePair
import qualified Amazonka.Prelude as Prelude

-- | Specifies a tag-based condition that determines whether an S3 object is
-- included or excluded from a classification job.
--
-- /See:/ 'newTagScopeTerm' smart constructor.
data TagScopeTerm = TagScopeTerm'
  { -- | The operator to use in the condition. Valid values are EQ (equals) or NE
    -- (not equals).
    TagScopeTerm -> Maybe JobComparator
comparator :: Prelude.Maybe JobComparator,
    -- | The object property to use in the condition. The only valid value is
    -- TAG.
    TagScopeTerm -> Maybe Text
key :: Prelude.Maybe Prelude.Text,
    -- | The tag keys or tag key and value pairs to use in the condition. To
    -- specify only tag keys in a condition, specify the keys in this array and
    -- set the value for each associated tag value to an empty string.
    TagScopeTerm -> Maybe [TagValuePair]
tagValues :: Prelude.Maybe [TagValuePair],
    -- | The type of object to apply the condition to.
    TagScopeTerm -> Maybe TagTarget
target :: Prelude.Maybe TagTarget
  }
  deriving (TagScopeTerm -> TagScopeTerm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagScopeTerm -> TagScopeTerm -> Bool
$c/= :: TagScopeTerm -> TagScopeTerm -> Bool
== :: TagScopeTerm -> TagScopeTerm -> Bool
$c== :: TagScopeTerm -> TagScopeTerm -> Bool
Prelude.Eq, ReadPrec [TagScopeTerm]
ReadPrec TagScopeTerm
Int -> ReadS TagScopeTerm
ReadS [TagScopeTerm]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagScopeTerm]
$creadListPrec :: ReadPrec [TagScopeTerm]
readPrec :: ReadPrec TagScopeTerm
$creadPrec :: ReadPrec TagScopeTerm
readList :: ReadS [TagScopeTerm]
$creadList :: ReadS [TagScopeTerm]
readsPrec :: Int -> ReadS TagScopeTerm
$creadsPrec :: Int -> ReadS TagScopeTerm
Prelude.Read, Int -> TagScopeTerm -> ShowS
[TagScopeTerm] -> ShowS
TagScopeTerm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagScopeTerm] -> ShowS
$cshowList :: [TagScopeTerm] -> ShowS
show :: TagScopeTerm -> String
$cshow :: TagScopeTerm -> String
showsPrec :: Int -> TagScopeTerm -> ShowS
$cshowsPrec :: Int -> TagScopeTerm -> ShowS
Prelude.Show, forall x. Rep TagScopeTerm x -> TagScopeTerm
forall x. TagScopeTerm -> Rep TagScopeTerm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagScopeTerm x -> TagScopeTerm
$cfrom :: forall x. TagScopeTerm -> Rep TagScopeTerm x
Prelude.Generic)

-- |
-- Create a value of 'TagScopeTerm' 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:
--
-- 'comparator', 'tagScopeTerm_comparator' - The operator to use in the condition. Valid values are EQ (equals) or NE
-- (not equals).
--
-- 'key', 'tagScopeTerm_key' - The object property to use in the condition. The only valid value is
-- TAG.
--
-- 'tagValues', 'tagScopeTerm_tagValues' - The tag keys or tag key and value pairs to use in the condition. To
-- specify only tag keys in a condition, specify the keys in this array and
-- set the value for each associated tag value to an empty string.
--
-- 'target', 'tagScopeTerm_target' - The type of object to apply the condition to.
newTagScopeTerm ::
  TagScopeTerm
newTagScopeTerm :: TagScopeTerm
newTagScopeTerm =
  TagScopeTerm'
    { $sel:comparator:TagScopeTerm' :: Maybe JobComparator
comparator = forall a. Maybe a
Prelude.Nothing,
      $sel:key:TagScopeTerm' :: Maybe Text
key = forall a. Maybe a
Prelude.Nothing,
      $sel:tagValues:TagScopeTerm' :: Maybe [TagValuePair]
tagValues = forall a. Maybe a
Prelude.Nothing,
      $sel:target:TagScopeTerm' :: Maybe TagTarget
target = forall a. Maybe a
Prelude.Nothing
    }

-- | The operator to use in the condition. Valid values are EQ (equals) or NE
-- (not equals).
tagScopeTerm_comparator :: Lens.Lens' TagScopeTerm (Prelude.Maybe JobComparator)
tagScopeTerm_comparator :: Lens' TagScopeTerm (Maybe JobComparator)
tagScopeTerm_comparator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagScopeTerm' {Maybe JobComparator
comparator :: Maybe JobComparator
$sel:comparator:TagScopeTerm' :: TagScopeTerm -> Maybe JobComparator
comparator} -> Maybe JobComparator
comparator) (\s :: TagScopeTerm
s@TagScopeTerm' {} Maybe JobComparator
a -> TagScopeTerm
s {$sel:comparator:TagScopeTerm' :: Maybe JobComparator
comparator = Maybe JobComparator
a} :: TagScopeTerm)

-- | The object property to use in the condition. The only valid value is
-- TAG.
tagScopeTerm_key :: Lens.Lens' TagScopeTerm (Prelude.Maybe Prelude.Text)
tagScopeTerm_key :: Lens' TagScopeTerm (Maybe Text)
tagScopeTerm_key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagScopeTerm' {Maybe Text
key :: Maybe Text
$sel:key:TagScopeTerm' :: TagScopeTerm -> Maybe Text
key} -> Maybe Text
key) (\s :: TagScopeTerm
s@TagScopeTerm' {} Maybe Text
a -> TagScopeTerm
s {$sel:key:TagScopeTerm' :: Maybe Text
key = Maybe Text
a} :: TagScopeTerm)

-- | The tag keys or tag key and value pairs to use in the condition. To
-- specify only tag keys in a condition, specify the keys in this array and
-- set the value for each associated tag value to an empty string.
tagScopeTerm_tagValues :: Lens.Lens' TagScopeTerm (Prelude.Maybe [TagValuePair])
tagScopeTerm_tagValues :: Lens' TagScopeTerm (Maybe [TagValuePair])
tagScopeTerm_tagValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagScopeTerm' {Maybe [TagValuePair]
tagValues :: Maybe [TagValuePair]
$sel:tagValues:TagScopeTerm' :: TagScopeTerm -> Maybe [TagValuePair]
tagValues} -> Maybe [TagValuePair]
tagValues) (\s :: TagScopeTerm
s@TagScopeTerm' {} Maybe [TagValuePair]
a -> TagScopeTerm
s {$sel:tagValues:TagScopeTerm' :: Maybe [TagValuePair]
tagValues = Maybe [TagValuePair]
a} :: TagScopeTerm) 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 type of object to apply the condition to.
tagScopeTerm_target :: Lens.Lens' TagScopeTerm (Prelude.Maybe TagTarget)
tagScopeTerm_target :: Lens' TagScopeTerm (Maybe TagTarget)
tagScopeTerm_target = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagScopeTerm' {Maybe TagTarget
target :: Maybe TagTarget
$sel:target:TagScopeTerm' :: TagScopeTerm -> Maybe TagTarget
target} -> Maybe TagTarget
target) (\s :: TagScopeTerm
s@TagScopeTerm' {} Maybe TagTarget
a -> TagScopeTerm
s {$sel:target:TagScopeTerm' :: Maybe TagTarget
target = Maybe TagTarget
a} :: TagScopeTerm)

instance Data.FromJSON TagScopeTerm where
  parseJSON :: Value -> Parser TagScopeTerm
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"TagScopeTerm"
      ( \Object
x ->
          Maybe JobComparator
-> Maybe Text
-> Maybe [TagValuePair]
-> Maybe TagTarget
-> TagScopeTerm
TagScopeTerm'
            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
"comparator")
            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
"key")
            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
"tagValues" 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
"target")
      )

instance Prelude.Hashable TagScopeTerm where
  hashWithSalt :: Int -> TagScopeTerm -> Int
hashWithSalt Int
_salt TagScopeTerm' {Maybe [TagValuePair]
Maybe Text
Maybe JobComparator
Maybe TagTarget
target :: Maybe TagTarget
tagValues :: Maybe [TagValuePair]
key :: Maybe Text
comparator :: Maybe JobComparator
$sel:target:TagScopeTerm' :: TagScopeTerm -> Maybe TagTarget
$sel:tagValues:TagScopeTerm' :: TagScopeTerm -> Maybe [TagValuePair]
$sel:key:TagScopeTerm' :: TagScopeTerm -> Maybe Text
$sel:comparator:TagScopeTerm' :: TagScopeTerm -> Maybe JobComparator
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobComparator
comparator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
key
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagValuePair]
tagValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TagTarget
target

instance Prelude.NFData TagScopeTerm where
  rnf :: TagScopeTerm -> ()
rnf TagScopeTerm' {Maybe [TagValuePair]
Maybe Text
Maybe JobComparator
Maybe TagTarget
target :: Maybe TagTarget
tagValues :: Maybe [TagValuePair]
key :: Maybe Text
comparator :: Maybe JobComparator
$sel:target:TagScopeTerm' :: TagScopeTerm -> Maybe TagTarget
$sel:tagValues:TagScopeTerm' :: TagScopeTerm -> Maybe [TagValuePair]
$sel:key:TagScopeTerm' :: TagScopeTerm -> Maybe Text
$sel:comparator:TagScopeTerm' :: TagScopeTerm -> Maybe JobComparator
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe JobComparator
comparator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
key
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagValuePair]
tagValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TagTarget
target

instance Data.ToJSON TagScopeTerm where
  toJSON :: TagScopeTerm -> Value
toJSON TagScopeTerm' {Maybe [TagValuePair]
Maybe Text
Maybe JobComparator
Maybe TagTarget
target :: Maybe TagTarget
tagValues :: Maybe [TagValuePair]
key :: Maybe Text
comparator :: Maybe JobComparator
$sel:target:TagScopeTerm' :: TagScopeTerm -> Maybe TagTarget
$sel:tagValues:TagScopeTerm' :: TagScopeTerm -> Maybe [TagValuePair]
$sel:key:TagScopeTerm' :: TagScopeTerm -> Maybe Text
$sel:comparator:TagScopeTerm' :: TagScopeTerm -> Maybe JobComparator
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"comparator" 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 JobComparator
comparator,
            (Key
"key" 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 Text
key,
            (Key
"tagValues" 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 [TagValuePair]
tagValues,
            (Key
"target" 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 TagTarget
target
          ]
      )