{-# 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.Braket.GetJob
-- 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 the specified Amazon Braket job.
module Amazonka.Braket.GetJob
  ( -- * Creating a Request
    GetJob (..),
    newGetJob,

    -- * Request Lenses
    getJob_jobArn,

    -- * Destructuring the Response
    GetJobResponse (..),
    newGetJobResponse,

    -- * Response Lenses
    getJobResponse_billableDuration,
    getJobResponse_checkpointConfig,
    getJobResponse_deviceConfig,
    getJobResponse_endedAt,
    getJobResponse_events,
    getJobResponse_failureReason,
    getJobResponse_hyperParameters,
    getJobResponse_inputDataConfig,
    getJobResponse_startedAt,
    getJobResponse_stoppingCondition,
    getJobResponse_tags,
    getJobResponse_httpStatus,
    getJobResponse_algorithmSpecification,
    getJobResponse_createdAt,
    getJobResponse_instanceConfig,
    getJobResponse_jobArn,
    getJobResponse_jobName,
    getJobResponse_outputDataConfig,
    getJobResponse_roleArn,
    getJobResponse_status,
  )
where

import Amazonka.Braket.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

-- | /See:/ 'newGetJob' smart constructor.
data GetJob = GetJob'
  { -- | The ARN of the job to retrieve.
    GetJob -> Text
jobArn :: Prelude.Text
  }
  deriving (GetJob -> GetJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetJob -> GetJob -> Bool
$c/= :: GetJob -> GetJob -> Bool
== :: GetJob -> GetJob -> Bool
$c== :: GetJob -> GetJob -> Bool
Prelude.Eq, ReadPrec [GetJob]
ReadPrec GetJob
Int -> ReadS GetJob
ReadS [GetJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetJob]
$creadListPrec :: ReadPrec [GetJob]
readPrec :: ReadPrec GetJob
$creadPrec :: ReadPrec GetJob
readList :: ReadS [GetJob]
$creadList :: ReadS [GetJob]
readsPrec :: Int -> ReadS GetJob
$creadsPrec :: Int -> ReadS GetJob
Prelude.Read, Int -> GetJob -> ShowS
[GetJob] -> ShowS
GetJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetJob] -> ShowS
$cshowList :: [GetJob] -> ShowS
show :: GetJob -> String
$cshow :: GetJob -> String
showsPrec :: Int -> GetJob -> ShowS
$cshowsPrec :: Int -> GetJob -> ShowS
Prelude.Show, forall x. Rep GetJob x -> GetJob
forall x. GetJob -> Rep GetJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetJob x -> GetJob
$cfrom :: forall x. GetJob -> Rep GetJob x
Prelude.Generic)

-- |
-- Create a value of 'GetJob' 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:
--
-- 'jobArn', 'getJob_jobArn' - The ARN of the job to retrieve.
newGetJob ::
  -- | 'jobArn'
  Prelude.Text ->
  GetJob
newGetJob :: Text -> GetJob
newGetJob Text
pJobArn_ = GetJob' {$sel:jobArn:GetJob' :: Text
jobArn = Text
pJobArn_}

-- | The ARN of the job to retrieve.
getJob_jobArn :: Lens.Lens' GetJob Prelude.Text
getJob_jobArn :: Lens' GetJob Text
getJob_jobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJob' {Text
jobArn :: Text
$sel:jobArn:GetJob' :: GetJob -> Text
jobArn} -> Text
jobArn) (\s :: GetJob
s@GetJob' {} Text
a -> GetJob
s {$sel:jobArn:GetJob' :: Text
jobArn = Text
a} :: GetJob)

instance Core.AWSRequest GetJob where
  type AWSResponse GetJob = GetJobResponse
  request :: (Service -> Service) -> GetJob -> Request GetJob
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 GetJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetJob)))
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 Int
-> Maybe JobCheckpointConfig
-> Maybe DeviceConfig
-> Maybe ISO8601
-> Maybe [JobEventDetails]
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe [InputFileConfig]
-> Maybe ISO8601
-> Maybe JobStoppingCondition
-> Maybe (HashMap Text Text)
-> Int
-> AlgorithmSpecification
-> ISO8601
-> InstanceConfig
-> Text
-> Text
-> JobOutputDataConfig
-> Text
-> JobPrimaryStatus
-> GetJobResponse
GetJobResponse'
            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
"billableDuration")
            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
"checkpointConfig")
            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
"deviceConfig")
            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
"endedAt")
            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
"events" 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
"failureReason")
            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
"hyperParameters"
                            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
"inputDataConfig"
                            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
"startedAt")
            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
"stoppingCondition")
            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
"tags" 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.<*> (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
"algorithmSpecification")
            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
"createdAt")
            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
"instanceConfig")
            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
"jobArn")
            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
"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 a
Data..:> Key
"outputDataConfig")
            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
"roleArn")
            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 GetJob where
  hashWithSalt :: Int -> GetJob -> Int
hashWithSalt Int
_salt GetJob' {Text
jobArn :: Text
$sel:jobArn:GetJob' :: GetJob -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobArn

instance Prelude.NFData GetJob where
  rnf :: GetJob -> ()
rnf GetJob' {Text
jobArn :: Text
$sel:jobArn:GetJob' :: GetJob -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
jobArn

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

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

-- | /See:/ 'newGetJobResponse' smart constructor.
data GetJobResponse = GetJobResponse'
  { -- | The billable time the Amazon Braket job used to complete.
    GetJobResponse -> Maybe Int
billableDuration :: Prelude.Maybe Prelude.Int,
    -- | Information about the output locations for job checkpoint data.
    GetJobResponse -> Maybe JobCheckpointConfig
checkpointConfig :: Prelude.Maybe JobCheckpointConfig,
    -- | The quantum processing unit (QPU) or simulator used to run the Amazon
    -- Braket job.
    GetJobResponse -> Maybe DeviceConfig
deviceConfig :: Prelude.Maybe DeviceConfig,
    -- | The date and time that the Amazon Braket job ended.
    GetJobResponse -> Maybe ISO8601
endedAt :: Prelude.Maybe Data.ISO8601,
    -- | Details about the type and time events occurred related to the Amazon
    -- Braket job.
    GetJobResponse -> Maybe [JobEventDetails]
events :: Prelude.Maybe [JobEventDetails],
    -- | A description of the reason why an Amazon Braket job failed, if it
    -- failed.
    GetJobResponse -> Maybe Text
failureReason :: Prelude.Maybe Prelude.Text,
    -- | Algorithm-specific parameters used by an Amazon Braket job that
    -- influence the quality of the traiing job. The values are set with a
    -- string of JSON key:value pairs, where the key is the name of the
    -- hyperparameter and the value is the value of th hyperparameter.
    GetJobResponse -> Maybe (HashMap Text Text)
hyperParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A list of parameters that specify the name and type of input data and
    -- where it is located.
    GetJobResponse -> Maybe [InputFileConfig]
inputDataConfig :: Prelude.Maybe [InputFileConfig],
    -- | The date and time that the Amazon Braket job was started.
    GetJobResponse -> Maybe ISO8601
startedAt :: Prelude.Maybe Data.ISO8601,
    -- | The user-defined criteria that specifies when to stop a job running.
    GetJobResponse -> Maybe JobStoppingCondition
stoppingCondition :: Prelude.Maybe JobStoppingCondition,
    -- | A tag object that consists of a key and an optional value, used to
    -- manage metadata for Amazon Braket resources.
    GetJobResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetJobResponse -> Int
httpStatus :: Prelude.Int,
    -- | Definition of the Amazon Braket job created. Specifies the container
    -- image the job uses, information about the Python scripts used for entry
    -- and training, and the user-defined metrics used to evaluation the job.
    GetJobResponse -> AlgorithmSpecification
algorithmSpecification :: AlgorithmSpecification,
    -- | The date and time that the Amazon Braket job was created.
    GetJobResponse -> ISO8601
createdAt :: Data.ISO8601,
    -- | The resource instances to use while running the hybrid job on Amazon
    -- Braket.
    GetJobResponse -> InstanceConfig
instanceConfig :: InstanceConfig,
    -- | The ARN of the Amazon Braket job.
    GetJobResponse -> Text
jobArn :: Prelude.Text,
    -- | The name of the Amazon Braket job.
    GetJobResponse -> Text
jobName :: Prelude.Text,
    -- | The path to the S3 location where job artifacts are stored and the
    -- encryption key used to store them there.
    GetJobResponse -> JobOutputDataConfig
outputDataConfig :: JobOutputDataConfig,
    -- | The Amazon Resource Name (ARN) of an IAM role that Amazon Braket can
    -- assume to perform tasks on behalf of a user. It can access user
    -- resources, run an Amazon Braket job container on behalf of user, and
    -- output resources to the s3 buckets of a user.
    GetJobResponse -> Text
roleArn :: Prelude.Text,
    -- | The status of the Amazon Braket job.
    GetJobResponse -> JobPrimaryStatus
status :: JobPrimaryStatus
  }
  deriving (GetJobResponse -> GetJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetJobResponse -> GetJobResponse -> Bool
$c/= :: GetJobResponse -> GetJobResponse -> Bool
== :: GetJobResponse -> GetJobResponse -> Bool
$c== :: GetJobResponse -> GetJobResponse -> Bool
Prelude.Eq, ReadPrec [GetJobResponse]
ReadPrec GetJobResponse
Int -> ReadS GetJobResponse
ReadS [GetJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetJobResponse]
$creadListPrec :: ReadPrec [GetJobResponse]
readPrec :: ReadPrec GetJobResponse
$creadPrec :: ReadPrec GetJobResponse
readList :: ReadS [GetJobResponse]
$creadList :: ReadS [GetJobResponse]
readsPrec :: Int -> ReadS GetJobResponse
$creadsPrec :: Int -> ReadS GetJobResponse
Prelude.Read, Int -> GetJobResponse -> ShowS
[GetJobResponse] -> ShowS
GetJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetJobResponse] -> ShowS
$cshowList :: [GetJobResponse] -> ShowS
show :: GetJobResponse -> String
$cshow :: GetJobResponse -> String
showsPrec :: Int -> GetJobResponse -> ShowS
$cshowsPrec :: Int -> GetJobResponse -> ShowS
Prelude.Show, forall x. Rep GetJobResponse x -> GetJobResponse
forall x. GetJobResponse -> Rep GetJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetJobResponse x -> GetJobResponse
$cfrom :: forall x. GetJobResponse -> Rep GetJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetJobResponse' 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:
--
-- 'billableDuration', 'getJobResponse_billableDuration' - The billable time the Amazon Braket job used to complete.
--
-- 'checkpointConfig', 'getJobResponse_checkpointConfig' - Information about the output locations for job checkpoint data.
--
-- 'deviceConfig', 'getJobResponse_deviceConfig' - The quantum processing unit (QPU) or simulator used to run the Amazon
-- Braket job.
--
-- 'endedAt', 'getJobResponse_endedAt' - The date and time that the Amazon Braket job ended.
--
-- 'events', 'getJobResponse_events' - Details about the type and time events occurred related to the Amazon
-- Braket job.
--
-- 'failureReason', 'getJobResponse_failureReason' - A description of the reason why an Amazon Braket job failed, if it
-- failed.
--
-- 'hyperParameters', 'getJobResponse_hyperParameters' - Algorithm-specific parameters used by an Amazon Braket job that
-- influence the quality of the traiing job. The values are set with a
-- string of JSON key:value pairs, where the key is the name of the
-- hyperparameter and the value is the value of th hyperparameter.
--
-- 'inputDataConfig', 'getJobResponse_inputDataConfig' - A list of parameters that specify the name and type of input data and
-- where it is located.
--
-- 'startedAt', 'getJobResponse_startedAt' - The date and time that the Amazon Braket job was started.
--
-- 'stoppingCondition', 'getJobResponse_stoppingCondition' - The user-defined criteria that specifies when to stop a job running.
--
-- 'tags', 'getJobResponse_tags' - A tag object that consists of a key and an optional value, used to
-- manage metadata for Amazon Braket resources.
--
-- 'httpStatus', 'getJobResponse_httpStatus' - The response's http status code.
--
-- 'algorithmSpecification', 'getJobResponse_algorithmSpecification' - Definition of the Amazon Braket job created. Specifies the container
-- image the job uses, information about the Python scripts used for entry
-- and training, and the user-defined metrics used to evaluation the job.
--
-- 'createdAt', 'getJobResponse_createdAt' - The date and time that the Amazon Braket job was created.
--
-- 'instanceConfig', 'getJobResponse_instanceConfig' - The resource instances to use while running the hybrid job on Amazon
-- Braket.
--
-- 'jobArn', 'getJobResponse_jobArn' - The ARN of the Amazon Braket job.
--
-- 'jobName', 'getJobResponse_jobName' - The name of the Amazon Braket job.
--
-- 'outputDataConfig', 'getJobResponse_outputDataConfig' - The path to the S3 location where job artifacts are stored and the
-- encryption key used to store them there.
--
-- 'roleArn', 'getJobResponse_roleArn' - The Amazon Resource Name (ARN) of an IAM role that Amazon Braket can
-- assume to perform tasks on behalf of a user. It can access user
-- resources, run an Amazon Braket job container on behalf of user, and
-- output resources to the s3 buckets of a user.
--
-- 'status', 'getJobResponse_status' - The status of the Amazon Braket job.
newGetJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'algorithmSpecification'
  AlgorithmSpecification ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'instanceConfig'
  InstanceConfig ->
  -- | 'jobArn'
  Prelude.Text ->
  -- | 'jobName'
  Prelude.Text ->
  -- | 'outputDataConfig'
  JobOutputDataConfig ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'status'
  JobPrimaryStatus ->
  GetJobResponse
newGetJobResponse :: Int
-> AlgorithmSpecification
-> UTCTime
-> InstanceConfig
-> Text
-> Text
-> JobOutputDataConfig
-> Text
-> JobPrimaryStatus
-> GetJobResponse
newGetJobResponse
  Int
pHttpStatus_
  AlgorithmSpecification
pAlgorithmSpecification_
  UTCTime
pCreatedAt_
  InstanceConfig
pInstanceConfig_
  Text
pJobArn_
  Text
pJobName_
  JobOutputDataConfig
pOutputDataConfig_
  Text
pRoleArn_
  JobPrimaryStatus
pStatus_ =
    GetJobResponse'
      { $sel:billableDuration:GetJobResponse' :: Maybe Int
billableDuration = forall a. Maybe a
Prelude.Nothing,
        $sel:checkpointConfig:GetJobResponse' :: Maybe JobCheckpointConfig
checkpointConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:deviceConfig:GetJobResponse' :: Maybe DeviceConfig
deviceConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:endedAt:GetJobResponse' :: Maybe ISO8601
endedAt = forall a. Maybe a
Prelude.Nothing,
        $sel:events:GetJobResponse' :: Maybe [JobEventDetails]
events = forall a. Maybe a
Prelude.Nothing,
        $sel:failureReason:GetJobResponse' :: Maybe Text
failureReason = forall a. Maybe a
Prelude.Nothing,
        $sel:hyperParameters:GetJobResponse' :: Maybe (HashMap Text Text)
hyperParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:inputDataConfig:GetJobResponse' :: Maybe [InputFileConfig]
inputDataConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:startedAt:GetJobResponse' :: Maybe ISO8601
startedAt = forall a. Maybe a
Prelude.Nothing,
        $sel:stoppingCondition:GetJobResponse' :: Maybe JobStoppingCondition
stoppingCondition = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:GetJobResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetJobResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:algorithmSpecification:GetJobResponse' :: AlgorithmSpecification
algorithmSpecification = AlgorithmSpecification
pAlgorithmSpecification_,
        $sel:createdAt:GetJobResponse' :: ISO8601
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:instanceConfig:GetJobResponse' :: InstanceConfig
instanceConfig = InstanceConfig
pInstanceConfig_,
        $sel:jobArn:GetJobResponse' :: Text
jobArn = Text
pJobArn_,
        $sel:jobName:GetJobResponse' :: Text
jobName = Text
pJobName_,
        $sel:outputDataConfig:GetJobResponse' :: JobOutputDataConfig
outputDataConfig = JobOutputDataConfig
pOutputDataConfig_,
        $sel:roleArn:GetJobResponse' :: Text
roleArn = Text
pRoleArn_,
        $sel:status:GetJobResponse' :: JobPrimaryStatus
status = JobPrimaryStatus
pStatus_
      }

-- | The billable time the Amazon Braket job used to complete.
getJobResponse_billableDuration :: Lens.Lens' GetJobResponse (Prelude.Maybe Prelude.Int)
getJobResponse_billableDuration :: Lens' GetJobResponse (Maybe Int)
getJobResponse_billableDuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe Int
billableDuration :: Maybe Int
$sel:billableDuration:GetJobResponse' :: GetJobResponse -> Maybe Int
billableDuration} -> Maybe Int
billableDuration) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe Int
a -> GetJobResponse
s {$sel:billableDuration:GetJobResponse' :: Maybe Int
billableDuration = Maybe Int
a} :: GetJobResponse)

-- | Information about the output locations for job checkpoint data.
getJobResponse_checkpointConfig :: Lens.Lens' GetJobResponse (Prelude.Maybe JobCheckpointConfig)
getJobResponse_checkpointConfig :: Lens' GetJobResponse (Maybe JobCheckpointConfig)
getJobResponse_checkpointConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe JobCheckpointConfig
checkpointConfig :: Maybe JobCheckpointConfig
$sel:checkpointConfig:GetJobResponse' :: GetJobResponse -> Maybe JobCheckpointConfig
checkpointConfig} -> Maybe JobCheckpointConfig
checkpointConfig) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe JobCheckpointConfig
a -> GetJobResponse
s {$sel:checkpointConfig:GetJobResponse' :: Maybe JobCheckpointConfig
checkpointConfig = Maybe JobCheckpointConfig
a} :: GetJobResponse)

-- | The quantum processing unit (QPU) or simulator used to run the Amazon
-- Braket job.
getJobResponse_deviceConfig :: Lens.Lens' GetJobResponse (Prelude.Maybe DeviceConfig)
getJobResponse_deviceConfig :: Lens' GetJobResponse (Maybe DeviceConfig)
getJobResponse_deviceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe DeviceConfig
deviceConfig :: Maybe DeviceConfig
$sel:deviceConfig:GetJobResponse' :: GetJobResponse -> Maybe DeviceConfig
deviceConfig} -> Maybe DeviceConfig
deviceConfig) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe DeviceConfig
a -> GetJobResponse
s {$sel:deviceConfig:GetJobResponse' :: Maybe DeviceConfig
deviceConfig = Maybe DeviceConfig
a} :: GetJobResponse)

-- | The date and time that the Amazon Braket job ended.
getJobResponse_endedAt :: Lens.Lens' GetJobResponse (Prelude.Maybe Prelude.UTCTime)
getJobResponse_endedAt :: Lens' GetJobResponse (Maybe UTCTime)
getJobResponse_endedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe ISO8601
endedAt :: Maybe ISO8601
$sel:endedAt:GetJobResponse' :: GetJobResponse -> Maybe ISO8601
endedAt} -> Maybe ISO8601
endedAt) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe ISO8601
a -> GetJobResponse
s {$sel:endedAt:GetJobResponse' :: Maybe ISO8601
endedAt = Maybe ISO8601
a} :: GetJobResponse) 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

-- | Details about the type and time events occurred related to the Amazon
-- Braket job.
getJobResponse_events :: Lens.Lens' GetJobResponse (Prelude.Maybe [JobEventDetails])
getJobResponse_events :: Lens' GetJobResponse (Maybe [JobEventDetails])
getJobResponse_events = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe [JobEventDetails]
events :: Maybe [JobEventDetails]
$sel:events:GetJobResponse' :: GetJobResponse -> Maybe [JobEventDetails]
events} -> Maybe [JobEventDetails]
events) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe [JobEventDetails]
a -> GetJobResponse
s {$sel:events:GetJobResponse' :: Maybe [JobEventDetails]
events = Maybe [JobEventDetails]
a} :: GetJobResponse) 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 description of the reason why an Amazon Braket job failed, if it
-- failed.
getJobResponse_failureReason :: Lens.Lens' GetJobResponse (Prelude.Maybe Prelude.Text)
getJobResponse_failureReason :: Lens' GetJobResponse (Maybe Text)
getJobResponse_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe Text
failureReason :: Maybe Text
$sel:failureReason:GetJobResponse' :: GetJobResponse -> Maybe Text
failureReason} -> Maybe Text
failureReason) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe Text
a -> GetJobResponse
s {$sel:failureReason:GetJobResponse' :: Maybe Text
failureReason = Maybe Text
a} :: GetJobResponse)

-- | Algorithm-specific parameters used by an Amazon Braket job that
-- influence the quality of the traiing job. The values are set with a
-- string of JSON key:value pairs, where the key is the name of the
-- hyperparameter and the value is the value of th hyperparameter.
getJobResponse_hyperParameters :: Lens.Lens' GetJobResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getJobResponse_hyperParameters :: Lens' GetJobResponse (Maybe (HashMap Text Text))
getJobResponse_hyperParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe (HashMap Text Text)
hyperParameters :: Maybe (HashMap Text Text)
$sel:hyperParameters:GetJobResponse' :: GetJobResponse -> Maybe (HashMap Text Text)
hyperParameters} -> Maybe (HashMap Text Text)
hyperParameters) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe (HashMap Text Text)
a -> GetJobResponse
s {$sel:hyperParameters:GetJobResponse' :: Maybe (HashMap Text Text)
hyperParameters = Maybe (HashMap Text Text)
a} :: GetJobResponse) 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 list of parameters that specify the name and type of input data and
-- where it is located.
getJobResponse_inputDataConfig :: Lens.Lens' GetJobResponse (Prelude.Maybe [InputFileConfig])
getJobResponse_inputDataConfig :: Lens' GetJobResponse (Maybe [InputFileConfig])
getJobResponse_inputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe [InputFileConfig]
inputDataConfig :: Maybe [InputFileConfig]
$sel:inputDataConfig:GetJobResponse' :: GetJobResponse -> Maybe [InputFileConfig]
inputDataConfig} -> Maybe [InputFileConfig]
inputDataConfig) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe [InputFileConfig]
a -> GetJobResponse
s {$sel:inputDataConfig:GetJobResponse' :: Maybe [InputFileConfig]
inputDataConfig = Maybe [InputFileConfig]
a} :: GetJobResponse) 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 date and time that the Amazon Braket job was started.
getJobResponse_startedAt :: Lens.Lens' GetJobResponse (Prelude.Maybe Prelude.UTCTime)
getJobResponse_startedAt :: Lens' GetJobResponse (Maybe UTCTime)
getJobResponse_startedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe ISO8601
startedAt :: Maybe ISO8601
$sel:startedAt:GetJobResponse' :: GetJobResponse -> Maybe ISO8601
startedAt} -> Maybe ISO8601
startedAt) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe ISO8601
a -> GetJobResponse
s {$sel:startedAt:GetJobResponse' :: Maybe ISO8601
startedAt = Maybe ISO8601
a} :: GetJobResponse) 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 user-defined criteria that specifies when to stop a job running.
getJobResponse_stoppingCondition :: Lens.Lens' GetJobResponse (Prelude.Maybe JobStoppingCondition)
getJobResponse_stoppingCondition :: Lens' GetJobResponse (Maybe JobStoppingCondition)
getJobResponse_stoppingCondition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe JobStoppingCondition
stoppingCondition :: Maybe JobStoppingCondition
$sel:stoppingCondition:GetJobResponse' :: GetJobResponse -> Maybe JobStoppingCondition
stoppingCondition} -> Maybe JobStoppingCondition
stoppingCondition) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe JobStoppingCondition
a -> GetJobResponse
s {$sel:stoppingCondition:GetJobResponse' :: Maybe JobStoppingCondition
stoppingCondition = Maybe JobStoppingCondition
a} :: GetJobResponse)

-- | A tag object that consists of a key and an optional value, used to
-- manage metadata for Amazon Braket resources.
getJobResponse_tags :: Lens.Lens' GetJobResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getJobResponse_tags :: Lens' GetJobResponse (Maybe (HashMap Text Text))
getJobResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetJobResponse' :: GetJobResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetJobResponse
s@GetJobResponse' {} Maybe (HashMap Text Text)
a -> GetJobResponse
s {$sel:tags:GetJobResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetJobResponse) 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.
getJobResponse_httpStatus :: Lens.Lens' GetJobResponse Prelude.Int
getJobResponse_httpStatus :: Lens' GetJobResponse Int
getJobResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetJobResponse' :: GetJobResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetJobResponse
s@GetJobResponse' {} Int
a -> GetJobResponse
s {$sel:httpStatus:GetJobResponse' :: Int
httpStatus = Int
a} :: GetJobResponse)

-- | Definition of the Amazon Braket job created. Specifies the container
-- image the job uses, information about the Python scripts used for entry
-- and training, and the user-defined metrics used to evaluation the job.
getJobResponse_algorithmSpecification :: Lens.Lens' GetJobResponse AlgorithmSpecification
getJobResponse_algorithmSpecification :: Lens' GetJobResponse AlgorithmSpecification
getJobResponse_algorithmSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {AlgorithmSpecification
algorithmSpecification :: AlgorithmSpecification
$sel:algorithmSpecification:GetJobResponse' :: GetJobResponse -> AlgorithmSpecification
algorithmSpecification} -> AlgorithmSpecification
algorithmSpecification) (\s :: GetJobResponse
s@GetJobResponse' {} AlgorithmSpecification
a -> GetJobResponse
s {$sel:algorithmSpecification:GetJobResponse' :: AlgorithmSpecification
algorithmSpecification = AlgorithmSpecification
a} :: GetJobResponse)

-- | The date and time that the Amazon Braket job was created.
getJobResponse_createdAt :: Lens.Lens' GetJobResponse Prelude.UTCTime
getJobResponse_createdAt :: Lens' GetJobResponse UTCTime
getJobResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {ISO8601
createdAt :: ISO8601
$sel:createdAt:GetJobResponse' :: GetJobResponse -> ISO8601
createdAt} -> ISO8601
createdAt) (\s :: GetJobResponse
s@GetJobResponse' {} ISO8601
a -> GetJobResponse
s {$sel:createdAt:GetJobResponse' :: ISO8601
createdAt = ISO8601
a} :: GetJobResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The resource instances to use while running the hybrid job on Amazon
-- Braket.
getJobResponse_instanceConfig :: Lens.Lens' GetJobResponse InstanceConfig
getJobResponse_instanceConfig :: Lens' GetJobResponse InstanceConfig
getJobResponse_instanceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {InstanceConfig
instanceConfig :: InstanceConfig
$sel:instanceConfig:GetJobResponse' :: GetJobResponse -> InstanceConfig
instanceConfig} -> InstanceConfig
instanceConfig) (\s :: GetJobResponse
s@GetJobResponse' {} InstanceConfig
a -> GetJobResponse
s {$sel:instanceConfig:GetJobResponse' :: InstanceConfig
instanceConfig = InstanceConfig
a} :: GetJobResponse)

-- | The ARN of the Amazon Braket job.
getJobResponse_jobArn :: Lens.Lens' GetJobResponse Prelude.Text
getJobResponse_jobArn :: Lens' GetJobResponse Text
getJobResponse_jobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Text
jobArn :: Text
$sel:jobArn:GetJobResponse' :: GetJobResponse -> Text
jobArn} -> Text
jobArn) (\s :: GetJobResponse
s@GetJobResponse' {} Text
a -> GetJobResponse
s {$sel:jobArn:GetJobResponse' :: Text
jobArn = Text
a} :: GetJobResponse)

-- | The name of the Amazon Braket job.
getJobResponse_jobName :: Lens.Lens' GetJobResponse Prelude.Text
getJobResponse_jobName :: Lens' GetJobResponse Text
getJobResponse_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Text
jobName :: Text
$sel:jobName:GetJobResponse' :: GetJobResponse -> Text
jobName} -> Text
jobName) (\s :: GetJobResponse
s@GetJobResponse' {} Text
a -> GetJobResponse
s {$sel:jobName:GetJobResponse' :: Text
jobName = Text
a} :: GetJobResponse)

-- | The path to the S3 location where job artifacts are stored and the
-- encryption key used to store them there.
getJobResponse_outputDataConfig :: Lens.Lens' GetJobResponse JobOutputDataConfig
getJobResponse_outputDataConfig :: Lens' GetJobResponse JobOutputDataConfig
getJobResponse_outputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {JobOutputDataConfig
outputDataConfig :: JobOutputDataConfig
$sel:outputDataConfig:GetJobResponse' :: GetJobResponse -> JobOutputDataConfig
outputDataConfig} -> JobOutputDataConfig
outputDataConfig) (\s :: GetJobResponse
s@GetJobResponse' {} JobOutputDataConfig
a -> GetJobResponse
s {$sel:outputDataConfig:GetJobResponse' :: JobOutputDataConfig
outputDataConfig = JobOutputDataConfig
a} :: GetJobResponse)

-- | The Amazon Resource Name (ARN) of an IAM role that Amazon Braket can
-- assume to perform tasks on behalf of a user. It can access user
-- resources, run an Amazon Braket job container on behalf of user, and
-- output resources to the s3 buckets of a user.
getJobResponse_roleArn :: Lens.Lens' GetJobResponse Prelude.Text
getJobResponse_roleArn :: Lens' GetJobResponse Text
getJobResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {Text
roleArn :: Text
$sel:roleArn:GetJobResponse' :: GetJobResponse -> Text
roleArn} -> Text
roleArn) (\s :: GetJobResponse
s@GetJobResponse' {} Text
a -> GetJobResponse
s {$sel:roleArn:GetJobResponse' :: Text
roleArn = Text
a} :: GetJobResponse)

-- | The status of the Amazon Braket job.
getJobResponse_status :: Lens.Lens' GetJobResponse JobPrimaryStatus
getJobResponse_status :: Lens' GetJobResponse JobPrimaryStatus
getJobResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetJobResponse' {JobPrimaryStatus
status :: JobPrimaryStatus
$sel:status:GetJobResponse' :: GetJobResponse -> JobPrimaryStatus
status} -> JobPrimaryStatus
status) (\s :: GetJobResponse
s@GetJobResponse' {} JobPrimaryStatus
a -> GetJobResponse
s {$sel:status:GetJobResponse' :: JobPrimaryStatus
status = JobPrimaryStatus
a} :: GetJobResponse)

instance Prelude.NFData GetJobResponse where
  rnf :: GetJobResponse -> ()
rnf GetJobResponse' {Int
Maybe Int
Maybe [JobEventDetails]
Maybe [InputFileConfig]
Maybe Text
Maybe (HashMap Text Text)
Maybe ISO8601
Maybe DeviceConfig
Maybe JobCheckpointConfig
Maybe JobStoppingCondition
Text
ISO8601
InstanceConfig
JobOutputDataConfig
JobPrimaryStatus
AlgorithmSpecification
status :: JobPrimaryStatus
roleArn :: Text
outputDataConfig :: JobOutputDataConfig
jobName :: Text
jobArn :: Text
instanceConfig :: InstanceConfig
createdAt :: ISO8601
algorithmSpecification :: AlgorithmSpecification
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
stoppingCondition :: Maybe JobStoppingCondition
startedAt :: Maybe ISO8601
inputDataConfig :: Maybe [InputFileConfig]
hyperParameters :: Maybe (HashMap Text Text)
failureReason :: Maybe Text
events :: Maybe [JobEventDetails]
endedAt :: Maybe ISO8601
deviceConfig :: Maybe DeviceConfig
checkpointConfig :: Maybe JobCheckpointConfig
billableDuration :: Maybe Int
$sel:status:GetJobResponse' :: GetJobResponse -> JobPrimaryStatus
$sel:roleArn:GetJobResponse' :: GetJobResponse -> Text
$sel:outputDataConfig:GetJobResponse' :: GetJobResponse -> JobOutputDataConfig
$sel:jobName:GetJobResponse' :: GetJobResponse -> Text
$sel:jobArn:GetJobResponse' :: GetJobResponse -> Text
$sel:instanceConfig:GetJobResponse' :: GetJobResponse -> InstanceConfig
$sel:createdAt:GetJobResponse' :: GetJobResponse -> ISO8601
$sel:algorithmSpecification:GetJobResponse' :: GetJobResponse -> AlgorithmSpecification
$sel:httpStatus:GetJobResponse' :: GetJobResponse -> Int
$sel:tags:GetJobResponse' :: GetJobResponse -> Maybe (HashMap Text Text)
$sel:stoppingCondition:GetJobResponse' :: GetJobResponse -> Maybe JobStoppingCondition
$sel:startedAt:GetJobResponse' :: GetJobResponse -> Maybe ISO8601
$sel:inputDataConfig:GetJobResponse' :: GetJobResponse -> Maybe [InputFileConfig]
$sel:hyperParameters:GetJobResponse' :: GetJobResponse -> Maybe (HashMap Text Text)
$sel:failureReason:GetJobResponse' :: GetJobResponse -> Maybe Text
$sel:events:GetJobResponse' :: GetJobResponse -> Maybe [JobEventDetails]
$sel:endedAt:GetJobResponse' :: GetJobResponse -> Maybe ISO8601
$sel:deviceConfig:GetJobResponse' :: GetJobResponse -> Maybe DeviceConfig
$sel:checkpointConfig:GetJobResponse' :: GetJobResponse -> Maybe JobCheckpointConfig
$sel:billableDuration:GetJobResponse' :: GetJobResponse -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
billableDuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobCheckpointConfig
checkpointConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeviceConfig
deviceConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
endedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [JobEventDetails]
events
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
failureReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
hyperParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputFileConfig]
inputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
startedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobStoppingCondition
stoppingCondition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      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 AlgorithmSpecification
algorithmSpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InstanceConfig
instanceConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf JobOutputDataConfig
outputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf JobPrimaryStatus
status