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

    -- * Request Lenses
    registerTargetWithMaintenanceWindow_clientToken,
    registerTargetWithMaintenanceWindow_description,
    registerTargetWithMaintenanceWindow_name,
    registerTargetWithMaintenanceWindow_ownerInformation,
    registerTargetWithMaintenanceWindow_windowId,
    registerTargetWithMaintenanceWindow_resourceType,
    registerTargetWithMaintenanceWindow_targets,

    -- * Destructuring the Response
    RegisterTargetWithMaintenanceWindowResponse (..),
    newRegisterTargetWithMaintenanceWindowResponse,

    -- * Response Lenses
    registerTargetWithMaintenanceWindowResponse_windowTargetId,
    registerTargetWithMaintenanceWindowResponse_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:/ 'newRegisterTargetWithMaintenanceWindow' smart constructor.
data RegisterTargetWithMaintenanceWindow = RegisterTargetWithMaintenanceWindow'
  { -- | User-provided idempotency token.
    RegisterTargetWithMaintenanceWindow -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | An optional description for the target.
    RegisterTargetWithMaintenanceWindow -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | An optional name for the target.
    RegisterTargetWithMaintenanceWindow -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | User-provided value that will be included in any Amazon CloudWatch
    -- Events events raised while running tasks for these targets in this
    -- maintenance window.
    RegisterTargetWithMaintenanceWindow -> Maybe (Sensitive Text)
ownerInformation :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The ID of the maintenance window the target should be registered with.
    RegisterTargetWithMaintenanceWindow -> Text
windowId :: Prelude.Text,
    -- | The type of target being registered with the maintenance window.
    RegisterTargetWithMaintenanceWindow
-> MaintenanceWindowResourceType
resourceType :: MaintenanceWindowResourceType,
    -- | The targets to register with the maintenance window. In other words, the
    -- managed nodes to run commands on when the maintenance window runs.
    --
    -- If a single maintenance window task is registered with multiple targets,
    -- its task invocations occur sequentially and not in parallel. If your
    -- task must run on multiple targets at the same time, register a task for
    -- each target individually and assign each task the same priority level.
    --
    -- You can specify targets using managed node IDs, resource group names, or
    -- tags that have been applied to managed nodes.
    --
    -- __Example 1__: Specify managed node IDs
    --
    -- @Key=InstanceIds,Values=\<instance-id-1>,\<instance-id-2>,\<instance-id-3>@
    --
    -- __Example 2__: Use tag key-pairs applied to managed nodes
    --
    -- @Key=tag:\<my-tag-key>,Values=\<my-tag-value-1>,\<my-tag-value-2>@
    --
    -- __Example 3__: Use tag-keys applied to managed nodes
    --
    -- @Key=tag-key,Values=\<my-tag-key-1>,\<my-tag-key-2>@
    --
    -- __Example 4__: Use resource group names
    --
    -- @Key=resource-groups:Name,Values=\<resource-group-name>@
    --
    -- __Example 5__: Use filters for resource group types
    --
    -- @Key=resource-groups:ResourceTypeFilters,Values=\<resource-type-1>,\<resource-type-2>@
    --
    -- For @Key=resource-groups:ResourceTypeFilters@, specify resource types in
    -- the following format
    --
    -- @Key=resource-groups:ResourceTypeFilters,Values=AWS::EC2::INSTANCE,AWS::EC2::VPC@
    --
    -- For more information about these examples formats, including the best
    -- use case for each one, see
    -- <https://docs.aws.amazon.com/systems-manager/latest/userguide/mw-cli-tutorial-targets-examples.html Examples: Register targets with a maintenance window>
    -- in the /Amazon Web Services Systems Manager User Guide/.
    RegisterTargetWithMaintenanceWindow -> [Target]
targets :: [Target]
  }
  deriving (RegisterTargetWithMaintenanceWindow
-> RegisterTargetWithMaintenanceWindow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterTargetWithMaintenanceWindow
-> RegisterTargetWithMaintenanceWindow -> Bool
$c/= :: RegisterTargetWithMaintenanceWindow
-> RegisterTargetWithMaintenanceWindow -> Bool
== :: RegisterTargetWithMaintenanceWindow
-> RegisterTargetWithMaintenanceWindow -> Bool
$c== :: RegisterTargetWithMaintenanceWindow
-> RegisterTargetWithMaintenanceWindow -> Bool
Prelude.Eq, Int -> RegisterTargetWithMaintenanceWindow -> ShowS
[RegisterTargetWithMaintenanceWindow] -> ShowS
RegisterTargetWithMaintenanceWindow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterTargetWithMaintenanceWindow] -> ShowS
$cshowList :: [RegisterTargetWithMaintenanceWindow] -> ShowS
show :: RegisterTargetWithMaintenanceWindow -> String
$cshow :: RegisterTargetWithMaintenanceWindow -> String
showsPrec :: Int -> RegisterTargetWithMaintenanceWindow -> ShowS
$cshowsPrec :: Int -> RegisterTargetWithMaintenanceWindow -> ShowS
Prelude.Show, forall x.
Rep RegisterTargetWithMaintenanceWindow x
-> RegisterTargetWithMaintenanceWindow
forall x.
RegisterTargetWithMaintenanceWindow
-> Rep RegisterTargetWithMaintenanceWindow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RegisterTargetWithMaintenanceWindow x
-> RegisterTargetWithMaintenanceWindow
$cfrom :: forall x.
RegisterTargetWithMaintenanceWindow
-> Rep RegisterTargetWithMaintenanceWindow x
Prelude.Generic)

-- |
-- Create a value of 'RegisterTargetWithMaintenanceWindow' 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:
--
-- 'clientToken', 'registerTargetWithMaintenanceWindow_clientToken' - User-provided idempotency token.
--
-- 'description', 'registerTargetWithMaintenanceWindow_description' - An optional description for the target.
--
-- 'name', 'registerTargetWithMaintenanceWindow_name' - An optional name for the target.
--
-- 'ownerInformation', 'registerTargetWithMaintenanceWindow_ownerInformation' - User-provided value that will be included in any Amazon CloudWatch
-- Events events raised while running tasks for these targets in this
-- maintenance window.
--
-- 'windowId', 'registerTargetWithMaintenanceWindow_windowId' - The ID of the maintenance window the target should be registered with.
--
-- 'resourceType', 'registerTargetWithMaintenanceWindow_resourceType' - The type of target being registered with the maintenance window.
--
-- 'targets', 'registerTargetWithMaintenanceWindow_targets' - The targets to register with the maintenance window. In other words, the
-- managed nodes to run commands on when the maintenance window runs.
--
-- If a single maintenance window task is registered with multiple targets,
-- its task invocations occur sequentially and not in parallel. If your
-- task must run on multiple targets at the same time, register a task for
-- each target individually and assign each task the same priority level.
--
-- You can specify targets using managed node IDs, resource group names, or
-- tags that have been applied to managed nodes.
--
-- __Example 1__: Specify managed node IDs
--
-- @Key=InstanceIds,Values=\<instance-id-1>,\<instance-id-2>,\<instance-id-3>@
--
-- __Example 2__: Use tag key-pairs applied to managed nodes
--
-- @Key=tag:\<my-tag-key>,Values=\<my-tag-value-1>,\<my-tag-value-2>@
--
-- __Example 3__: Use tag-keys applied to managed nodes
--
-- @Key=tag-key,Values=\<my-tag-key-1>,\<my-tag-key-2>@
--
-- __Example 4__: Use resource group names
--
-- @Key=resource-groups:Name,Values=\<resource-group-name>@
--
-- __Example 5__: Use filters for resource group types
--
-- @Key=resource-groups:ResourceTypeFilters,Values=\<resource-type-1>,\<resource-type-2>@
--
-- For @Key=resource-groups:ResourceTypeFilters@, specify resource types in
-- the following format
--
-- @Key=resource-groups:ResourceTypeFilters,Values=AWS::EC2::INSTANCE,AWS::EC2::VPC@
--
-- For more information about these examples formats, including the best
-- use case for each one, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/mw-cli-tutorial-targets-examples.html Examples: Register targets with a maintenance window>
-- in the /Amazon Web Services Systems Manager User Guide/.
newRegisterTargetWithMaintenanceWindow ::
  -- | 'windowId'
  Prelude.Text ->
  -- | 'resourceType'
  MaintenanceWindowResourceType ->
  RegisterTargetWithMaintenanceWindow
newRegisterTargetWithMaintenanceWindow :: Text
-> MaintenanceWindowResourceType
-> RegisterTargetWithMaintenanceWindow
newRegisterTargetWithMaintenanceWindow
  Text
pWindowId_
  MaintenanceWindowResourceType
pResourceType_ =
    RegisterTargetWithMaintenanceWindow'
      { $sel:clientToken:RegisterTargetWithMaintenanceWindow' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:RegisterTargetWithMaintenanceWindow' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
        $sel:name:RegisterTargetWithMaintenanceWindow' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:ownerInformation:RegisterTargetWithMaintenanceWindow' :: Maybe (Sensitive Text)
ownerInformation = forall a. Maybe a
Prelude.Nothing,
        $sel:windowId:RegisterTargetWithMaintenanceWindow' :: Text
windowId = Text
pWindowId_,
        $sel:resourceType:RegisterTargetWithMaintenanceWindow' :: MaintenanceWindowResourceType
resourceType = MaintenanceWindowResourceType
pResourceType_,
        $sel:targets:RegisterTargetWithMaintenanceWindow' :: [Target]
targets = forall a. Monoid a => a
Prelude.mempty
      }

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

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

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

-- | User-provided value that will be included in any Amazon CloudWatch
-- Events events raised while running tasks for these targets in this
-- maintenance window.
registerTargetWithMaintenanceWindow_ownerInformation :: Lens.Lens' RegisterTargetWithMaintenanceWindow (Prelude.Maybe Prelude.Text)
registerTargetWithMaintenanceWindow_ownerInformation :: Lens' RegisterTargetWithMaintenanceWindow (Maybe Text)
registerTargetWithMaintenanceWindow_ownerInformation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTargetWithMaintenanceWindow' {Maybe (Sensitive Text)
ownerInformation :: Maybe (Sensitive Text)
$sel:ownerInformation:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe (Sensitive Text)
ownerInformation} -> Maybe (Sensitive Text)
ownerInformation) (\s :: RegisterTargetWithMaintenanceWindow
s@RegisterTargetWithMaintenanceWindow' {} Maybe (Sensitive Text)
a -> RegisterTargetWithMaintenanceWindow
s {$sel:ownerInformation:RegisterTargetWithMaintenanceWindow' :: Maybe (Sensitive Text)
ownerInformation = Maybe (Sensitive Text)
a} :: RegisterTargetWithMaintenanceWindow) 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

-- | The ID of the maintenance window the target should be registered with.
registerTargetWithMaintenanceWindow_windowId :: Lens.Lens' RegisterTargetWithMaintenanceWindow Prelude.Text
registerTargetWithMaintenanceWindow_windowId :: Lens' RegisterTargetWithMaintenanceWindow Text
registerTargetWithMaintenanceWindow_windowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTargetWithMaintenanceWindow' {Text
windowId :: Text
$sel:windowId:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Text
windowId} -> Text
windowId) (\s :: RegisterTargetWithMaintenanceWindow
s@RegisterTargetWithMaintenanceWindow' {} Text
a -> RegisterTargetWithMaintenanceWindow
s {$sel:windowId:RegisterTargetWithMaintenanceWindow' :: Text
windowId = Text
a} :: RegisterTargetWithMaintenanceWindow)

-- | The type of target being registered with the maintenance window.
registerTargetWithMaintenanceWindow_resourceType :: Lens.Lens' RegisterTargetWithMaintenanceWindow MaintenanceWindowResourceType
registerTargetWithMaintenanceWindow_resourceType :: Lens'
  RegisterTargetWithMaintenanceWindow MaintenanceWindowResourceType
registerTargetWithMaintenanceWindow_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTargetWithMaintenanceWindow' {MaintenanceWindowResourceType
resourceType :: MaintenanceWindowResourceType
$sel:resourceType:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow
-> MaintenanceWindowResourceType
resourceType} -> MaintenanceWindowResourceType
resourceType) (\s :: RegisterTargetWithMaintenanceWindow
s@RegisterTargetWithMaintenanceWindow' {} MaintenanceWindowResourceType
a -> RegisterTargetWithMaintenanceWindow
s {$sel:resourceType:RegisterTargetWithMaintenanceWindow' :: MaintenanceWindowResourceType
resourceType = MaintenanceWindowResourceType
a} :: RegisterTargetWithMaintenanceWindow)

-- | The targets to register with the maintenance window. In other words, the
-- managed nodes to run commands on when the maintenance window runs.
--
-- If a single maintenance window task is registered with multiple targets,
-- its task invocations occur sequentially and not in parallel. If your
-- task must run on multiple targets at the same time, register a task for
-- each target individually and assign each task the same priority level.
--
-- You can specify targets using managed node IDs, resource group names, or
-- tags that have been applied to managed nodes.
--
-- __Example 1__: Specify managed node IDs
--
-- @Key=InstanceIds,Values=\<instance-id-1>,\<instance-id-2>,\<instance-id-3>@
--
-- __Example 2__: Use tag key-pairs applied to managed nodes
--
-- @Key=tag:\<my-tag-key>,Values=\<my-tag-value-1>,\<my-tag-value-2>@
--
-- __Example 3__: Use tag-keys applied to managed nodes
--
-- @Key=tag-key,Values=\<my-tag-key-1>,\<my-tag-key-2>@
--
-- __Example 4__: Use resource group names
--
-- @Key=resource-groups:Name,Values=\<resource-group-name>@
--
-- __Example 5__: Use filters for resource group types
--
-- @Key=resource-groups:ResourceTypeFilters,Values=\<resource-type-1>,\<resource-type-2>@
--
-- For @Key=resource-groups:ResourceTypeFilters@, specify resource types in
-- the following format
--
-- @Key=resource-groups:ResourceTypeFilters,Values=AWS::EC2::INSTANCE,AWS::EC2::VPC@
--
-- For more information about these examples formats, including the best
-- use case for each one, see
-- <https://docs.aws.amazon.com/systems-manager/latest/userguide/mw-cli-tutorial-targets-examples.html Examples: Register targets with a maintenance window>
-- in the /Amazon Web Services Systems Manager User Guide/.
registerTargetWithMaintenanceWindow_targets :: Lens.Lens' RegisterTargetWithMaintenanceWindow [Target]
registerTargetWithMaintenanceWindow_targets :: Lens' RegisterTargetWithMaintenanceWindow [Target]
registerTargetWithMaintenanceWindow_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTargetWithMaintenanceWindow' {[Target]
targets :: [Target]
$sel:targets:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> [Target]
targets} -> [Target]
targets) (\s :: RegisterTargetWithMaintenanceWindow
s@RegisterTargetWithMaintenanceWindow' {} [Target]
a -> RegisterTargetWithMaintenanceWindow
s {$sel:targets:RegisterTargetWithMaintenanceWindow' :: [Target]
targets = [Target]
a} :: RegisterTargetWithMaintenanceWindow) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Core.AWSRequest
    RegisterTargetWithMaintenanceWindow
  where
  type
    AWSResponse RegisterTargetWithMaintenanceWindow =
      RegisterTargetWithMaintenanceWindowResponse
  request :: (Service -> Service)
-> RegisterTargetWithMaintenanceWindow
-> Request RegisterTargetWithMaintenanceWindow
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 RegisterTargetWithMaintenanceWindow
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse RegisterTargetWithMaintenanceWindow)))
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 -> RegisterTargetWithMaintenanceWindowResponse
RegisterTargetWithMaintenanceWindowResponse'
            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
"WindowTargetId")
            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
    RegisterTargetWithMaintenanceWindow
  where
  hashWithSalt :: Int -> RegisterTargetWithMaintenanceWindow -> Int
hashWithSalt
    Int
_salt
    RegisterTargetWithMaintenanceWindow' {[Target]
Maybe Text
Maybe (Sensitive Text)
Text
MaintenanceWindowResourceType
targets :: [Target]
resourceType :: MaintenanceWindowResourceType
windowId :: Text
ownerInformation :: Maybe (Sensitive Text)
name :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:targets:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> [Target]
$sel:resourceType:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow
-> MaintenanceWindowResourceType
$sel:windowId:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Text
$sel:ownerInformation:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe (Sensitive Text)
$sel:name:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe Text
$sel:description:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe (Sensitive Text)
$sel:clientToken:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
description
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
ownerInformation
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
windowId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MaintenanceWindowResourceType
resourceType
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Target]
targets

instance
  Prelude.NFData
    RegisterTargetWithMaintenanceWindow
  where
  rnf :: RegisterTargetWithMaintenanceWindow -> ()
rnf RegisterTargetWithMaintenanceWindow' {[Target]
Maybe Text
Maybe (Sensitive Text)
Text
MaintenanceWindowResourceType
targets :: [Target]
resourceType :: MaintenanceWindowResourceType
windowId :: Text
ownerInformation :: Maybe (Sensitive Text)
name :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:targets:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> [Target]
$sel:resourceType:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow
-> MaintenanceWindowResourceType
$sel:windowId:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Text
$sel:ownerInformation:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe (Sensitive Text)
$sel:name:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe Text
$sel:description:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe (Sensitive Text)
$sel:clientToken:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe Text
..} =
    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 (Sensitive Text)
description
      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 (Sensitive Text)
ownerInformation
      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 MaintenanceWindowResourceType
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Target]
targets

instance
  Data.ToHeaders
    RegisterTargetWithMaintenanceWindow
  where
  toHeaders :: RegisterTargetWithMaintenanceWindow -> 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.RegisterTargetWithMaintenanceWindow" ::
                          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
    RegisterTargetWithMaintenanceWindow
  where
  toJSON :: RegisterTargetWithMaintenanceWindow -> Value
toJSON RegisterTargetWithMaintenanceWindow' {[Target]
Maybe Text
Maybe (Sensitive Text)
Text
MaintenanceWindowResourceType
targets :: [Target]
resourceType :: MaintenanceWindowResourceType
windowId :: Text
ownerInformation :: Maybe (Sensitive Text)
name :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:targets:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> [Target]
$sel:resourceType:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow
-> MaintenanceWindowResourceType
$sel:windowId:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Text
$sel:ownerInformation:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe (Sensitive Text)
$sel:name:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe Text
$sel:description:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe (Sensitive Text)
$sel:clientToken:RegisterTargetWithMaintenanceWindow' :: RegisterTargetWithMaintenanceWindow -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"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
"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
"OwnerInformation" 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)
ownerInformation,
            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
"ResourceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MaintenanceWindowResourceType
resourceType),
            forall a. a -> Maybe a
Prelude.Just (Key
"Targets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Target]
targets)
          ]
      )

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

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

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

-- |
-- Create a value of 'RegisterTargetWithMaintenanceWindowResponse' 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:
--
-- 'windowTargetId', 'registerTargetWithMaintenanceWindowResponse_windowTargetId' - The ID of the target definition in this maintenance window.
--
-- 'httpStatus', 'registerTargetWithMaintenanceWindowResponse_httpStatus' - The response's http status code.
newRegisterTargetWithMaintenanceWindowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RegisterTargetWithMaintenanceWindowResponse
newRegisterTargetWithMaintenanceWindowResponse :: Int -> RegisterTargetWithMaintenanceWindowResponse
newRegisterTargetWithMaintenanceWindowResponse
  Int
pHttpStatus_ =
    RegisterTargetWithMaintenanceWindowResponse'
      { $sel:windowTargetId:RegisterTargetWithMaintenanceWindowResponse' :: Maybe Text
windowTargetId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:RegisterTargetWithMaintenanceWindowResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The ID of the target definition in this maintenance window.
registerTargetWithMaintenanceWindowResponse_windowTargetId :: Lens.Lens' RegisterTargetWithMaintenanceWindowResponse (Prelude.Maybe Prelude.Text)
registerTargetWithMaintenanceWindowResponse_windowTargetId :: Lens' RegisterTargetWithMaintenanceWindowResponse (Maybe Text)
registerTargetWithMaintenanceWindowResponse_windowTargetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterTargetWithMaintenanceWindowResponse' {Maybe Text
windowTargetId :: Maybe Text
$sel:windowTargetId:RegisterTargetWithMaintenanceWindowResponse' :: RegisterTargetWithMaintenanceWindowResponse -> Maybe Text
windowTargetId} -> Maybe Text
windowTargetId) (\s :: RegisterTargetWithMaintenanceWindowResponse
s@RegisterTargetWithMaintenanceWindowResponse' {} Maybe Text
a -> RegisterTargetWithMaintenanceWindowResponse
s {$sel:windowTargetId:RegisterTargetWithMaintenanceWindowResponse' :: Maybe Text
windowTargetId = Maybe Text
a} :: RegisterTargetWithMaintenanceWindowResponse)

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

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