{-# 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.CognitoIdentityProvider.ListUsers
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the users in the Amazon Cognito user pool.
--
-- This operation returns paginated results.
module Amazonka.CognitoIdentityProvider.ListUsers
  ( -- * Creating a Request
    ListUsers (..),
    newListUsers,

    -- * Request Lenses
    listUsers_attributesToGet,
    listUsers_filter,
    listUsers_limit,
    listUsers_paginationToken,
    listUsers_userPoolId,

    -- * Destructuring the Response
    ListUsersResponse (..),
    newListUsersResponse,

    -- * Response Lenses
    listUsersResponse_paginationToken,
    listUsersResponse_users,
    listUsersResponse_httpStatus,
  )
where

import Amazonka.CognitoIdentityProvider.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Represents the request to list users.
--
-- /See:/ 'newListUsers' smart constructor.
data ListUsers = ListUsers'
  { -- | An array of strings, where each string is the name of a user attribute
    -- to be returned for each user in the search results. If the array is
    -- null, all attributes are returned.
    ListUsers -> Maybe [Text]
attributesToGet :: Prelude.Maybe [Prelude.Text],
    -- | A filter string of the form \"/AttributeName/ /Filter-Type/
    -- \"/AttributeValue/\"\". Quotation marks within the filter string must be
    -- escaped using the backslash (\\) character. For example, \"@family_name@
    -- = \\\"Reddy\\\"\".
    --
    -- -   /AttributeName/: The name of the attribute to search for. You can
    --     only search for one attribute at a time.
    --
    -- -   /Filter-Type/: For an exact match, use =, for example,
    --     \"@given_name@ = \\\"Jon\\\"\". For a prefix (\"starts with\")
    --     match, use ^=, for example, \"@given_name@ ^= \\\"Jon\\\"\".
    --
    -- -   /AttributeValue/: The attribute value that must be matched for each
    --     user.
    --
    -- If the filter string is empty, @ListUsers@ returns all users in the user
    -- pool.
    --
    -- You can only search for the following standard attributes:
    --
    -- -   @username@ (case-sensitive)
    --
    -- -   @email@
    --
    -- -   @phone_number@
    --
    -- -   @name@
    --
    -- -   @given_name@
    --
    -- -   @family_name@
    --
    -- -   @preferred_username@
    --
    -- -   @cognito:user_status@ (called __Status__ in the Console)
    --     (case-insensitive)
    --
    -- -   @status (called @__@Enabled@__@ in the Console) (case-sensitive)@
    --
    -- -   @sub@
    --
    -- Custom attributes aren\'t searchable.
    --
    -- You can also list users with a client-side filter. The server-side
    -- filter matches no more than one attribute. For an advanced search, use a
    -- client-side filter with the @--query@ parameter of the @list-users@
    -- action in the CLI. When you use a client-side filter, ListUsers returns
    -- a paginated list of zero or more users. You can receive multiple pages
    -- in a row with zero results. Repeat the query with each pagination token
    -- that is returned until you receive a null pagination token value, and
    -- then review the combined result.
    --
    -- For more information about server-side and client-side filtering, see
    -- <https://docs.aws.amazon.com/cli/latest/userguide/cli-usage-filter.html FilteringCLI output>
    -- in the
    -- <https://docs.aws.amazon.com/cli/latest/userguide/cli-usage-filter.html Command Line Interface User Guide>.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/cognito/latest/developerguide/how-to-manage-user-accounts.html#cognito-user-pools-searching-for-users-using-listusers-api Searching for Users Using the ListUsers API>
    -- and
    -- <https://docs.aws.amazon.com/cognito/latest/developerguide/how-to-manage-user-accounts.html#cognito-user-pools-searching-for-users-listusers-api-examples Examples of Using the ListUsers API>
    -- in the /Amazon Cognito Developer Guide/.
    ListUsers -> Maybe Text
filter' :: Prelude.Maybe Prelude.Text,
    -- | Maximum number of users to be returned.
    ListUsers -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | An identifier that was returned from the previous call to this
    -- operation, which can be used to return the next set of items in the
    -- list.
    ListUsers -> Maybe Text
paginationToken :: Prelude.Maybe Prelude.Text,
    -- | The user pool ID for the user pool on which the search should be
    -- performed.
    ListUsers -> Text
userPoolId :: Prelude.Text
  }
  deriving (ListUsers -> ListUsers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListUsers -> ListUsers -> Bool
$c/= :: ListUsers -> ListUsers -> Bool
== :: ListUsers -> ListUsers -> Bool
$c== :: ListUsers -> ListUsers -> Bool
Prelude.Eq, ReadPrec [ListUsers]
ReadPrec ListUsers
Int -> ReadS ListUsers
ReadS [ListUsers]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListUsers]
$creadListPrec :: ReadPrec [ListUsers]
readPrec :: ReadPrec ListUsers
$creadPrec :: ReadPrec ListUsers
readList :: ReadS [ListUsers]
$creadList :: ReadS [ListUsers]
readsPrec :: Int -> ReadS ListUsers
$creadsPrec :: Int -> ReadS ListUsers
Prelude.Read, Int -> ListUsers -> ShowS
[ListUsers] -> ShowS
ListUsers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListUsers] -> ShowS
$cshowList :: [ListUsers] -> ShowS
show :: ListUsers -> String
$cshow :: ListUsers -> String
showsPrec :: Int -> ListUsers -> ShowS
$cshowsPrec :: Int -> ListUsers -> ShowS
Prelude.Show, forall x. Rep ListUsers x -> ListUsers
forall x. ListUsers -> Rep ListUsers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListUsers x -> ListUsers
$cfrom :: forall x. ListUsers -> Rep ListUsers x
Prelude.Generic)

-- |
-- Create a value of 'ListUsers' 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:
--
-- 'attributesToGet', 'listUsers_attributesToGet' - An array of strings, where each string is the name of a user attribute
-- to be returned for each user in the search results. If the array is
-- null, all attributes are returned.
--
-- 'filter'', 'listUsers_filter' - A filter string of the form \"/AttributeName/ /Filter-Type/
-- \"/AttributeValue/\"\". Quotation marks within the filter string must be
-- escaped using the backslash (\\) character. For example, \"@family_name@
-- = \\\"Reddy\\\"\".
--
-- -   /AttributeName/: The name of the attribute to search for. You can
--     only search for one attribute at a time.
--
-- -   /Filter-Type/: For an exact match, use =, for example,
--     \"@given_name@ = \\\"Jon\\\"\". For a prefix (\"starts with\")
--     match, use ^=, for example, \"@given_name@ ^= \\\"Jon\\\"\".
--
-- -   /AttributeValue/: The attribute value that must be matched for each
--     user.
--
-- If the filter string is empty, @ListUsers@ returns all users in the user
-- pool.
--
-- You can only search for the following standard attributes:
--
-- -   @username@ (case-sensitive)
--
-- -   @email@
--
-- -   @phone_number@
--
-- -   @name@
--
-- -   @given_name@
--
-- -   @family_name@
--
-- -   @preferred_username@
--
-- -   @cognito:user_status@ (called __Status__ in the Console)
--     (case-insensitive)
--
-- -   @status (called @__@Enabled@__@ in the Console) (case-sensitive)@
--
-- -   @sub@
--
-- Custom attributes aren\'t searchable.
--
-- You can also list users with a client-side filter. The server-side
-- filter matches no more than one attribute. For an advanced search, use a
-- client-side filter with the @--query@ parameter of the @list-users@
-- action in the CLI. When you use a client-side filter, ListUsers returns
-- a paginated list of zero or more users. You can receive multiple pages
-- in a row with zero results. Repeat the query with each pagination token
-- that is returned until you receive a null pagination token value, and
-- then review the combined result.
--
-- For more information about server-side and client-side filtering, see
-- <https://docs.aws.amazon.com/cli/latest/userguide/cli-usage-filter.html FilteringCLI output>
-- in the
-- <https://docs.aws.amazon.com/cli/latest/userguide/cli-usage-filter.html Command Line Interface User Guide>.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/how-to-manage-user-accounts.html#cognito-user-pools-searching-for-users-using-listusers-api Searching for Users Using the ListUsers API>
-- and
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/how-to-manage-user-accounts.html#cognito-user-pools-searching-for-users-listusers-api-examples Examples of Using the ListUsers API>
-- in the /Amazon Cognito Developer Guide/.
--
-- 'limit', 'listUsers_limit' - Maximum number of users to be returned.
--
-- 'paginationToken', 'listUsers_paginationToken' - An identifier that was returned from the previous call to this
-- operation, which can be used to return the next set of items in the
-- list.
--
-- 'userPoolId', 'listUsers_userPoolId' - The user pool ID for the user pool on which the search should be
-- performed.
newListUsers ::
  -- | 'userPoolId'
  Prelude.Text ->
  ListUsers
newListUsers :: Text -> ListUsers
newListUsers Text
pUserPoolId_ =
  ListUsers'
    { $sel:attributesToGet:ListUsers' :: Maybe [Text]
attributesToGet = forall a. Maybe a
Prelude.Nothing,
      $sel:filter':ListUsers' :: Maybe Text
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:limit:ListUsers' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:paginationToken:ListUsers' :: Maybe Text
paginationToken = forall a. Maybe a
Prelude.Nothing,
      $sel:userPoolId:ListUsers' :: Text
userPoolId = Text
pUserPoolId_
    }

-- | An array of strings, where each string is the name of a user attribute
-- to be returned for each user in the search results. If the array is
-- null, all attributes are returned.
listUsers_attributesToGet :: Lens.Lens' ListUsers (Prelude.Maybe [Prelude.Text])
listUsers_attributesToGet :: Lens' ListUsers (Maybe [Text])
listUsers_attributesToGet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUsers' {Maybe [Text]
attributesToGet :: Maybe [Text]
$sel:attributesToGet:ListUsers' :: ListUsers -> Maybe [Text]
attributesToGet} -> Maybe [Text]
attributesToGet) (\s :: ListUsers
s@ListUsers' {} Maybe [Text]
a -> ListUsers
s {$sel:attributesToGet:ListUsers' :: Maybe [Text]
attributesToGet = Maybe [Text]
a} :: ListUsers) 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 filter string of the form \"/AttributeName/ /Filter-Type/
-- \"/AttributeValue/\"\". Quotation marks within the filter string must be
-- escaped using the backslash (\\) character. For example, \"@family_name@
-- = \\\"Reddy\\\"\".
--
-- -   /AttributeName/: The name of the attribute to search for. You can
--     only search for one attribute at a time.
--
-- -   /Filter-Type/: For an exact match, use =, for example,
--     \"@given_name@ = \\\"Jon\\\"\". For a prefix (\"starts with\")
--     match, use ^=, for example, \"@given_name@ ^= \\\"Jon\\\"\".
--
-- -   /AttributeValue/: The attribute value that must be matched for each
--     user.
--
-- If the filter string is empty, @ListUsers@ returns all users in the user
-- pool.
--
-- You can only search for the following standard attributes:
--
-- -   @username@ (case-sensitive)
--
-- -   @email@
--
-- -   @phone_number@
--
-- -   @name@
--
-- -   @given_name@
--
-- -   @family_name@
--
-- -   @preferred_username@
--
-- -   @cognito:user_status@ (called __Status__ in the Console)
--     (case-insensitive)
--
-- -   @status (called @__@Enabled@__@ in the Console) (case-sensitive)@
--
-- -   @sub@
--
-- Custom attributes aren\'t searchable.
--
-- You can also list users with a client-side filter. The server-side
-- filter matches no more than one attribute. For an advanced search, use a
-- client-side filter with the @--query@ parameter of the @list-users@
-- action in the CLI. When you use a client-side filter, ListUsers returns
-- a paginated list of zero or more users. You can receive multiple pages
-- in a row with zero results. Repeat the query with each pagination token
-- that is returned until you receive a null pagination token value, and
-- then review the combined result.
--
-- For more information about server-side and client-side filtering, see
-- <https://docs.aws.amazon.com/cli/latest/userguide/cli-usage-filter.html FilteringCLI output>
-- in the
-- <https://docs.aws.amazon.com/cli/latest/userguide/cli-usage-filter.html Command Line Interface User Guide>.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/how-to-manage-user-accounts.html#cognito-user-pools-searching-for-users-using-listusers-api Searching for Users Using the ListUsers API>
-- and
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/how-to-manage-user-accounts.html#cognito-user-pools-searching-for-users-listusers-api-examples Examples of Using the ListUsers API>
-- in the /Amazon Cognito Developer Guide/.
listUsers_filter :: Lens.Lens' ListUsers (Prelude.Maybe Prelude.Text)
listUsers_filter :: Lens' ListUsers (Maybe Text)
listUsers_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUsers' {Maybe Text
filter' :: Maybe Text
$sel:filter':ListUsers' :: ListUsers -> Maybe Text
filter'} -> Maybe Text
filter') (\s :: ListUsers
s@ListUsers' {} Maybe Text
a -> ListUsers
s {$sel:filter':ListUsers' :: Maybe Text
filter' = Maybe Text
a} :: ListUsers)

-- | Maximum number of users to be returned.
listUsers_limit :: Lens.Lens' ListUsers (Prelude.Maybe Prelude.Natural)
listUsers_limit :: Lens' ListUsers (Maybe Natural)
listUsers_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUsers' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ListUsers' :: ListUsers -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ListUsers
s@ListUsers' {} Maybe Natural
a -> ListUsers
s {$sel:limit:ListUsers' :: Maybe Natural
limit = Maybe Natural
a} :: ListUsers)

-- | An identifier that was returned from the previous call to this
-- operation, which can be used to return the next set of items in the
-- list.
listUsers_paginationToken :: Lens.Lens' ListUsers (Prelude.Maybe Prelude.Text)
listUsers_paginationToken :: Lens' ListUsers (Maybe Text)
listUsers_paginationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUsers' {Maybe Text
paginationToken :: Maybe Text
$sel:paginationToken:ListUsers' :: ListUsers -> Maybe Text
paginationToken} -> Maybe Text
paginationToken) (\s :: ListUsers
s@ListUsers' {} Maybe Text
a -> ListUsers
s {$sel:paginationToken:ListUsers' :: Maybe Text
paginationToken = Maybe Text
a} :: ListUsers)

-- | The user pool ID for the user pool on which the search should be
-- performed.
listUsers_userPoolId :: Lens.Lens' ListUsers Prelude.Text
listUsers_userPoolId :: Lens' ListUsers Text
listUsers_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUsers' {Text
userPoolId :: Text
$sel:userPoolId:ListUsers' :: ListUsers -> Text
userPoolId} -> Text
userPoolId) (\s :: ListUsers
s@ListUsers' {} Text
a -> ListUsers
s {$sel:userPoolId:ListUsers' :: Text
userPoolId = Text
a} :: ListUsers)

instance Core.AWSPager ListUsers where
  page :: ListUsers -> AWSResponse ListUsers -> Maybe ListUsers
page ListUsers
rq AWSResponse ListUsers
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListUsers
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListUsersResponse (Maybe Text)
listUsersResponse_paginationToken
            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 ListUsers
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListUsersResponse (Maybe [UserType])
listUsersResponse_users
            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.$ ListUsers
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListUsers (Maybe Text)
listUsers_paginationToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListUsers
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListUsersResponse (Maybe Text)
listUsersResponse_paginationToken
          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 ListUsers where
  type AWSResponse ListUsers = ListUsersResponse
  request :: (Service -> Service) -> ListUsers -> Request ListUsers
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 ListUsers
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListUsers)))
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 -> Maybe [UserType] -> Int -> ListUsersResponse
ListUsersResponse'
            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
"PaginationToken")
            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
"Users" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListUsers where
  hashWithSalt :: Int -> ListUsers -> Int
hashWithSalt Int
_salt ListUsers' {Maybe Natural
Maybe [Text]
Maybe Text
Text
userPoolId :: Text
paginationToken :: Maybe Text
limit :: Maybe Natural
filter' :: Maybe Text
attributesToGet :: Maybe [Text]
$sel:userPoolId:ListUsers' :: ListUsers -> Text
$sel:paginationToken:ListUsers' :: ListUsers -> Maybe Text
$sel:limit:ListUsers' :: ListUsers -> Maybe Natural
$sel:filter':ListUsers' :: ListUsers -> Maybe Text
$sel:attributesToGet:ListUsers' :: ListUsers -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
attributesToGet
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
paginationToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId

instance Prelude.NFData ListUsers where
  rnf :: ListUsers -> ()
rnf ListUsers' {Maybe Natural
Maybe [Text]
Maybe Text
Text
userPoolId :: Text
paginationToken :: Maybe Text
limit :: Maybe Natural
filter' :: Maybe Text
attributesToGet :: Maybe [Text]
$sel:userPoolId:ListUsers' :: ListUsers -> Text
$sel:paginationToken:ListUsers' :: ListUsers -> Maybe Text
$sel:limit:ListUsers' :: ListUsers -> Maybe Natural
$sel:filter':ListUsers' :: ListUsers -> Maybe Text
$sel:attributesToGet:ListUsers' :: ListUsers -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
attributesToGet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
paginationToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId

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

instance Data.ToJSON ListUsers where
  toJSON :: ListUsers -> Value
toJSON ListUsers' {Maybe Natural
Maybe [Text]
Maybe Text
Text
userPoolId :: Text
paginationToken :: Maybe Text
limit :: Maybe Natural
filter' :: Maybe Text
attributesToGet :: Maybe [Text]
$sel:userPoolId:ListUsers' :: ListUsers -> Text
$sel:paginationToken:ListUsers' :: ListUsers -> Maybe Text
$sel:limit:ListUsers' :: ListUsers -> Maybe Natural
$sel:filter':ListUsers' :: ListUsers -> Maybe Text
$sel:attributesToGet:ListUsers' :: ListUsers -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AttributesToGet" 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]
attributesToGet,
            (Key
"Filter" 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
filter',
            (Key
"Limit" 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 Natural
limit,
            (Key
"PaginationToken" 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
paginationToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"UserPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userPoolId)
          ]
      )

instance Data.ToPath ListUsers where
  toPath :: ListUsers -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | The response from the request to list users.
--
-- /See:/ 'newListUsersResponse' smart constructor.
data ListUsersResponse = ListUsersResponse'
  { -- | An identifier that was returned from the previous call to this
    -- operation, which can be used to return the next set of items in the
    -- list.
    ListUsersResponse -> Maybe Text
paginationToken :: Prelude.Maybe Prelude.Text,
    -- | The users returned in the request to list users.
    ListUsersResponse -> Maybe [UserType]
users :: Prelude.Maybe [UserType],
    -- | The response's http status code.
    ListUsersResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListUsersResponse -> ListUsersResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListUsersResponse -> ListUsersResponse -> Bool
$c/= :: ListUsersResponse -> ListUsersResponse -> Bool
== :: ListUsersResponse -> ListUsersResponse -> Bool
$c== :: ListUsersResponse -> ListUsersResponse -> Bool
Prelude.Eq, Int -> ListUsersResponse -> ShowS
[ListUsersResponse] -> ShowS
ListUsersResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListUsersResponse] -> ShowS
$cshowList :: [ListUsersResponse] -> ShowS
show :: ListUsersResponse -> String
$cshow :: ListUsersResponse -> String
showsPrec :: Int -> ListUsersResponse -> ShowS
$cshowsPrec :: Int -> ListUsersResponse -> ShowS
Prelude.Show, forall x. Rep ListUsersResponse x -> ListUsersResponse
forall x. ListUsersResponse -> Rep ListUsersResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListUsersResponse x -> ListUsersResponse
$cfrom :: forall x. ListUsersResponse -> Rep ListUsersResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListUsersResponse' 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:
--
-- 'paginationToken', 'listUsersResponse_paginationToken' - An identifier that was returned from the previous call to this
-- operation, which can be used to return the next set of items in the
-- list.
--
-- 'users', 'listUsersResponse_users' - The users returned in the request to list users.
--
-- 'httpStatus', 'listUsersResponse_httpStatus' - The response's http status code.
newListUsersResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListUsersResponse
newListUsersResponse :: Int -> ListUsersResponse
newListUsersResponse Int
pHttpStatus_ =
  ListUsersResponse'
    { $sel:paginationToken:ListUsersResponse' :: Maybe Text
paginationToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:users:ListUsersResponse' :: Maybe [UserType]
users = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListUsersResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An identifier that was returned from the previous call to this
-- operation, which can be used to return the next set of items in the
-- list.
listUsersResponse_paginationToken :: Lens.Lens' ListUsersResponse (Prelude.Maybe Prelude.Text)
listUsersResponse_paginationToken :: Lens' ListUsersResponse (Maybe Text)
listUsersResponse_paginationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUsersResponse' {Maybe Text
paginationToken :: Maybe Text
$sel:paginationToken:ListUsersResponse' :: ListUsersResponse -> Maybe Text
paginationToken} -> Maybe Text
paginationToken) (\s :: ListUsersResponse
s@ListUsersResponse' {} Maybe Text
a -> ListUsersResponse
s {$sel:paginationToken:ListUsersResponse' :: Maybe Text
paginationToken = Maybe Text
a} :: ListUsersResponse)

-- | The users returned in the request to list users.
listUsersResponse_users :: Lens.Lens' ListUsersResponse (Prelude.Maybe [UserType])
listUsersResponse_users :: Lens' ListUsersResponse (Maybe [UserType])
listUsersResponse_users = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUsersResponse' {Maybe [UserType]
users :: Maybe [UserType]
$sel:users:ListUsersResponse' :: ListUsersResponse -> Maybe [UserType]
users} -> Maybe [UserType]
users) (\s :: ListUsersResponse
s@ListUsersResponse' {} Maybe [UserType]
a -> ListUsersResponse
s {$sel:users:ListUsersResponse' :: Maybe [UserType]
users = Maybe [UserType]
a} :: ListUsersResponse) 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 response's http status code.
listUsersResponse_httpStatus :: Lens.Lens' ListUsersResponse Prelude.Int
listUsersResponse_httpStatus :: Lens' ListUsersResponse Int
listUsersResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUsersResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListUsersResponse' :: ListUsersResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListUsersResponse
s@ListUsersResponse' {} Int
a -> ListUsersResponse
s {$sel:httpStatus:ListUsersResponse' :: Int
httpStatus = Int
a} :: ListUsersResponse)

instance Prelude.NFData ListUsersResponse where
  rnf :: ListUsersResponse -> ()
rnf ListUsersResponse' {Int
Maybe [UserType]
Maybe Text
httpStatus :: Int
users :: Maybe [UserType]
paginationToken :: Maybe Text
$sel:httpStatus:ListUsersResponse' :: ListUsersResponse -> Int
$sel:users:ListUsersResponse' :: ListUsersResponse -> Maybe [UserType]
$sel:paginationToken:ListUsersResponse' :: ListUsersResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
paginationToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UserType]
users
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus