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

    -- * Request Lenses
    updateJob_abortConfig,
    updateJob_description,
    updateJob_jobExecutionsRetryConfig,
    updateJob_jobExecutionsRolloutConfig,
    updateJob_namespaceId,
    updateJob_presignedUrlConfig,
    updateJob_timeoutConfig,
    updateJob_jobId,

    -- * Destructuring the Response
    UpdateJobResponse (..),
    newUpdateJobResponse,
  )
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:/ 'newUpdateJob' smart constructor.
data UpdateJob = UpdateJob'
  { -- | Allows you to create criteria to abort a job.
    UpdateJob -> Maybe AbortConfig
abortConfig :: Prelude.Maybe AbortConfig,
    -- | A short text description of the job.
    UpdateJob -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Allows you to create the criteria to retry a job.
    UpdateJob -> Maybe JobExecutionsRetryConfig
jobExecutionsRetryConfig :: Prelude.Maybe JobExecutionsRetryConfig,
    -- | Allows you to create a staged rollout of the job.
    UpdateJob -> Maybe JobExecutionsRolloutConfig
jobExecutionsRolloutConfig :: Prelude.Maybe JobExecutionsRolloutConfig,
    -- | 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.
    UpdateJob -> Maybe Text
namespaceId :: Prelude.Maybe Prelude.Text,
    -- | Configuration information for pre-signed S3 URLs.
    UpdateJob -> Maybe PresignedUrlConfig
presignedUrlConfig :: Prelude.Maybe PresignedUrlConfig,
    -- | 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@.
    UpdateJob -> Maybe TimeoutConfig
timeoutConfig :: Prelude.Maybe TimeoutConfig,
    -- | The ID of the job to be updated.
    UpdateJob -> Text
jobId :: Prelude.Text
  }
  deriving (UpdateJob -> UpdateJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateJob -> UpdateJob -> Bool
$c/= :: UpdateJob -> UpdateJob -> Bool
== :: UpdateJob -> UpdateJob -> Bool
$c== :: UpdateJob -> UpdateJob -> Bool
Prelude.Eq, ReadPrec [UpdateJob]
ReadPrec UpdateJob
Int -> ReadS UpdateJob
ReadS [UpdateJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateJob]
$creadListPrec :: ReadPrec [UpdateJob]
readPrec :: ReadPrec UpdateJob
$creadPrec :: ReadPrec UpdateJob
readList :: ReadS [UpdateJob]
$creadList :: ReadS [UpdateJob]
readsPrec :: Int -> ReadS UpdateJob
$creadsPrec :: Int -> ReadS UpdateJob
Prelude.Read, Int -> UpdateJob -> ShowS
[UpdateJob] -> ShowS
UpdateJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateJob] -> ShowS
$cshowList :: [UpdateJob] -> ShowS
show :: UpdateJob -> String
$cshow :: UpdateJob -> String
showsPrec :: Int -> UpdateJob -> ShowS
$cshowsPrec :: Int -> UpdateJob -> ShowS
Prelude.Show, forall x. Rep UpdateJob x -> UpdateJob
forall x. UpdateJob -> Rep UpdateJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateJob x -> UpdateJob
$cfrom :: forall x. UpdateJob -> Rep UpdateJob x
Prelude.Generic)

-- |
-- Create a value of 'UpdateJob' 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', 'updateJob_abortConfig' - Allows you to create criteria to abort a job.
--
-- 'description', 'updateJob_description' - A short text description of the job.
--
-- 'jobExecutionsRetryConfig', 'updateJob_jobExecutionsRetryConfig' - Allows you to create the criteria to retry a job.
--
-- 'jobExecutionsRolloutConfig', 'updateJob_jobExecutionsRolloutConfig' - Allows you to create a staged rollout of the job.
--
-- 'namespaceId', 'updateJob_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', 'updateJob_presignedUrlConfig' - Configuration information for pre-signed S3 URLs.
--
-- 'timeoutConfig', 'updateJob_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', 'updateJob_jobId' - The ID of the job to be updated.
newUpdateJob ::
  -- | 'jobId'
  Prelude.Text ->
  UpdateJob
newUpdateJob :: Text -> UpdateJob
newUpdateJob Text
pJobId_ =
  UpdateJob'
    { $sel:abortConfig:UpdateJob' :: Maybe AbortConfig
abortConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateJob' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:jobExecutionsRetryConfig:UpdateJob' :: Maybe JobExecutionsRetryConfig
jobExecutionsRetryConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:jobExecutionsRolloutConfig:UpdateJob' :: Maybe JobExecutionsRolloutConfig
jobExecutionsRolloutConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:namespaceId:UpdateJob' :: Maybe Text
namespaceId = forall a. Maybe a
Prelude.Nothing,
      $sel:presignedUrlConfig:UpdateJob' :: Maybe PresignedUrlConfig
presignedUrlConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:timeoutConfig:UpdateJob' :: Maybe TimeoutConfig
timeoutConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:UpdateJob' :: Text
jobId = Text
pJobId_
    }

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

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

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

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

-- | 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.
updateJob_namespaceId :: Lens.Lens' UpdateJob (Prelude.Maybe Prelude.Text)
updateJob_namespaceId :: Lens' UpdateJob (Maybe Text)
updateJob_namespaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateJob' {Maybe Text
namespaceId :: Maybe Text
$sel:namespaceId:UpdateJob' :: UpdateJob -> Maybe Text
namespaceId} -> Maybe Text
namespaceId) (\s :: UpdateJob
s@UpdateJob' {} Maybe Text
a -> UpdateJob
s {$sel:namespaceId:UpdateJob' :: Maybe Text
namespaceId = Maybe Text
a} :: UpdateJob)

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

-- | 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@.
updateJob_timeoutConfig :: Lens.Lens' UpdateJob (Prelude.Maybe TimeoutConfig)
updateJob_timeoutConfig :: Lens' UpdateJob (Maybe TimeoutConfig)
updateJob_timeoutConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateJob' {Maybe TimeoutConfig
timeoutConfig :: Maybe TimeoutConfig
$sel:timeoutConfig:UpdateJob' :: UpdateJob -> Maybe TimeoutConfig
timeoutConfig} -> Maybe TimeoutConfig
timeoutConfig) (\s :: UpdateJob
s@UpdateJob' {} Maybe TimeoutConfig
a -> UpdateJob
s {$sel:timeoutConfig:UpdateJob' :: Maybe TimeoutConfig
timeoutConfig = Maybe TimeoutConfig
a} :: UpdateJob)

-- | The ID of the job to be updated.
updateJob_jobId :: Lens.Lens' UpdateJob Prelude.Text
updateJob_jobId :: Lens' UpdateJob Text
updateJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateJob' {Text
jobId :: Text
$sel:jobId:UpdateJob' :: UpdateJob -> Text
jobId} -> Text
jobId) (\s :: UpdateJob
s@UpdateJob' {} Text
a -> UpdateJob
s {$sel:jobId:UpdateJob' :: Text
jobId = Text
a} :: UpdateJob)

instance Core.AWSRequest UpdateJob where
  type AWSResponse UpdateJob = UpdateJobResponse
  request :: (Service -> Service) -> UpdateJob -> Request UpdateJob
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateJob)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateJobResponse
UpdateJobResponse'

instance Prelude.Hashable UpdateJob where
  hashWithSalt :: Int -> UpdateJob -> Int
hashWithSalt Int
_salt UpdateJob' {Maybe Text
Maybe AbortConfig
Maybe PresignedUrlConfig
Maybe JobExecutionsRolloutConfig
Maybe JobExecutionsRetryConfig
Maybe TimeoutConfig
Text
jobId :: Text
timeoutConfig :: Maybe TimeoutConfig
presignedUrlConfig :: Maybe PresignedUrlConfig
namespaceId :: Maybe Text
jobExecutionsRolloutConfig :: Maybe JobExecutionsRolloutConfig
jobExecutionsRetryConfig :: Maybe JobExecutionsRetryConfig
description :: Maybe Text
abortConfig :: Maybe AbortConfig
$sel:jobId:UpdateJob' :: UpdateJob -> Text
$sel:timeoutConfig:UpdateJob' :: UpdateJob -> Maybe TimeoutConfig
$sel:presignedUrlConfig:UpdateJob' :: UpdateJob -> Maybe PresignedUrlConfig
$sel:namespaceId:UpdateJob' :: UpdateJob -> Maybe Text
$sel:jobExecutionsRolloutConfig:UpdateJob' :: UpdateJob -> Maybe JobExecutionsRolloutConfig
$sel:jobExecutionsRetryConfig:UpdateJob' :: UpdateJob -> Maybe JobExecutionsRetryConfig
$sel:description:UpdateJob' :: UpdateJob -> Maybe Text
$sel:abortConfig:UpdateJob' :: UpdateJob -> 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 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
namespaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PresignedUrlConfig
presignedUrlConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimeoutConfig
timeoutConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

instance Prelude.NFData UpdateJob where
  rnf :: UpdateJob -> ()
rnf UpdateJob' {Maybe Text
Maybe AbortConfig
Maybe PresignedUrlConfig
Maybe JobExecutionsRolloutConfig
Maybe JobExecutionsRetryConfig
Maybe TimeoutConfig
Text
jobId :: Text
timeoutConfig :: Maybe TimeoutConfig
presignedUrlConfig :: Maybe PresignedUrlConfig
namespaceId :: Maybe Text
jobExecutionsRolloutConfig :: Maybe JobExecutionsRolloutConfig
jobExecutionsRetryConfig :: Maybe JobExecutionsRetryConfig
description :: Maybe Text
abortConfig :: Maybe AbortConfig
$sel:jobId:UpdateJob' :: UpdateJob -> Text
$sel:timeoutConfig:UpdateJob' :: UpdateJob -> Maybe TimeoutConfig
$sel:presignedUrlConfig:UpdateJob' :: UpdateJob -> Maybe PresignedUrlConfig
$sel:namespaceId:UpdateJob' :: UpdateJob -> Maybe Text
$sel:jobExecutionsRolloutConfig:UpdateJob' :: UpdateJob -> Maybe JobExecutionsRolloutConfig
$sel:jobExecutionsRetryConfig:UpdateJob' :: UpdateJob -> Maybe JobExecutionsRetryConfig
$sel:description:UpdateJob' :: UpdateJob -> Maybe Text
$sel:abortConfig:UpdateJob' :: UpdateJob -> 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 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
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 TimeoutConfig
timeoutConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobId

instance Data.ToHeaders UpdateJob where
  toHeaders :: UpdateJob -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdateJob where
  toJSON :: UpdateJob -> Value
toJSON UpdateJob' {Maybe Text
Maybe AbortConfig
Maybe PresignedUrlConfig
Maybe JobExecutionsRolloutConfig
Maybe JobExecutionsRetryConfig
Maybe TimeoutConfig
Text
jobId :: Text
timeoutConfig :: Maybe TimeoutConfig
presignedUrlConfig :: Maybe PresignedUrlConfig
namespaceId :: Maybe Text
jobExecutionsRolloutConfig :: Maybe JobExecutionsRolloutConfig
jobExecutionsRetryConfig :: Maybe JobExecutionsRetryConfig
description :: Maybe Text
abortConfig :: Maybe AbortConfig
$sel:jobId:UpdateJob' :: UpdateJob -> Text
$sel:timeoutConfig:UpdateJob' :: UpdateJob -> Maybe TimeoutConfig
$sel:presignedUrlConfig:UpdateJob' :: UpdateJob -> Maybe PresignedUrlConfig
$sel:namespaceId:UpdateJob' :: UpdateJob -> Maybe Text
$sel:jobExecutionsRolloutConfig:UpdateJob' :: UpdateJob -> Maybe JobExecutionsRolloutConfig
$sel:jobExecutionsRetryConfig:UpdateJob' :: UpdateJob -> Maybe JobExecutionsRetryConfig
$sel:description:UpdateJob' :: UpdateJob -> Maybe Text
$sel:abortConfig:UpdateJob' :: UpdateJob -> 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
"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
"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
"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
          ]
      )

instance Data.ToPath UpdateJob where
  toPath :: UpdateJob -> ByteString
toPath UpdateJob' {Maybe Text
Maybe AbortConfig
Maybe PresignedUrlConfig
Maybe JobExecutionsRolloutConfig
Maybe JobExecutionsRetryConfig
Maybe TimeoutConfig
Text
jobId :: Text
timeoutConfig :: Maybe TimeoutConfig
presignedUrlConfig :: Maybe PresignedUrlConfig
namespaceId :: Maybe Text
jobExecutionsRolloutConfig :: Maybe JobExecutionsRolloutConfig
jobExecutionsRetryConfig :: Maybe JobExecutionsRetryConfig
description :: Maybe Text
abortConfig :: Maybe AbortConfig
$sel:jobId:UpdateJob' :: UpdateJob -> Text
$sel:timeoutConfig:UpdateJob' :: UpdateJob -> Maybe TimeoutConfig
$sel:presignedUrlConfig:UpdateJob' :: UpdateJob -> Maybe PresignedUrlConfig
$sel:namespaceId:UpdateJob' :: UpdateJob -> Maybe Text
$sel:jobExecutionsRolloutConfig:UpdateJob' :: UpdateJob -> Maybe JobExecutionsRolloutConfig
$sel:jobExecutionsRetryConfig:UpdateJob' :: UpdateJob -> Maybe JobExecutionsRetryConfig
$sel:description:UpdateJob' :: UpdateJob -> Maybe Text
$sel:abortConfig:UpdateJob' :: UpdateJob -> 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 UpdateJob where
  toQuery :: UpdateJob -> QueryString
toQuery UpdateJob' {Maybe Text
Maybe AbortConfig
Maybe PresignedUrlConfig
Maybe JobExecutionsRolloutConfig
Maybe JobExecutionsRetryConfig
Maybe TimeoutConfig
Text
jobId :: Text
timeoutConfig :: Maybe TimeoutConfig
presignedUrlConfig :: Maybe PresignedUrlConfig
namespaceId :: Maybe Text
jobExecutionsRolloutConfig :: Maybe JobExecutionsRolloutConfig
jobExecutionsRetryConfig :: Maybe JobExecutionsRetryConfig
description :: Maybe Text
abortConfig :: Maybe AbortConfig
$sel:jobId:UpdateJob' :: UpdateJob -> Text
$sel:timeoutConfig:UpdateJob' :: UpdateJob -> Maybe TimeoutConfig
$sel:presignedUrlConfig:UpdateJob' :: UpdateJob -> Maybe PresignedUrlConfig
$sel:namespaceId:UpdateJob' :: UpdateJob -> Maybe Text
$sel:jobExecutionsRolloutConfig:UpdateJob' :: UpdateJob -> Maybe JobExecutionsRolloutConfig
$sel:jobExecutionsRetryConfig:UpdateJob' :: UpdateJob -> Maybe JobExecutionsRetryConfig
$sel:description:UpdateJob' :: UpdateJob -> Maybe Text
$sel:abortConfig:UpdateJob' :: UpdateJob -> Maybe AbortConfig
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"namespaceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
namespaceId]

-- | /See:/ 'newUpdateJobResponse' smart constructor.
data UpdateJobResponse = UpdateJobResponse'
  {
  }
  deriving (UpdateJobResponse -> UpdateJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateJobResponse -> UpdateJobResponse -> Bool
$c/= :: UpdateJobResponse -> UpdateJobResponse -> Bool
== :: UpdateJobResponse -> UpdateJobResponse -> Bool
$c== :: UpdateJobResponse -> UpdateJobResponse -> Bool
Prelude.Eq, ReadPrec [UpdateJobResponse]
ReadPrec UpdateJobResponse
Int -> ReadS UpdateJobResponse
ReadS [UpdateJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateJobResponse]
$creadListPrec :: ReadPrec [UpdateJobResponse]
readPrec :: ReadPrec UpdateJobResponse
$creadPrec :: ReadPrec UpdateJobResponse
readList :: ReadS [UpdateJobResponse]
$creadList :: ReadS [UpdateJobResponse]
readsPrec :: Int -> ReadS UpdateJobResponse
$creadsPrec :: Int -> ReadS UpdateJobResponse
Prelude.Read, Int -> UpdateJobResponse -> ShowS
[UpdateJobResponse] -> ShowS
UpdateJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateJobResponse] -> ShowS
$cshowList :: [UpdateJobResponse] -> ShowS
show :: UpdateJobResponse -> String
$cshow :: UpdateJobResponse -> String
showsPrec :: Int -> UpdateJobResponse -> ShowS
$cshowsPrec :: Int -> UpdateJobResponse -> ShowS
Prelude.Show, forall x. Rep UpdateJobResponse x -> UpdateJobResponse
forall x. UpdateJobResponse -> Rep UpdateJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateJobResponse x -> UpdateJobResponse
$cfrom :: forall x. UpdateJobResponse -> Rep UpdateJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateJobResponse' 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.
newUpdateJobResponse ::
  UpdateJobResponse
newUpdateJobResponse :: UpdateJobResponse
newUpdateJobResponse = UpdateJobResponse
UpdateJobResponse'

instance Prelude.NFData UpdateJobResponse where
  rnf :: UpdateJobResponse -> ()
rnf UpdateJobResponse
_ = ()