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

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

-- |
-- Module      : Amazonka.Batch.SubmitJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Submits an Batch job from a job definition. Parameters that are
-- specified during SubmitJob override parameters defined in the job
-- definition. vCPU and memory requirements that are specified in the
-- @resourceRequirements@ objects in the job definition are the exception.
-- They can\'t be overridden this way using the @memory@ and @vcpus@
-- parameters. Rather, you must specify updates to job definition
-- parameters in a @resourceRequirements@ object that\'s included in the
-- @containerOverrides@ parameter.
--
-- Job queues with a scheduling policy are limited to 500 active fair share
-- identifiers at a time.
--
-- Jobs that run on Fargate resources can\'t be guaranteed to run for more
-- than 14 days. This is because, after 14 days, Fargate resources might
-- become unavailable and job might be terminated.
module Amazonka.Batch.SubmitJob
  ( -- * Creating a Request
    SubmitJob (..),
    newSubmitJob,

    -- * Request Lenses
    submitJob_arrayProperties,
    submitJob_containerOverrides,
    submitJob_dependsOn,
    submitJob_eksPropertiesOverride,
    submitJob_nodeOverrides,
    submitJob_parameters,
    submitJob_propagateTags,
    submitJob_retryStrategy,
    submitJob_schedulingPriorityOverride,
    submitJob_shareIdentifier,
    submitJob_tags,
    submitJob_timeout,
    submitJob_jobName,
    submitJob_jobQueue,
    submitJob_jobDefinition,

    -- * Destructuring the Response
    SubmitJobResponse (..),
    newSubmitJobResponse,

    -- * Response Lenses
    submitJobResponse_jobArn,
    submitJobResponse_httpStatus,
    submitJobResponse_jobName,
    submitJobResponse_jobId,
  )
where

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

-- | Contains the parameters for @SubmitJob@.
--
-- /See:/ 'newSubmitJob' smart constructor.
data SubmitJob = SubmitJob'
  { -- | The array properties for the submitted job, such as the size of the
    -- array. The array size can be between 2 and 10,000. If you specify array
    -- properties for a job, it becomes an array job. For more information, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/array_jobs.html Array Jobs>
    -- in the /Batch User Guide/.
    SubmitJob -> Maybe ArrayProperties
arrayProperties :: Prelude.Maybe ArrayProperties,
    -- | An object with various properties that override the defaults for the job
    -- definition that specify the name of a container in the specified job
    -- definition and the overrides it should receive. You can override the
    -- default command for a container, which is specified in the job
    -- definition or the Docker image, with a @command@ override. You can also
    -- override existing environment variables on a container or add new
    -- environment variables to it with an @environment@ override.
    SubmitJob -> Maybe ContainerOverrides
containerOverrides :: Prelude.Maybe ContainerOverrides,
    -- | A list of dependencies for the job. A job can depend upon a maximum of
    -- 20 jobs. You can specify a @SEQUENTIAL@ type dependency without
    -- specifying a job ID for array jobs so that each child array job
    -- completes sequentially, starting at index 0. You can also specify an
    -- @N_TO_N@ type dependency with a job ID for array jobs. In that case,
    -- each index child of this job must wait for the corresponding index child
    -- of each dependency to complete before it can begin.
    SubmitJob -> Maybe [JobDependency]
dependsOn :: Prelude.Maybe [JobDependency],
    -- | An object that can only be specified for jobs that are run on Amazon EKS
    -- resources with various properties that override defaults for the job
    -- definition.
    SubmitJob -> Maybe EksPropertiesOverride
eksPropertiesOverride :: Prelude.Maybe EksPropertiesOverride,
    -- | A list of node overrides in JSON format that specify the node range to
    -- target and the container overrides for that node range.
    --
    -- This parameter isn\'t applicable to jobs that are running on Fargate
    -- resources; use @containerOverrides@ instead.
    SubmitJob -> Maybe NodeOverrides
nodeOverrides :: Prelude.Maybe NodeOverrides,
    -- | Additional parameters passed to the job that replace parameter
    -- substitution placeholders that are set in the job definition. Parameters
    -- are specified as a key and value pair mapping. Parameters in a
    -- @SubmitJob@ request override any corresponding parameter defaults from
    -- the job definition.
    SubmitJob -> Maybe (HashMap Text Text)
parameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | 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 during task
    -- creation. 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.
    -- When specified, this overrides the tag propagation setting in the job
    -- definition.
    SubmitJob -> Maybe Bool
propagateTags :: Prelude.Maybe Prelude.Bool,
    -- | The retry strategy to use for failed jobs from this SubmitJob operation.
    -- When a retry strategy is specified here, it overrides the retry strategy
    -- defined in the job definition.
    SubmitJob -> Maybe RetryStrategy
retryStrategy :: Prelude.Maybe RetryStrategy,
    -- | The scheduling priority for the job. 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. This
    -- overrides any scheduling priority in the job definition.
    --
    -- The minimum supported value is 0 and the maximum supported value is
    -- 9999.
    SubmitJob -> Maybe Int
schedulingPriorityOverride :: Prelude.Maybe Prelude.Int,
    -- | The share identifier for the job. If the job queue doesn\'t have a
    -- scheduling policy, then this parameter must not be specified. If the job
    -- queue has a scheduling policy, then this parameter must be specified.
    SubmitJob -> Maybe Text
shareIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The tags that you apply to the job request to help you categorize and
    -- organize your resources. Each tag consists of a key and an optional
    -- value. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
    -- in /Amazon Web Services General Reference/.
    SubmitJob -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The timeout configuration for this SubmitJob operation. You can specify
    -- a timeout duration after which Batch terminates your jobs if they
    -- haven\'t finished. If a job is terminated due to a timeout, it isn\'t
    -- retried. The minimum value for the timeout is 60 seconds. This
    -- configuration overrides any timeout configuration specified in the job
    -- definition. For array jobs, child jobs have the same timeout
    -- configuration as the parent job. For more information, see
    -- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/job_timeouts.html Job Timeouts>
    -- in the /Amazon Elastic Container Service Developer Guide/.
    SubmitJob -> Maybe JobTimeout
timeout :: Prelude.Maybe JobTimeout,
    -- | The name of the job. It can be up to 128 letters long. The first
    -- character must be alphanumeric, can contain uppercase and lowercase
    -- letters, numbers, hyphens (-), and underscores (_).
    SubmitJob -> Text
jobName :: Prelude.Text,
    -- | The job queue where the job is submitted. You can specify either the
    -- name or the Amazon Resource Name (ARN) of the queue.
    SubmitJob -> Text
jobQueue :: Prelude.Text,
    -- | The job definition used by this job. This value can be one of @name@,
    -- @name:revision@, or the Amazon Resource Name (ARN) for the job
    -- definition. If @name@ is specified without a revision then the latest
    -- active revision is used.
    SubmitJob -> Text
jobDefinition :: Prelude.Text
  }
  deriving (SubmitJob -> SubmitJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubmitJob -> SubmitJob -> Bool
$c/= :: SubmitJob -> SubmitJob -> Bool
== :: SubmitJob -> SubmitJob -> Bool
$c== :: SubmitJob -> SubmitJob -> Bool
Prelude.Eq, ReadPrec [SubmitJob]
ReadPrec SubmitJob
Int -> ReadS SubmitJob
ReadS [SubmitJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubmitJob]
$creadListPrec :: ReadPrec [SubmitJob]
readPrec :: ReadPrec SubmitJob
$creadPrec :: ReadPrec SubmitJob
readList :: ReadS [SubmitJob]
$creadList :: ReadS [SubmitJob]
readsPrec :: Int -> ReadS SubmitJob
$creadsPrec :: Int -> ReadS SubmitJob
Prelude.Read, Int -> SubmitJob -> ShowS
[SubmitJob] -> ShowS
SubmitJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubmitJob] -> ShowS
$cshowList :: [SubmitJob] -> ShowS
show :: SubmitJob -> String
$cshow :: SubmitJob -> String
showsPrec :: Int -> SubmitJob -> ShowS
$cshowsPrec :: Int -> SubmitJob -> ShowS
Prelude.Show, forall x. Rep SubmitJob x -> SubmitJob
forall x. SubmitJob -> Rep SubmitJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubmitJob x -> SubmitJob
$cfrom :: forall x. SubmitJob -> Rep SubmitJob x
Prelude.Generic)

-- |
-- Create a value of 'SubmitJob' 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', 'submitJob_arrayProperties' - The array properties for the submitted job, such as the size of the
-- array. The array size can be between 2 and 10,000. If you specify array
-- properties for a job, it becomes an array job. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/array_jobs.html Array Jobs>
-- in the /Batch User Guide/.
--
-- 'containerOverrides', 'submitJob_containerOverrides' - An object with various properties that override the defaults for the job
-- definition that specify the name of a container in the specified job
-- definition and the overrides it should receive. You can override the
-- default command for a container, which is specified in the job
-- definition or the Docker image, with a @command@ override. You can also
-- override existing environment variables on a container or add new
-- environment variables to it with an @environment@ override.
--
-- 'dependsOn', 'submitJob_dependsOn' - A list of dependencies for the job. A job can depend upon a maximum of
-- 20 jobs. You can specify a @SEQUENTIAL@ type dependency without
-- specifying a job ID for array jobs so that each child array job
-- completes sequentially, starting at index 0. You can also specify an
-- @N_TO_N@ type dependency with a job ID for array jobs. In that case,
-- each index child of this job must wait for the corresponding index child
-- of each dependency to complete before it can begin.
--
-- 'eksPropertiesOverride', 'submitJob_eksPropertiesOverride' - An object that can only be specified for jobs that are run on Amazon EKS
-- resources with various properties that override defaults for the job
-- definition.
--
-- 'nodeOverrides', 'submitJob_nodeOverrides' - A list of node overrides in JSON format that specify the node range to
-- target and the container overrides for that node range.
--
-- This parameter isn\'t applicable to jobs that are running on Fargate
-- resources; use @containerOverrides@ instead.
--
-- 'parameters', 'submitJob_parameters' - Additional parameters passed to the job that replace parameter
-- substitution placeholders that are set in the job definition. Parameters
-- are specified as a key and value pair mapping. Parameters in a
-- @SubmitJob@ request override any corresponding parameter defaults from
-- the job definition.
--
-- 'propagateTags', 'submitJob_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 during task
-- creation. 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.
-- When specified, this overrides the tag propagation setting in the job
-- definition.
--
-- 'retryStrategy', 'submitJob_retryStrategy' - The retry strategy to use for failed jobs from this SubmitJob operation.
-- When a retry strategy is specified here, it overrides the retry strategy
-- defined in the job definition.
--
-- 'schedulingPriorityOverride', 'submitJob_schedulingPriorityOverride' - The scheduling priority for the job. 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. This
-- overrides any scheduling priority in the job definition.
--
-- The minimum supported value is 0 and the maximum supported value is
-- 9999.
--
-- 'shareIdentifier', 'submitJob_shareIdentifier' - The share identifier for the job. If the job queue doesn\'t have a
-- scheduling policy, then this parameter must not be specified. If the job
-- queue has a scheduling policy, then this parameter must be specified.
--
-- 'tags', 'submitJob_tags' - The tags that you apply to the job request to help you categorize and
-- organize your resources. Each tag consists of a key and an optional
-- value. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- in /Amazon Web Services General Reference/.
--
-- 'timeout', 'submitJob_timeout' - The timeout configuration for this SubmitJob operation. You can specify
-- a timeout duration after which Batch terminates your jobs if they
-- haven\'t finished. If a job is terminated due to a timeout, it isn\'t
-- retried. The minimum value for the timeout is 60 seconds. This
-- configuration overrides any timeout configuration specified in the job
-- definition. For array jobs, child jobs have the same timeout
-- configuration as the parent job. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/job_timeouts.html Job Timeouts>
-- in the /Amazon Elastic Container Service Developer Guide/.
--
-- 'jobName', 'submitJob_jobName' - The name of the job. It can be up to 128 letters long. The first
-- character must be alphanumeric, can contain uppercase and lowercase
-- letters, numbers, hyphens (-), and underscores (_).
--
-- 'jobQueue', 'submitJob_jobQueue' - The job queue where the job is submitted. You can specify either the
-- name or the Amazon Resource Name (ARN) of the queue.
--
-- 'jobDefinition', 'submitJob_jobDefinition' - The job definition used by this job. This value can be one of @name@,
-- @name:revision@, or the Amazon Resource Name (ARN) for the job
-- definition. If @name@ is specified without a revision then the latest
-- active revision is used.
newSubmitJob ::
  -- | 'jobName'
  Prelude.Text ->
  -- | 'jobQueue'
  Prelude.Text ->
  -- | 'jobDefinition'
  Prelude.Text ->
  SubmitJob
newSubmitJob :: Text -> Text -> Text -> SubmitJob
newSubmitJob Text
pJobName_ Text
pJobQueue_ Text
pJobDefinition_ =
  SubmitJob'
    { $sel:arrayProperties:SubmitJob' :: Maybe ArrayProperties
arrayProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:containerOverrides:SubmitJob' :: Maybe ContainerOverrides
containerOverrides = forall a. Maybe a
Prelude.Nothing,
      $sel:dependsOn:SubmitJob' :: Maybe [JobDependency]
dependsOn = forall a. Maybe a
Prelude.Nothing,
      $sel:eksPropertiesOverride:SubmitJob' :: Maybe EksPropertiesOverride
eksPropertiesOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:nodeOverrides:SubmitJob' :: Maybe NodeOverrides
nodeOverrides = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:SubmitJob' :: Maybe (HashMap Text Text)
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:propagateTags:SubmitJob' :: Maybe Bool
propagateTags = forall a. Maybe a
Prelude.Nothing,
      $sel:retryStrategy:SubmitJob' :: Maybe RetryStrategy
retryStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:schedulingPriorityOverride:SubmitJob' :: Maybe Int
schedulingPriorityOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:shareIdentifier:SubmitJob' :: Maybe Text
shareIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:SubmitJob' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:timeout:SubmitJob' :: Maybe JobTimeout
timeout = forall a. Maybe a
Prelude.Nothing,
      $sel:jobName:SubmitJob' :: Text
jobName = Text
pJobName_,
      $sel:jobQueue:SubmitJob' :: Text
jobQueue = Text
pJobQueue_,
      $sel:jobDefinition:SubmitJob' :: Text
jobDefinition = Text
pJobDefinition_
    }

-- | The array properties for the submitted job, such as the size of the
-- array. The array size can be between 2 and 10,000. If you specify array
-- properties for a job, it becomes an array job. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/array_jobs.html Array Jobs>
-- in the /Batch User Guide/.
submitJob_arrayProperties :: Lens.Lens' SubmitJob (Prelude.Maybe ArrayProperties)
submitJob_arrayProperties :: Lens' SubmitJob (Maybe ArrayProperties)
submitJob_arrayProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe ArrayProperties
arrayProperties :: Maybe ArrayProperties
$sel:arrayProperties:SubmitJob' :: SubmitJob -> Maybe ArrayProperties
arrayProperties} -> Maybe ArrayProperties
arrayProperties) (\s :: SubmitJob
s@SubmitJob' {} Maybe ArrayProperties
a -> SubmitJob
s {$sel:arrayProperties:SubmitJob' :: Maybe ArrayProperties
arrayProperties = Maybe ArrayProperties
a} :: SubmitJob)

-- | An object with various properties that override the defaults for the job
-- definition that specify the name of a container in the specified job
-- definition and the overrides it should receive. You can override the
-- default command for a container, which is specified in the job
-- definition or the Docker image, with a @command@ override. You can also
-- override existing environment variables on a container or add new
-- environment variables to it with an @environment@ override.
submitJob_containerOverrides :: Lens.Lens' SubmitJob (Prelude.Maybe ContainerOverrides)
submitJob_containerOverrides :: Lens' SubmitJob (Maybe ContainerOverrides)
submitJob_containerOverrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe ContainerOverrides
containerOverrides :: Maybe ContainerOverrides
$sel:containerOverrides:SubmitJob' :: SubmitJob -> Maybe ContainerOverrides
containerOverrides} -> Maybe ContainerOverrides
containerOverrides) (\s :: SubmitJob
s@SubmitJob' {} Maybe ContainerOverrides
a -> SubmitJob
s {$sel:containerOverrides:SubmitJob' :: Maybe ContainerOverrides
containerOverrides = Maybe ContainerOverrides
a} :: SubmitJob)

-- | A list of dependencies for the job. A job can depend upon a maximum of
-- 20 jobs. You can specify a @SEQUENTIAL@ type dependency without
-- specifying a job ID for array jobs so that each child array job
-- completes sequentially, starting at index 0. You can also specify an
-- @N_TO_N@ type dependency with a job ID for array jobs. In that case,
-- each index child of this job must wait for the corresponding index child
-- of each dependency to complete before it can begin.
submitJob_dependsOn :: Lens.Lens' SubmitJob (Prelude.Maybe [JobDependency])
submitJob_dependsOn :: Lens' SubmitJob (Maybe [JobDependency])
submitJob_dependsOn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe [JobDependency]
dependsOn :: Maybe [JobDependency]
$sel:dependsOn:SubmitJob' :: SubmitJob -> Maybe [JobDependency]
dependsOn} -> Maybe [JobDependency]
dependsOn) (\s :: SubmitJob
s@SubmitJob' {} Maybe [JobDependency]
a -> SubmitJob
s {$sel:dependsOn:SubmitJob' :: Maybe [JobDependency]
dependsOn = Maybe [JobDependency]
a} :: SubmitJob) 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 can only be specified for jobs that are run on Amazon EKS
-- resources with various properties that override defaults for the job
-- definition.
submitJob_eksPropertiesOverride :: Lens.Lens' SubmitJob (Prelude.Maybe EksPropertiesOverride)
submitJob_eksPropertiesOverride :: Lens' SubmitJob (Maybe EksPropertiesOverride)
submitJob_eksPropertiesOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe EksPropertiesOverride
eksPropertiesOverride :: Maybe EksPropertiesOverride
$sel:eksPropertiesOverride:SubmitJob' :: SubmitJob -> Maybe EksPropertiesOverride
eksPropertiesOverride} -> Maybe EksPropertiesOverride
eksPropertiesOverride) (\s :: SubmitJob
s@SubmitJob' {} Maybe EksPropertiesOverride
a -> SubmitJob
s {$sel:eksPropertiesOverride:SubmitJob' :: Maybe EksPropertiesOverride
eksPropertiesOverride = Maybe EksPropertiesOverride
a} :: SubmitJob)

-- | A list of node overrides in JSON format that specify the node range to
-- target and the container overrides for that node range.
--
-- This parameter isn\'t applicable to jobs that are running on Fargate
-- resources; use @containerOverrides@ instead.
submitJob_nodeOverrides :: Lens.Lens' SubmitJob (Prelude.Maybe NodeOverrides)
submitJob_nodeOverrides :: Lens' SubmitJob (Maybe NodeOverrides)
submitJob_nodeOverrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe NodeOverrides
nodeOverrides :: Maybe NodeOverrides
$sel:nodeOverrides:SubmitJob' :: SubmitJob -> Maybe NodeOverrides
nodeOverrides} -> Maybe NodeOverrides
nodeOverrides) (\s :: SubmitJob
s@SubmitJob' {} Maybe NodeOverrides
a -> SubmitJob
s {$sel:nodeOverrides:SubmitJob' :: Maybe NodeOverrides
nodeOverrides = Maybe NodeOverrides
a} :: SubmitJob)

-- | Additional parameters passed to the job that replace parameter
-- substitution placeholders that are set in the job definition. Parameters
-- are specified as a key and value pair mapping. Parameters in a
-- @SubmitJob@ request override any corresponding parameter defaults from
-- the job definition.
submitJob_parameters :: Lens.Lens' SubmitJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
submitJob_parameters :: Lens' SubmitJob (Maybe (HashMap Text Text))
submitJob_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Text)
$sel:parameters:SubmitJob' :: SubmitJob -> Maybe (HashMap Text Text)
parameters} -> Maybe (HashMap Text Text)
parameters) (\s :: SubmitJob
s@SubmitJob' {} Maybe (HashMap Text Text)
a -> SubmitJob
s {$sel:parameters:SubmitJob' :: Maybe (HashMap Text Text)
parameters = Maybe (HashMap Text Text)
a} :: SubmitJob) 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 during task
-- creation. 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.
-- When specified, this overrides the tag propagation setting in the job
-- definition.
submitJob_propagateTags :: Lens.Lens' SubmitJob (Prelude.Maybe Prelude.Bool)
submitJob_propagateTags :: Lens' SubmitJob (Maybe Bool)
submitJob_propagateTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe Bool
propagateTags :: Maybe Bool
$sel:propagateTags:SubmitJob' :: SubmitJob -> Maybe Bool
propagateTags} -> Maybe Bool
propagateTags) (\s :: SubmitJob
s@SubmitJob' {} Maybe Bool
a -> SubmitJob
s {$sel:propagateTags:SubmitJob' :: Maybe Bool
propagateTags = Maybe Bool
a} :: SubmitJob)

-- | The retry strategy to use for failed jobs from this SubmitJob operation.
-- When a retry strategy is specified here, it overrides the retry strategy
-- defined in the job definition.
submitJob_retryStrategy :: Lens.Lens' SubmitJob (Prelude.Maybe RetryStrategy)
submitJob_retryStrategy :: Lens' SubmitJob (Maybe RetryStrategy)
submitJob_retryStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe RetryStrategy
retryStrategy :: Maybe RetryStrategy
$sel:retryStrategy:SubmitJob' :: SubmitJob -> Maybe RetryStrategy
retryStrategy} -> Maybe RetryStrategy
retryStrategy) (\s :: SubmitJob
s@SubmitJob' {} Maybe RetryStrategy
a -> SubmitJob
s {$sel:retryStrategy:SubmitJob' :: Maybe RetryStrategy
retryStrategy = Maybe RetryStrategy
a} :: SubmitJob)

-- | The scheduling priority for the job. 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. This
-- overrides any scheduling priority in the job definition.
--
-- The minimum supported value is 0 and the maximum supported value is
-- 9999.
submitJob_schedulingPriorityOverride :: Lens.Lens' SubmitJob (Prelude.Maybe Prelude.Int)
submitJob_schedulingPriorityOverride :: Lens' SubmitJob (Maybe Int)
submitJob_schedulingPriorityOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe Int
schedulingPriorityOverride :: Maybe Int
$sel:schedulingPriorityOverride:SubmitJob' :: SubmitJob -> Maybe Int
schedulingPriorityOverride} -> Maybe Int
schedulingPriorityOverride) (\s :: SubmitJob
s@SubmitJob' {} Maybe Int
a -> SubmitJob
s {$sel:schedulingPriorityOverride:SubmitJob' :: Maybe Int
schedulingPriorityOverride = Maybe Int
a} :: SubmitJob)

-- | The share identifier for the job. If the job queue doesn\'t have a
-- scheduling policy, then this parameter must not be specified. If the job
-- queue has a scheduling policy, then this parameter must be specified.
submitJob_shareIdentifier :: Lens.Lens' SubmitJob (Prelude.Maybe Prelude.Text)
submitJob_shareIdentifier :: Lens' SubmitJob (Maybe Text)
submitJob_shareIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe Text
shareIdentifier :: Maybe Text
$sel:shareIdentifier:SubmitJob' :: SubmitJob -> Maybe Text
shareIdentifier} -> Maybe Text
shareIdentifier) (\s :: SubmitJob
s@SubmitJob' {} Maybe Text
a -> SubmitJob
s {$sel:shareIdentifier:SubmitJob' :: Maybe Text
shareIdentifier = Maybe Text
a} :: SubmitJob)

-- | The tags that you apply to the job request to help you categorize and
-- organize your resources. Each tag consists of a key and an optional
-- value. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- in /Amazon Web Services General Reference/.
submitJob_tags :: Lens.Lens' SubmitJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
submitJob_tags :: Lens' SubmitJob (Maybe (HashMap Text Text))
submitJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:SubmitJob' :: SubmitJob -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: SubmitJob
s@SubmitJob' {} Maybe (HashMap Text Text)
a -> SubmitJob
s {$sel:tags:SubmitJob' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: SubmitJob) 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 this SubmitJob operation. You can specify
-- a timeout duration after which Batch terminates your jobs if they
-- haven\'t finished. If a job is terminated due to a timeout, it isn\'t
-- retried. The minimum value for the timeout is 60 seconds. This
-- configuration overrides any timeout configuration specified in the job
-- definition. For array jobs, child jobs have the same timeout
-- configuration as the parent job. For more information, see
-- <https://docs.aws.amazon.com/AmazonECS/latest/developerguide/job_timeouts.html Job Timeouts>
-- in the /Amazon Elastic Container Service Developer Guide/.
submitJob_timeout :: Lens.Lens' SubmitJob (Prelude.Maybe JobTimeout)
submitJob_timeout :: Lens' SubmitJob (Maybe JobTimeout)
submitJob_timeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Maybe JobTimeout
timeout :: Maybe JobTimeout
$sel:timeout:SubmitJob' :: SubmitJob -> Maybe JobTimeout
timeout} -> Maybe JobTimeout
timeout) (\s :: SubmitJob
s@SubmitJob' {} Maybe JobTimeout
a -> SubmitJob
s {$sel:timeout:SubmitJob' :: Maybe JobTimeout
timeout = Maybe JobTimeout
a} :: SubmitJob)

-- | The name of the job. It can be up to 128 letters long. The first
-- character must be alphanumeric, can contain uppercase and lowercase
-- letters, numbers, hyphens (-), and underscores (_).
submitJob_jobName :: Lens.Lens' SubmitJob Prelude.Text
submitJob_jobName :: Lens' SubmitJob Text
submitJob_jobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Text
jobName :: Text
$sel:jobName:SubmitJob' :: SubmitJob -> Text
jobName} -> Text
jobName) (\s :: SubmitJob
s@SubmitJob' {} Text
a -> SubmitJob
s {$sel:jobName:SubmitJob' :: Text
jobName = Text
a} :: SubmitJob)

-- | The job queue where the job is submitted. You can specify either the
-- name or the Amazon Resource Name (ARN) of the queue.
submitJob_jobQueue :: Lens.Lens' SubmitJob Prelude.Text
submitJob_jobQueue :: Lens' SubmitJob Text
submitJob_jobQueue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Text
jobQueue :: Text
$sel:jobQueue:SubmitJob' :: SubmitJob -> Text
jobQueue} -> Text
jobQueue) (\s :: SubmitJob
s@SubmitJob' {} Text
a -> SubmitJob
s {$sel:jobQueue:SubmitJob' :: Text
jobQueue = Text
a} :: SubmitJob)

-- | The job definition used by this job. This value can be one of @name@,
-- @name:revision@, or the Amazon Resource Name (ARN) for the job
-- definition. If @name@ is specified without a revision then the latest
-- active revision is used.
submitJob_jobDefinition :: Lens.Lens' SubmitJob Prelude.Text
submitJob_jobDefinition :: Lens' SubmitJob Text
submitJob_jobDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SubmitJob' {Text
jobDefinition :: Text
$sel:jobDefinition:SubmitJob' :: SubmitJob -> Text
jobDefinition} -> Text
jobDefinition) (\s :: SubmitJob
s@SubmitJob' {} Text
a -> SubmitJob
s {$sel:jobDefinition:SubmitJob' :: Text
jobDefinition = Text
a} :: SubmitJob)

instance Core.AWSRequest SubmitJob where
  type AWSResponse SubmitJob = SubmitJobResponse
  request :: (Service -> Service) -> SubmitJob -> Request SubmitJob
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy SubmitJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SubmitJob)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> Text -> Text -> SubmitJobResponse
SubmitJobResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"jobArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"jobName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"jobId")
      )

instance Prelude.Hashable SubmitJob where
  hashWithSalt :: Int -> SubmitJob -> Int
hashWithSalt Int
_salt SubmitJob' {Maybe Bool
Maybe Int
Maybe [JobDependency]
Maybe Text
Maybe (HashMap Text Text)
Maybe ArrayProperties
Maybe EksPropertiesOverride
Maybe JobTimeout
Maybe ContainerOverrides
Maybe NodeOverrides
Maybe RetryStrategy
Text
jobDefinition :: Text
jobQueue :: Text
jobName :: Text
timeout :: Maybe JobTimeout
tags :: Maybe (HashMap Text Text)
shareIdentifier :: Maybe Text
schedulingPriorityOverride :: Maybe Int
retryStrategy :: Maybe RetryStrategy
propagateTags :: Maybe Bool
parameters :: Maybe (HashMap Text Text)
nodeOverrides :: Maybe NodeOverrides
eksPropertiesOverride :: Maybe EksPropertiesOverride
dependsOn :: Maybe [JobDependency]
containerOverrides :: Maybe ContainerOverrides
arrayProperties :: Maybe ArrayProperties
$sel:jobDefinition:SubmitJob' :: SubmitJob -> Text
$sel:jobQueue:SubmitJob' :: SubmitJob -> Text
$sel:jobName:SubmitJob' :: SubmitJob -> Text
$sel:timeout:SubmitJob' :: SubmitJob -> Maybe JobTimeout
$sel:tags:SubmitJob' :: SubmitJob -> Maybe (HashMap Text Text)
$sel:shareIdentifier:SubmitJob' :: SubmitJob -> Maybe Text
$sel:schedulingPriorityOverride:SubmitJob' :: SubmitJob -> Maybe Int
$sel:retryStrategy:SubmitJob' :: SubmitJob -> Maybe RetryStrategy
$sel:propagateTags:SubmitJob' :: SubmitJob -> Maybe Bool
$sel:parameters:SubmitJob' :: SubmitJob -> Maybe (HashMap Text Text)
$sel:nodeOverrides:SubmitJob' :: SubmitJob -> Maybe NodeOverrides
$sel:eksPropertiesOverride:SubmitJob' :: SubmitJob -> Maybe EksPropertiesOverride
$sel:dependsOn:SubmitJob' :: SubmitJob -> Maybe [JobDependency]
$sel:containerOverrides:SubmitJob' :: SubmitJob -> Maybe ContainerOverrides
$sel:arrayProperties:SubmitJob' :: SubmitJob -> Maybe ArrayProperties
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ArrayProperties
arrayProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContainerOverrides
containerOverrides
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [JobDependency]
dependsOn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EksPropertiesOverride
eksPropertiesOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NodeOverrides
nodeOverrides
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
parameters
      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
schedulingPriorityOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
shareIdentifier
      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
jobQueue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobDefinition

instance Prelude.NFData SubmitJob where
  rnf :: SubmitJob -> ()
rnf SubmitJob' {Maybe Bool
Maybe Int
Maybe [JobDependency]
Maybe Text
Maybe (HashMap Text Text)
Maybe ArrayProperties
Maybe EksPropertiesOverride
Maybe JobTimeout
Maybe ContainerOverrides
Maybe NodeOverrides
Maybe RetryStrategy
Text
jobDefinition :: Text
jobQueue :: Text
jobName :: Text
timeout :: Maybe JobTimeout
tags :: Maybe (HashMap Text Text)
shareIdentifier :: Maybe Text
schedulingPriorityOverride :: Maybe Int
retryStrategy :: Maybe RetryStrategy
propagateTags :: Maybe Bool
parameters :: Maybe (HashMap Text Text)
nodeOverrides :: Maybe NodeOverrides
eksPropertiesOverride :: Maybe EksPropertiesOverride
dependsOn :: Maybe [JobDependency]
containerOverrides :: Maybe ContainerOverrides
arrayProperties :: Maybe ArrayProperties
$sel:jobDefinition:SubmitJob' :: SubmitJob -> Text
$sel:jobQueue:SubmitJob' :: SubmitJob -> Text
$sel:jobName:SubmitJob' :: SubmitJob -> Text
$sel:timeout:SubmitJob' :: SubmitJob -> Maybe JobTimeout
$sel:tags:SubmitJob' :: SubmitJob -> Maybe (HashMap Text Text)
$sel:shareIdentifier:SubmitJob' :: SubmitJob -> Maybe Text
$sel:schedulingPriorityOverride:SubmitJob' :: SubmitJob -> Maybe Int
$sel:retryStrategy:SubmitJob' :: SubmitJob -> Maybe RetryStrategy
$sel:propagateTags:SubmitJob' :: SubmitJob -> Maybe Bool
$sel:parameters:SubmitJob' :: SubmitJob -> Maybe (HashMap Text Text)
$sel:nodeOverrides:SubmitJob' :: SubmitJob -> Maybe NodeOverrides
$sel:eksPropertiesOverride:SubmitJob' :: SubmitJob -> Maybe EksPropertiesOverride
$sel:dependsOn:SubmitJob' :: SubmitJob -> Maybe [JobDependency]
$sel:containerOverrides:SubmitJob' :: SubmitJob -> Maybe ContainerOverrides
$sel:arrayProperties:SubmitJob' :: SubmitJob -> Maybe ArrayProperties
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ArrayProperties
arrayProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContainerOverrides
containerOverrides
      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 EksPropertiesOverride
eksPropertiesOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NodeOverrides
nodeOverrides
      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 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
schedulingPriorityOverride
      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 (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
jobQueue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobDefinition

instance Data.ToHeaders SubmitJob where
  toHeaders :: SubmitJob -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON SubmitJob where
  toJSON :: SubmitJob -> Value
toJSON SubmitJob' {Maybe Bool
Maybe Int
Maybe [JobDependency]
Maybe Text
Maybe (HashMap Text Text)
Maybe ArrayProperties
Maybe EksPropertiesOverride
Maybe JobTimeout
Maybe ContainerOverrides
Maybe NodeOverrides
Maybe RetryStrategy
Text
jobDefinition :: Text
jobQueue :: Text
jobName :: Text
timeout :: Maybe JobTimeout
tags :: Maybe (HashMap Text Text)
shareIdentifier :: Maybe Text
schedulingPriorityOverride :: Maybe Int
retryStrategy :: Maybe RetryStrategy
propagateTags :: Maybe Bool
parameters :: Maybe (HashMap Text Text)
nodeOverrides :: Maybe NodeOverrides
eksPropertiesOverride :: Maybe EksPropertiesOverride
dependsOn :: Maybe [JobDependency]
containerOverrides :: Maybe ContainerOverrides
arrayProperties :: Maybe ArrayProperties
$sel:jobDefinition:SubmitJob' :: SubmitJob -> Text
$sel:jobQueue:SubmitJob' :: SubmitJob -> Text
$sel:jobName:SubmitJob' :: SubmitJob -> Text
$sel:timeout:SubmitJob' :: SubmitJob -> Maybe JobTimeout
$sel:tags:SubmitJob' :: SubmitJob -> Maybe (HashMap Text Text)
$sel:shareIdentifier:SubmitJob' :: SubmitJob -> Maybe Text
$sel:schedulingPriorityOverride:SubmitJob' :: SubmitJob -> Maybe Int
$sel:retryStrategy:SubmitJob' :: SubmitJob -> Maybe RetryStrategy
$sel:propagateTags:SubmitJob' :: SubmitJob -> Maybe Bool
$sel:parameters:SubmitJob' :: SubmitJob -> Maybe (HashMap Text Text)
$sel:nodeOverrides:SubmitJob' :: SubmitJob -> Maybe NodeOverrides
$sel:eksPropertiesOverride:SubmitJob' :: SubmitJob -> Maybe EksPropertiesOverride
$sel:dependsOn:SubmitJob' :: SubmitJob -> Maybe [JobDependency]
$sel:containerOverrides:SubmitJob' :: SubmitJob -> Maybe ContainerOverrides
$sel:arrayProperties:SubmitJob' :: SubmitJob -> Maybe ArrayProperties
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"arrayProperties" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ArrayProperties
arrayProperties,
            (Key
"containerOverrides" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ContainerOverrides
containerOverrides,
            (Key
"dependsOn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [JobDependency]
dependsOn,
            (Key
"eksPropertiesOverride" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EksPropertiesOverride
eksPropertiesOverride,
            (Key
"nodeOverrides" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe NodeOverrides
nodeOverrides,
            (Key
"parameters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
parameters,
            (Key
"propagateTags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
propagateTags,
            (Key
"retryStrategy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RetryStrategy
retryStrategy,
            (Key
"schedulingPriorityOverride" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
schedulingPriorityOverride,
            (Key
"shareIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
shareIdentifier,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            (Key
"timeout" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe JobTimeout
timeout,
            forall a. a -> Maybe a
Prelude.Just (Key
"jobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobName),
            forall a. a -> Maybe a
Prelude.Just (Key
"jobQueue" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobQueue),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"jobDefinition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobDefinition)
          ]
      )

instance Data.ToPath SubmitJob where
  toPath :: SubmitJob -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/submitjob"

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

-- | /See:/ 'newSubmitJobResponse' smart constructor.
data SubmitJobResponse = SubmitJobResponse'
  { -- | The Amazon Resource Name (ARN) for the job.
    SubmitJobResponse -> Maybe Text
jobArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    SubmitJobResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the job.
    SubmitJobResponse -> Text
jobName :: Prelude.Text,
    -- | The unique identifier for the job.
    SubmitJobResponse -> Text
jobId :: Prelude.Text
  }
  deriving (SubmitJobResponse -> SubmitJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubmitJobResponse -> SubmitJobResponse -> Bool
$c/= :: SubmitJobResponse -> SubmitJobResponse -> Bool
== :: SubmitJobResponse -> SubmitJobResponse -> Bool
$c== :: SubmitJobResponse -> SubmitJobResponse -> Bool
Prelude.Eq, ReadPrec [SubmitJobResponse]
ReadPrec SubmitJobResponse
Int -> ReadS SubmitJobResponse
ReadS [SubmitJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubmitJobResponse]
$creadListPrec :: ReadPrec [SubmitJobResponse]
readPrec :: ReadPrec SubmitJobResponse
$creadPrec :: ReadPrec SubmitJobResponse
readList :: ReadS [SubmitJobResponse]
$creadList :: ReadS [SubmitJobResponse]
readsPrec :: Int -> ReadS SubmitJobResponse
$creadsPrec :: Int -> ReadS SubmitJobResponse
Prelude.Read, Int -> SubmitJobResponse -> ShowS
[SubmitJobResponse] -> ShowS
SubmitJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubmitJobResponse] -> ShowS
$cshowList :: [SubmitJobResponse] -> ShowS
show :: SubmitJobResponse -> String
$cshow :: SubmitJobResponse -> String
showsPrec :: Int -> SubmitJobResponse -> ShowS
$cshowsPrec :: Int -> SubmitJobResponse -> ShowS
Prelude.Show, forall x. Rep SubmitJobResponse x -> SubmitJobResponse
forall x. SubmitJobResponse -> Rep SubmitJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubmitJobResponse x -> SubmitJobResponse
$cfrom :: forall x. SubmitJobResponse -> Rep SubmitJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'SubmitJobResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'jobArn', 'submitJobResponse_jobArn' - The Amazon Resource Name (ARN) for the job.
--
-- 'httpStatus', 'submitJobResponse_httpStatus' - The response's http status code.
--
-- 'jobName', 'submitJobResponse_jobName' - The name of the job.
--
-- 'jobId', 'submitJobResponse_jobId' - The unique identifier for the job.
newSubmitJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'jobName'
  Prelude.Text ->
  -- | 'jobId'
  Prelude.Text ->
  SubmitJobResponse
newSubmitJobResponse :: Int -> Text -> Text -> SubmitJobResponse
newSubmitJobResponse Int
pHttpStatus_ Text
pJobName_ Text
pJobId_ =
  SubmitJobResponse'
    { $sel:jobArn:SubmitJobResponse' :: Maybe Text
jobArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SubmitJobResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:jobName:SubmitJobResponse' :: Text
jobName = Text
pJobName_,
      $sel:jobId:SubmitJobResponse' :: Text
jobId = Text
pJobId_
    }

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

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

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

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

instance Prelude.NFData SubmitJobResponse where
  rnf :: SubmitJobResponse -> ()
rnf SubmitJobResponse' {Int
Maybe Text
Text
jobId :: Text
jobName :: Text
httpStatus :: Int
jobArn :: Maybe Text
$sel:jobId:SubmitJobResponse' :: SubmitJobResponse -> Text
$sel:jobName:SubmitJobResponse' :: SubmitJobResponse -> Text
$sel:httpStatus:SubmitJobResponse' :: SubmitJobResponse -> Int
$sel:jobArn:SubmitJobResponse' :: SubmitJobResponse -> Maybe Text
..} =
    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 Int
httpStatus
      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