{-# 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.SSM.RegisterTaskWithMaintenanceWindow
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds a new task to a maintenance window.
module Amazonka.SSM.RegisterTaskWithMaintenanceWindow
  ( -- * Creating a Request
    RegisterTaskWithMaintenanceWindow (..),
    newRegisterTaskWithMaintenanceWindow,

    -- * Request Lenses
    registerTaskWithMaintenanceWindow_alarmConfiguration,
    registerTaskWithMaintenanceWindow_clientToken,
    registerTaskWithMaintenanceWindow_cutoffBehavior,
    registerTaskWithMaintenanceWindow_description,
    registerTaskWithMaintenanceWindow_loggingInfo,
    registerTaskWithMaintenanceWindow_maxConcurrency,
    registerTaskWithMaintenanceWindow_maxErrors,
    registerTaskWithMaintenanceWindow_name,
    registerTaskWithMaintenanceWindow_priority,
    registerTaskWithMaintenanceWindow_serviceRoleArn,
    registerTaskWithMaintenanceWindow_targets,
    registerTaskWithMaintenanceWindow_taskInvocationParameters,
    registerTaskWithMaintenanceWindow_taskParameters,
    registerTaskWithMaintenanceWindow_windowId,
    registerTaskWithMaintenanceWindow_taskArn,
    registerTaskWithMaintenanceWindow_taskType,

    -- * Destructuring the Response
    RegisterTaskWithMaintenanceWindowResponse (..),
    newRegisterTaskWithMaintenanceWindowResponse,

    -- * Response Lenses
    registerTaskWithMaintenanceWindowResponse_windowTaskId,
    registerTaskWithMaintenanceWindowResponse_httpStatus,
  )
where

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
import Amazonka.SSM.Types

-- | /See:/ 'newRegisterTaskWithMaintenanceWindow' smart constructor.
data RegisterTaskWithMaintenanceWindow = RegisterTaskWithMaintenanceWindow'
  { -- | The CloudWatch alarm you want to apply to your maintenance window task.
    RegisterTaskWithMaintenanceWindow -> Maybe AlarmConfiguration
alarmConfiguration :: Prelude.Maybe AlarmConfiguration,
    -- | User-provided idempotency token.
    RegisterTaskWithMaintenanceWindow -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether tasks should continue to run after the cutoff time
    -- specified in the maintenance windows is reached.
    --
    -- -   @CONTINUE_TASK@: When the cutoff time is reached, any tasks that are
    --     running continue. The default value.
    --
    -- -   @CANCEL_TASK@:
    --
    --     -   For Automation, Lambda, Step Functions tasks: When the cutoff
    --         time is reached, any task invocations that are already running
    --         continue, but no new task invocations are started.
    --
    --     -   For Run Command tasks: When the cutoff time is reached, the
    --         system sends a CancelCommand operation that attempts to cancel
    --         the command associated with the task. However, there is no
    --         guarantee that the command will be terminated and the underlying
    --         process stopped.
    --
    --     The status for tasks that are not completed is @TIMED_OUT@.
    RegisterTaskWithMaintenanceWindow
-> Maybe MaintenanceWindowTaskCutoffBehavior
cutoffBehavior :: Prelude.Maybe MaintenanceWindowTaskCutoffBehavior,
    -- | An optional description for the task.
    RegisterTaskWithMaintenanceWindow -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A structure containing information about an Amazon Simple Storage
    -- Service (Amazon S3) bucket to write managed node-level logs to.
    --
    -- @LoggingInfo@ has been deprecated. To specify an Amazon Simple Storage
    -- Service (Amazon S3) bucket to contain logs, instead use the
    -- @OutputS3BucketName@ and @OutputS3KeyPrefix@ options in the
    -- @TaskInvocationParameters@ structure. For information about how Amazon
    -- Web Services Systems Manager handles these options for the supported
    -- maintenance window task types, see
    -- MaintenanceWindowTaskInvocationParameters.
    RegisterTaskWithMaintenanceWindow -> Maybe LoggingInfo
loggingInfo :: Prelude.Maybe LoggingInfo,
    -- | The maximum number of targets this task can be run for, in parallel.
    --
    -- Although this element is listed as \"Required: No\", a value can be
    -- omitted only when you are registering or updating a
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/maintenance-windows-targetless-tasks.html targetless task>
    -- You must provide a value in all other cases.
    --
    -- For maintenance window tasks without a target specified, you can\'t
    -- supply a value for this option. Instead, the system inserts a
    -- placeholder value of @1@. This value doesn\'t affect the running of your
    -- task.
    RegisterTaskWithMaintenanceWindow -> Maybe Text
maxConcurrency :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of errors allowed before this task stops being
    -- scheduled.
    --
    -- Although this element is listed as \"Required: No\", a value can be
    -- omitted only when you are registering or updating a
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/maintenance-windows-targetless-tasks.html targetless task>
    -- You must provide a value in all other cases.
    --
    -- For maintenance window tasks without a target specified, you can\'t
    -- supply a value for this option. Instead, the system inserts a
    -- placeholder value of @1@. This value doesn\'t affect the running of your
    -- task.
    RegisterTaskWithMaintenanceWindow -> Maybe Text
maxErrors :: Prelude.Maybe Prelude.Text,
    -- | An optional name for the task.
    RegisterTaskWithMaintenanceWindow -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The priority of the task in the maintenance window, the lower the number
    -- the higher the priority. Tasks in a maintenance window are scheduled in
    -- priority order with tasks that have the same priority scheduled in
    -- parallel.
    RegisterTaskWithMaintenanceWindow -> Maybe Natural
priority :: Prelude.Maybe Prelude.Natural,
    -- | The Amazon Resource Name (ARN) of the IAM service role for Amazon Web
    -- Services Systems Manager to assume when running a maintenance window
    -- task. If you do not specify a service role ARN, Systems Manager uses
    -- your account\'s service-linked role. If no service-linked role for
    -- Systems Manager exists in your account, it is created when you run
    -- @RegisterTaskWithMaintenanceWindow@.
    --
    -- For more information, see the following topics in the in the /Amazon Web
    -- Services Systems Manager User Guide/:
    --
    -- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/using-service-linked-roles.html#slr-permissions Using service-linked roles for Systems Manager>
    --
    -- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/sysman-maintenance-permissions.html#maintenance-window-tasks-service-role Should I use a service-linked role or a custom service role to run maintenance window tasks?>
    RegisterTaskWithMaintenanceWindow -> Maybe Text
serviceRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The targets (either managed nodes or maintenance window targets).
    --
    -- One or more targets must be specified for maintenance window Run
    -- Command-type tasks. Depending on the task, targets are optional for
    -- other maintenance window task types (Automation, Lambda, and Step
    -- Functions). For more information about running tasks that don\'t specify
    -- targets, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/maintenance-windows-targetless-tasks.html Registering maintenance window tasks without targets>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    --
    -- Specify managed nodes using the following format:
    --
    -- @Key=InstanceIds,Values=\<instance-id-1>,\<instance-id-2>@
    --
    -- Specify maintenance window targets using the following format:
    --
    -- @Key=WindowTargetIds,Values=\<window-target-id-1>,\<window-target-id-2>@
    RegisterTaskWithMaintenanceWindow -> Maybe [Target]
targets :: Prelude.Maybe [Target],
    -- | The parameters that the task should use during execution. Populate only
    -- the fields that match the task type. All other fields should be empty.
    RegisterTaskWithMaintenanceWindow
-> Maybe MaintenanceWindowTaskInvocationParameters
taskInvocationParameters :: Prelude.Maybe MaintenanceWindowTaskInvocationParameters,
    -- | The parameters that should be passed to the task when it is run.
    --
    -- @TaskParameters@ has been deprecated. To specify parameters to pass to a
    -- task when it runs, instead use the @Parameters@ option in the
    -- @TaskInvocationParameters@ structure. For information about how Systems
    -- Manager handles these options for the supported maintenance window task
    -- types, see MaintenanceWindowTaskInvocationParameters.
    RegisterTaskWithMaintenanceWindow
-> Maybe
     (Sensitive
        (HashMap
           Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskParameters :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text (Data.Sensitive MaintenanceWindowTaskParameterValueExpression))),
    -- | The ID of the maintenance window the task should be added to.
    RegisterTaskWithMaintenanceWindow -> Text
windowId :: Prelude.Text,
    -- | The ARN of the task to run.
    RegisterTaskWithMaintenanceWindow -> Text
taskArn :: Prelude.Text,
    -- | The type of task being registered.
    RegisterTaskWithMaintenanceWindow -> MaintenanceWindowTaskType
taskType :: MaintenanceWindowTaskType
  }
  deriving (RegisterTaskWithMaintenanceWindow
-> RegisterTaskWithMaintenanceWindow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterTaskWithMaintenanceWindow
-> RegisterTaskWithMaintenanceWindow -> Bool
$c/= :: RegisterTaskWithMaintenanceWindow
-> RegisterTaskWithMaintenanceWindow -> Bool
== :: RegisterTaskWithMaintenanceWindow
-> RegisterTaskWithMaintenanceWindow -> Bool
$c== :: RegisterTaskWithMaintenanceWindow
-> RegisterTaskWithMaintenanceWindow -> Bool
Prelude.Eq, Int -> RegisterTaskWithMaintenanceWindow -> ShowS
[RegisterTaskWithMaintenanceWindow] -> ShowS
RegisterTaskWithMaintenanceWindow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterTaskWithMaintenanceWindow] -> ShowS
$cshowList :: [RegisterTaskWithMaintenanceWindow] -> ShowS
show :: RegisterTaskWithMaintenanceWindow -> String
$cshow :: RegisterTaskWithMaintenanceWindow -> String
showsPrec :: Int -> RegisterTaskWithMaintenanceWindow -> ShowS
$cshowsPrec :: Int -> RegisterTaskWithMaintenanceWindow -> ShowS
Prelude.Show, forall x.
Rep RegisterTaskWithMaintenanceWindow x
-> RegisterTaskWithMaintenanceWindow
forall x.
RegisterTaskWithMaintenanceWindow
-> Rep RegisterTaskWithMaintenanceWindow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterTaskWithMaintenanceWindow x
-> RegisterTaskWithMaintenanceWindow
$cfrom :: forall x.
RegisterTaskWithMaintenanceWindow
-> Rep RegisterTaskWithMaintenanceWindow x
Prelude.Generic)

-- |
-- Create a value of 'RegisterTaskWithMaintenanceWindow' 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:
--
-- 'alarmConfiguration', 'registerTaskWithMaintenanceWindow_alarmConfiguration' - The CloudWatch alarm you want to apply to your maintenance window task.
--
-- 'clientToken', 'registerTaskWithMaintenanceWindow_clientToken' - User-provided idempotency token.
--
-- 'cutoffBehavior', 'registerTaskWithMaintenanceWindow_cutoffBehavior' - Indicates whether tasks should continue to run after the cutoff time
-- specified in the maintenance windows is reached.
--
-- -   @CONTINUE_TASK@: When the cutoff time is reached, any tasks that are
--     running continue. The default value.
--
-- -   @CANCEL_TASK@:
--
--     -   For Automation, Lambda, Step Functions tasks: When the cutoff
--         time is reached, any task invocations that are already running
--         continue, but no new task invocations are started.
--
--     -   For Run Command tasks: When the cutoff time is reached, the
--         system sends a CancelCommand operation that attempts to cancel
--         the command associated with the task. However, there is no
--         guarantee that the command will be terminated and the underlying
--         process stopped.
--
--     The status for tasks that are not completed is @TIMED_OUT@.
--
-- 'description', 'registerTaskWithMaintenanceWindow_description' - An optional description for the task.
--
-- 'loggingInfo', 'registerTaskWithMaintenanceWindow_loggingInfo' - A structure containing information about an Amazon Simple Storage
-- Service (Amazon S3) bucket to write managed node-level logs to.
--
-- @LoggingInfo@ has been deprecated. To specify an Amazon Simple Storage
-- Service (Amazon S3) bucket to contain logs, instead use the
-- @OutputS3BucketName@ and @OutputS3KeyPrefix@ options in the
-- @TaskInvocationParameters@ structure. For information about how Amazon
-- Web Services Systems Manager handles these options for the supported
-- maintenance window task types, see
-- MaintenanceWindowTaskInvocationParameters.
--
-- 'maxConcurrency', 'registerTaskWithMaintenanceWindow_maxConcurrency' - The maximum number of targets this task can be run for, in parallel.
--
-- Although this element is listed as \"Required: No\", a value can be
-- omitted only when you are registering or updating a
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/maintenance-windows-targetless-tasks.html targetless task>
-- You must provide a value in all other cases.
--
-- For maintenance window tasks without a target specified, you can\'t
-- supply a value for this option. Instead, the system inserts a
-- placeholder value of @1@. This value doesn\'t affect the running of your
-- task.
--
-- 'maxErrors', 'registerTaskWithMaintenanceWindow_maxErrors' - The maximum number of errors allowed before this task stops being
-- scheduled.
--
-- Although this element is listed as \"Required: No\", a value can be
-- omitted only when you are registering or updating a
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/maintenance-windows-targetless-tasks.html targetless task>
-- You must provide a value in all other cases.
--
-- For maintenance window tasks without a target specified, you can\'t
-- supply a value for this option. Instead, the system inserts a
-- placeholder value of @1@. This value doesn\'t affect the running of your
-- task.
--
-- 'name', 'registerTaskWithMaintenanceWindow_name' - An optional name for the task.
--
-- 'priority', 'registerTaskWithMaintenanceWindow_priority' - The priority of the task in the maintenance window, the lower the number
-- the higher the priority. Tasks in a maintenance window are scheduled in
-- priority order with tasks that have the same priority scheduled in
-- parallel.
--
-- 'serviceRoleArn', 'registerTaskWithMaintenanceWindow_serviceRoleArn' - The Amazon Resource Name (ARN) of the IAM service role for Amazon Web
-- Services Systems Manager to assume when running a maintenance window
-- task. If you do not specify a service role ARN, Systems Manager uses
-- your account\'s service-linked role. If no service-linked role for
-- Systems Manager exists in your account, it is created when you run
-- @RegisterTaskWithMaintenanceWindow@.
--
-- For more information, see the following topics in the in the /Amazon Web
-- Services Systems Manager User Guide/:
--
-- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/using-service-linked-roles.html#slr-permissions Using service-linked roles for Systems Manager>
--
-- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/sysman-maintenance-permissions.html#maintenance-window-tasks-service-role Should I use a service-linked role or a custom service role to run maintenance window tasks?>
--
-- 'targets', 'registerTaskWithMaintenanceWindow_targets' - The targets (either managed nodes or maintenance window targets).
--
-- One or more targets must be specified for maintenance window Run
-- Command-type tasks. Depending on the task, targets are optional for
-- other maintenance window task types (Automation, Lambda, and Step
-- Functions). For more information about running tasks that don\'t specify
-- targets, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/maintenance-windows-targetless-tasks.html Registering maintenance window tasks without targets>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- Specify managed nodes using the following format:
--
-- @Key=InstanceIds,Values=\<instance-id-1>,\<instance-id-2>@
--
-- Specify maintenance window targets using the following format:
--
-- @Key=WindowTargetIds,Values=\<window-target-id-1>,\<window-target-id-2>@
--
-- 'taskInvocationParameters', 'registerTaskWithMaintenanceWindow_taskInvocationParameters' - The parameters that the task should use during execution. Populate only
-- the fields that match the task type. All other fields should be empty.
--
-- 'taskParameters', 'registerTaskWithMaintenanceWindow_taskParameters' - The parameters that should be passed to the task when it is run.
--
-- @TaskParameters@ has been deprecated. To specify parameters to pass to a
-- task when it runs, instead use the @Parameters@ option in the
-- @TaskInvocationParameters@ structure. For information about how Systems
-- Manager handles these options for the supported maintenance window task
-- types, see MaintenanceWindowTaskInvocationParameters.
--
-- 'windowId', 'registerTaskWithMaintenanceWindow_windowId' - The ID of the maintenance window the task should be added to.
--
-- 'taskArn', 'registerTaskWithMaintenanceWindow_taskArn' - The ARN of the task to run.
--
-- 'taskType', 'registerTaskWithMaintenanceWindow_taskType' - The type of task being registered.
newRegisterTaskWithMaintenanceWindow ::
  -- | 'windowId'
  Prelude.Text ->
  -- | 'taskArn'
  Prelude.Text ->
  -- | 'taskType'
  MaintenanceWindowTaskType ->
  RegisterTaskWithMaintenanceWindow
newRegisterTaskWithMaintenanceWindow :: Text
-> Text
-> MaintenanceWindowTaskType
-> RegisterTaskWithMaintenanceWindow
newRegisterTaskWithMaintenanceWindow
  Text
pWindowId_
  Text
pTaskArn_
  MaintenanceWindowTaskType
pTaskType_ =
    RegisterTaskWithMaintenanceWindow'
      { $sel:alarmConfiguration:RegisterTaskWithMaintenanceWindow' :: Maybe AlarmConfiguration
alarmConfiguration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clientToken:RegisterTaskWithMaintenanceWindow' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:cutoffBehavior:RegisterTaskWithMaintenanceWindow' :: Maybe MaintenanceWindowTaskCutoffBehavior
cutoffBehavior = forall a. Maybe a
Prelude.Nothing,
        $sel:description:RegisterTaskWithMaintenanceWindow' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
        $sel:loggingInfo:RegisterTaskWithMaintenanceWindow' :: Maybe LoggingInfo
loggingInfo = forall a. Maybe a
Prelude.Nothing,
        $sel:maxConcurrency:RegisterTaskWithMaintenanceWindow' :: Maybe Text
maxConcurrency = forall a. Maybe a
Prelude.Nothing,
        $sel:maxErrors:RegisterTaskWithMaintenanceWindow' :: Maybe Text
maxErrors = forall a. Maybe a
Prelude.Nothing,
        $sel:name:RegisterTaskWithMaintenanceWindow' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:priority:RegisterTaskWithMaintenanceWindow' :: Maybe Natural
priority = forall a. Maybe a
Prelude.Nothing,
        $sel:serviceRoleArn:RegisterTaskWithMaintenanceWindow' :: Maybe Text
serviceRoleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:targets:RegisterTaskWithMaintenanceWindow' :: Maybe [Target]
targets = forall a. Maybe a
Prelude.Nothing,
        $sel:taskInvocationParameters:RegisterTaskWithMaintenanceWindow' :: Maybe MaintenanceWindowTaskInvocationParameters
taskInvocationParameters =
          forall a. Maybe a
Prelude.Nothing,
        $sel:taskParameters:RegisterTaskWithMaintenanceWindow' :: Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:windowId:RegisterTaskWithMaintenanceWindow' :: Text
windowId = Text
pWindowId_,
        $sel:taskArn:RegisterTaskWithMaintenanceWindow' :: Text
taskArn = Text
pTaskArn_,
        $sel:taskType:RegisterTaskWithMaintenanceWindow' :: MaintenanceWindowTaskType
taskType = MaintenanceWindowTaskType
pTaskType_
      }

-- | The CloudWatch alarm you want to apply to your maintenance window task.
registerTaskWithMaintenanceWindow_alarmConfiguration :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe AlarmConfiguration)
registerTaskWithMaintenanceWindow_alarmConfiguration :: Lens' RegisterTaskWithMaintenanceWindow (Maybe AlarmConfiguration)
registerTaskWithMaintenanceWindow_alarmConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe AlarmConfiguration
alarmConfiguration :: Maybe AlarmConfiguration
$sel:alarmConfiguration:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe AlarmConfiguration
alarmConfiguration} -> Maybe AlarmConfiguration
alarmConfiguration) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe AlarmConfiguration
a -> RegisterTaskWithMaintenanceWindow
s {$sel:alarmConfiguration:RegisterTaskWithMaintenanceWindow' :: Maybe AlarmConfiguration
alarmConfiguration = Maybe AlarmConfiguration
a} :: RegisterTaskWithMaintenanceWindow)

-- | User-provided idempotency token.
registerTaskWithMaintenanceWindow_clientToken :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe Prelude.Text)
registerTaskWithMaintenanceWindow_clientToken :: Lens' RegisterTaskWithMaintenanceWindow (Maybe Text)
registerTaskWithMaintenanceWindow_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe Text
a -> RegisterTaskWithMaintenanceWindow
s {$sel:clientToken:RegisterTaskWithMaintenanceWindow' :: Maybe Text
clientToken = Maybe Text
a} :: RegisterTaskWithMaintenanceWindow)

-- | Indicates whether tasks should continue to run after the cutoff time
-- specified in the maintenance windows is reached.
--
-- -   @CONTINUE_TASK@: When the cutoff time is reached, any tasks that are
--     running continue. The default value.
--
-- -   @CANCEL_TASK@:
--
--     -   For Automation, Lambda, Step Functions tasks: When the cutoff
--         time is reached, any task invocations that are already running
--         continue, but no new task invocations are started.
--
--     -   For Run Command tasks: When the cutoff time is reached, the
--         system sends a CancelCommand operation that attempts to cancel
--         the command associated with the task. However, there is no
--         guarantee that the command will be terminated and the underlying
--         process stopped.
--
--     The status for tasks that are not completed is @TIMED_OUT@.
registerTaskWithMaintenanceWindow_cutoffBehavior :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe MaintenanceWindowTaskCutoffBehavior)
registerTaskWithMaintenanceWindow_cutoffBehavior :: Lens'
  RegisterTaskWithMaintenanceWindow
  (Maybe MaintenanceWindowTaskCutoffBehavior)
registerTaskWithMaintenanceWindow_cutoffBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe MaintenanceWindowTaskCutoffBehavior
cutoffBehavior :: Maybe MaintenanceWindowTaskCutoffBehavior
$sel:cutoffBehavior:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe MaintenanceWindowTaskCutoffBehavior
cutoffBehavior} -> Maybe MaintenanceWindowTaskCutoffBehavior
cutoffBehavior) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe MaintenanceWindowTaskCutoffBehavior
a -> RegisterTaskWithMaintenanceWindow
s {$sel:cutoffBehavior:RegisterTaskWithMaintenanceWindow' :: Maybe MaintenanceWindowTaskCutoffBehavior
cutoffBehavior = Maybe MaintenanceWindowTaskCutoffBehavior
a} :: RegisterTaskWithMaintenanceWindow)

-- | An optional description for the task.
registerTaskWithMaintenanceWindow_description :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe Prelude.Text)
registerTaskWithMaintenanceWindow_description :: Lens' RegisterTaskWithMaintenanceWindow (Maybe Text)
registerTaskWithMaintenanceWindow_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe (Sensitive Text)
a -> RegisterTaskWithMaintenanceWindow
s {$sel:description:RegisterTaskWithMaintenanceWindow' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: RegisterTaskWithMaintenanceWindow) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | A structure containing information about an Amazon Simple Storage
-- Service (Amazon S3) bucket to write managed node-level logs to.
--
-- @LoggingInfo@ has been deprecated. To specify an Amazon Simple Storage
-- Service (Amazon S3) bucket to contain logs, instead use the
-- @OutputS3BucketName@ and @OutputS3KeyPrefix@ options in the
-- @TaskInvocationParameters@ structure. For information about how Amazon
-- Web Services Systems Manager handles these options for the supported
-- maintenance window task types, see
-- MaintenanceWindowTaskInvocationParameters.
registerTaskWithMaintenanceWindow_loggingInfo :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe LoggingInfo)
registerTaskWithMaintenanceWindow_loggingInfo :: Lens' RegisterTaskWithMaintenanceWindow (Maybe LoggingInfo)
registerTaskWithMaintenanceWindow_loggingInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe LoggingInfo
loggingInfo :: Maybe LoggingInfo
$sel:loggingInfo:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe LoggingInfo
loggingInfo} -> Maybe LoggingInfo
loggingInfo) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe LoggingInfo
a -> RegisterTaskWithMaintenanceWindow
s {$sel:loggingInfo:RegisterTaskWithMaintenanceWindow' :: Maybe LoggingInfo
loggingInfo = Maybe LoggingInfo
a} :: RegisterTaskWithMaintenanceWindow)

-- | The maximum number of targets this task can be run for, in parallel.
--
-- Although this element is listed as \"Required: No\", a value can be
-- omitted only when you are registering or updating a
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/maintenance-windows-targetless-tasks.html targetless task>
-- You must provide a value in all other cases.
--
-- For maintenance window tasks without a target specified, you can\'t
-- supply a value for this option. Instead, the system inserts a
-- placeholder value of @1@. This value doesn\'t affect the running of your
-- task.
registerTaskWithMaintenanceWindow_maxConcurrency :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe Prelude.Text)
registerTaskWithMaintenanceWindow_maxConcurrency :: Lens' RegisterTaskWithMaintenanceWindow (Maybe Text)
registerTaskWithMaintenanceWindow_maxConcurrency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe Text
maxConcurrency :: Maybe Text
$sel:maxConcurrency:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
maxConcurrency} -> Maybe Text
maxConcurrency) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe Text
a -> RegisterTaskWithMaintenanceWindow
s {$sel:maxConcurrency:RegisterTaskWithMaintenanceWindow' :: Maybe Text
maxConcurrency = Maybe Text
a} :: RegisterTaskWithMaintenanceWindow)

-- | The maximum number of errors allowed before this task stops being
-- scheduled.
--
-- Although this element is listed as \"Required: No\", a value can be
-- omitted only when you are registering or updating a
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/maintenance-windows-targetless-tasks.html targetless task>
-- You must provide a value in all other cases.
--
-- For maintenance window tasks without a target specified, you can\'t
-- supply a value for this option. Instead, the system inserts a
-- placeholder value of @1@. This value doesn\'t affect the running of your
-- task.
registerTaskWithMaintenanceWindow_maxErrors :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe Prelude.Text)
registerTaskWithMaintenanceWindow_maxErrors :: Lens' RegisterTaskWithMaintenanceWindow (Maybe Text)
registerTaskWithMaintenanceWindow_maxErrors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe Text
maxErrors :: Maybe Text
$sel:maxErrors:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
maxErrors} -> Maybe Text
maxErrors) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe Text
a -> RegisterTaskWithMaintenanceWindow
s {$sel:maxErrors:RegisterTaskWithMaintenanceWindow' :: Maybe Text
maxErrors = Maybe Text
a} :: RegisterTaskWithMaintenanceWindow)

-- | An optional name for the task.
registerTaskWithMaintenanceWindow_name :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe Prelude.Text)
registerTaskWithMaintenanceWindow_name :: Lens' RegisterTaskWithMaintenanceWindow (Maybe Text)
registerTaskWithMaintenanceWindow_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe Text
name :: Maybe Text
$sel:name:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
name} -> Maybe Text
name) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe Text
a -> RegisterTaskWithMaintenanceWindow
s {$sel:name:RegisterTaskWithMaintenanceWindow' :: Maybe Text
name = Maybe Text
a} :: RegisterTaskWithMaintenanceWindow)

-- | The priority of the task in the maintenance window, the lower the number
-- the higher the priority. Tasks in a maintenance window are scheduled in
-- priority order with tasks that have the same priority scheduled in
-- parallel.
registerTaskWithMaintenanceWindow_priority :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe Prelude.Natural)
registerTaskWithMaintenanceWindow_priority :: Lens' RegisterTaskWithMaintenanceWindow (Maybe Natural)
registerTaskWithMaintenanceWindow_priority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe Natural
priority :: Maybe Natural
$sel:priority:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Natural
priority} -> Maybe Natural
priority) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe Natural
a -> RegisterTaskWithMaintenanceWindow
s {$sel:priority:RegisterTaskWithMaintenanceWindow' :: Maybe Natural
priority = Maybe Natural
a} :: RegisterTaskWithMaintenanceWindow)

-- | The Amazon Resource Name (ARN) of the IAM service role for Amazon Web
-- Services Systems Manager to assume when running a maintenance window
-- task. If you do not specify a service role ARN, Systems Manager uses
-- your account\'s service-linked role. If no service-linked role for
-- Systems Manager exists in your account, it is created when you run
-- @RegisterTaskWithMaintenanceWindow@.
--
-- For more information, see the following topics in the in the /Amazon Web
-- Services Systems Manager User Guide/:
--
-- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/using-service-linked-roles.html#slr-permissions Using service-linked roles for Systems Manager>
--
-- -   <https://docs.aws.amazon.com/systems-manager/latest/userguide/sysman-maintenance-permissions.html#maintenance-window-tasks-service-role Should I use a service-linked role or a custom service role to run maintenance window tasks?>
registerTaskWithMaintenanceWindow_serviceRoleArn :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe Prelude.Text)
registerTaskWithMaintenanceWindow_serviceRoleArn :: Lens' RegisterTaskWithMaintenanceWindow (Maybe Text)
registerTaskWithMaintenanceWindow_serviceRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe Text
serviceRoleArn :: Maybe Text
$sel:serviceRoleArn:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
serviceRoleArn} -> Maybe Text
serviceRoleArn) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe Text
a -> RegisterTaskWithMaintenanceWindow
s {$sel:serviceRoleArn:RegisterTaskWithMaintenanceWindow' :: Maybe Text
serviceRoleArn = Maybe Text
a} :: RegisterTaskWithMaintenanceWindow)

-- | The targets (either managed nodes or maintenance window targets).
--
-- One or more targets must be specified for maintenance window Run
-- Command-type tasks. Depending on the task, targets are optional for
-- other maintenance window task types (Automation, Lambda, and Step
-- Functions). For more information about running tasks that don\'t specify
-- targets, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/maintenance-windows-targetless-tasks.html Registering maintenance window tasks without targets>
-- in the /Amazon Web Services Systems Manager User Guide/.
--
-- Specify managed nodes using the following format:
--
-- @Key=InstanceIds,Values=\<instance-id-1>,\<instance-id-2>@
--
-- Specify maintenance window targets using the following format:
--
-- @Key=WindowTargetIds,Values=\<window-target-id-1>,\<window-target-id-2>@
registerTaskWithMaintenanceWindow_targets :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe [Target])
registerTaskWithMaintenanceWindow_targets :: Lens' RegisterTaskWithMaintenanceWindow (Maybe [Target])
registerTaskWithMaintenanceWindow_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe [Target]
targets :: Maybe [Target]
$sel:targets:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe [Target]
targets} -> Maybe [Target]
targets) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe [Target]
a -> RegisterTaskWithMaintenanceWindow
s {$sel:targets:RegisterTaskWithMaintenanceWindow' :: Maybe [Target]
targets = Maybe [Target]
a} :: RegisterTaskWithMaintenanceWindow) 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 parameters that the task should use during execution. Populate only
-- the fields that match the task type. All other fields should be empty.
registerTaskWithMaintenanceWindow_taskInvocationParameters :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe MaintenanceWindowTaskInvocationParameters)
registerTaskWithMaintenanceWindow_taskInvocationParameters :: Lens'
  RegisterTaskWithMaintenanceWindow
  (Maybe MaintenanceWindowTaskInvocationParameters)
registerTaskWithMaintenanceWindow_taskInvocationParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe MaintenanceWindowTaskInvocationParameters
taskInvocationParameters :: Maybe MaintenanceWindowTaskInvocationParameters
$sel:taskInvocationParameters:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe MaintenanceWindowTaskInvocationParameters
taskInvocationParameters} -> Maybe MaintenanceWindowTaskInvocationParameters
taskInvocationParameters) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe MaintenanceWindowTaskInvocationParameters
a -> RegisterTaskWithMaintenanceWindow
s {$sel:taskInvocationParameters:RegisterTaskWithMaintenanceWindow' :: Maybe MaintenanceWindowTaskInvocationParameters
taskInvocationParameters = Maybe MaintenanceWindowTaskInvocationParameters
a} :: RegisterTaskWithMaintenanceWindow)

-- | The parameters that should be passed to the task when it is run.
--
-- @TaskParameters@ has been deprecated. To specify parameters to pass to a
-- task when it runs, instead use the @Parameters@ option in the
-- @TaskInvocationParameters@ structure. For information about how Systems
-- Manager handles these options for the supported maintenance window task
-- types, see MaintenanceWindowTaskInvocationParameters.
registerTaskWithMaintenanceWindow_taskParameters :: Lens.Lens' RegisterTaskWithMaintenanceWindow (Prelude.Maybe (Prelude.HashMap Prelude.Text MaintenanceWindowTaskParameterValueExpression))
registerTaskWithMaintenanceWindow_taskParameters :: Lens'
  RegisterTaskWithMaintenanceWindow
  (Maybe
     (HashMap Text MaintenanceWindowTaskParameterValueExpression))
registerTaskWithMaintenanceWindow_taskParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskParameters :: Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
$sel:taskParameters:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe
     (Sensitive
        (HashMap
           Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskParameters} -> Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskParameters) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
a -> RegisterTaskWithMaintenanceWindow
s {$sel:taskParameters:RegisterTaskWithMaintenanceWindow' :: Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskParameters = Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
a} :: RegisterTaskWithMaintenanceWindow) 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 a. Iso' (Sensitive a) a
Data._Sensitive 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)

-- | The ID of the maintenance window the task should be added to.
registerTaskWithMaintenanceWindow_windowId :: Lens.Lens' RegisterTaskWithMaintenanceWindow Prelude.Text
registerTaskWithMaintenanceWindow_windowId :: Lens' RegisterTaskWithMaintenanceWindow Text
registerTaskWithMaintenanceWindow_windowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Text
windowId :: Text
$sel:windowId:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Text
windowId} -> Text
windowId) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Text
a -> RegisterTaskWithMaintenanceWindow
s {$sel:windowId:RegisterTaskWithMaintenanceWindow' :: Text
windowId = Text
a} :: RegisterTaskWithMaintenanceWindow)

-- | The ARN of the task to run.
registerTaskWithMaintenanceWindow_taskArn :: Lens.Lens' RegisterTaskWithMaintenanceWindow Prelude.Text
registerTaskWithMaintenanceWindow_taskArn :: Lens' RegisterTaskWithMaintenanceWindow Text
registerTaskWithMaintenanceWindow_taskArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {Text
taskArn :: Text
$sel:taskArn:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Text
taskArn} -> Text
taskArn) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} Text
a -> RegisterTaskWithMaintenanceWindow
s {$sel:taskArn:RegisterTaskWithMaintenanceWindow' :: Text
taskArn = Text
a} :: RegisterTaskWithMaintenanceWindow)

-- | The type of task being registered.
registerTaskWithMaintenanceWindow_taskType :: Lens.Lens' RegisterTaskWithMaintenanceWindow MaintenanceWindowTaskType
registerTaskWithMaintenanceWindow_taskType :: Lens' RegisterTaskWithMaintenanceWindow MaintenanceWindowTaskType
registerTaskWithMaintenanceWindow_taskType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindow' {MaintenanceWindowTaskType
taskType :: MaintenanceWindowTaskType
$sel:taskType:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> MaintenanceWindowTaskType
taskType} -> MaintenanceWindowTaskType
taskType) (\s :: RegisterTaskWithMaintenanceWindow
s@RegisterTaskWithMaintenanceWindow' {} MaintenanceWindowTaskType
a -> RegisterTaskWithMaintenanceWindow
s {$sel:taskType:RegisterTaskWithMaintenanceWindow' :: MaintenanceWindowTaskType
taskType = MaintenanceWindowTaskType
a} :: RegisterTaskWithMaintenanceWindow)

instance
  Core.AWSRequest
    RegisterTaskWithMaintenanceWindow
  where
  type
    AWSResponse RegisterTaskWithMaintenanceWindow =
      RegisterTaskWithMaintenanceWindowResponse
  request :: (Service -> Service)
-> RegisterTaskWithMaintenanceWindow
-> Request RegisterTaskWithMaintenanceWindow
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 RegisterTaskWithMaintenanceWindow
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse RegisterTaskWithMaintenanceWindow)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> RegisterTaskWithMaintenanceWindowResponse
RegisterTaskWithMaintenanceWindowResponse'
            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
"WindowTaskId")
            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
    RegisterTaskWithMaintenanceWindow
  where
  hashWithSalt :: Int -> RegisterTaskWithMaintenanceWindow -> Int
hashWithSalt
    Int
_salt
    RegisterTaskWithMaintenanceWindow' {Maybe Natural
Maybe [Target]
Maybe Text
Maybe (Sensitive Text)
Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
Maybe AlarmConfiguration
Maybe LoggingInfo
Maybe MaintenanceWindowTaskCutoffBehavior
Maybe MaintenanceWindowTaskInvocationParameters
Text
MaintenanceWindowTaskType
taskType :: MaintenanceWindowTaskType
taskArn :: Text
windowId :: Text
taskParameters :: Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskInvocationParameters :: Maybe MaintenanceWindowTaskInvocationParameters
targets :: Maybe [Target]
serviceRoleArn :: Maybe Text
priority :: Maybe Natural
name :: Maybe Text
maxErrors :: Maybe Text
maxConcurrency :: Maybe Text
loggingInfo :: Maybe LoggingInfo
description :: Maybe (Sensitive Text)
cutoffBehavior :: Maybe MaintenanceWindowTaskCutoffBehavior
clientToken :: Maybe Text
alarmConfiguration :: Maybe AlarmConfiguration
$sel:taskType:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> MaintenanceWindowTaskType
$sel:taskArn:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Text
$sel:windowId:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Text
$sel:taskParameters:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe
     (Sensitive
        (HashMap
           Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
$sel:taskInvocationParameters:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe MaintenanceWindowTaskInvocationParameters
$sel:targets:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe [Target]
$sel:serviceRoleArn:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:priority:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Natural
$sel:name:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:maxErrors:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:maxConcurrency:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:loggingInfo:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe LoggingInfo
$sel:description:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe (Sensitive Text)
$sel:cutoffBehavior:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe MaintenanceWindowTaskCutoffBehavior
$sel:clientToken:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:alarmConfiguration:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe AlarmConfiguration
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AlarmConfiguration
alarmConfiguration
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MaintenanceWindowTaskCutoffBehavior
cutoffBehavior
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
description
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoggingInfo
loggingInfo
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maxConcurrency
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maxErrors
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
priority
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceRoleArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Target]
targets
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MaintenanceWindowTaskInvocationParameters
taskInvocationParameters
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskParameters
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
windowId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
taskArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MaintenanceWindowTaskType
taskType

instance
  Prelude.NFData
    RegisterTaskWithMaintenanceWindow
  where
  rnf :: RegisterTaskWithMaintenanceWindow -> ()
rnf RegisterTaskWithMaintenanceWindow' {Maybe Natural
Maybe [Target]
Maybe Text
Maybe (Sensitive Text)
Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
Maybe AlarmConfiguration
Maybe LoggingInfo
Maybe MaintenanceWindowTaskCutoffBehavior
Maybe MaintenanceWindowTaskInvocationParameters
Text
MaintenanceWindowTaskType
taskType :: MaintenanceWindowTaskType
taskArn :: Text
windowId :: Text
taskParameters :: Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskInvocationParameters :: Maybe MaintenanceWindowTaskInvocationParameters
targets :: Maybe [Target]
serviceRoleArn :: Maybe Text
priority :: Maybe Natural
name :: Maybe Text
maxErrors :: Maybe Text
maxConcurrency :: Maybe Text
loggingInfo :: Maybe LoggingInfo
description :: Maybe (Sensitive Text)
cutoffBehavior :: Maybe MaintenanceWindowTaskCutoffBehavior
clientToken :: Maybe Text
alarmConfiguration :: Maybe AlarmConfiguration
$sel:taskType:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> MaintenanceWindowTaskType
$sel:taskArn:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Text
$sel:windowId:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Text
$sel:taskParameters:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe
     (Sensitive
        (HashMap
           Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
$sel:taskInvocationParameters:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe MaintenanceWindowTaskInvocationParameters
$sel:targets:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe [Target]
$sel:serviceRoleArn:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:priority:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Natural
$sel:name:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:maxErrors:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:maxConcurrency:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:loggingInfo:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe LoggingInfo
$sel:description:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe (Sensitive Text)
$sel:cutoffBehavior:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe MaintenanceWindowTaskCutoffBehavior
$sel:clientToken:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:alarmConfiguration:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe AlarmConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AlarmConfiguration
alarmConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MaintenanceWindowTaskCutoffBehavior
cutoffBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoggingInfo
loggingInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maxConcurrency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maxErrors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
priority
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Target]
targets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MaintenanceWindowTaskInvocationParameters
taskInvocationParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
windowId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
taskArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MaintenanceWindowTaskType
taskType

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

instance
  Data.ToJSON
    RegisterTaskWithMaintenanceWindow
  where
  toJSON :: RegisterTaskWithMaintenanceWindow -> Value
toJSON RegisterTaskWithMaintenanceWindow' {Maybe Natural
Maybe [Target]
Maybe Text
Maybe (Sensitive Text)
Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
Maybe AlarmConfiguration
Maybe LoggingInfo
Maybe MaintenanceWindowTaskCutoffBehavior
Maybe MaintenanceWindowTaskInvocationParameters
Text
MaintenanceWindowTaskType
taskType :: MaintenanceWindowTaskType
taskArn :: Text
windowId :: Text
taskParameters :: Maybe
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskInvocationParameters :: Maybe MaintenanceWindowTaskInvocationParameters
targets :: Maybe [Target]
serviceRoleArn :: Maybe Text
priority :: Maybe Natural
name :: Maybe Text
maxErrors :: Maybe Text
maxConcurrency :: Maybe Text
loggingInfo :: Maybe LoggingInfo
description :: Maybe (Sensitive Text)
cutoffBehavior :: Maybe MaintenanceWindowTaskCutoffBehavior
clientToken :: Maybe Text
alarmConfiguration :: Maybe AlarmConfiguration
$sel:taskType:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> MaintenanceWindowTaskType
$sel:taskArn:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Text
$sel:windowId:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Text
$sel:taskParameters:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe
     (Sensitive
        (HashMap
           Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
$sel:taskInvocationParameters:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe MaintenanceWindowTaskInvocationParameters
$sel:targets:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe [Target]
$sel:serviceRoleArn:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:priority:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Natural
$sel:name:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:maxErrors:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:maxConcurrency:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:loggingInfo:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe LoggingInfo
$sel:description:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe (Sensitive Text)
$sel:cutoffBehavior:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow
-> Maybe MaintenanceWindowTaskCutoffBehavior
$sel:clientToken:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe Text
$sel:alarmConfiguration:RegisterTaskWithMaintenanceWindow' :: RegisterTaskWithMaintenanceWindow -> Maybe AlarmConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AlarmConfiguration" 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 AlarmConfiguration
alarmConfiguration,
            (Key
"ClientToken" 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
clientToken,
            (Key
"CutoffBehavior" 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 MaintenanceWindowTaskCutoffBehavior
cutoffBehavior,
            (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 (Sensitive Text)
description,
            (Key
"LoggingInfo" 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 LoggingInfo
loggingInfo,
            (Key
"MaxConcurrency" 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
maxConcurrency,
            (Key
"MaxErrors" 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
maxErrors,
            (Key
"Name" 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
name,
            (Key
"Priority" 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 Natural
priority,
            (Key
"ServiceRoleArn" 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
serviceRoleArn,
            (Key
"Targets" 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 [Target]
targets,
            (Key
"TaskInvocationParameters" 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 MaintenanceWindowTaskInvocationParameters
taskInvocationParameters,
            (Key
"TaskParameters" 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
  (Sensitive
     (HashMap
        Text (Sensitive MaintenanceWindowTaskParameterValueExpression)))
taskParameters,
            forall a. a -> Maybe a
Prelude.Just (Key
"WindowId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
windowId),
            forall a. a -> Maybe a
Prelude.Just (Key
"TaskArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
taskArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"TaskType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MaintenanceWindowTaskType
taskType)
          ]
      )

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

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

-- | /See:/ 'newRegisterTaskWithMaintenanceWindowResponse' smart constructor.
data RegisterTaskWithMaintenanceWindowResponse = RegisterTaskWithMaintenanceWindowResponse'
  { -- | The ID of the task in the maintenance window.
    RegisterTaskWithMaintenanceWindowResponse -> Maybe Text
windowTaskId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    RegisterTaskWithMaintenanceWindowResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RegisterTaskWithMaintenanceWindowResponse
-> RegisterTaskWithMaintenanceWindowResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterTaskWithMaintenanceWindowResponse
-> RegisterTaskWithMaintenanceWindowResponse -> Bool
$c/= :: RegisterTaskWithMaintenanceWindowResponse
-> RegisterTaskWithMaintenanceWindowResponse -> Bool
== :: RegisterTaskWithMaintenanceWindowResponse
-> RegisterTaskWithMaintenanceWindowResponse -> Bool
$c== :: RegisterTaskWithMaintenanceWindowResponse
-> RegisterTaskWithMaintenanceWindowResponse -> Bool
Prelude.Eq, ReadPrec [RegisterTaskWithMaintenanceWindowResponse]
ReadPrec RegisterTaskWithMaintenanceWindowResponse
Int -> ReadS RegisterTaskWithMaintenanceWindowResponse
ReadS [RegisterTaskWithMaintenanceWindowResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterTaskWithMaintenanceWindowResponse]
$creadListPrec :: ReadPrec [RegisterTaskWithMaintenanceWindowResponse]
readPrec :: ReadPrec RegisterTaskWithMaintenanceWindowResponse
$creadPrec :: ReadPrec RegisterTaskWithMaintenanceWindowResponse
readList :: ReadS [RegisterTaskWithMaintenanceWindowResponse]
$creadList :: ReadS [RegisterTaskWithMaintenanceWindowResponse]
readsPrec :: Int -> ReadS RegisterTaskWithMaintenanceWindowResponse
$creadsPrec :: Int -> ReadS RegisterTaskWithMaintenanceWindowResponse
Prelude.Read, Int -> RegisterTaskWithMaintenanceWindowResponse -> ShowS
[RegisterTaskWithMaintenanceWindowResponse] -> ShowS
RegisterTaskWithMaintenanceWindowResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterTaskWithMaintenanceWindowResponse] -> ShowS
$cshowList :: [RegisterTaskWithMaintenanceWindowResponse] -> ShowS
show :: RegisterTaskWithMaintenanceWindowResponse -> String
$cshow :: RegisterTaskWithMaintenanceWindowResponse -> String
showsPrec :: Int -> RegisterTaskWithMaintenanceWindowResponse -> ShowS
$cshowsPrec :: Int -> RegisterTaskWithMaintenanceWindowResponse -> ShowS
Prelude.Show, forall x.
Rep RegisterTaskWithMaintenanceWindowResponse x
-> RegisterTaskWithMaintenanceWindowResponse
forall x.
RegisterTaskWithMaintenanceWindowResponse
-> Rep RegisterTaskWithMaintenanceWindowResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterTaskWithMaintenanceWindowResponse x
-> RegisterTaskWithMaintenanceWindowResponse
$cfrom :: forall x.
RegisterTaskWithMaintenanceWindowResponse
-> Rep RegisterTaskWithMaintenanceWindowResponse x
Prelude.Generic)

-- |
-- Create a value of 'RegisterTaskWithMaintenanceWindowResponse' 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:
--
-- 'windowTaskId', 'registerTaskWithMaintenanceWindowResponse_windowTaskId' - The ID of the task in the maintenance window.
--
-- 'httpStatus', 'registerTaskWithMaintenanceWindowResponse_httpStatus' - The response's http status code.
newRegisterTaskWithMaintenanceWindowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterTaskWithMaintenanceWindowResponse
newRegisterTaskWithMaintenanceWindowResponse :: Int -> RegisterTaskWithMaintenanceWindowResponse
newRegisterTaskWithMaintenanceWindowResponse
  Int
pHttpStatus_ =
    RegisterTaskWithMaintenanceWindowResponse'
      { $sel:windowTaskId:RegisterTaskWithMaintenanceWindowResponse' :: Maybe Text
windowTaskId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:RegisterTaskWithMaintenanceWindowResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The ID of the task in the maintenance window.
registerTaskWithMaintenanceWindowResponse_windowTaskId :: Lens.Lens' RegisterTaskWithMaintenanceWindowResponse (Prelude.Maybe Prelude.Text)
registerTaskWithMaintenanceWindowResponse_windowTaskId :: Lens' RegisterTaskWithMaintenanceWindowResponse (Maybe Text)
registerTaskWithMaintenanceWindowResponse_windowTaskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTaskWithMaintenanceWindowResponse' {Maybe Text
windowTaskId :: Maybe Text
$sel:windowTaskId:RegisterTaskWithMaintenanceWindowResponse' :: RegisterTaskWithMaintenanceWindowResponse -> Maybe Text
windowTaskId} -> Maybe Text
windowTaskId) (\s :: RegisterTaskWithMaintenanceWindowResponse
s@RegisterTaskWithMaintenanceWindowResponse' {} Maybe Text
a -> RegisterTaskWithMaintenanceWindowResponse
s {$sel:windowTaskId:RegisterTaskWithMaintenanceWindowResponse' :: Maybe Text
windowTaskId = Maybe Text
a} :: RegisterTaskWithMaintenanceWindowResponse)

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

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