{-# 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.M2.GetBatchJobExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the details of a specific batch job execution for a specific
-- application.
module Amazonka.M2.GetBatchJobExecution
  ( -- * Creating a Request
    GetBatchJobExecution (..),
    newGetBatchJobExecution,

    -- * Request Lenses
    getBatchJobExecution_applicationId,
    getBatchJobExecution_executionId,

    -- * Destructuring the Response
    GetBatchJobExecutionResponse (..),
    newGetBatchJobExecutionResponse,

    -- * Response Lenses
    getBatchJobExecutionResponse_endTime,
    getBatchJobExecutionResponse_jobId,
    getBatchJobExecutionResponse_jobName,
    getBatchJobExecutionResponse_jobType,
    getBatchJobExecutionResponse_jobUser,
    getBatchJobExecutionResponse_statusReason,
    getBatchJobExecutionResponse_httpStatus,
    getBatchJobExecutionResponse_applicationId,
    getBatchJobExecutionResponse_executionId,
    getBatchJobExecutionResponse_startTime,
    getBatchJobExecutionResponse_status,
  )
where

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

-- | /See:/ 'newGetBatchJobExecution' smart constructor.
data GetBatchJobExecution = GetBatchJobExecution'
  { -- | The identifier of the application.
    GetBatchJobExecution -> Text
applicationId :: Prelude.Text,
    -- | The unique identifier of the batch job execution.
    GetBatchJobExecution -> Text
executionId :: Prelude.Text
  }
  deriving (GetBatchJobExecution -> GetBatchJobExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBatchJobExecution -> GetBatchJobExecution -> Bool
$c/= :: GetBatchJobExecution -> GetBatchJobExecution -> Bool
== :: GetBatchJobExecution -> GetBatchJobExecution -> Bool
$c== :: GetBatchJobExecution -> GetBatchJobExecution -> Bool
Prelude.Eq, ReadPrec [GetBatchJobExecution]
ReadPrec GetBatchJobExecution
Int -> ReadS GetBatchJobExecution
ReadS [GetBatchJobExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBatchJobExecution]
$creadListPrec :: ReadPrec [GetBatchJobExecution]
readPrec :: ReadPrec GetBatchJobExecution
$creadPrec :: ReadPrec GetBatchJobExecution
readList :: ReadS [GetBatchJobExecution]
$creadList :: ReadS [GetBatchJobExecution]
readsPrec :: Int -> ReadS GetBatchJobExecution
$creadsPrec :: Int -> ReadS GetBatchJobExecution
Prelude.Read, Int -> GetBatchJobExecution -> ShowS
[GetBatchJobExecution] -> ShowS
GetBatchJobExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBatchJobExecution] -> ShowS
$cshowList :: [GetBatchJobExecution] -> ShowS
show :: GetBatchJobExecution -> String
$cshow :: GetBatchJobExecution -> String
showsPrec :: Int -> GetBatchJobExecution -> ShowS
$cshowsPrec :: Int -> GetBatchJobExecution -> ShowS
Prelude.Show, forall x. Rep GetBatchJobExecution x -> GetBatchJobExecution
forall x. GetBatchJobExecution -> Rep GetBatchJobExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBatchJobExecution x -> GetBatchJobExecution
$cfrom :: forall x. GetBatchJobExecution -> Rep GetBatchJobExecution x
Prelude.Generic)

-- |
-- Create a value of 'GetBatchJobExecution' 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', 'getBatchJobExecution_applicationId' - The identifier of the application.
--
-- 'executionId', 'getBatchJobExecution_executionId' - The unique identifier of the batch job execution.
newGetBatchJobExecution ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'executionId'
  Prelude.Text ->
  GetBatchJobExecution
newGetBatchJobExecution :: Text -> Text -> GetBatchJobExecution
newGetBatchJobExecution Text
pApplicationId_ Text
pExecutionId_ =
  GetBatchJobExecution'
    { $sel:applicationId:GetBatchJobExecution' :: Text
applicationId =
        Text
pApplicationId_,
      $sel:executionId:GetBatchJobExecution' :: Text
executionId = Text
pExecutionId_
    }

-- | The identifier of the application.
getBatchJobExecution_applicationId :: Lens.Lens' GetBatchJobExecution Prelude.Text
getBatchJobExecution_applicationId :: Lens' GetBatchJobExecution Text
getBatchJobExecution_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecution' {Text
applicationId :: Text
$sel:applicationId:GetBatchJobExecution' :: GetBatchJobExecution -> Text
applicationId} -> Text
applicationId) (\s :: GetBatchJobExecution
s@GetBatchJobExecution' {} Text
a -> GetBatchJobExecution
s {$sel:applicationId:GetBatchJobExecution' :: Text
applicationId = Text
a} :: GetBatchJobExecution)

-- | The unique identifier of the batch job execution.
getBatchJobExecution_executionId :: Lens.Lens' GetBatchJobExecution Prelude.Text
getBatchJobExecution_executionId :: Lens' GetBatchJobExecution Text
getBatchJobExecution_executionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecution' {Text
executionId :: Text
$sel:executionId:GetBatchJobExecution' :: GetBatchJobExecution -> Text
executionId} -> Text
executionId) (\s :: GetBatchJobExecution
s@GetBatchJobExecution' {} Text
a -> GetBatchJobExecution
s {$sel:executionId:GetBatchJobExecution' :: Text
executionId = Text
a} :: GetBatchJobExecution)

instance Core.AWSRequest GetBatchJobExecution where
  type
    AWSResponse GetBatchJobExecution =
      GetBatchJobExecutionResponse
  request :: (Service -> Service)
-> GetBatchJobExecution -> Request GetBatchJobExecution
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 GetBatchJobExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetBatchJobExecution)))
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 POSIX
-> Maybe Text
-> Maybe Text
-> Maybe BatchJobType
-> Maybe Text
-> Maybe Text
-> Int
-> Text
-> Text
-> POSIX
-> BatchJobExecutionStatus
-> GetBatchJobExecutionResponse
GetBatchJobExecutionResponse'
            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
"endTime")
            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
"jobId")
            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
"jobName")
            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
"jobType")
            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
"jobUser")
            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
"statusReason")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"applicationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"executionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"startTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"status")
      )

instance Prelude.Hashable GetBatchJobExecution where
  hashWithSalt :: Int -> GetBatchJobExecution -> Int
hashWithSalt Int
_salt GetBatchJobExecution' {Text
executionId :: Text
applicationId :: Text
$sel:executionId:GetBatchJobExecution' :: GetBatchJobExecution -> Text
$sel:applicationId:GetBatchJobExecution' :: GetBatchJobExecution -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
executionId

instance Prelude.NFData GetBatchJobExecution where
  rnf :: GetBatchJobExecution -> ()
rnf GetBatchJobExecution' {Text
executionId :: Text
applicationId :: Text
$sel:executionId:GetBatchJobExecution' :: GetBatchJobExecution -> Text
$sel:applicationId:GetBatchJobExecution' :: GetBatchJobExecution -> 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
executionId

instance Data.ToHeaders GetBatchJobExecution where
  toHeaders :: GetBatchJobExecution -> 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 GetBatchJobExecution where
  toPath :: GetBatchJobExecution -> ByteString
toPath GetBatchJobExecution' {Text
executionId :: Text
applicationId :: Text
$sel:executionId:GetBatchJobExecution' :: GetBatchJobExecution -> Text
$sel:applicationId:GetBatchJobExecution' :: GetBatchJobExecution -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/batch-job-executions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
executionId
      ]

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

-- | /See:/ 'newGetBatchJobExecutionResponse' smart constructor.
data GetBatchJobExecutionResponse = GetBatchJobExecutionResponse'
  { -- | The timestamp when the batch job execution ended.
    GetBatchJobExecutionResponse -> Maybe POSIX
endTime :: Prelude.Maybe Data.POSIX,
    -- | The unique identifier for this batch job.
    GetBatchJobExecutionResponse -> Maybe Text
jobId :: Prelude.Maybe Prelude.Text,
    -- | The name of this batch job.
    GetBatchJobExecutionResponse -> Maybe Text
jobName :: Prelude.Maybe Prelude.Text,
    -- | The type of job.
    GetBatchJobExecutionResponse -> Maybe BatchJobType
jobType :: Prelude.Maybe BatchJobType,
    -- | The user for the job.
    GetBatchJobExecutionResponse -> Maybe Text
jobUser :: Prelude.Maybe Prelude.Text,
    -- | The reason for the reported status.
    GetBatchJobExecutionResponse -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetBatchJobExecutionResponse -> Int
httpStatus :: Prelude.Int,
    -- | The identifier of the application.
    GetBatchJobExecutionResponse -> Text
applicationId :: Prelude.Text,
    -- | The unique identifier for this batch job execution.
    GetBatchJobExecutionResponse -> Text
executionId :: Prelude.Text,
    -- | The timestamp when the batch job execution started.
    GetBatchJobExecutionResponse -> POSIX
startTime :: Data.POSIX,
    -- | The status of the batch job execution.
    GetBatchJobExecutionResponse -> BatchJobExecutionStatus
status :: BatchJobExecutionStatus
  }
  deriving (GetBatchJobExecutionResponse
-> GetBatchJobExecutionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBatchJobExecutionResponse
-> GetBatchJobExecutionResponse -> Bool
$c/= :: GetBatchJobExecutionResponse
-> GetBatchJobExecutionResponse -> Bool
== :: GetBatchJobExecutionResponse
-> GetBatchJobExecutionResponse -> Bool
$c== :: GetBatchJobExecutionResponse
-> GetBatchJobExecutionResponse -> Bool
Prelude.Eq, ReadPrec [GetBatchJobExecutionResponse]
ReadPrec GetBatchJobExecutionResponse
Int -> ReadS GetBatchJobExecutionResponse
ReadS [GetBatchJobExecutionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBatchJobExecutionResponse]
$creadListPrec :: ReadPrec [GetBatchJobExecutionResponse]
readPrec :: ReadPrec GetBatchJobExecutionResponse
$creadPrec :: ReadPrec GetBatchJobExecutionResponse
readList :: ReadS [GetBatchJobExecutionResponse]
$creadList :: ReadS [GetBatchJobExecutionResponse]
readsPrec :: Int -> ReadS GetBatchJobExecutionResponse
$creadsPrec :: Int -> ReadS GetBatchJobExecutionResponse
Prelude.Read, Int -> GetBatchJobExecutionResponse -> ShowS
[GetBatchJobExecutionResponse] -> ShowS
GetBatchJobExecutionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBatchJobExecutionResponse] -> ShowS
$cshowList :: [GetBatchJobExecutionResponse] -> ShowS
show :: GetBatchJobExecutionResponse -> String
$cshow :: GetBatchJobExecutionResponse -> String
showsPrec :: Int -> GetBatchJobExecutionResponse -> ShowS
$cshowsPrec :: Int -> GetBatchJobExecutionResponse -> ShowS
Prelude.Show, forall x.
Rep GetBatchJobExecutionResponse x -> GetBatchJobExecutionResponse
forall x.
GetBatchJobExecutionResponse -> Rep GetBatchJobExecutionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBatchJobExecutionResponse x -> GetBatchJobExecutionResponse
$cfrom :: forall x.
GetBatchJobExecutionResponse -> Rep GetBatchJobExecutionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBatchJobExecutionResponse' 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:
--
-- 'endTime', 'getBatchJobExecutionResponse_endTime' - The timestamp when the batch job execution ended.
--
-- 'jobId', 'getBatchJobExecutionResponse_jobId' - The unique identifier for this batch job.
--
-- 'jobName', 'getBatchJobExecutionResponse_jobName' - The name of this batch job.
--
-- 'jobType', 'getBatchJobExecutionResponse_jobType' - The type of job.
--
-- 'jobUser', 'getBatchJobExecutionResponse_jobUser' - The user for the job.
--
-- 'statusReason', 'getBatchJobExecutionResponse_statusReason' - The reason for the reported status.
--
-- 'httpStatus', 'getBatchJobExecutionResponse_httpStatus' - The response's http status code.
--
-- 'applicationId', 'getBatchJobExecutionResponse_applicationId' - The identifier of the application.
--
-- 'executionId', 'getBatchJobExecutionResponse_executionId' - The unique identifier for this batch job execution.
--
-- 'startTime', 'getBatchJobExecutionResponse_startTime' - The timestamp when the batch job execution started.
--
-- 'status', 'getBatchJobExecutionResponse_status' - The status of the batch job execution.
newGetBatchJobExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'executionId'
  Prelude.Text ->
  -- | 'startTime'
  Prelude.UTCTime ->
  -- | 'status'
  BatchJobExecutionStatus ->
  GetBatchJobExecutionResponse
newGetBatchJobExecutionResponse :: Int
-> Text
-> Text
-> UTCTime
-> BatchJobExecutionStatus
-> GetBatchJobExecutionResponse
newGetBatchJobExecutionResponse
  Int
pHttpStatus_
  Text
pApplicationId_
  Text
pExecutionId_
  UTCTime
pStartTime_
  BatchJobExecutionStatus
pStatus_ =
    GetBatchJobExecutionResponse'
      { $sel:endTime:GetBatchJobExecutionResponse' :: Maybe POSIX
endTime =
          forall a. Maybe a
Prelude.Nothing,
        $sel:jobId:GetBatchJobExecutionResponse' :: Maybe Text
jobId = forall a. Maybe a
Prelude.Nothing,
        $sel:jobName:GetBatchJobExecutionResponse' :: Maybe Text
jobName = forall a. Maybe a
Prelude.Nothing,
        $sel:jobType:GetBatchJobExecutionResponse' :: Maybe BatchJobType
jobType = forall a. Maybe a
Prelude.Nothing,
        $sel:jobUser:GetBatchJobExecutionResponse' :: Maybe Text
jobUser = forall a. Maybe a
Prelude.Nothing,
        $sel:statusReason:GetBatchJobExecutionResponse' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetBatchJobExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:applicationId:GetBatchJobExecutionResponse' :: Text
applicationId = Text
pApplicationId_,
        $sel:executionId:GetBatchJobExecutionResponse' :: Text
executionId = Text
pExecutionId_,
        $sel:startTime:GetBatchJobExecutionResponse' :: POSIX
startTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTime_,
        $sel:status:GetBatchJobExecutionResponse' :: BatchJobExecutionStatus
status = BatchJobExecutionStatus
pStatus_
      }

-- | The timestamp when the batch job execution ended.
getBatchJobExecutionResponse_endTime :: Lens.Lens' GetBatchJobExecutionResponse (Prelude.Maybe Prelude.UTCTime)
getBatchJobExecutionResponse_endTime :: Lens' GetBatchJobExecutionResponse (Maybe UTCTime)
getBatchJobExecutionResponse_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecutionResponse' {Maybe POSIX
endTime :: Maybe POSIX
$sel:endTime:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe POSIX
endTime} -> Maybe POSIX
endTime) (\s :: GetBatchJobExecutionResponse
s@GetBatchJobExecutionResponse' {} Maybe POSIX
a -> GetBatchJobExecutionResponse
s {$sel:endTime:GetBatchJobExecutionResponse' :: Maybe POSIX
endTime = Maybe POSIX
a} :: GetBatchJobExecutionResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The unique identifier for this batch job.
getBatchJobExecutionResponse_jobId :: Lens.Lens' GetBatchJobExecutionResponse (Prelude.Maybe Prelude.Text)
getBatchJobExecutionResponse_jobId :: Lens' GetBatchJobExecutionResponse (Maybe Text)
getBatchJobExecutionResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecutionResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: GetBatchJobExecutionResponse
s@GetBatchJobExecutionResponse' {} Maybe Text
a -> GetBatchJobExecutionResponse
s {$sel:jobId:GetBatchJobExecutionResponse' :: Maybe Text
jobId = Maybe Text
a} :: GetBatchJobExecutionResponse)

-- | The name of this batch job.
getBatchJobExecutionResponse_jobName :: Lens.Lens' GetBatchJobExecutionResponse (Prelude.Maybe Prelude.Text)
getBatchJobExecutionResponse_jobName :: Lens' GetBatchJobExecutionResponse (Maybe Text)
getBatchJobExecutionResponse_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecutionResponse' {Maybe Text
jobName :: Maybe Text
$sel:jobName:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe Text
jobName} -> Maybe Text
jobName) (\s :: GetBatchJobExecutionResponse
s@GetBatchJobExecutionResponse' {} Maybe Text
a -> GetBatchJobExecutionResponse
s {$sel:jobName:GetBatchJobExecutionResponse' :: Maybe Text
jobName = Maybe Text
a} :: GetBatchJobExecutionResponse)

-- | The type of job.
getBatchJobExecutionResponse_jobType :: Lens.Lens' GetBatchJobExecutionResponse (Prelude.Maybe BatchJobType)
getBatchJobExecutionResponse_jobType :: Lens' GetBatchJobExecutionResponse (Maybe BatchJobType)
getBatchJobExecutionResponse_jobType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecutionResponse' {Maybe BatchJobType
jobType :: Maybe BatchJobType
$sel:jobType:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe BatchJobType
jobType} -> Maybe BatchJobType
jobType) (\s :: GetBatchJobExecutionResponse
s@GetBatchJobExecutionResponse' {} Maybe BatchJobType
a -> GetBatchJobExecutionResponse
s {$sel:jobType:GetBatchJobExecutionResponse' :: Maybe BatchJobType
jobType = Maybe BatchJobType
a} :: GetBatchJobExecutionResponse)

-- | The user for the job.
getBatchJobExecutionResponse_jobUser :: Lens.Lens' GetBatchJobExecutionResponse (Prelude.Maybe Prelude.Text)
getBatchJobExecutionResponse_jobUser :: Lens' GetBatchJobExecutionResponse (Maybe Text)
getBatchJobExecutionResponse_jobUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecutionResponse' {Maybe Text
jobUser :: Maybe Text
$sel:jobUser:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe Text
jobUser} -> Maybe Text
jobUser) (\s :: GetBatchJobExecutionResponse
s@GetBatchJobExecutionResponse' {} Maybe Text
a -> GetBatchJobExecutionResponse
s {$sel:jobUser:GetBatchJobExecutionResponse' :: Maybe Text
jobUser = Maybe Text
a} :: GetBatchJobExecutionResponse)

-- | The reason for the reported status.
getBatchJobExecutionResponse_statusReason :: Lens.Lens' GetBatchJobExecutionResponse (Prelude.Maybe Prelude.Text)
getBatchJobExecutionResponse_statusReason :: Lens' GetBatchJobExecutionResponse (Maybe Text)
getBatchJobExecutionResponse_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecutionResponse' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: GetBatchJobExecutionResponse
s@GetBatchJobExecutionResponse' {} Maybe Text
a -> GetBatchJobExecutionResponse
s {$sel:statusReason:GetBatchJobExecutionResponse' :: Maybe Text
statusReason = Maybe Text
a} :: GetBatchJobExecutionResponse)

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

-- | The identifier of the application.
getBatchJobExecutionResponse_applicationId :: Lens.Lens' GetBatchJobExecutionResponse Prelude.Text
getBatchJobExecutionResponse_applicationId :: Lens' GetBatchJobExecutionResponse Text
getBatchJobExecutionResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecutionResponse' {Text
applicationId :: Text
$sel:applicationId:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Text
applicationId} -> Text
applicationId) (\s :: GetBatchJobExecutionResponse
s@GetBatchJobExecutionResponse' {} Text
a -> GetBatchJobExecutionResponse
s {$sel:applicationId:GetBatchJobExecutionResponse' :: Text
applicationId = Text
a} :: GetBatchJobExecutionResponse)

-- | The unique identifier for this batch job execution.
getBatchJobExecutionResponse_executionId :: Lens.Lens' GetBatchJobExecutionResponse Prelude.Text
getBatchJobExecutionResponse_executionId :: Lens' GetBatchJobExecutionResponse Text
getBatchJobExecutionResponse_executionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecutionResponse' {Text
executionId :: Text
$sel:executionId:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Text
executionId} -> Text
executionId) (\s :: GetBatchJobExecutionResponse
s@GetBatchJobExecutionResponse' {} Text
a -> GetBatchJobExecutionResponse
s {$sel:executionId:GetBatchJobExecutionResponse' :: Text
executionId = Text
a} :: GetBatchJobExecutionResponse)

-- | The timestamp when the batch job execution started.
getBatchJobExecutionResponse_startTime :: Lens.Lens' GetBatchJobExecutionResponse Prelude.UTCTime
getBatchJobExecutionResponse_startTime :: Lens' GetBatchJobExecutionResponse UTCTime
getBatchJobExecutionResponse_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecutionResponse' {POSIX
startTime :: POSIX
$sel:startTime:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> POSIX
startTime} -> POSIX
startTime) (\s :: GetBatchJobExecutionResponse
s@GetBatchJobExecutionResponse' {} POSIX
a -> GetBatchJobExecutionResponse
s {$sel:startTime:GetBatchJobExecutionResponse' :: POSIX
startTime = POSIX
a} :: GetBatchJobExecutionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status of the batch job execution.
getBatchJobExecutionResponse_status :: Lens.Lens' GetBatchJobExecutionResponse BatchJobExecutionStatus
getBatchJobExecutionResponse_status :: Lens' GetBatchJobExecutionResponse BatchJobExecutionStatus
getBatchJobExecutionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBatchJobExecutionResponse' {BatchJobExecutionStatus
status :: BatchJobExecutionStatus
$sel:status:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> BatchJobExecutionStatus
status} -> BatchJobExecutionStatus
status) (\s :: GetBatchJobExecutionResponse
s@GetBatchJobExecutionResponse' {} BatchJobExecutionStatus
a -> GetBatchJobExecutionResponse
s {$sel:status:GetBatchJobExecutionResponse' :: BatchJobExecutionStatus
status = BatchJobExecutionStatus
a} :: GetBatchJobExecutionResponse)

instance Prelude.NFData GetBatchJobExecutionResponse where
  rnf :: GetBatchJobExecutionResponse -> ()
rnf GetBatchJobExecutionResponse' {Int
Maybe Text
Maybe POSIX
Maybe BatchJobType
Text
POSIX
BatchJobExecutionStatus
status :: BatchJobExecutionStatus
startTime :: POSIX
executionId :: Text
applicationId :: Text
httpStatus :: Int
statusReason :: Maybe Text
jobUser :: Maybe Text
jobType :: Maybe BatchJobType
jobName :: Maybe Text
jobId :: Maybe Text
endTime :: Maybe POSIX
$sel:status:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> BatchJobExecutionStatus
$sel:startTime:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> POSIX
$sel:executionId:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Text
$sel:applicationId:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Text
$sel:httpStatus:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Int
$sel:statusReason:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe Text
$sel:jobUser:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe Text
$sel:jobType:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe BatchJobType
$sel:jobName:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe Text
$sel:jobId:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe Text
$sel:endTime:GetBatchJobExecutionResponse' :: GetBatchJobExecutionResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BatchJobType
jobType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobUser
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
executionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BatchJobExecutionStatus
status