{-# 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.IoT.CreateJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a job.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreateJob>
-- action.
module Amazonka.IoT.CreateJob
  ( -- * Creating a Request
    CreateJob (..),
    newCreateJob,

    -- * Request Lenses
    createJob_abortConfig,
    createJob_description,
    createJob_document,
    createJob_documentParameters,
    createJob_documentSource,
    createJob_jobExecutionsRetryConfig,
    createJob_jobExecutionsRolloutConfig,
    createJob_jobTemplateArn,
    createJob_namespaceId,
    createJob_presignedUrlConfig,
    createJob_schedulingConfig,
    createJob_tags,
    createJob_targetSelection,
    createJob_timeoutConfig,
    createJob_jobId,
    createJob_targets,

    -- * Destructuring the Response
    CreateJobResponse (..),
    newCreateJobResponse,

    -- * Response Lenses
    createJobResponse_description,
    createJobResponse_jobArn,
    createJobResponse_jobId,
    createJobResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateJob' smart constructor.
data CreateJob = CreateJob'
  { -- | Allows you to create the criteria to abort a job.
    CreateJob -> Maybe AbortConfig
abortConfig :: Prelude.Maybe AbortConfig,
    -- | A short text description of the job.
    CreateJob -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The job document. Required if you don\'t specify a value for
    -- @documentSource@.
    CreateJob -> Maybe Text
document :: Prelude.Maybe Prelude.Text,
    -- | Parameters of an Amazon Web Services managed template that you can
    -- specify to create the job document.
    --
    -- @documentParameters@ can only be used when creating jobs from Amazon Web
    -- Services managed templates. This parameter can\'t be used with custom
    -- job templates or to create jobs from them.
    CreateJob -> Maybe (HashMap Text Text)
documentParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | An S3 link to the job document. Required if you don\'t specify a value
    -- for @document@.
    --
    -- If the job document resides in an S3 bucket, you must use a placeholder
    -- link when specifying the document.
    --
    -- The placeholder link is of the following form:
    --
    -- @${aws:iot:s3-presigned-url:https:\/\/s3.amazonaws.com\/@/@bucket@/@\/@/@key@/@}@
    --
    -- where /bucket/ is your bucket name and /key/ is the object in the bucket
    -- to which you are linking.
    CreateJob -> Maybe Text
documentSource :: Prelude.Maybe Prelude.Text,
    -- | Allows you to create the criteria to retry a job.
    CreateJob -> Maybe JobExecutionsRetryConfig
jobExecutionsRetryConfig :: Prelude.Maybe JobExecutionsRetryConfig,
    -- | Allows you to create a staged rollout of the job.
    CreateJob -> Maybe JobExecutionsRolloutConfig
jobExecutionsRolloutConfig :: Prelude.Maybe JobExecutionsRolloutConfig,
    -- | The ARN of the job template used to create the job.
    CreateJob -> Maybe Text
jobTemplateArn :: Prelude.Maybe Prelude.Text,
    -- | The namespace used to indicate that a job is a customer-managed job.
    --
    -- When you specify a value for this parameter, Amazon Web Services IoT
    -- Core sends jobs notifications to MQTT topics that contain the value in
    -- the following format.
    --
    -- @$aws\/things\/@/@THING_NAME@/@\/jobs\/@/@JOB_ID@/@\/notify-namespace-@/@NAMESPACE_ID@/@\/@
    --
    -- The @namespaceId@ feature is in public preview.
    CreateJob -> Maybe Text
namespaceId :: Prelude.Maybe Prelude.Text,
    -- | Configuration information for pre-signed S3 URLs.
    CreateJob -> Maybe PresignedUrlConfig
presignedUrlConfig :: Prelude.Maybe PresignedUrlConfig,
    -- | The configuration that allows you to schedule a job for a future date
    -- and time in addition to specifying the end behavior for each job
    -- execution.
    CreateJob -> Maybe SchedulingConfig
schedulingConfig :: Prelude.Maybe SchedulingConfig,
    -- | Metadata which can be used to manage the job.
    CreateJob -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Specifies whether the job will continue to run (CONTINUOUS), or will be
    -- complete after all those things specified as targets have completed the
    -- job (SNAPSHOT). If continuous, the job may also be run on a thing when a
    -- change is detected in a target. For example, a job will run on a thing
    -- when the thing is added to a target group, even after the job was
    -- completed by all things originally in the group.
    --
    -- We recommend that you use continuous jobs instead of snapshot jobs for
    -- dynamic thing group targets. By using continuous jobs, devices that join
    -- the group receive the job execution even after the job has been created.
    CreateJob -> Maybe TargetSelection
targetSelection :: Prelude.Maybe TargetSelection,
    -- | Specifies the amount of time each device has to finish its execution of
    -- the job. The timer is started when the job execution status is set to
    -- @IN_PROGRESS@. If the job execution status is not set to another
    -- terminal state before the time expires, it will be automatically set to
    -- @TIMED_OUT@.
    CreateJob -> Maybe TimeoutConfig
timeoutConfig :: Prelude.Maybe TimeoutConfig,
    -- | A job identifier which must be unique for your Amazon Web Services
    -- account. We recommend using a UUID. Alpha-numeric characters, \"-\" and
    -- \"_\" are valid for use here.
    CreateJob -> Text
jobId :: Prelude.Text,
    -- | A list of things and thing groups to which the job should be sent.
    CreateJob -> NonEmpty Text
targets :: Prelude.NonEmpty Prelude.Text
  }
  deriving (CreateJob -> CreateJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateJob -> CreateJob -> Bool
$c/= :: CreateJob -> CreateJob -> Bool
== :: CreateJob -> CreateJob -> Bool
$c== :: CreateJob -> CreateJob -> Bool
Prelude.Eq, ReadPrec [CreateJob]
ReadPrec CreateJob
Int -> ReadS CreateJob
ReadS [CreateJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateJob]
$creadListPrec :: ReadPrec [CreateJob]
readPrec :: ReadPrec CreateJob
$creadPrec :: ReadPrec CreateJob
readList :: ReadS [CreateJob]
$creadList :: ReadS [CreateJob]
readsPrec :: Int -> ReadS CreateJob
$creadsPrec :: Int -> ReadS CreateJob
Prelude.Read, Int -> CreateJob -> ShowS
[CreateJob] -> ShowS
CreateJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateJob] -> ShowS
$cshowList :: [CreateJob] -> ShowS
show :: CreateJob -> String
$cshow :: CreateJob -> String
showsPrec :: Int -> CreateJob -> ShowS
$cshowsPrec :: Int -> CreateJob -> ShowS
Prelude.Show, forall x. Rep CreateJob x -> CreateJob
forall x. CreateJob -> Rep CreateJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateJob x -> CreateJob
$cfrom :: forall x. CreateJob -> Rep CreateJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateJob' 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:
--
-- 'abortConfig', 'createJob_abortConfig' - Allows you to create the criteria to abort a job.
--
-- 'description', 'createJob_description' - A short text description of the job.
--
-- 'document', 'createJob_document' - The job document. Required if you don\'t specify a value for
-- @documentSource@.
--
-- 'documentParameters', 'createJob_documentParameters' - Parameters of an Amazon Web Services managed template that you can
-- specify to create the job document.
--
-- @documentParameters@ can only be used when creating jobs from Amazon Web
-- Services managed templates. This parameter can\'t be used with custom
-- job templates or to create jobs from them.
--
-- 'documentSource', 'createJob_documentSource' - An S3 link to the job document. Required if you don\'t specify a value
-- for @document@.
--
-- If the job document resides in an S3 bucket, you must use a placeholder
-- link when specifying the document.
--
-- The placeholder link is of the following form:
--
-- @${aws:iot:s3-presigned-url:https:\/\/s3.amazonaws.com\/@/@bucket@/@\/@/@key@/@}@
--
-- where /bucket/ is your bucket name and /key/ is the object in the bucket
-- to which you are linking.
--
-- 'jobExecutionsRetryConfig', 'createJob_jobExecutionsRetryConfig' - Allows you to create the criteria to retry a job.
--
-- 'jobExecutionsRolloutConfig', 'createJob_jobExecutionsRolloutConfig' - Allows you to create a staged rollout of the job.
--
-- 'jobTemplateArn', 'createJob_jobTemplateArn' - The ARN of the job template used to create the job.
--
-- 'namespaceId', 'createJob_namespaceId' - The namespace used to indicate that a job is a customer-managed job.
--
-- When you specify a value for this parameter, Amazon Web Services IoT
-- Core sends jobs notifications to MQTT topics that contain the value in
-- the following format.
--
-- @$aws\/things\/@/@THING_NAME@/@\/jobs\/@/@JOB_ID@/@\/notify-namespace-@/@NAMESPACE_ID@/@\/@
--
-- The @namespaceId@ feature is in public preview.
--
-- 'presignedUrlConfig', 'createJob_presignedUrlConfig' - Configuration information for pre-signed S3 URLs.
--
-- 'schedulingConfig', 'createJob_schedulingConfig' - The configuration that allows you to schedule a job for a future date
-- and time in addition to specifying the end behavior for each job
-- execution.
--
-- 'tags', 'createJob_tags' - Metadata which can be used to manage the job.
--
-- 'targetSelection', 'createJob_targetSelection' - Specifies whether the job will continue to run (CONTINUOUS), or will be
-- complete after all those things specified as targets have completed the
-- job (SNAPSHOT). If continuous, the job may also be run on a thing when a
-- change is detected in a target. For example, a job will run on a thing
-- when the thing is added to a target group, even after the job was
-- completed by all things originally in the group.
--
-- We recommend that you use continuous jobs instead of snapshot jobs for
-- dynamic thing group targets. By using continuous jobs, devices that join
-- the group receive the job execution even after the job has been created.
--
-- 'timeoutConfig', 'createJob_timeoutConfig' - Specifies the amount of time each device has to finish its execution of
-- the job. The timer is started when the job execution status is set to
-- @IN_PROGRESS@. If the job execution status is not set to another
-- terminal state before the time expires, it will be automatically set to
-- @TIMED_OUT@.
--
-- 'jobId', 'createJob_jobId' - A job identifier which must be unique for your Amazon Web Services
-- account. We recommend using a UUID. Alpha-numeric characters, \"-\" and
-- \"_\" are valid for use here.
--
-- 'targets', 'createJob_targets' - A list of things and thing groups to which the job should be sent.
newCreateJob ::
  -- | 'jobId'
  Prelude.Text ->
  -- | 'targets'
  Prelude.NonEmpty Prelude.Text ->
  CreateJob
newCreateJob :: Text -> NonEmpty Text -> CreateJob
newCreateJob Text
pJobId_ NonEmpty Text
pTargets_ =
  CreateJob'
    { $sel:abortConfig:CreateJob' :: Maybe AbortConfig
abortConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateJob' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:document:CreateJob' :: Maybe Text
document = forall a. Maybe a
Prelude.Nothing,
      $sel:documentParameters:CreateJob' :: Maybe (HashMap Text Text)
documentParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:documentSource:CreateJob' :: Maybe Text
documentSource = forall a. Maybe a
Prelude.Nothing,
      $sel:jobExecutionsRetryConfig:CreateJob' :: Maybe JobExecutionsRetryConfig
jobExecutionsRetryConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:jobExecutionsRolloutConfig:CreateJob' :: Maybe JobExecutionsRolloutConfig
jobExecutionsRolloutConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:jobTemplateArn:CreateJob' :: Maybe Text
jobTemplateArn = forall a. Maybe a
Prelude.Nothing,
      $sel:namespaceId:CreateJob' :: Maybe Text
namespaceId = forall a. Maybe a
Prelude.Nothing,
      $sel:presignedUrlConfig:CreateJob' :: Maybe PresignedUrlConfig
presignedUrlConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:schedulingConfig:CreateJob' :: Maybe SchedulingConfig
schedulingConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateJob' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:targetSelection:CreateJob' :: Maybe TargetSelection
targetSelection = forall a. Maybe a
Prelude.Nothing,
      $sel:timeoutConfig:CreateJob' :: Maybe TimeoutConfig
timeoutConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:CreateJob' :: Text
jobId = Text
pJobId_,
      $sel:targets:CreateJob' :: NonEmpty Text
targets = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pTargets_
    }

-- | Allows you to create the criteria to abort a job.
createJob_abortConfig :: Lens.Lens' CreateJob (Prelude.Maybe AbortConfig)
createJob_abortConfig :: Lens' CreateJob (Maybe AbortConfig)
createJob_abortConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe AbortConfig
abortConfig :: Maybe AbortConfig
$sel:abortConfig:CreateJob' :: CreateJob -> Maybe AbortConfig
abortConfig} -> Maybe AbortConfig
abortConfig) (\s :: CreateJob
s@CreateJob' {} Maybe AbortConfig
a -> CreateJob
s {$sel:abortConfig:CreateJob' :: Maybe AbortConfig
abortConfig = Maybe AbortConfig
a} :: CreateJob)

-- | A short text description of the job.
createJob_description :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_description :: Lens' CreateJob (Maybe Text)
createJob_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
description :: Maybe Text
$sel:description:CreateJob' :: CreateJob -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:description:CreateJob' :: Maybe Text
description = Maybe Text
a} :: CreateJob)

-- | The job document. Required if you don\'t specify a value for
-- @documentSource@.
createJob_document :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_document :: Lens' CreateJob (Maybe Text)
createJob_document = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
document :: Maybe Text
$sel:document:CreateJob' :: CreateJob -> Maybe Text
document} -> Maybe Text
document) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:document:CreateJob' :: Maybe Text
document = Maybe Text
a} :: CreateJob)

-- | Parameters of an Amazon Web Services managed template that you can
-- specify to create the job document.
--
-- @documentParameters@ can only be used when creating jobs from Amazon Web
-- Services managed templates. This parameter can\'t be used with custom
-- job templates or to create jobs from them.
createJob_documentParameters :: Lens.Lens' CreateJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createJob_documentParameters :: Lens' CreateJob (Maybe (HashMap Text Text))
createJob_documentParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe (HashMap Text Text)
documentParameters :: Maybe (HashMap Text Text)
$sel:documentParameters:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
documentParameters} -> Maybe (HashMap Text Text)
documentParameters) (\s :: CreateJob
s@CreateJob' {} Maybe (HashMap Text Text)
a -> CreateJob
s {$sel:documentParameters:CreateJob' :: Maybe (HashMap Text Text)
documentParameters = Maybe (HashMap Text Text)
a} :: CreateJob) 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 S3 link to the job document. Required if you don\'t specify a value
-- for @document@.
--
-- If the job document resides in an S3 bucket, you must use a placeholder
-- link when specifying the document.
--
-- The placeholder link is of the following form:
--
-- @${aws:iot:s3-presigned-url:https:\/\/s3.amazonaws.com\/@/@bucket@/@\/@/@key@/@}@
--
-- where /bucket/ is your bucket name and /key/ is the object in the bucket
-- to which you are linking.
createJob_documentSource :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_documentSource :: Lens' CreateJob (Maybe Text)
createJob_documentSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
documentSource :: Maybe Text
$sel:documentSource:CreateJob' :: CreateJob -> Maybe Text
documentSource} -> Maybe Text
documentSource) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:documentSource:CreateJob' :: Maybe Text
documentSource = Maybe Text
a} :: CreateJob)

-- | Allows you to create the criteria to retry a job.
createJob_jobExecutionsRetryConfig :: Lens.Lens' CreateJob (Prelude.Maybe JobExecutionsRetryConfig)
createJob_jobExecutionsRetryConfig :: Lens' CreateJob (Maybe JobExecutionsRetryConfig)
createJob_jobExecutionsRetryConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe JobExecutionsRetryConfig
jobExecutionsRetryConfig :: Maybe JobExecutionsRetryConfig
$sel:jobExecutionsRetryConfig:CreateJob' :: CreateJob -> Maybe JobExecutionsRetryConfig
jobExecutionsRetryConfig} -> Maybe JobExecutionsRetryConfig
jobExecutionsRetryConfig) (\s :: CreateJob
s@CreateJob' {} Maybe JobExecutionsRetryConfig
a -> CreateJob
s {$sel:jobExecutionsRetryConfig:CreateJob' :: Maybe JobExecutionsRetryConfig
jobExecutionsRetryConfig = Maybe JobExecutionsRetryConfig
a} :: CreateJob)

-- | Allows you to create a staged rollout of the job.
createJob_jobExecutionsRolloutConfig :: Lens.Lens' CreateJob (Prelude.Maybe JobExecutionsRolloutConfig)
createJob_jobExecutionsRolloutConfig :: Lens' CreateJob (Maybe JobExecutionsRolloutConfig)
createJob_jobExecutionsRolloutConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe JobExecutionsRolloutConfig
jobExecutionsRolloutConfig :: Maybe JobExecutionsRolloutConfig
$sel:jobExecutionsRolloutConfig:CreateJob' :: CreateJob -> Maybe JobExecutionsRolloutConfig
jobExecutionsRolloutConfig} -> Maybe JobExecutionsRolloutConfig
jobExecutionsRolloutConfig) (\s :: CreateJob
s@CreateJob' {} Maybe JobExecutionsRolloutConfig
a -> CreateJob
s {$sel:jobExecutionsRolloutConfig:CreateJob' :: Maybe JobExecutionsRolloutConfig
jobExecutionsRolloutConfig = Maybe JobExecutionsRolloutConfig
a} :: CreateJob)

-- | The ARN of the job template used to create the job.
createJob_jobTemplateArn :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_jobTemplateArn :: Lens' CreateJob (Maybe Text)
createJob_jobTemplateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
jobTemplateArn :: Maybe Text
$sel:jobTemplateArn:CreateJob' :: CreateJob -> Maybe Text
jobTemplateArn} -> Maybe Text
jobTemplateArn) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:jobTemplateArn:CreateJob' :: Maybe Text
jobTemplateArn = Maybe Text
a} :: CreateJob)

-- | The namespace used to indicate that a job is a customer-managed job.
--
-- When you specify a value for this parameter, Amazon Web Services IoT
-- Core sends jobs notifications to MQTT topics that contain the value in
-- the following format.
--
-- @$aws\/things\/@/@THING_NAME@/@\/jobs\/@/@JOB_ID@/@\/notify-namespace-@/@NAMESPACE_ID@/@\/@
--
-- The @namespaceId@ feature is in public preview.
createJob_namespaceId :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_namespaceId :: Lens' CreateJob (Maybe Text)
createJob_namespaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
namespaceId :: Maybe Text
$sel:namespaceId:CreateJob' :: CreateJob -> Maybe Text
namespaceId} -> Maybe Text
namespaceId) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:namespaceId:CreateJob' :: Maybe Text
namespaceId = Maybe Text
a} :: CreateJob)

-- | Configuration information for pre-signed S3 URLs.
createJob_presignedUrlConfig :: Lens.Lens' CreateJob (Prelude.Maybe PresignedUrlConfig)
createJob_presignedUrlConfig :: Lens' CreateJob (Maybe PresignedUrlConfig)
createJob_presignedUrlConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe PresignedUrlConfig
presignedUrlConfig :: Maybe PresignedUrlConfig
$sel:presignedUrlConfig:CreateJob' :: CreateJob -> Maybe PresignedUrlConfig
presignedUrlConfig} -> Maybe PresignedUrlConfig
presignedUrlConfig) (\s :: CreateJob
s@CreateJob' {} Maybe PresignedUrlConfig
a -> CreateJob
s {$sel:presignedUrlConfig:CreateJob' :: Maybe PresignedUrlConfig
presignedUrlConfig = Maybe PresignedUrlConfig
a} :: CreateJob)

-- | The configuration that allows you to schedule a job for a future date
-- and time in addition to specifying the end behavior for each job
-- execution.
createJob_schedulingConfig :: Lens.Lens' CreateJob (Prelude.Maybe SchedulingConfig)
createJob_schedulingConfig :: Lens' CreateJob (Maybe SchedulingConfig)
createJob_schedulingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe SchedulingConfig
schedulingConfig :: Maybe SchedulingConfig
$sel:schedulingConfig:CreateJob' :: CreateJob -> Maybe SchedulingConfig
schedulingConfig} -> Maybe SchedulingConfig
schedulingConfig) (\s :: CreateJob
s@CreateJob' {} Maybe SchedulingConfig
a -> CreateJob
s {$sel:schedulingConfig:CreateJob' :: Maybe SchedulingConfig
schedulingConfig = Maybe SchedulingConfig
a} :: CreateJob)

-- | Metadata which can be used to manage the job.
createJob_tags :: Lens.Lens' CreateJob (Prelude.Maybe [Tag])
createJob_tags :: Lens' CreateJob (Maybe [Tag])
createJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateJob' :: CreateJob -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateJob
s@CreateJob' {} Maybe [Tag]
a -> CreateJob
s {$sel:tags:CreateJob' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateJob) 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 the job will continue to run (CONTINUOUS), or will be
-- complete after all those things specified as targets have completed the
-- job (SNAPSHOT). If continuous, the job may also be run on a thing when a
-- change is detected in a target. For example, a job will run on a thing
-- when the thing is added to a target group, even after the job was
-- completed by all things originally in the group.
--
-- We recommend that you use continuous jobs instead of snapshot jobs for
-- dynamic thing group targets. By using continuous jobs, devices that join
-- the group receive the job execution even after the job has been created.
createJob_targetSelection :: Lens.Lens' CreateJob (Prelude.Maybe TargetSelection)
createJob_targetSelection :: Lens' CreateJob (Maybe TargetSelection)
createJob_targetSelection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe TargetSelection
targetSelection :: Maybe TargetSelection
$sel:targetSelection:CreateJob' :: CreateJob -> Maybe TargetSelection
targetSelection} -> Maybe TargetSelection
targetSelection) (\s :: CreateJob
s@CreateJob' {} Maybe TargetSelection
a -> CreateJob
s {$sel:targetSelection:CreateJob' :: Maybe TargetSelection
targetSelection = Maybe TargetSelection
a} :: CreateJob)

-- | Specifies the amount of time each device has to finish its execution of
-- the job. The timer is started when the job execution status is set to
-- @IN_PROGRESS@. If the job execution status is not set to another
-- terminal state before the time expires, it will be automatically set to
-- @TIMED_OUT@.
createJob_timeoutConfig :: Lens.Lens' CreateJob (Prelude.Maybe TimeoutConfig)
createJob_timeoutConfig :: Lens' CreateJob (Maybe TimeoutConfig)
createJob_timeoutConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe TimeoutConfig
timeoutConfig :: Maybe TimeoutConfig
$sel:timeoutConfig:CreateJob' :: CreateJob -> Maybe TimeoutConfig
timeoutConfig} -> Maybe TimeoutConfig
timeoutConfig) (\s :: CreateJob
s@CreateJob' {} Maybe TimeoutConfig
a -> CreateJob
s {$sel:timeoutConfig:CreateJob' :: Maybe TimeoutConfig
timeoutConfig = Maybe TimeoutConfig
a} :: CreateJob)

-- | A job identifier which must be unique for your Amazon Web Services
-- account. We recommend using a UUID. Alpha-numeric characters, \"-\" and
-- \"_\" are valid for use here.
createJob_jobId :: Lens.Lens' CreateJob Prelude.Text
createJob_jobId :: Lens' CreateJob Text
createJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Text
jobId :: Text
$sel:jobId:CreateJob' :: CreateJob -> Text
jobId} -> Text
jobId) (\s :: CreateJob
s@CreateJob' {} Text
a -> CreateJob
s {$sel:jobId:CreateJob' :: Text
jobId = Text
a} :: CreateJob)

-- | A list of things and thing groups to which the job should be sent.
createJob_targets :: Lens.Lens' CreateJob (Prelude.NonEmpty Prelude.Text)
createJob_targets :: Lens' CreateJob (NonEmpty Text)
createJob_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {NonEmpty Text
targets :: NonEmpty Text
$sel:targets:CreateJob' :: CreateJob -> NonEmpty Text
targets} -> NonEmpty Text
targets) (\s :: CreateJob
s@CreateJob' {} NonEmpty Text
a -> CreateJob
s {$sel:targets:CreateJob' :: NonEmpty Text
targets = NonEmpty Text
a} :: CreateJob) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateJob where
  type AWSResponse CreateJob = CreateJobResponse
  request :: (Service -> Service) -> CreateJob -> Request CreateJob
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateJob)))
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 -> Maybe Text -> Maybe Text -> Int -> CreateJobResponse
CreateJobResponse'
            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
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"jobArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"jobId")
            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))
      )

instance Prelude.Hashable CreateJob where
  hashWithSalt :: Int -> CreateJob -> Int
hashWithSalt Int
_salt CreateJob' {Maybe [Tag]
Maybe Text
Maybe (HashMap Text Text)
Maybe AbortConfig
Maybe PresignedUrlConfig
Maybe JobExecutionsRolloutConfig
Maybe JobExecutionsRetryConfig
Maybe SchedulingConfig
Maybe TargetSelection
Maybe TimeoutConfig
NonEmpty Text
Text
targets :: NonEmpty Text
jobId :: Text
timeoutConfig :: Maybe TimeoutConfig
targetSelection :: Maybe TargetSelection
tags :: Maybe [Tag]
schedulingConfig :: Maybe SchedulingConfig
presignedUrlConfig :: Maybe PresignedUrlConfig
namespaceId :: Maybe Text
jobTemplateArn :: Maybe Text
jobExecutionsRolloutConfig :: Maybe JobExecutionsRolloutConfig
jobExecutionsRetryConfig :: Maybe JobExecutionsRetryConfig
documentSource :: Maybe Text
documentParameters :: Maybe (HashMap Text Text)
document :: Maybe Text
description :: Maybe Text
abortConfig :: Maybe AbortConfig
$sel:targets:CreateJob' :: CreateJob -> NonEmpty Text
$sel:jobId:CreateJob' :: CreateJob -> Text
$sel:timeoutConfig:CreateJob' :: CreateJob -> Maybe TimeoutConfig
$sel:targetSelection:CreateJob' :: CreateJob -> Maybe TargetSelection
$sel:tags:CreateJob' :: CreateJob -> Maybe [Tag]
$sel:schedulingConfig:CreateJob' :: CreateJob -> Maybe SchedulingConfig
$sel:presignedUrlConfig:CreateJob' :: CreateJob -> Maybe PresignedUrlConfig
$sel:namespaceId:CreateJob' :: CreateJob -> Maybe Text
$sel:jobTemplateArn:CreateJob' :: CreateJob -> Maybe Text
$sel:jobExecutionsRolloutConfig:CreateJob' :: CreateJob -> Maybe JobExecutionsRolloutConfig
$sel:jobExecutionsRetryConfig:CreateJob' :: CreateJob -> Maybe JobExecutionsRetryConfig
$sel:documentSource:CreateJob' :: CreateJob -> Maybe Text
$sel:documentParameters:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
$sel:document:CreateJob' :: CreateJob -> Maybe Text
$sel:description:CreateJob' :: CreateJob -> Maybe Text
$sel:abortConfig:CreateJob' :: CreateJob -> Maybe AbortConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AbortConfig
abortConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
document
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
documentParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
documentSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobExecutionsRetryConfig
jobExecutionsRetryConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobExecutionsRolloutConfig
jobExecutionsRolloutConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobTemplateArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
namespaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PresignedUrlConfig
presignedUrlConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SchedulingConfig
schedulingConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetSelection
targetSelection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimeoutConfig
timeoutConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
targets

instance Prelude.NFData CreateJob where
  rnf :: CreateJob -> ()
rnf CreateJob' {Maybe [Tag]
Maybe Text
Maybe (HashMap Text Text)
Maybe AbortConfig
Maybe PresignedUrlConfig
Maybe JobExecutionsRolloutConfig
Maybe JobExecutionsRetryConfig
Maybe SchedulingConfig
Maybe TargetSelection
Maybe TimeoutConfig
NonEmpty Text
Text
targets :: NonEmpty Text
jobId :: Text
timeoutConfig :: Maybe TimeoutConfig
targetSelection :: Maybe TargetSelection
tags :: Maybe [Tag]
schedulingConfig :: Maybe SchedulingConfig
presignedUrlConfig :: Maybe PresignedUrlConfig
namespaceId :: Maybe Text
jobTemplateArn :: Maybe Text
jobExecutionsRolloutConfig :: Maybe JobExecutionsRolloutConfig
jobExecutionsRetryConfig :: Maybe JobExecutionsRetryConfig
documentSource :: Maybe Text
documentParameters :: Maybe (HashMap Text Text)
document :: Maybe Text
description :: Maybe Text
abortConfig :: Maybe AbortConfig
$sel:targets:CreateJob' :: CreateJob -> NonEmpty Text
$sel:jobId:CreateJob' :: CreateJob -> Text
$sel:timeoutConfig:CreateJob' :: CreateJob -> Maybe TimeoutConfig
$sel:targetSelection:CreateJob' :: CreateJob -> Maybe TargetSelection
$sel:tags:CreateJob' :: CreateJob -> Maybe [Tag]
$sel:schedulingConfig:CreateJob' :: CreateJob -> Maybe SchedulingConfig
$sel:presignedUrlConfig:CreateJob' :: CreateJob -> Maybe PresignedUrlConfig
$sel:namespaceId:CreateJob' :: CreateJob -> Maybe Text
$sel:jobTemplateArn:CreateJob' :: CreateJob -> Maybe Text
$sel:jobExecutionsRolloutConfig:CreateJob' :: CreateJob -> Maybe JobExecutionsRolloutConfig
$sel:jobExecutionsRetryConfig:CreateJob' :: CreateJob -> Maybe JobExecutionsRetryConfig
$sel:documentSource:CreateJob' :: CreateJob -> Maybe Text
$sel:documentParameters:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
$sel:document:CreateJob' :: CreateJob -> Maybe Text
$sel:description:CreateJob' :: CreateJob -> Maybe Text
$sel:abortConfig:CreateJob' :: CreateJob -> Maybe AbortConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AbortConfig
abortConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
document
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
documentParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
documentSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobExecutionsRetryConfig
jobExecutionsRetryConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobExecutionsRolloutConfig
jobExecutionsRolloutConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobTemplateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
namespaceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PresignedUrlConfig
presignedUrlConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SchedulingConfig
schedulingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetSelection
targetSelection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TimeoutConfig
timeoutConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
targets

instance Data.ToHeaders CreateJob where
  toHeaders :: CreateJob -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON CreateJob where
  toJSON :: CreateJob -> Value
toJSON CreateJob' {Maybe [Tag]
Maybe Text
Maybe (HashMap Text Text)
Maybe AbortConfig
Maybe PresignedUrlConfig
Maybe JobExecutionsRolloutConfig
Maybe JobExecutionsRetryConfig
Maybe SchedulingConfig
Maybe TargetSelection
Maybe TimeoutConfig
NonEmpty Text
Text
targets :: NonEmpty Text
jobId :: Text
timeoutConfig :: Maybe TimeoutConfig
targetSelection :: Maybe TargetSelection
tags :: Maybe [Tag]
schedulingConfig :: Maybe SchedulingConfig
presignedUrlConfig :: Maybe PresignedUrlConfig
namespaceId :: Maybe Text
jobTemplateArn :: Maybe Text
jobExecutionsRolloutConfig :: Maybe JobExecutionsRolloutConfig
jobExecutionsRetryConfig :: Maybe JobExecutionsRetryConfig
documentSource :: Maybe Text
documentParameters :: Maybe (HashMap Text Text)
document :: Maybe Text
description :: Maybe Text
abortConfig :: Maybe AbortConfig
$sel:targets:CreateJob' :: CreateJob -> NonEmpty Text
$sel:jobId:CreateJob' :: CreateJob -> Text
$sel:timeoutConfig:CreateJob' :: CreateJob -> Maybe TimeoutConfig
$sel:targetSelection:CreateJob' :: CreateJob -> Maybe TargetSelection
$sel:tags:CreateJob' :: CreateJob -> Maybe [Tag]
$sel:schedulingConfig:CreateJob' :: CreateJob -> Maybe SchedulingConfig
$sel:presignedUrlConfig:CreateJob' :: CreateJob -> Maybe PresignedUrlConfig
$sel:namespaceId:CreateJob' :: CreateJob -> Maybe Text
$sel:jobTemplateArn:CreateJob' :: CreateJob -> Maybe Text
$sel:jobExecutionsRolloutConfig:CreateJob' :: CreateJob -> Maybe JobExecutionsRolloutConfig
$sel:jobExecutionsRetryConfig:CreateJob' :: CreateJob -> Maybe JobExecutionsRetryConfig
$sel:documentSource:CreateJob' :: CreateJob -> Maybe Text
$sel:documentParameters:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
$sel:document:CreateJob' :: CreateJob -> Maybe Text
$sel:description:CreateJob' :: CreateJob -> Maybe Text
$sel:abortConfig:CreateJob' :: CreateJob -> Maybe AbortConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"abortConfig" 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 AbortConfig
abortConfig,
            (Key
"description" 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
description,
            (Key
"document" 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
document,
            (Key
"documentParameters" 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)
documentParameters,
            (Key
"documentSource" 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
documentSource,
            (Key
"jobExecutionsRetryConfig" 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 JobExecutionsRetryConfig
jobExecutionsRetryConfig,
            (Key
"jobExecutionsRolloutConfig" 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 JobExecutionsRolloutConfig
jobExecutionsRolloutConfig,
            (Key
"jobTemplateArn" 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
jobTemplateArn,
            (Key
"namespaceId" 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
namespaceId,
            (Key
"presignedUrlConfig" 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 PresignedUrlConfig
presignedUrlConfig,
            (Key
"schedulingConfig" 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 SchedulingConfig
schedulingConfig,
            (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 [Tag]
tags,
            (Key
"targetSelection" 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 TargetSelection
targetSelection,
            (Key
"timeoutConfig" 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 TimeoutConfig
timeoutConfig,
            forall a. a -> Maybe a
Prelude.Just (Key
"targets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
targets)
          ]
      )

instance Data.ToPath CreateJob where
  toPath :: CreateJob -> ByteString
toPath CreateJob' {Maybe [Tag]
Maybe Text
Maybe (HashMap Text Text)
Maybe AbortConfig
Maybe PresignedUrlConfig
Maybe JobExecutionsRolloutConfig
Maybe JobExecutionsRetryConfig
Maybe SchedulingConfig
Maybe TargetSelection
Maybe TimeoutConfig
NonEmpty Text
Text
targets :: NonEmpty Text
jobId :: Text
timeoutConfig :: Maybe TimeoutConfig
targetSelection :: Maybe TargetSelection
tags :: Maybe [Tag]
schedulingConfig :: Maybe SchedulingConfig
presignedUrlConfig :: Maybe PresignedUrlConfig
namespaceId :: Maybe Text
jobTemplateArn :: Maybe Text
jobExecutionsRolloutConfig :: Maybe JobExecutionsRolloutConfig
jobExecutionsRetryConfig :: Maybe JobExecutionsRetryConfig
documentSource :: Maybe Text
documentParameters :: Maybe (HashMap Text Text)
document :: Maybe Text
description :: Maybe Text
abortConfig :: Maybe AbortConfig
$sel:targets:CreateJob' :: CreateJob -> NonEmpty Text
$sel:jobId:CreateJob' :: CreateJob -> Text
$sel:timeoutConfig:CreateJob' :: CreateJob -> Maybe TimeoutConfig
$sel:targetSelection:CreateJob' :: CreateJob -> Maybe TargetSelection
$sel:tags:CreateJob' :: CreateJob -> Maybe [Tag]
$sel:schedulingConfig:CreateJob' :: CreateJob -> Maybe SchedulingConfig
$sel:presignedUrlConfig:CreateJob' :: CreateJob -> Maybe PresignedUrlConfig
$sel:namespaceId:CreateJob' :: CreateJob -> Maybe Text
$sel:jobTemplateArn:CreateJob' :: CreateJob -> Maybe Text
$sel:jobExecutionsRolloutConfig:CreateJob' :: CreateJob -> Maybe JobExecutionsRolloutConfig
$sel:jobExecutionsRetryConfig:CreateJob' :: CreateJob -> Maybe JobExecutionsRetryConfig
$sel:documentSource:CreateJob' :: CreateJob -> Maybe Text
$sel:documentParameters:CreateJob' :: CreateJob -> Maybe (HashMap Text Text)
$sel:document:CreateJob' :: CreateJob -> Maybe Text
$sel:description:CreateJob' :: CreateJob -> Maybe Text
$sel:abortConfig:CreateJob' :: CreateJob -> Maybe AbortConfig
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/jobs/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
jobId]

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

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

-- |
-- Create a value of 'CreateJobResponse' 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:
--
-- 'description', 'createJobResponse_description' - The job description.
--
-- 'jobArn', 'createJobResponse_jobArn' - The job ARN.
--
-- 'jobId', 'createJobResponse_jobId' - The unique identifier you assigned to this job.
--
-- 'httpStatus', 'createJobResponse_httpStatus' - The response's http status code.
newCreateJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateJobResponse
newCreateJobResponse :: Int -> CreateJobResponse
newCreateJobResponse Int
pHttpStatus_ =
  CreateJobResponse'
    { $sel:description:CreateJobResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:jobArn:CreateJobResponse' :: Maybe Text
jobArn = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:CreateJobResponse' :: Maybe Text
jobId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The job description.
createJobResponse_description :: Lens.Lens' CreateJobResponse (Prelude.Maybe Prelude.Text)
createJobResponse_description :: Lens' CreateJobResponse (Maybe Text)
createJobResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateJobResponse' :: CreateJobResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateJobResponse
s@CreateJobResponse' {} Maybe Text
a -> CreateJobResponse
s {$sel:description:CreateJobResponse' :: Maybe Text
description = Maybe Text
a} :: CreateJobResponse)

-- | The job ARN.
createJobResponse_jobArn :: Lens.Lens' CreateJobResponse (Prelude.Maybe Prelude.Text)
createJobResponse_jobArn :: Lens' CreateJobResponse (Maybe Text)
createJobResponse_jobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobResponse' {Maybe Text
jobArn :: Maybe Text
$sel:jobArn:CreateJobResponse' :: CreateJobResponse -> Maybe Text
jobArn} -> Maybe Text
jobArn) (\s :: CreateJobResponse
s@CreateJobResponse' {} Maybe Text
a -> CreateJobResponse
s {$sel:jobArn:CreateJobResponse' :: Maybe Text
jobArn = Maybe Text
a} :: CreateJobResponse)

-- | The unique identifier you assigned to this job.
createJobResponse_jobId :: Lens.Lens' CreateJobResponse (Prelude.Maybe Prelude.Text)
createJobResponse_jobId :: Lens' CreateJobResponse (Maybe Text)
createJobResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:CreateJobResponse' :: CreateJobResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: CreateJobResponse
s@CreateJobResponse' {} Maybe Text
a -> CreateJobResponse
s {$sel:jobId:CreateJobResponse' :: Maybe Text
jobId = Maybe Text
a} :: CreateJobResponse)

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

instance Prelude.NFData CreateJobResponse where
  rnf :: CreateJobResponse -> ()
rnf CreateJobResponse' {Int
Maybe Text
httpStatus :: Int
jobId :: Maybe Text
jobArn :: Maybe Text
description :: Maybe Text
$sel:httpStatus:CreateJobResponse' :: CreateJobResponse -> Int
$sel:jobId:CreateJobResponse' :: CreateJobResponse -> Maybe Text
$sel:jobArn:CreateJobResponse' :: CreateJobResponse -> Maybe Text
$sel:description:CreateJobResponse' :: CreateJobResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus