{-# 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.TestCustomDataIdentifier
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Tests a custom data identifier.
module Amazonka.MacieV2.TestCustomDataIdentifier
  ( -- * Creating a Request
    TestCustomDataIdentifier (..),
    newTestCustomDataIdentifier,

    -- * Request Lenses
    testCustomDataIdentifier_ignoreWords,
    testCustomDataIdentifier_keywords,
    testCustomDataIdentifier_maximumMatchDistance,
    testCustomDataIdentifier_regex,
    testCustomDataIdentifier_sampleText,

    -- * Destructuring the Response
    TestCustomDataIdentifierResponse (..),
    newTestCustomDataIdentifierResponse,

    -- * Response Lenses
    testCustomDataIdentifierResponse_matchCount,
    testCustomDataIdentifierResponse_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:/ 'newTestCustomDataIdentifier' smart constructor.
data TestCustomDataIdentifier = TestCustomDataIdentifier'
  { -- | 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.
    TestCustomDataIdentifier -> 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.
    TestCustomDataIdentifier -> 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.
    TestCustomDataIdentifier -> Maybe Int
maximumMatchDistance :: Prelude.Maybe Prelude.Int,
    -- | The regular expression (/regex/) that defines the pattern to match. The
    -- expression can contain as many as 512 characters.
    TestCustomDataIdentifier -> Text
regex :: Prelude.Text,
    -- | The sample text to inspect by using the custom data identifier. The text
    -- can contain as many as 1,000 characters.
    TestCustomDataIdentifier -> Text
sampleText :: Prelude.Text
  }
  deriving (TestCustomDataIdentifier -> TestCustomDataIdentifier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestCustomDataIdentifier -> TestCustomDataIdentifier -> Bool
$c/= :: TestCustomDataIdentifier -> TestCustomDataIdentifier -> Bool
== :: TestCustomDataIdentifier -> TestCustomDataIdentifier -> Bool
$c== :: TestCustomDataIdentifier -> TestCustomDataIdentifier -> Bool
Prelude.Eq, ReadPrec [TestCustomDataIdentifier]
ReadPrec TestCustomDataIdentifier
Int -> ReadS TestCustomDataIdentifier
ReadS [TestCustomDataIdentifier]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestCustomDataIdentifier]
$creadListPrec :: ReadPrec [TestCustomDataIdentifier]
readPrec :: ReadPrec TestCustomDataIdentifier
$creadPrec :: ReadPrec TestCustomDataIdentifier
readList :: ReadS [TestCustomDataIdentifier]
$creadList :: ReadS [TestCustomDataIdentifier]
readsPrec :: Int -> ReadS TestCustomDataIdentifier
$creadsPrec :: Int -> ReadS TestCustomDataIdentifier
Prelude.Read, Int -> TestCustomDataIdentifier -> ShowS
[TestCustomDataIdentifier] -> ShowS
TestCustomDataIdentifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestCustomDataIdentifier] -> ShowS
$cshowList :: [TestCustomDataIdentifier] -> ShowS
show :: TestCustomDataIdentifier -> String
$cshow :: TestCustomDataIdentifier -> String
showsPrec :: Int -> TestCustomDataIdentifier -> ShowS
$cshowsPrec :: Int -> TestCustomDataIdentifier -> ShowS
Prelude.Show, forall x.
Rep TestCustomDataIdentifier x -> TestCustomDataIdentifier
forall x.
TestCustomDataIdentifier -> Rep TestCustomDataIdentifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TestCustomDataIdentifier x -> TestCustomDataIdentifier
$cfrom :: forall x.
TestCustomDataIdentifier -> Rep TestCustomDataIdentifier x
Prelude.Generic)

-- |
-- Create a value of 'TestCustomDataIdentifier' 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:
--
-- 'ignoreWords', 'testCustomDataIdentifier_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', 'testCustomDataIdentifier_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', 'testCustomDataIdentifier_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.
--
-- 'regex', 'testCustomDataIdentifier_regex' - The regular expression (/regex/) that defines the pattern to match. The
-- expression can contain as many as 512 characters.
--
-- 'sampleText', 'testCustomDataIdentifier_sampleText' - The sample text to inspect by using the custom data identifier. The text
-- can contain as many as 1,000 characters.
newTestCustomDataIdentifier ::
  -- | 'regex'
  Prelude.Text ->
  -- | 'sampleText'
  Prelude.Text ->
  TestCustomDataIdentifier
newTestCustomDataIdentifier :: Text -> Text -> TestCustomDataIdentifier
newTestCustomDataIdentifier Text
pRegex_ Text
pSampleText_ =
  TestCustomDataIdentifier'
    { $sel:ignoreWords:TestCustomDataIdentifier' :: Maybe [Text]
ignoreWords =
        forall a. Maybe a
Prelude.Nothing,
      $sel:keywords:TestCustomDataIdentifier' :: Maybe [Text]
keywords = forall a. Maybe a
Prelude.Nothing,
      $sel:maximumMatchDistance:TestCustomDataIdentifier' :: Maybe Int
maximumMatchDistance = forall a. Maybe a
Prelude.Nothing,
      $sel:regex:TestCustomDataIdentifier' :: Text
regex = Text
pRegex_,
      $sel:sampleText:TestCustomDataIdentifier' :: Text
sampleText = Text
pSampleText_
    }

-- | 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.
testCustomDataIdentifier_ignoreWords :: Lens.Lens' TestCustomDataIdentifier (Prelude.Maybe [Prelude.Text])
testCustomDataIdentifier_ignoreWords :: Lens' TestCustomDataIdentifier (Maybe [Text])
testCustomDataIdentifier_ignoreWords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestCustomDataIdentifier' {Maybe [Text]
ignoreWords :: Maybe [Text]
$sel:ignoreWords:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe [Text]
ignoreWords} -> Maybe [Text]
ignoreWords) (\s :: TestCustomDataIdentifier
s@TestCustomDataIdentifier' {} Maybe [Text]
a -> TestCustomDataIdentifier
s {$sel:ignoreWords:TestCustomDataIdentifier' :: Maybe [Text]
ignoreWords = Maybe [Text]
a} :: TestCustomDataIdentifier) 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.
testCustomDataIdentifier_keywords :: Lens.Lens' TestCustomDataIdentifier (Prelude.Maybe [Prelude.Text])
testCustomDataIdentifier_keywords :: Lens' TestCustomDataIdentifier (Maybe [Text])
testCustomDataIdentifier_keywords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestCustomDataIdentifier' {Maybe [Text]
keywords :: Maybe [Text]
$sel:keywords:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe [Text]
keywords} -> Maybe [Text]
keywords) (\s :: TestCustomDataIdentifier
s@TestCustomDataIdentifier' {} Maybe [Text]
a -> TestCustomDataIdentifier
s {$sel:keywords:TestCustomDataIdentifier' :: Maybe [Text]
keywords = Maybe [Text]
a} :: TestCustomDataIdentifier) 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.
testCustomDataIdentifier_maximumMatchDistance :: Lens.Lens' TestCustomDataIdentifier (Prelude.Maybe Prelude.Int)
testCustomDataIdentifier_maximumMatchDistance :: Lens' TestCustomDataIdentifier (Maybe Int)
testCustomDataIdentifier_maximumMatchDistance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestCustomDataIdentifier' {Maybe Int
maximumMatchDistance :: Maybe Int
$sel:maximumMatchDistance:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe Int
maximumMatchDistance} -> Maybe Int
maximumMatchDistance) (\s :: TestCustomDataIdentifier
s@TestCustomDataIdentifier' {} Maybe Int
a -> TestCustomDataIdentifier
s {$sel:maximumMatchDistance:TestCustomDataIdentifier' :: Maybe Int
maximumMatchDistance = Maybe Int
a} :: TestCustomDataIdentifier)

-- | The regular expression (/regex/) that defines the pattern to match. The
-- expression can contain as many as 512 characters.
testCustomDataIdentifier_regex :: Lens.Lens' TestCustomDataIdentifier Prelude.Text
testCustomDataIdentifier_regex :: Lens' TestCustomDataIdentifier Text
testCustomDataIdentifier_regex = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestCustomDataIdentifier' {Text
regex :: Text
$sel:regex:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Text
regex} -> Text
regex) (\s :: TestCustomDataIdentifier
s@TestCustomDataIdentifier' {} Text
a -> TestCustomDataIdentifier
s {$sel:regex:TestCustomDataIdentifier' :: Text
regex = Text
a} :: TestCustomDataIdentifier)

-- | The sample text to inspect by using the custom data identifier. The text
-- can contain as many as 1,000 characters.
testCustomDataIdentifier_sampleText :: Lens.Lens' TestCustomDataIdentifier Prelude.Text
testCustomDataIdentifier_sampleText :: Lens' TestCustomDataIdentifier Text
testCustomDataIdentifier_sampleText = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestCustomDataIdentifier' {Text
sampleText :: Text
$sel:sampleText:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Text
sampleText} -> Text
sampleText) (\s :: TestCustomDataIdentifier
s@TestCustomDataIdentifier' {} Text
a -> TestCustomDataIdentifier
s {$sel:sampleText:TestCustomDataIdentifier' :: Text
sampleText = Text
a} :: TestCustomDataIdentifier)

instance Core.AWSRequest TestCustomDataIdentifier where
  type
    AWSResponse TestCustomDataIdentifier =
      TestCustomDataIdentifierResponse
  request :: (Service -> Service)
-> TestCustomDataIdentifier -> Request TestCustomDataIdentifier
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 TestCustomDataIdentifier
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse TestCustomDataIdentifier)))
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 Int -> Int -> TestCustomDataIdentifierResponse
TestCustomDataIdentifierResponse'
            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
"matchCount")
            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 TestCustomDataIdentifier where
  hashWithSalt :: Int -> TestCustomDataIdentifier -> Int
hashWithSalt Int
_salt TestCustomDataIdentifier' {Maybe Int
Maybe [Text]
Text
sampleText :: Text
regex :: Text
maximumMatchDistance :: Maybe Int
keywords :: Maybe [Text]
ignoreWords :: Maybe [Text]
$sel:sampleText:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Text
$sel:regex:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Text
$sel:maximumMatchDistance:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe Int
$sel:keywords:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe [Text]
$sel:ignoreWords:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe [Text]
..} =
    Int
_salt
      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` Text
regex
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sampleText

instance Prelude.NFData TestCustomDataIdentifier where
  rnf :: TestCustomDataIdentifier -> ()
rnf TestCustomDataIdentifier' {Maybe Int
Maybe [Text]
Text
sampleText :: Text
regex :: Text
maximumMatchDistance :: Maybe Int
keywords :: Maybe [Text]
ignoreWords :: Maybe [Text]
$sel:sampleText:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Text
$sel:regex:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Text
$sel:maximumMatchDistance:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe Int
$sel:keywords:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe [Text]
$sel:ignoreWords:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe [Text]
..} =
    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 Text
regex
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sampleText

instance Data.ToHeaders TestCustomDataIdentifier where
  toHeaders :: TestCustomDataIdentifier -> 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 TestCustomDataIdentifier where
  toJSON :: TestCustomDataIdentifier -> Value
toJSON TestCustomDataIdentifier' {Maybe Int
Maybe [Text]
Text
sampleText :: Text
regex :: Text
maximumMatchDistance :: Maybe Int
keywords :: Maybe [Text]
ignoreWords :: Maybe [Text]
$sel:sampleText:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Text
$sel:regex:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Text
$sel:maximumMatchDistance:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe Int
$sel:keywords:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe [Text]
$sel:ignoreWords:TestCustomDataIdentifier' :: TestCustomDataIdentifier -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            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
"sampleText" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sampleText)
          ]
      )

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

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

-- | /See:/ 'newTestCustomDataIdentifierResponse' smart constructor.
data TestCustomDataIdentifierResponse = TestCustomDataIdentifierResponse'
  { -- | The number of occurrences of sample text that matched the criteria
    -- specified by the custom data identifier.
    TestCustomDataIdentifierResponse -> Maybe Int
matchCount :: Prelude.Maybe Prelude.Int,
    -- | The response's http status code.
    TestCustomDataIdentifierResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TestCustomDataIdentifierResponse
-> TestCustomDataIdentifierResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestCustomDataIdentifierResponse
-> TestCustomDataIdentifierResponse -> Bool
$c/= :: TestCustomDataIdentifierResponse
-> TestCustomDataIdentifierResponse -> Bool
== :: TestCustomDataIdentifierResponse
-> TestCustomDataIdentifierResponse -> Bool
$c== :: TestCustomDataIdentifierResponse
-> TestCustomDataIdentifierResponse -> Bool
Prelude.Eq, ReadPrec [TestCustomDataIdentifierResponse]
ReadPrec TestCustomDataIdentifierResponse
Int -> ReadS TestCustomDataIdentifierResponse
ReadS [TestCustomDataIdentifierResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestCustomDataIdentifierResponse]
$creadListPrec :: ReadPrec [TestCustomDataIdentifierResponse]
readPrec :: ReadPrec TestCustomDataIdentifierResponse
$creadPrec :: ReadPrec TestCustomDataIdentifierResponse
readList :: ReadS [TestCustomDataIdentifierResponse]
$creadList :: ReadS [TestCustomDataIdentifierResponse]
readsPrec :: Int -> ReadS TestCustomDataIdentifierResponse
$creadsPrec :: Int -> ReadS TestCustomDataIdentifierResponse
Prelude.Read, Int -> TestCustomDataIdentifierResponse -> ShowS
[TestCustomDataIdentifierResponse] -> ShowS
TestCustomDataIdentifierResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestCustomDataIdentifierResponse] -> ShowS
$cshowList :: [TestCustomDataIdentifierResponse] -> ShowS
show :: TestCustomDataIdentifierResponse -> String
$cshow :: TestCustomDataIdentifierResponse -> String
showsPrec :: Int -> TestCustomDataIdentifierResponse -> ShowS
$cshowsPrec :: Int -> TestCustomDataIdentifierResponse -> ShowS
Prelude.Show, forall x.
Rep TestCustomDataIdentifierResponse x
-> TestCustomDataIdentifierResponse
forall x.
TestCustomDataIdentifierResponse
-> Rep TestCustomDataIdentifierResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TestCustomDataIdentifierResponse x
-> TestCustomDataIdentifierResponse
$cfrom :: forall x.
TestCustomDataIdentifierResponse
-> Rep TestCustomDataIdentifierResponse x
Prelude.Generic)

-- |
-- Create a value of 'TestCustomDataIdentifierResponse' 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:
--
-- 'matchCount', 'testCustomDataIdentifierResponse_matchCount' - The number of occurrences of sample text that matched the criteria
-- specified by the custom data identifier.
--
-- 'httpStatus', 'testCustomDataIdentifierResponse_httpStatus' - The response's http status code.
newTestCustomDataIdentifierResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TestCustomDataIdentifierResponse
newTestCustomDataIdentifierResponse :: Int -> TestCustomDataIdentifierResponse
newTestCustomDataIdentifierResponse Int
pHttpStatus_ =
  TestCustomDataIdentifierResponse'
    { $sel:matchCount:TestCustomDataIdentifierResponse' :: Maybe Int
matchCount =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TestCustomDataIdentifierResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The number of occurrences of sample text that matched the criteria
-- specified by the custom data identifier.
testCustomDataIdentifierResponse_matchCount :: Lens.Lens' TestCustomDataIdentifierResponse (Prelude.Maybe Prelude.Int)
testCustomDataIdentifierResponse_matchCount :: Lens' TestCustomDataIdentifierResponse (Maybe Int)
testCustomDataIdentifierResponse_matchCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestCustomDataIdentifierResponse' {Maybe Int
matchCount :: Maybe Int
$sel:matchCount:TestCustomDataIdentifierResponse' :: TestCustomDataIdentifierResponse -> Maybe Int
matchCount} -> Maybe Int
matchCount) (\s :: TestCustomDataIdentifierResponse
s@TestCustomDataIdentifierResponse' {} Maybe Int
a -> TestCustomDataIdentifierResponse
s {$sel:matchCount:TestCustomDataIdentifierResponse' :: Maybe Int
matchCount = Maybe Int
a} :: TestCustomDataIdentifierResponse)

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

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