{-# 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.JobDefinition
-- 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.JobDefinition where

import Amazonka.Batch.Types.ContainerProperties
import Amazonka.Batch.Types.EksProperties
import Amazonka.Batch.Types.JobTimeout
import Amazonka.Batch.Types.NodeProperties
import Amazonka.Batch.Types.OrchestrationType
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 definition.
--
-- /See:/ 'newJobDefinition' smart constructor.
data JobDefinition = JobDefinition'
  { -- | The orchestration type of the compute environment. The valid values are
    -- @ECS@ (default) or @EKS@.
    JobDefinition -> Maybe OrchestrationType
containerOrchestrationType :: Prelude.Maybe OrchestrationType,
    -- | An object with various properties specific to Amazon ECS based jobs.
    -- Valid values are @containerProperties@, @eksProperties@, and
    -- @nodeProperties@. Only one can be specified.
    JobDefinition -> Maybe ContainerProperties
containerProperties :: Prelude.Maybe ContainerProperties,
    -- | An object with various properties that are specific to Amazon EKS based
    -- jobs. Valid values are @containerProperties@, @eksProperties@, and
    -- @nodeProperties@. Only one can be specified.
    JobDefinition -> Maybe EksProperties
eksProperties :: Prelude.Maybe EksProperties,
    -- | An object with various properties that are specific to multi-node
    -- parallel jobs. Valid values are @containerProperties@, @eksProperties@,
    -- and @nodeProperties@. Only one can be specified.
    --
    -- If the job runs on Fargate resources, don\'t specify @nodeProperties@.
    -- Use @containerProperties@ instead.
    JobDefinition -> Maybe NodeProperties
nodeProperties :: Prelude.Maybe NodeProperties,
    -- | Default parameters or parameter substitution placeholders that are set
    -- in the job definition. Parameters are specified as a key-value pair
    -- mapping. Parameters in a @SubmitJob@ request override any corresponding
    -- parameter defaults from the job definition. For more information about
    -- specifying parameters, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/job_definition_parameters.html Job definition parameters>
    -- in the /Batch User Guide/.
    JobDefinition -> 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@.
    JobDefinition -> 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.
    JobDefinition -> Maybe Bool
propagateTags :: Prelude.Maybe Prelude.Bool,
    -- | The retry strategy to use for failed jobs that are submitted with this
    -- job definition.
    JobDefinition -> Maybe RetryStrategy
retryStrategy :: Prelude.Maybe RetryStrategy,
    -- | The scheduling priority 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.
    JobDefinition -> Maybe Int
schedulingPriority :: Prelude.Maybe Prelude.Int,
    -- | The status of the job definition.
    JobDefinition -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | The tags that are applied to the job definition.
    JobDefinition -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The timeout time for jobs that are submitted with this job definition.
    -- After the amount of time you specify passes, Batch terminates your jobs
    -- if they aren\'t finished.
    JobDefinition -> Maybe JobTimeout
timeout :: Prelude.Maybe JobTimeout,
    -- | The name of the job definition.
    JobDefinition -> Text
jobDefinitionName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) for the job definition.
    JobDefinition -> Text
jobDefinitionArn :: Prelude.Text,
    -- | The revision of the job definition.
    JobDefinition -> Int
revision :: Prelude.Int,
    -- | The type of job definition. It\'s either @container@ or @multinode@. If
    -- the job is run on Fargate resources, then @multinode@ isn\'t supported.
    -- For more information about multi-node parallel jobs, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/multi-node-job-def.html Creating a multi-node parallel job definition>
    -- in the /Batch User Guide/.
    JobDefinition -> Text
type' :: Prelude.Text
  }
  deriving (JobDefinition -> JobDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobDefinition -> JobDefinition -> Bool
$c/= :: JobDefinition -> JobDefinition -> Bool
== :: JobDefinition -> JobDefinition -> Bool
$c== :: JobDefinition -> JobDefinition -> Bool
Prelude.Eq, ReadPrec [JobDefinition]
ReadPrec JobDefinition
Int -> ReadS JobDefinition
ReadS [JobDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JobDefinition]
$creadListPrec :: ReadPrec [JobDefinition]
readPrec :: ReadPrec JobDefinition
$creadPrec :: ReadPrec JobDefinition
readList :: ReadS [JobDefinition]
$creadList :: ReadS [JobDefinition]
readsPrec :: Int -> ReadS JobDefinition
$creadsPrec :: Int -> ReadS JobDefinition
Prelude.Read, Int -> JobDefinition -> ShowS
[JobDefinition] -> ShowS
JobDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobDefinition] -> ShowS
$cshowList :: [JobDefinition] -> ShowS
show :: JobDefinition -> String
$cshow :: JobDefinition -> String
showsPrec :: Int -> JobDefinition -> ShowS
$cshowsPrec :: Int -> JobDefinition -> ShowS
Prelude.Show, forall x. Rep JobDefinition x -> JobDefinition
forall x. JobDefinition -> Rep JobDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobDefinition x -> JobDefinition
$cfrom :: forall x. JobDefinition -> Rep JobDefinition x
Prelude.Generic)

-- |
-- Create a value of 'JobDefinition' 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:
--
-- 'containerOrchestrationType', 'jobDefinition_containerOrchestrationType' - The orchestration type of the compute environment. The valid values are
-- @ECS@ (default) or @EKS@.
--
-- 'containerProperties', 'jobDefinition_containerProperties' - An object with various properties specific to Amazon ECS based jobs.
-- Valid values are @containerProperties@, @eksProperties@, and
-- @nodeProperties@. Only one can be specified.
--
-- 'eksProperties', 'jobDefinition_eksProperties' - An object with various properties that are specific to Amazon EKS based
-- jobs. Valid values are @containerProperties@, @eksProperties@, and
-- @nodeProperties@. Only one can be specified.
--
-- 'nodeProperties', 'jobDefinition_nodeProperties' - An object with various properties that are specific to multi-node
-- parallel jobs. Valid values are @containerProperties@, @eksProperties@,
-- and @nodeProperties@. Only one can be specified.
--
-- If the job runs on Fargate resources, don\'t specify @nodeProperties@.
-- Use @containerProperties@ instead.
--
-- 'parameters', 'jobDefinition_parameters' - Default parameters or parameter substitution placeholders that are set
-- in the job definition. Parameters are specified as a key-value pair
-- mapping. Parameters in a @SubmitJob@ request override any corresponding
-- parameter defaults from the job definition. For more information about
-- specifying parameters, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/job_definition_parameters.html Job definition parameters>
-- in the /Batch User Guide/.
--
-- 'platformCapabilities', 'jobDefinition_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', 'jobDefinition_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', 'jobDefinition_retryStrategy' - The retry strategy to use for failed jobs that are submitted with this
-- job definition.
--
-- 'schedulingPriority', 'jobDefinition_schedulingPriority' - The scheduling priority 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.
--
-- 'status', 'jobDefinition_status' - The status of the job definition.
--
-- 'tags', 'jobDefinition_tags' - The tags that are applied to the job definition.
--
-- 'timeout', 'jobDefinition_timeout' - The timeout time for jobs that are submitted with this job definition.
-- After the amount of time you specify passes, Batch terminates your jobs
-- if they aren\'t finished.
--
-- 'jobDefinitionName', 'jobDefinition_jobDefinitionName' - The name of the job definition.
--
-- 'jobDefinitionArn', 'jobDefinition_jobDefinitionArn' - The Amazon Resource Name (ARN) for the job definition.
--
-- 'revision', 'jobDefinition_revision' - The revision of the job definition.
--
-- 'type'', 'jobDefinition_type' - The type of job definition. It\'s either @container@ or @multinode@. If
-- the job is run on Fargate resources, then @multinode@ isn\'t supported.
-- For more information about multi-node parallel jobs, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/multi-node-job-def.html Creating a multi-node parallel job definition>
-- in the /Batch User Guide/.
newJobDefinition ::
  -- | 'jobDefinitionName'
  Prelude.Text ->
  -- | 'jobDefinitionArn'
  Prelude.Text ->
  -- | 'revision'
  Prelude.Int ->
  -- | 'type''
  Prelude.Text ->
  JobDefinition
newJobDefinition :: Text -> Text -> Int -> Text -> JobDefinition
newJobDefinition
  Text
pJobDefinitionName_
  Text
pJobDefinitionArn_
  Int
pRevision_
  Text
pType_ =
    JobDefinition'
      { $sel:containerOrchestrationType:JobDefinition' :: Maybe OrchestrationType
containerOrchestrationType =
          forall a. Maybe a
Prelude.Nothing,
        $sel:containerProperties:JobDefinition' :: Maybe ContainerProperties
containerProperties = forall a. Maybe a
Prelude.Nothing,
        $sel:eksProperties:JobDefinition' :: Maybe EksProperties
eksProperties = forall a. Maybe a
Prelude.Nothing,
        $sel:nodeProperties:JobDefinition' :: Maybe NodeProperties
nodeProperties = forall a. Maybe a
Prelude.Nothing,
        $sel:parameters:JobDefinition' :: Maybe (HashMap Text Text)
parameters = forall a. Maybe a
Prelude.Nothing,
        $sel:platformCapabilities:JobDefinition' :: Maybe [PlatformCapability]
platformCapabilities = forall a. Maybe a
Prelude.Nothing,
        $sel:propagateTags:JobDefinition' :: Maybe Bool
propagateTags = forall a. Maybe a
Prelude.Nothing,
        $sel:retryStrategy:JobDefinition' :: Maybe RetryStrategy
retryStrategy = forall a. Maybe a
Prelude.Nothing,
        $sel:schedulingPriority:JobDefinition' :: Maybe Int
schedulingPriority = forall a. Maybe a
Prelude.Nothing,
        $sel:status:JobDefinition' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:JobDefinition' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:timeout:JobDefinition' :: Maybe JobTimeout
timeout = forall a. Maybe a
Prelude.Nothing,
        $sel:jobDefinitionName:JobDefinition' :: Text
jobDefinitionName = Text
pJobDefinitionName_,
        $sel:jobDefinitionArn:JobDefinition' :: Text
jobDefinitionArn = Text
pJobDefinitionArn_,
        $sel:revision:JobDefinition' :: Int
revision = Int
pRevision_,
        $sel:type':JobDefinition' :: Text
type' = Text
pType_
      }

-- | The orchestration type of the compute environment. The valid values are
-- @ECS@ (default) or @EKS@.
jobDefinition_containerOrchestrationType :: Lens.Lens' JobDefinition (Prelude.Maybe OrchestrationType)
jobDefinition_containerOrchestrationType :: Lens' JobDefinition (Maybe OrchestrationType)
jobDefinition_containerOrchestrationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe OrchestrationType
containerOrchestrationType :: Maybe OrchestrationType
$sel:containerOrchestrationType:JobDefinition' :: JobDefinition -> Maybe OrchestrationType
containerOrchestrationType} -> Maybe OrchestrationType
containerOrchestrationType) (\s :: JobDefinition
s@JobDefinition' {} Maybe OrchestrationType
a -> JobDefinition
s {$sel:containerOrchestrationType:JobDefinition' :: Maybe OrchestrationType
containerOrchestrationType = Maybe OrchestrationType
a} :: JobDefinition)

-- | An object with various properties specific to Amazon ECS based jobs.
-- Valid values are @containerProperties@, @eksProperties@, and
-- @nodeProperties@. Only one can be specified.
jobDefinition_containerProperties :: Lens.Lens' JobDefinition (Prelude.Maybe ContainerProperties)
jobDefinition_containerProperties :: Lens' JobDefinition (Maybe ContainerProperties)
jobDefinition_containerProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe ContainerProperties
containerProperties :: Maybe ContainerProperties
$sel:containerProperties:JobDefinition' :: JobDefinition -> Maybe ContainerProperties
containerProperties} -> Maybe ContainerProperties
containerProperties) (\s :: JobDefinition
s@JobDefinition' {} Maybe ContainerProperties
a -> JobDefinition
s {$sel:containerProperties:JobDefinition' :: Maybe ContainerProperties
containerProperties = Maybe ContainerProperties
a} :: JobDefinition)

-- | An object with various properties that are specific to Amazon EKS based
-- jobs. Valid values are @containerProperties@, @eksProperties@, and
-- @nodeProperties@. Only one can be specified.
jobDefinition_eksProperties :: Lens.Lens' JobDefinition (Prelude.Maybe EksProperties)
jobDefinition_eksProperties :: Lens' JobDefinition (Maybe EksProperties)
jobDefinition_eksProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe EksProperties
eksProperties :: Maybe EksProperties
$sel:eksProperties:JobDefinition' :: JobDefinition -> Maybe EksProperties
eksProperties} -> Maybe EksProperties
eksProperties) (\s :: JobDefinition
s@JobDefinition' {} Maybe EksProperties
a -> JobDefinition
s {$sel:eksProperties:JobDefinition' :: Maybe EksProperties
eksProperties = Maybe EksProperties
a} :: JobDefinition)

-- | An object with various properties that are specific to multi-node
-- parallel jobs. Valid values are @containerProperties@, @eksProperties@,
-- and @nodeProperties@. Only one can be specified.
--
-- If the job runs on Fargate resources, don\'t specify @nodeProperties@.
-- Use @containerProperties@ instead.
jobDefinition_nodeProperties :: Lens.Lens' JobDefinition (Prelude.Maybe NodeProperties)
jobDefinition_nodeProperties :: Lens' JobDefinition (Maybe NodeProperties)
jobDefinition_nodeProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe NodeProperties
nodeProperties :: Maybe NodeProperties
$sel:nodeProperties:JobDefinition' :: JobDefinition -> Maybe NodeProperties
nodeProperties} -> Maybe NodeProperties
nodeProperties) (\s :: JobDefinition
s@JobDefinition' {} Maybe NodeProperties
a -> JobDefinition
s {$sel:nodeProperties:JobDefinition' :: Maybe NodeProperties
nodeProperties = Maybe NodeProperties
a} :: JobDefinition)

-- | Default parameters or parameter substitution placeholders that are set
-- in the job definition. Parameters are specified as a key-value pair
-- mapping. Parameters in a @SubmitJob@ request override any corresponding
-- parameter defaults from the job definition. For more information about
-- specifying parameters, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/job_definition_parameters.html Job definition parameters>
-- in the /Batch User Guide/.
jobDefinition_parameters :: Lens.Lens' JobDefinition (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
jobDefinition_parameters :: Lens' JobDefinition (Maybe (HashMap Text Text))
jobDefinition_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Text)
$sel:parameters:JobDefinition' :: JobDefinition -> Maybe (HashMap Text Text)
parameters} -> Maybe (HashMap Text Text)
parameters) (\s :: JobDefinition
s@JobDefinition' {} Maybe (HashMap Text Text)
a -> JobDefinition
s {$sel:parameters:JobDefinition' :: Maybe (HashMap Text Text)
parameters = Maybe (HashMap Text Text)
a} :: JobDefinition) 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@.
jobDefinition_platformCapabilities :: Lens.Lens' JobDefinition (Prelude.Maybe [PlatformCapability])
jobDefinition_platformCapabilities :: Lens' JobDefinition (Maybe [PlatformCapability])
jobDefinition_platformCapabilities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe [PlatformCapability]
platformCapabilities :: Maybe [PlatformCapability]
$sel:platformCapabilities:JobDefinition' :: JobDefinition -> Maybe [PlatformCapability]
platformCapabilities} -> Maybe [PlatformCapability]
platformCapabilities) (\s :: JobDefinition
s@JobDefinition' {} Maybe [PlatformCapability]
a -> JobDefinition
s {$sel:platformCapabilities:JobDefinition' :: Maybe [PlatformCapability]
platformCapabilities = Maybe [PlatformCapability]
a} :: JobDefinition) 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.
jobDefinition_propagateTags :: Lens.Lens' JobDefinition (Prelude.Maybe Prelude.Bool)
jobDefinition_propagateTags :: Lens' JobDefinition (Maybe Bool)
jobDefinition_propagateTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe Bool
propagateTags :: Maybe Bool
$sel:propagateTags:JobDefinition' :: JobDefinition -> Maybe Bool
propagateTags} -> Maybe Bool
propagateTags) (\s :: JobDefinition
s@JobDefinition' {} Maybe Bool
a -> JobDefinition
s {$sel:propagateTags:JobDefinition' :: Maybe Bool
propagateTags = Maybe Bool
a} :: JobDefinition)

-- | The retry strategy to use for failed jobs that are submitted with this
-- job definition.
jobDefinition_retryStrategy :: Lens.Lens' JobDefinition (Prelude.Maybe RetryStrategy)
jobDefinition_retryStrategy :: Lens' JobDefinition (Maybe RetryStrategy)
jobDefinition_retryStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe RetryStrategy
retryStrategy :: Maybe RetryStrategy
$sel:retryStrategy:JobDefinition' :: JobDefinition -> Maybe RetryStrategy
retryStrategy} -> Maybe RetryStrategy
retryStrategy) (\s :: JobDefinition
s@JobDefinition' {} Maybe RetryStrategy
a -> JobDefinition
s {$sel:retryStrategy:JobDefinition' :: Maybe RetryStrategy
retryStrategy = Maybe RetryStrategy
a} :: JobDefinition)

-- | The scheduling priority 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.
jobDefinition_schedulingPriority :: Lens.Lens' JobDefinition (Prelude.Maybe Prelude.Int)
jobDefinition_schedulingPriority :: Lens' JobDefinition (Maybe Int)
jobDefinition_schedulingPriority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe Int
schedulingPriority :: Maybe Int
$sel:schedulingPriority:JobDefinition' :: JobDefinition -> Maybe Int
schedulingPriority} -> Maybe Int
schedulingPriority) (\s :: JobDefinition
s@JobDefinition' {} Maybe Int
a -> JobDefinition
s {$sel:schedulingPriority:JobDefinition' :: Maybe Int
schedulingPriority = Maybe Int
a} :: JobDefinition)

-- | The status of the job definition.
jobDefinition_status :: Lens.Lens' JobDefinition (Prelude.Maybe Prelude.Text)
jobDefinition_status :: Lens' JobDefinition (Maybe Text)
jobDefinition_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe Text
status :: Maybe Text
$sel:status:JobDefinition' :: JobDefinition -> Maybe Text
status} -> Maybe Text
status) (\s :: JobDefinition
s@JobDefinition' {} Maybe Text
a -> JobDefinition
s {$sel:status:JobDefinition' :: Maybe Text
status = Maybe Text
a} :: JobDefinition)

-- | The tags that are applied to the job definition.
jobDefinition_tags :: Lens.Lens' JobDefinition (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
jobDefinition_tags :: Lens' JobDefinition (Maybe (HashMap Text Text))
jobDefinition_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:JobDefinition' :: JobDefinition -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: JobDefinition
s@JobDefinition' {} Maybe (HashMap Text Text)
a -> JobDefinition
s {$sel:tags:JobDefinition' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: JobDefinition) 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 time for jobs that are submitted with this job definition.
-- After the amount of time you specify passes, Batch terminates your jobs
-- if they aren\'t finished.
jobDefinition_timeout :: Lens.Lens' JobDefinition (Prelude.Maybe JobTimeout)
jobDefinition_timeout :: Lens' JobDefinition (Maybe JobTimeout)
jobDefinition_timeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Maybe JobTimeout
timeout :: Maybe JobTimeout
$sel:timeout:JobDefinition' :: JobDefinition -> Maybe JobTimeout
timeout} -> Maybe JobTimeout
timeout) (\s :: JobDefinition
s@JobDefinition' {} Maybe JobTimeout
a -> JobDefinition
s {$sel:timeout:JobDefinition' :: Maybe JobTimeout
timeout = Maybe JobTimeout
a} :: JobDefinition)

-- | The name of the job definition.
jobDefinition_jobDefinitionName :: Lens.Lens' JobDefinition Prelude.Text
jobDefinition_jobDefinitionName :: Lens' JobDefinition Text
jobDefinition_jobDefinitionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Text
jobDefinitionName :: Text
$sel:jobDefinitionName:JobDefinition' :: JobDefinition -> Text
jobDefinitionName} -> Text
jobDefinitionName) (\s :: JobDefinition
s@JobDefinition' {} Text
a -> JobDefinition
s {$sel:jobDefinitionName:JobDefinition' :: Text
jobDefinitionName = Text
a} :: JobDefinition)

-- | The Amazon Resource Name (ARN) for the job definition.
jobDefinition_jobDefinitionArn :: Lens.Lens' JobDefinition Prelude.Text
jobDefinition_jobDefinitionArn :: Lens' JobDefinition Text
jobDefinition_jobDefinitionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Text
jobDefinitionArn :: Text
$sel:jobDefinitionArn:JobDefinition' :: JobDefinition -> Text
jobDefinitionArn} -> Text
jobDefinitionArn) (\s :: JobDefinition
s@JobDefinition' {} Text
a -> JobDefinition
s {$sel:jobDefinitionArn:JobDefinition' :: Text
jobDefinitionArn = Text
a} :: JobDefinition)

-- | The revision of the job definition.
jobDefinition_revision :: Lens.Lens' JobDefinition Prelude.Int
jobDefinition_revision :: Lens' JobDefinition Int
jobDefinition_revision = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Int
revision :: Int
$sel:revision:JobDefinition' :: JobDefinition -> Int
revision} -> Int
revision) (\s :: JobDefinition
s@JobDefinition' {} Int
a -> JobDefinition
s {$sel:revision:JobDefinition' :: Int
revision = Int
a} :: JobDefinition)

-- | The type of job definition. It\'s either @container@ or @multinode@. If
-- the job is run on Fargate resources, then @multinode@ isn\'t supported.
-- For more information about multi-node parallel jobs, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/multi-node-job-def.html Creating a multi-node parallel job definition>
-- in the /Batch User Guide/.
jobDefinition_type :: Lens.Lens' JobDefinition Prelude.Text
jobDefinition_type :: Lens' JobDefinition Text
jobDefinition_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobDefinition' {Text
type' :: Text
$sel:type':JobDefinition' :: JobDefinition -> Text
type'} -> Text
type') (\s :: JobDefinition
s@JobDefinition' {} Text
a -> JobDefinition
s {$sel:type':JobDefinition' :: Text
type' = Text
a} :: JobDefinition)

instance Data.FromJSON JobDefinition where
  parseJSON :: Value -> Parser JobDefinition
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"JobDefinition"
      ( \Object
x ->
          Maybe OrchestrationType
-> Maybe ContainerProperties
-> Maybe EksProperties
-> Maybe NodeProperties
-> Maybe (HashMap Text Text)
-> Maybe [PlatformCapability]
-> Maybe Bool
-> Maybe RetryStrategy
-> Maybe Int
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe JobTimeout
-> Text
-> Text
-> Int
-> Text
-> JobDefinition
JobDefinition'
            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
"containerOrchestrationType")
            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
"containerProperties")
            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
"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
"status")
            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
"jobDefinitionName")
            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
"jobDefinitionArn")
            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
"revision")
            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
"type")
      )

instance Prelude.Hashable JobDefinition where
  hashWithSalt :: Int -> JobDefinition -> Int
hashWithSalt Int
_salt JobDefinition' {Int
Maybe Bool
Maybe Int
Maybe [PlatformCapability]
Maybe Text
Maybe (HashMap Text Text)
Maybe EksProperties
Maybe JobTimeout
Maybe OrchestrationType
Maybe RetryStrategy
Maybe ContainerProperties
Maybe NodeProperties
Text
type' :: Text
revision :: Int
jobDefinitionArn :: Text
jobDefinitionName :: Text
timeout :: Maybe JobTimeout
tags :: Maybe (HashMap Text Text)
status :: Maybe Text
schedulingPriority :: Maybe Int
retryStrategy :: Maybe RetryStrategy
propagateTags :: Maybe Bool
platformCapabilities :: Maybe [PlatformCapability]
parameters :: Maybe (HashMap Text Text)
nodeProperties :: Maybe NodeProperties
eksProperties :: Maybe EksProperties
containerProperties :: Maybe ContainerProperties
containerOrchestrationType :: Maybe OrchestrationType
$sel:type':JobDefinition' :: JobDefinition -> Text
$sel:revision:JobDefinition' :: JobDefinition -> Int
$sel:jobDefinitionArn:JobDefinition' :: JobDefinition -> Text
$sel:jobDefinitionName:JobDefinition' :: JobDefinition -> Text
$sel:timeout:JobDefinition' :: JobDefinition -> Maybe JobTimeout
$sel:tags:JobDefinition' :: JobDefinition -> Maybe (HashMap Text Text)
$sel:status:JobDefinition' :: JobDefinition -> Maybe Text
$sel:schedulingPriority:JobDefinition' :: JobDefinition -> Maybe Int
$sel:retryStrategy:JobDefinition' :: JobDefinition -> Maybe RetryStrategy
$sel:propagateTags:JobDefinition' :: JobDefinition -> Maybe Bool
$sel:platformCapabilities:JobDefinition' :: JobDefinition -> Maybe [PlatformCapability]
$sel:parameters:JobDefinition' :: JobDefinition -> Maybe (HashMap Text Text)
$sel:nodeProperties:JobDefinition' :: JobDefinition -> Maybe NodeProperties
$sel:eksProperties:JobDefinition' :: JobDefinition -> Maybe EksProperties
$sel:containerProperties:JobDefinition' :: JobDefinition -> Maybe ContainerProperties
$sel:containerOrchestrationType:JobDefinition' :: JobDefinition -> Maybe OrchestrationType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrchestrationType
containerOrchestrationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContainerProperties
containerProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EksProperties
eksProperties
      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
status
      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
jobDefinitionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobDefinitionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
revision
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
type'

instance Prelude.NFData JobDefinition where
  rnf :: JobDefinition -> ()
rnf JobDefinition' {Int
Maybe Bool
Maybe Int
Maybe [PlatformCapability]
Maybe Text
Maybe (HashMap Text Text)
Maybe EksProperties
Maybe JobTimeout
Maybe OrchestrationType
Maybe RetryStrategy
Maybe ContainerProperties
Maybe NodeProperties
Text
type' :: Text
revision :: Int
jobDefinitionArn :: Text
jobDefinitionName :: Text
timeout :: Maybe JobTimeout
tags :: Maybe (HashMap Text Text)
status :: Maybe Text
schedulingPriority :: Maybe Int
retryStrategy :: Maybe RetryStrategy
propagateTags :: Maybe Bool
platformCapabilities :: Maybe [PlatformCapability]
parameters :: Maybe (HashMap Text Text)
nodeProperties :: Maybe NodeProperties
eksProperties :: Maybe EksProperties
containerProperties :: Maybe ContainerProperties
containerOrchestrationType :: Maybe OrchestrationType
$sel:type':JobDefinition' :: JobDefinition -> Text
$sel:revision:JobDefinition' :: JobDefinition -> Int
$sel:jobDefinitionArn:JobDefinition' :: JobDefinition -> Text
$sel:jobDefinitionName:JobDefinition' :: JobDefinition -> Text
$sel:timeout:JobDefinition' :: JobDefinition -> Maybe JobTimeout
$sel:tags:JobDefinition' :: JobDefinition -> Maybe (HashMap Text Text)
$sel:status:JobDefinition' :: JobDefinition -> Maybe Text
$sel:schedulingPriority:JobDefinition' :: JobDefinition -> Maybe Int
$sel:retryStrategy:JobDefinition' :: JobDefinition -> Maybe RetryStrategy
$sel:propagateTags:JobDefinition' :: JobDefinition -> Maybe Bool
$sel:platformCapabilities:JobDefinition' :: JobDefinition -> Maybe [PlatformCapability]
$sel:parameters:JobDefinition' :: JobDefinition -> Maybe (HashMap Text Text)
$sel:nodeProperties:JobDefinition' :: JobDefinition -> Maybe NodeProperties
$sel:eksProperties:JobDefinition' :: JobDefinition -> Maybe EksProperties
$sel:containerProperties:JobDefinition' :: JobDefinition -> Maybe ContainerProperties
$sel:containerOrchestrationType:JobDefinition' :: JobDefinition -> Maybe OrchestrationType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe OrchestrationType
containerOrchestrationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContainerProperties
containerProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EksProperties
eksProperties
      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
status
      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
jobDefinitionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobDefinitionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
revision
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
type'