{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.CreateCustomDataIdentifier
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates and defines the criteria and other settings for a custom data
-- identifier.
module Amazonka.MacieV2.CreateCustomDataIdentifier
  ( -- * Creating a Request
    CreateCustomDataIdentifier (..),
    newCreateCustomDataIdentifier,

    -- * Request Lenses
    createCustomDataIdentifier_clientToken,
    createCustomDataIdentifier_description,
    createCustomDataIdentifier_ignoreWords,
    createCustomDataIdentifier_keywords,
    createCustomDataIdentifier_maximumMatchDistance,
    createCustomDataIdentifier_severityLevels,
    createCustomDataIdentifier_tags,
    createCustomDataIdentifier_regex,
    createCustomDataIdentifier_name,

    -- * Destructuring the Response
    CreateCustomDataIdentifierResponse (..),
    newCreateCustomDataIdentifierResponse,

    -- * Response Lenses
    createCustomDataIdentifierResponse_customDataIdentifierId,
    createCustomDataIdentifierResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateCustomDataIdentifier' smart constructor.
data CreateCustomDataIdentifier = CreateCustomDataIdentifier'
  { -- | A unique, case-sensitive token that you provide to ensure the
    -- idempotency of the request.
    CreateCustomDataIdentifier -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A custom description of the custom data identifier. The description can
    -- contain as many as 512 characters.
    --
    -- We strongly recommend that you avoid including any sensitive data in the
    -- description of a custom data identifier. Other users of your account
    -- might be able to see this description, depending on the actions that
    -- they\'re allowed to perform in Amazon Macie.
    CreateCustomDataIdentifier -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An array that lists specific character sequences (/ignore words/) to
    -- exclude from the results. If the text matched by the regular expression
    -- contains any string in this array, Amazon Macie ignores it. The array
    -- can contain as many as 10 ignore words. Each ignore word can contain
    -- 4-90 UTF-8 characters. Ignore words are case sensitive.
    CreateCustomDataIdentifier -> Maybe [Text]
ignoreWords :: Prelude.Maybe [Prelude.Text],
    -- | An array that lists specific character sequences (/keywords/), one of
    -- which must precede and be within proximity (maximumMatchDistance) of the
    -- regular expression to match. The array can contain as many as 50
    -- keywords. Each keyword can contain 3-90 UTF-8 characters. Keywords
    -- aren\'t case sensitive.
    CreateCustomDataIdentifier -> Maybe [Text]
keywords :: Prelude.Maybe [Prelude.Text],
    -- | The maximum number of characters that can exist between the end of at
    -- least one complete character sequence specified by the keywords array
    -- and the end of the text that matches the regex pattern. If a complete
    -- keyword precedes all the text that matches the pattern and the keyword
    -- is within the specified distance, Amazon Macie includes the result. The
    -- distance can be 1-300 characters. The default value is 50.
    CreateCustomDataIdentifier -> Maybe Int
maximumMatchDistance :: Prelude.Maybe Prelude.Int,
    -- | The severity to assign to findings that the custom data identifier
    -- produces, based on the number of occurrences of text that matches the
    -- custom data identifier\'s detection criteria. You can specify as many as
    -- three SeverityLevel objects in this array, one for each severity: LOW,
    -- MEDIUM, or HIGH. If you specify more than one, the occurrences
    -- thresholds must be in ascending order by severity, moving from LOW to
    -- HIGH. For example, 1 for LOW, 50 for MEDIUM, and 100 for HIGH. If an S3
    -- object contains fewer occurrences than the lowest specified threshold,
    -- Amazon Macie doesn\'t create a finding.
    --
    -- If you don\'t specify any values for this array, Macie creates findings
    -- for S3 objects that contain at least one occurrence of text that matches
    -- the detection criteria, and Macie assigns the MEDIUM severity to those
    -- findings.
    CreateCustomDataIdentifier -> Maybe [SeverityLevel]
severityLevels :: Prelude.Maybe [SeverityLevel],
    -- | A map of key-value pairs that specifies the tags to associate with the
    -- custom data identifier.
    --
    -- A custom data identifier can have a maximum of 50 tags. Each tag
    -- consists of a tag key and an associated tag value. The maximum length of
    -- a tag key is 128 characters. The maximum length of a tag value is 256
    -- characters.
    CreateCustomDataIdentifier -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The regular expression (/regex/) that defines the pattern to match. The
    -- expression can contain as many as 512 characters.
    CreateCustomDataIdentifier -> Text
regex :: Prelude.Text,
    -- | A custom name for the custom data identifier. The name can contain as
    -- many as 128 characters.
    --
    -- We strongly recommend that you avoid including any sensitive data in the
    -- name of a custom data identifier. Other users of your account might be
    -- able to see this name, depending on the actions that they\'re allowed to
    -- perform in Amazon Macie.
    CreateCustomDataIdentifier -> Text
name :: Prelude.Text
  }
  deriving (CreateCustomDataIdentifier -> CreateCustomDataIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCustomDataIdentifier -> CreateCustomDataIdentifier -> Bool
$c/= :: CreateCustomDataIdentifier -> CreateCustomDataIdentifier -> Bool
== :: CreateCustomDataIdentifier -> CreateCustomDataIdentifier -> Bool
$c== :: CreateCustomDataIdentifier -> CreateCustomDataIdentifier -> Bool
Prelude.Eq, ReadPrec [CreateCustomDataIdentifier]
ReadPrec CreateCustomDataIdentifier
Int -> ReadS CreateCustomDataIdentifier
ReadS [CreateCustomDataIdentifier]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCustomDataIdentifier]
$creadListPrec :: ReadPrec [CreateCustomDataIdentifier]
readPrec :: ReadPrec CreateCustomDataIdentifier
$creadPrec :: ReadPrec CreateCustomDataIdentifier
readList :: ReadS [CreateCustomDataIdentifier]
$creadList :: ReadS [CreateCustomDataIdentifier]
readsPrec :: Int -> ReadS CreateCustomDataIdentifier
$creadsPrec :: Int -> ReadS CreateCustomDataIdentifier
Prelude.Read, Int -> CreateCustomDataIdentifier -> ShowS
[CreateCustomDataIdentifier] -> ShowS
CreateCustomDataIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCustomDataIdentifier] -> ShowS
$cshowList :: [CreateCustomDataIdentifier] -> ShowS
show :: CreateCustomDataIdentifier -> String
$cshow :: CreateCustomDataIdentifier -> String
showsPrec :: Int -> CreateCustomDataIdentifier -> ShowS
$cshowsPrec :: Int -> CreateCustomDataIdentifier -> ShowS
Prelude.Show, forall x.
Rep CreateCustomDataIdentifier x -> CreateCustomDataIdentifier
forall x.
CreateCustomDataIdentifier -> Rep CreateCustomDataIdentifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCustomDataIdentifier x -> CreateCustomDataIdentifier
$cfrom :: forall x.
CreateCustomDataIdentifier -> Rep CreateCustomDataIdentifier x
Prelude.Generic)

-- |
-- Create a value of 'CreateCustomDataIdentifier' 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:
--
-- 'clientToken', 'createCustomDataIdentifier_clientToken' - A unique, case-sensitive token that you provide to ensure the
-- idempotency of the request.
--
-- 'description', 'createCustomDataIdentifier_description' - A custom description of the custom data identifier. The description can
-- contain as many as 512 characters.
--
-- We strongly recommend that you avoid including any sensitive data in the
-- description of a custom data identifier. Other users of your account
-- might be able to see this description, depending on the actions that
-- they\'re allowed to perform in Amazon Macie.
--
-- 'ignoreWords', 'createCustomDataIdentifier_ignoreWords' - An array that lists specific character sequences (/ignore words/) to
-- exclude from the results. If the text matched by the regular expression
-- contains any string in this array, Amazon Macie ignores it. The array
-- can contain as many as 10 ignore words. Each ignore word can contain
-- 4-90 UTF-8 characters. Ignore words are case sensitive.
--
-- 'keywords', 'createCustomDataIdentifier_keywords' - An array that lists specific character sequences (/keywords/), one of
-- which must precede and be within proximity (maximumMatchDistance) of the
-- regular expression to match. The array can contain as many as 50
-- keywords. Each keyword can contain 3-90 UTF-8 characters. Keywords
-- aren\'t case sensitive.
--
-- 'maximumMatchDistance', 'createCustomDataIdentifier_maximumMatchDistance' - The maximum number of characters that can exist between the end of at
-- least one complete character sequence specified by the keywords array
-- and the end of the text that matches the regex pattern. If a complete
-- keyword precedes all the text that matches the pattern and the keyword
-- is within the specified distance, Amazon Macie includes the result. The
-- distance can be 1-300 characters. The default value is 50.
--
-- 'severityLevels', 'createCustomDataIdentifier_severityLevels' - The severity to assign to findings that the custom data identifier
-- produces, based on the number of occurrences of text that matches the
-- custom data identifier\'s detection criteria. You can specify as many as
-- three SeverityLevel objects in this array, one for each severity: LOW,
-- MEDIUM, or HIGH. If you specify more than one, the occurrences
-- thresholds must be in ascending order by severity, moving from LOW to
-- HIGH. For example, 1 for LOW, 50 for MEDIUM, and 100 for HIGH. If an S3
-- object contains fewer occurrences than the lowest specified threshold,
-- Amazon Macie doesn\'t create a finding.
--
-- If you don\'t specify any values for this array, Macie creates findings
-- for S3 objects that contain at least one occurrence of text that matches
-- the detection criteria, and Macie assigns the MEDIUM severity to those
-- findings.
--
-- 'tags', 'createCustomDataIdentifier_tags' - A map of key-value pairs that specifies the tags to associate with the
-- custom data identifier.
--
-- A custom data identifier can have a maximum of 50 tags. Each tag
-- consists of a tag key and an associated tag value. The maximum length of
-- a tag key is 128 characters. The maximum length of a tag value is 256
-- characters.
--
-- 'regex', 'createCustomDataIdentifier_regex' - The regular expression (/regex/) that defines the pattern to match. The
-- expression can contain as many as 512 characters.
--
-- 'name', 'createCustomDataIdentifier_name' - A custom name for the custom data identifier. The name can contain as
-- many as 128 characters.
--
-- We strongly recommend that you avoid including any sensitive data in the
-- name of a custom data identifier. Other users of your account might be
-- able to see this name, depending on the actions that they\'re allowed to
-- perform in Amazon Macie.
newCreateCustomDataIdentifier ::
  -- | 'regex'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  CreateCustomDataIdentifier
newCreateCustomDataIdentifier :: Text -> Text -> CreateCustomDataIdentifier
newCreateCustomDataIdentifier Text
pRegex_ Text
pName_ =
  CreateCustomDataIdentifier'
    { $sel:clientToken:CreateCustomDataIdentifier' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateCustomDataIdentifier' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:ignoreWords:CreateCustomDataIdentifier' :: Maybe [Text]
ignoreWords = forall a. Maybe a
Prelude.Nothing,
      $sel:keywords:CreateCustomDataIdentifier' :: Maybe [Text]
keywords = forall a. Maybe a
Prelude.Nothing,
      $sel:maximumMatchDistance:CreateCustomDataIdentifier' :: Maybe Int
maximumMatchDistance = forall a. Maybe a
Prelude.Nothing,
      $sel:severityLevels:CreateCustomDataIdentifier' :: Maybe [SeverityLevel]
severityLevels = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateCustomDataIdentifier' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:regex:CreateCustomDataIdentifier' :: Text
regex = Text
pRegex_,
      $sel:name:CreateCustomDataIdentifier' :: Text
name = Text
pName_
    }

-- | A unique, case-sensitive token that you provide to ensure the
-- idempotency of the request.
createCustomDataIdentifier_clientToken :: Lens.Lens' CreateCustomDataIdentifier (Prelude.Maybe Prelude.Text)
createCustomDataIdentifier_clientToken :: Lens' CreateCustomDataIdentifier (Maybe Text)
createCustomDataIdentifier_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifier' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateCustomDataIdentifier
s@CreateCustomDataIdentifier' {} Maybe Text
a -> CreateCustomDataIdentifier
s {$sel:clientToken:CreateCustomDataIdentifier' :: Maybe Text
clientToken = Maybe Text
a} :: CreateCustomDataIdentifier)

-- | A custom description of the custom data identifier. The description can
-- contain as many as 512 characters.
--
-- We strongly recommend that you avoid including any sensitive data in the
-- description of a custom data identifier. Other users of your account
-- might be able to see this description, depending on the actions that
-- they\'re allowed to perform in Amazon Macie.
createCustomDataIdentifier_description :: Lens.Lens' CreateCustomDataIdentifier (Prelude.Maybe Prelude.Text)
createCustomDataIdentifier_description :: Lens' CreateCustomDataIdentifier (Maybe Text)
createCustomDataIdentifier_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifier' {Maybe Text
description :: Maybe Text
$sel:description:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateCustomDataIdentifier
s@CreateCustomDataIdentifier' {} Maybe Text
a -> CreateCustomDataIdentifier
s {$sel:description:CreateCustomDataIdentifier' :: Maybe Text
description = Maybe Text
a} :: CreateCustomDataIdentifier)

-- | An array that lists specific character sequences (/ignore words/) to
-- exclude from the results. If the text matched by the regular expression
-- contains any string in this array, Amazon Macie ignores it. The array
-- can contain as many as 10 ignore words. Each ignore word can contain
-- 4-90 UTF-8 characters. Ignore words are case sensitive.
createCustomDataIdentifier_ignoreWords :: Lens.Lens' CreateCustomDataIdentifier (Prelude.Maybe [Prelude.Text])
createCustomDataIdentifier_ignoreWords :: Lens' CreateCustomDataIdentifier (Maybe [Text])
createCustomDataIdentifier_ignoreWords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifier' {Maybe [Text]
ignoreWords :: Maybe [Text]
$sel:ignoreWords:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [Text]
ignoreWords} -> Maybe [Text]
ignoreWords) (\s :: CreateCustomDataIdentifier
s@CreateCustomDataIdentifier' {} Maybe [Text]
a -> CreateCustomDataIdentifier
s {$sel:ignoreWords:CreateCustomDataIdentifier' :: Maybe [Text]
ignoreWords = Maybe [Text]
a} :: CreateCustomDataIdentifier) 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 array that lists specific character sequences (/keywords/), one of
-- which must precede and be within proximity (maximumMatchDistance) of the
-- regular expression to match. The array can contain as many as 50
-- keywords. Each keyword can contain 3-90 UTF-8 characters. Keywords
-- aren\'t case sensitive.
createCustomDataIdentifier_keywords :: Lens.Lens' CreateCustomDataIdentifier (Prelude.Maybe [Prelude.Text])
createCustomDataIdentifier_keywords :: Lens' CreateCustomDataIdentifier (Maybe [Text])
createCustomDataIdentifier_keywords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifier' {Maybe [Text]
keywords :: Maybe [Text]
$sel:keywords:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [Text]
keywords} -> Maybe [Text]
keywords) (\s :: CreateCustomDataIdentifier
s@CreateCustomDataIdentifier' {} Maybe [Text]
a -> CreateCustomDataIdentifier
s {$sel:keywords:CreateCustomDataIdentifier' :: Maybe [Text]
keywords = Maybe [Text]
a} :: CreateCustomDataIdentifier) 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 maximum number of characters that can exist between the end of at
-- least one complete character sequence specified by the keywords array
-- and the end of the text that matches the regex pattern. If a complete
-- keyword precedes all the text that matches the pattern and the keyword
-- is within the specified distance, Amazon Macie includes the result. The
-- distance can be 1-300 characters. The default value is 50.
createCustomDataIdentifier_maximumMatchDistance :: Lens.Lens' CreateCustomDataIdentifier (Prelude.Maybe Prelude.Int)
createCustomDataIdentifier_maximumMatchDistance :: Lens' CreateCustomDataIdentifier (Maybe Int)
createCustomDataIdentifier_maximumMatchDistance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifier' {Maybe Int
maximumMatchDistance :: Maybe Int
$sel:maximumMatchDistance:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Int
maximumMatchDistance} -> Maybe Int
maximumMatchDistance) (\s :: CreateCustomDataIdentifier
s@CreateCustomDataIdentifier' {} Maybe Int
a -> CreateCustomDataIdentifier
s {$sel:maximumMatchDistance:CreateCustomDataIdentifier' :: Maybe Int
maximumMatchDistance = Maybe Int
a} :: CreateCustomDataIdentifier)

-- | The severity to assign to findings that the custom data identifier
-- produces, based on the number of occurrences of text that matches the
-- custom data identifier\'s detection criteria. You can specify as many as
-- three SeverityLevel objects in this array, one for each severity: LOW,
-- MEDIUM, or HIGH. If you specify more than one, the occurrences
-- thresholds must be in ascending order by severity, moving from LOW to
-- HIGH. For example, 1 for LOW, 50 for MEDIUM, and 100 for HIGH. If an S3
-- object contains fewer occurrences than the lowest specified threshold,
-- Amazon Macie doesn\'t create a finding.
--
-- If you don\'t specify any values for this array, Macie creates findings
-- for S3 objects that contain at least one occurrence of text that matches
-- the detection criteria, and Macie assigns the MEDIUM severity to those
-- findings.
createCustomDataIdentifier_severityLevels :: Lens.Lens' CreateCustomDataIdentifier (Prelude.Maybe [SeverityLevel])
createCustomDataIdentifier_severityLevels :: Lens' CreateCustomDataIdentifier (Maybe [SeverityLevel])
createCustomDataIdentifier_severityLevels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifier' {Maybe [SeverityLevel]
severityLevels :: Maybe [SeverityLevel]
$sel:severityLevels:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [SeverityLevel]
severityLevels} -> Maybe [SeverityLevel]
severityLevels) (\s :: CreateCustomDataIdentifier
s@CreateCustomDataIdentifier' {} Maybe [SeverityLevel]
a -> CreateCustomDataIdentifier
s {$sel:severityLevels:CreateCustomDataIdentifier' :: Maybe [SeverityLevel]
severityLevels = Maybe [SeverityLevel]
a} :: CreateCustomDataIdentifier) 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 map of key-value pairs that specifies the tags to associate with the
-- custom data identifier.
--
-- A custom data identifier can have a maximum of 50 tags. Each tag
-- consists of a tag key and an associated tag value. The maximum length of
-- a tag key is 128 characters. The maximum length of a tag value is 256
-- characters.
createCustomDataIdentifier_tags :: Lens.Lens' CreateCustomDataIdentifier (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createCustomDataIdentifier_tags :: Lens' CreateCustomDataIdentifier (Maybe (HashMap Text Text))
createCustomDataIdentifier_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifier' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateCustomDataIdentifier
s@CreateCustomDataIdentifier' {} Maybe (HashMap Text Text)
a -> CreateCustomDataIdentifier
s {$sel:tags:CreateCustomDataIdentifier' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateCustomDataIdentifier) 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 regular expression (/regex/) that defines the pattern to match. The
-- expression can contain as many as 512 characters.
createCustomDataIdentifier_regex :: Lens.Lens' CreateCustomDataIdentifier Prelude.Text
createCustomDataIdentifier_regex :: Lens' CreateCustomDataIdentifier Text
createCustomDataIdentifier_regex = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifier' {Text
regex :: Text
$sel:regex:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Text
regex} -> Text
regex) (\s :: CreateCustomDataIdentifier
s@CreateCustomDataIdentifier' {} Text
a -> CreateCustomDataIdentifier
s {$sel:regex:CreateCustomDataIdentifier' :: Text
regex = Text
a} :: CreateCustomDataIdentifier)

-- | A custom name for the custom data identifier. The name can contain as
-- many as 128 characters.
--
-- We strongly recommend that you avoid including any sensitive data in the
-- name of a custom data identifier. Other users of your account might be
-- able to see this name, depending on the actions that they\'re allowed to
-- perform in Amazon Macie.
createCustomDataIdentifier_name :: Lens.Lens' CreateCustomDataIdentifier Prelude.Text
createCustomDataIdentifier_name :: Lens' CreateCustomDataIdentifier Text
createCustomDataIdentifier_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifier' {Text
name :: Text
$sel:name:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Text
name} -> Text
name) (\s :: CreateCustomDataIdentifier
s@CreateCustomDataIdentifier' {} Text
a -> CreateCustomDataIdentifier
s {$sel:name:CreateCustomDataIdentifier' :: Text
name = Text
a} :: CreateCustomDataIdentifier)

instance Core.AWSRequest CreateCustomDataIdentifier where
  type
    AWSResponse CreateCustomDataIdentifier =
      CreateCustomDataIdentifierResponse
  request :: (Service -> Service)
-> CreateCustomDataIdentifier -> Request CreateCustomDataIdentifier
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateCustomDataIdentifier
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateCustomDataIdentifier)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> CreateCustomDataIdentifierResponse
CreateCustomDataIdentifierResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"customDataIdentifierId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateCustomDataIdentifier where
  hashWithSalt :: Int -> CreateCustomDataIdentifier -> Int
hashWithSalt Int
_salt CreateCustomDataIdentifier' {Maybe Int
Maybe [Text]
Maybe [SeverityLevel]
Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
regex :: Text
tags :: Maybe (HashMap Text Text)
severityLevels :: Maybe [SeverityLevel]
maximumMatchDistance :: Maybe Int
keywords :: Maybe [Text]
ignoreWords :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Text
$sel:regex:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Text
$sel:tags:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe (HashMap Text Text)
$sel:severityLevels:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [SeverityLevel]
$sel:maximumMatchDistance:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Int
$sel:keywords:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [Text]
$sel:ignoreWords:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [Text]
$sel:description:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Text
$sel:clientToken:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
ignoreWords
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
keywords
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maximumMatchDistance
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SeverityLevel]
severityLevels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
regex
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateCustomDataIdentifier where
  rnf :: CreateCustomDataIdentifier -> ()
rnf CreateCustomDataIdentifier' {Maybe Int
Maybe [Text]
Maybe [SeverityLevel]
Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
regex :: Text
tags :: Maybe (HashMap Text Text)
severityLevels :: Maybe [SeverityLevel]
maximumMatchDistance :: Maybe Int
keywords :: Maybe [Text]
ignoreWords :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Text
$sel:regex:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Text
$sel:tags:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe (HashMap Text Text)
$sel:severityLevels:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [SeverityLevel]
$sel:maximumMatchDistance:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Int
$sel:keywords:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [Text]
$sel:ignoreWords:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [Text]
$sel:description:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Text
$sel:clientToken:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
ignoreWords
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
keywords
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maximumMatchDistance
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SeverityLevel]
severityLevels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
regex
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateCustomDataIdentifier where
  toHeaders :: CreateCustomDataIdentifier -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateCustomDataIdentifier where
  toJSON :: CreateCustomDataIdentifier -> Value
toJSON CreateCustomDataIdentifier' {Maybe Int
Maybe [Text]
Maybe [SeverityLevel]
Maybe Text
Maybe (HashMap Text Text)
Text
name :: Text
regex :: Text
tags :: Maybe (HashMap Text Text)
severityLevels :: Maybe [SeverityLevel]
maximumMatchDistance :: Maybe Int
keywords :: Maybe [Text]
ignoreWords :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Text
$sel:regex:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Text
$sel:tags:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe (HashMap Text Text)
$sel:severityLevels:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [SeverityLevel]
$sel:maximumMatchDistance:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Int
$sel:keywords:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [Text]
$sel:ignoreWords:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe [Text]
$sel:description:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Text
$sel:clientToken:CreateCustomDataIdentifier' :: CreateCustomDataIdentifier -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (Key
"description" 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
description,
            (Key
"ignoreWords" 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]
ignoreWords,
            (Key
"keywords" 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]
keywords,
            (Key
"maximumMatchDistance" 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 Int
maximumMatchDistance,
            (Key
"severityLevels" 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 [SeverityLevel]
severityLevels,
            (Key
"tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"regex" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
regex),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance Data.ToPath CreateCustomDataIdentifier where
  toPath :: CreateCustomDataIdentifier -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/custom-data-identifiers"

instance Data.ToQuery CreateCustomDataIdentifier where
  toQuery :: CreateCustomDataIdentifier -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateCustomDataIdentifierResponse' smart constructor.
data CreateCustomDataIdentifierResponse = CreateCustomDataIdentifierResponse'
  { -- | The unique identifier for the custom data identifier that was created.
    CreateCustomDataIdentifierResponse -> Maybe Text
customDataIdentifierId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateCustomDataIdentifierResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateCustomDataIdentifierResponse
-> CreateCustomDataIdentifierResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCustomDataIdentifierResponse
-> CreateCustomDataIdentifierResponse -> Bool
$c/= :: CreateCustomDataIdentifierResponse
-> CreateCustomDataIdentifierResponse -> Bool
== :: CreateCustomDataIdentifierResponse
-> CreateCustomDataIdentifierResponse -> Bool
$c== :: CreateCustomDataIdentifierResponse
-> CreateCustomDataIdentifierResponse -> Bool
Prelude.Eq, ReadPrec [CreateCustomDataIdentifierResponse]
ReadPrec CreateCustomDataIdentifierResponse
Int -> ReadS CreateCustomDataIdentifierResponse
ReadS [CreateCustomDataIdentifierResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCustomDataIdentifierResponse]
$creadListPrec :: ReadPrec [CreateCustomDataIdentifierResponse]
readPrec :: ReadPrec CreateCustomDataIdentifierResponse
$creadPrec :: ReadPrec CreateCustomDataIdentifierResponse
readList :: ReadS [CreateCustomDataIdentifierResponse]
$creadList :: ReadS [CreateCustomDataIdentifierResponse]
readsPrec :: Int -> ReadS CreateCustomDataIdentifierResponse
$creadsPrec :: Int -> ReadS CreateCustomDataIdentifierResponse
Prelude.Read, Int -> CreateCustomDataIdentifierResponse -> ShowS
[CreateCustomDataIdentifierResponse] -> ShowS
CreateCustomDataIdentifierResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCustomDataIdentifierResponse] -> ShowS
$cshowList :: [CreateCustomDataIdentifierResponse] -> ShowS
show :: CreateCustomDataIdentifierResponse -> String
$cshow :: CreateCustomDataIdentifierResponse -> String
showsPrec :: Int -> CreateCustomDataIdentifierResponse -> ShowS
$cshowsPrec :: Int -> CreateCustomDataIdentifierResponse -> ShowS
Prelude.Show, forall x.
Rep CreateCustomDataIdentifierResponse x
-> CreateCustomDataIdentifierResponse
forall x.
CreateCustomDataIdentifierResponse
-> Rep CreateCustomDataIdentifierResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCustomDataIdentifierResponse x
-> CreateCustomDataIdentifierResponse
$cfrom :: forall x.
CreateCustomDataIdentifierResponse
-> Rep CreateCustomDataIdentifierResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCustomDataIdentifierResponse' 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:
--
-- 'customDataIdentifierId', 'createCustomDataIdentifierResponse_customDataIdentifierId' - The unique identifier for the custom data identifier that was created.
--
-- 'httpStatus', 'createCustomDataIdentifierResponse_httpStatus' - The response's http status code.
newCreateCustomDataIdentifierResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCustomDataIdentifierResponse
newCreateCustomDataIdentifierResponse :: Int -> CreateCustomDataIdentifierResponse
newCreateCustomDataIdentifierResponse Int
pHttpStatus_ =
  CreateCustomDataIdentifierResponse'
    { $sel:customDataIdentifierId:CreateCustomDataIdentifierResponse' :: Maybe Text
customDataIdentifierId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCustomDataIdentifierResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique identifier for the custom data identifier that was created.
createCustomDataIdentifierResponse_customDataIdentifierId :: Lens.Lens' CreateCustomDataIdentifierResponse (Prelude.Maybe Prelude.Text)
createCustomDataIdentifierResponse_customDataIdentifierId :: Lens' CreateCustomDataIdentifierResponse (Maybe Text)
createCustomDataIdentifierResponse_customDataIdentifierId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifierResponse' {Maybe Text
customDataIdentifierId :: Maybe Text
$sel:customDataIdentifierId:CreateCustomDataIdentifierResponse' :: CreateCustomDataIdentifierResponse -> Maybe Text
customDataIdentifierId} -> Maybe Text
customDataIdentifierId) (\s :: CreateCustomDataIdentifierResponse
s@CreateCustomDataIdentifierResponse' {} Maybe Text
a -> CreateCustomDataIdentifierResponse
s {$sel:customDataIdentifierId:CreateCustomDataIdentifierResponse' :: Maybe Text
customDataIdentifierId = Maybe Text
a} :: CreateCustomDataIdentifierResponse)

-- | The response's http status code.
createCustomDataIdentifierResponse_httpStatus :: Lens.Lens' CreateCustomDataIdentifierResponse Prelude.Int
createCustomDataIdentifierResponse_httpStatus :: Lens' CreateCustomDataIdentifierResponse Int
createCustomDataIdentifierResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomDataIdentifierResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateCustomDataIdentifierResponse' :: CreateCustomDataIdentifierResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateCustomDataIdentifierResponse
s@CreateCustomDataIdentifierResponse' {} Int
a -> CreateCustomDataIdentifierResponse
s {$sel:httpStatus:CreateCustomDataIdentifierResponse' :: Int
httpStatus = Int
a} :: CreateCustomDataIdentifierResponse)

instance
  Prelude.NFData
    CreateCustomDataIdentifierResponse
  where
  rnf :: CreateCustomDataIdentifierResponse -> ()
rnf CreateCustomDataIdentifierResponse' {Int
Maybe Text
httpStatus :: Int
customDataIdentifierId :: Maybe Text
$sel:httpStatus:CreateCustomDataIdentifierResponse' :: CreateCustomDataIdentifierResponse -> Int
$sel:customDataIdentifierId:CreateCustomDataIdentifierResponse' :: CreateCustomDataIdentifierResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customDataIdentifierId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus