{-# 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.ListCustomDataIdentifiers
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a subset of information about all the custom data identifiers
-- for an account.
--
-- This operation returns paginated results.
module Amazonka.MacieV2.ListCustomDataIdentifiers
  ( -- * Creating a Request
    ListCustomDataIdentifiers (..),
    newListCustomDataIdentifiers,

    -- * Request Lenses
    listCustomDataIdentifiers_maxResults,
    listCustomDataIdentifiers_nextToken,

    -- * Destructuring the Response
    ListCustomDataIdentifiersResponse (..),
    newListCustomDataIdentifiersResponse,

    -- * Response Lenses
    listCustomDataIdentifiersResponse_items,
    listCustomDataIdentifiersResponse_nextToken,
    listCustomDataIdentifiersResponse_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:/ 'newListCustomDataIdentifiers' smart constructor.
data ListCustomDataIdentifiers = ListCustomDataIdentifiers'
  { -- | The maximum number of items to include in each page of the response.
    ListCustomDataIdentifiers -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | The nextToken string that specifies which page of results to return in a
    -- paginated response.
    ListCustomDataIdentifiers -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListCustomDataIdentifiers -> ListCustomDataIdentifiers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCustomDataIdentifiers -> ListCustomDataIdentifiers -> Bool
$c/= :: ListCustomDataIdentifiers -> ListCustomDataIdentifiers -> Bool
== :: ListCustomDataIdentifiers -> ListCustomDataIdentifiers -> Bool
$c== :: ListCustomDataIdentifiers -> ListCustomDataIdentifiers -> Bool
Prelude.Eq, ReadPrec [ListCustomDataIdentifiers]
ReadPrec ListCustomDataIdentifiers
Int -> ReadS ListCustomDataIdentifiers
ReadS [ListCustomDataIdentifiers]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCustomDataIdentifiers]
$creadListPrec :: ReadPrec [ListCustomDataIdentifiers]
readPrec :: ReadPrec ListCustomDataIdentifiers
$creadPrec :: ReadPrec ListCustomDataIdentifiers
readList :: ReadS [ListCustomDataIdentifiers]
$creadList :: ReadS [ListCustomDataIdentifiers]
readsPrec :: Int -> ReadS ListCustomDataIdentifiers
$creadsPrec :: Int -> ReadS ListCustomDataIdentifiers
Prelude.Read, Int -> ListCustomDataIdentifiers -> ShowS
[ListCustomDataIdentifiers] -> ShowS
ListCustomDataIdentifiers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCustomDataIdentifiers] -> ShowS
$cshowList :: [ListCustomDataIdentifiers] -> ShowS
show :: ListCustomDataIdentifiers -> String
$cshow :: ListCustomDataIdentifiers -> String
showsPrec :: Int -> ListCustomDataIdentifiers -> ShowS
$cshowsPrec :: Int -> ListCustomDataIdentifiers -> ShowS
Prelude.Show, forall x.
Rep ListCustomDataIdentifiers x -> ListCustomDataIdentifiers
forall x.
ListCustomDataIdentifiers -> Rep ListCustomDataIdentifiers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCustomDataIdentifiers x -> ListCustomDataIdentifiers
$cfrom :: forall x.
ListCustomDataIdentifiers -> Rep ListCustomDataIdentifiers x
Prelude.Generic)

-- |
-- Create a value of 'ListCustomDataIdentifiers' 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:
--
-- 'maxResults', 'listCustomDataIdentifiers_maxResults' - The maximum number of items to include in each page of the response.
--
-- 'nextToken', 'listCustomDataIdentifiers_nextToken' - The nextToken string that specifies which page of results to return in a
-- paginated response.
newListCustomDataIdentifiers ::
  ListCustomDataIdentifiers
newListCustomDataIdentifiers :: ListCustomDataIdentifiers
newListCustomDataIdentifiers =
  ListCustomDataIdentifiers'
    { $sel:maxResults:ListCustomDataIdentifiers' :: Maybe Int
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCustomDataIdentifiers' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of items to include in each page of the response.
listCustomDataIdentifiers_maxResults :: Lens.Lens' ListCustomDataIdentifiers (Prelude.Maybe Prelude.Int)
listCustomDataIdentifiers_maxResults :: Lens' ListCustomDataIdentifiers (Maybe Int)
listCustomDataIdentifiers_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomDataIdentifiers' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListCustomDataIdentifiers' :: ListCustomDataIdentifiers -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListCustomDataIdentifiers
s@ListCustomDataIdentifiers' {} Maybe Int
a -> ListCustomDataIdentifiers
s {$sel:maxResults:ListCustomDataIdentifiers' :: Maybe Int
maxResults = Maybe Int
a} :: ListCustomDataIdentifiers)

-- | The nextToken string that specifies which page of results to return in a
-- paginated response.
listCustomDataIdentifiers_nextToken :: Lens.Lens' ListCustomDataIdentifiers (Prelude.Maybe Prelude.Text)
listCustomDataIdentifiers_nextToken :: Lens' ListCustomDataIdentifiers (Maybe Text)
listCustomDataIdentifiers_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomDataIdentifiers' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCustomDataIdentifiers' :: ListCustomDataIdentifiers -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCustomDataIdentifiers
s@ListCustomDataIdentifiers' {} Maybe Text
a -> ListCustomDataIdentifiers
s {$sel:nextToken:ListCustomDataIdentifiers' :: Maybe Text
nextToken = Maybe Text
a} :: ListCustomDataIdentifiers)

instance Core.AWSPager ListCustomDataIdentifiers where
  page :: ListCustomDataIdentifiers
-> AWSResponse ListCustomDataIdentifiers
-> Maybe ListCustomDataIdentifiers
page ListCustomDataIdentifiers
rq AWSResponse ListCustomDataIdentifiers
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCustomDataIdentifiers
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCustomDataIdentifiersResponse (Maybe Text)
listCustomDataIdentifiersResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCustomDataIdentifiers
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListCustomDataIdentifiersResponse
  (Maybe [CustomDataIdentifierSummary])
listCustomDataIdentifiersResponse_items
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListCustomDataIdentifiers
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCustomDataIdentifiers (Maybe Text)
listCustomDataIdentifiers_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCustomDataIdentifiers
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCustomDataIdentifiersResponse (Maybe Text)
listCustomDataIdentifiersResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListCustomDataIdentifiers where
  type
    AWSResponse ListCustomDataIdentifiers =
      ListCustomDataIdentifiersResponse
  request :: (Service -> Service)
-> ListCustomDataIdentifiers -> Request ListCustomDataIdentifiers
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 ListCustomDataIdentifiers
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListCustomDataIdentifiers)))
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 [CustomDataIdentifierSummary]
-> Maybe Text -> Int -> ListCustomDataIdentifiersResponse
ListCustomDataIdentifiersResponse'
            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
"items" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"nextToken")
            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 ListCustomDataIdentifiers where
  hashWithSalt :: Int -> ListCustomDataIdentifiers -> Int
hashWithSalt Int
_salt ListCustomDataIdentifiers' {Maybe Int
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:nextToken:ListCustomDataIdentifiers' :: ListCustomDataIdentifiers -> Maybe Text
$sel:maxResults:ListCustomDataIdentifiers' :: ListCustomDataIdentifiers -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

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

instance Data.ToHeaders ListCustomDataIdentifiers where
  toHeaders :: ListCustomDataIdentifiers -> 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 ListCustomDataIdentifiers where
  toJSON :: ListCustomDataIdentifiers -> Value
toJSON ListCustomDataIdentifiers' {Maybe Int
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:nextToken:ListCustomDataIdentifiers' :: ListCustomDataIdentifiers -> Maybe Text
$sel:maxResults:ListCustomDataIdentifiers' :: ListCustomDataIdentifiers -> Maybe Int
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"maxResults" 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
maxResults,
            (Key
"nextToken" 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
nextToken
          ]
      )

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

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

-- | /See:/ 'newListCustomDataIdentifiersResponse' smart constructor.
data ListCustomDataIdentifiersResponse = ListCustomDataIdentifiersResponse'
  { -- | An array of objects, one for each custom data identifier.
    ListCustomDataIdentifiersResponse
-> Maybe [CustomDataIdentifierSummary]
items :: Prelude.Maybe [CustomDataIdentifierSummary],
    -- | The string to use in a subsequent request to get the next page of
    -- results in a paginated response. This value is null if there are no
    -- additional pages.
    ListCustomDataIdentifiersResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCustomDataIdentifiersResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCustomDataIdentifiersResponse
-> ListCustomDataIdentifiersResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCustomDataIdentifiersResponse
-> ListCustomDataIdentifiersResponse -> Bool
$c/= :: ListCustomDataIdentifiersResponse
-> ListCustomDataIdentifiersResponse -> Bool
== :: ListCustomDataIdentifiersResponse
-> ListCustomDataIdentifiersResponse -> Bool
$c== :: ListCustomDataIdentifiersResponse
-> ListCustomDataIdentifiersResponse -> Bool
Prelude.Eq, ReadPrec [ListCustomDataIdentifiersResponse]
ReadPrec ListCustomDataIdentifiersResponse
Int -> ReadS ListCustomDataIdentifiersResponse
ReadS [ListCustomDataIdentifiersResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCustomDataIdentifiersResponse]
$creadListPrec :: ReadPrec [ListCustomDataIdentifiersResponse]
readPrec :: ReadPrec ListCustomDataIdentifiersResponse
$creadPrec :: ReadPrec ListCustomDataIdentifiersResponse
readList :: ReadS [ListCustomDataIdentifiersResponse]
$creadList :: ReadS [ListCustomDataIdentifiersResponse]
readsPrec :: Int -> ReadS ListCustomDataIdentifiersResponse
$creadsPrec :: Int -> ReadS ListCustomDataIdentifiersResponse
Prelude.Read, Int -> ListCustomDataIdentifiersResponse -> ShowS
[ListCustomDataIdentifiersResponse] -> ShowS
ListCustomDataIdentifiersResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCustomDataIdentifiersResponse] -> ShowS
$cshowList :: [ListCustomDataIdentifiersResponse] -> ShowS
show :: ListCustomDataIdentifiersResponse -> String
$cshow :: ListCustomDataIdentifiersResponse -> String
showsPrec :: Int -> ListCustomDataIdentifiersResponse -> ShowS
$cshowsPrec :: Int -> ListCustomDataIdentifiersResponse -> ShowS
Prelude.Show, forall x.
Rep ListCustomDataIdentifiersResponse x
-> ListCustomDataIdentifiersResponse
forall x.
ListCustomDataIdentifiersResponse
-> Rep ListCustomDataIdentifiersResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCustomDataIdentifiersResponse x
-> ListCustomDataIdentifiersResponse
$cfrom :: forall x.
ListCustomDataIdentifiersResponse
-> Rep ListCustomDataIdentifiersResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCustomDataIdentifiersResponse' 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:
--
-- 'items', 'listCustomDataIdentifiersResponse_items' - An array of objects, one for each custom data identifier.
--
-- 'nextToken', 'listCustomDataIdentifiersResponse_nextToken' - The string to use in a subsequent request to get the next page of
-- results in a paginated response. This value is null if there are no
-- additional pages.
--
-- 'httpStatus', 'listCustomDataIdentifiersResponse_httpStatus' - The response's http status code.
newListCustomDataIdentifiersResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCustomDataIdentifiersResponse
newListCustomDataIdentifiersResponse :: Int -> ListCustomDataIdentifiersResponse
newListCustomDataIdentifiersResponse Int
pHttpStatus_ =
  ListCustomDataIdentifiersResponse'
    { $sel:items:ListCustomDataIdentifiersResponse' :: Maybe [CustomDataIdentifierSummary]
items =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCustomDataIdentifiersResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCustomDataIdentifiersResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of objects, one for each custom data identifier.
listCustomDataIdentifiersResponse_items :: Lens.Lens' ListCustomDataIdentifiersResponse (Prelude.Maybe [CustomDataIdentifierSummary])
listCustomDataIdentifiersResponse_items :: Lens'
  ListCustomDataIdentifiersResponse
  (Maybe [CustomDataIdentifierSummary])
listCustomDataIdentifiersResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomDataIdentifiersResponse' {Maybe [CustomDataIdentifierSummary]
items :: Maybe [CustomDataIdentifierSummary]
$sel:items:ListCustomDataIdentifiersResponse' :: ListCustomDataIdentifiersResponse
-> Maybe [CustomDataIdentifierSummary]
items} -> Maybe [CustomDataIdentifierSummary]
items) (\s :: ListCustomDataIdentifiersResponse
s@ListCustomDataIdentifiersResponse' {} Maybe [CustomDataIdentifierSummary]
a -> ListCustomDataIdentifiersResponse
s {$sel:items:ListCustomDataIdentifiersResponse' :: Maybe [CustomDataIdentifierSummary]
items = Maybe [CustomDataIdentifierSummary]
a} :: ListCustomDataIdentifiersResponse) 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 string to use in a subsequent request to get the next page of
-- results in a paginated response. This value is null if there are no
-- additional pages.
listCustomDataIdentifiersResponse_nextToken :: Lens.Lens' ListCustomDataIdentifiersResponse (Prelude.Maybe Prelude.Text)
listCustomDataIdentifiersResponse_nextToken :: Lens' ListCustomDataIdentifiersResponse (Maybe Text)
listCustomDataIdentifiersResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomDataIdentifiersResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCustomDataIdentifiersResponse' :: ListCustomDataIdentifiersResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCustomDataIdentifiersResponse
s@ListCustomDataIdentifiersResponse' {} Maybe Text
a -> ListCustomDataIdentifiersResponse
s {$sel:nextToken:ListCustomDataIdentifiersResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCustomDataIdentifiersResponse)

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

instance
  Prelude.NFData
    ListCustomDataIdentifiersResponse
  where
  rnf :: ListCustomDataIdentifiersResponse -> ()
rnf ListCustomDataIdentifiersResponse' {Int
Maybe [CustomDataIdentifierSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
items :: Maybe [CustomDataIdentifierSummary]
$sel:httpStatus:ListCustomDataIdentifiersResponse' :: ListCustomDataIdentifiersResponse -> Int
$sel:nextToken:ListCustomDataIdentifiersResponse' :: ListCustomDataIdentifiersResponse -> Maybe Text
$sel:items:ListCustomDataIdentifiersResponse' :: ListCustomDataIdentifiersResponse
-> Maybe [CustomDataIdentifierSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CustomDataIdentifierSummary]
items
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus