{-# 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.Redshift.ModifyClusterMaintenance
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the maintenance settings of a cluster.
module Amazonka.Redshift.ModifyClusterMaintenance
  ( -- * Creating a Request
    ModifyClusterMaintenance (..),
    newModifyClusterMaintenance,

    -- * Request Lenses
    modifyClusterMaintenance_deferMaintenance,
    modifyClusterMaintenance_deferMaintenanceDuration,
    modifyClusterMaintenance_deferMaintenanceEndTime,
    modifyClusterMaintenance_deferMaintenanceIdentifier,
    modifyClusterMaintenance_deferMaintenanceStartTime,
    modifyClusterMaintenance_clusterIdentifier,

    -- * Destructuring the Response
    ModifyClusterMaintenanceResponse (..),
    newModifyClusterMaintenanceResponse,

    -- * Response Lenses
    modifyClusterMaintenanceResponse_cluster,
    modifyClusterMaintenanceResponse_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 Amazonka.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newModifyClusterMaintenance' smart constructor.
data ModifyClusterMaintenance = ModifyClusterMaintenance'
  { -- | A boolean indicating whether to enable the deferred maintenance window.
    ModifyClusterMaintenance -> Maybe Bool
deferMaintenance :: Prelude.Maybe Prelude.Bool,
    -- | An integer indicating the duration of the maintenance window in days. If
    -- you specify a duration, you can\'t specify an end time. The duration
    -- must be 45 days or less.
    ModifyClusterMaintenance -> Maybe Int
deferMaintenanceDuration :: Prelude.Maybe Prelude.Int,
    -- | A timestamp indicating end time for the deferred maintenance window. If
    -- you specify an end time, you can\'t specify a duration.
    ModifyClusterMaintenance -> Maybe ISO8601
deferMaintenanceEndTime :: Prelude.Maybe Data.ISO8601,
    -- | A unique identifier for the deferred maintenance window.
    ModifyClusterMaintenance -> Maybe Text
deferMaintenanceIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A timestamp indicating the start time for the deferred maintenance
    -- window.
    ModifyClusterMaintenance -> Maybe ISO8601
deferMaintenanceStartTime :: Prelude.Maybe Data.ISO8601,
    -- | A unique identifier for the cluster.
    ModifyClusterMaintenance -> Text
clusterIdentifier :: Prelude.Text
  }
  deriving (ModifyClusterMaintenance -> ModifyClusterMaintenance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyClusterMaintenance -> ModifyClusterMaintenance -> Bool
$c/= :: ModifyClusterMaintenance -> ModifyClusterMaintenance -> Bool
== :: ModifyClusterMaintenance -> ModifyClusterMaintenance -> Bool
$c== :: ModifyClusterMaintenance -> ModifyClusterMaintenance -> Bool
Prelude.Eq, ReadPrec [ModifyClusterMaintenance]
ReadPrec ModifyClusterMaintenance
Int -> ReadS ModifyClusterMaintenance
ReadS [ModifyClusterMaintenance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyClusterMaintenance]
$creadListPrec :: ReadPrec [ModifyClusterMaintenance]
readPrec :: ReadPrec ModifyClusterMaintenance
$creadPrec :: ReadPrec ModifyClusterMaintenance
readList :: ReadS [ModifyClusterMaintenance]
$creadList :: ReadS [ModifyClusterMaintenance]
readsPrec :: Int -> ReadS ModifyClusterMaintenance
$creadsPrec :: Int -> ReadS ModifyClusterMaintenance
Prelude.Read, Int -> ModifyClusterMaintenance -> ShowS
[ModifyClusterMaintenance] -> ShowS
ModifyClusterMaintenance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyClusterMaintenance] -> ShowS
$cshowList :: [ModifyClusterMaintenance] -> ShowS
show :: ModifyClusterMaintenance -> String
$cshow :: ModifyClusterMaintenance -> String
showsPrec :: Int -> ModifyClusterMaintenance -> ShowS
$cshowsPrec :: Int -> ModifyClusterMaintenance -> ShowS
Prelude.Show, forall x.
Rep ModifyClusterMaintenance x -> ModifyClusterMaintenance
forall x.
ModifyClusterMaintenance -> Rep ModifyClusterMaintenance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyClusterMaintenance x -> ModifyClusterMaintenance
$cfrom :: forall x.
ModifyClusterMaintenance -> Rep ModifyClusterMaintenance x
Prelude.Generic)

-- |
-- Create a value of 'ModifyClusterMaintenance' 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:
--
-- 'deferMaintenance', 'modifyClusterMaintenance_deferMaintenance' - A boolean indicating whether to enable the deferred maintenance window.
--
-- 'deferMaintenanceDuration', 'modifyClusterMaintenance_deferMaintenanceDuration' - An integer indicating the duration of the maintenance window in days. If
-- you specify a duration, you can\'t specify an end time. The duration
-- must be 45 days or less.
--
-- 'deferMaintenanceEndTime', 'modifyClusterMaintenance_deferMaintenanceEndTime' - A timestamp indicating end time for the deferred maintenance window. If
-- you specify an end time, you can\'t specify a duration.
--
-- 'deferMaintenanceIdentifier', 'modifyClusterMaintenance_deferMaintenanceIdentifier' - A unique identifier for the deferred maintenance window.
--
-- 'deferMaintenanceStartTime', 'modifyClusterMaintenance_deferMaintenanceStartTime' - A timestamp indicating the start time for the deferred maintenance
-- window.
--
-- 'clusterIdentifier', 'modifyClusterMaintenance_clusterIdentifier' - A unique identifier for the cluster.
newModifyClusterMaintenance ::
  -- | 'clusterIdentifier'
  Prelude.Text ->
  ModifyClusterMaintenance
newModifyClusterMaintenance :: Text -> ModifyClusterMaintenance
newModifyClusterMaintenance Text
pClusterIdentifier_ =
  ModifyClusterMaintenance'
    { $sel:deferMaintenance:ModifyClusterMaintenance' :: Maybe Bool
deferMaintenance =
        forall a. Maybe a
Prelude.Nothing,
      $sel:deferMaintenanceDuration:ModifyClusterMaintenance' :: Maybe Int
deferMaintenanceDuration = forall a. Maybe a
Prelude.Nothing,
      $sel:deferMaintenanceEndTime:ModifyClusterMaintenance' :: Maybe ISO8601
deferMaintenanceEndTime = forall a. Maybe a
Prelude.Nothing,
      $sel:deferMaintenanceIdentifier:ModifyClusterMaintenance' :: Maybe Text
deferMaintenanceIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:deferMaintenanceStartTime:ModifyClusterMaintenance' :: Maybe ISO8601
deferMaintenanceStartTime = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterIdentifier:ModifyClusterMaintenance' :: Text
clusterIdentifier = Text
pClusterIdentifier_
    }

-- | A boolean indicating whether to enable the deferred maintenance window.
modifyClusterMaintenance_deferMaintenance :: Lens.Lens' ModifyClusterMaintenance (Prelude.Maybe Prelude.Bool)
modifyClusterMaintenance_deferMaintenance :: Lens' ModifyClusterMaintenance (Maybe Bool)
modifyClusterMaintenance_deferMaintenance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterMaintenance' {Maybe Bool
deferMaintenance :: Maybe Bool
$sel:deferMaintenance:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Bool
deferMaintenance} -> Maybe Bool
deferMaintenance) (\s :: ModifyClusterMaintenance
s@ModifyClusterMaintenance' {} Maybe Bool
a -> ModifyClusterMaintenance
s {$sel:deferMaintenance:ModifyClusterMaintenance' :: Maybe Bool
deferMaintenance = Maybe Bool
a} :: ModifyClusterMaintenance)

-- | An integer indicating the duration of the maintenance window in days. If
-- you specify a duration, you can\'t specify an end time. The duration
-- must be 45 days or less.
modifyClusterMaintenance_deferMaintenanceDuration :: Lens.Lens' ModifyClusterMaintenance (Prelude.Maybe Prelude.Int)
modifyClusterMaintenance_deferMaintenanceDuration :: Lens' ModifyClusterMaintenance (Maybe Int)
modifyClusterMaintenance_deferMaintenanceDuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterMaintenance' {Maybe Int
deferMaintenanceDuration :: Maybe Int
$sel:deferMaintenanceDuration:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Int
deferMaintenanceDuration} -> Maybe Int
deferMaintenanceDuration) (\s :: ModifyClusterMaintenance
s@ModifyClusterMaintenance' {} Maybe Int
a -> ModifyClusterMaintenance
s {$sel:deferMaintenanceDuration:ModifyClusterMaintenance' :: Maybe Int
deferMaintenanceDuration = Maybe Int
a} :: ModifyClusterMaintenance)

-- | A timestamp indicating end time for the deferred maintenance window. If
-- you specify an end time, you can\'t specify a duration.
modifyClusterMaintenance_deferMaintenanceEndTime :: Lens.Lens' ModifyClusterMaintenance (Prelude.Maybe Prelude.UTCTime)
modifyClusterMaintenance_deferMaintenanceEndTime :: Lens' ModifyClusterMaintenance (Maybe UTCTime)
modifyClusterMaintenance_deferMaintenanceEndTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterMaintenance' {Maybe ISO8601
deferMaintenanceEndTime :: Maybe ISO8601
$sel:deferMaintenanceEndTime:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe ISO8601
deferMaintenanceEndTime} -> Maybe ISO8601
deferMaintenanceEndTime) (\s :: ModifyClusterMaintenance
s@ModifyClusterMaintenance' {} Maybe ISO8601
a -> ModifyClusterMaintenance
s {$sel:deferMaintenanceEndTime:ModifyClusterMaintenance' :: Maybe ISO8601
deferMaintenanceEndTime = Maybe ISO8601
a} :: ModifyClusterMaintenance) 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

-- | A unique identifier for the deferred maintenance window.
modifyClusterMaintenance_deferMaintenanceIdentifier :: Lens.Lens' ModifyClusterMaintenance (Prelude.Maybe Prelude.Text)
modifyClusterMaintenance_deferMaintenanceIdentifier :: Lens' ModifyClusterMaintenance (Maybe Text)
modifyClusterMaintenance_deferMaintenanceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterMaintenance' {Maybe Text
deferMaintenanceIdentifier :: Maybe Text
$sel:deferMaintenanceIdentifier:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Text
deferMaintenanceIdentifier} -> Maybe Text
deferMaintenanceIdentifier) (\s :: ModifyClusterMaintenance
s@ModifyClusterMaintenance' {} Maybe Text
a -> ModifyClusterMaintenance
s {$sel:deferMaintenanceIdentifier:ModifyClusterMaintenance' :: Maybe Text
deferMaintenanceIdentifier = Maybe Text
a} :: ModifyClusterMaintenance)

-- | A timestamp indicating the start time for the deferred maintenance
-- window.
modifyClusterMaintenance_deferMaintenanceStartTime :: Lens.Lens' ModifyClusterMaintenance (Prelude.Maybe Prelude.UTCTime)
modifyClusterMaintenance_deferMaintenanceStartTime :: Lens' ModifyClusterMaintenance (Maybe UTCTime)
modifyClusterMaintenance_deferMaintenanceStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterMaintenance' {Maybe ISO8601
deferMaintenanceStartTime :: Maybe ISO8601
$sel:deferMaintenanceStartTime:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe ISO8601
deferMaintenanceStartTime} -> Maybe ISO8601
deferMaintenanceStartTime) (\s :: ModifyClusterMaintenance
s@ModifyClusterMaintenance' {} Maybe ISO8601
a -> ModifyClusterMaintenance
s {$sel:deferMaintenanceStartTime:ModifyClusterMaintenance' :: Maybe ISO8601
deferMaintenanceStartTime = Maybe ISO8601
a} :: ModifyClusterMaintenance) 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

-- | A unique identifier for the cluster.
modifyClusterMaintenance_clusterIdentifier :: Lens.Lens' ModifyClusterMaintenance Prelude.Text
modifyClusterMaintenance_clusterIdentifier :: Lens' ModifyClusterMaintenance Text
modifyClusterMaintenance_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterMaintenance' {Text
clusterIdentifier :: Text
$sel:clusterIdentifier:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Text
clusterIdentifier} -> Text
clusterIdentifier) (\s :: ModifyClusterMaintenance
s@ModifyClusterMaintenance' {} Text
a -> ModifyClusterMaintenance
s {$sel:clusterIdentifier:ModifyClusterMaintenance' :: Text
clusterIdentifier = Text
a} :: ModifyClusterMaintenance)

instance Core.AWSRequest ModifyClusterMaintenance where
  type
    AWSResponse ModifyClusterMaintenance =
      ModifyClusterMaintenanceResponse
  request :: (Service -> Service)
-> ModifyClusterMaintenance -> Request ModifyClusterMaintenance
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ModifyClusterMaintenance
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyClusterMaintenance)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ModifyClusterMaintenanceResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Cluster -> Int -> ModifyClusterMaintenanceResponse
ModifyClusterMaintenanceResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Cluster")
            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 ModifyClusterMaintenance where
  hashWithSalt :: Int -> ModifyClusterMaintenance -> Int
hashWithSalt Int
_salt ModifyClusterMaintenance' {Maybe Bool
Maybe Int
Maybe Text
Maybe ISO8601
Text
clusterIdentifier :: Text
deferMaintenanceStartTime :: Maybe ISO8601
deferMaintenanceIdentifier :: Maybe Text
deferMaintenanceEndTime :: Maybe ISO8601
deferMaintenanceDuration :: Maybe Int
deferMaintenance :: Maybe Bool
$sel:clusterIdentifier:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Text
$sel:deferMaintenanceStartTime:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe ISO8601
$sel:deferMaintenanceIdentifier:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Text
$sel:deferMaintenanceEndTime:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe ISO8601
$sel:deferMaintenanceDuration:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Int
$sel:deferMaintenance:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deferMaintenance
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
deferMaintenanceDuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
deferMaintenanceEndTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deferMaintenanceIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
deferMaintenanceStartTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterIdentifier

instance Prelude.NFData ModifyClusterMaintenance where
  rnf :: ModifyClusterMaintenance -> ()
rnf ModifyClusterMaintenance' {Maybe Bool
Maybe Int
Maybe Text
Maybe ISO8601
Text
clusterIdentifier :: Text
deferMaintenanceStartTime :: Maybe ISO8601
deferMaintenanceIdentifier :: Maybe Text
deferMaintenanceEndTime :: Maybe ISO8601
deferMaintenanceDuration :: Maybe Int
deferMaintenance :: Maybe Bool
$sel:clusterIdentifier:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Text
$sel:deferMaintenanceStartTime:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe ISO8601
$sel:deferMaintenanceIdentifier:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Text
$sel:deferMaintenanceEndTime:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe ISO8601
$sel:deferMaintenanceDuration:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Int
$sel:deferMaintenance:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deferMaintenance
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
deferMaintenanceDuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
deferMaintenanceEndTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deferMaintenanceIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
deferMaintenanceStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterIdentifier

instance Data.ToHeaders ModifyClusterMaintenance where
  toHeaders :: ModifyClusterMaintenance -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ModifyClusterMaintenance where
  toQuery :: ModifyClusterMaintenance -> QueryString
toQuery ModifyClusterMaintenance' {Maybe Bool
Maybe Int
Maybe Text
Maybe ISO8601
Text
clusterIdentifier :: Text
deferMaintenanceStartTime :: Maybe ISO8601
deferMaintenanceIdentifier :: Maybe Text
deferMaintenanceEndTime :: Maybe ISO8601
deferMaintenanceDuration :: Maybe Int
deferMaintenance :: Maybe Bool
$sel:clusterIdentifier:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Text
$sel:deferMaintenanceStartTime:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe ISO8601
$sel:deferMaintenanceIdentifier:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Text
$sel:deferMaintenanceEndTime:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe ISO8601
$sel:deferMaintenanceDuration:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Int
$sel:deferMaintenance:ModifyClusterMaintenance' :: ModifyClusterMaintenance -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyClusterMaintenance" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"DeferMaintenance" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
deferMaintenance,
        ByteString
"DeferMaintenanceDuration"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
deferMaintenanceDuration,
        ByteString
"DeferMaintenanceEndTime"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
deferMaintenanceEndTime,
        ByteString
"DeferMaintenanceIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
deferMaintenanceIdentifier,
        ByteString
"DeferMaintenanceStartTime"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
deferMaintenanceStartTime,
        ByteString
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clusterIdentifier
      ]

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

-- |
-- Create a value of 'ModifyClusterMaintenanceResponse' 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:
--
-- 'cluster', 'modifyClusterMaintenanceResponse_cluster' - Undocumented member.
--
-- 'httpStatus', 'modifyClusterMaintenanceResponse_httpStatus' - The response's http status code.
newModifyClusterMaintenanceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyClusterMaintenanceResponse
newModifyClusterMaintenanceResponse :: Int -> ModifyClusterMaintenanceResponse
newModifyClusterMaintenanceResponse Int
pHttpStatus_ =
  ModifyClusterMaintenanceResponse'
    { $sel:cluster:ModifyClusterMaintenanceResponse' :: Maybe Cluster
cluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyClusterMaintenanceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
modifyClusterMaintenanceResponse_cluster :: Lens.Lens' ModifyClusterMaintenanceResponse (Prelude.Maybe Cluster)
modifyClusterMaintenanceResponse_cluster :: Lens' ModifyClusterMaintenanceResponse (Maybe Cluster)
modifyClusterMaintenanceResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClusterMaintenanceResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:ModifyClusterMaintenanceResponse' :: ModifyClusterMaintenanceResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: ModifyClusterMaintenanceResponse
s@ModifyClusterMaintenanceResponse' {} Maybe Cluster
a -> ModifyClusterMaintenanceResponse
s {$sel:cluster:ModifyClusterMaintenanceResponse' :: Maybe Cluster
cluster = Maybe Cluster
a} :: ModifyClusterMaintenanceResponse)

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

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