{-# 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.GetExportJob
-- 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 a specific export
-- job for an application.
module Amazonka.Pinpoint.GetExportJob
  ( -- * Creating a Request
    GetExportJob (..),
    newGetExportJob,

    -- * Request Lenses
    getExportJob_applicationId,
    getExportJob_jobId,

    -- * Destructuring the Response
    GetExportJobResponse (..),
    newGetExportJobResponse,

    -- * Response Lenses
    getExportJobResponse_httpStatus,
    getExportJobResponse_exportJobResponse,
  )
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:/ 'newGetExportJob' smart constructor.
data GetExportJob = GetExportJob'
  { -- | The unique identifier for the application. This identifier is displayed
    -- as the __Project ID__ on the Amazon Pinpoint console.
    GetExportJob -> Text
applicationId :: Prelude.Text,
    -- | The unique identifier for the job.
    GetExportJob -> Text
jobId :: Prelude.Text
  }
  deriving (GetExportJob -> GetExportJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExportJob -> GetExportJob -> Bool
$c/= :: GetExportJob -> GetExportJob -> Bool
== :: GetExportJob -> GetExportJob -> Bool
$c== :: GetExportJob -> GetExportJob -> Bool
Prelude.Eq, ReadPrec [GetExportJob]
ReadPrec GetExportJob
Int -> ReadS GetExportJob
ReadS [GetExportJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetExportJob]
$creadListPrec :: ReadPrec [GetExportJob]
readPrec :: ReadPrec GetExportJob
$creadPrec :: ReadPrec GetExportJob
readList :: ReadS [GetExportJob]
$creadList :: ReadS [GetExportJob]
readsPrec :: Int -> ReadS GetExportJob
$creadsPrec :: Int -> ReadS GetExportJob
Prelude.Read, Int -> GetExportJob -> ShowS
[GetExportJob] -> ShowS
GetExportJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExportJob] -> ShowS
$cshowList :: [GetExportJob] -> ShowS
show :: GetExportJob -> String
$cshow :: GetExportJob -> String
showsPrec :: Int -> GetExportJob -> ShowS
$cshowsPrec :: Int -> GetExportJob -> ShowS
Prelude.Show, forall x. Rep GetExportJob x -> GetExportJob
forall x. GetExportJob -> Rep GetExportJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetExportJob x -> GetExportJob
$cfrom :: forall x. GetExportJob -> Rep GetExportJob x
Prelude.Generic)

-- |
-- Create a value of 'GetExportJob' 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:
--
-- 'applicationId', 'getExportJob_applicationId' - The unique identifier for the application. This identifier is displayed
-- as the __Project ID__ on the Amazon Pinpoint console.
--
-- 'jobId', 'getExportJob_jobId' - The unique identifier for the job.
newGetExportJob ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'jobId'
  Prelude.Text ->
  GetExportJob
newGetExportJob :: Text -> Text -> GetExportJob
newGetExportJob Text
pApplicationId_ Text
pJobId_ =
  GetExportJob'
    { $sel:applicationId:GetExportJob' :: Text
applicationId = Text
pApplicationId_,
      $sel:jobId:GetExportJob' :: Text
jobId = Text
pJobId_
    }

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

-- | The unique identifier for the job.
getExportJob_jobId :: Lens.Lens' GetExportJob Prelude.Text
getExportJob_jobId :: Lens' GetExportJob Text
getExportJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExportJob' {Text
jobId :: Text
$sel:jobId:GetExportJob' :: GetExportJob -> Text
jobId} -> Text
jobId) (\s :: GetExportJob
s@GetExportJob' {} Text
a -> GetExportJob
s {$sel:jobId:GetExportJob' :: Text
jobId = Text
a} :: GetExportJob)

instance Core.AWSRequest GetExportJob where
  type AWSResponse GetExportJob = GetExportJobResponse
  request :: (Service -> Service) -> GetExportJob -> Request GetExportJob
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 GetExportJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetExportJob)))
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 -> ExportJobResponse -> GetExportJobResponse
GetExportJobResponse'
            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 GetExportJob where
  hashWithSalt :: Int -> GetExportJob -> Int
hashWithSalt Int
_salt GetExportJob' {Text
jobId :: Text
applicationId :: Text
$sel:jobId:GetExportJob' :: GetExportJob -> Text
$sel:applicationId:GetExportJob' :: GetExportJob -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

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

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

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

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

-- |
-- Create a value of 'GetExportJobResponse' 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', 'getExportJobResponse_httpStatus' - The response's http status code.
--
-- 'exportJobResponse', 'getExportJobResponse_exportJobResponse' - Undocumented member.
newGetExportJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'exportJobResponse'
  ExportJobResponse ->
  GetExportJobResponse
newGetExportJobResponse :: Int -> ExportJobResponse -> GetExportJobResponse
newGetExportJobResponse
  Int
pHttpStatus_
  ExportJobResponse
pExportJobResponse_ =
    GetExportJobResponse'
      { $sel:httpStatus:GetExportJobResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:exportJobResponse:GetExportJobResponse' :: ExportJobResponse
exportJobResponse = ExportJobResponse
pExportJobResponse_
      }

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

-- | Undocumented member.
getExportJobResponse_exportJobResponse :: Lens.Lens' GetExportJobResponse ExportJobResponse
getExportJobResponse_exportJobResponse :: Lens' GetExportJobResponse ExportJobResponse
getExportJobResponse_exportJobResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExportJobResponse' {ExportJobResponse
exportJobResponse :: ExportJobResponse
$sel:exportJobResponse:GetExportJobResponse' :: GetExportJobResponse -> ExportJobResponse
exportJobResponse} -> ExportJobResponse
exportJobResponse) (\s :: GetExportJobResponse
s@GetExportJobResponse' {} ExportJobResponse
a -> GetExportJobResponse
s {$sel:exportJobResponse:GetExportJobResponse' :: ExportJobResponse
exportJobResponse = ExportJobResponse
a} :: GetExportJobResponse)

instance Prelude.NFData GetExportJobResponse where
  rnf :: GetExportJobResponse -> ()
rnf GetExportJobResponse' {Int
ExportJobResponse
exportJobResponse :: ExportJobResponse
httpStatus :: Int
$sel:exportJobResponse:GetExportJobResponse' :: GetExportJobResponse -> ExportJobResponse
$sel:httpStatus:GetExportJobResponse' :: GetExportJobResponse -> 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 ExportJobResponse
exportJobResponse