{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Batch.Types.JobDetail
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Batch.Types.JobDetail where

import Amazonka.Batch.Types.ArrayPropertiesDetail
import Amazonka.Batch.Types.AttemptDetail
import Amazonka.Batch.Types.ContainerDetail
import Amazonka.Batch.Types.EksAttemptDetail
import Amazonka.Batch.Types.EksPropertiesDetail
import Amazonka.Batch.Types.JobDependency
import Amazonka.Batch.Types.JobStatus
import Amazonka.Batch.Types.JobTimeout
import Amazonka.Batch.Types.NodeDetails
import Amazonka.Batch.Types.NodeProperties
import Amazonka.Batch.Types.PlatformCapability
import Amazonka.Batch.Types.RetryStrategy
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

-- | An object that represents an Batch job.
--
-- /See:/ 'newJobDetail' smart constructor.
data JobDetail = JobDetail'
  { -- | The array properties of the job, if it\'s an array job.
    JobDetail -> Maybe ArrayPropertiesDetail
arrayProperties :: Prelude.Maybe ArrayPropertiesDetail,
    -- | A list of job attempts that are associated with this job.
    JobDetail -> Maybe [AttemptDetail]
attempts :: Prelude.Maybe [AttemptDetail],
    -- | An object that represents the details for the container that\'s
    -- associated with the job.
    JobDetail -> Maybe ContainerDetail
container :: Prelude.Maybe ContainerDetail,
    -- | The Unix timestamp (in milliseconds) for when the job was created. For
    -- non-array jobs and parent array jobs, this is when the job entered the
    -- @SUBMITTED@ state. This is specifically at the time SubmitJob was
    -- called. For array child jobs, this is when the child job was spawned by
    -- its parent and entered the @PENDING@ state.
    JobDetail -> Maybe Integer
createdAt :: Prelude.Maybe Prelude.Integer,
    -- | A list of job IDs that this job depends on.
    JobDetail -> Maybe [JobDependency]
dependsOn :: Prelude.Maybe [JobDependency],
    -- | A list of job attempts that are associated with this job.
    JobDetail -> Maybe [EksAttemptDetail]
eksAttempts :: Prelude.Maybe [EksAttemptDetail],
    -- | An object with various properties that are specific to Amazon EKS based
    -- jobs. Only one of @container@, @eksProperties@, or @nodeDetails@ is
    -- specified.
    JobDetail -> Maybe EksPropertiesDetail
eksProperties :: Prelude.Maybe EksPropertiesDetail,
    -- | Indicates whether the job is canceled.
    JobDetail -> Maybe Bool
isCancelled :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether the job is terminated.
    JobDetail -> Maybe Bool
isTerminated :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the job.
    JobDetail -> Maybe Text
jobArn :: Prelude.Maybe Prelude.Text,
    -- | An object that represents the details of a node that\'s associated with
    -- a multi-node parallel job.
    JobDetail -> Maybe NodeDetails
nodeDetails :: Prelude.Maybe NodeDetails,
    -- | An object that represents the node properties of a multi-node parallel
    -- job.
    --
    -- This isn\'t applicable to jobs that are running on Fargate resources.
    JobDetail -> Maybe NodeProperties
nodeProperties :: Prelude.Maybe NodeProperties,
    -- | Additional parameters that are passed to the job that replace parameter
    -- substitution placeholders or override any corresponding parameter
    -- defaults from the job definition.
    JobDetail -> Maybe (HashMap Text Text)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The platform capabilities required by the job definition. If no value is
    -- specified, it defaults to @EC2@. Jobs run on Fargate resources specify
    -- @FARGATE@.
    JobDetail -> Maybe [PlatformCapability]
platformCapabilities :: Prelude.Maybe [PlatformCapability],
    -- | Specifies whether to propagate the tags from the job or job definition
    -- to the corresponding Amazon ECS task. If no value is specified, the tags
    -- aren\'t propagated. Tags can only be propagated to the tasks when the
    -- tasks are created. For tags with the same name, job tags are given
    -- priority over job definitions tags. If the total number of combined tags
    -- from the job and job definition is over 50, the job is moved to the
    -- @FAILED@ state.
    JobDetail -> Maybe Bool
propagateTags :: Prelude.Maybe Prelude.Bool,
    -- | The retry strategy to use for this job if an attempt fails.
    JobDetail -> Maybe RetryStrategy
retryStrategy :: Prelude.Maybe RetryStrategy,
    -- | The scheduling policy of the job definition. This only affects jobs in
    -- job queues with a fair share policy. Jobs with a higher scheduling
    -- priority are scheduled before jobs with a lower scheduling priority.
    JobDetail -> Maybe Int
schedulingPriority :: Prelude.Maybe Prelude.Int,
    -- | The share identifier for the job.
    JobDetail -> Maybe Text
shareIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The Unix timestamp (in milliseconds) for when the job was started. More
    -- specifically, it\'s when the job transitioned from the @STARTING@ state
    -- to the @RUNNING@ state. This parameter isn\'t provided for child jobs of
    -- array jobs or multi-node parallel jobs.
    JobDetail -> Maybe Integer
startedAt :: Prelude.Maybe Prelude.Integer,
    -- | A short, human-readable string to provide more details for the current
    -- status of the job.
    JobDetail -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | The Unix timestamp (in milliseconds) for when the job was stopped. More
    -- specifically, it\'s when the job transitioned from the @RUNNING@ state
    -- to a terminal state, such as @SUCCEEDED@ or @FAILED@.
    JobDetail -> Maybe Integer
stoppedAt :: Prelude.Maybe Prelude.Integer,
    -- | The tags that are applied to the job.
    JobDetail -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The timeout configuration for the job.
    JobDetail -> Maybe JobTimeout
timeout :: Prelude.Maybe JobTimeout,
    -- | The job name.
    JobDetail -> Text
jobName :: Prelude.Text,
    -- | The job ID.
    JobDetail -> Text
jobId :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the job queue that the job is
    -- associated with.
    JobDetail -> Text
jobQueue :: Prelude.Text,
    -- | The current status for the job.
    --
    -- If your jobs don\'t progress to @STARTING@, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/troubleshooting.html#job_stuck_in_runnable Jobs stuck in RUNNABLE status>
    -- in the troubleshooting section of the /Batch User Guide/.
    JobDetail -> JobStatus
status :: JobStatus,
    -- | The Amazon Resource Name (ARN) of the job definition that this job uses.
    JobDetail -> Text
jobDefinition :: Prelude.Text
  }
  deriving (JobDetail -> JobDetail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobDetail -> JobDetail -> Bool
$c/= :: JobDetail -> JobDetail -> Bool
== :: JobDetail -> JobDetail -> Bool
$c== :: JobDetail -> JobDetail -> Bool
Prelude.Eq, ReadPrec [JobDetail]
ReadPrec JobDetail
Int -> ReadS JobDetail
ReadS [JobDetail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JobDetail]
$creadListPrec :: ReadPrec [JobDetail]
readPrec :: ReadPrec JobDetail
$creadPrec :: ReadPrec JobDetail
readList :: ReadS [JobDetail]
$creadList :: ReadS [JobDetail]
readsPrec :: Int -> ReadS JobDetail
$creadsPrec :: Int -> ReadS JobDetail
Prelude.Read, Int -> JobDetail -> ShowS
[JobDetail] -> ShowS
JobDetail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobDetail] -> ShowS
$cshowList :: [JobDetail] -> ShowS
show :: JobDetail -> String
$cshow :: JobDetail -> String
showsPrec :: Int -> JobDetail -> ShowS
$cshowsPrec :: Int -> JobDetail -> ShowS
Prelude.Show, forall x. Rep JobDetail x -> JobDetail
forall x. JobDetail -> Rep JobDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobDetail x -> JobDetail
$cfrom :: forall x. JobDetail -> Rep JobDetail x
Prelude.Generic)

-- |
-- Create a value of 'JobDetail' 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:
--
-- 'arrayProperties', 'jobDetail_arrayProperties' - The array properties of the job, if it\'s an array job.
--
-- 'attempts', 'jobDetail_attempts' - A list of job attempts that are associated with this job.
--
-- 'container', 'jobDetail_container' - An object that represents the details for the container that\'s
-- associated with the job.
--
-- 'createdAt', 'jobDetail_createdAt' - The Unix timestamp (in milliseconds) for when the job was created. For
-- non-array jobs and parent array jobs, this is when the job entered the
-- @SUBMITTED@ state. This is specifically at the time SubmitJob was
-- called. For array child jobs, this is when the child job was spawned by
-- its parent and entered the @PENDING@ state.
--
-- 'dependsOn', 'jobDetail_dependsOn' - A list of job IDs that this job depends on.
--
-- 'eksAttempts', 'jobDetail_eksAttempts' - A list of job attempts that are associated with this job.
--
-- 'eksProperties', 'jobDetail_eksProperties' - An object with various properties that are specific to Amazon EKS based
-- jobs. Only one of @container@, @eksProperties@, or @nodeDetails@ is
-- specified.
--
-- 'isCancelled', 'jobDetail_isCancelled' - Indicates whether the job is canceled.
--
-- 'isTerminated', 'jobDetail_isTerminated' - Indicates whether the job is terminated.
--
-- 'jobArn', 'jobDetail_jobArn' - The Amazon Resource Name (ARN) of the job.
--
-- 'nodeDetails', 'jobDetail_nodeDetails' - An object that represents the details of a node that\'s associated with
-- a multi-node parallel job.
--
-- 'nodeProperties', 'jobDetail_nodeProperties' - An object that represents the node properties of a multi-node parallel
-- job.
--
-- This isn\'t applicable to jobs that are running on Fargate resources.
--
-- 'parameters', 'jobDetail_parameters' - Additional parameters that are passed to the job that replace parameter
-- substitution placeholders or override any corresponding parameter
-- defaults from the job definition.
--
-- 'platformCapabilities', 'jobDetail_platformCapabilities' - The platform capabilities required by the job definition. If no value is
-- specified, it defaults to @EC2@. Jobs run on Fargate resources specify
-- @FARGATE@.
--
-- 'propagateTags', 'jobDetail_propagateTags' - Specifies whether to propagate the tags from the job or job definition
-- to the corresponding Amazon ECS task. If no value is specified, the tags
-- aren\'t propagated. Tags can only be propagated to the tasks when the
-- tasks are created. For tags with the same name, job tags are given
-- priority over job definitions tags. If the total number of combined tags
-- from the job and job definition is over 50, the job is moved to the
-- @FAILED@ state.
--
-- 'retryStrategy', 'jobDetail_retryStrategy' - The retry strategy to use for this job if an attempt fails.
--
-- 'schedulingPriority', 'jobDetail_schedulingPriority' - The scheduling policy of the job definition. This only affects jobs in
-- job queues with a fair share policy. Jobs with a higher scheduling
-- priority are scheduled before jobs with a lower scheduling priority.
--
-- 'shareIdentifier', 'jobDetail_shareIdentifier' - The share identifier for the job.
--
-- 'startedAt', 'jobDetail_startedAt' - The Unix timestamp (in milliseconds) for when the job was started. More
-- specifically, it\'s when the job transitioned from the @STARTING@ state
-- to the @RUNNING@ state. This parameter isn\'t provided for child jobs of
-- array jobs or multi-node parallel jobs.
--
-- 'statusReason', 'jobDetail_statusReason' - A short, human-readable string to provide more details for the current
-- status of the job.
--
-- 'stoppedAt', 'jobDetail_stoppedAt' - The Unix timestamp (in milliseconds) for when the job was stopped. More
-- specifically, it\'s when the job transitioned from the @RUNNING@ state
-- to a terminal state, such as @SUCCEEDED@ or @FAILED@.
--
-- 'tags', 'jobDetail_tags' - The tags that are applied to the job.
--
-- 'timeout', 'jobDetail_timeout' - The timeout configuration for the job.
--
-- 'jobName', 'jobDetail_jobName' - The job name.
--
-- 'jobId', 'jobDetail_jobId' - The job ID.
--
-- 'jobQueue', 'jobDetail_jobQueue' - The Amazon Resource Name (ARN) of the job queue that the job is
-- associated with.
--
-- 'status', 'jobDetail_status' - The current status for the job.
--
-- If your jobs don\'t progress to @STARTING@, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/troubleshooting.html#job_stuck_in_runnable Jobs stuck in RUNNABLE status>
-- in the troubleshooting section of the /Batch User Guide/.
--
-- 'jobDefinition', 'jobDetail_jobDefinition' - The Amazon Resource Name (ARN) of the job definition that this job uses.
newJobDetail ::
  -- | 'jobName'
  Prelude.Text ->
  -- | 'jobId'
  Prelude.Text ->
  -- | 'jobQueue'
  Prelude.Text ->
  -- | 'status'
  JobStatus ->
  -- | 'jobDefinition'
  Prelude.Text ->
  JobDetail
newJobDetail :: Text -> Text -> Text -> JobStatus -> Text -> JobDetail
newJobDetail
  Text
pJobName_
  Text
pJobId_
  Text
pJobQueue_
  JobStatus
pStatus_
  Text
pJobDefinition_ =
    JobDetail'
      { $sel:arrayProperties:JobDetail' :: Maybe ArrayPropertiesDetail
arrayProperties = forall a. Maybe a
Prelude.Nothing,
        $sel:attempts:JobDetail' :: Maybe [AttemptDetail]
attempts = forall a. Maybe a
Prelude.Nothing,
        $sel:container:JobDetail' :: Maybe ContainerDetail
container = forall a. Maybe a
Prelude.Nothing,
        $sel:createdAt:JobDetail' :: Maybe Integer
createdAt = forall a. Maybe a
Prelude.Nothing,
        $sel:dependsOn:JobDetail' :: Maybe [JobDependency]
dependsOn = forall a. Maybe a
Prelude.Nothing,
        $sel:eksAttempts:JobDetail' :: Maybe [EksAttemptDetail]
eksAttempts = forall a. Maybe a
Prelude.Nothing,
        $sel:eksProperties:JobDetail' :: Maybe EksPropertiesDetail
eksProperties = forall a. Maybe a
Prelude.Nothing,
        $sel:isCancelled:JobDetail' :: Maybe Bool
isCancelled = forall a. Maybe a
Prelude.Nothing,
        $sel:isTerminated:JobDetail' :: Maybe Bool
isTerminated = forall a. Maybe a
Prelude.Nothing,
        $sel:jobArn:JobDetail' :: Maybe Text
jobArn = forall a. Maybe a
Prelude.Nothing,
        $sel:nodeDetails:JobDetail' :: Maybe NodeDetails
nodeDetails = forall a. Maybe a
Prelude.Nothing,
        $sel:nodeProperties:JobDetail' :: Maybe NodeProperties
nodeProperties = forall a. Maybe a
Prelude.Nothing,
        $sel:parameters:JobDetail' :: Maybe (HashMap Text Text)
parameters = forall a. Maybe a
Prelude.Nothing,
        $sel:platformCapabilities:JobDetail' :: Maybe [PlatformCapability]
platformCapabilities = forall a. Maybe a
Prelude.Nothing,
        $sel:propagateTags:JobDetail' :: Maybe Bool
propagateTags = forall a. Maybe a
Prelude.Nothing,
        $sel:retryStrategy:JobDetail' :: Maybe RetryStrategy
retryStrategy = forall a. Maybe a
Prelude.Nothing,
        $sel:schedulingPriority:JobDetail' :: Maybe Int
schedulingPriority = forall a. Maybe a
Prelude.Nothing,
        $sel:shareIdentifier:JobDetail' :: Maybe Text
shareIdentifier = forall a. Maybe a
Prelude.Nothing,
        $sel:startedAt:JobDetail' :: Maybe Integer
startedAt = forall a. Maybe a
Prelude.Nothing,
        $sel:statusReason:JobDetail' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
        $sel:stoppedAt:JobDetail' :: Maybe Integer
stoppedAt = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:JobDetail' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:timeout:JobDetail' :: Maybe JobTimeout
timeout = forall a. Maybe a
Prelude.Nothing,
        $sel:jobName:JobDetail' :: Text
jobName = Text
pJobName_,
        $sel:jobId:JobDetail' :: Text
jobId = Text
pJobId_,
        $sel:jobQueue:JobDetail' :: Text
jobQueue = Text
pJobQueue_,
        $sel:status:JobDetail' :: JobStatus
status = JobStatus
pStatus_,
        $sel:jobDefinition:JobDetail' :: Text
jobDefinition = Text
pJobDefinition_
      }

-- | The array properties of the job, if it\'s an array job.
jobDetail_arrayProperties :: Lens.Lens' JobDetail (Prelude.Maybe ArrayPropertiesDetail)
jobDetail_arrayProperties :: Lens' JobDetail (Maybe ArrayPropertiesDetail)
jobDetail_arrayProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe ArrayPropertiesDetail
arrayProperties :: Maybe ArrayPropertiesDetail
$sel:arrayProperties:JobDetail' :: JobDetail -> Maybe ArrayPropertiesDetail
arrayProperties} -> Maybe ArrayPropertiesDetail
arrayProperties) (\s :: JobDetail
s@JobDetail' {} Maybe ArrayPropertiesDetail
a -> JobDetail
s {$sel:arrayProperties:JobDetail' :: Maybe ArrayPropertiesDetail
arrayProperties = Maybe ArrayPropertiesDetail
a} :: JobDetail)

-- | A list of job attempts that are associated with this job.
jobDetail_attempts :: Lens.Lens' JobDetail (Prelude.Maybe [AttemptDetail])
jobDetail_attempts :: Lens' JobDetail (Maybe [AttemptDetail])
jobDetail_attempts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe [AttemptDetail]
attempts :: Maybe [AttemptDetail]
$sel:attempts:JobDetail' :: JobDetail -> Maybe [AttemptDetail]
attempts} -> Maybe [AttemptDetail]
attempts) (\s :: JobDetail
s@JobDetail' {} Maybe [AttemptDetail]
a -> JobDetail
s {$sel:attempts:JobDetail' :: Maybe [AttemptDetail]
attempts = Maybe [AttemptDetail]
a} :: JobDetail) 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

-- | An object that represents the details for the container that\'s
-- associated with the job.
jobDetail_container :: Lens.Lens' JobDetail (Prelude.Maybe ContainerDetail)
jobDetail_container :: Lens' JobDetail (Maybe ContainerDetail)
jobDetail_container = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe ContainerDetail
container :: Maybe ContainerDetail
$sel:container:JobDetail' :: JobDetail -> Maybe ContainerDetail
container} -> Maybe ContainerDetail
container) (\s :: JobDetail
s@JobDetail' {} Maybe ContainerDetail
a -> JobDetail
s {$sel:container:JobDetail' :: Maybe ContainerDetail
container = Maybe ContainerDetail
a} :: JobDetail)

-- | The Unix timestamp (in milliseconds) for when the job was created. For
-- non-array jobs and parent array jobs, this is when the job entered the
-- @SUBMITTED@ state. This is specifically at the time SubmitJob was
-- called. For array child jobs, this is when the child job was spawned by
-- its parent and entered the @PENDING@ state.
jobDetail_createdAt :: Lens.Lens' JobDetail (Prelude.Maybe Prelude.Integer)
jobDetail_createdAt :: Lens' JobDetail (Maybe Integer)
jobDetail_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe Integer
createdAt :: Maybe Integer
$sel:createdAt:JobDetail' :: JobDetail -> Maybe Integer
createdAt} -> Maybe Integer
createdAt) (\s :: JobDetail
s@JobDetail' {} Maybe Integer
a -> JobDetail
s {$sel:createdAt:JobDetail' :: Maybe Integer
createdAt = Maybe Integer
a} :: JobDetail)

-- | A list of job IDs that this job depends on.
jobDetail_dependsOn :: Lens.Lens' JobDetail (Prelude.Maybe [JobDependency])
jobDetail_dependsOn :: Lens' JobDetail (Maybe [JobDependency])
jobDetail_dependsOn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe [JobDependency]
dependsOn :: Maybe [JobDependency]
$sel:dependsOn:JobDetail' :: JobDetail -> Maybe [JobDependency]
dependsOn} -> Maybe [JobDependency]
dependsOn) (\s :: JobDetail
s@JobDetail' {} Maybe [JobDependency]
a -> JobDetail
s {$sel:dependsOn:JobDetail' :: Maybe [JobDependency]
dependsOn = Maybe [JobDependency]
a} :: JobDetail) 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 job attempts that are associated with this job.
jobDetail_eksAttempts :: Lens.Lens' JobDetail (Prelude.Maybe [EksAttemptDetail])
jobDetail_eksAttempts :: Lens' JobDetail (Maybe [EksAttemptDetail])
jobDetail_eksAttempts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe [EksAttemptDetail]
eksAttempts :: Maybe [EksAttemptDetail]
$sel:eksAttempts:JobDetail' :: JobDetail -> Maybe [EksAttemptDetail]
eksAttempts} -> Maybe [EksAttemptDetail]
eksAttempts) (\s :: JobDetail
s@JobDetail' {} Maybe [EksAttemptDetail]
a -> JobDetail
s {$sel:eksAttempts:JobDetail' :: Maybe [EksAttemptDetail]
eksAttempts = Maybe [EksAttemptDetail]
a} :: JobDetail) 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

-- | An object with various properties that are specific to Amazon EKS based
-- jobs. Only one of @container@, @eksProperties@, or @nodeDetails@ is
-- specified.
jobDetail_eksProperties :: Lens.Lens' JobDetail (Prelude.Maybe EksPropertiesDetail)
jobDetail_eksProperties :: Lens' JobDetail (Maybe EksPropertiesDetail)
jobDetail_eksProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe EksPropertiesDetail
eksProperties :: Maybe EksPropertiesDetail
$sel:eksProperties:JobDetail' :: JobDetail -> Maybe EksPropertiesDetail
eksProperties} -> Maybe EksPropertiesDetail
eksProperties) (\s :: JobDetail
s@JobDetail' {} Maybe EksPropertiesDetail
a -> JobDetail
s {$sel:eksProperties:JobDetail' :: Maybe EksPropertiesDetail
eksProperties = Maybe EksPropertiesDetail
a} :: JobDetail)

-- | Indicates whether the job is canceled.
jobDetail_isCancelled :: Lens.Lens' JobDetail (Prelude.Maybe Prelude.Bool)
jobDetail_isCancelled :: Lens' JobDetail (Maybe Bool)
jobDetail_isCancelled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe Bool
isCancelled :: Maybe Bool
$sel:isCancelled:JobDetail' :: JobDetail -> Maybe Bool
isCancelled} -> Maybe Bool
isCancelled) (\s :: JobDetail
s@JobDetail' {} Maybe Bool
a -> JobDetail
s {$sel:isCancelled:JobDetail' :: Maybe Bool
isCancelled = Maybe Bool
a} :: JobDetail)

-- | Indicates whether the job is terminated.
jobDetail_isTerminated :: Lens.Lens' JobDetail (Prelude.Maybe Prelude.Bool)
jobDetail_isTerminated :: Lens' JobDetail (Maybe Bool)
jobDetail_isTerminated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe Bool
isTerminated :: Maybe Bool
$sel:isTerminated:JobDetail' :: JobDetail -> Maybe Bool
isTerminated} -> Maybe Bool
isTerminated) (\s :: JobDetail
s@JobDetail' {} Maybe Bool
a -> JobDetail
s {$sel:isTerminated:JobDetail' :: Maybe Bool
isTerminated = Maybe Bool
a} :: JobDetail)

-- | The Amazon Resource Name (ARN) of the job.
jobDetail_jobArn :: Lens.Lens' JobDetail (Prelude.Maybe Prelude.Text)
jobDetail_jobArn :: Lens' JobDetail (Maybe Text)
jobDetail_jobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe Text
jobArn :: Maybe Text
$sel:jobArn:JobDetail' :: JobDetail -> Maybe Text
jobArn} -> Maybe Text
jobArn) (\s :: JobDetail
s@JobDetail' {} Maybe Text
a -> JobDetail
s {$sel:jobArn:JobDetail' :: Maybe Text
jobArn = Maybe Text
a} :: JobDetail)

-- | An object that represents the details of a node that\'s associated with
-- a multi-node parallel job.
jobDetail_nodeDetails :: Lens.Lens' JobDetail (Prelude.Maybe NodeDetails)
jobDetail_nodeDetails :: Lens' JobDetail (Maybe NodeDetails)
jobDetail_nodeDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe NodeDetails
nodeDetails :: Maybe NodeDetails
$sel:nodeDetails:JobDetail' :: JobDetail -> Maybe NodeDetails
nodeDetails} -> Maybe NodeDetails
nodeDetails) (\s :: JobDetail
s@JobDetail' {} Maybe NodeDetails
a -> JobDetail
s {$sel:nodeDetails:JobDetail' :: Maybe NodeDetails
nodeDetails = Maybe NodeDetails
a} :: JobDetail)

-- | An object that represents the node properties of a multi-node parallel
-- job.
--
-- This isn\'t applicable to jobs that are running on Fargate resources.
jobDetail_nodeProperties :: Lens.Lens' JobDetail (Prelude.Maybe NodeProperties)
jobDetail_nodeProperties :: Lens' JobDetail (Maybe NodeProperties)
jobDetail_nodeProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe NodeProperties
nodeProperties :: Maybe NodeProperties
$sel:nodeProperties:JobDetail' :: JobDetail -> Maybe NodeProperties
nodeProperties} -> Maybe NodeProperties
nodeProperties) (\s :: JobDetail
s@JobDetail' {} Maybe NodeProperties
a -> JobDetail
s {$sel:nodeProperties:JobDetail' :: Maybe NodeProperties
nodeProperties = Maybe NodeProperties
a} :: JobDetail)

-- | Additional parameters that are passed to the job that replace parameter
-- substitution placeholders or override any corresponding parameter
-- defaults from the job definition.
jobDetail_parameters :: Lens.Lens' JobDetail (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
jobDetail_parameters :: Lens' JobDetail (Maybe (HashMap Text Text))
jobDetail_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Text)
$sel:parameters:JobDetail' :: JobDetail -> Maybe (HashMap Text Text)
parameters} -> Maybe (HashMap Text Text)
parameters) (\s :: JobDetail
s@JobDetail' {} Maybe (HashMap Text Text)
a -> JobDetail
s {$sel:parameters:JobDetail' :: Maybe (HashMap Text Text)
parameters = Maybe (HashMap Text Text)
a} :: JobDetail) 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 platform capabilities required by the job definition. If no value is
-- specified, it defaults to @EC2@. Jobs run on Fargate resources specify
-- @FARGATE@.
jobDetail_platformCapabilities :: Lens.Lens' JobDetail (Prelude.Maybe [PlatformCapability])
jobDetail_platformCapabilities :: Lens' JobDetail (Maybe [PlatformCapability])
jobDetail_platformCapabilities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe [PlatformCapability]
platformCapabilities :: Maybe [PlatformCapability]
$sel:platformCapabilities:JobDetail' :: JobDetail -> Maybe [PlatformCapability]
platformCapabilities} -> Maybe [PlatformCapability]
platformCapabilities) (\s :: JobDetail
s@JobDetail' {} Maybe [PlatformCapability]
a -> JobDetail
s {$sel:platformCapabilities:JobDetail' :: Maybe [PlatformCapability]
platformCapabilities = Maybe [PlatformCapability]
a} :: JobDetail) 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

-- | Specifies whether to propagate the tags from the job or job definition
-- to the corresponding Amazon ECS task. If no value is specified, the tags
-- aren\'t propagated. Tags can only be propagated to the tasks when the
-- tasks are created. For tags with the same name, job tags are given
-- priority over job definitions tags. If the total number of combined tags
-- from the job and job definition is over 50, the job is moved to the
-- @FAILED@ state.
jobDetail_propagateTags :: Lens.Lens' JobDetail (Prelude.Maybe Prelude.Bool)
jobDetail_propagateTags :: Lens' JobDetail (Maybe Bool)
jobDetail_propagateTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe Bool
propagateTags :: Maybe Bool
$sel:propagateTags:JobDetail' :: JobDetail -> Maybe Bool
propagateTags} -> Maybe Bool
propagateTags) (\s :: JobDetail
s@JobDetail' {} Maybe Bool
a -> JobDetail
s {$sel:propagateTags:JobDetail' :: Maybe Bool
propagateTags = Maybe Bool
a} :: JobDetail)

-- | The retry strategy to use for this job if an attempt fails.
jobDetail_retryStrategy :: Lens.Lens' JobDetail (Prelude.Maybe RetryStrategy)
jobDetail_retryStrategy :: Lens' JobDetail (Maybe RetryStrategy)
jobDetail_retryStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe RetryStrategy
retryStrategy :: Maybe RetryStrategy
$sel:retryStrategy:JobDetail' :: JobDetail -> Maybe RetryStrategy
retryStrategy} -> Maybe RetryStrategy
retryStrategy) (\s :: JobDetail
s@JobDetail' {} Maybe RetryStrategy
a -> JobDetail
s {$sel:retryStrategy:JobDetail' :: Maybe RetryStrategy
retryStrategy = Maybe RetryStrategy
a} :: JobDetail)

-- | The scheduling policy of the job definition. This only affects jobs in
-- job queues with a fair share policy. Jobs with a higher scheduling
-- priority are scheduled before jobs with a lower scheduling priority.
jobDetail_schedulingPriority :: Lens.Lens' JobDetail (Prelude.Maybe Prelude.Int)
jobDetail_schedulingPriority :: Lens' JobDetail (Maybe Int)
jobDetail_schedulingPriority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe Int
schedulingPriority :: Maybe Int
$sel:schedulingPriority:JobDetail' :: JobDetail -> Maybe Int
schedulingPriority} -> Maybe Int
schedulingPriority) (\s :: JobDetail
s@JobDetail' {} Maybe Int
a -> JobDetail
s {$sel:schedulingPriority:JobDetail' :: Maybe Int
schedulingPriority = Maybe Int
a} :: JobDetail)

-- | The share identifier for the job.
jobDetail_shareIdentifier :: Lens.Lens' JobDetail (Prelude.Maybe Prelude.Text)
jobDetail_shareIdentifier :: Lens' JobDetail (Maybe Text)
jobDetail_shareIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe Text
shareIdentifier :: Maybe Text
$sel:shareIdentifier:JobDetail' :: JobDetail -> Maybe Text
shareIdentifier} -> Maybe Text
shareIdentifier) (\s :: JobDetail
s@JobDetail' {} Maybe Text
a -> JobDetail
s {$sel:shareIdentifier:JobDetail' :: Maybe Text
shareIdentifier = Maybe Text
a} :: JobDetail)

-- | The Unix timestamp (in milliseconds) for when the job was started. More
-- specifically, it\'s when the job transitioned from the @STARTING@ state
-- to the @RUNNING@ state. This parameter isn\'t provided for child jobs of
-- array jobs or multi-node parallel jobs.
jobDetail_startedAt :: Lens.Lens' JobDetail (Prelude.Maybe Prelude.Integer)
jobDetail_startedAt :: Lens' JobDetail (Maybe Integer)
jobDetail_startedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe Integer
startedAt :: Maybe Integer
$sel:startedAt:JobDetail' :: JobDetail -> Maybe Integer
startedAt} -> Maybe Integer
startedAt) (\s :: JobDetail
s@JobDetail' {} Maybe Integer
a -> JobDetail
s {$sel:startedAt:JobDetail' :: Maybe Integer
startedAt = Maybe Integer
a} :: JobDetail)

-- | A short, human-readable string to provide more details for the current
-- status of the job.
jobDetail_statusReason :: Lens.Lens' JobDetail (Prelude.Maybe Prelude.Text)
jobDetail_statusReason :: Lens' JobDetail (Maybe Text)
jobDetail_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:JobDetail' :: JobDetail -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: JobDetail
s@JobDetail' {} Maybe Text
a -> JobDetail
s {$sel:statusReason:JobDetail' :: Maybe Text
statusReason = Maybe Text
a} :: JobDetail)

-- | The Unix timestamp (in milliseconds) for when the job was stopped. More
-- specifically, it\'s when the job transitioned from the @RUNNING@ state
-- to a terminal state, such as @SUCCEEDED@ or @FAILED@.
jobDetail_stoppedAt :: Lens.Lens' JobDetail (Prelude.Maybe Prelude.Integer)
jobDetail_stoppedAt :: Lens' JobDetail (Maybe Integer)
jobDetail_stoppedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe Integer
stoppedAt :: Maybe Integer
$sel:stoppedAt:JobDetail' :: JobDetail -> Maybe Integer
stoppedAt} -> Maybe Integer
stoppedAt) (\s :: JobDetail
s@JobDetail' {} Maybe Integer
a -> JobDetail
s {$sel:stoppedAt:JobDetail' :: Maybe Integer
stoppedAt = Maybe Integer
a} :: JobDetail)

-- | The tags that are applied to the job.
jobDetail_tags :: Lens.Lens' JobDetail (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
jobDetail_tags :: Lens' JobDetail (Maybe (HashMap Text Text))
jobDetail_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:JobDetail' :: JobDetail -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: JobDetail
s@JobDetail' {} Maybe (HashMap Text Text)
a -> JobDetail
s {$sel:tags:JobDetail' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: JobDetail) 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 timeout configuration for the job.
jobDetail_timeout :: Lens.Lens' JobDetail (Prelude.Maybe JobTimeout)
jobDetail_timeout :: Lens' JobDetail (Maybe JobTimeout)
jobDetail_timeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Maybe JobTimeout
timeout :: Maybe JobTimeout
$sel:timeout:JobDetail' :: JobDetail -> Maybe JobTimeout
timeout} -> Maybe JobTimeout
timeout) (\s :: JobDetail
s@JobDetail' {} Maybe JobTimeout
a -> JobDetail
s {$sel:timeout:JobDetail' :: Maybe JobTimeout
timeout = Maybe JobTimeout
a} :: JobDetail)

-- | The job name.
jobDetail_jobName :: Lens.Lens' JobDetail Prelude.Text
jobDetail_jobName :: Lens' JobDetail Text
jobDetail_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Text
jobName :: Text
$sel:jobName:JobDetail' :: JobDetail -> Text
jobName} -> Text
jobName) (\s :: JobDetail
s@JobDetail' {} Text
a -> JobDetail
s {$sel:jobName:JobDetail' :: Text
jobName = Text
a} :: JobDetail)

-- | The job ID.
jobDetail_jobId :: Lens.Lens' JobDetail Prelude.Text
jobDetail_jobId :: Lens' JobDetail Text
jobDetail_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Text
jobId :: Text
$sel:jobId:JobDetail' :: JobDetail -> Text
jobId} -> Text
jobId) (\s :: JobDetail
s@JobDetail' {} Text
a -> JobDetail
s {$sel:jobId:JobDetail' :: Text
jobId = Text
a} :: JobDetail)

-- | The Amazon Resource Name (ARN) of the job queue that the job is
-- associated with.
jobDetail_jobQueue :: Lens.Lens' JobDetail Prelude.Text
jobDetail_jobQueue :: Lens' JobDetail Text
jobDetail_jobQueue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Text
jobQueue :: Text
$sel:jobQueue:JobDetail' :: JobDetail -> Text
jobQueue} -> Text
jobQueue) (\s :: JobDetail
s@JobDetail' {} Text
a -> JobDetail
s {$sel:jobQueue:JobDetail' :: Text
jobQueue = Text
a} :: JobDetail)

-- | The current status for the job.
--
-- If your jobs don\'t progress to @STARTING@, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/troubleshooting.html#job_stuck_in_runnable Jobs stuck in RUNNABLE status>
-- in the troubleshooting section of the /Batch User Guide/.
jobDetail_status :: Lens.Lens' JobDetail JobStatus
jobDetail_status :: Lens' JobDetail JobStatus
jobDetail_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {JobStatus
status :: JobStatus
$sel:status:JobDetail' :: JobDetail -> JobStatus
status} -> JobStatus
status) (\s :: JobDetail
s@JobDetail' {} JobStatus
a -> JobDetail
s {$sel:status:JobDetail' :: JobStatus
status = JobStatus
a} :: JobDetail)

-- | The Amazon Resource Name (ARN) of the job definition that this job uses.
jobDetail_jobDefinition :: Lens.Lens' JobDetail Prelude.Text
jobDetail_jobDefinition :: Lens' JobDetail Text
jobDetail_jobDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDetail' {Text
jobDefinition :: Text
$sel:jobDefinition:JobDetail' :: JobDetail -> Text
jobDefinition} -> Text
jobDefinition) (\s :: JobDetail
s@JobDetail' {} Text
a -> JobDetail
s {$sel:jobDefinition:JobDetail' :: Text
jobDefinition = Text
a} :: JobDetail)

instance Data.FromJSON JobDetail where
  parseJSON :: Value -> Parser JobDetail
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"JobDetail"
      ( \Object
x ->
          Maybe ArrayPropertiesDetail
-> Maybe [AttemptDetail]
-> Maybe ContainerDetail
-> Maybe Integer
-> Maybe [JobDependency]
-> Maybe [EksAttemptDetail]
-> Maybe EksPropertiesDetail
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe NodeDetails
-> Maybe NodeProperties
-> Maybe (HashMap Text Text)
-> Maybe [PlatformCapability]
-> Maybe Bool
-> Maybe RetryStrategy
-> Maybe Int
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe (HashMap Text Text)
-> Maybe JobTimeout
-> Text
-> Text
-> Text
-> JobStatus
-> Text
-> JobDetail
JobDetail'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"arrayProperties")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"attempts" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"container")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe 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 -> Parser (Maybe a)
Data..:? Key
"dependsOn" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"eksAttempts" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"eksProperties")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"isCancelled")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"isTerminated")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe 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 -> Parser (Maybe a)
Data..:? Key
"nodeDetails")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"nodeProperties")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"parameters" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"platformCapabilities"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"propagateTags")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"retryStrategy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"schedulingPriority")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"shareIdentifier")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (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 -> Parser (Maybe a)
Data..:? Key
"statusReason")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"stoppedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"tags" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"timeout")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser 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 -> Parser 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 -> Parser a
Data..: Key
"jobQueue")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"jobDefinition")
      )

instance Prelude.Hashable JobDetail where
  hashWithSalt :: Int -> JobDetail -> Int
hashWithSalt Int
_salt JobDetail' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [EksAttemptDetail]
Maybe [JobDependency]
Maybe [AttemptDetail]
Maybe [PlatformCapability]
Maybe Text
Maybe (HashMap Text Text)
Maybe ArrayPropertiesDetail
Maybe EksPropertiesDetail
Maybe JobTimeout
Maybe NodeDetails
Maybe RetryStrategy
Maybe NodeProperties
Maybe ContainerDetail
Text
JobStatus
jobDefinition :: Text
status :: JobStatus
jobQueue :: Text
jobId :: Text
jobName :: Text
timeout :: Maybe JobTimeout
tags :: Maybe (HashMap Text Text)
stoppedAt :: Maybe Integer
statusReason :: Maybe Text
startedAt :: Maybe Integer
shareIdentifier :: Maybe Text
schedulingPriority :: Maybe Int
retryStrategy :: Maybe RetryStrategy
propagateTags :: Maybe Bool
platformCapabilities :: Maybe [PlatformCapability]
parameters :: Maybe (HashMap Text Text)
nodeProperties :: Maybe NodeProperties
nodeDetails :: Maybe NodeDetails
jobArn :: Maybe Text
isTerminated :: Maybe Bool
isCancelled :: Maybe Bool
eksProperties :: Maybe EksPropertiesDetail
eksAttempts :: Maybe [EksAttemptDetail]
dependsOn :: Maybe [JobDependency]
createdAt :: Maybe Integer
container :: Maybe ContainerDetail
attempts :: Maybe [AttemptDetail]
arrayProperties :: Maybe ArrayPropertiesDetail
$sel:jobDefinition:JobDetail' :: JobDetail -> Text
$sel:status:JobDetail' :: JobDetail -> JobStatus
$sel:jobQueue:JobDetail' :: JobDetail -> Text
$sel:jobId:JobDetail' :: JobDetail -> Text
$sel:jobName:JobDetail' :: JobDetail -> Text
$sel:timeout:JobDetail' :: JobDetail -> Maybe JobTimeout
$sel:tags:JobDetail' :: JobDetail -> Maybe (HashMap Text Text)
$sel:stoppedAt:JobDetail' :: JobDetail -> Maybe Integer
$sel:statusReason:JobDetail' :: JobDetail -> Maybe Text
$sel:startedAt:JobDetail' :: JobDetail -> Maybe Integer
$sel:shareIdentifier:JobDetail' :: JobDetail -> Maybe Text
$sel:schedulingPriority:JobDetail' :: JobDetail -> Maybe Int
$sel:retryStrategy:JobDetail' :: JobDetail -> Maybe RetryStrategy
$sel:propagateTags:JobDetail' :: JobDetail -> Maybe Bool
$sel:platformCapabilities:JobDetail' :: JobDetail -> Maybe [PlatformCapability]
$sel:parameters:JobDetail' :: JobDetail -> Maybe (HashMap Text Text)
$sel:nodeProperties:JobDetail' :: JobDetail -> Maybe NodeProperties
$sel:nodeDetails:JobDetail' :: JobDetail -> Maybe NodeDetails
$sel:jobArn:JobDetail' :: JobDetail -> Maybe Text
$sel:isTerminated:JobDetail' :: JobDetail -> Maybe Bool
$sel:isCancelled:JobDetail' :: JobDetail -> Maybe Bool
$sel:eksProperties:JobDetail' :: JobDetail -> Maybe EksPropertiesDetail
$sel:eksAttempts:JobDetail' :: JobDetail -> Maybe [EksAttemptDetail]
$sel:dependsOn:JobDetail' :: JobDetail -> Maybe [JobDependency]
$sel:createdAt:JobDetail' :: JobDetail -> Maybe Integer
$sel:container:JobDetail' :: JobDetail -> Maybe ContainerDetail
$sel:attempts:JobDetail' :: JobDetail -> Maybe [AttemptDetail]
$sel:arrayProperties:JobDetail' :: JobDetail -> Maybe ArrayPropertiesDetail
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ArrayPropertiesDetail
arrayProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AttemptDetail]
attempts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContainerDetail
container
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [JobDependency]
dependsOn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EksAttemptDetail]
eksAttempts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EksPropertiesDetail
eksProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isCancelled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isTerminated
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NodeDetails
nodeDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NodeProperties
nodeProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PlatformCapability]
platformCapabilities
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
propagateTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RetryStrategy
retryStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
schedulingPriority
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
shareIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
startedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
stoppedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobTimeout
timeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobQueue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` JobStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobDefinition

instance Prelude.NFData JobDetail where
  rnf :: JobDetail -> ()
rnf JobDetail' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [EksAttemptDetail]
Maybe [JobDependency]
Maybe [AttemptDetail]
Maybe [PlatformCapability]
Maybe Text
Maybe (HashMap Text Text)
Maybe ArrayPropertiesDetail
Maybe EksPropertiesDetail
Maybe JobTimeout
Maybe NodeDetails
Maybe RetryStrategy
Maybe NodeProperties
Maybe ContainerDetail
Text
JobStatus
jobDefinition :: Text
status :: JobStatus
jobQueue :: Text
jobId :: Text
jobName :: Text
timeout :: Maybe JobTimeout
tags :: Maybe (HashMap Text Text)
stoppedAt :: Maybe Integer
statusReason :: Maybe Text
startedAt :: Maybe Integer
shareIdentifier :: Maybe Text
schedulingPriority :: Maybe Int
retryStrategy :: Maybe RetryStrategy
propagateTags :: Maybe Bool
platformCapabilities :: Maybe [PlatformCapability]
parameters :: Maybe (HashMap Text Text)
nodeProperties :: Maybe NodeProperties
nodeDetails :: Maybe NodeDetails
jobArn :: Maybe Text
isTerminated :: Maybe Bool
isCancelled :: Maybe Bool
eksProperties :: Maybe EksPropertiesDetail
eksAttempts :: Maybe [EksAttemptDetail]
dependsOn :: Maybe [JobDependency]
createdAt :: Maybe Integer
container :: Maybe ContainerDetail
attempts :: Maybe [AttemptDetail]
arrayProperties :: Maybe ArrayPropertiesDetail
$sel:jobDefinition:JobDetail' :: JobDetail -> Text
$sel:status:JobDetail' :: JobDetail -> JobStatus
$sel:jobQueue:JobDetail' :: JobDetail -> Text
$sel:jobId:JobDetail' :: JobDetail -> Text
$sel:jobName:JobDetail' :: JobDetail -> Text
$sel:timeout:JobDetail' :: JobDetail -> Maybe JobTimeout
$sel:tags:JobDetail' :: JobDetail -> Maybe (HashMap Text Text)
$sel:stoppedAt:JobDetail' :: JobDetail -> Maybe Integer
$sel:statusReason:JobDetail' :: JobDetail -> Maybe Text
$sel:startedAt:JobDetail' :: JobDetail -> Maybe Integer
$sel:shareIdentifier:JobDetail' :: JobDetail -> Maybe Text
$sel:schedulingPriority:JobDetail' :: JobDetail -> Maybe Int
$sel:retryStrategy:JobDetail' :: JobDetail -> Maybe RetryStrategy
$sel:propagateTags:JobDetail' :: JobDetail -> Maybe Bool
$sel:platformCapabilities:JobDetail' :: JobDetail -> Maybe [PlatformCapability]
$sel:parameters:JobDetail' :: JobDetail -> Maybe (HashMap Text Text)
$sel:nodeProperties:JobDetail' :: JobDetail -> Maybe NodeProperties
$sel:nodeDetails:JobDetail' :: JobDetail -> Maybe NodeDetails
$sel:jobArn:JobDetail' :: JobDetail -> Maybe Text
$sel:isTerminated:JobDetail' :: JobDetail -> Maybe Bool
$sel:isCancelled:JobDetail' :: JobDetail -> Maybe Bool
$sel:eksProperties:JobDetail' :: JobDetail -> Maybe EksPropertiesDetail
$sel:eksAttempts:JobDetail' :: JobDetail -> Maybe [EksAttemptDetail]
$sel:dependsOn:JobDetail' :: JobDetail -> Maybe [JobDependency]
$sel:createdAt:JobDetail' :: JobDetail -> Maybe Integer
$sel:container:JobDetail' :: JobDetail -> Maybe ContainerDetail
$sel:attempts:JobDetail' :: JobDetail -> Maybe [AttemptDetail]
$sel:arrayProperties:JobDetail' :: JobDetail -> Maybe ArrayPropertiesDetail
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ArrayPropertiesDetail
arrayProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [AttemptDetail]
attempts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContainerDetail
container
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [JobDependency]
dependsOn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [EksAttemptDetail]
eksAttempts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EksPropertiesDetail
eksProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isCancelled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isTerminated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NodeDetails
nodeDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NodeProperties
nodeProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PlatformCapability]
platformCapabilities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
propagateTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RetryStrategy
retryStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
schedulingPriority
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
shareIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
startedAt
      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 Maybe Integer
stoppedAt
      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 Maybe JobTimeout
timeout
      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 Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Text
jobQueue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        JobStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Text
jobDefinition