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

    -- * Request Lenses
    getMaintenanceWindow_windowId,

    -- * Destructuring the Response
    GetMaintenanceWindowResponse (..),
    newGetMaintenanceWindowResponse,

    -- * Response Lenses
    getMaintenanceWindowResponse_allowUnassociatedTargets,
    getMaintenanceWindowResponse_createdDate,
    getMaintenanceWindowResponse_cutoff,
    getMaintenanceWindowResponse_description,
    getMaintenanceWindowResponse_duration,
    getMaintenanceWindowResponse_enabled,
    getMaintenanceWindowResponse_endDate,
    getMaintenanceWindowResponse_modifiedDate,
    getMaintenanceWindowResponse_name,
    getMaintenanceWindowResponse_nextExecutionTime,
    getMaintenanceWindowResponse_schedule,
    getMaintenanceWindowResponse_scheduleOffset,
    getMaintenanceWindowResponse_scheduleTimezone,
    getMaintenanceWindowResponse_startDate,
    getMaintenanceWindowResponse_windowId,
    getMaintenanceWindowResponse_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:/ 'newGetMaintenanceWindow' smart constructor.
data GetMaintenanceWindow = GetMaintenanceWindow'
  { -- | The ID of the maintenance window for which you want to retrieve
    -- information.
    GetMaintenanceWindow -> Text
windowId :: Prelude.Text
  }
  deriving (GetMaintenanceWindow -> GetMaintenanceWindow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMaintenanceWindow -> GetMaintenanceWindow -> Bool
$c/= :: GetMaintenanceWindow -> GetMaintenanceWindow -> Bool
== :: GetMaintenanceWindow -> GetMaintenanceWindow -> Bool
$c== :: GetMaintenanceWindow -> GetMaintenanceWindow -> Bool
Prelude.Eq, ReadPrec [GetMaintenanceWindow]
ReadPrec GetMaintenanceWindow
Int -> ReadS GetMaintenanceWindow
ReadS [GetMaintenanceWindow]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMaintenanceWindow]
$creadListPrec :: ReadPrec [GetMaintenanceWindow]
readPrec :: ReadPrec GetMaintenanceWindow
$creadPrec :: ReadPrec GetMaintenanceWindow
readList :: ReadS [GetMaintenanceWindow]
$creadList :: ReadS [GetMaintenanceWindow]
readsPrec :: Int -> ReadS GetMaintenanceWindow
$creadsPrec :: Int -> ReadS GetMaintenanceWindow
Prelude.Read, Int -> GetMaintenanceWindow -> ShowS
[GetMaintenanceWindow] -> ShowS
GetMaintenanceWindow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMaintenanceWindow] -> ShowS
$cshowList :: [GetMaintenanceWindow] -> ShowS
show :: GetMaintenanceWindow -> String
$cshow :: GetMaintenanceWindow -> String
showsPrec :: Int -> GetMaintenanceWindow -> ShowS
$cshowsPrec :: Int -> GetMaintenanceWindow -> ShowS
Prelude.Show, forall x. Rep GetMaintenanceWindow x -> GetMaintenanceWindow
forall x. GetMaintenanceWindow -> Rep GetMaintenanceWindow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMaintenanceWindow x -> GetMaintenanceWindow
$cfrom :: forall x. GetMaintenanceWindow -> Rep GetMaintenanceWindow x
Prelude.Generic)

-- |
-- Create a value of 'GetMaintenanceWindow' 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', 'getMaintenanceWindow_windowId' - The ID of the maintenance window for which you want to retrieve
-- information.
newGetMaintenanceWindow ::
  -- | 'windowId'
  Prelude.Text ->
  GetMaintenanceWindow
newGetMaintenanceWindow :: Text -> GetMaintenanceWindow
newGetMaintenanceWindow Text
pWindowId_ =
  GetMaintenanceWindow' {$sel:windowId:GetMaintenanceWindow' :: Text
windowId = Text
pWindowId_}

-- | The ID of the maintenance window for which you want to retrieve
-- information.
getMaintenanceWindow_windowId :: Lens.Lens' GetMaintenanceWindow Prelude.Text
getMaintenanceWindow_windowId :: Lens' GetMaintenanceWindow Text
getMaintenanceWindow_windowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindow' {Text
windowId :: Text
$sel:windowId:GetMaintenanceWindow' :: GetMaintenanceWindow -> Text
windowId} -> Text
windowId) (\s :: GetMaintenanceWindow
s@GetMaintenanceWindow' {} Text
a -> GetMaintenanceWindow
s {$sel:windowId:GetMaintenanceWindow' :: Text
windowId = Text
a} :: GetMaintenanceWindow)

instance Core.AWSRequest GetMaintenanceWindow where
  type
    AWSResponse GetMaintenanceWindow =
      GetMaintenanceWindowResponse
  request :: (Service -> Service)
-> GetMaintenanceWindow -> Request GetMaintenanceWindow
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 GetMaintenanceWindow
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetMaintenanceWindow)))
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 Bool
-> Maybe POSIX
-> Maybe Natural
-> Maybe (Sensitive Text)
-> Maybe Natural
-> Maybe Bool
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Natural
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> GetMaintenanceWindowResponse
GetMaintenanceWindowResponse'
            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
"AllowUnassociatedTargets")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreatedDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Cutoff")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Duration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Enabled")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EndDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ModifiedDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextExecutionTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Schedule")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ScheduleOffset")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ScheduleTimezone")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StartDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"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 GetMaintenanceWindow where
  hashWithSalt :: Int -> GetMaintenanceWindow -> Int
hashWithSalt Int
_salt GetMaintenanceWindow' {Text
windowId :: Text
$sel:windowId:GetMaintenanceWindow' :: GetMaintenanceWindow -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
windowId

instance Prelude.NFData GetMaintenanceWindow where
  rnf :: GetMaintenanceWindow -> ()
rnf GetMaintenanceWindow' {Text
windowId :: Text
$sel:windowId:GetMaintenanceWindow' :: GetMaintenanceWindow -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
windowId

instance Data.ToHeaders GetMaintenanceWindow where
  toHeaders :: GetMaintenanceWindow -> 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.GetMaintenanceWindow" ::
                          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 GetMaintenanceWindow where
  toJSON :: GetMaintenanceWindow -> Value
toJSON GetMaintenanceWindow' {Text
windowId :: Text
$sel:windowId:GetMaintenanceWindow' :: GetMaintenanceWindow -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"WindowId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
windowId)]
      )

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

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

-- | /See:/ 'newGetMaintenanceWindowResponse' smart constructor.
data GetMaintenanceWindowResponse = GetMaintenanceWindowResponse'
  { -- | Whether targets must be registered with the maintenance window before
    -- tasks can be defined for those targets.
    GetMaintenanceWindowResponse -> Maybe Bool
allowUnassociatedTargets :: Prelude.Maybe Prelude.Bool,
    -- | The date the maintenance window was created.
    GetMaintenanceWindowResponse -> Maybe POSIX
createdDate :: Prelude.Maybe Data.POSIX,
    -- | The number of hours before the end of the maintenance window that Amazon
    -- Web Services Systems Manager stops scheduling new tasks for execution.
    GetMaintenanceWindowResponse -> Maybe Natural
cutoff :: Prelude.Maybe Prelude.Natural,
    -- | The description of the maintenance window.
    GetMaintenanceWindowResponse -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The duration of the maintenance window in hours.
    GetMaintenanceWindowResponse -> Maybe Natural
duration :: Prelude.Maybe Prelude.Natural,
    -- | Indicates whether the maintenance window is enabled.
    GetMaintenanceWindowResponse -> Maybe Bool
enabled :: Prelude.Maybe Prelude.Bool,
    -- | The date and time, in ISO-8601 Extended format, for when the maintenance
    -- window is scheduled to become inactive. The maintenance window won\'t
    -- run after this specified time.
    GetMaintenanceWindowResponse -> Maybe Text
endDate :: Prelude.Maybe Prelude.Text,
    -- | The date the maintenance window was last modified.
    GetMaintenanceWindowResponse -> Maybe POSIX
modifiedDate :: Prelude.Maybe Data.POSIX,
    -- | The name of the maintenance window.
    GetMaintenanceWindowResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The next time the maintenance window will actually run, taking into
    -- account any specified times for the maintenance window to become active
    -- or inactive.
    GetMaintenanceWindowResponse -> Maybe Text
nextExecutionTime :: Prelude.Maybe Prelude.Text,
    -- | The schedule of the maintenance window in the form of a cron or rate
    -- expression.
    GetMaintenanceWindowResponse -> Maybe Text
schedule :: Prelude.Maybe Prelude.Text,
    -- | The number of days to wait to run a maintenance window after the
    -- scheduled cron expression date and time.
    GetMaintenanceWindowResponse -> 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.
    GetMaintenanceWindowResponse -> Maybe Text
scheduleTimezone :: Prelude.Maybe Prelude.Text,
    -- | The date and time, in ISO-8601 Extended format, for when the maintenance
    -- window is scheduled to become active. The maintenance window won\'t run
    -- before this specified time.
    GetMaintenanceWindowResponse -> Maybe Text
startDate :: Prelude.Maybe Prelude.Text,
    -- | The ID of the created maintenance window.
    GetMaintenanceWindowResponse -> Maybe Text
windowId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetMaintenanceWindowResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetMaintenanceWindowResponse
-> GetMaintenanceWindowResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMaintenanceWindowResponse
-> GetMaintenanceWindowResponse -> Bool
$c/= :: GetMaintenanceWindowResponse
-> GetMaintenanceWindowResponse -> Bool
== :: GetMaintenanceWindowResponse
-> GetMaintenanceWindowResponse -> Bool
$c== :: GetMaintenanceWindowResponse
-> GetMaintenanceWindowResponse -> Bool
Prelude.Eq, Int -> GetMaintenanceWindowResponse -> ShowS
[GetMaintenanceWindowResponse] -> ShowS
GetMaintenanceWindowResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMaintenanceWindowResponse] -> ShowS
$cshowList :: [GetMaintenanceWindowResponse] -> ShowS
show :: GetMaintenanceWindowResponse -> String
$cshow :: GetMaintenanceWindowResponse -> String
showsPrec :: Int -> GetMaintenanceWindowResponse -> ShowS
$cshowsPrec :: Int -> GetMaintenanceWindowResponse -> ShowS
Prelude.Show, forall x.
Rep GetMaintenanceWindowResponse x -> GetMaintenanceWindowResponse
forall x.
GetMaintenanceWindowResponse -> Rep GetMaintenanceWindowResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetMaintenanceWindowResponse x -> GetMaintenanceWindowResponse
$cfrom :: forall x.
GetMaintenanceWindowResponse -> Rep GetMaintenanceWindowResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMaintenanceWindowResponse' 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:
--
-- 'allowUnassociatedTargets', 'getMaintenanceWindowResponse_allowUnassociatedTargets' - Whether targets must be registered with the maintenance window before
-- tasks can be defined for those targets.
--
-- 'createdDate', 'getMaintenanceWindowResponse_createdDate' - The date the maintenance window was created.
--
-- 'cutoff', 'getMaintenanceWindowResponse_cutoff' - The number of hours before the end of the maintenance window that Amazon
-- Web Services Systems Manager stops scheduling new tasks for execution.
--
-- 'description', 'getMaintenanceWindowResponse_description' - The description of the maintenance window.
--
-- 'duration', 'getMaintenanceWindowResponse_duration' - The duration of the maintenance window in hours.
--
-- 'enabled', 'getMaintenanceWindowResponse_enabled' - Indicates whether the maintenance window is enabled.
--
-- 'endDate', 'getMaintenanceWindowResponse_endDate' - The date and time, in ISO-8601 Extended format, for when the maintenance
-- window is scheduled to become inactive. The maintenance window won\'t
-- run after this specified time.
--
-- 'modifiedDate', 'getMaintenanceWindowResponse_modifiedDate' - The date the maintenance window was last modified.
--
-- 'name', 'getMaintenanceWindowResponse_name' - The name of the maintenance window.
--
-- 'nextExecutionTime', 'getMaintenanceWindowResponse_nextExecutionTime' - The next time the maintenance window will actually run, taking into
-- account any specified times for the maintenance window to become active
-- or inactive.
--
-- 'schedule', 'getMaintenanceWindowResponse_schedule' - The schedule of the maintenance window in the form of a cron or rate
-- expression.
--
-- 'scheduleOffset', 'getMaintenanceWindowResponse_scheduleOffset' - The number of days to wait to run a maintenance window after the
-- scheduled cron expression date and time.
--
-- 'scheduleTimezone', 'getMaintenanceWindowResponse_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', 'getMaintenanceWindowResponse_startDate' - The date and time, in ISO-8601 Extended format, for when the maintenance
-- window is scheduled to become active. The maintenance window won\'t run
-- before this specified time.
--
-- 'windowId', 'getMaintenanceWindowResponse_windowId' - The ID of the created maintenance window.
--
-- 'httpStatus', 'getMaintenanceWindowResponse_httpStatus' - The response's http status code.
newGetMaintenanceWindowResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMaintenanceWindowResponse
newGetMaintenanceWindowResponse :: Int -> GetMaintenanceWindowResponse
newGetMaintenanceWindowResponse Int
pHttpStatus_ =
  GetMaintenanceWindowResponse'
    { $sel:allowUnassociatedTargets:GetMaintenanceWindowResponse' :: Maybe Bool
allowUnassociatedTargets =
        forall a. Maybe a
Prelude.Nothing,
      $sel:createdDate:GetMaintenanceWindowResponse' :: Maybe POSIX
createdDate = forall a. Maybe a
Prelude.Nothing,
      $sel:cutoff:GetMaintenanceWindowResponse' :: Maybe Natural
cutoff = forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetMaintenanceWindowResponse' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
      $sel:duration:GetMaintenanceWindowResponse' :: Maybe Natural
duration = forall a. Maybe a
Prelude.Nothing,
      $sel:enabled:GetMaintenanceWindowResponse' :: Maybe Bool
enabled = forall a. Maybe a
Prelude.Nothing,
      $sel:endDate:GetMaintenanceWindowResponse' :: Maybe Text
endDate = forall a. Maybe a
Prelude.Nothing,
      $sel:modifiedDate:GetMaintenanceWindowResponse' :: Maybe POSIX
modifiedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetMaintenanceWindowResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:nextExecutionTime:GetMaintenanceWindowResponse' :: Maybe Text
nextExecutionTime = forall a. Maybe a
Prelude.Nothing,
      $sel:schedule:GetMaintenanceWindowResponse' :: Maybe Text
schedule = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduleOffset:GetMaintenanceWindowResponse' :: Maybe Natural
scheduleOffset = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduleTimezone:GetMaintenanceWindowResponse' :: Maybe Text
scheduleTimezone = forall a. Maybe a
Prelude.Nothing,
      $sel:startDate:GetMaintenanceWindowResponse' :: Maybe Text
startDate = forall a. Maybe a
Prelude.Nothing,
      $sel:windowId:GetMaintenanceWindowResponse' :: Maybe Text
windowId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMaintenanceWindowResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Whether targets must be registered with the maintenance window before
-- tasks can be defined for those targets.
getMaintenanceWindowResponse_allowUnassociatedTargets :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.Bool)
getMaintenanceWindowResponse_allowUnassociatedTargets :: Lens' GetMaintenanceWindowResponse (Maybe Bool)
getMaintenanceWindowResponse_allowUnassociatedTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe Bool
allowUnassociatedTargets :: Maybe Bool
$sel:allowUnassociatedTargets:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Bool
allowUnassociatedTargets} -> Maybe Bool
allowUnassociatedTargets) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe Bool
a -> GetMaintenanceWindowResponse
s {$sel:allowUnassociatedTargets:GetMaintenanceWindowResponse' :: Maybe Bool
allowUnassociatedTargets = Maybe Bool
a} :: GetMaintenanceWindowResponse)

-- | The date the maintenance window was created.
getMaintenanceWindowResponse_createdDate :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.UTCTime)
getMaintenanceWindowResponse_createdDate :: Lens' GetMaintenanceWindowResponse (Maybe UTCTime)
getMaintenanceWindowResponse_createdDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe POSIX
createdDate :: Maybe POSIX
$sel:createdDate:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe POSIX
createdDate} -> Maybe POSIX
createdDate) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe POSIX
a -> GetMaintenanceWindowResponse
s {$sel:createdDate:GetMaintenanceWindowResponse' :: Maybe POSIX
createdDate = Maybe POSIX
a} :: GetMaintenanceWindowResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

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

-- | The description of the maintenance window.
getMaintenanceWindowResponse_description :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.Text)
getMaintenanceWindowResponse_description :: Lens' GetMaintenanceWindowResponse (Maybe Text)
getMaintenanceWindowResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe (Sensitive Text)
a -> GetMaintenanceWindowResponse
s {$sel:description:GetMaintenanceWindowResponse' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: GetMaintenanceWindowResponse) 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 duration of the maintenance window in hours.
getMaintenanceWindowResponse_duration :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.Natural)
getMaintenanceWindowResponse_duration :: Lens' GetMaintenanceWindowResponse (Maybe Natural)
getMaintenanceWindowResponse_duration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe Natural
duration :: Maybe Natural
$sel:duration:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Natural
duration} -> Maybe Natural
duration) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe Natural
a -> GetMaintenanceWindowResponse
s {$sel:duration:GetMaintenanceWindowResponse' :: Maybe Natural
duration = Maybe Natural
a} :: GetMaintenanceWindowResponse)

-- | Indicates whether the maintenance window is enabled.
getMaintenanceWindowResponse_enabled :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.Bool)
getMaintenanceWindowResponse_enabled :: Lens' GetMaintenanceWindowResponse (Maybe Bool)
getMaintenanceWindowResponse_enabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe Bool
enabled :: Maybe Bool
$sel:enabled:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Bool
enabled} -> Maybe Bool
enabled) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe Bool
a -> GetMaintenanceWindowResponse
s {$sel:enabled:GetMaintenanceWindowResponse' :: Maybe Bool
enabled = Maybe Bool
a} :: GetMaintenanceWindowResponse)

-- | The date and time, in ISO-8601 Extended format, for when the maintenance
-- window is scheduled to become inactive. The maintenance window won\'t
-- run after this specified time.
getMaintenanceWindowResponse_endDate :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.Text)
getMaintenanceWindowResponse_endDate :: Lens' GetMaintenanceWindowResponse (Maybe Text)
getMaintenanceWindowResponse_endDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe Text
endDate :: Maybe Text
$sel:endDate:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
endDate} -> Maybe Text
endDate) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe Text
a -> GetMaintenanceWindowResponse
s {$sel:endDate:GetMaintenanceWindowResponse' :: Maybe Text
endDate = Maybe Text
a} :: GetMaintenanceWindowResponse)

-- | The date the maintenance window was last modified.
getMaintenanceWindowResponse_modifiedDate :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.UTCTime)
getMaintenanceWindowResponse_modifiedDate :: Lens' GetMaintenanceWindowResponse (Maybe UTCTime)
getMaintenanceWindowResponse_modifiedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe POSIX
modifiedDate :: Maybe POSIX
$sel:modifiedDate:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe POSIX
modifiedDate} -> Maybe POSIX
modifiedDate) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe POSIX
a -> GetMaintenanceWindowResponse
s {$sel:modifiedDate:GetMaintenanceWindowResponse' :: Maybe POSIX
modifiedDate = Maybe POSIX
a} :: GetMaintenanceWindowResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name of the maintenance window.
getMaintenanceWindowResponse_name :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.Text)
getMaintenanceWindowResponse_name :: Lens' GetMaintenanceWindowResponse (Maybe Text)
getMaintenanceWindowResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe Text
a -> GetMaintenanceWindowResponse
s {$sel:name:GetMaintenanceWindowResponse' :: Maybe Text
name = Maybe Text
a} :: GetMaintenanceWindowResponse)

-- | The next time the maintenance window will actually run, taking into
-- account any specified times for the maintenance window to become active
-- or inactive.
getMaintenanceWindowResponse_nextExecutionTime :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.Text)
getMaintenanceWindowResponse_nextExecutionTime :: Lens' GetMaintenanceWindowResponse (Maybe Text)
getMaintenanceWindowResponse_nextExecutionTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe Text
nextExecutionTime :: Maybe Text
$sel:nextExecutionTime:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
nextExecutionTime} -> Maybe Text
nextExecutionTime) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe Text
a -> GetMaintenanceWindowResponse
s {$sel:nextExecutionTime:GetMaintenanceWindowResponse' :: Maybe Text
nextExecutionTime = Maybe Text
a} :: GetMaintenanceWindowResponse)

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

-- | The number of days to wait to run a maintenance window after the
-- scheduled cron expression date and time.
getMaintenanceWindowResponse_scheduleOffset :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.Natural)
getMaintenanceWindowResponse_scheduleOffset :: Lens' GetMaintenanceWindowResponse (Maybe Natural)
getMaintenanceWindowResponse_scheduleOffset = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe Natural
scheduleOffset :: Maybe Natural
$sel:scheduleOffset:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Natural
scheduleOffset} -> Maybe Natural
scheduleOffset) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe Natural
a -> GetMaintenanceWindowResponse
s {$sel:scheduleOffset:GetMaintenanceWindowResponse' :: Maybe Natural
scheduleOffset = Maybe Natural
a} :: GetMaintenanceWindowResponse)

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

-- | The date and time, in ISO-8601 Extended format, for when the maintenance
-- window is scheduled to become active. The maintenance window won\'t run
-- before this specified time.
getMaintenanceWindowResponse_startDate :: Lens.Lens' GetMaintenanceWindowResponse (Prelude.Maybe Prelude.Text)
getMaintenanceWindowResponse_startDate :: Lens' GetMaintenanceWindowResponse (Maybe Text)
getMaintenanceWindowResponse_startDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMaintenanceWindowResponse' {Maybe Text
startDate :: Maybe Text
$sel:startDate:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
startDate} -> Maybe Text
startDate) (\s :: GetMaintenanceWindowResponse
s@GetMaintenanceWindowResponse' {} Maybe Text
a -> GetMaintenanceWindowResponse
s {$sel:startDate:GetMaintenanceWindowResponse' :: Maybe Text
startDate = Maybe Text
a} :: GetMaintenanceWindowResponse)

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

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

instance Prelude.NFData GetMaintenanceWindowResponse where
  rnf :: GetMaintenanceWindowResponse -> ()
rnf GetMaintenanceWindowResponse' {Int
Maybe Bool
Maybe Natural
Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
httpStatus :: Int
windowId :: Maybe Text
startDate :: Maybe Text
scheduleTimezone :: Maybe Text
scheduleOffset :: Maybe Natural
schedule :: Maybe Text
nextExecutionTime :: Maybe Text
name :: Maybe Text
modifiedDate :: Maybe POSIX
endDate :: Maybe Text
enabled :: Maybe Bool
duration :: Maybe Natural
description :: Maybe (Sensitive Text)
cutoff :: Maybe Natural
createdDate :: Maybe POSIX
allowUnassociatedTargets :: Maybe Bool
$sel:httpStatus:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Int
$sel:windowId:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
$sel:startDate:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
$sel:scheduleTimezone:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
$sel:scheduleOffset:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Natural
$sel:schedule:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
$sel:nextExecutionTime:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
$sel:name:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
$sel:modifiedDate:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe POSIX
$sel:endDate:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Text
$sel:enabled:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Bool
$sel:duration:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Natural
$sel:description:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe (Sensitive Text)
$sel:cutoff:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Natural
$sel:createdDate:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe POSIX
$sel:allowUnassociatedTargets:GetMaintenanceWindowResponse' :: GetMaintenanceWindowResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowUnassociatedTargets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
cutoff
      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 Natural
duration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enabled
      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 POSIX
modifiedDate
      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 Text
nextExecutionTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schedule
      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 Text
windowId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus