{-# 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.StorageGateway.DescribeMaintenanceStartTime
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns your gateway\'s weekly maintenance start time including the day
-- and time of the week. Note that values are in terms of the gateway\'s
-- time zone.
module Amazonka.StorageGateway.DescribeMaintenanceStartTime
  ( -- * Creating a Request
    DescribeMaintenanceStartTime (..),
    newDescribeMaintenanceStartTime,

    -- * Request Lenses
    describeMaintenanceStartTime_gatewayARN,

    -- * Destructuring the Response
    DescribeMaintenanceStartTimeResponse (..),
    newDescribeMaintenanceStartTimeResponse,

    -- * Response Lenses
    describeMaintenanceStartTimeResponse_dayOfMonth,
    describeMaintenanceStartTimeResponse_dayOfWeek,
    describeMaintenanceStartTimeResponse_gatewayARN,
    describeMaintenanceStartTimeResponse_hourOfDay,
    describeMaintenanceStartTimeResponse_minuteOfHour,
    describeMaintenanceStartTimeResponse_timezone,
    describeMaintenanceStartTimeResponse_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.StorageGateway.Types

-- | A JSON object containing the Amazon Resource Name (ARN) of the gateway.
--
-- /See:/ 'newDescribeMaintenanceStartTime' smart constructor.
data DescribeMaintenanceStartTime = DescribeMaintenanceStartTime'
  { DescribeMaintenanceStartTime -> Text
gatewayARN :: Prelude.Text
  }
  deriving (DescribeMaintenanceStartTime
-> DescribeMaintenanceStartTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeMaintenanceStartTime
-> DescribeMaintenanceStartTime -> Bool
$c/= :: DescribeMaintenanceStartTime
-> DescribeMaintenanceStartTime -> Bool
== :: DescribeMaintenanceStartTime
-> DescribeMaintenanceStartTime -> Bool
$c== :: DescribeMaintenanceStartTime
-> DescribeMaintenanceStartTime -> Bool
Prelude.Eq, ReadPrec [DescribeMaintenanceStartTime]
ReadPrec DescribeMaintenanceStartTime
Int -> ReadS DescribeMaintenanceStartTime
ReadS [DescribeMaintenanceStartTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeMaintenanceStartTime]
$creadListPrec :: ReadPrec [DescribeMaintenanceStartTime]
readPrec :: ReadPrec DescribeMaintenanceStartTime
$creadPrec :: ReadPrec DescribeMaintenanceStartTime
readList :: ReadS [DescribeMaintenanceStartTime]
$creadList :: ReadS [DescribeMaintenanceStartTime]
readsPrec :: Int -> ReadS DescribeMaintenanceStartTime
$creadsPrec :: Int -> ReadS DescribeMaintenanceStartTime
Prelude.Read, Int -> DescribeMaintenanceStartTime -> ShowS
[DescribeMaintenanceStartTime] -> ShowS
DescribeMaintenanceStartTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeMaintenanceStartTime] -> ShowS
$cshowList :: [DescribeMaintenanceStartTime] -> ShowS
show :: DescribeMaintenanceStartTime -> String
$cshow :: DescribeMaintenanceStartTime -> String
showsPrec :: Int -> DescribeMaintenanceStartTime -> ShowS
$cshowsPrec :: Int -> DescribeMaintenanceStartTime -> ShowS
Prelude.Show, forall x.
Rep DescribeMaintenanceStartTime x -> DescribeMaintenanceStartTime
forall x.
DescribeMaintenanceStartTime -> Rep DescribeMaintenanceStartTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeMaintenanceStartTime x -> DescribeMaintenanceStartTime
$cfrom :: forall x.
DescribeMaintenanceStartTime -> Rep DescribeMaintenanceStartTime x
Prelude.Generic)

-- |
-- Create a value of 'DescribeMaintenanceStartTime' 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:
--
-- 'gatewayARN', 'describeMaintenanceStartTime_gatewayARN' - Undocumented member.
newDescribeMaintenanceStartTime ::
  -- | 'gatewayARN'
  Prelude.Text ->
  DescribeMaintenanceStartTime
newDescribeMaintenanceStartTime :: Text -> DescribeMaintenanceStartTime
newDescribeMaintenanceStartTime Text
pGatewayARN_ =
  DescribeMaintenanceStartTime'
    { $sel:gatewayARN:DescribeMaintenanceStartTime' :: Text
gatewayARN =
        Text
pGatewayARN_
    }

-- | Undocumented member.
describeMaintenanceStartTime_gatewayARN :: Lens.Lens' DescribeMaintenanceStartTime Prelude.Text
describeMaintenanceStartTime_gatewayARN :: Lens' DescribeMaintenanceStartTime Text
describeMaintenanceStartTime_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMaintenanceStartTime' {Text
gatewayARN :: Text
$sel:gatewayARN:DescribeMaintenanceStartTime' :: DescribeMaintenanceStartTime -> Text
gatewayARN} -> Text
gatewayARN) (\s :: DescribeMaintenanceStartTime
s@DescribeMaintenanceStartTime' {} Text
a -> DescribeMaintenanceStartTime
s {$sel:gatewayARN:DescribeMaintenanceStartTime' :: Text
gatewayARN = Text
a} :: DescribeMaintenanceStartTime)

instance Core.AWSRequest DescribeMaintenanceStartTime where
  type
    AWSResponse DescribeMaintenanceStartTime =
      DescribeMaintenanceStartTimeResponse
  request :: (Service -> Service)
-> DescribeMaintenanceStartTime
-> Request DescribeMaintenanceStartTime
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 DescribeMaintenanceStartTime
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeMaintenanceStartTime)))
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 Natural
-> Maybe Natural
-> Maybe Text
-> Maybe Natural
-> Maybe Natural
-> Maybe Text
-> Int
-> DescribeMaintenanceStartTimeResponse
DescribeMaintenanceStartTimeResponse'
            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
"DayOfMonth")
            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
"DayOfWeek")
            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
"GatewayARN")
            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
"HourOfDay")
            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
"MinuteOfHour")
            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
"Timezone")
            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
    DescribeMaintenanceStartTime
  where
  hashWithSalt :: Int -> DescribeMaintenanceStartTime -> Int
hashWithSalt Int
_salt DescribeMaintenanceStartTime' {Text
gatewayARN :: Text
$sel:gatewayARN:DescribeMaintenanceStartTime' :: DescribeMaintenanceStartTime -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN

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

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

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

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

-- | A JSON object containing the following fields:
--
-- -   DescribeMaintenanceStartTimeOutput$DayOfMonth
--
-- -   DescribeMaintenanceStartTimeOutput$DayOfWeek
--
-- -   DescribeMaintenanceStartTimeOutput$HourOfDay
--
-- -   DescribeMaintenanceStartTimeOutput$MinuteOfHour
--
-- -   DescribeMaintenanceStartTimeOutput$Timezone
--
-- /See:/ 'newDescribeMaintenanceStartTimeResponse' smart constructor.
data DescribeMaintenanceStartTimeResponse = DescribeMaintenanceStartTimeResponse'
  { -- | The day of the month component of the maintenance start time represented
    -- as an ordinal number from 1 to 28, where 1 represents the first day of
    -- the month and 28 represents the last day of the month.
    DescribeMaintenanceStartTimeResponse -> Maybe Natural
dayOfMonth :: Prelude.Maybe Prelude.Natural,
    -- | An ordinal number between 0 and 6 that represents the day of the week,
    -- where 0 represents Sunday and 6 represents Saturday. The day of week is
    -- in the time zone of the gateway.
    DescribeMaintenanceStartTimeResponse -> Maybe Natural
dayOfWeek :: Prelude.Maybe Prelude.Natural,
    DescribeMaintenanceStartTimeResponse -> Maybe Text
gatewayARN :: Prelude.Maybe Prelude.Text,
    -- | The hour component of the maintenance start time represented as /hh/,
    -- where /hh/ is the hour (0 to 23). The hour of the day is in the time
    -- zone of the gateway.
    DescribeMaintenanceStartTimeResponse -> Maybe Natural
hourOfDay :: Prelude.Maybe Prelude.Natural,
    -- | The minute component of the maintenance start time represented as /mm/,
    -- where /mm/ is the minute (0 to 59). The minute of the hour is in the
    -- time zone of the gateway.
    DescribeMaintenanceStartTimeResponse -> Maybe Natural
minuteOfHour :: Prelude.Maybe Prelude.Natural,
    -- | A value that indicates the time zone that is set for the gateway. The
    -- start time and day of week specified should be in the time zone of the
    -- gateway.
    DescribeMaintenanceStartTimeResponse -> Maybe Text
timezone :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeMaintenanceStartTimeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeMaintenanceStartTimeResponse
-> DescribeMaintenanceStartTimeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeMaintenanceStartTimeResponse
-> DescribeMaintenanceStartTimeResponse -> Bool
$c/= :: DescribeMaintenanceStartTimeResponse
-> DescribeMaintenanceStartTimeResponse -> Bool
== :: DescribeMaintenanceStartTimeResponse
-> DescribeMaintenanceStartTimeResponse -> Bool
$c== :: DescribeMaintenanceStartTimeResponse
-> DescribeMaintenanceStartTimeResponse -> Bool
Prelude.Eq, ReadPrec [DescribeMaintenanceStartTimeResponse]
ReadPrec DescribeMaintenanceStartTimeResponse
Int -> ReadS DescribeMaintenanceStartTimeResponse
ReadS [DescribeMaintenanceStartTimeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeMaintenanceStartTimeResponse]
$creadListPrec :: ReadPrec [DescribeMaintenanceStartTimeResponse]
readPrec :: ReadPrec DescribeMaintenanceStartTimeResponse
$creadPrec :: ReadPrec DescribeMaintenanceStartTimeResponse
readList :: ReadS [DescribeMaintenanceStartTimeResponse]
$creadList :: ReadS [DescribeMaintenanceStartTimeResponse]
readsPrec :: Int -> ReadS DescribeMaintenanceStartTimeResponse
$creadsPrec :: Int -> ReadS DescribeMaintenanceStartTimeResponse
Prelude.Read, Int -> DescribeMaintenanceStartTimeResponse -> ShowS
[DescribeMaintenanceStartTimeResponse] -> ShowS
DescribeMaintenanceStartTimeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeMaintenanceStartTimeResponse] -> ShowS
$cshowList :: [DescribeMaintenanceStartTimeResponse] -> ShowS
show :: DescribeMaintenanceStartTimeResponse -> String
$cshow :: DescribeMaintenanceStartTimeResponse -> String
showsPrec :: Int -> DescribeMaintenanceStartTimeResponse -> ShowS
$cshowsPrec :: Int -> DescribeMaintenanceStartTimeResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeMaintenanceStartTimeResponse x
-> DescribeMaintenanceStartTimeResponse
forall x.
DescribeMaintenanceStartTimeResponse
-> Rep DescribeMaintenanceStartTimeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeMaintenanceStartTimeResponse x
-> DescribeMaintenanceStartTimeResponse
$cfrom :: forall x.
DescribeMaintenanceStartTimeResponse
-> Rep DescribeMaintenanceStartTimeResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeMaintenanceStartTimeResponse' 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:
--
-- 'dayOfMonth', 'describeMaintenanceStartTimeResponse_dayOfMonth' - The day of the month component of the maintenance start time represented
-- as an ordinal number from 1 to 28, where 1 represents the first day of
-- the month and 28 represents the last day of the month.
--
-- 'dayOfWeek', 'describeMaintenanceStartTimeResponse_dayOfWeek' - An ordinal number between 0 and 6 that represents the day of the week,
-- where 0 represents Sunday and 6 represents Saturday. The day of week is
-- in the time zone of the gateway.
--
-- 'gatewayARN', 'describeMaintenanceStartTimeResponse_gatewayARN' - Undocumented member.
--
-- 'hourOfDay', 'describeMaintenanceStartTimeResponse_hourOfDay' - The hour component of the maintenance start time represented as /hh/,
-- where /hh/ is the hour (0 to 23). The hour of the day is in the time
-- zone of the gateway.
--
-- 'minuteOfHour', 'describeMaintenanceStartTimeResponse_minuteOfHour' - The minute component of the maintenance start time represented as /mm/,
-- where /mm/ is the minute (0 to 59). The minute of the hour is in the
-- time zone of the gateway.
--
-- 'timezone', 'describeMaintenanceStartTimeResponse_timezone' - A value that indicates the time zone that is set for the gateway. The
-- start time and day of week specified should be in the time zone of the
-- gateway.
--
-- 'httpStatus', 'describeMaintenanceStartTimeResponse_httpStatus' - The response's http status code.
newDescribeMaintenanceStartTimeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeMaintenanceStartTimeResponse
newDescribeMaintenanceStartTimeResponse :: Int -> DescribeMaintenanceStartTimeResponse
newDescribeMaintenanceStartTimeResponse Int
pHttpStatus_ =
  DescribeMaintenanceStartTimeResponse'
    { $sel:dayOfMonth:DescribeMaintenanceStartTimeResponse' :: Maybe Natural
dayOfMonth =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dayOfWeek:DescribeMaintenanceStartTimeResponse' :: Maybe Natural
dayOfWeek = forall a. Maybe a
Prelude.Nothing,
      $sel:gatewayARN:DescribeMaintenanceStartTimeResponse' :: Maybe Text
gatewayARN = forall a. Maybe a
Prelude.Nothing,
      $sel:hourOfDay:DescribeMaintenanceStartTimeResponse' :: Maybe Natural
hourOfDay = forall a. Maybe a
Prelude.Nothing,
      $sel:minuteOfHour:DescribeMaintenanceStartTimeResponse' :: Maybe Natural
minuteOfHour = forall a. Maybe a
Prelude.Nothing,
      $sel:timezone:DescribeMaintenanceStartTimeResponse' :: Maybe Text
timezone = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeMaintenanceStartTimeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The day of the month component of the maintenance start time represented
-- as an ordinal number from 1 to 28, where 1 represents the first day of
-- the month and 28 represents the last day of the month.
describeMaintenanceStartTimeResponse_dayOfMonth :: Lens.Lens' DescribeMaintenanceStartTimeResponse (Prelude.Maybe Prelude.Natural)
describeMaintenanceStartTimeResponse_dayOfMonth :: Lens' DescribeMaintenanceStartTimeResponse (Maybe Natural)
describeMaintenanceStartTimeResponse_dayOfMonth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMaintenanceStartTimeResponse' {Maybe Natural
dayOfMonth :: Maybe Natural
$sel:dayOfMonth:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Natural
dayOfMonth} -> Maybe Natural
dayOfMonth) (\s :: DescribeMaintenanceStartTimeResponse
s@DescribeMaintenanceStartTimeResponse' {} Maybe Natural
a -> DescribeMaintenanceStartTimeResponse
s {$sel:dayOfMonth:DescribeMaintenanceStartTimeResponse' :: Maybe Natural
dayOfMonth = Maybe Natural
a} :: DescribeMaintenanceStartTimeResponse)

-- | An ordinal number between 0 and 6 that represents the day of the week,
-- where 0 represents Sunday and 6 represents Saturday. The day of week is
-- in the time zone of the gateway.
describeMaintenanceStartTimeResponse_dayOfWeek :: Lens.Lens' DescribeMaintenanceStartTimeResponse (Prelude.Maybe Prelude.Natural)
describeMaintenanceStartTimeResponse_dayOfWeek :: Lens' DescribeMaintenanceStartTimeResponse (Maybe Natural)
describeMaintenanceStartTimeResponse_dayOfWeek = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMaintenanceStartTimeResponse' {Maybe Natural
dayOfWeek :: Maybe Natural
$sel:dayOfWeek:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Natural
dayOfWeek} -> Maybe Natural
dayOfWeek) (\s :: DescribeMaintenanceStartTimeResponse
s@DescribeMaintenanceStartTimeResponse' {} Maybe Natural
a -> DescribeMaintenanceStartTimeResponse
s {$sel:dayOfWeek:DescribeMaintenanceStartTimeResponse' :: Maybe Natural
dayOfWeek = Maybe Natural
a} :: DescribeMaintenanceStartTimeResponse)

-- | Undocumented member.
describeMaintenanceStartTimeResponse_gatewayARN :: Lens.Lens' DescribeMaintenanceStartTimeResponse (Prelude.Maybe Prelude.Text)
describeMaintenanceStartTimeResponse_gatewayARN :: Lens' DescribeMaintenanceStartTimeResponse (Maybe Text)
describeMaintenanceStartTimeResponse_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMaintenanceStartTimeResponse' {Maybe Text
gatewayARN :: Maybe Text
$sel:gatewayARN:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Text
gatewayARN} -> Maybe Text
gatewayARN) (\s :: DescribeMaintenanceStartTimeResponse
s@DescribeMaintenanceStartTimeResponse' {} Maybe Text
a -> DescribeMaintenanceStartTimeResponse
s {$sel:gatewayARN:DescribeMaintenanceStartTimeResponse' :: Maybe Text
gatewayARN = Maybe Text
a} :: DescribeMaintenanceStartTimeResponse)

-- | The hour component of the maintenance start time represented as /hh/,
-- where /hh/ is the hour (0 to 23). The hour of the day is in the time
-- zone of the gateway.
describeMaintenanceStartTimeResponse_hourOfDay :: Lens.Lens' DescribeMaintenanceStartTimeResponse (Prelude.Maybe Prelude.Natural)
describeMaintenanceStartTimeResponse_hourOfDay :: Lens' DescribeMaintenanceStartTimeResponse (Maybe Natural)
describeMaintenanceStartTimeResponse_hourOfDay = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMaintenanceStartTimeResponse' {Maybe Natural
hourOfDay :: Maybe Natural
$sel:hourOfDay:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Natural
hourOfDay} -> Maybe Natural
hourOfDay) (\s :: DescribeMaintenanceStartTimeResponse
s@DescribeMaintenanceStartTimeResponse' {} Maybe Natural
a -> DescribeMaintenanceStartTimeResponse
s {$sel:hourOfDay:DescribeMaintenanceStartTimeResponse' :: Maybe Natural
hourOfDay = Maybe Natural
a} :: DescribeMaintenanceStartTimeResponse)

-- | The minute component of the maintenance start time represented as /mm/,
-- where /mm/ is the minute (0 to 59). The minute of the hour is in the
-- time zone of the gateway.
describeMaintenanceStartTimeResponse_minuteOfHour :: Lens.Lens' DescribeMaintenanceStartTimeResponse (Prelude.Maybe Prelude.Natural)
describeMaintenanceStartTimeResponse_minuteOfHour :: Lens' DescribeMaintenanceStartTimeResponse (Maybe Natural)
describeMaintenanceStartTimeResponse_minuteOfHour = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMaintenanceStartTimeResponse' {Maybe Natural
minuteOfHour :: Maybe Natural
$sel:minuteOfHour:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Natural
minuteOfHour} -> Maybe Natural
minuteOfHour) (\s :: DescribeMaintenanceStartTimeResponse
s@DescribeMaintenanceStartTimeResponse' {} Maybe Natural
a -> DescribeMaintenanceStartTimeResponse
s {$sel:minuteOfHour:DescribeMaintenanceStartTimeResponse' :: Maybe Natural
minuteOfHour = Maybe Natural
a} :: DescribeMaintenanceStartTimeResponse)

-- | A value that indicates the time zone that is set for the gateway. The
-- start time and day of week specified should be in the time zone of the
-- gateway.
describeMaintenanceStartTimeResponse_timezone :: Lens.Lens' DescribeMaintenanceStartTimeResponse (Prelude.Maybe Prelude.Text)
describeMaintenanceStartTimeResponse_timezone :: Lens' DescribeMaintenanceStartTimeResponse (Maybe Text)
describeMaintenanceStartTimeResponse_timezone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeMaintenanceStartTimeResponse' {Maybe Text
timezone :: Maybe Text
$sel:timezone:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Text
timezone} -> Maybe Text
timezone) (\s :: DescribeMaintenanceStartTimeResponse
s@DescribeMaintenanceStartTimeResponse' {} Maybe Text
a -> DescribeMaintenanceStartTimeResponse
s {$sel:timezone:DescribeMaintenanceStartTimeResponse' :: Maybe Text
timezone = Maybe Text
a} :: DescribeMaintenanceStartTimeResponse)

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

instance
  Prelude.NFData
    DescribeMaintenanceStartTimeResponse
  where
  rnf :: DescribeMaintenanceStartTimeResponse -> ()
rnf DescribeMaintenanceStartTimeResponse' {Int
Maybe Natural
Maybe Text
httpStatus :: Int
timezone :: Maybe Text
minuteOfHour :: Maybe Natural
hourOfDay :: Maybe Natural
gatewayARN :: Maybe Text
dayOfWeek :: Maybe Natural
dayOfMonth :: Maybe Natural
$sel:httpStatus:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Int
$sel:timezone:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Text
$sel:minuteOfHour:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Natural
$sel:hourOfDay:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Natural
$sel:gatewayARN:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Text
$sel:dayOfWeek:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Natural
$sel:dayOfMonth:DescribeMaintenanceStartTimeResponse' :: DescribeMaintenanceStartTimeResponse -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
dayOfMonth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
dayOfWeek
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
gatewayARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
hourOfDay
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
minuteOfHour
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timezone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus