{-# 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.CreateGlobalCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an Aurora global database spread across multiple Amazon Web
-- Services Regions. The global database contains a single primary cluster
-- with read-write capability, and a read-only secondary cluster that
-- receives data from the primary cluster through high-speed replication
-- performed by the Aurora storage subsystem.
--
-- You can create a global database that is initially empty, and then add a
-- primary cluster and a secondary cluster to it. Or you can specify an
-- existing Aurora cluster during the create operation, and this cluster
-- becomes the primary cluster of the global database.
--
-- This action applies only to Aurora DB clusters.
module Amazonka.RDS.CreateGlobalCluster
  ( -- * Creating a Request
    CreateGlobalCluster (..),
    newCreateGlobalCluster,

    -- * Request Lenses
    createGlobalCluster_databaseName,
    createGlobalCluster_deletionProtection,
    createGlobalCluster_engine,
    createGlobalCluster_engineVersion,
    createGlobalCluster_globalClusterIdentifier,
    createGlobalCluster_sourceDBClusterIdentifier,
    createGlobalCluster_storageEncrypted,

    -- * Destructuring the Response
    CreateGlobalClusterResponse (..),
    newCreateGlobalClusterResponse,

    -- * Response Lenses
    createGlobalClusterResponse_globalCluster,
    createGlobalClusterResponse_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:/ 'newCreateGlobalCluster' smart constructor.
data CreateGlobalCluster = CreateGlobalCluster'
  { -- | The name for your database of up to 64 alphanumeric characters. If you
    -- do not provide a name, Amazon Aurora will not create a database in the
    -- global database cluster you are creating.
    CreateGlobalCluster -> Maybe Text
databaseName :: Prelude.Maybe Prelude.Text,
    -- | The deletion protection setting for the new global database. The global
    -- database can\'t be deleted when deletion protection is enabled.
    CreateGlobalCluster -> Maybe Bool
deletionProtection :: Prelude.Maybe Prelude.Bool,
    -- | The name of the database engine to be used for this DB cluster.
    CreateGlobalCluster -> Maybe Text
engine :: Prelude.Maybe Prelude.Text,
    -- | The engine version of the Aurora global database.
    CreateGlobalCluster -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | The cluster identifier of the new global database cluster.
    CreateGlobalCluster -> Maybe Text
globalClusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) to use as the primary cluster of the
    -- global database. This parameter is optional.
    CreateGlobalCluster -> Maybe Text
sourceDBClusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The storage encryption setting for the new global database cluster.
    CreateGlobalCluster -> Maybe Bool
storageEncrypted :: Prelude.Maybe Prelude.Bool
  }
  deriving (CreateGlobalCluster -> CreateGlobalCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGlobalCluster -> CreateGlobalCluster -> Bool
$c/= :: CreateGlobalCluster -> CreateGlobalCluster -> Bool
== :: CreateGlobalCluster -> CreateGlobalCluster -> Bool
$c== :: CreateGlobalCluster -> CreateGlobalCluster -> Bool
Prelude.Eq, ReadPrec [CreateGlobalCluster]
ReadPrec CreateGlobalCluster
Int -> ReadS CreateGlobalCluster
ReadS [CreateGlobalCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGlobalCluster]
$creadListPrec :: ReadPrec [CreateGlobalCluster]
readPrec :: ReadPrec CreateGlobalCluster
$creadPrec :: ReadPrec CreateGlobalCluster
readList :: ReadS [CreateGlobalCluster]
$creadList :: ReadS [CreateGlobalCluster]
readsPrec :: Int -> ReadS CreateGlobalCluster
$creadsPrec :: Int -> ReadS CreateGlobalCluster
Prelude.Read, Int -> CreateGlobalCluster -> ShowS
[CreateGlobalCluster] -> ShowS
CreateGlobalCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGlobalCluster] -> ShowS
$cshowList :: [CreateGlobalCluster] -> ShowS
show :: CreateGlobalCluster -> String
$cshow :: CreateGlobalCluster -> String
showsPrec :: Int -> CreateGlobalCluster -> ShowS
$cshowsPrec :: Int -> CreateGlobalCluster -> ShowS
Prelude.Show, forall x. Rep CreateGlobalCluster x -> CreateGlobalCluster
forall x. CreateGlobalCluster -> Rep CreateGlobalCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateGlobalCluster x -> CreateGlobalCluster
$cfrom :: forall x. CreateGlobalCluster -> Rep CreateGlobalCluster x
Prelude.Generic)

-- |
-- Create a value of 'CreateGlobalCluster' 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:
--
-- 'databaseName', 'createGlobalCluster_databaseName' - The name for your database of up to 64 alphanumeric characters. If you
-- do not provide a name, Amazon Aurora will not create a database in the
-- global database cluster you are creating.
--
-- 'deletionProtection', 'createGlobalCluster_deletionProtection' - The deletion protection setting for the new global database. The global
-- database can\'t be deleted when deletion protection is enabled.
--
-- 'engine', 'createGlobalCluster_engine' - The name of the database engine to be used for this DB cluster.
--
-- 'engineVersion', 'createGlobalCluster_engineVersion' - The engine version of the Aurora global database.
--
-- 'globalClusterIdentifier', 'createGlobalCluster_globalClusterIdentifier' - The cluster identifier of the new global database cluster.
--
-- 'sourceDBClusterIdentifier', 'createGlobalCluster_sourceDBClusterIdentifier' - The Amazon Resource Name (ARN) to use as the primary cluster of the
-- global database. This parameter is optional.
--
-- 'storageEncrypted', 'createGlobalCluster_storageEncrypted' - The storage encryption setting for the new global database cluster.
newCreateGlobalCluster ::
  CreateGlobalCluster
newCreateGlobalCluster :: CreateGlobalCluster
newCreateGlobalCluster =
  CreateGlobalCluster'
    { $sel:databaseName:CreateGlobalCluster' :: Maybe Text
databaseName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:deletionProtection:CreateGlobalCluster' :: Maybe Bool
deletionProtection = forall a. Maybe a
Prelude.Nothing,
      $sel:engine:CreateGlobalCluster' :: Maybe Text
engine = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:CreateGlobalCluster' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:globalClusterIdentifier:CreateGlobalCluster' :: Maybe Text
globalClusterIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceDBClusterIdentifier:CreateGlobalCluster' :: Maybe Text
sourceDBClusterIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:storageEncrypted:CreateGlobalCluster' :: Maybe Bool
storageEncrypted = forall a. Maybe a
Prelude.Nothing
    }

-- | The name for your database of up to 64 alphanumeric characters. If you
-- do not provide a name, Amazon Aurora will not create a database in the
-- global database cluster you are creating.
createGlobalCluster_databaseName :: Lens.Lens' CreateGlobalCluster (Prelude.Maybe Prelude.Text)
createGlobalCluster_databaseName :: Lens' CreateGlobalCluster (Maybe Text)
createGlobalCluster_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalCluster' {Maybe Text
databaseName :: Maybe Text
$sel:databaseName:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
databaseName} -> Maybe Text
databaseName) (\s :: CreateGlobalCluster
s@CreateGlobalCluster' {} Maybe Text
a -> CreateGlobalCluster
s {$sel:databaseName:CreateGlobalCluster' :: Maybe Text
databaseName = Maybe Text
a} :: CreateGlobalCluster)

-- | The deletion protection setting for the new global database. The global
-- database can\'t be deleted when deletion protection is enabled.
createGlobalCluster_deletionProtection :: Lens.Lens' CreateGlobalCluster (Prelude.Maybe Prelude.Bool)
createGlobalCluster_deletionProtection :: Lens' CreateGlobalCluster (Maybe Bool)
createGlobalCluster_deletionProtection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalCluster' {Maybe Bool
deletionProtection :: Maybe Bool
$sel:deletionProtection:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Bool
deletionProtection} -> Maybe Bool
deletionProtection) (\s :: CreateGlobalCluster
s@CreateGlobalCluster' {} Maybe Bool
a -> CreateGlobalCluster
s {$sel:deletionProtection:CreateGlobalCluster' :: Maybe Bool
deletionProtection = Maybe Bool
a} :: CreateGlobalCluster)

-- | The name of the database engine to be used for this DB cluster.
createGlobalCluster_engine :: Lens.Lens' CreateGlobalCluster (Prelude.Maybe Prelude.Text)
createGlobalCluster_engine :: Lens' CreateGlobalCluster (Maybe Text)
createGlobalCluster_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalCluster' {Maybe Text
engine :: Maybe Text
$sel:engine:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
engine} -> Maybe Text
engine) (\s :: CreateGlobalCluster
s@CreateGlobalCluster' {} Maybe Text
a -> CreateGlobalCluster
s {$sel:engine:CreateGlobalCluster' :: Maybe Text
engine = Maybe Text
a} :: CreateGlobalCluster)

-- | The engine version of the Aurora global database.
createGlobalCluster_engineVersion :: Lens.Lens' CreateGlobalCluster (Prelude.Maybe Prelude.Text)
createGlobalCluster_engineVersion :: Lens' CreateGlobalCluster (Maybe Text)
createGlobalCluster_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalCluster' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: CreateGlobalCluster
s@CreateGlobalCluster' {} Maybe Text
a -> CreateGlobalCluster
s {$sel:engineVersion:CreateGlobalCluster' :: Maybe Text
engineVersion = Maybe Text
a} :: CreateGlobalCluster)

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

-- | The Amazon Resource Name (ARN) to use as the primary cluster of the
-- global database. This parameter is optional.
createGlobalCluster_sourceDBClusterIdentifier :: Lens.Lens' CreateGlobalCluster (Prelude.Maybe Prelude.Text)
createGlobalCluster_sourceDBClusterIdentifier :: Lens' CreateGlobalCluster (Maybe Text)
createGlobalCluster_sourceDBClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalCluster' {Maybe Text
sourceDBClusterIdentifier :: Maybe Text
$sel:sourceDBClusterIdentifier:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
sourceDBClusterIdentifier} -> Maybe Text
sourceDBClusterIdentifier) (\s :: CreateGlobalCluster
s@CreateGlobalCluster' {} Maybe Text
a -> CreateGlobalCluster
s {$sel:sourceDBClusterIdentifier:CreateGlobalCluster' :: Maybe Text
sourceDBClusterIdentifier = Maybe Text
a} :: CreateGlobalCluster)

-- | The storage encryption setting for the new global database cluster.
createGlobalCluster_storageEncrypted :: Lens.Lens' CreateGlobalCluster (Prelude.Maybe Prelude.Bool)
createGlobalCluster_storageEncrypted :: Lens' CreateGlobalCluster (Maybe Bool)
createGlobalCluster_storageEncrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalCluster' {Maybe Bool
storageEncrypted :: Maybe Bool
$sel:storageEncrypted:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Bool
storageEncrypted} -> Maybe Bool
storageEncrypted) (\s :: CreateGlobalCluster
s@CreateGlobalCluster' {} Maybe Bool
a -> CreateGlobalCluster
s {$sel:storageEncrypted:CreateGlobalCluster' :: Maybe Bool
storageEncrypted = Maybe Bool
a} :: CreateGlobalCluster)

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

instance Prelude.NFData CreateGlobalCluster where
  rnf :: CreateGlobalCluster -> ()
rnf CreateGlobalCluster' {Maybe Bool
Maybe Text
storageEncrypted :: Maybe Bool
sourceDBClusterIdentifier :: Maybe Text
globalClusterIdentifier :: Maybe Text
engineVersion :: Maybe Text
engine :: Maybe Text
deletionProtection :: Maybe Bool
databaseName :: Maybe Text
$sel:storageEncrypted:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Bool
$sel:sourceDBClusterIdentifier:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:globalClusterIdentifier:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:engineVersion:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:engine:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:deletionProtection:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Bool
$sel:databaseName:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
databaseName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deletionProtection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engine
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
globalClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceDBClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
storageEncrypted

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

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

instance Data.ToQuery CreateGlobalCluster where
  toQuery :: CreateGlobalCluster -> QueryString
toQuery CreateGlobalCluster' {Maybe Bool
Maybe Text
storageEncrypted :: Maybe Bool
sourceDBClusterIdentifier :: Maybe Text
globalClusterIdentifier :: Maybe Text
engineVersion :: Maybe Text
engine :: Maybe Text
deletionProtection :: Maybe Bool
databaseName :: Maybe Text
$sel:storageEncrypted:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Bool
$sel:sourceDBClusterIdentifier:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:globalClusterIdentifier:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:engineVersion:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:engine:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:deletionProtection:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Bool
$sel:databaseName:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateGlobalCluster" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"DatabaseName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
databaseName,
        ByteString
"DeletionProtection" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
deletionProtection,
        ByteString
"Engine" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
engine,
        ByteString
"EngineVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
engineVersion,
        ByteString
"GlobalClusterIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
globalClusterIdentifier,
        ByteString
"SourceDBClusterIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
sourceDBClusterIdentifier,
        ByteString
"StorageEncrypted" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
storageEncrypted
      ]

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

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

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

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

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