{-# 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.Pinpoint.GetImportJobs
-- 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 information about the status and settings of all the import
-- jobs for an application.
module Amazonka.Pinpoint.GetImportJobs
  ( -- * Creating a Request
    GetImportJobs (..),
    newGetImportJobs,

    -- * Request Lenses
    getImportJobs_pageSize,
    getImportJobs_token,
    getImportJobs_applicationId,

    -- * Destructuring the Response
    GetImportJobsResponse (..),
    newGetImportJobsResponse,

    -- * Response Lenses
    getImportJobsResponse_httpStatus,
    getImportJobsResponse_importJobsResponse,
  )
where

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

-- | /See:/ 'newGetImportJobs' smart constructor.
data GetImportJobs = GetImportJobs'
  { -- | The maximum number of items to include in each page of a paginated
    -- response. This parameter is not supported for application, campaign, and
    -- journey metrics.
    GetImportJobs -> Maybe Text
pageSize :: Prelude.Maybe Prelude.Text,
    -- | The NextToken string that specifies which page of results to return in a
    -- paginated response.
    GetImportJobs -> Maybe Text
token :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the application. This identifier is displayed
    -- as the __Project ID__ on the Amazon Pinpoint console.
    GetImportJobs -> Text
applicationId :: Prelude.Text
  }
  deriving (GetImportJobs -> GetImportJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetImportJobs -> GetImportJobs -> Bool
$c/= :: GetImportJobs -> GetImportJobs -> Bool
== :: GetImportJobs -> GetImportJobs -> Bool
$c== :: GetImportJobs -> GetImportJobs -> Bool
Prelude.Eq, ReadPrec [GetImportJobs]
ReadPrec GetImportJobs
Int -> ReadS GetImportJobs
ReadS [GetImportJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetImportJobs]
$creadListPrec :: ReadPrec [GetImportJobs]
readPrec :: ReadPrec GetImportJobs
$creadPrec :: ReadPrec GetImportJobs
readList :: ReadS [GetImportJobs]
$creadList :: ReadS [GetImportJobs]
readsPrec :: Int -> ReadS GetImportJobs
$creadsPrec :: Int -> ReadS GetImportJobs
Prelude.Read, Int -> GetImportJobs -> ShowS
[GetImportJobs] -> ShowS
GetImportJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetImportJobs] -> ShowS
$cshowList :: [GetImportJobs] -> ShowS
show :: GetImportJobs -> String
$cshow :: GetImportJobs -> String
showsPrec :: Int -> GetImportJobs -> ShowS
$cshowsPrec :: Int -> GetImportJobs -> ShowS
Prelude.Show, forall x. Rep GetImportJobs x -> GetImportJobs
forall x. GetImportJobs -> Rep GetImportJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetImportJobs x -> GetImportJobs
$cfrom :: forall x. GetImportJobs -> Rep GetImportJobs x
Prelude.Generic)

-- |
-- Create a value of 'GetImportJobs' 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:
--
-- 'pageSize', 'getImportJobs_pageSize' - The maximum number of items to include in each page of a paginated
-- response. This parameter is not supported for application, campaign, and
-- journey metrics.
--
-- 'token', 'getImportJobs_token' - The NextToken string that specifies which page of results to return in a
-- paginated response.
--
-- 'applicationId', 'getImportJobs_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
newGetImportJobs ::
  -- | 'applicationId'
  Prelude.Text ->
  GetImportJobs
newGetImportJobs :: Text -> GetImportJobs
newGetImportJobs Text
pApplicationId_ =
  GetImportJobs'
    { $sel:pageSize:GetImportJobs' :: Maybe Text
pageSize = forall a. Maybe a
Prelude.Nothing,
      $sel:token:GetImportJobs' :: Maybe Text
token = forall a. Maybe a
Prelude.Nothing,
      $sel:applicationId:GetImportJobs' :: Text
applicationId = Text
pApplicationId_
    }

-- | The maximum number of items to include in each page of a paginated
-- response. This parameter is not supported for application, campaign, and
-- journey metrics.
getImportJobs_pageSize :: Lens.Lens' GetImportJobs (Prelude.Maybe Prelude.Text)
getImportJobs_pageSize :: Lens' GetImportJobs (Maybe Text)
getImportJobs_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImportJobs' {Maybe Text
pageSize :: Maybe Text
$sel:pageSize:GetImportJobs' :: GetImportJobs -> Maybe Text
pageSize} -> Maybe Text
pageSize) (\s :: GetImportJobs
s@GetImportJobs' {} Maybe Text
a -> GetImportJobs
s {$sel:pageSize:GetImportJobs' :: Maybe Text
pageSize = Maybe Text
a} :: GetImportJobs)

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

-- | The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
getImportJobs_applicationId :: Lens.Lens' GetImportJobs Prelude.Text
getImportJobs_applicationId :: Lens' GetImportJobs Text
getImportJobs_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImportJobs' {Text
applicationId :: Text
$sel:applicationId:GetImportJobs' :: GetImportJobs -> Text
applicationId} -> Text
applicationId) (\s :: GetImportJobs
s@GetImportJobs' {} Text
a -> GetImportJobs
s {$sel:applicationId:GetImportJobs' :: Text
applicationId = Text
a} :: GetImportJobs)

instance Core.AWSRequest GetImportJobs where
  type
    AWSResponse GetImportJobs =
      GetImportJobsResponse
  request :: (Service -> Service) -> GetImportJobs -> Request GetImportJobs
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 GetImportJobs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetImportJobs)))
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 ->
          Int -> ImportJobsResponse -> GetImportJobsResponse
GetImportJobsResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)
      )

instance Prelude.Hashable GetImportJobs where
  hashWithSalt :: Int -> GetImportJobs -> Int
hashWithSalt Int
_salt GetImportJobs' {Maybe Text
Text
applicationId :: Text
token :: Maybe Text
pageSize :: Maybe Text
$sel:applicationId:GetImportJobs' :: GetImportJobs -> Text
$sel:token:GetImportJobs' :: GetImportJobs -> Maybe Text
$sel:pageSize:GetImportJobs' :: GetImportJobs -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pageSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
token
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId

instance Prelude.NFData GetImportJobs where
  rnf :: GetImportJobs -> ()
rnf GetImportJobs' {Maybe Text
Text
applicationId :: Text
token :: Maybe Text
pageSize :: Maybe Text
$sel:applicationId:GetImportJobs' :: GetImportJobs -> Text
$sel:token:GetImportJobs' :: GetImportJobs -> Maybe Text
$sel:pageSize:GetImportJobs' :: GetImportJobs -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pageSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
token
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId

instance Data.ToHeaders GetImportJobs where
  toHeaders :: GetImportJobs -> 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 GetImportJobs where
  toPath :: GetImportJobs -> ByteString
toPath GetImportJobs' {Maybe Text
Text
applicationId :: Text
token :: Maybe Text
pageSize :: Maybe Text
$sel:applicationId:GetImportJobs' :: GetImportJobs -> Text
$sel:token:GetImportJobs' :: GetImportJobs -> Maybe Text
$sel:pageSize:GetImportJobs' :: GetImportJobs -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/apps/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/jobs/import"
      ]

instance Data.ToQuery GetImportJobs where
  toQuery :: GetImportJobs -> QueryString
toQuery GetImportJobs' {Maybe Text
Text
applicationId :: Text
token :: Maybe Text
pageSize :: Maybe Text
$sel:applicationId:GetImportJobs' :: GetImportJobs -> Text
$sel:token:GetImportJobs' :: GetImportJobs -> Maybe Text
$sel:pageSize:GetImportJobs' :: GetImportJobs -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"page-size" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
pageSize, ByteString
"token" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
token]

-- | /See:/ 'newGetImportJobsResponse' smart constructor.
data GetImportJobsResponse = GetImportJobsResponse'
  { -- | The response's http status code.
    GetImportJobsResponse -> Int
httpStatus :: Prelude.Int,
    GetImportJobsResponse -> ImportJobsResponse
importJobsResponse :: ImportJobsResponse
  }
  deriving (GetImportJobsResponse -> GetImportJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetImportJobsResponse -> GetImportJobsResponse -> Bool
$c/= :: GetImportJobsResponse -> GetImportJobsResponse -> Bool
== :: GetImportJobsResponse -> GetImportJobsResponse -> Bool
$c== :: GetImportJobsResponse -> GetImportJobsResponse -> Bool
Prelude.Eq, ReadPrec [GetImportJobsResponse]
ReadPrec GetImportJobsResponse
Int -> ReadS GetImportJobsResponse
ReadS [GetImportJobsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetImportJobsResponse]
$creadListPrec :: ReadPrec [GetImportJobsResponse]
readPrec :: ReadPrec GetImportJobsResponse
$creadPrec :: ReadPrec GetImportJobsResponse
readList :: ReadS [GetImportJobsResponse]
$creadList :: ReadS [GetImportJobsResponse]
readsPrec :: Int -> ReadS GetImportJobsResponse
$creadsPrec :: Int -> ReadS GetImportJobsResponse
Prelude.Read, Int -> GetImportJobsResponse -> ShowS
[GetImportJobsResponse] -> ShowS
GetImportJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetImportJobsResponse] -> ShowS
$cshowList :: [GetImportJobsResponse] -> ShowS
show :: GetImportJobsResponse -> String
$cshow :: GetImportJobsResponse -> String
showsPrec :: Int -> GetImportJobsResponse -> ShowS
$cshowsPrec :: Int -> GetImportJobsResponse -> ShowS
Prelude.Show, forall x. Rep GetImportJobsResponse x -> GetImportJobsResponse
forall x. GetImportJobsResponse -> Rep GetImportJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetImportJobsResponse x -> GetImportJobsResponse
$cfrom :: forall x. GetImportJobsResponse -> Rep GetImportJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetImportJobsResponse' 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:
--
-- 'httpStatus', 'getImportJobsResponse_httpStatus' - The response's http status code.
--
-- 'importJobsResponse', 'getImportJobsResponse_importJobsResponse' - Undocumented member.
newGetImportJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'importJobsResponse'
  ImportJobsResponse ->
  GetImportJobsResponse
newGetImportJobsResponse :: Int -> ImportJobsResponse -> GetImportJobsResponse
newGetImportJobsResponse
  Int
pHttpStatus_
  ImportJobsResponse
pImportJobsResponse_ =
    GetImportJobsResponse'
      { $sel:httpStatus:GetImportJobsResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:importJobsResponse:GetImportJobsResponse' :: ImportJobsResponse
importJobsResponse = ImportJobsResponse
pImportJobsResponse_
      }

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

-- | Undocumented member.
getImportJobsResponse_importJobsResponse :: Lens.Lens' GetImportJobsResponse ImportJobsResponse
getImportJobsResponse_importJobsResponse :: Lens' GetImportJobsResponse ImportJobsResponse
getImportJobsResponse_importJobsResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetImportJobsResponse' {ImportJobsResponse
importJobsResponse :: ImportJobsResponse
$sel:importJobsResponse:GetImportJobsResponse' :: GetImportJobsResponse -> ImportJobsResponse
importJobsResponse} -> ImportJobsResponse
importJobsResponse) (\s :: GetImportJobsResponse
s@GetImportJobsResponse' {} ImportJobsResponse
a -> GetImportJobsResponse
s {$sel:importJobsResponse:GetImportJobsResponse' :: ImportJobsResponse
importJobsResponse = ImportJobsResponse
a} :: GetImportJobsResponse)

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