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

    -- * Request Lenses
    updateMaintenanceStartTime_dayOfMonth,
    updateMaintenanceStartTime_dayOfWeek,
    updateMaintenanceStartTime_gatewayARN,
    updateMaintenanceStartTime_hourOfDay,
    updateMaintenanceStartTime_minuteOfHour,

    -- * Destructuring the Response
    UpdateMaintenanceStartTimeResponse (..),
    newUpdateMaintenanceStartTimeResponse,

    -- * Response Lenses
    updateMaintenanceStartTimeResponse_gatewayARN,
    updateMaintenanceStartTimeResponse_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 following fields:
--
-- -   UpdateMaintenanceStartTimeInput$DayOfMonth
--
-- -   UpdateMaintenanceStartTimeInput$DayOfWeek
--
-- -   UpdateMaintenanceStartTimeInput$HourOfDay
--
-- -   UpdateMaintenanceStartTimeInput$MinuteOfHour
--
-- /See:/ 'newUpdateMaintenanceStartTime' smart constructor.
data UpdateMaintenanceStartTime = UpdateMaintenanceStartTime'
  { -- | 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.
    UpdateMaintenanceStartTime -> Maybe Natural
dayOfMonth :: Prelude.Maybe Prelude.Natural,
    -- | The day of the week component of the maintenance start time week
    -- represented as an ordinal number from 0 to 6, where 0 represents Sunday
    -- and 6 Saturday.
    UpdateMaintenanceStartTime -> Maybe Natural
dayOfWeek :: Prelude.Maybe Prelude.Natural,
    UpdateMaintenanceStartTime -> Text
gatewayARN :: Prelude.Text,
    -- | The hour component of the maintenance start time represented as /hh/,
    -- where /hh/ is the hour (00 to 23). The hour of the day is in the time
    -- zone of the gateway.
    UpdateMaintenanceStartTime -> Natural
hourOfDay :: Prelude.Natural,
    -- | The minute component of the maintenance start time represented as /mm/,
    -- where /mm/ is the minute (00 to 59). The minute of the hour is in the
    -- time zone of the gateway.
    UpdateMaintenanceStartTime -> Natural
minuteOfHour :: Prelude.Natural
  }
  deriving (UpdateMaintenanceStartTime -> UpdateMaintenanceStartTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMaintenanceStartTime -> UpdateMaintenanceStartTime -> Bool
$c/= :: UpdateMaintenanceStartTime -> UpdateMaintenanceStartTime -> Bool
== :: UpdateMaintenanceStartTime -> UpdateMaintenanceStartTime -> Bool
$c== :: UpdateMaintenanceStartTime -> UpdateMaintenanceStartTime -> Bool
Prelude.Eq, ReadPrec [UpdateMaintenanceStartTime]
ReadPrec UpdateMaintenanceStartTime
Int -> ReadS UpdateMaintenanceStartTime
ReadS [UpdateMaintenanceStartTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMaintenanceStartTime]
$creadListPrec :: ReadPrec [UpdateMaintenanceStartTime]
readPrec :: ReadPrec UpdateMaintenanceStartTime
$creadPrec :: ReadPrec UpdateMaintenanceStartTime
readList :: ReadS [UpdateMaintenanceStartTime]
$creadList :: ReadS [UpdateMaintenanceStartTime]
readsPrec :: Int -> ReadS UpdateMaintenanceStartTime
$creadsPrec :: Int -> ReadS UpdateMaintenanceStartTime
Prelude.Read, Int -> UpdateMaintenanceStartTime -> ShowS
[UpdateMaintenanceStartTime] -> ShowS
UpdateMaintenanceStartTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMaintenanceStartTime] -> ShowS
$cshowList :: [UpdateMaintenanceStartTime] -> ShowS
show :: UpdateMaintenanceStartTime -> String
$cshow :: UpdateMaintenanceStartTime -> String
showsPrec :: Int -> UpdateMaintenanceStartTime -> ShowS
$cshowsPrec :: Int -> UpdateMaintenanceStartTime -> ShowS
Prelude.Show, forall x.
Rep UpdateMaintenanceStartTime x -> UpdateMaintenanceStartTime
forall x.
UpdateMaintenanceStartTime -> Rep UpdateMaintenanceStartTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateMaintenanceStartTime x -> UpdateMaintenanceStartTime
$cfrom :: forall x.
UpdateMaintenanceStartTime -> Rep UpdateMaintenanceStartTime x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMaintenanceStartTime' 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', 'updateMaintenanceStartTime_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', 'updateMaintenanceStartTime_dayOfWeek' - The day of the week component of the maintenance start time week
-- represented as an ordinal number from 0 to 6, where 0 represents Sunday
-- and 6 Saturday.
--
-- 'gatewayARN', 'updateMaintenanceStartTime_gatewayARN' - Undocumented member.
--
-- 'hourOfDay', 'updateMaintenanceStartTime_hourOfDay' - The hour component of the maintenance start time represented as /hh/,
-- where /hh/ is the hour (00 to 23). The hour of the day is in the time
-- zone of the gateway.
--
-- 'minuteOfHour', 'updateMaintenanceStartTime_minuteOfHour' - The minute component of the maintenance start time represented as /mm/,
-- where /mm/ is the minute (00 to 59). The minute of the hour is in the
-- time zone of the gateway.
newUpdateMaintenanceStartTime ::
  -- | 'gatewayARN'
  Prelude.Text ->
  -- | 'hourOfDay'
  Prelude.Natural ->
  -- | 'minuteOfHour'
  Prelude.Natural ->
  UpdateMaintenanceStartTime
newUpdateMaintenanceStartTime :: Text -> Natural -> Natural -> UpdateMaintenanceStartTime
newUpdateMaintenanceStartTime
  Text
pGatewayARN_
  Natural
pHourOfDay_
  Natural
pMinuteOfHour_ =
    UpdateMaintenanceStartTime'
      { $sel:dayOfMonth:UpdateMaintenanceStartTime' :: Maybe Natural
dayOfMonth =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dayOfWeek:UpdateMaintenanceStartTime' :: Maybe Natural
dayOfWeek = forall a. Maybe a
Prelude.Nothing,
        $sel:gatewayARN:UpdateMaintenanceStartTime' :: Text
gatewayARN = Text
pGatewayARN_,
        $sel:hourOfDay:UpdateMaintenanceStartTime' :: Natural
hourOfDay = Natural
pHourOfDay_,
        $sel:minuteOfHour:UpdateMaintenanceStartTime' :: Natural
minuteOfHour = Natural
pMinuteOfHour_
      }

-- | 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.
updateMaintenanceStartTime_dayOfMonth :: Lens.Lens' UpdateMaintenanceStartTime (Prelude.Maybe Prelude.Natural)
updateMaintenanceStartTime_dayOfMonth :: Lens' UpdateMaintenanceStartTime (Maybe Natural)
updateMaintenanceStartTime_dayOfMonth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMaintenanceStartTime' {Maybe Natural
dayOfMonth :: Maybe Natural
$sel:dayOfMonth:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Maybe Natural
dayOfMonth} -> Maybe Natural
dayOfMonth) (\s :: UpdateMaintenanceStartTime
s@UpdateMaintenanceStartTime' {} Maybe Natural
a -> UpdateMaintenanceStartTime
s {$sel:dayOfMonth:UpdateMaintenanceStartTime' :: Maybe Natural
dayOfMonth = Maybe Natural
a} :: UpdateMaintenanceStartTime)

-- | The day of the week component of the maintenance start time week
-- represented as an ordinal number from 0 to 6, where 0 represents Sunday
-- and 6 Saturday.
updateMaintenanceStartTime_dayOfWeek :: Lens.Lens' UpdateMaintenanceStartTime (Prelude.Maybe Prelude.Natural)
updateMaintenanceStartTime_dayOfWeek :: Lens' UpdateMaintenanceStartTime (Maybe Natural)
updateMaintenanceStartTime_dayOfWeek = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMaintenanceStartTime' {Maybe Natural
dayOfWeek :: Maybe Natural
$sel:dayOfWeek:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Maybe Natural
dayOfWeek} -> Maybe Natural
dayOfWeek) (\s :: UpdateMaintenanceStartTime
s@UpdateMaintenanceStartTime' {} Maybe Natural
a -> UpdateMaintenanceStartTime
s {$sel:dayOfWeek:UpdateMaintenanceStartTime' :: Maybe Natural
dayOfWeek = Maybe Natural
a} :: UpdateMaintenanceStartTime)

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

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

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

instance Core.AWSRequest UpdateMaintenanceStartTime where
  type
    AWSResponse UpdateMaintenanceStartTime =
      UpdateMaintenanceStartTimeResponse
  request :: (Service -> Service)
-> UpdateMaintenanceStartTime -> Request UpdateMaintenanceStartTime
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 UpdateMaintenanceStartTime
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateMaintenanceStartTime)))
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 -> UpdateMaintenanceStartTimeResponse
UpdateMaintenanceStartTimeResponse'
            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
"GatewayARN")
            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 UpdateMaintenanceStartTime where
  hashWithSalt :: Int -> UpdateMaintenanceStartTime -> Int
hashWithSalt Int
_salt UpdateMaintenanceStartTime' {Natural
Maybe Natural
Text
minuteOfHour :: Natural
hourOfDay :: Natural
gatewayARN :: Text
dayOfWeek :: Maybe Natural
dayOfMonth :: Maybe Natural
$sel:minuteOfHour:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Natural
$sel:hourOfDay:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Natural
$sel:gatewayARN:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Text
$sel:dayOfWeek:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Maybe Natural
$sel:dayOfMonth:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
dayOfMonth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
dayOfWeek
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
hourOfDay
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
minuteOfHour

instance Prelude.NFData UpdateMaintenanceStartTime where
  rnf :: UpdateMaintenanceStartTime -> ()
rnf UpdateMaintenanceStartTime' {Natural
Maybe Natural
Text
minuteOfHour :: Natural
hourOfDay :: Natural
gatewayARN :: Text
dayOfWeek :: Maybe Natural
dayOfMonth :: Maybe Natural
$sel:minuteOfHour:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Natural
$sel:hourOfDay:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Natural
$sel:gatewayARN:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Text
$sel:dayOfWeek:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Maybe Natural
$sel:dayOfMonth:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> 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 Text
gatewayARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
hourOfDay
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
minuteOfHour

instance Data.ToHeaders UpdateMaintenanceStartTime where
  toHeaders :: UpdateMaintenanceStartTime -> 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.UpdateMaintenanceStartTime" ::
                          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 UpdateMaintenanceStartTime where
  toJSON :: UpdateMaintenanceStartTime -> Value
toJSON UpdateMaintenanceStartTime' {Natural
Maybe Natural
Text
minuteOfHour :: Natural
hourOfDay :: Natural
gatewayARN :: Text
dayOfWeek :: Maybe Natural
dayOfMonth :: Maybe Natural
$sel:minuteOfHour:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Natural
$sel:hourOfDay:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Natural
$sel:gatewayARN:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Text
$sel:dayOfWeek:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Maybe Natural
$sel:dayOfMonth:UpdateMaintenanceStartTime' :: UpdateMaintenanceStartTime -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DayOfMonth" 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
dayOfMonth,
            (Key
"DayOfWeek" 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
dayOfWeek,
            forall a. a -> Maybe a
Prelude.Just (Key
"GatewayARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gatewayARN),
            forall a. a -> Maybe a
Prelude.Just (Key
"HourOfDay" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
hourOfDay),
            forall a. a -> Maybe a
Prelude.Just (Key
"MinuteOfHour" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
minuteOfHour)
          ]
      )

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

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

-- | A JSON object containing the Amazon Resource Name (ARN) of the gateway
-- whose maintenance start time is updated.
--
-- /See:/ 'newUpdateMaintenanceStartTimeResponse' smart constructor.
data UpdateMaintenanceStartTimeResponse = UpdateMaintenanceStartTimeResponse'
  { UpdateMaintenanceStartTimeResponse -> Maybe Text
gatewayARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateMaintenanceStartTimeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateMaintenanceStartTimeResponse
-> UpdateMaintenanceStartTimeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMaintenanceStartTimeResponse
-> UpdateMaintenanceStartTimeResponse -> Bool
$c/= :: UpdateMaintenanceStartTimeResponse
-> UpdateMaintenanceStartTimeResponse -> Bool
== :: UpdateMaintenanceStartTimeResponse
-> UpdateMaintenanceStartTimeResponse -> Bool
$c== :: UpdateMaintenanceStartTimeResponse
-> UpdateMaintenanceStartTimeResponse -> Bool
Prelude.Eq, ReadPrec [UpdateMaintenanceStartTimeResponse]
ReadPrec UpdateMaintenanceStartTimeResponse
Int -> ReadS UpdateMaintenanceStartTimeResponse
ReadS [UpdateMaintenanceStartTimeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMaintenanceStartTimeResponse]
$creadListPrec :: ReadPrec [UpdateMaintenanceStartTimeResponse]
readPrec :: ReadPrec UpdateMaintenanceStartTimeResponse
$creadPrec :: ReadPrec UpdateMaintenanceStartTimeResponse
readList :: ReadS [UpdateMaintenanceStartTimeResponse]
$creadList :: ReadS [UpdateMaintenanceStartTimeResponse]
readsPrec :: Int -> ReadS UpdateMaintenanceStartTimeResponse
$creadsPrec :: Int -> ReadS UpdateMaintenanceStartTimeResponse
Prelude.Read, Int -> UpdateMaintenanceStartTimeResponse -> ShowS
[UpdateMaintenanceStartTimeResponse] -> ShowS
UpdateMaintenanceStartTimeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMaintenanceStartTimeResponse] -> ShowS
$cshowList :: [UpdateMaintenanceStartTimeResponse] -> ShowS
show :: UpdateMaintenanceStartTimeResponse -> String
$cshow :: UpdateMaintenanceStartTimeResponse -> String
showsPrec :: Int -> UpdateMaintenanceStartTimeResponse -> ShowS
$cshowsPrec :: Int -> UpdateMaintenanceStartTimeResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateMaintenanceStartTimeResponse x
-> UpdateMaintenanceStartTimeResponse
forall x.
UpdateMaintenanceStartTimeResponse
-> Rep UpdateMaintenanceStartTimeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateMaintenanceStartTimeResponse x
-> UpdateMaintenanceStartTimeResponse
$cfrom :: forall x.
UpdateMaintenanceStartTimeResponse
-> Rep UpdateMaintenanceStartTimeResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMaintenanceStartTimeResponse' 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', 'updateMaintenanceStartTimeResponse_gatewayARN' - Undocumented member.
--
-- 'httpStatus', 'updateMaintenanceStartTimeResponse_httpStatus' - The response's http status code.
newUpdateMaintenanceStartTimeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateMaintenanceStartTimeResponse
newUpdateMaintenanceStartTimeResponse :: Int -> UpdateMaintenanceStartTimeResponse
newUpdateMaintenanceStartTimeResponse Int
pHttpStatus_ =
  UpdateMaintenanceStartTimeResponse'
    { $sel:gatewayARN:UpdateMaintenanceStartTimeResponse' :: Maybe Text
gatewayARN =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateMaintenanceStartTimeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance
  Prelude.NFData
    UpdateMaintenanceStartTimeResponse
  where
  rnf :: UpdateMaintenanceStartTimeResponse -> ()
rnf UpdateMaintenanceStartTimeResponse' {Int
Maybe Text
httpStatus :: Int
gatewayARN :: Maybe Text
$sel:httpStatus:UpdateMaintenanceStartTimeResponse' :: UpdateMaintenanceStartTimeResponse -> Int
$sel:gatewayARN:UpdateMaintenanceStartTimeResponse' :: UpdateMaintenanceStartTimeResponse -> Maybe Text
..} =
    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 Int
httpStatus