{-# 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.RegisterJobDefinition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers an Batch job definition.
module Amazonka.Batch.RegisterJobDefinition
  ( -- * Creating a Request
    RegisterJobDefinition (..),
    newRegisterJobDefinition,

    -- * Request Lenses
    registerJobDefinition_containerProperties,
    registerJobDefinition_eksProperties,
    registerJobDefinition_nodeProperties,
    registerJobDefinition_parameters,
    registerJobDefinition_platformCapabilities,
    registerJobDefinition_propagateTags,
    registerJobDefinition_retryStrategy,
    registerJobDefinition_schedulingPriority,
    registerJobDefinition_tags,
    registerJobDefinition_timeout,
    registerJobDefinition_jobDefinitionName,
    registerJobDefinition_type,

    -- * Destructuring the Response
    RegisterJobDefinitionResponse (..),
    newRegisterJobDefinitionResponse,

    -- * Response Lenses
    registerJobDefinitionResponse_httpStatus,
    registerJobDefinitionResponse_jobDefinitionName,
    registerJobDefinitionResponse_jobDefinitionArn,
    registerJobDefinitionResponse_revision,
  )
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 @RegisterJobDefinition@.
--
-- /See:/ 'newRegisterJobDefinition' smart constructor.
data RegisterJobDefinition = RegisterJobDefinition'
  { -- | An object with various properties specific to Amazon ECS based
    -- single-node container-based jobs. If the job definition\'s @type@
    -- parameter is @container@, then you must specify either
    -- @containerProperties@ or @nodeProperties@. This must not be specified
    -- for Amazon EKS based job definitions.
    --
    -- If the job runs on Fargate resources, then you must not specify
    -- @nodeProperties@; use only @containerProperties@.
    RegisterJobDefinition -> Maybe ContainerProperties
containerProperties :: Prelude.Maybe ContainerProperties,
    -- | An object with various properties that are specific to Amazon EKS based
    -- jobs. This must not be specified for Amazon ECS based job definitions.
    RegisterJobDefinition -> Maybe EksProperties
eksProperties :: Prelude.Maybe EksProperties,
    -- | An object with various properties specific to multi-node parallel jobs.
    -- If you specify node properties for a job, it becomes a multi-node
    -- parallel job. For more information, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/multi-node-parallel-jobs.html Multi-node Parallel Jobs>
    -- in the /Batch User Guide/. If the job definition\'s @type@ parameter is
    -- @container@, then you must specify either @containerProperties@ or
    -- @nodeProperties@.
    --
    -- If the job runs on Fargate resources, then you must not specify
    -- @nodeProperties@; use @containerProperties@ instead.
    --
    -- If the job runs on Amazon EKS resources, then you must not specify
    -- @nodeProperties@.
    RegisterJobDefinition -> Maybe NodeProperties
nodeProperties :: Prelude.Maybe NodeProperties,
    -- | Default parameter substitution placeholders to 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.
    RegisterJobDefinition -> 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@. To run the job on Fargate resources,
    -- specify @FARGATE@.
    --
    -- If the job runs on Amazon EKS resources, then you must not specify
    -- @platformCapabilities@.
    RegisterJobDefinition -> 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
    -- are not 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.
    --
    -- If the job runs on Amazon EKS resources, then you must not specify
    -- @propagateTags@.
    RegisterJobDefinition -> Maybe Bool
propagateTags :: Prelude.Maybe Prelude.Bool,
    -- | The retry strategy to use for failed jobs that are submitted with this
    -- job definition. Any retry strategy that\'s specified during a SubmitJob
    -- operation overrides the retry strategy defined here. If a job is
    -- terminated due to a timeout, it isn\'t retried.
    RegisterJobDefinition -> Maybe RetryStrategy
retryStrategy :: Prelude.Maybe RetryStrategy,
    -- | The scheduling priority for jobs that are submitted with this 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.
    --
    -- The minimum supported value is 0 and the maximum supported value is
    -- 9999.
    RegisterJobDefinition -> Maybe Int
schedulingPriority :: Prelude.Maybe Prelude.Int,
    -- | The tags that you apply to the job definition 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/batch/latest/userguide/using-tags.html Tagging Amazon Web Services Resources>
    -- in /Batch User Guide/.
    RegisterJobDefinition -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The timeout configuration for jobs that are submitted with this job
    -- definition, after which Batch terminates your jobs if they have not
    -- finished. If a job is terminated due to a timeout, it isn\'t retried.
    -- The minimum value for the timeout is 60 seconds. Any timeout
    -- configuration that\'s specified during a SubmitJob operation overrides
    -- the timeout configuration defined here. For more information, see
    -- <https://docs.aws.amazon.com/batch/latest/userguide/job_timeouts.html Job Timeouts>
    -- in the /Batch User Guide/.
    RegisterJobDefinition -> Maybe JobTimeout
timeout :: Prelude.Maybe JobTimeout,
    -- | The name of the job definition to register. It can be up to 128 letters
    -- long. It can contain uppercase and lowercase letters, numbers, hyphens
    -- (-), and underscores (_).
    RegisterJobDefinition -> Text
jobDefinitionName :: Prelude.Text,
    -- | The type of job definition. 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/.
    --
    -- If the job is run on Fargate resources, then @multinode@ isn\'t
    -- supported.
    RegisterJobDefinition -> JobDefinitionType
type' :: JobDefinitionType
  }
  deriving (RegisterJobDefinition -> RegisterJobDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterJobDefinition -> RegisterJobDefinition -> Bool
$c/= :: RegisterJobDefinition -> RegisterJobDefinition -> Bool
== :: RegisterJobDefinition -> RegisterJobDefinition -> Bool
$c== :: RegisterJobDefinition -> RegisterJobDefinition -> Bool
Prelude.Eq, ReadPrec [RegisterJobDefinition]
ReadPrec RegisterJobDefinition
Int -> ReadS RegisterJobDefinition
ReadS [RegisterJobDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterJobDefinition]
$creadListPrec :: ReadPrec [RegisterJobDefinition]
readPrec :: ReadPrec RegisterJobDefinition
$creadPrec :: ReadPrec RegisterJobDefinition
readList :: ReadS [RegisterJobDefinition]
$creadList :: ReadS [RegisterJobDefinition]
readsPrec :: Int -> ReadS RegisterJobDefinition
$creadsPrec :: Int -> ReadS RegisterJobDefinition
Prelude.Read, Int -> RegisterJobDefinition -> ShowS
[RegisterJobDefinition] -> ShowS
RegisterJobDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterJobDefinition] -> ShowS
$cshowList :: [RegisterJobDefinition] -> ShowS
show :: RegisterJobDefinition -> String
$cshow :: RegisterJobDefinition -> String
showsPrec :: Int -> RegisterJobDefinition -> ShowS
$cshowsPrec :: Int -> RegisterJobDefinition -> ShowS
Prelude.Show, forall x. Rep RegisterJobDefinition x -> RegisterJobDefinition
forall x. RegisterJobDefinition -> Rep RegisterJobDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterJobDefinition x -> RegisterJobDefinition
$cfrom :: forall x. RegisterJobDefinition -> Rep RegisterJobDefinition x
Prelude.Generic)

-- |
-- Create a value of 'RegisterJobDefinition' 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:
--
-- 'containerProperties', 'registerJobDefinition_containerProperties' - An object with various properties specific to Amazon ECS based
-- single-node container-based jobs. If the job definition\'s @type@
-- parameter is @container@, then you must specify either
-- @containerProperties@ or @nodeProperties@. This must not be specified
-- for Amazon EKS based job definitions.
--
-- If the job runs on Fargate resources, then you must not specify
-- @nodeProperties@; use only @containerProperties@.
--
-- 'eksProperties', 'registerJobDefinition_eksProperties' - An object with various properties that are specific to Amazon EKS based
-- jobs. This must not be specified for Amazon ECS based job definitions.
--
-- 'nodeProperties', 'registerJobDefinition_nodeProperties' - An object with various properties specific to multi-node parallel jobs.
-- If you specify node properties for a job, it becomes a multi-node
-- parallel job. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/multi-node-parallel-jobs.html Multi-node Parallel Jobs>
-- in the /Batch User Guide/. If the job definition\'s @type@ parameter is
-- @container@, then you must specify either @containerProperties@ or
-- @nodeProperties@.
--
-- If the job runs on Fargate resources, then you must not specify
-- @nodeProperties@; use @containerProperties@ instead.
--
-- If the job runs on Amazon EKS resources, then you must not specify
-- @nodeProperties@.
--
-- 'parameters', 'registerJobDefinition_parameters' - Default parameter substitution placeholders to 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.
--
-- 'platformCapabilities', 'registerJobDefinition_platformCapabilities' - The platform capabilities required by the job definition. If no value is
-- specified, it defaults to @EC2@. To run the job on Fargate resources,
-- specify @FARGATE@.
--
-- If the job runs on Amazon EKS resources, then you must not specify
-- @platformCapabilities@.
--
-- 'propagateTags', 'registerJobDefinition_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
-- are not 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.
--
-- If the job runs on Amazon EKS resources, then you must not specify
-- @propagateTags@.
--
-- 'retryStrategy', 'registerJobDefinition_retryStrategy' - The retry strategy to use for failed jobs that are submitted with this
-- job definition. Any retry strategy that\'s specified during a SubmitJob
-- operation overrides the retry strategy defined here. If a job is
-- terminated due to a timeout, it isn\'t retried.
--
-- 'schedulingPriority', 'registerJobDefinition_schedulingPriority' - The scheduling priority for jobs that are submitted with this 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.
--
-- The minimum supported value is 0 and the maximum supported value is
-- 9999.
--
-- 'tags', 'registerJobDefinition_tags' - The tags that you apply to the job definition 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/batch/latest/userguide/using-tags.html Tagging Amazon Web Services Resources>
-- in /Batch User Guide/.
--
-- 'timeout', 'registerJobDefinition_timeout' - The timeout configuration for jobs that are submitted with this job
-- definition, after which Batch terminates your jobs if they have not
-- finished. If a job is terminated due to a timeout, it isn\'t retried.
-- The minimum value for the timeout is 60 seconds. Any timeout
-- configuration that\'s specified during a SubmitJob operation overrides
-- the timeout configuration defined here. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/job_timeouts.html Job Timeouts>
-- in the /Batch User Guide/.
--
-- 'jobDefinitionName', 'registerJobDefinition_jobDefinitionName' - The name of the job definition to register. It can be up to 128 letters
-- long. It can contain uppercase and lowercase letters, numbers, hyphens
-- (-), and underscores (_).
--
-- 'type'', 'registerJobDefinition_type' - The type of job definition. 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/.
--
-- If the job is run on Fargate resources, then @multinode@ isn\'t
-- supported.
newRegisterJobDefinition ::
  -- | 'jobDefinitionName'
  Prelude.Text ->
  -- | 'type''
  JobDefinitionType ->
  RegisterJobDefinition
newRegisterJobDefinition :: Text -> JobDefinitionType -> RegisterJobDefinition
newRegisterJobDefinition Text
pJobDefinitionName_ JobDefinitionType
pType_ =
  RegisterJobDefinition'
    { $sel:containerProperties:RegisterJobDefinition' :: Maybe ContainerProperties
containerProperties =
        forall a. Maybe a
Prelude.Nothing,
      $sel:eksProperties:RegisterJobDefinition' :: Maybe EksProperties
eksProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:nodeProperties:RegisterJobDefinition' :: Maybe NodeProperties
nodeProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:parameters:RegisterJobDefinition' :: Maybe (HashMap Text Text)
parameters = forall a. Maybe a
Prelude.Nothing,
      $sel:platformCapabilities:RegisterJobDefinition' :: Maybe [PlatformCapability]
platformCapabilities = forall a. Maybe a
Prelude.Nothing,
      $sel:propagateTags:RegisterJobDefinition' :: Maybe Bool
propagateTags = forall a. Maybe a
Prelude.Nothing,
      $sel:retryStrategy:RegisterJobDefinition' :: Maybe RetryStrategy
retryStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:schedulingPriority:RegisterJobDefinition' :: Maybe Int
schedulingPriority = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:RegisterJobDefinition' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:timeout:RegisterJobDefinition' :: Maybe JobTimeout
timeout = forall a. Maybe a
Prelude.Nothing,
      $sel:jobDefinitionName:RegisterJobDefinition' :: Text
jobDefinitionName = Text
pJobDefinitionName_,
      $sel:type':RegisterJobDefinition' :: JobDefinitionType
type' = JobDefinitionType
pType_
    }

-- | An object with various properties specific to Amazon ECS based
-- single-node container-based jobs. If the job definition\'s @type@
-- parameter is @container@, then you must specify either
-- @containerProperties@ or @nodeProperties@. This must not be specified
-- for Amazon EKS based job definitions.
--
-- If the job runs on Fargate resources, then you must not specify
-- @nodeProperties@; use only @containerProperties@.
registerJobDefinition_containerProperties :: Lens.Lens' RegisterJobDefinition (Prelude.Maybe ContainerProperties)
registerJobDefinition_containerProperties :: Lens' RegisterJobDefinition (Maybe ContainerProperties)
registerJobDefinition_containerProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Maybe ContainerProperties
containerProperties :: Maybe ContainerProperties
$sel:containerProperties:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe ContainerProperties
containerProperties} -> Maybe ContainerProperties
containerProperties) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Maybe ContainerProperties
a -> RegisterJobDefinition
s {$sel:containerProperties:RegisterJobDefinition' :: Maybe ContainerProperties
containerProperties = Maybe ContainerProperties
a} :: RegisterJobDefinition)

-- | An object with various properties that are specific to Amazon EKS based
-- jobs. This must not be specified for Amazon ECS based job definitions.
registerJobDefinition_eksProperties :: Lens.Lens' RegisterJobDefinition (Prelude.Maybe EksProperties)
registerJobDefinition_eksProperties :: Lens' RegisterJobDefinition (Maybe EksProperties)
registerJobDefinition_eksProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Maybe EksProperties
eksProperties :: Maybe EksProperties
$sel:eksProperties:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe EksProperties
eksProperties} -> Maybe EksProperties
eksProperties) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Maybe EksProperties
a -> RegisterJobDefinition
s {$sel:eksProperties:RegisterJobDefinition' :: Maybe EksProperties
eksProperties = Maybe EksProperties
a} :: RegisterJobDefinition)

-- | An object with various properties specific to multi-node parallel jobs.
-- If you specify node properties for a job, it becomes a multi-node
-- parallel job. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/multi-node-parallel-jobs.html Multi-node Parallel Jobs>
-- in the /Batch User Guide/. If the job definition\'s @type@ parameter is
-- @container@, then you must specify either @containerProperties@ or
-- @nodeProperties@.
--
-- If the job runs on Fargate resources, then you must not specify
-- @nodeProperties@; use @containerProperties@ instead.
--
-- If the job runs on Amazon EKS resources, then you must not specify
-- @nodeProperties@.
registerJobDefinition_nodeProperties :: Lens.Lens' RegisterJobDefinition (Prelude.Maybe NodeProperties)
registerJobDefinition_nodeProperties :: Lens' RegisterJobDefinition (Maybe NodeProperties)
registerJobDefinition_nodeProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Maybe NodeProperties
nodeProperties :: Maybe NodeProperties
$sel:nodeProperties:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe NodeProperties
nodeProperties} -> Maybe NodeProperties
nodeProperties) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Maybe NodeProperties
a -> RegisterJobDefinition
s {$sel:nodeProperties:RegisterJobDefinition' :: Maybe NodeProperties
nodeProperties = Maybe NodeProperties
a} :: RegisterJobDefinition)

-- | Default parameter substitution placeholders to 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.
registerJobDefinition_parameters :: Lens.Lens' RegisterJobDefinition (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
registerJobDefinition_parameters :: Lens' RegisterJobDefinition (Maybe (HashMap Text Text))
registerJobDefinition_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Maybe (HashMap Text Text)
parameters :: Maybe (HashMap Text Text)
$sel:parameters:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe (HashMap Text Text)
parameters} -> Maybe (HashMap Text Text)
parameters) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Maybe (HashMap Text Text)
a -> RegisterJobDefinition
s {$sel:parameters:RegisterJobDefinition' :: Maybe (HashMap Text Text)
parameters = Maybe (HashMap Text Text)
a} :: RegisterJobDefinition) 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@. To run the job on Fargate resources,
-- specify @FARGATE@.
--
-- If the job runs on Amazon EKS resources, then you must not specify
-- @platformCapabilities@.
registerJobDefinition_platformCapabilities :: Lens.Lens' RegisterJobDefinition (Prelude.Maybe [PlatformCapability])
registerJobDefinition_platformCapabilities :: Lens' RegisterJobDefinition (Maybe [PlatformCapability])
registerJobDefinition_platformCapabilities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Maybe [PlatformCapability]
platformCapabilities :: Maybe [PlatformCapability]
$sel:platformCapabilities:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe [PlatformCapability]
platformCapabilities} -> Maybe [PlatformCapability]
platformCapabilities) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Maybe [PlatformCapability]
a -> RegisterJobDefinition
s {$sel:platformCapabilities:RegisterJobDefinition' :: Maybe [PlatformCapability]
platformCapabilities = Maybe [PlatformCapability]
a} :: RegisterJobDefinition) 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
-- are not 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.
--
-- If the job runs on Amazon EKS resources, then you must not specify
-- @propagateTags@.
registerJobDefinition_propagateTags :: Lens.Lens' RegisterJobDefinition (Prelude.Maybe Prelude.Bool)
registerJobDefinition_propagateTags :: Lens' RegisterJobDefinition (Maybe Bool)
registerJobDefinition_propagateTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Maybe Bool
propagateTags :: Maybe Bool
$sel:propagateTags:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe Bool
propagateTags} -> Maybe Bool
propagateTags) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Maybe Bool
a -> RegisterJobDefinition
s {$sel:propagateTags:RegisterJobDefinition' :: Maybe Bool
propagateTags = Maybe Bool
a} :: RegisterJobDefinition)

-- | The retry strategy to use for failed jobs that are submitted with this
-- job definition. Any retry strategy that\'s specified during a SubmitJob
-- operation overrides the retry strategy defined here. If a job is
-- terminated due to a timeout, it isn\'t retried.
registerJobDefinition_retryStrategy :: Lens.Lens' RegisterJobDefinition (Prelude.Maybe RetryStrategy)
registerJobDefinition_retryStrategy :: Lens' RegisterJobDefinition (Maybe RetryStrategy)
registerJobDefinition_retryStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Maybe RetryStrategy
retryStrategy :: Maybe RetryStrategy
$sel:retryStrategy:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe RetryStrategy
retryStrategy} -> Maybe RetryStrategy
retryStrategy) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Maybe RetryStrategy
a -> RegisterJobDefinition
s {$sel:retryStrategy:RegisterJobDefinition' :: Maybe RetryStrategy
retryStrategy = Maybe RetryStrategy
a} :: RegisterJobDefinition)

-- | The scheduling priority for jobs that are submitted with this 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.
--
-- The minimum supported value is 0 and the maximum supported value is
-- 9999.
registerJobDefinition_schedulingPriority :: Lens.Lens' RegisterJobDefinition (Prelude.Maybe Prelude.Int)
registerJobDefinition_schedulingPriority :: Lens' RegisterJobDefinition (Maybe Int)
registerJobDefinition_schedulingPriority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Maybe Int
schedulingPriority :: Maybe Int
$sel:schedulingPriority:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe Int
schedulingPriority} -> Maybe Int
schedulingPriority) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Maybe Int
a -> RegisterJobDefinition
s {$sel:schedulingPriority:RegisterJobDefinition' :: Maybe Int
schedulingPriority = Maybe Int
a} :: RegisterJobDefinition)

-- | The tags that you apply to the job definition 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/batch/latest/userguide/using-tags.html Tagging Amazon Web Services Resources>
-- in /Batch User Guide/.
registerJobDefinition_tags :: Lens.Lens' RegisterJobDefinition (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
registerJobDefinition_tags :: Lens' RegisterJobDefinition (Maybe (HashMap Text Text))
registerJobDefinition_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Maybe (HashMap Text Text)
a -> RegisterJobDefinition
s {$sel:tags:RegisterJobDefinition' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: RegisterJobDefinition) 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 jobs that are submitted with this job
-- definition, after which Batch terminates your jobs if they have not
-- finished. If a job is terminated due to a timeout, it isn\'t retried.
-- The minimum value for the timeout is 60 seconds. Any timeout
-- configuration that\'s specified during a SubmitJob operation overrides
-- the timeout configuration defined here. For more information, see
-- <https://docs.aws.amazon.com/batch/latest/userguide/job_timeouts.html Job Timeouts>
-- in the /Batch User Guide/.
registerJobDefinition_timeout :: Lens.Lens' RegisterJobDefinition (Prelude.Maybe JobTimeout)
registerJobDefinition_timeout :: Lens' RegisterJobDefinition (Maybe JobTimeout)
registerJobDefinition_timeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Maybe JobTimeout
timeout :: Maybe JobTimeout
$sel:timeout:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe JobTimeout
timeout} -> Maybe JobTimeout
timeout) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Maybe JobTimeout
a -> RegisterJobDefinition
s {$sel:timeout:RegisterJobDefinition' :: Maybe JobTimeout
timeout = Maybe JobTimeout
a} :: RegisterJobDefinition)

-- | The name of the job definition to register. It can be up to 128 letters
-- long. It can contain uppercase and lowercase letters, numbers, hyphens
-- (-), and underscores (_).
registerJobDefinition_jobDefinitionName :: Lens.Lens' RegisterJobDefinition Prelude.Text
registerJobDefinition_jobDefinitionName :: Lens' RegisterJobDefinition Text
registerJobDefinition_jobDefinitionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {Text
jobDefinitionName :: Text
$sel:jobDefinitionName:RegisterJobDefinition' :: RegisterJobDefinition -> Text
jobDefinitionName} -> Text
jobDefinitionName) (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} Text
a -> RegisterJobDefinition
s {$sel:jobDefinitionName:RegisterJobDefinition' :: Text
jobDefinitionName = Text
a} :: RegisterJobDefinition)

-- | The type of job definition. 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/.
--
-- If the job is run on Fargate resources, then @multinode@ isn\'t
-- supported.
registerJobDefinition_type :: Lens.Lens' RegisterJobDefinition JobDefinitionType
registerJobDefinition_type :: Lens' RegisterJobDefinition JobDefinitionType
registerJobDefinition_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterJobDefinition' {JobDefinitionType
type' :: JobDefinitionType
$sel:type':RegisterJobDefinition' :: RegisterJobDefinition -> JobDefinitionType
type'} -> JobDefinitionType
type') (\s :: RegisterJobDefinition
s@RegisterJobDefinition' {} JobDefinitionType
a -> RegisterJobDefinition
s {$sel:type':RegisterJobDefinition' :: JobDefinitionType
type' = JobDefinitionType
a} :: RegisterJobDefinition)

instance Core.AWSRequest RegisterJobDefinition where
  type
    AWSResponse RegisterJobDefinition =
      RegisterJobDefinitionResponse
  request :: (Service -> Service)
-> RegisterJobDefinition -> Request RegisterJobDefinition
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 RegisterJobDefinition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RegisterJobDefinition)))
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 ->
          Int -> Text -> Text -> Int -> RegisterJobDefinitionResponse
RegisterJobDefinitionResponse'
            forall (f :: * -> *) a b. Functor 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
"jobDefinitionName")
            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
"jobDefinitionArn")
            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
"revision")
      )

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

instance Prelude.NFData RegisterJobDefinition where
  rnf :: RegisterJobDefinition -> ()
rnf RegisterJobDefinition' {Maybe Bool
Maybe Int
Maybe [PlatformCapability]
Maybe (HashMap Text Text)
Maybe EksProperties
Maybe JobTimeout
Maybe RetryStrategy
Maybe ContainerProperties
Maybe NodeProperties
Text
JobDefinitionType
type' :: JobDefinitionType
jobDefinitionName :: Text
timeout :: Maybe JobTimeout
tags :: Maybe (HashMap Text 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
$sel:type':RegisterJobDefinition' :: RegisterJobDefinition -> JobDefinitionType
$sel:jobDefinitionName:RegisterJobDefinition' :: RegisterJobDefinition -> Text
$sel:timeout:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe JobTimeout
$sel:tags:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe (HashMap Text Text)
$sel:schedulingPriority:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe Int
$sel:retryStrategy:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe RetryStrategy
$sel:propagateTags:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe Bool
$sel:platformCapabilities:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe [PlatformCapability]
$sel:parameters:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe (HashMap Text Text)
$sel:nodeProperties:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe NodeProperties
$sel:eksProperties:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe EksProperties
$sel:containerProperties:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe ContainerProperties
..} =
    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 (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 JobDefinitionType
type'

instance Data.ToHeaders RegisterJobDefinition where
  toHeaders :: RegisterJobDefinition -> 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 RegisterJobDefinition where
  toJSON :: RegisterJobDefinition -> Value
toJSON RegisterJobDefinition' {Maybe Bool
Maybe Int
Maybe [PlatformCapability]
Maybe (HashMap Text Text)
Maybe EksProperties
Maybe JobTimeout
Maybe RetryStrategy
Maybe ContainerProperties
Maybe NodeProperties
Text
JobDefinitionType
type' :: JobDefinitionType
jobDefinitionName :: Text
timeout :: Maybe JobTimeout
tags :: Maybe (HashMap Text 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
$sel:type':RegisterJobDefinition' :: RegisterJobDefinition -> JobDefinitionType
$sel:jobDefinitionName:RegisterJobDefinition' :: RegisterJobDefinition -> Text
$sel:timeout:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe JobTimeout
$sel:tags:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe (HashMap Text Text)
$sel:schedulingPriority:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe Int
$sel:retryStrategy:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe RetryStrategy
$sel:propagateTags:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe Bool
$sel:platformCapabilities:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe [PlatformCapability]
$sel:parameters:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe (HashMap Text Text)
$sel:nodeProperties:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe NodeProperties
$sel:eksProperties:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe EksProperties
$sel:containerProperties:RegisterJobDefinition' :: RegisterJobDefinition -> Maybe ContainerProperties
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"containerProperties" 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 ContainerProperties
containerProperties,
            (Key
"eksProperties" 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 EksProperties
eksProperties,
            (Key
"nodeProperties" 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 NodeProperties
nodeProperties,
            (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
"platformCapabilities" 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 [PlatformCapability]
platformCapabilities,
            (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
"schedulingPriority" 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
schedulingPriority,
            (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
"jobDefinitionName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobDefinitionName),
            forall a. a -> Maybe a
Prelude.Just (Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= JobDefinitionType
type')
          ]
      )

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

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

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

-- |
-- Create a value of 'RegisterJobDefinitionResponse' 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:
--
-- 'httpStatus', 'registerJobDefinitionResponse_httpStatus' - The response's http status code.
--
-- 'jobDefinitionName', 'registerJobDefinitionResponse_jobDefinitionName' - The name of the job definition.
--
-- 'jobDefinitionArn', 'registerJobDefinitionResponse_jobDefinitionArn' - The Amazon Resource Name (ARN) of the job definition.
--
-- 'revision', 'registerJobDefinitionResponse_revision' - The revision of the job definition.
newRegisterJobDefinitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'jobDefinitionName'
  Prelude.Text ->
  -- | 'jobDefinitionArn'
  Prelude.Text ->
  -- | 'revision'
  Prelude.Int ->
  RegisterJobDefinitionResponse
newRegisterJobDefinitionResponse :: Int -> Text -> Text -> Int -> RegisterJobDefinitionResponse
newRegisterJobDefinitionResponse
  Int
pHttpStatus_
  Text
pJobDefinitionName_
  Text
pJobDefinitionArn_
  Int
pRevision_ =
    RegisterJobDefinitionResponse'
      { $sel:httpStatus:RegisterJobDefinitionResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:jobDefinitionName:RegisterJobDefinitionResponse' :: Text
jobDefinitionName = Text
pJobDefinitionName_,
        $sel:jobDefinitionArn:RegisterJobDefinitionResponse' :: Text
jobDefinitionArn = Text
pJobDefinitionArn_,
        $sel:revision:RegisterJobDefinitionResponse' :: Int
revision = Int
pRevision_
      }

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

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

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

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

instance Prelude.NFData RegisterJobDefinitionResponse where
  rnf :: RegisterJobDefinitionResponse -> ()
rnf RegisterJobDefinitionResponse' {Int
Text
revision :: Int
jobDefinitionArn :: Text
jobDefinitionName :: Text
httpStatus :: Int
$sel:revision:RegisterJobDefinitionResponse' :: RegisterJobDefinitionResponse -> Int
$sel:jobDefinitionArn:RegisterJobDefinitionResponse' :: RegisterJobDefinitionResponse -> Text
$sel:jobDefinitionName:RegisterJobDefinitionResponse' :: RegisterJobDefinitionResponse -> Text
$sel:httpStatus:RegisterJobDefinitionResponse' :: RegisterJobDefinitionResponse -> Int
..} =
    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
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