{-# 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.SESV2.ListImportJobs
-- 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 all of the import jobs.
module Amazonka.SESV2.ListImportJobs
  ( -- * Creating a Request
    ListImportJobs (..),
    newListImportJobs,

    -- * Request Lenses
    listImportJobs_importDestinationType,
    listImportJobs_nextToken,
    listImportJobs_pageSize,

    -- * Destructuring the Response
    ListImportJobsResponse (..),
    newListImportJobsResponse,

    -- * Response Lenses
    listImportJobsResponse_importJobs,
    listImportJobsResponse_nextToken,
    listImportJobsResponse_httpStatus,
  )
where

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
import Amazonka.SESV2.Types

-- | Represents a request to list all of the import jobs for a data
-- destination within the specified maximum number of import jobs.
--
-- /See:/ 'newListImportJobs' smart constructor.
data ListImportJobs = ListImportJobs'
  { -- | The destination of the import job, which can be used to list import jobs
    -- that have a certain @ImportDestinationType@.
    ListImportJobs -> Maybe ImportDestinationType
importDestinationType :: Prelude.Maybe ImportDestinationType,
    -- | A string token indicating that there might be additional import jobs
    -- available to be listed. Copy this token to a subsequent call to
    -- @ListImportJobs@ with the same parameters to retrieve the next page of
    -- import jobs.
    ListImportJobs -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Maximum number of import jobs to return at once. Use this parameter to
    -- paginate results. If additional import jobs exist beyond the specified
    -- limit, the @NextToken@ element is sent in the response. Use the
    -- @NextToken@ value in subsequent requests to retrieve additional
    -- addresses.
    ListImportJobs -> Maybe Int
pageSize :: Prelude.Maybe Prelude.Int
  }
  deriving (ListImportJobs -> ListImportJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListImportJobs -> ListImportJobs -> Bool
$c/= :: ListImportJobs -> ListImportJobs -> Bool
== :: ListImportJobs -> ListImportJobs -> Bool
$c== :: ListImportJobs -> ListImportJobs -> Bool
Prelude.Eq, ReadPrec [ListImportJobs]
ReadPrec ListImportJobs
Int -> ReadS ListImportJobs
ReadS [ListImportJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListImportJobs]
$creadListPrec :: ReadPrec [ListImportJobs]
readPrec :: ReadPrec ListImportJobs
$creadPrec :: ReadPrec ListImportJobs
readList :: ReadS [ListImportJobs]
$creadList :: ReadS [ListImportJobs]
readsPrec :: Int -> ReadS ListImportJobs
$creadsPrec :: Int -> ReadS ListImportJobs
Prelude.Read, Int -> ListImportJobs -> ShowS
[ListImportJobs] -> ShowS
ListImportJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListImportJobs] -> ShowS
$cshowList :: [ListImportJobs] -> ShowS
show :: ListImportJobs -> String
$cshow :: ListImportJobs -> String
showsPrec :: Int -> ListImportJobs -> ShowS
$cshowsPrec :: Int -> ListImportJobs -> ShowS
Prelude.Show, forall x. Rep ListImportJobs x -> ListImportJobs
forall x. ListImportJobs -> Rep ListImportJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListImportJobs x -> ListImportJobs
$cfrom :: forall x. ListImportJobs -> Rep ListImportJobs x
Prelude.Generic)

-- |
-- Create a value of 'ListImportJobs' 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:
--
-- 'importDestinationType', 'listImportJobs_importDestinationType' - The destination of the import job, which can be used to list import jobs
-- that have a certain @ImportDestinationType@.
--
-- 'nextToken', 'listImportJobs_nextToken' - A string token indicating that there might be additional import jobs
-- available to be listed. Copy this token to a subsequent call to
-- @ListImportJobs@ with the same parameters to retrieve the next page of
-- import jobs.
--
-- 'pageSize', 'listImportJobs_pageSize' - Maximum number of import jobs to return at once. Use this parameter to
-- paginate results. If additional import jobs exist beyond the specified
-- limit, the @NextToken@ element is sent in the response. Use the
-- @NextToken@ value in subsequent requests to retrieve additional
-- addresses.
newListImportJobs ::
  ListImportJobs
newListImportJobs :: ListImportJobs
newListImportJobs =
  ListImportJobs'
    { $sel:importDestinationType:ListImportJobs' :: Maybe ImportDestinationType
importDestinationType =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListImportJobs' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:ListImportJobs' :: Maybe Int
pageSize = forall a. Maybe a
Prelude.Nothing
    }

-- | The destination of the import job, which can be used to list import jobs
-- that have a certain @ImportDestinationType@.
listImportJobs_importDestinationType :: Lens.Lens' ListImportJobs (Prelude.Maybe ImportDestinationType)
listImportJobs_importDestinationType :: Lens' ListImportJobs (Maybe ImportDestinationType)
listImportJobs_importDestinationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportJobs' {Maybe ImportDestinationType
importDestinationType :: Maybe ImportDestinationType
$sel:importDestinationType:ListImportJobs' :: ListImportJobs -> Maybe ImportDestinationType
importDestinationType} -> Maybe ImportDestinationType
importDestinationType) (\s :: ListImportJobs
s@ListImportJobs' {} Maybe ImportDestinationType
a -> ListImportJobs
s {$sel:importDestinationType:ListImportJobs' :: Maybe ImportDestinationType
importDestinationType = Maybe ImportDestinationType
a} :: ListImportJobs)

-- | A string token indicating that there might be additional import jobs
-- available to be listed. Copy this token to a subsequent call to
-- @ListImportJobs@ with the same parameters to retrieve the next page of
-- import jobs.
listImportJobs_nextToken :: Lens.Lens' ListImportJobs (Prelude.Maybe Prelude.Text)
listImportJobs_nextToken :: Lens' ListImportJobs (Maybe Text)
listImportJobs_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportJobs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListImportJobs' :: ListImportJobs -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListImportJobs
s@ListImportJobs' {} Maybe Text
a -> ListImportJobs
s {$sel:nextToken:ListImportJobs' :: Maybe Text
nextToken = Maybe Text
a} :: ListImportJobs)

-- | Maximum number of import jobs to return at once. Use this parameter to
-- paginate results. If additional import jobs exist beyond the specified
-- limit, the @NextToken@ element is sent in the response. Use the
-- @NextToken@ value in subsequent requests to retrieve additional
-- addresses.
listImportJobs_pageSize :: Lens.Lens' ListImportJobs (Prelude.Maybe Prelude.Int)
listImportJobs_pageSize :: Lens' ListImportJobs (Maybe Int)
listImportJobs_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportJobs' {Maybe Int
pageSize :: Maybe Int
$sel:pageSize:ListImportJobs' :: ListImportJobs -> Maybe Int
pageSize} -> Maybe Int
pageSize) (\s :: ListImportJobs
s@ListImportJobs' {} Maybe Int
a -> ListImportJobs
s {$sel:pageSize:ListImportJobs' :: Maybe Int
pageSize = Maybe Int
a} :: ListImportJobs)

instance Core.AWSRequest ListImportJobs where
  type
    AWSResponse ListImportJobs =
      ListImportJobsResponse
  request :: (Service -> Service) -> ListImportJobs -> Request ListImportJobs
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListImportJobs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListImportJobs)))
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 [ImportJobSummary]
-> Maybe Text -> Int -> ListImportJobsResponse
ListImportJobsResponse'
            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
"ImportJobs" 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 ListImportJobs where
  hashWithSalt :: Int -> ListImportJobs -> Int
hashWithSalt Int
_salt ListImportJobs' {Maybe Int
Maybe Text
Maybe ImportDestinationType
pageSize :: Maybe Int
nextToken :: Maybe Text
importDestinationType :: Maybe ImportDestinationType
$sel:pageSize:ListImportJobs' :: ListImportJobs -> Maybe Int
$sel:nextToken:ListImportJobs' :: ListImportJobs -> Maybe Text
$sel:importDestinationType:ListImportJobs' :: ListImportJobs -> Maybe ImportDestinationType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ImportDestinationType
importDestinationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
pageSize

instance Prelude.NFData ListImportJobs where
  rnf :: ListImportJobs -> ()
rnf ListImportJobs' {Maybe Int
Maybe Text
Maybe ImportDestinationType
pageSize :: Maybe Int
nextToken :: Maybe Text
importDestinationType :: Maybe ImportDestinationType
$sel:pageSize:ListImportJobs' :: ListImportJobs -> Maybe Int
$sel:nextToken:ListImportJobs' :: ListImportJobs -> Maybe Text
$sel:importDestinationType:ListImportJobs' :: ListImportJobs -> Maybe ImportDestinationType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ImportDestinationType
importDestinationType
      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 Maybe Int
pageSize

instance Data.ToHeaders ListImportJobs where
  toHeaders :: ListImportJobs -> 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.ToPath ListImportJobs where
  toPath :: ListImportJobs -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v2/email/import-jobs"

instance Data.ToQuery ListImportJobs where
  toQuery :: ListImportJobs -> QueryString
toQuery ListImportJobs' {Maybe Int
Maybe Text
Maybe ImportDestinationType
pageSize :: Maybe Int
nextToken :: Maybe Text
importDestinationType :: Maybe ImportDestinationType
$sel:pageSize:ListImportJobs' :: ListImportJobs -> Maybe Int
$sel:nextToken:ListImportJobs' :: ListImportJobs -> Maybe Text
$sel:importDestinationType:ListImportJobs' :: ListImportJobs -> Maybe ImportDestinationType
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"PageSize" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
pageSize
      ]

-- | An HTTP 200 response if the request succeeds, or an error message if the
-- request fails.
--
-- /See:/ 'newListImportJobsResponse' smart constructor.
data ListImportJobsResponse = ListImportJobsResponse'
  { -- | A list of the import job summaries.
    ListImportJobsResponse -> Maybe [ImportJobSummary]
importJobs :: Prelude.Maybe [ImportJobSummary],
    -- | A string token indicating that there might be additional import jobs
    -- available to be listed. Copy this token to a subsequent call to
    -- @ListImportJobs@ with the same parameters to retrieve the next page of
    -- import jobs.
    ListImportJobsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListImportJobsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListImportJobsResponse -> ListImportJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListImportJobsResponse -> ListImportJobsResponse -> Bool
$c/= :: ListImportJobsResponse -> ListImportJobsResponse -> Bool
== :: ListImportJobsResponse -> ListImportJobsResponse -> Bool
$c== :: ListImportJobsResponse -> ListImportJobsResponse -> Bool
Prelude.Eq, ReadPrec [ListImportJobsResponse]
ReadPrec ListImportJobsResponse
Int -> ReadS ListImportJobsResponse
ReadS [ListImportJobsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListImportJobsResponse]
$creadListPrec :: ReadPrec [ListImportJobsResponse]
readPrec :: ReadPrec ListImportJobsResponse
$creadPrec :: ReadPrec ListImportJobsResponse
readList :: ReadS [ListImportJobsResponse]
$creadList :: ReadS [ListImportJobsResponse]
readsPrec :: Int -> ReadS ListImportJobsResponse
$creadsPrec :: Int -> ReadS ListImportJobsResponse
Prelude.Read, Int -> ListImportJobsResponse -> ShowS
[ListImportJobsResponse] -> ShowS
ListImportJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListImportJobsResponse] -> ShowS
$cshowList :: [ListImportJobsResponse] -> ShowS
show :: ListImportJobsResponse -> String
$cshow :: ListImportJobsResponse -> String
showsPrec :: Int -> ListImportJobsResponse -> ShowS
$cshowsPrec :: Int -> ListImportJobsResponse -> ShowS
Prelude.Show, forall x. Rep ListImportJobsResponse x -> ListImportJobsResponse
forall x. ListImportJobsResponse -> Rep ListImportJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListImportJobsResponse x -> ListImportJobsResponse
$cfrom :: forall x. ListImportJobsResponse -> Rep ListImportJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListImportJobsResponse' 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:
--
-- 'importJobs', 'listImportJobsResponse_importJobs' - A list of the import job summaries.
--
-- 'nextToken', 'listImportJobsResponse_nextToken' - A string token indicating that there might be additional import jobs
-- available to be listed. Copy this token to a subsequent call to
-- @ListImportJobs@ with the same parameters to retrieve the next page of
-- import jobs.
--
-- 'httpStatus', 'listImportJobsResponse_httpStatus' - The response's http status code.
newListImportJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListImportJobsResponse
newListImportJobsResponse :: Int -> ListImportJobsResponse
newListImportJobsResponse Int
pHttpStatus_ =
  ListImportJobsResponse'
    { $sel:importJobs:ListImportJobsResponse' :: Maybe [ImportJobSummary]
importJobs =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListImportJobsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListImportJobsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of the import job summaries.
listImportJobsResponse_importJobs :: Lens.Lens' ListImportJobsResponse (Prelude.Maybe [ImportJobSummary])
listImportJobsResponse_importJobs :: Lens' ListImportJobsResponse (Maybe [ImportJobSummary])
listImportJobsResponse_importJobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportJobsResponse' {Maybe [ImportJobSummary]
importJobs :: Maybe [ImportJobSummary]
$sel:importJobs:ListImportJobsResponse' :: ListImportJobsResponse -> Maybe [ImportJobSummary]
importJobs} -> Maybe [ImportJobSummary]
importJobs) (\s :: ListImportJobsResponse
s@ListImportJobsResponse' {} Maybe [ImportJobSummary]
a -> ListImportJobsResponse
s {$sel:importJobs:ListImportJobsResponse' :: Maybe [ImportJobSummary]
importJobs = Maybe [ImportJobSummary]
a} :: ListImportJobsResponse) 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 string token indicating that there might be additional import jobs
-- available to be listed. Copy this token to a subsequent call to
-- @ListImportJobs@ with the same parameters to retrieve the next page of
-- import jobs.
listImportJobsResponse_nextToken :: Lens.Lens' ListImportJobsResponse (Prelude.Maybe Prelude.Text)
listImportJobsResponse_nextToken :: Lens' ListImportJobsResponse (Maybe Text)
listImportJobsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportJobsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListImportJobsResponse' :: ListImportJobsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListImportJobsResponse
s@ListImportJobsResponse' {} Maybe Text
a -> ListImportJobsResponse
s {$sel:nextToken:ListImportJobsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListImportJobsResponse)

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

instance Prelude.NFData ListImportJobsResponse where
  rnf :: ListImportJobsResponse -> ()
rnf ListImportJobsResponse' {Int
Maybe [ImportJobSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
importJobs :: Maybe [ImportJobSummary]
$sel:httpStatus:ListImportJobsResponse' :: ListImportJobsResponse -> Int
$sel:nextToken:ListImportJobsResponse' :: ListImportJobsResponse -> Maybe Text
$sel:importJobs:ListImportJobsResponse' :: ListImportJobsResponse -> Maybe [ImportJobSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ImportJobSummary]
importJobs
      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