{-# 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.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 a Neptune global database spread across multiple Amazon Regions.
-- The global database contains a single primary cluster with read-write
-- capability, and read-only secondary clusters that receive data from the
-- primary cluster through high-speed replication performed by the Neptune
-- storage subsystem.
--
-- You can create a global database that is initially empty, and then add a
-- primary cluster and secondary clusters to it, or you can specify an
-- existing Neptune cluster during the create operation to become the
-- primary cluster of the global database.
module Amazonka.Neptune.CreateGlobalCluster
  ( -- * Creating a Request
    CreateGlobalCluster (..),
    newCreateGlobalCluster,

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

    -- * 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 Amazonka.Neptune.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateGlobalCluster' smart constructor.
data CreateGlobalCluster = CreateGlobalCluster'
  { -- | 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 in the global database.
    --
    -- Valid values: @neptune@
    CreateGlobalCluster -> Maybe Text
engine :: Prelude.Maybe Prelude.Text,
    -- | The Neptune engine version to be used by the global database.
    --
    -- Valid values: @1.2.0.0@ or above.
    CreateGlobalCluster -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | (/Optional/) The Amazon Resource Name (ARN) of an existing Neptune DB
    -- cluster to use as the primary cluster of the new global database.
    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,
    -- | The cluster identifier of the new global database cluster.
    CreateGlobalCluster -> Text
globalClusterIdentifier :: Prelude.Text
  }
  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:
--
-- '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 in the global database.
--
-- Valid values: @neptune@
--
-- 'engineVersion', 'createGlobalCluster_engineVersion' - The Neptune engine version to be used by the global database.
--
-- Valid values: @1.2.0.0@ or above.
--
-- 'sourceDBClusterIdentifier', 'createGlobalCluster_sourceDBClusterIdentifier' - (/Optional/) The Amazon Resource Name (ARN) of an existing Neptune DB
-- cluster to use as the primary cluster of the new global database.
--
-- 'storageEncrypted', 'createGlobalCluster_storageEncrypted' - The storage encryption setting for the new global database cluster.
--
-- 'globalClusterIdentifier', 'createGlobalCluster_globalClusterIdentifier' - The cluster identifier of the new global database cluster.
newCreateGlobalCluster ::
  -- | 'globalClusterIdentifier'
  Prelude.Text ->
  CreateGlobalCluster
newCreateGlobalCluster :: Text -> CreateGlobalCluster
newCreateGlobalCluster Text
pGlobalClusterIdentifier_ =
  CreateGlobalCluster'
    { $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:sourceDBClusterIdentifier:CreateGlobalCluster' :: Maybe Text
sourceDBClusterIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:storageEncrypted:CreateGlobalCluster' :: Maybe Bool
storageEncrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:globalClusterIdentifier:CreateGlobalCluster' :: Text
globalClusterIdentifier = Text
pGlobalClusterIdentifier_
    }

-- | 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 in the global database.
--
-- Valid values: @neptune@
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 Neptune engine version to be used by the global database.
--
-- Valid values: @1.2.0.0@ or above.
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)

-- | (/Optional/) The Amazon Resource Name (ARN) of an existing Neptune DB
-- cluster to use as the primary cluster of the new global database.
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)

-- | The cluster identifier of the new global database cluster.
createGlobalCluster_globalClusterIdentifier :: Lens.Lens' CreateGlobalCluster Prelude.Text
createGlobalCluster_globalClusterIdentifier :: Lens' CreateGlobalCluster Text
createGlobalCluster_globalClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalCluster' {Text
globalClusterIdentifier :: Text
$sel:globalClusterIdentifier:CreateGlobalCluster' :: CreateGlobalCluster -> Text
globalClusterIdentifier} -> Text
globalClusterIdentifier) (\s :: CreateGlobalCluster
s@CreateGlobalCluster' {} Text
a -> CreateGlobalCluster
s {$sel:globalClusterIdentifier:CreateGlobalCluster' :: Text
globalClusterIdentifier = Text
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
Text
globalClusterIdentifier :: Text
storageEncrypted :: Maybe Bool
sourceDBClusterIdentifier :: Maybe Text
engineVersion :: Maybe Text
engine :: Maybe Text
deletionProtection :: Maybe Bool
$sel:globalClusterIdentifier:CreateGlobalCluster' :: CreateGlobalCluster -> Text
$sel:storageEncrypted:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Bool
$sel:sourceDBClusterIdentifier:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:engineVersion:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:engine:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:deletionProtection:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Bool
..} =
    Int
_salt
      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
sourceDBClusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
storageEncrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
globalClusterIdentifier

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

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
Text
globalClusterIdentifier :: Text
storageEncrypted :: Maybe Bool
sourceDBClusterIdentifier :: Maybe Text
engineVersion :: Maybe Text
engine :: Maybe Text
deletionProtection :: Maybe Bool
$sel:globalClusterIdentifier:CreateGlobalCluster' :: CreateGlobalCluster -> Text
$sel:storageEncrypted:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Bool
$sel:sourceDBClusterIdentifier:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:engineVersion:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:engine:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Text
$sel:deletionProtection:CreateGlobalCluster' :: CreateGlobalCluster -> Maybe Bool
..} =
    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
"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
"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,
        ByteString
"GlobalClusterIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
globalClusterIdentifier
      ]

-- | /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