{-# 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.CreateMaintenanceWindow
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new maintenance window.
--
-- The value you specify for @Duration@ determines the specific end time
-- for the maintenance window based on the time it begins. No maintenance
-- window tasks are permitted to start after the resulting endtime minus
-- the number of hours you specify for @Cutoff@. For example, if the
-- maintenance window starts at 3 PM, the duration is three hours, and the
-- value you specify for @Cutoff@ is one hour, no maintenance window tasks
-- can start after 5 PM.
module Amazonka.SSM.CreateMaintenanceWindow
  ( -- * Creating a Request
    CreateMaintenanceWindow (..),
    newCreateMaintenanceWindow,

    -- * Request Lenses
    createMaintenanceWindow_clientToken,
    createMaintenanceWindow_description,
    createMaintenanceWindow_endDate,
    createMaintenanceWindow_scheduleOffset,
    createMaintenanceWindow_scheduleTimezone,
    createMaintenanceWindow_startDate,
    createMaintenanceWindow_tags,
    createMaintenanceWindow_name,
    createMaintenanceWindow_schedule,
    createMaintenanceWindow_duration,
    createMaintenanceWindow_cutoff,
    createMaintenanceWindow_allowUnassociatedTargets,

    -- * Destructuring the Response
    CreateMaintenanceWindowResponse (..),
    newCreateMaintenanceWindowResponse,

    -- * Response Lenses
    createMaintenanceWindowResponse_windowId,
    createMaintenanceWindowResponse_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:/ 'newCreateMaintenanceWindow' smart constructor.
data CreateMaintenanceWindow = CreateMaintenanceWindow'
  { -- | User-provided idempotency token.
    CreateMaintenanceWindow -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | An optional description for the maintenance window. We recommend
    -- specifying a description to help you organize your maintenance windows.
    CreateMaintenanceWindow -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The date and time, in ISO-8601 Extended format, for when you want the
    -- maintenance window to become inactive. @EndDate@ allows you to set a
    -- date and time in the future when the maintenance window will no longer
    -- run.
    CreateMaintenanceWindow -> Maybe Text
endDate :: Prelude.Maybe Prelude.Text,
    -- | The number of days to wait after the date and time specified by a cron
    -- expression before running the maintenance window.
    --
    -- For example, the following cron expression schedules a maintenance
    -- window to run on the third Tuesday of every month at 11:30 PM.
    --
    -- @cron(30 23 ? * TUE#3 *)@
    --
    -- If the schedule offset is @2@, the maintenance window won\'t run until
    -- two days later.
    CreateMaintenanceWindow -> Maybe Natural
scheduleOffset :: Prelude.Maybe Prelude.Natural,
    -- | The time zone that the scheduled maintenance window executions are based
    -- on, in Internet Assigned Numbers Authority (IANA) format. For example:
    -- \"America\/Los_Angeles\", \"UTC\", or \"Asia\/Seoul\". For more
    -- information, see the
    -- <https://www.iana.org/time-zones Time Zone Database> on the IANA
    -- website.
    CreateMaintenanceWindow -> Maybe Text
scheduleTimezone :: Prelude.Maybe Prelude.Text,
    -- | The date and time, in ISO-8601 Extended format, for when you want the
    -- maintenance window to become active. @StartDate@ allows you to delay
    -- activation of the maintenance window until the specified future date.
    CreateMaintenanceWindow -> Maybe Text
startDate :: Prelude.Maybe Prelude.Text,
    -- | Optional metadata that you assign to a resource. Tags enable you to
    -- categorize a resource in different ways, such as by purpose, owner, or
    -- environment. For example, you might want to tag a maintenance window to
    -- identify the type of tasks it will run, the types of targets, and the
    -- environment it will run in. In this case, you could specify the
    -- following key-value pairs:
    --
    -- -   @Key=TaskType,Value=AgentUpdate@
    --
    -- -   @Key=OS,Value=Windows@
    --
    -- -   @Key=Environment,Value=Production@
    --
    -- To add tags to an existing maintenance window, use the AddTagsToResource
    -- operation.
    CreateMaintenanceWindow -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the maintenance window.
    CreateMaintenanceWindow -> Text
name :: Prelude.Text,
    -- | The schedule of the maintenance window in the form of a cron or rate
    -- expression.
    CreateMaintenanceWindow -> Text
schedule :: Prelude.Text,
    -- | The duration of the maintenance window in hours.
    CreateMaintenanceWindow -> Natural
duration :: Prelude.Natural,
    -- | The number of hours before the end of the maintenance window that Amazon
    -- Web Services Systems Manager stops scheduling new tasks for execution.
    CreateMaintenanceWindow -> Natural
cutoff :: Prelude.Natural,
    -- | Enables a maintenance window task to run on managed nodes, even if you
    -- haven\'t registered those nodes as targets. If enabled, then you must
    -- specify the unregistered managed nodes (by node ID) when you register a
    -- task with the maintenance window.
    --
    -- If you don\'t enable this option, then you must specify
    -- previously-registered targets when you register a task with the
    -- maintenance window.
    CreateMaintenanceWindow -> Bool
allowUnassociatedTargets :: Prelude.Bool
  }
  deriving (CreateMaintenanceWindow -> CreateMaintenanceWindow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMaintenanceWindow -> CreateMaintenanceWindow -> Bool
$c/= :: CreateMaintenanceWindow -> CreateMaintenanceWindow -> Bool
== :: CreateMaintenanceWindow -> CreateMaintenanceWindow -> Bool
$c== :: CreateMaintenanceWindow -> CreateMaintenanceWindow -> Bool
Prelude.Eq, Int -> CreateMaintenanceWindow -> ShowS
[CreateMaintenanceWindow] -> ShowS
CreateMaintenanceWindow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMaintenanceWindow] -> ShowS
$cshowList :: [CreateMaintenanceWindow] -> ShowS
show :: CreateMaintenanceWindow -> String
$cshow :: CreateMaintenanceWindow -> String
showsPrec :: Int -> CreateMaintenanceWindow -> ShowS
$cshowsPrec :: Int -> CreateMaintenanceWindow -> ShowS
Prelude.Show, forall x. Rep CreateMaintenanceWindow x -> CreateMaintenanceWindow
forall x. CreateMaintenanceWindow -> Rep CreateMaintenanceWindow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateMaintenanceWindow x -> CreateMaintenanceWindow
$cfrom :: forall x. CreateMaintenanceWindow -> Rep CreateMaintenanceWindow x
Prelude.Generic)

-- |
-- Create a value of 'CreateMaintenanceWindow' 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', 'createMaintenanceWindow_clientToken' - User-provided idempotency token.
--
-- 'description', 'createMaintenanceWindow_description' - An optional description for the maintenance window. We recommend
-- specifying a description to help you organize your maintenance windows.
--
-- 'endDate', 'createMaintenanceWindow_endDate' - The date and time, in ISO-8601 Extended format, for when you want the
-- maintenance window to become inactive. @EndDate@ allows you to set a
-- date and time in the future when the maintenance window will no longer
-- run.
--
-- 'scheduleOffset', 'createMaintenanceWindow_scheduleOffset' - The number of days to wait after the date and time specified by a cron
-- expression before running the maintenance window.
--
-- For example, the following cron expression schedules a maintenance
-- window to run on the third Tuesday of every month at 11:30 PM.
--
-- @cron(30 23 ? * TUE#3 *)@
--
-- If the schedule offset is @2@, the maintenance window won\'t run until
-- two days later.
--
-- 'scheduleTimezone', 'createMaintenanceWindow_scheduleTimezone' - The time zone that the scheduled maintenance window executions are based
-- on, in Internet Assigned Numbers Authority (IANA) format. For example:
-- \"America\/Los_Angeles\", \"UTC\", or \"Asia\/Seoul\". For more
-- information, see the
-- <https://www.iana.org/time-zones Time Zone Database> on the IANA
-- website.
--
-- 'startDate', 'createMaintenanceWindow_startDate' - The date and time, in ISO-8601 Extended format, for when you want the
-- maintenance window to become active. @StartDate@ allows you to delay
-- activation of the maintenance window until the specified future date.
--
-- 'tags', 'createMaintenanceWindow_tags' - Optional metadata that you assign to a resource. Tags enable you to
-- categorize a resource in different ways, such as by purpose, owner, or
-- environment. For example, you might want to tag a maintenance window to
-- identify the type of tasks it will run, the types of targets, and the
-- environment it will run in. In this case, you could specify the
-- following key-value pairs:
--
-- -   @Key=TaskType,Value=AgentUpdate@
--
-- -   @Key=OS,Value=Windows@
--
-- -   @Key=Environment,Value=Production@
--
-- To add tags to an existing maintenance window, use the AddTagsToResource
-- operation.
--
-- 'name', 'createMaintenanceWindow_name' - The name of the maintenance window.
--
-- 'schedule', 'createMaintenanceWindow_schedule' - The schedule of the maintenance window in the form of a cron or rate
-- expression.
--
-- 'duration', 'createMaintenanceWindow_duration' - The duration of the maintenance window in hours.
--
-- 'cutoff', 'createMaintenanceWindow_cutoff' - The number of hours before the end of the maintenance window that Amazon
-- Web Services Systems Manager stops scheduling new tasks for execution.
--
-- 'allowUnassociatedTargets', 'createMaintenanceWindow_allowUnassociatedTargets' - Enables a maintenance window task to run on managed nodes, even if you
-- haven\'t registered those nodes as targets. If enabled, then you must
-- specify the unregistered managed nodes (by node ID) when you register a
-- task with the maintenance window.
--
-- If you don\'t enable this option, then you must specify
-- previously-registered targets when you register a task with the
-- maintenance window.
newCreateMaintenanceWindow ::
  -- | 'name'
  Prelude.Text ->
  -- | 'schedule'
  Prelude.Text ->
  -- | 'duration'
  Prelude.Natural ->
  -- | 'cutoff'
  Prelude.Natural ->
  -- | 'allowUnassociatedTargets'
  Prelude.Bool ->
  CreateMaintenanceWindow
newCreateMaintenanceWindow :: Text
-> Text -> Natural -> Natural -> Bool -> CreateMaintenanceWindow
newCreateMaintenanceWindow
  Text
pName_
  Text
pSchedule_
  Natural
pDuration_
  Natural
pCutoff_
  Bool
pAllowUnassociatedTargets_ =
    CreateMaintenanceWindow'
      { $sel:clientToken:CreateMaintenanceWindow' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateMaintenanceWindow' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
        $sel:endDate:CreateMaintenanceWindow' :: Maybe Text
endDate = forall a. Maybe a
Prelude.Nothing,
        $sel:scheduleOffset:CreateMaintenanceWindow' :: Maybe Natural
scheduleOffset = forall a. Maybe a
Prelude.Nothing,
        $sel:scheduleTimezone:CreateMaintenanceWindow' :: Maybe Text
scheduleTimezone = forall a. Maybe a
Prelude.Nothing,
        $sel:startDate:CreateMaintenanceWindow' :: Maybe Text
startDate = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateMaintenanceWindow' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateMaintenanceWindow' :: Text
name = Text
pName_,
        $sel:schedule:CreateMaintenanceWindow' :: Text
schedule = Text
pSchedule_,
        $sel:duration:CreateMaintenanceWindow' :: Natural
duration = Natural
pDuration_,
        $sel:cutoff:CreateMaintenanceWindow' :: Natural
cutoff = Natural
pCutoff_,
        $sel:allowUnassociatedTargets:CreateMaintenanceWindow' :: Bool
allowUnassociatedTargets =
          Bool
pAllowUnassociatedTargets_
      }

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

-- | An optional description for the maintenance window. We recommend
-- specifying a description to help you organize your maintenance windows.
createMaintenanceWindow_description :: Lens.Lens' CreateMaintenanceWindow (Prelude.Maybe Prelude.Text)
createMaintenanceWindow_description :: Lens' CreateMaintenanceWindow (Maybe Text)
createMaintenanceWindow_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Maybe (Sensitive Text)
a -> CreateMaintenanceWindow
s {$sel:description:CreateMaintenanceWindow' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: CreateMaintenanceWindow) 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 date and time, in ISO-8601 Extended format, for when you want the
-- maintenance window to become inactive. @EndDate@ allows you to set a
-- date and time in the future when the maintenance window will no longer
-- run.
createMaintenanceWindow_endDate :: Lens.Lens' CreateMaintenanceWindow (Prelude.Maybe Prelude.Text)
createMaintenanceWindow_endDate :: Lens' CreateMaintenanceWindow (Maybe Text)
createMaintenanceWindow_endDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Maybe Text
endDate :: Maybe Text
$sel:endDate:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
endDate} -> Maybe Text
endDate) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Maybe Text
a -> CreateMaintenanceWindow
s {$sel:endDate:CreateMaintenanceWindow' :: Maybe Text
endDate = Maybe Text
a} :: CreateMaintenanceWindow)

-- | The number of days to wait after the date and time specified by a cron
-- expression before running the maintenance window.
--
-- For example, the following cron expression schedules a maintenance
-- window to run on the third Tuesday of every month at 11:30 PM.
--
-- @cron(30 23 ? * TUE#3 *)@
--
-- If the schedule offset is @2@, the maintenance window won\'t run until
-- two days later.
createMaintenanceWindow_scheduleOffset :: Lens.Lens' CreateMaintenanceWindow (Prelude.Maybe Prelude.Natural)
createMaintenanceWindow_scheduleOffset :: Lens' CreateMaintenanceWindow (Maybe Natural)
createMaintenanceWindow_scheduleOffset = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Maybe Natural
scheduleOffset :: Maybe Natural
$sel:scheduleOffset:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Natural
scheduleOffset} -> Maybe Natural
scheduleOffset) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Maybe Natural
a -> CreateMaintenanceWindow
s {$sel:scheduleOffset:CreateMaintenanceWindow' :: Maybe Natural
scheduleOffset = Maybe Natural
a} :: CreateMaintenanceWindow)

-- | The time zone that the scheduled maintenance window executions are based
-- on, in Internet Assigned Numbers Authority (IANA) format. For example:
-- \"America\/Los_Angeles\", \"UTC\", or \"Asia\/Seoul\". For more
-- information, see the
-- <https://www.iana.org/time-zones Time Zone Database> on the IANA
-- website.
createMaintenanceWindow_scheduleTimezone :: Lens.Lens' CreateMaintenanceWindow (Prelude.Maybe Prelude.Text)
createMaintenanceWindow_scheduleTimezone :: Lens' CreateMaintenanceWindow (Maybe Text)
createMaintenanceWindow_scheduleTimezone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Maybe Text
scheduleTimezone :: Maybe Text
$sel:scheduleTimezone:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
scheduleTimezone} -> Maybe Text
scheduleTimezone) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Maybe Text
a -> CreateMaintenanceWindow
s {$sel:scheduleTimezone:CreateMaintenanceWindow' :: Maybe Text
scheduleTimezone = Maybe Text
a} :: CreateMaintenanceWindow)

-- | The date and time, in ISO-8601 Extended format, for when you want the
-- maintenance window to become active. @StartDate@ allows you to delay
-- activation of the maintenance window until the specified future date.
createMaintenanceWindow_startDate :: Lens.Lens' CreateMaintenanceWindow (Prelude.Maybe Prelude.Text)
createMaintenanceWindow_startDate :: Lens' CreateMaintenanceWindow (Maybe Text)
createMaintenanceWindow_startDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Maybe Text
startDate :: Maybe Text
$sel:startDate:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
startDate} -> Maybe Text
startDate) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Maybe Text
a -> CreateMaintenanceWindow
s {$sel:startDate:CreateMaintenanceWindow' :: Maybe Text
startDate = Maybe Text
a} :: CreateMaintenanceWindow)

-- | Optional metadata that you assign to a resource. Tags enable you to
-- categorize a resource in different ways, such as by purpose, owner, or
-- environment. For example, you might want to tag a maintenance window to
-- identify the type of tasks it will run, the types of targets, and the
-- environment it will run in. In this case, you could specify the
-- following key-value pairs:
--
-- -   @Key=TaskType,Value=AgentUpdate@
--
-- -   @Key=OS,Value=Windows@
--
-- -   @Key=Environment,Value=Production@
--
-- To add tags to an existing maintenance window, use the AddTagsToResource
-- operation.
createMaintenanceWindow_tags :: Lens.Lens' CreateMaintenanceWindow (Prelude.Maybe [Tag])
createMaintenanceWindow_tags :: Lens' CreateMaintenanceWindow (Maybe [Tag])
createMaintenanceWindow_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Maybe [Tag]
a -> CreateMaintenanceWindow
s {$sel:tags:CreateMaintenanceWindow' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateMaintenanceWindow) 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 name of the maintenance window.
createMaintenanceWindow_name :: Lens.Lens' CreateMaintenanceWindow Prelude.Text
createMaintenanceWindow_name :: Lens' CreateMaintenanceWindow Text
createMaintenanceWindow_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Text
name :: Text
$sel:name:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Text
name} -> Text
name) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Text
a -> CreateMaintenanceWindow
s {$sel:name:CreateMaintenanceWindow' :: Text
name = Text
a} :: CreateMaintenanceWindow)

-- | The schedule of the maintenance window in the form of a cron or rate
-- expression.
createMaintenanceWindow_schedule :: Lens.Lens' CreateMaintenanceWindow Prelude.Text
createMaintenanceWindow_schedule :: Lens' CreateMaintenanceWindow Text
createMaintenanceWindow_schedule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Text
schedule :: Text
$sel:schedule:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Text
schedule} -> Text
schedule) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Text
a -> CreateMaintenanceWindow
s {$sel:schedule:CreateMaintenanceWindow' :: Text
schedule = Text
a} :: CreateMaintenanceWindow)

-- | The duration of the maintenance window in hours.
createMaintenanceWindow_duration :: Lens.Lens' CreateMaintenanceWindow Prelude.Natural
createMaintenanceWindow_duration :: Lens' CreateMaintenanceWindow Natural
createMaintenanceWindow_duration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Natural
duration :: Natural
$sel:duration:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Natural
duration} -> Natural
duration) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Natural
a -> CreateMaintenanceWindow
s {$sel:duration:CreateMaintenanceWindow' :: Natural
duration = Natural
a} :: CreateMaintenanceWindow)

-- | The number of hours before the end of the maintenance window that Amazon
-- Web Services Systems Manager stops scheduling new tasks for execution.
createMaintenanceWindow_cutoff :: Lens.Lens' CreateMaintenanceWindow Prelude.Natural
createMaintenanceWindow_cutoff :: Lens' CreateMaintenanceWindow Natural
createMaintenanceWindow_cutoff = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Natural
cutoff :: Natural
$sel:cutoff:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Natural
cutoff} -> Natural
cutoff) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Natural
a -> CreateMaintenanceWindow
s {$sel:cutoff:CreateMaintenanceWindow' :: Natural
cutoff = Natural
a} :: CreateMaintenanceWindow)

-- | Enables a maintenance window task to run on managed nodes, even if you
-- haven\'t registered those nodes as targets. If enabled, then you must
-- specify the unregistered managed nodes (by node ID) when you register a
-- task with the maintenance window.
--
-- If you don\'t enable this option, then you must specify
-- previously-registered targets when you register a task with the
-- maintenance window.
createMaintenanceWindow_allowUnassociatedTargets :: Lens.Lens' CreateMaintenanceWindow Prelude.Bool
createMaintenanceWindow_allowUnassociatedTargets :: Lens' CreateMaintenanceWindow Bool
createMaintenanceWindow_allowUnassociatedTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindow' {Bool
allowUnassociatedTargets :: Bool
$sel:allowUnassociatedTargets:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Bool
allowUnassociatedTargets} -> Bool
allowUnassociatedTargets) (\s :: CreateMaintenanceWindow
s@CreateMaintenanceWindow' {} Bool
a -> CreateMaintenanceWindow
s {$sel:allowUnassociatedTargets:CreateMaintenanceWindow' :: Bool
allowUnassociatedTargets = Bool
a} :: CreateMaintenanceWindow)

instance Core.AWSRequest CreateMaintenanceWindow where
  type
    AWSResponse CreateMaintenanceWindow =
      CreateMaintenanceWindowResponse
  request :: (Service -> Service)
-> CreateMaintenanceWindow -> Request CreateMaintenanceWindow
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 CreateMaintenanceWindow
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateMaintenanceWindow)))
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 -> CreateMaintenanceWindowResponse
CreateMaintenanceWindowResponse'
            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
"WindowId")
            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 CreateMaintenanceWindow where
  hashWithSalt :: Int -> CreateMaintenanceWindow -> Int
hashWithSalt Int
_salt CreateMaintenanceWindow' {Bool
Natural
Maybe Natural
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
allowUnassociatedTargets :: Bool
cutoff :: Natural
duration :: Natural
schedule :: Text
name :: Text
tags :: Maybe [Tag]
startDate :: Maybe Text
scheduleTimezone :: Maybe Text
scheduleOffset :: Maybe Natural
endDate :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:allowUnassociatedTargets:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Bool
$sel:cutoff:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Natural
$sel:duration:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Natural
$sel:schedule:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Text
$sel:name:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Text
$sel:tags:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe [Tag]
$sel:startDate:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
$sel:scheduleTimezone:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
$sel:scheduleOffset:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Natural
$sel:endDate:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
$sel:description:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe (Sensitive Text)
$sel:clientToken:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> 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
endDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
scheduleOffset
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
scheduleTimezone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
startDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schedule
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
duration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
cutoff
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
allowUnassociatedTargets

instance Prelude.NFData CreateMaintenanceWindow where
  rnf :: CreateMaintenanceWindow -> ()
rnf CreateMaintenanceWindow' {Bool
Natural
Maybe Natural
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
allowUnassociatedTargets :: Bool
cutoff :: Natural
duration :: Natural
schedule :: Text
name :: Text
tags :: Maybe [Tag]
startDate :: Maybe Text
scheduleTimezone :: Maybe Text
scheduleOffset :: Maybe Natural
endDate :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:allowUnassociatedTargets:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Bool
$sel:cutoff:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Natural
$sel:duration:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Natural
$sel:schedule:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Text
$sel:name:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Text
$sel:tags:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe [Tag]
$sel:startDate:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
$sel:scheduleTimezone:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
$sel:scheduleOffset:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Natural
$sel:endDate:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
$sel:description:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe (Sensitive Text)
$sel:clientToken:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> 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
endDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
scheduleOffset
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
scheduleTimezone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
startDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
schedule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
duration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
cutoff
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
allowUnassociatedTargets

instance Data.ToHeaders CreateMaintenanceWindow where
  toHeaders :: CreateMaintenanceWindow -> 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.CreateMaintenanceWindow" ::
                          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 CreateMaintenanceWindow where
  toJSON :: CreateMaintenanceWindow -> Value
toJSON CreateMaintenanceWindow' {Bool
Natural
Maybe Natural
Maybe [Tag]
Maybe Text
Maybe (Sensitive Text)
Text
allowUnassociatedTargets :: Bool
cutoff :: Natural
duration :: Natural
schedule :: Text
name :: Text
tags :: Maybe [Tag]
startDate :: Maybe Text
scheduleTimezone :: Maybe Text
scheduleOffset :: Maybe Natural
endDate :: Maybe Text
description :: Maybe (Sensitive Text)
clientToken :: Maybe Text
$sel:allowUnassociatedTargets:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Bool
$sel:cutoff:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Natural
$sel:duration:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Natural
$sel:schedule:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Text
$sel:name:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Text
$sel:tags:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe [Tag]
$sel:startDate:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
$sel:scheduleTimezone:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
$sel:scheduleOffset:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Natural
$sel:endDate:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe Text
$sel:description:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> Maybe (Sensitive Text)
$sel:clientToken:CreateMaintenanceWindow' :: CreateMaintenanceWindow -> 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
"EndDate" 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
endDate,
            (Key
"ScheduleOffset" 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
scheduleOffset,
            (Key
"ScheduleTimezone" 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
scheduleTimezone,
            (Key
"StartDate" 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
startDate,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Schedule" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
schedule),
            forall a. a -> Maybe a
Prelude.Just (Key
"Duration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
duration),
            forall a. a -> Maybe a
Prelude.Just (Key
"Cutoff" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
cutoff),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"AllowUnassociatedTargets"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
allowUnassociatedTargets
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateMaintenanceWindowResponse' 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:
--
-- 'windowId', 'createMaintenanceWindowResponse_windowId' - The ID of the created maintenance window.
--
-- 'httpStatus', 'createMaintenanceWindowResponse_httpStatus' - The response's http status code.
newCreateMaintenanceWindowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateMaintenanceWindowResponse
newCreateMaintenanceWindowResponse :: Int -> CreateMaintenanceWindowResponse
newCreateMaintenanceWindowResponse Int
pHttpStatus_ =
  CreateMaintenanceWindowResponse'
    { $sel:windowId:CreateMaintenanceWindowResponse' :: Maybe Text
windowId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateMaintenanceWindowResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the created maintenance window.
createMaintenanceWindowResponse_windowId :: Lens.Lens' CreateMaintenanceWindowResponse (Prelude.Maybe Prelude.Text)
createMaintenanceWindowResponse_windowId :: Lens' CreateMaintenanceWindowResponse (Maybe Text)
createMaintenanceWindowResponse_windowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMaintenanceWindowResponse' {Maybe Text
windowId :: Maybe Text
$sel:windowId:CreateMaintenanceWindowResponse' :: CreateMaintenanceWindowResponse -> Maybe Text
windowId} -> Maybe Text
windowId) (\s :: CreateMaintenanceWindowResponse
s@CreateMaintenanceWindowResponse' {} Maybe Text
a -> CreateMaintenanceWindowResponse
s {$sel:windowId:CreateMaintenanceWindowResponse' :: Maybe Text
windowId = Maybe Text
a} :: CreateMaintenanceWindowResponse)

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

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