{-# 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.Neptune.DeleteGlobalCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a global database. The primary and all secondary clusters must
-- already be detached or deleted first.
module Amazonka.Neptune.DeleteGlobalCluster
  ( -- * Creating a Request
    DeleteGlobalCluster (..),
    newDeleteGlobalCluster,

    -- * Request Lenses
    deleteGlobalCluster_globalClusterIdentifier,

    -- * Destructuring the Response
    DeleteGlobalClusterResponse (..),
    newDeleteGlobalClusterResponse,

    -- * Response Lenses
    deleteGlobalClusterResponse_globalCluster,
    deleteGlobalClusterResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteGlobalCluster' smart constructor.
data DeleteGlobalCluster = DeleteGlobalCluster'
  { -- | The cluster identifier of the global database cluster being deleted.
    DeleteGlobalCluster -> Text
globalClusterIdentifier :: Prelude.Text
  }
  deriving (DeleteGlobalCluster -> DeleteGlobalCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteGlobalCluster -> DeleteGlobalCluster -> Bool
$c/= :: DeleteGlobalCluster -> DeleteGlobalCluster -> Bool
== :: DeleteGlobalCluster -> DeleteGlobalCluster -> Bool
$c== :: DeleteGlobalCluster -> DeleteGlobalCluster -> Bool
Prelude.Eq, ReadPrec [DeleteGlobalCluster]
ReadPrec DeleteGlobalCluster
Int -> ReadS DeleteGlobalCluster
ReadS [DeleteGlobalCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteGlobalCluster]
$creadListPrec :: ReadPrec [DeleteGlobalCluster]
readPrec :: ReadPrec DeleteGlobalCluster
$creadPrec :: ReadPrec DeleteGlobalCluster
readList :: ReadS [DeleteGlobalCluster]
$creadList :: ReadS [DeleteGlobalCluster]
readsPrec :: Int -> ReadS DeleteGlobalCluster
$creadsPrec :: Int -> ReadS DeleteGlobalCluster
Prelude.Read, Int -> DeleteGlobalCluster -> ShowS
[DeleteGlobalCluster] -> ShowS
DeleteGlobalCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteGlobalCluster] -> ShowS
$cshowList :: [DeleteGlobalCluster] -> ShowS
show :: DeleteGlobalCluster -> String
$cshow :: DeleteGlobalCluster -> String
showsPrec :: Int -> DeleteGlobalCluster -> ShowS
$cshowsPrec :: Int -> DeleteGlobalCluster -> ShowS
Prelude.Show, forall x. Rep DeleteGlobalCluster x -> DeleteGlobalCluster
forall x. DeleteGlobalCluster -> Rep DeleteGlobalCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteGlobalCluster x -> DeleteGlobalCluster
$cfrom :: forall x. DeleteGlobalCluster -> Rep DeleteGlobalCluster x
Prelude.Generic)

-- |
-- Create a value of 'DeleteGlobalCluster' 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', 'deleteGlobalCluster_globalClusterIdentifier' - The cluster identifier of the global database cluster being deleted.
newDeleteGlobalCluster ::
  -- | 'globalClusterIdentifier'
  Prelude.Text ->
  DeleteGlobalCluster
newDeleteGlobalCluster :: Text -> DeleteGlobalCluster
newDeleteGlobalCluster Text
pGlobalClusterIdentifier_ =
  DeleteGlobalCluster'
    { $sel:globalClusterIdentifier:DeleteGlobalCluster' :: Text
globalClusterIdentifier =
        Text
pGlobalClusterIdentifier_
    }

-- | The cluster identifier of the global database cluster being deleted.
deleteGlobalCluster_globalClusterIdentifier :: Lens.Lens' DeleteGlobalCluster Prelude.Text
deleteGlobalCluster_globalClusterIdentifier :: Lens' DeleteGlobalCluster Text
deleteGlobalCluster_globalClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteGlobalCluster' {Text
globalClusterIdentifier :: Text
$sel:globalClusterIdentifier:DeleteGlobalCluster' :: DeleteGlobalCluster -> Text
globalClusterIdentifier} -> Text
globalClusterIdentifier) (\s :: DeleteGlobalCluster
s@DeleteGlobalCluster' {} Text
a -> DeleteGlobalCluster
s {$sel:globalClusterIdentifier:DeleteGlobalCluster' :: Text
globalClusterIdentifier = Text
a} :: DeleteGlobalCluster)

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

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

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

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

instance Data.ToQuery DeleteGlobalCluster where
  toQuery :: DeleteGlobalCluster -> QueryString
toQuery DeleteGlobalCluster' {Text
globalClusterIdentifier :: Text
$sel:globalClusterIdentifier:DeleteGlobalCluster' :: DeleteGlobalCluster -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteGlobalCluster" :: 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
      ]

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

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

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

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

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