{-# 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.RDS.RebootDBCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- You might need to reboot your DB cluster, usually for maintenance
-- reasons. For example, if you make certain modifications, or if you
-- change the DB cluster parameter group associated with the DB cluster,
-- reboot the DB cluster for the changes to take effect.
--
-- Rebooting a DB cluster restarts the database engine service. Rebooting a
-- DB cluster results in a momentary outage, during which the DB cluster
-- status is set to rebooting.
--
-- Use this operation only for a non-Aurora Multi-AZ DB cluster.
--
-- For more information on Multi-AZ DB clusters, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/multi-az-db-clusters-concepts.html Multi-AZ deployments with two readable standby DB instances>
-- in the /Amazon RDS User Guide./
module Amazonka.RDS.RebootDBCluster
  ( -- * Creating a Request
    RebootDBCluster (..),
    newRebootDBCluster,

    -- * Request Lenses
    rebootDBCluster_dbClusterIdentifier,

    -- * Destructuring the Response
    RebootDBClusterResponse (..),
    newRebootDBClusterResponse,

    -- * Response Lenses
    rebootDBClusterResponse_dbCluster,
    rebootDBClusterResponse_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.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newRebootDBCluster' smart constructor.
data RebootDBCluster = RebootDBCluster'
  { -- | The DB cluster identifier. This parameter is stored as a lowercase
    -- string.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing DBCluster.
    RebootDBCluster -> Text
dbClusterIdentifier :: Prelude.Text
  }
  deriving (RebootDBCluster -> RebootDBCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RebootDBCluster -> RebootDBCluster -> Bool
$c/= :: RebootDBCluster -> RebootDBCluster -> Bool
== :: RebootDBCluster -> RebootDBCluster -> Bool
$c== :: RebootDBCluster -> RebootDBCluster -> Bool
Prelude.Eq, ReadPrec [RebootDBCluster]
ReadPrec RebootDBCluster
Int -> ReadS RebootDBCluster
ReadS [RebootDBCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RebootDBCluster]
$creadListPrec :: ReadPrec [RebootDBCluster]
readPrec :: ReadPrec RebootDBCluster
$creadPrec :: ReadPrec RebootDBCluster
readList :: ReadS [RebootDBCluster]
$creadList :: ReadS [RebootDBCluster]
readsPrec :: Int -> ReadS RebootDBCluster
$creadsPrec :: Int -> ReadS RebootDBCluster
Prelude.Read, Int -> RebootDBCluster -> ShowS
[RebootDBCluster] -> ShowS
RebootDBCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RebootDBCluster] -> ShowS
$cshowList :: [RebootDBCluster] -> ShowS
show :: RebootDBCluster -> String
$cshow :: RebootDBCluster -> String
showsPrec :: Int -> RebootDBCluster -> ShowS
$cshowsPrec :: Int -> RebootDBCluster -> ShowS
Prelude.Show, forall x. Rep RebootDBCluster x -> RebootDBCluster
forall x. RebootDBCluster -> Rep RebootDBCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RebootDBCluster x -> RebootDBCluster
$cfrom :: forall x. RebootDBCluster -> Rep RebootDBCluster x
Prelude.Generic)

-- |
-- Create a value of 'RebootDBCluster' 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:
--
-- 'dbClusterIdentifier', 'rebootDBCluster_dbClusterIdentifier' - The DB cluster identifier. This parameter is stored as a lowercase
-- string.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBCluster.
newRebootDBCluster ::
  -- | 'dbClusterIdentifier'
  Prelude.Text ->
  RebootDBCluster
newRebootDBCluster :: Text -> RebootDBCluster
newRebootDBCluster Text
pDBClusterIdentifier_ =
  RebootDBCluster'
    { $sel:dbClusterIdentifier:RebootDBCluster' :: Text
dbClusterIdentifier =
        Text
pDBClusterIdentifier_
    }

-- | The DB cluster identifier. This parameter is stored as a lowercase
-- string.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBCluster.
rebootDBCluster_dbClusterIdentifier :: Lens.Lens' RebootDBCluster Prelude.Text
rebootDBCluster_dbClusterIdentifier :: Lens' RebootDBCluster Text
rebootDBCluster_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RebootDBCluster' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:RebootDBCluster' :: RebootDBCluster -> Text
dbClusterIdentifier} -> Text
dbClusterIdentifier) (\s :: RebootDBCluster
s@RebootDBCluster' {} Text
a -> RebootDBCluster
s {$sel:dbClusterIdentifier:RebootDBCluster' :: Text
dbClusterIdentifier = Text
a} :: RebootDBCluster)

instance Core.AWSRequest RebootDBCluster where
  type
    AWSResponse RebootDBCluster =
      RebootDBClusterResponse
  request :: (Service -> Service) -> RebootDBCluster -> Request RebootDBCluster
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 RebootDBCluster
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RebootDBCluster)))
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
"RebootDBClusterResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBCluster -> Int -> RebootDBClusterResponse
RebootDBClusterResponse'
            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
"DBCluster")
            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 RebootDBCluster where
  hashWithSalt :: Int -> RebootDBCluster -> Int
hashWithSalt Int
_salt RebootDBCluster' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:RebootDBCluster' :: RebootDBCluster -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbClusterIdentifier

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

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

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

instance Data.ToQuery RebootDBCluster where
  toQuery :: RebootDBCluster -> QueryString
toQuery RebootDBCluster' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:RebootDBCluster' :: RebootDBCluster -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RebootDBCluster" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"DBClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbClusterIdentifier
      ]

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

-- |
-- Create a value of 'RebootDBClusterResponse' 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:
--
-- 'dbCluster', 'rebootDBClusterResponse_dbCluster' - Undocumented member.
--
-- 'httpStatus', 'rebootDBClusterResponse_httpStatus' - The response's http status code.
newRebootDBClusterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RebootDBClusterResponse
newRebootDBClusterResponse :: Int -> RebootDBClusterResponse
newRebootDBClusterResponse Int
pHttpStatus_ =
  RebootDBClusterResponse'
    { $sel:dbCluster:RebootDBClusterResponse' :: Maybe DBCluster
dbCluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RebootDBClusterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
rebootDBClusterResponse_dbCluster :: Lens.Lens' RebootDBClusterResponse (Prelude.Maybe DBCluster)
rebootDBClusterResponse_dbCluster :: Lens' RebootDBClusterResponse (Maybe DBCluster)
rebootDBClusterResponse_dbCluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RebootDBClusterResponse' {Maybe DBCluster
dbCluster :: Maybe DBCluster
$sel:dbCluster:RebootDBClusterResponse' :: RebootDBClusterResponse -> Maybe DBCluster
dbCluster} -> Maybe DBCluster
dbCluster) (\s :: RebootDBClusterResponse
s@RebootDBClusterResponse' {} Maybe DBCluster
a -> RebootDBClusterResponse
s {$sel:dbCluster:RebootDBClusterResponse' :: Maybe DBCluster
dbCluster = Maybe DBCluster
a} :: RebootDBClusterResponse)

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

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