{-# 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.StopDBCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops an Amazon Aurora DB cluster. When you stop a DB cluster, Aurora
-- retains the DB cluster\'s metadata, including its endpoints and DB
-- parameter groups. Aurora also retains the transaction logs so you can do
-- a point-in-time restore if necessary.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/aurora-cluster-stop-start.html Stopping and Starting an Aurora Cluster>
-- in the /Amazon Aurora User Guide/.
--
-- This action only applies to Aurora DB clusters.
module Amazonka.RDS.StopDBCluster
  ( -- * Creating a Request
    StopDBCluster (..),
    newStopDBCluster,

    -- * Request Lenses
    stopDBCluster_dbClusterIdentifier,

    -- * Destructuring the Response
    StopDBClusterResponse (..),
    newStopDBClusterResponse,

    -- * Response Lenses
    stopDBClusterResponse_dbCluster,
    stopDBClusterResponse_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:/ 'newStopDBCluster' smart constructor.
data StopDBCluster = StopDBCluster'
  { -- | The DB cluster identifier of the Amazon Aurora DB cluster to be stopped.
    -- This parameter is stored as a lowercase string.
    StopDBCluster -> Text
dbClusterIdentifier :: Prelude.Text
  }
  deriving (StopDBCluster -> StopDBCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopDBCluster -> StopDBCluster -> Bool
$c/= :: StopDBCluster -> StopDBCluster -> Bool
== :: StopDBCluster -> StopDBCluster -> Bool
$c== :: StopDBCluster -> StopDBCluster -> Bool
Prelude.Eq, ReadPrec [StopDBCluster]
ReadPrec StopDBCluster
Int -> ReadS StopDBCluster
ReadS [StopDBCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopDBCluster]
$creadListPrec :: ReadPrec [StopDBCluster]
readPrec :: ReadPrec StopDBCluster
$creadPrec :: ReadPrec StopDBCluster
readList :: ReadS [StopDBCluster]
$creadList :: ReadS [StopDBCluster]
readsPrec :: Int -> ReadS StopDBCluster
$creadsPrec :: Int -> ReadS StopDBCluster
Prelude.Read, Int -> StopDBCluster -> ShowS
[StopDBCluster] -> ShowS
StopDBCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopDBCluster] -> ShowS
$cshowList :: [StopDBCluster] -> ShowS
show :: StopDBCluster -> String
$cshow :: StopDBCluster -> String
showsPrec :: Int -> StopDBCluster -> ShowS
$cshowsPrec :: Int -> StopDBCluster -> ShowS
Prelude.Show, forall x. Rep StopDBCluster x -> StopDBCluster
forall x. StopDBCluster -> Rep StopDBCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopDBCluster x -> StopDBCluster
$cfrom :: forall x. StopDBCluster -> Rep StopDBCluster x
Prelude.Generic)

-- |
-- Create a value of 'StopDBCluster' 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', 'stopDBCluster_dbClusterIdentifier' - The DB cluster identifier of the Amazon Aurora DB cluster to be stopped.
-- This parameter is stored as a lowercase string.
newStopDBCluster ::
  -- | 'dbClusterIdentifier'
  Prelude.Text ->
  StopDBCluster
newStopDBCluster :: Text -> StopDBCluster
newStopDBCluster Text
pDBClusterIdentifier_ =
  StopDBCluster'
    { $sel:dbClusterIdentifier:StopDBCluster' :: Text
dbClusterIdentifier =
        Text
pDBClusterIdentifier_
    }

-- | The DB cluster identifier of the Amazon Aurora DB cluster to be stopped.
-- This parameter is stored as a lowercase string.
stopDBCluster_dbClusterIdentifier :: Lens.Lens' StopDBCluster Prelude.Text
stopDBCluster_dbClusterIdentifier :: Lens' StopDBCluster Text
stopDBCluster_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopDBCluster' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:StopDBCluster' :: StopDBCluster -> Text
dbClusterIdentifier} -> Text
dbClusterIdentifier) (\s :: StopDBCluster
s@StopDBCluster' {} Text
a -> StopDBCluster
s {$sel:dbClusterIdentifier:StopDBCluster' :: Text
dbClusterIdentifier = Text
a} :: StopDBCluster)

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

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

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

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

instance Data.ToQuery StopDBCluster where
  toQuery :: StopDBCluster -> QueryString
toQuery StopDBCluster' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:StopDBCluster' :: StopDBCluster -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"StopDBCluster" :: 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:/ 'newStopDBClusterResponse' smart constructor.
data StopDBClusterResponse = StopDBClusterResponse'
  { StopDBClusterResponse -> Maybe DBCluster
dbCluster :: Prelude.Maybe DBCluster,
    -- | The response's http status code.
    StopDBClusterResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StopDBClusterResponse -> StopDBClusterResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopDBClusterResponse -> StopDBClusterResponse -> Bool
$c/= :: StopDBClusterResponse -> StopDBClusterResponse -> Bool
== :: StopDBClusterResponse -> StopDBClusterResponse -> Bool
$c== :: StopDBClusterResponse -> StopDBClusterResponse -> Bool
Prelude.Eq, ReadPrec [StopDBClusterResponse]
ReadPrec StopDBClusterResponse
Int -> ReadS StopDBClusterResponse
ReadS [StopDBClusterResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopDBClusterResponse]
$creadListPrec :: ReadPrec [StopDBClusterResponse]
readPrec :: ReadPrec StopDBClusterResponse
$creadPrec :: ReadPrec StopDBClusterResponse
readList :: ReadS [StopDBClusterResponse]
$creadList :: ReadS [StopDBClusterResponse]
readsPrec :: Int -> ReadS StopDBClusterResponse
$creadsPrec :: Int -> ReadS StopDBClusterResponse
Prelude.Read, Int -> StopDBClusterResponse -> ShowS
[StopDBClusterResponse] -> ShowS
StopDBClusterResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopDBClusterResponse] -> ShowS
$cshowList :: [StopDBClusterResponse] -> ShowS
show :: StopDBClusterResponse -> String
$cshow :: StopDBClusterResponse -> String
showsPrec :: Int -> StopDBClusterResponse -> ShowS
$cshowsPrec :: Int -> StopDBClusterResponse -> ShowS
Prelude.Show, forall x. Rep StopDBClusterResponse x -> StopDBClusterResponse
forall x. StopDBClusterResponse -> Rep StopDBClusterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopDBClusterResponse x -> StopDBClusterResponse
$cfrom :: forall x. StopDBClusterResponse -> Rep StopDBClusterResponse x
Prelude.Generic)

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

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

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

instance Prelude.NFData StopDBClusterResponse where
  rnf :: StopDBClusterResponse -> ()
rnf StopDBClusterResponse' {Int
Maybe DBCluster
httpStatus :: Int
dbCluster :: Maybe DBCluster
$sel:httpStatus:StopDBClusterResponse' :: StopDBClusterResponse -> Int
$sel:dbCluster:StopDBClusterResponse' :: StopDBClusterResponse -> 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