{-# 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.PromoteReadReplicaDBCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Promotes a read replica DB cluster to a standalone DB cluster.
module Amazonka.RDS.PromoteReadReplicaDBCluster
  ( -- * Creating a Request
    PromoteReadReplicaDBCluster (..),
    newPromoteReadReplicaDBCluster,

    -- * Request Lenses
    promoteReadReplicaDBCluster_dbClusterIdentifier,

    -- * Destructuring the Response
    PromoteReadReplicaDBClusterResponse (..),
    newPromoteReadReplicaDBClusterResponse,

    -- * Response Lenses
    promoteReadReplicaDBClusterResponse_dbCluster,
    promoteReadReplicaDBClusterResponse_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:/ 'newPromoteReadReplicaDBCluster' smart constructor.
data PromoteReadReplicaDBCluster = PromoteReadReplicaDBCluster'
  { -- | The identifier of the DB cluster read replica to promote. This parameter
    -- isn\'t case-sensitive.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing DB cluster read replica.
    --
    -- Example: @my-cluster-replica1@
    PromoteReadReplicaDBCluster -> Text
dbClusterIdentifier :: Prelude.Text
  }
  deriving (PromoteReadReplicaDBCluster -> PromoteReadReplicaDBCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PromoteReadReplicaDBCluster -> PromoteReadReplicaDBCluster -> Bool
$c/= :: PromoteReadReplicaDBCluster -> PromoteReadReplicaDBCluster -> Bool
== :: PromoteReadReplicaDBCluster -> PromoteReadReplicaDBCluster -> Bool
$c== :: PromoteReadReplicaDBCluster -> PromoteReadReplicaDBCluster -> Bool
Prelude.Eq, ReadPrec [PromoteReadReplicaDBCluster]
ReadPrec PromoteReadReplicaDBCluster
Int -> ReadS PromoteReadReplicaDBCluster
ReadS [PromoteReadReplicaDBCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PromoteReadReplicaDBCluster]
$creadListPrec :: ReadPrec [PromoteReadReplicaDBCluster]
readPrec :: ReadPrec PromoteReadReplicaDBCluster
$creadPrec :: ReadPrec PromoteReadReplicaDBCluster
readList :: ReadS [PromoteReadReplicaDBCluster]
$creadList :: ReadS [PromoteReadReplicaDBCluster]
readsPrec :: Int -> ReadS PromoteReadReplicaDBCluster
$creadsPrec :: Int -> ReadS PromoteReadReplicaDBCluster
Prelude.Read, Int -> PromoteReadReplicaDBCluster -> ShowS
[PromoteReadReplicaDBCluster] -> ShowS
PromoteReadReplicaDBCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PromoteReadReplicaDBCluster] -> ShowS
$cshowList :: [PromoteReadReplicaDBCluster] -> ShowS
show :: PromoteReadReplicaDBCluster -> String
$cshow :: PromoteReadReplicaDBCluster -> String
showsPrec :: Int -> PromoteReadReplicaDBCluster -> ShowS
$cshowsPrec :: Int -> PromoteReadReplicaDBCluster -> ShowS
Prelude.Show, forall x.
Rep PromoteReadReplicaDBCluster x -> PromoteReadReplicaDBCluster
forall x.
PromoteReadReplicaDBCluster -> Rep PromoteReadReplicaDBCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PromoteReadReplicaDBCluster x -> PromoteReadReplicaDBCluster
$cfrom :: forall x.
PromoteReadReplicaDBCluster -> Rep PromoteReadReplicaDBCluster x
Prelude.Generic)

-- |
-- Create a value of 'PromoteReadReplicaDBCluster' 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', 'promoteReadReplicaDBCluster_dbClusterIdentifier' - The identifier of the DB cluster read replica to promote. This parameter
-- isn\'t case-sensitive.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DB cluster read replica.
--
-- Example: @my-cluster-replica1@
newPromoteReadReplicaDBCluster ::
  -- | 'dbClusterIdentifier'
  Prelude.Text ->
  PromoteReadReplicaDBCluster
newPromoteReadReplicaDBCluster :: Text -> PromoteReadReplicaDBCluster
newPromoteReadReplicaDBCluster Text
pDBClusterIdentifier_ =
  PromoteReadReplicaDBCluster'
    { $sel:dbClusterIdentifier:PromoteReadReplicaDBCluster' :: Text
dbClusterIdentifier =
        Text
pDBClusterIdentifier_
    }

-- | The identifier of the DB cluster read replica to promote. This parameter
-- isn\'t case-sensitive.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DB cluster read replica.
--
-- Example: @my-cluster-replica1@
promoteReadReplicaDBCluster_dbClusterIdentifier :: Lens.Lens' PromoteReadReplicaDBCluster Prelude.Text
promoteReadReplicaDBCluster_dbClusterIdentifier :: Lens' PromoteReadReplicaDBCluster Text
promoteReadReplicaDBCluster_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PromoteReadReplicaDBCluster' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:PromoteReadReplicaDBCluster' :: PromoteReadReplicaDBCluster -> Text
dbClusterIdentifier} -> Text
dbClusterIdentifier) (\s :: PromoteReadReplicaDBCluster
s@PromoteReadReplicaDBCluster' {} Text
a -> PromoteReadReplicaDBCluster
s {$sel:dbClusterIdentifier:PromoteReadReplicaDBCluster' :: Text
dbClusterIdentifier = Text
a} :: PromoteReadReplicaDBCluster)

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

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

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

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

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

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

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

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

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