{-# 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.ListUserImportJobs
-- 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 user import jobs.
module Amazonka.CognitoIdentityProvider.ListUserImportJobs
  ( -- * Creating a Request
    ListUserImportJobs (..),
    newListUserImportJobs,

    -- * Request Lenses
    listUserImportJobs_paginationToken,
    listUserImportJobs_userPoolId,
    listUserImportJobs_maxResults,

    -- * Destructuring the Response
    ListUserImportJobsResponse (..),
    newListUserImportJobsResponse,

    -- * Response Lenses
    listUserImportJobsResponse_paginationToken,
    listUserImportJobsResponse_userImportJobs,
    listUserImportJobsResponse_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 the user import jobs.
--
-- /See:/ 'newListUserImportJobs' smart constructor.
data ListUserImportJobs = ListUserImportJobs'
  { -- | An identifier that was returned from the previous call to
    -- @ListUserImportJobs@, which can be used to return the next set of import
    -- jobs in the list.
    ListUserImportJobs -> Maybe Text
paginationToken :: Prelude.Maybe Prelude.Text,
    -- | The user pool ID for the user pool that the users are being imported
    -- into.
    ListUserImportJobs -> Text
userPoolId :: Prelude.Text,
    -- | The maximum number of import jobs you want the request to return.
    ListUserImportJobs -> Natural
maxResults :: Prelude.Natural
  }
  deriving (ListUserImportJobs -> ListUserImportJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListUserImportJobs -> ListUserImportJobs -> Bool
$c/= :: ListUserImportJobs -> ListUserImportJobs -> Bool
== :: ListUserImportJobs -> ListUserImportJobs -> Bool
$c== :: ListUserImportJobs -> ListUserImportJobs -> Bool
Prelude.Eq, ReadPrec [ListUserImportJobs]
ReadPrec ListUserImportJobs
Int -> ReadS ListUserImportJobs
ReadS [ListUserImportJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListUserImportJobs]
$creadListPrec :: ReadPrec [ListUserImportJobs]
readPrec :: ReadPrec ListUserImportJobs
$creadPrec :: ReadPrec ListUserImportJobs
readList :: ReadS [ListUserImportJobs]
$creadList :: ReadS [ListUserImportJobs]
readsPrec :: Int -> ReadS ListUserImportJobs
$creadsPrec :: Int -> ReadS ListUserImportJobs
Prelude.Read, Int -> ListUserImportJobs -> ShowS
[ListUserImportJobs] -> ShowS
ListUserImportJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListUserImportJobs] -> ShowS
$cshowList :: [ListUserImportJobs] -> ShowS
show :: ListUserImportJobs -> String
$cshow :: ListUserImportJobs -> String
showsPrec :: Int -> ListUserImportJobs -> ShowS
$cshowsPrec :: Int -> ListUserImportJobs -> ShowS
Prelude.Show, forall x. Rep ListUserImportJobs x -> ListUserImportJobs
forall x. ListUserImportJobs -> Rep ListUserImportJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListUserImportJobs x -> ListUserImportJobs
$cfrom :: forall x. ListUserImportJobs -> Rep ListUserImportJobs x
Prelude.Generic)

-- |
-- Create a value of 'ListUserImportJobs' 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', 'listUserImportJobs_paginationToken' - An identifier that was returned from the previous call to
-- @ListUserImportJobs@, which can be used to return the next set of import
-- jobs in the list.
--
-- 'userPoolId', 'listUserImportJobs_userPoolId' - The user pool ID for the user pool that the users are being imported
-- into.
--
-- 'maxResults', 'listUserImportJobs_maxResults' - The maximum number of import jobs you want the request to return.
newListUserImportJobs ::
  -- | 'userPoolId'
  Prelude.Text ->
  -- | 'maxResults'
  Prelude.Natural ->
  ListUserImportJobs
newListUserImportJobs :: Text -> Natural -> ListUserImportJobs
newListUserImportJobs Text
pUserPoolId_ Natural
pMaxResults_ =
  ListUserImportJobs'
    { $sel:paginationToken:ListUserImportJobs' :: Maybe Text
paginationToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:userPoolId:ListUserImportJobs' :: Text
userPoolId = Text
pUserPoolId_,
      $sel:maxResults:ListUserImportJobs' :: Natural
maxResults = Natural
pMaxResults_
    }

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

-- | The user pool ID for the user pool that the users are being imported
-- into.
listUserImportJobs_userPoolId :: Lens.Lens' ListUserImportJobs Prelude.Text
listUserImportJobs_userPoolId :: Lens' ListUserImportJobs Text
listUserImportJobs_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserImportJobs' {Text
userPoolId :: Text
$sel:userPoolId:ListUserImportJobs' :: ListUserImportJobs -> Text
userPoolId} -> Text
userPoolId) (\s :: ListUserImportJobs
s@ListUserImportJobs' {} Text
a -> ListUserImportJobs
s {$sel:userPoolId:ListUserImportJobs' :: Text
userPoolId = Text
a} :: ListUserImportJobs)

-- | The maximum number of import jobs you want the request to return.
listUserImportJobs_maxResults :: Lens.Lens' ListUserImportJobs Prelude.Natural
listUserImportJobs_maxResults :: Lens' ListUserImportJobs Natural
listUserImportJobs_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserImportJobs' {Natural
maxResults :: Natural
$sel:maxResults:ListUserImportJobs' :: ListUserImportJobs -> Natural
maxResults} -> Natural
maxResults) (\s :: ListUserImportJobs
s@ListUserImportJobs' {} Natural
a -> ListUserImportJobs
s {$sel:maxResults:ListUserImportJobs' :: Natural
maxResults = Natural
a} :: ListUserImportJobs)

instance Core.AWSRequest ListUserImportJobs where
  type
    AWSResponse ListUserImportJobs =
      ListUserImportJobsResponse
  request :: (Service -> Service)
-> ListUserImportJobs -> Request ListUserImportJobs
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 ListUserImportJobs
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListUserImportJobs)))
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 (NonEmpty UserImportJobType)
-> Int
-> ListUserImportJobsResponse
ListUserImportJobsResponse'
            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
"UserImportJobs")
            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 ListUserImportJobs where
  hashWithSalt :: Int -> ListUserImportJobs -> Int
hashWithSalt Int
_salt ListUserImportJobs' {Natural
Maybe Text
Text
maxResults :: Natural
userPoolId :: Text
paginationToken :: Maybe Text
$sel:maxResults:ListUserImportJobs' :: ListUserImportJobs -> Natural
$sel:userPoolId:ListUserImportJobs' :: ListUserImportJobs -> Text
$sel:paginationToken:ListUserImportJobs' :: ListUserImportJobs -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
paginationToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
maxResults

instance Prelude.NFData ListUserImportJobs where
  rnf :: ListUserImportJobs -> ()
rnf ListUserImportJobs' {Natural
Maybe Text
Text
maxResults :: Natural
userPoolId :: Text
paginationToken :: Maybe Text
$sel:maxResults:ListUserImportJobs' :: ListUserImportJobs -> Natural
$sel:userPoolId:ListUserImportJobs' :: ListUserImportJobs -> Text
$sel:paginationToken:ListUserImportJobs' :: ListUserImportJobs -> 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 Text
userPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
maxResults

instance Data.ToHeaders ListUserImportJobs where
  toHeaders :: ListUserImportJobs -> 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.ListUserImportJobs" ::
                          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 ListUserImportJobs where
  toJSON :: ListUserImportJobs -> Value
toJSON ListUserImportJobs' {Natural
Maybe Text
Text
maxResults :: Natural
userPoolId :: Text
paginationToken :: Maybe Text
$sel:maxResults:ListUserImportJobs' :: ListUserImportJobs -> Natural
$sel:userPoolId:ListUserImportJobs' :: ListUserImportJobs -> Text
$sel:paginationToken:ListUserImportJobs' :: ListUserImportJobs -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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),
            forall a. a -> Maybe a
Prelude.Just (Key
"MaxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
maxResults)
          ]
      )

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

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

-- | Represents the response from the server to the request to list the user
-- import jobs.
--
-- /See:/ 'newListUserImportJobsResponse' smart constructor.
data ListUserImportJobsResponse = ListUserImportJobsResponse'
  { -- | An identifier that can be used to return the next set of user import
    -- jobs in the list.
    ListUserImportJobsResponse -> Maybe Text
paginationToken :: Prelude.Maybe Prelude.Text,
    -- | The user import jobs.
    ListUserImportJobsResponse -> Maybe (NonEmpty UserImportJobType)
userImportJobs :: Prelude.Maybe (Prelude.NonEmpty UserImportJobType),
    -- | The response's http status code.
    ListUserImportJobsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListUserImportJobsResponse -> ListUserImportJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListUserImportJobsResponse -> ListUserImportJobsResponse -> Bool
$c/= :: ListUserImportJobsResponse -> ListUserImportJobsResponse -> Bool
== :: ListUserImportJobsResponse -> ListUserImportJobsResponse -> Bool
$c== :: ListUserImportJobsResponse -> ListUserImportJobsResponse -> Bool
Prelude.Eq, ReadPrec [ListUserImportJobsResponse]
ReadPrec ListUserImportJobsResponse
Int -> ReadS ListUserImportJobsResponse
ReadS [ListUserImportJobsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListUserImportJobsResponse]
$creadListPrec :: ReadPrec [ListUserImportJobsResponse]
readPrec :: ReadPrec ListUserImportJobsResponse
$creadPrec :: ReadPrec ListUserImportJobsResponse
readList :: ReadS [ListUserImportJobsResponse]
$creadList :: ReadS [ListUserImportJobsResponse]
readsPrec :: Int -> ReadS ListUserImportJobsResponse
$creadsPrec :: Int -> ReadS ListUserImportJobsResponse
Prelude.Read, Int -> ListUserImportJobsResponse -> ShowS
[ListUserImportJobsResponse] -> ShowS
ListUserImportJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListUserImportJobsResponse] -> ShowS
$cshowList :: [ListUserImportJobsResponse] -> ShowS
show :: ListUserImportJobsResponse -> String
$cshow :: ListUserImportJobsResponse -> String
showsPrec :: Int -> ListUserImportJobsResponse -> ShowS
$cshowsPrec :: Int -> ListUserImportJobsResponse -> ShowS
Prelude.Show, forall x.
Rep ListUserImportJobsResponse x -> ListUserImportJobsResponse
forall x.
ListUserImportJobsResponse -> Rep ListUserImportJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListUserImportJobsResponse x -> ListUserImportJobsResponse
$cfrom :: forall x.
ListUserImportJobsResponse -> Rep ListUserImportJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListUserImportJobsResponse' 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', 'listUserImportJobsResponse_paginationToken' - An identifier that can be used to return the next set of user import
-- jobs in the list.
--
-- 'userImportJobs', 'listUserImportJobsResponse_userImportJobs' - The user import jobs.
--
-- 'httpStatus', 'listUserImportJobsResponse_httpStatus' - The response's http status code.
newListUserImportJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListUserImportJobsResponse
newListUserImportJobsResponse :: Int -> ListUserImportJobsResponse
newListUserImportJobsResponse Int
pHttpStatus_ =
  ListUserImportJobsResponse'
    { $sel:paginationToken:ListUserImportJobsResponse' :: Maybe Text
paginationToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:userImportJobs:ListUserImportJobsResponse' :: Maybe (NonEmpty UserImportJobType)
userImportJobs = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListUserImportJobsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An identifier that can be used to return the next set of user import
-- jobs in the list.
listUserImportJobsResponse_paginationToken :: Lens.Lens' ListUserImportJobsResponse (Prelude.Maybe Prelude.Text)
listUserImportJobsResponse_paginationToken :: Lens' ListUserImportJobsResponse (Maybe Text)
listUserImportJobsResponse_paginationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserImportJobsResponse' {Maybe Text
paginationToken :: Maybe Text
$sel:paginationToken:ListUserImportJobsResponse' :: ListUserImportJobsResponse -> Maybe Text
paginationToken} -> Maybe Text
paginationToken) (\s :: ListUserImportJobsResponse
s@ListUserImportJobsResponse' {} Maybe Text
a -> ListUserImportJobsResponse
s {$sel:paginationToken:ListUserImportJobsResponse' :: Maybe Text
paginationToken = Maybe Text
a} :: ListUserImportJobsResponse)

-- | The user import jobs.
listUserImportJobsResponse_userImportJobs :: Lens.Lens' ListUserImportJobsResponse (Prelude.Maybe (Prelude.NonEmpty UserImportJobType))
listUserImportJobsResponse_userImportJobs :: Lens'
  ListUserImportJobsResponse (Maybe (NonEmpty UserImportJobType))
listUserImportJobsResponse_userImportJobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserImportJobsResponse' {Maybe (NonEmpty UserImportJobType)
userImportJobs :: Maybe (NonEmpty UserImportJobType)
$sel:userImportJobs:ListUserImportJobsResponse' :: ListUserImportJobsResponse -> Maybe (NonEmpty UserImportJobType)
userImportJobs} -> Maybe (NonEmpty UserImportJobType)
userImportJobs) (\s :: ListUserImportJobsResponse
s@ListUserImportJobsResponse' {} Maybe (NonEmpty UserImportJobType)
a -> ListUserImportJobsResponse
s {$sel:userImportJobs:ListUserImportJobsResponse' :: Maybe (NonEmpty UserImportJobType)
userImportJobs = Maybe (NonEmpty UserImportJobType)
a} :: ListUserImportJobsResponse) 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.
listUserImportJobsResponse_httpStatus :: Lens.Lens' ListUserImportJobsResponse Prelude.Int
listUserImportJobsResponse_httpStatus :: Lens' ListUserImportJobsResponse Int
listUserImportJobsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserImportJobsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListUserImportJobsResponse' :: ListUserImportJobsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListUserImportJobsResponse
s@ListUserImportJobsResponse' {} Int
a -> ListUserImportJobsResponse
s {$sel:httpStatus:ListUserImportJobsResponse' :: Int
httpStatus = Int
a} :: ListUserImportJobsResponse)

instance Prelude.NFData ListUserImportJobsResponse where
  rnf :: ListUserImportJobsResponse -> ()
rnf ListUserImportJobsResponse' {Int
Maybe (NonEmpty UserImportJobType)
Maybe Text
httpStatus :: Int
userImportJobs :: Maybe (NonEmpty UserImportJobType)
paginationToken :: Maybe Text
$sel:httpStatus:ListUserImportJobsResponse' :: ListUserImportJobsResponse -> Int
$sel:userImportJobs:ListUserImportJobsResponse' :: ListUserImportJobsResponse -> Maybe (NonEmpty UserImportJobType)
$sel:paginationToken:ListUserImportJobsResponse' :: ListUserImportJobsResponse -> 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 (NonEmpty UserImportJobType)
userImportJobs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus