{-# 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.CreateGlobalReplicationGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Global Datastore for Redis offers fully managed, fast, reliable and
-- secure cross-region replication. Using Global Datastore for Redis, you
-- can create cross-region read replica clusters for ElastiCache for Redis
-- to enable low-latency reads and disaster recovery across regions. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonElastiCache/latest/red-ug/Redis-Global-Datastore.html Replication Across Regions Using Global Datastore>.
--
-- -   The __GlobalReplicationGroupIdSuffix__ is the name of the Global
--     datastore.
--
-- -   The __PrimaryReplicationGroupId__ represents the name of the primary
--     cluster that accepts writes and will replicate updates to the
--     secondary cluster.
module Amazonka.ElastiCache.CreateGlobalReplicationGroup
  ( -- * Creating a Request
    CreateGlobalReplicationGroup (..),
    newCreateGlobalReplicationGroup,

    -- * Request Lenses
    createGlobalReplicationGroup_globalReplicationGroupDescription,
    createGlobalReplicationGroup_globalReplicationGroupIdSuffix,
    createGlobalReplicationGroup_primaryReplicationGroupId,

    -- * Destructuring the Response
    CreateGlobalReplicationGroupResponse (..),
    newCreateGlobalReplicationGroupResponse,

    -- * Response Lenses
    createGlobalReplicationGroupResponse_globalReplicationGroup,
    createGlobalReplicationGroupResponse_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:/ 'newCreateGlobalReplicationGroup' smart constructor.
data CreateGlobalReplicationGroup = CreateGlobalReplicationGroup'
  { -- | Provides details of the Global datastore
    CreateGlobalReplicationGroup -> Maybe Text
globalReplicationGroupDescription :: Prelude.Maybe Prelude.Text,
    -- | The suffix name of a Global datastore. Amazon ElastiCache automatically
    -- applies a prefix to the Global datastore ID when it is created. Each
    -- Amazon Region has its own prefix. For instance, a Global datastore ID
    -- created in the US-West-1 region will begin with \"dsdfu\" along with the
    -- suffix name you provide. The suffix, combined with the auto-generated
    -- prefix, guarantees uniqueness of the Global datastore name across
    -- multiple regions.
    --
    -- For a full list of Amazon Regions and their respective Global datastore
    -- iD prefixes, see
    -- <http://docs.aws.amazon.com/AmazonElastiCache/latest/red-ug/Redis-Global-Datastores-CLI.html Using the Amazon CLI with Global datastores>
    -- .
    CreateGlobalReplicationGroup -> Text
globalReplicationGroupIdSuffix :: Prelude.Text,
    -- | The name of the primary cluster that accepts writes and will replicate
    -- updates to the secondary cluster.
    CreateGlobalReplicationGroup -> Text
primaryReplicationGroupId :: Prelude.Text
  }
  deriving (CreateGlobalReplicationGroup
-> CreateGlobalReplicationGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGlobalReplicationGroup
-> CreateGlobalReplicationGroup -> Bool
$c/= :: CreateGlobalReplicationGroup
-> CreateGlobalReplicationGroup -> Bool
== :: CreateGlobalReplicationGroup
-> CreateGlobalReplicationGroup -> Bool
$c== :: CreateGlobalReplicationGroup
-> CreateGlobalReplicationGroup -> Bool
Prelude.Eq, ReadPrec [CreateGlobalReplicationGroup]
ReadPrec CreateGlobalReplicationGroup
Int -> ReadS CreateGlobalReplicationGroup
ReadS [CreateGlobalReplicationGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGlobalReplicationGroup]
$creadListPrec :: ReadPrec [CreateGlobalReplicationGroup]
readPrec :: ReadPrec CreateGlobalReplicationGroup
$creadPrec :: ReadPrec CreateGlobalReplicationGroup
readList :: ReadS [CreateGlobalReplicationGroup]
$creadList :: ReadS [CreateGlobalReplicationGroup]
readsPrec :: Int -> ReadS CreateGlobalReplicationGroup
$creadsPrec :: Int -> ReadS CreateGlobalReplicationGroup
Prelude.Read, Int -> CreateGlobalReplicationGroup -> ShowS
[CreateGlobalReplicationGroup] -> ShowS
CreateGlobalReplicationGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGlobalReplicationGroup] -> ShowS
$cshowList :: [CreateGlobalReplicationGroup] -> ShowS
show :: CreateGlobalReplicationGroup -> String
$cshow :: CreateGlobalReplicationGroup -> String
showsPrec :: Int -> CreateGlobalReplicationGroup -> ShowS
$cshowsPrec :: Int -> CreateGlobalReplicationGroup -> ShowS
Prelude.Show, forall x.
Rep CreateGlobalReplicationGroup x -> CreateGlobalReplicationGroup
forall x.
CreateGlobalReplicationGroup -> Rep CreateGlobalReplicationGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateGlobalReplicationGroup x -> CreateGlobalReplicationGroup
$cfrom :: forall x.
CreateGlobalReplicationGroup -> Rep CreateGlobalReplicationGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateGlobalReplicationGroup' 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:
--
-- 'globalReplicationGroupDescription', 'createGlobalReplicationGroup_globalReplicationGroupDescription' - Provides details of the Global datastore
--
-- 'globalReplicationGroupIdSuffix', 'createGlobalReplicationGroup_globalReplicationGroupIdSuffix' - The suffix name of a Global datastore. Amazon ElastiCache automatically
-- applies a prefix to the Global datastore ID when it is created. Each
-- Amazon Region has its own prefix. For instance, a Global datastore ID
-- created in the US-West-1 region will begin with \"dsdfu\" along with the
-- suffix name you provide. The suffix, combined with the auto-generated
-- prefix, guarantees uniqueness of the Global datastore name across
-- multiple regions.
--
-- For a full list of Amazon Regions and their respective Global datastore
-- iD prefixes, see
-- <http://docs.aws.amazon.com/AmazonElastiCache/latest/red-ug/Redis-Global-Datastores-CLI.html Using the Amazon CLI with Global datastores>
-- .
--
-- 'primaryReplicationGroupId', 'createGlobalReplicationGroup_primaryReplicationGroupId' - The name of the primary cluster that accepts writes and will replicate
-- updates to the secondary cluster.
newCreateGlobalReplicationGroup ::
  -- | 'globalReplicationGroupIdSuffix'
  Prelude.Text ->
  -- | 'primaryReplicationGroupId'
  Prelude.Text ->
  CreateGlobalReplicationGroup
newCreateGlobalReplicationGroup :: Text -> Text -> CreateGlobalReplicationGroup
newCreateGlobalReplicationGroup
  Text
pGlobalReplicationGroupIdSuffix_
  Text
pPrimaryReplicationGroupId_ =
    CreateGlobalReplicationGroup'
      { $sel:globalReplicationGroupDescription:CreateGlobalReplicationGroup' :: Maybe Text
globalReplicationGroupDescription =
          forall a. Maybe a
Prelude.Nothing,
        $sel:globalReplicationGroupIdSuffix:CreateGlobalReplicationGroup' :: Text
globalReplicationGroupIdSuffix =
          Text
pGlobalReplicationGroupIdSuffix_,
        $sel:primaryReplicationGroupId:CreateGlobalReplicationGroup' :: Text
primaryReplicationGroupId =
          Text
pPrimaryReplicationGroupId_
      }

-- | Provides details of the Global datastore
createGlobalReplicationGroup_globalReplicationGroupDescription :: Lens.Lens' CreateGlobalReplicationGroup (Prelude.Maybe Prelude.Text)
createGlobalReplicationGroup_globalReplicationGroupDescription :: Lens' CreateGlobalReplicationGroup (Maybe Text)
createGlobalReplicationGroup_globalReplicationGroupDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalReplicationGroup' {Maybe Text
globalReplicationGroupDescription :: Maybe Text
$sel:globalReplicationGroupDescription:CreateGlobalReplicationGroup' :: CreateGlobalReplicationGroup -> Maybe Text
globalReplicationGroupDescription} -> Maybe Text
globalReplicationGroupDescription) (\s :: CreateGlobalReplicationGroup
s@CreateGlobalReplicationGroup' {} Maybe Text
a -> CreateGlobalReplicationGroup
s {$sel:globalReplicationGroupDescription:CreateGlobalReplicationGroup' :: Maybe Text
globalReplicationGroupDescription = Maybe Text
a} :: CreateGlobalReplicationGroup)

-- | The suffix name of a Global datastore. Amazon ElastiCache automatically
-- applies a prefix to the Global datastore ID when it is created. Each
-- Amazon Region has its own prefix. For instance, a Global datastore ID
-- created in the US-West-1 region will begin with \"dsdfu\" along with the
-- suffix name you provide. The suffix, combined with the auto-generated
-- prefix, guarantees uniqueness of the Global datastore name across
-- multiple regions.
--
-- For a full list of Amazon Regions and their respective Global datastore
-- iD prefixes, see
-- <http://docs.aws.amazon.com/AmazonElastiCache/latest/red-ug/Redis-Global-Datastores-CLI.html Using the Amazon CLI with Global datastores>
-- .
createGlobalReplicationGroup_globalReplicationGroupIdSuffix :: Lens.Lens' CreateGlobalReplicationGroup Prelude.Text
createGlobalReplicationGroup_globalReplicationGroupIdSuffix :: Lens' CreateGlobalReplicationGroup Text
createGlobalReplicationGroup_globalReplicationGroupIdSuffix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalReplicationGroup' {Text
globalReplicationGroupIdSuffix :: Text
$sel:globalReplicationGroupIdSuffix:CreateGlobalReplicationGroup' :: CreateGlobalReplicationGroup -> Text
globalReplicationGroupIdSuffix} -> Text
globalReplicationGroupIdSuffix) (\s :: CreateGlobalReplicationGroup
s@CreateGlobalReplicationGroup' {} Text
a -> CreateGlobalReplicationGroup
s {$sel:globalReplicationGroupIdSuffix:CreateGlobalReplicationGroup' :: Text
globalReplicationGroupIdSuffix = Text
a} :: CreateGlobalReplicationGroup)

-- | The name of the primary cluster that accepts writes and will replicate
-- updates to the secondary cluster.
createGlobalReplicationGroup_primaryReplicationGroupId :: Lens.Lens' CreateGlobalReplicationGroup Prelude.Text
createGlobalReplicationGroup_primaryReplicationGroupId :: Lens' CreateGlobalReplicationGroup Text
createGlobalReplicationGroup_primaryReplicationGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalReplicationGroup' {Text
primaryReplicationGroupId :: Text
$sel:primaryReplicationGroupId:CreateGlobalReplicationGroup' :: CreateGlobalReplicationGroup -> Text
primaryReplicationGroupId} -> Text
primaryReplicationGroupId) (\s :: CreateGlobalReplicationGroup
s@CreateGlobalReplicationGroup' {} Text
a -> CreateGlobalReplicationGroup
s {$sel:primaryReplicationGroupId:CreateGlobalReplicationGroup' :: Text
primaryReplicationGroupId = Text
a} :: CreateGlobalReplicationGroup)

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

instance Prelude.NFData CreateGlobalReplicationGroup where
  rnf :: CreateGlobalReplicationGroup -> ()
rnf CreateGlobalReplicationGroup' {Maybe Text
Text
primaryReplicationGroupId :: Text
globalReplicationGroupIdSuffix :: Text
globalReplicationGroupDescription :: Maybe Text
$sel:primaryReplicationGroupId:CreateGlobalReplicationGroup' :: CreateGlobalReplicationGroup -> Text
$sel:globalReplicationGroupIdSuffix:CreateGlobalReplicationGroup' :: CreateGlobalReplicationGroup -> Text
$sel:globalReplicationGroupDescription:CreateGlobalReplicationGroup' :: CreateGlobalReplicationGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
globalReplicationGroupDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
globalReplicationGroupIdSuffix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
primaryReplicationGroupId

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

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

instance Data.ToQuery CreateGlobalReplicationGroup where
  toQuery :: CreateGlobalReplicationGroup -> QueryString
toQuery CreateGlobalReplicationGroup' {Maybe Text
Text
primaryReplicationGroupId :: Text
globalReplicationGroupIdSuffix :: Text
globalReplicationGroupDescription :: Maybe Text
$sel:primaryReplicationGroupId:CreateGlobalReplicationGroup' :: CreateGlobalReplicationGroup -> Text
$sel:globalReplicationGroupIdSuffix:CreateGlobalReplicationGroup' :: CreateGlobalReplicationGroup -> Text
$sel:globalReplicationGroupDescription:CreateGlobalReplicationGroup' :: CreateGlobalReplicationGroup -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CreateGlobalReplicationGroup" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"GlobalReplicationGroupDescription"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
globalReplicationGroupDescription,
        ByteString
"GlobalReplicationGroupIdSuffix"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
globalReplicationGroupIdSuffix,
        ByteString
"PrimaryReplicationGroupId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
primaryReplicationGroupId
      ]

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

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

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

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

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