{-# 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.DocumentDB.RemoveFromGlobalCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Detaches an Amazon DocumentDB secondary cluster from a global cluster.
-- The cluster becomes a standalone cluster with read-write capability
-- instead of being read-only and receiving data from a primary in a
-- different region.
--
-- This action only applies to Amazon DocumentDB clusters.
module Amazonka.DocumentDB.RemoveFromGlobalCluster
  ( -- * Creating a Request
    RemoveFromGlobalCluster (..),
    newRemoveFromGlobalCluster,

    -- * Request Lenses
    removeFromGlobalCluster_globalClusterIdentifier,
    removeFromGlobalCluster_dbClusterIdentifier,

    -- * Destructuring the Response
    RemoveFromGlobalClusterResponse (..),
    newRemoveFromGlobalClusterResponse,

    -- * Response Lenses
    removeFromGlobalClusterResponse_globalCluster,
    removeFromGlobalClusterResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DocumentDB.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Represents the input to RemoveFromGlobalCluster.
--
-- /See:/ 'newRemoveFromGlobalCluster' smart constructor.
data RemoveFromGlobalCluster = RemoveFromGlobalCluster'
  { -- | The cluster identifier to detach from the Amazon DocumentDB global
    -- cluster.
    RemoveFromGlobalCluster -> Text
globalClusterIdentifier :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) identifying the cluster that was detached
    -- from the Amazon DocumentDB global cluster.
    RemoveFromGlobalCluster -> Text
dbClusterIdentifier :: Prelude.Text
  }
  deriving (RemoveFromGlobalCluster -> RemoveFromGlobalCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveFromGlobalCluster -> RemoveFromGlobalCluster -> Bool
$c/= :: RemoveFromGlobalCluster -> RemoveFromGlobalCluster -> Bool
== :: RemoveFromGlobalCluster -> RemoveFromGlobalCluster -> Bool
$c== :: RemoveFromGlobalCluster -> RemoveFromGlobalCluster -> Bool
Prelude.Eq, ReadPrec [RemoveFromGlobalCluster]
ReadPrec RemoveFromGlobalCluster
Int -> ReadS RemoveFromGlobalCluster
ReadS [RemoveFromGlobalCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveFromGlobalCluster]
$creadListPrec :: ReadPrec [RemoveFromGlobalCluster]
readPrec :: ReadPrec RemoveFromGlobalCluster
$creadPrec :: ReadPrec RemoveFromGlobalCluster
readList :: ReadS [RemoveFromGlobalCluster]
$creadList :: ReadS [RemoveFromGlobalCluster]
readsPrec :: Int -> ReadS RemoveFromGlobalCluster
$creadsPrec :: Int -> ReadS RemoveFromGlobalCluster
Prelude.Read, Int -> RemoveFromGlobalCluster -> ShowS
[RemoveFromGlobalCluster] -> ShowS
RemoveFromGlobalCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveFromGlobalCluster] -> ShowS
$cshowList :: [RemoveFromGlobalCluster] -> ShowS
show :: RemoveFromGlobalCluster -> String
$cshow :: RemoveFromGlobalCluster -> String
showsPrec :: Int -> RemoveFromGlobalCluster -> ShowS
$cshowsPrec :: Int -> RemoveFromGlobalCluster -> ShowS
Prelude.Show, forall x. Rep RemoveFromGlobalCluster x -> RemoveFromGlobalCluster
forall x. RemoveFromGlobalCluster -> Rep RemoveFromGlobalCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoveFromGlobalCluster x -> RemoveFromGlobalCluster
$cfrom :: forall x. RemoveFromGlobalCluster -> Rep RemoveFromGlobalCluster x
Prelude.Generic)

-- |
-- Create a value of 'RemoveFromGlobalCluster' 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:
--
-- 'globalClusterIdentifier', 'removeFromGlobalCluster_globalClusterIdentifier' - The cluster identifier to detach from the Amazon DocumentDB global
-- cluster.
--
-- 'dbClusterIdentifier', 'removeFromGlobalCluster_dbClusterIdentifier' - The Amazon Resource Name (ARN) identifying the cluster that was detached
-- from the Amazon DocumentDB global cluster.
newRemoveFromGlobalCluster ::
  -- | 'globalClusterIdentifier'
  Prelude.Text ->
  -- | 'dbClusterIdentifier'
  Prelude.Text ->
  RemoveFromGlobalCluster
newRemoveFromGlobalCluster :: Text -> Text -> RemoveFromGlobalCluster
newRemoveFromGlobalCluster
  Text
pGlobalClusterIdentifier_
  Text
pDbClusterIdentifier_ =
    RemoveFromGlobalCluster'
      { $sel:globalClusterIdentifier:RemoveFromGlobalCluster' :: Text
globalClusterIdentifier =
          Text
pGlobalClusterIdentifier_,
        $sel:dbClusterIdentifier:RemoveFromGlobalCluster' :: Text
dbClusterIdentifier = Text
pDbClusterIdentifier_
      }

-- | The cluster identifier to detach from the Amazon DocumentDB global
-- cluster.
removeFromGlobalCluster_globalClusterIdentifier :: Lens.Lens' RemoveFromGlobalCluster Prelude.Text
removeFromGlobalCluster_globalClusterIdentifier :: Lens' RemoveFromGlobalCluster Text
removeFromGlobalCluster_globalClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveFromGlobalCluster' {Text
globalClusterIdentifier :: Text
$sel:globalClusterIdentifier:RemoveFromGlobalCluster' :: RemoveFromGlobalCluster -> Text
globalClusterIdentifier} -> Text
globalClusterIdentifier) (\s :: RemoveFromGlobalCluster
s@RemoveFromGlobalCluster' {} Text
a -> RemoveFromGlobalCluster
s {$sel:globalClusterIdentifier:RemoveFromGlobalCluster' :: Text
globalClusterIdentifier = Text
a} :: RemoveFromGlobalCluster)

-- | The Amazon Resource Name (ARN) identifying the cluster that was detached
-- from the Amazon DocumentDB global cluster.
removeFromGlobalCluster_dbClusterIdentifier :: Lens.Lens' RemoveFromGlobalCluster Prelude.Text
removeFromGlobalCluster_dbClusterIdentifier :: Lens' RemoveFromGlobalCluster Text
removeFromGlobalCluster_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveFromGlobalCluster' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:RemoveFromGlobalCluster' :: RemoveFromGlobalCluster -> Text
dbClusterIdentifier} -> Text
dbClusterIdentifier) (\s :: RemoveFromGlobalCluster
s@RemoveFromGlobalCluster' {} Text
a -> RemoveFromGlobalCluster
s {$sel:dbClusterIdentifier:RemoveFromGlobalCluster' :: Text
dbClusterIdentifier = Text
a} :: RemoveFromGlobalCluster)

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

instance Prelude.NFData RemoveFromGlobalCluster where
  rnf :: RemoveFromGlobalCluster -> ()
rnf RemoveFromGlobalCluster' {Text
dbClusterIdentifier :: Text
globalClusterIdentifier :: Text
$sel:dbClusterIdentifier:RemoveFromGlobalCluster' :: RemoveFromGlobalCluster -> Text
$sel:globalClusterIdentifier:RemoveFromGlobalCluster' :: RemoveFromGlobalCluster -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
globalClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbClusterIdentifier

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

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

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

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

-- |
-- Create a value of 'RemoveFromGlobalClusterResponse' 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:
--
-- 'globalCluster', 'removeFromGlobalClusterResponse_globalCluster' - Undocumented member.
--
-- 'httpStatus', 'removeFromGlobalClusterResponse_httpStatus' - The response's http status code.
newRemoveFromGlobalClusterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RemoveFromGlobalClusterResponse
newRemoveFromGlobalClusterResponse :: Int -> RemoveFromGlobalClusterResponse
newRemoveFromGlobalClusterResponse Int
pHttpStatus_ =
  RemoveFromGlobalClusterResponse'
    { $sel:globalCluster:RemoveFromGlobalClusterResponse' :: Maybe GlobalCluster
globalCluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RemoveFromGlobalClusterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
removeFromGlobalClusterResponse_globalCluster :: Lens.Lens' RemoveFromGlobalClusterResponse (Prelude.Maybe GlobalCluster)
removeFromGlobalClusterResponse_globalCluster :: Lens' RemoveFromGlobalClusterResponse (Maybe GlobalCluster)
removeFromGlobalClusterResponse_globalCluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveFromGlobalClusterResponse' {Maybe GlobalCluster
globalCluster :: Maybe GlobalCluster
$sel:globalCluster:RemoveFromGlobalClusterResponse' :: RemoveFromGlobalClusterResponse -> Maybe GlobalCluster
globalCluster} -> Maybe GlobalCluster
globalCluster) (\s :: RemoveFromGlobalClusterResponse
s@RemoveFromGlobalClusterResponse' {} Maybe GlobalCluster
a -> RemoveFromGlobalClusterResponse
s {$sel:globalCluster:RemoveFromGlobalClusterResponse' :: Maybe GlobalCluster
globalCluster = Maybe GlobalCluster
a} :: RemoveFromGlobalClusterResponse)

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

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