{-# 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.ElastiCache.DeleteGlobalReplicationGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deleting a Global datastore is a two-step process:
--
-- -   First, you must DisassociateGlobalReplicationGroup to remove the
--     secondary clusters in the Global datastore.
--
-- -   Once the Global datastore contains only the primary cluster, you can
--     use the @DeleteGlobalReplicationGroup@ API to delete the Global
--     datastore while retainining the primary cluster using
--     @RetainPrimaryReplicationGroup=true@.
--
-- Since the Global Datastore has only a primary cluster, you can delete
-- the Global Datastore while retaining the primary by setting
-- @RetainPrimaryReplicationGroup=true@. The primary cluster is never
-- deleted when deleting a Global Datastore. It can only be deleted when it
-- no longer is associated with any Global Datastore.
--
-- When you receive a successful response from this operation, Amazon
-- ElastiCache immediately begins deleting the selected resources; you
-- cannot cancel or revert this operation.
module Amazonka.ElastiCache.DeleteGlobalReplicationGroup
  ( -- * Creating a Request
    DeleteGlobalReplicationGroup (..),
    newDeleteGlobalReplicationGroup,

    -- * Request Lenses
    deleteGlobalReplicationGroup_globalReplicationGroupId,
    deleteGlobalReplicationGroup_retainPrimaryReplicationGroup,

    -- * Destructuring the Response
    DeleteGlobalReplicationGroupResponse (..),
    newDeleteGlobalReplicationGroupResponse,

    -- * Response Lenses
    deleteGlobalReplicationGroupResponse_globalReplicationGroup,
    deleteGlobalReplicationGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteGlobalReplicationGroup' smart constructor.
data DeleteGlobalReplicationGroup = DeleteGlobalReplicationGroup'
  { -- | The name of the Global datastore
    DeleteGlobalReplicationGroup -> Text
globalReplicationGroupId :: Prelude.Text,
    -- | The primary replication group is retained as a standalone replication
    -- group.
    DeleteGlobalReplicationGroup -> Bool
retainPrimaryReplicationGroup :: Prelude.Bool
  }
  deriving (DeleteGlobalReplicationGroup
-> DeleteGlobalReplicationGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteGlobalReplicationGroup
-> DeleteGlobalReplicationGroup -> Bool
$c/= :: DeleteGlobalReplicationGroup
-> DeleteGlobalReplicationGroup -> Bool
== :: DeleteGlobalReplicationGroup
-> DeleteGlobalReplicationGroup -> Bool
$c== :: DeleteGlobalReplicationGroup
-> DeleteGlobalReplicationGroup -> Bool
Prelude.Eq, ReadPrec [DeleteGlobalReplicationGroup]
ReadPrec DeleteGlobalReplicationGroup
Int -> ReadS DeleteGlobalReplicationGroup
ReadS [DeleteGlobalReplicationGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteGlobalReplicationGroup]
$creadListPrec :: ReadPrec [DeleteGlobalReplicationGroup]
readPrec :: ReadPrec DeleteGlobalReplicationGroup
$creadPrec :: ReadPrec DeleteGlobalReplicationGroup
readList :: ReadS [DeleteGlobalReplicationGroup]
$creadList :: ReadS [DeleteGlobalReplicationGroup]
readsPrec :: Int -> ReadS DeleteGlobalReplicationGroup
$creadsPrec :: Int -> ReadS DeleteGlobalReplicationGroup
Prelude.Read, Int -> DeleteGlobalReplicationGroup -> ShowS
[DeleteGlobalReplicationGroup] -> ShowS
DeleteGlobalReplicationGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteGlobalReplicationGroup] -> ShowS
$cshowList :: [DeleteGlobalReplicationGroup] -> ShowS
show :: DeleteGlobalReplicationGroup -> String
$cshow :: DeleteGlobalReplicationGroup -> String
showsPrec :: Int -> DeleteGlobalReplicationGroup -> ShowS
$cshowsPrec :: Int -> DeleteGlobalReplicationGroup -> ShowS
Prelude.Show, forall x.
Rep DeleteGlobalReplicationGroup x -> DeleteGlobalReplicationGroup
forall x.
DeleteGlobalReplicationGroup -> Rep DeleteGlobalReplicationGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteGlobalReplicationGroup x -> DeleteGlobalReplicationGroup
$cfrom :: forall x.
DeleteGlobalReplicationGroup -> Rep DeleteGlobalReplicationGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteGlobalReplicationGroup' 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:
--
-- 'globalReplicationGroupId', 'deleteGlobalReplicationGroup_globalReplicationGroupId' - The name of the Global datastore
--
-- 'retainPrimaryReplicationGroup', 'deleteGlobalReplicationGroup_retainPrimaryReplicationGroup' - The primary replication group is retained as a standalone replication
-- group.
newDeleteGlobalReplicationGroup ::
  -- | 'globalReplicationGroupId'
  Prelude.Text ->
  -- | 'retainPrimaryReplicationGroup'
  Prelude.Bool ->
  DeleteGlobalReplicationGroup
newDeleteGlobalReplicationGroup :: Text -> Bool -> DeleteGlobalReplicationGroup
newDeleteGlobalReplicationGroup
  Text
pGlobalReplicationGroupId_
  Bool
pRetainPrimaryReplicationGroup_ =
    DeleteGlobalReplicationGroup'
      { $sel:globalReplicationGroupId:DeleteGlobalReplicationGroup' :: Text
globalReplicationGroupId =
          Text
pGlobalReplicationGroupId_,
        $sel:retainPrimaryReplicationGroup:DeleteGlobalReplicationGroup' :: Bool
retainPrimaryReplicationGroup =
          Bool
pRetainPrimaryReplicationGroup_
      }

-- | The name of the Global datastore
deleteGlobalReplicationGroup_globalReplicationGroupId :: Lens.Lens' DeleteGlobalReplicationGroup Prelude.Text
deleteGlobalReplicationGroup_globalReplicationGroupId :: Lens' DeleteGlobalReplicationGroup Text
deleteGlobalReplicationGroup_globalReplicationGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteGlobalReplicationGroup' {Text
globalReplicationGroupId :: Text
$sel:globalReplicationGroupId:DeleteGlobalReplicationGroup' :: DeleteGlobalReplicationGroup -> Text
globalReplicationGroupId} -> Text
globalReplicationGroupId) (\s :: DeleteGlobalReplicationGroup
s@DeleteGlobalReplicationGroup' {} Text
a -> DeleteGlobalReplicationGroup
s {$sel:globalReplicationGroupId:DeleteGlobalReplicationGroup' :: Text
globalReplicationGroupId = Text
a} :: DeleteGlobalReplicationGroup)

-- | The primary replication group is retained as a standalone replication
-- group.
deleteGlobalReplicationGroup_retainPrimaryReplicationGroup :: Lens.Lens' DeleteGlobalReplicationGroup Prelude.Bool
deleteGlobalReplicationGroup_retainPrimaryReplicationGroup :: Lens' DeleteGlobalReplicationGroup Bool
deleteGlobalReplicationGroup_retainPrimaryReplicationGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteGlobalReplicationGroup' {Bool
retainPrimaryReplicationGroup :: Bool
$sel:retainPrimaryReplicationGroup:DeleteGlobalReplicationGroup' :: DeleteGlobalReplicationGroup -> Bool
retainPrimaryReplicationGroup} -> Bool
retainPrimaryReplicationGroup) (\s :: DeleteGlobalReplicationGroup
s@DeleteGlobalReplicationGroup' {} Bool
a -> DeleteGlobalReplicationGroup
s {$sel:retainPrimaryReplicationGroup:DeleteGlobalReplicationGroup' :: Bool
retainPrimaryReplicationGroup = Bool
a} :: DeleteGlobalReplicationGroup)

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

instance Prelude.NFData DeleteGlobalReplicationGroup where
  rnf :: DeleteGlobalReplicationGroup -> ()
rnf DeleteGlobalReplicationGroup' {Bool
Text
retainPrimaryReplicationGroup :: Bool
globalReplicationGroupId :: Text
$sel:retainPrimaryReplicationGroup:DeleteGlobalReplicationGroup' :: DeleteGlobalReplicationGroup -> Bool
$sel:globalReplicationGroupId:DeleteGlobalReplicationGroup' :: DeleteGlobalReplicationGroup -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
globalReplicationGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
retainPrimaryReplicationGroup

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

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

instance Data.ToQuery DeleteGlobalReplicationGroup where
  toQuery :: DeleteGlobalReplicationGroup -> QueryString
toQuery DeleteGlobalReplicationGroup' {Bool
Text
retainPrimaryReplicationGroup :: Bool
globalReplicationGroupId :: Text
$sel:retainPrimaryReplicationGroup:DeleteGlobalReplicationGroup' :: DeleteGlobalReplicationGroup -> Bool
$sel:globalReplicationGroupId:DeleteGlobalReplicationGroup' :: DeleteGlobalReplicationGroup -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DeleteGlobalReplicationGroup" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"GlobalReplicationGroupId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
globalReplicationGroupId,
        ByteString
"RetainPrimaryReplicationGroup"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Bool
retainPrimaryReplicationGroup
      ]

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

-- |
-- Create a value of 'DeleteGlobalReplicationGroupResponse' 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:
--
-- 'globalReplicationGroup', 'deleteGlobalReplicationGroupResponse_globalReplicationGroup' - Undocumented member.
--
-- 'httpStatus', 'deleteGlobalReplicationGroupResponse_httpStatus' - The response's http status code.
newDeleteGlobalReplicationGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteGlobalReplicationGroupResponse
newDeleteGlobalReplicationGroupResponse :: Int -> DeleteGlobalReplicationGroupResponse
newDeleteGlobalReplicationGroupResponse Int
pHttpStatus_ =
  DeleteGlobalReplicationGroupResponse'
    { $sel:globalReplicationGroup:DeleteGlobalReplicationGroupResponse' :: Maybe GlobalReplicationGroup
globalReplicationGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteGlobalReplicationGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
deleteGlobalReplicationGroupResponse_globalReplicationGroup :: Lens.Lens' DeleteGlobalReplicationGroupResponse (Prelude.Maybe GlobalReplicationGroup)
deleteGlobalReplicationGroupResponse_globalReplicationGroup :: Lens'
  DeleteGlobalReplicationGroupResponse (Maybe GlobalReplicationGroup)
deleteGlobalReplicationGroupResponse_globalReplicationGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteGlobalReplicationGroupResponse' {Maybe GlobalReplicationGroup
globalReplicationGroup :: Maybe GlobalReplicationGroup
$sel:globalReplicationGroup:DeleteGlobalReplicationGroupResponse' :: DeleteGlobalReplicationGroupResponse
-> Maybe GlobalReplicationGroup
globalReplicationGroup} -> Maybe GlobalReplicationGroup
globalReplicationGroup) (\s :: DeleteGlobalReplicationGroupResponse
s@DeleteGlobalReplicationGroupResponse' {} Maybe GlobalReplicationGroup
a -> DeleteGlobalReplicationGroupResponse
s {$sel:globalReplicationGroup:DeleteGlobalReplicationGroupResponse' :: Maybe GlobalReplicationGroup
globalReplicationGroup = Maybe GlobalReplicationGroup
a} :: DeleteGlobalReplicationGroupResponse)

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

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