{-# 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.CreateBlueGreenDeployment
-- 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 blue\/green deployment.
--
-- A blue\/green deployment creates a staging environment that copies the
-- production environment. In a blue\/green deployment, the blue
-- environment is the current production environment. The green environment
-- is the staging environment. The staging environment stays in sync with
-- the current production environment using logical replication.
--
-- You can make changes to the databases in the green environment without
-- affecting production workloads. For example, you can upgrade the major
-- or minor DB engine version, change database parameters, or make schema
-- changes in the staging environment. You can thoroughly test changes in
-- the green environment. When ready, you can switch over the environments
-- to promote the green environment to be the new production environment.
-- The switchover typically takes under a minute.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/blue-green-deployments.html Using Amazon RDS Blue\/Green Deployments for database updates>
-- in the /Amazon RDS User Guide/ and
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/blue-green-deployments.html Using Amazon RDS Blue\/Green Deployments for database updates>
-- in the /Amazon Aurora User Guide/.
module Amazonka.RDS.CreateBlueGreenDeployment
  ( -- * Creating a Request
    CreateBlueGreenDeployment (..),
    newCreateBlueGreenDeployment,

    -- * Request Lenses
    createBlueGreenDeployment_tags,
    createBlueGreenDeployment_targetDBClusterParameterGroupName,
    createBlueGreenDeployment_targetDBParameterGroupName,
    createBlueGreenDeployment_targetEngineVersion,
    createBlueGreenDeployment_blueGreenDeploymentName,
    createBlueGreenDeployment_source,

    -- * Destructuring the Response
    CreateBlueGreenDeploymentResponse (..),
    newCreateBlueGreenDeploymentResponse,

    -- * Response Lenses
    createBlueGreenDeploymentResponse_blueGreenDeployment,
    createBlueGreenDeploymentResponse_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:/ 'newCreateBlueGreenDeployment' smart constructor.
data CreateBlueGreenDeployment = CreateBlueGreenDeployment'
  { -- | Tags to assign to the blue\/green deployment.
    CreateBlueGreenDeployment -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The DB cluster parameter group associated with the Aurora DB cluster in
    -- the green environment.
    --
    -- To test parameter changes, specify a DB cluster parameter group that is
    -- different from the one associated with the source DB cluster.
    CreateBlueGreenDeployment -> Maybe Text
targetDBClusterParameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | The DB parameter group associated with the DB instance in the green
    -- environment.
    --
    -- To test parameter changes, specify a DB parameter group that is
    -- different from the one associated with the source DB instance.
    CreateBlueGreenDeployment -> Maybe Text
targetDBParameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | The engine version of the database in the green environment.
    --
    -- Specify the engine version to upgrade to in the green environment.
    CreateBlueGreenDeployment -> Maybe Text
targetEngineVersion :: Prelude.Maybe Prelude.Text,
    -- | The name of the blue\/green deployment.
    --
    -- Constraints:
    --
    -- -   Can\'t be the same as an existing blue\/green deployment name in the
    --     same account and Amazon Web Services Region.
    CreateBlueGreenDeployment -> Text
blueGreenDeploymentName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the source production database.
    --
    -- Specify the database that you want to clone. The blue\/green deployment
    -- creates this database in the green environment. You can make updates to
    -- the database in the green environment, such as an engine version
    -- upgrade. When you are ready, you can switch the database in the green
    -- environment to be the production database.
    CreateBlueGreenDeployment -> Text
source :: Prelude.Text
  }
  deriving (CreateBlueGreenDeployment -> CreateBlueGreenDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBlueGreenDeployment -> CreateBlueGreenDeployment -> Bool
$c/= :: CreateBlueGreenDeployment -> CreateBlueGreenDeployment -> Bool
== :: CreateBlueGreenDeployment -> CreateBlueGreenDeployment -> Bool
$c== :: CreateBlueGreenDeployment -> CreateBlueGreenDeployment -> Bool
Prelude.Eq, ReadPrec [CreateBlueGreenDeployment]
ReadPrec CreateBlueGreenDeployment
Int -> ReadS CreateBlueGreenDeployment
ReadS [CreateBlueGreenDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBlueGreenDeployment]
$creadListPrec :: ReadPrec [CreateBlueGreenDeployment]
readPrec :: ReadPrec CreateBlueGreenDeployment
$creadPrec :: ReadPrec CreateBlueGreenDeployment
readList :: ReadS [CreateBlueGreenDeployment]
$creadList :: ReadS [CreateBlueGreenDeployment]
readsPrec :: Int -> ReadS CreateBlueGreenDeployment
$creadsPrec :: Int -> ReadS CreateBlueGreenDeployment
Prelude.Read, Int -> CreateBlueGreenDeployment -> ShowS
[CreateBlueGreenDeployment] -> ShowS
CreateBlueGreenDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBlueGreenDeployment] -> ShowS
$cshowList :: [CreateBlueGreenDeployment] -> ShowS
show :: CreateBlueGreenDeployment -> String
$cshow :: CreateBlueGreenDeployment -> String
showsPrec :: Int -> CreateBlueGreenDeployment -> ShowS
$cshowsPrec :: Int -> CreateBlueGreenDeployment -> ShowS
Prelude.Show, forall x.
Rep CreateBlueGreenDeployment x -> CreateBlueGreenDeployment
forall x.
CreateBlueGreenDeployment -> Rep CreateBlueGreenDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateBlueGreenDeployment x -> CreateBlueGreenDeployment
$cfrom :: forall x.
CreateBlueGreenDeployment -> Rep CreateBlueGreenDeployment x
Prelude.Generic)

-- |
-- Create a value of 'CreateBlueGreenDeployment' 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:
--
-- 'tags', 'createBlueGreenDeployment_tags' - Tags to assign to the blue\/green deployment.
--
-- 'targetDBClusterParameterGroupName', 'createBlueGreenDeployment_targetDBClusterParameterGroupName' - The DB cluster parameter group associated with the Aurora DB cluster in
-- the green environment.
--
-- To test parameter changes, specify a DB cluster parameter group that is
-- different from the one associated with the source DB cluster.
--
-- 'targetDBParameterGroupName', 'createBlueGreenDeployment_targetDBParameterGroupName' - The DB parameter group associated with the DB instance in the green
-- environment.
--
-- To test parameter changes, specify a DB parameter group that is
-- different from the one associated with the source DB instance.
--
-- 'targetEngineVersion', 'createBlueGreenDeployment_targetEngineVersion' - The engine version of the database in the green environment.
--
-- Specify the engine version to upgrade to in the green environment.
--
-- 'blueGreenDeploymentName', 'createBlueGreenDeployment_blueGreenDeploymentName' - The name of the blue\/green deployment.
--
-- Constraints:
--
-- -   Can\'t be the same as an existing blue\/green deployment name in the
--     same account and Amazon Web Services Region.
--
-- 'source', 'createBlueGreenDeployment_source' - The Amazon Resource Name (ARN) of the source production database.
--
-- Specify the database that you want to clone. The blue\/green deployment
-- creates this database in the green environment. You can make updates to
-- the database in the green environment, such as an engine version
-- upgrade. When you are ready, you can switch the database in the green
-- environment to be the production database.
newCreateBlueGreenDeployment ::
  -- | 'blueGreenDeploymentName'
  Prelude.Text ->
  -- | 'source'
  Prelude.Text ->
  CreateBlueGreenDeployment
newCreateBlueGreenDeployment :: Text -> Text -> CreateBlueGreenDeployment
newCreateBlueGreenDeployment
  Text
pBlueGreenDeploymentName_
  Text
pSource_ =
    CreateBlueGreenDeployment'
      { $sel:tags:CreateBlueGreenDeployment' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:targetDBClusterParameterGroupName:CreateBlueGreenDeployment' :: Maybe Text
targetDBClusterParameterGroupName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:targetDBParameterGroupName:CreateBlueGreenDeployment' :: Maybe Text
targetDBParameterGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:targetEngineVersion:CreateBlueGreenDeployment' :: Maybe Text
targetEngineVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:blueGreenDeploymentName:CreateBlueGreenDeployment' :: Text
blueGreenDeploymentName =
          Text
pBlueGreenDeploymentName_,
        $sel:source:CreateBlueGreenDeployment' :: Text
source = Text
pSource_
      }

-- | Tags to assign to the blue\/green deployment.
createBlueGreenDeployment_tags :: Lens.Lens' CreateBlueGreenDeployment (Prelude.Maybe [Tag])
createBlueGreenDeployment_tags :: Lens' CreateBlueGreenDeployment (Maybe [Tag])
createBlueGreenDeployment_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBlueGreenDeployment' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateBlueGreenDeployment
s@CreateBlueGreenDeployment' {} Maybe [Tag]
a -> CreateBlueGreenDeployment
s {$sel:tags:CreateBlueGreenDeployment' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateBlueGreenDeployment) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The DB cluster parameter group associated with the Aurora DB cluster in
-- the green environment.
--
-- To test parameter changes, specify a DB cluster parameter group that is
-- different from the one associated with the source DB cluster.
createBlueGreenDeployment_targetDBClusterParameterGroupName :: Lens.Lens' CreateBlueGreenDeployment (Prelude.Maybe Prelude.Text)
createBlueGreenDeployment_targetDBClusterParameterGroupName :: Lens' CreateBlueGreenDeployment (Maybe Text)
createBlueGreenDeployment_targetDBClusterParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBlueGreenDeployment' {Maybe Text
targetDBClusterParameterGroupName :: Maybe Text
$sel:targetDBClusterParameterGroupName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
targetDBClusterParameterGroupName} -> Maybe Text
targetDBClusterParameterGroupName) (\s :: CreateBlueGreenDeployment
s@CreateBlueGreenDeployment' {} Maybe Text
a -> CreateBlueGreenDeployment
s {$sel:targetDBClusterParameterGroupName:CreateBlueGreenDeployment' :: Maybe Text
targetDBClusterParameterGroupName = Maybe Text
a} :: CreateBlueGreenDeployment)

-- | The DB parameter group associated with the DB instance in the green
-- environment.
--
-- To test parameter changes, specify a DB parameter group that is
-- different from the one associated with the source DB instance.
createBlueGreenDeployment_targetDBParameterGroupName :: Lens.Lens' CreateBlueGreenDeployment (Prelude.Maybe Prelude.Text)
createBlueGreenDeployment_targetDBParameterGroupName :: Lens' CreateBlueGreenDeployment (Maybe Text)
createBlueGreenDeployment_targetDBParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBlueGreenDeployment' {Maybe Text
targetDBParameterGroupName :: Maybe Text
$sel:targetDBParameterGroupName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
targetDBParameterGroupName} -> Maybe Text
targetDBParameterGroupName) (\s :: CreateBlueGreenDeployment
s@CreateBlueGreenDeployment' {} Maybe Text
a -> CreateBlueGreenDeployment
s {$sel:targetDBParameterGroupName:CreateBlueGreenDeployment' :: Maybe Text
targetDBParameterGroupName = Maybe Text
a} :: CreateBlueGreenDeployment)

-- | The engine version of the database in the green environment.
--
-- Specify the engine version to upgrade to in the green environment.
createBlueGreenDeployment_targetEngineVersion :: Lens.Lens' CreateBlueGreenDeployment (Prelude.Maybe Prelude.Text)
createBlueGreenDeployment_targetEngineVersion :: Lens' CreateBlueGreenDeployment (Maybe Text)
createBlueGreenDeployment_targetEngineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBlueGreenDeployment' {Maybe Text
targetEngineVersion :: Maybe Text
$sel:targetEngineVersion:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
targetEngineVersion} -> Maybe Text
targetEngineVersion) (\s :: CreateBlueGreenDeployment
s@CreateBlueGreenDeployment' {} Maybe Text
a -> CreateBlueGreenDeployment
s {$sel:targetEngineVersion:CreateBlueGreenDeployment' :: Maybe Text
targetEngineVersion = Maybe Text
a} :: CreateBlueGreenDeployment)

-- | The name of the blue\/green deployment.
--
-- Constraints:
--
-- -   Can\'t be the same as an existing blue\/green deployment name in the
--     same account and Amazon Web Services Region.
createBlueGreenDeployment_blueGreenDeploymentName :: Lens.Lens' CreateBlueGreenDeployment Prelude.Text
createBlueGreenDeployment_blueGreenDeploymentName :: Lens' CreateBlueGreenDeployment Text
createBlueGreenDeployment_blueGreenDeploymentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBlueGreenDeployment' {Text
blueGreenDeploymentName :: Text
$sel:blueGreenDeploymentName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Text
blueGreenDeploymentName} -> Text
blueGreenDeploymentName) (\s :: CreateBlueGreenDeployment
s@CreateBlueGreenDeployment' {} Text
a -> CreateBlueGreenDeployment
s {$sel:blueGreenDeploymentName:CreateBlueGreenDeployment' :: Text
blueGreenDeploymentName = Text
a} :: CreateBlueGreenDeployment)

-- | The Amazon Resource Name (ARN) of the source production database.
--
-- Specify the database that you want to clone. The blue\/green deployment
-- creates this database in the green environment. You can make updates to
-- the database in the green environment, such as an engine version
-- upgrade. When you are ready, you can switch the database in the green
-- environment to be the production database.
createBlueGreenDeployment_source :: Lens.Lens' CreateBlueGreenDeployment Prelude.Text
createBlueGreenDeployment_source :: Lens' CreateBlueGreenDeployment Text
createBlueGreenDeployment_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBlueGreenDeployment' {Text
source :: Text
$sel:source:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Text
source} -> Text
source) (\s :: CreateBlueGreenDeployment
s@CreateBlueGreenDeployment' {} Text
a -> CreateBlueGreenDeployment
s {$sel:source:CreateBlueGreenDeployment' :: Text
source = Text
a} :: CreateBlueGreenDeployment)

instance Core.AWSRequest CreateBlueGreenDeployment where
  type
    AWSResponse CreateBlueGreenDeployment =
      CreateBlueGreenDeploymentResponse
  request :: (Service -> Service)
-> CreateBlueGreenDeployment -> Request CreateBlueGreenDeployment
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 CreateBlueGreenDeployment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateBlueGreenDeployment)))
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
"CreateBlueGreenDeploymentResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe BlueGreenDeployment
-> Int -> CreateBlueGreenDeploymentResponse
CreateBlueGreenDeploymentResponse'
            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
"BlueGreenDeployment")
            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 CreateBlueGreenDeployment where
  hashWithSalt :: Int -> CreateBlueGreenDeployment -> Int
hashWithSalt Int
_salt CreateBlueGreenDeployment' {Maybe [Tag]
Maybe Text
Text
source :: Text
blueGreenDeploymentName :: Text
targetEngineVersion :: Maybe Text
targetDBParameterGroupName :: Maybe Text
targetDBClusterParameterGroupName :: Maybe Text
tags :: Maybe [Tag]
$sel:source:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Text
$sel:blueGreenDeploymentName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Text
$sel:targetEngineVersion:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
$sel:targetDBParameterGroupName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
$sel:targetDBClusterParameterGroupName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
$sel:tags:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetDBClusterParameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetDBParameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetEngineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
blueGreenDeploymentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
source

instance Prelude.NFData CreateBlueGreenDeployment where
  rnf :: CreateBlueGreenDeployment -> ()
rnf CreateBlueGreenDeployment' {Maybe [Tag]
Maybe Text
Text
source :: Text
blueGreenDeploymentName :: Text
targetEngineVersion :: Maybe Text
targetDBParameterGroupName :: Maybe Text
targetDBClusterParameterGroupName :: Maybe Text
tags :: Maybe [Tag]
$sel:source:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Text
$sel:blueGreenDeploymentName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Text
$sel:targetEngineVersion:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
$sel:targetDBParameterGroupName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
$sel:targetDBClusterParameterGroupName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
$sel:tags:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetDBClusterParameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetDBParameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetEngineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
blueGreenDeploymentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
source

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

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

instance Data.ToQuery CreateBlueGreenDeployment where
  toQuery :: CreateBlueGreenDeployment -> QueryString
toQuery CreateBlueGreenDeployment' {Maybe [Tag]
Maybe Text
Text
source :: Text
blueGreenDeploymentName :: Text
targetEngineVersion :: Maybe Text
targetDBParameterGroupName :: Maybe Text
targetDBClusterParameterGroupName :: Maybe Text
tags :: Maybe [Tag]
$sel:source:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Text
$sel:blueGreenDeploymentName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Text
$sel:targetEngineVersion:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
$sel:targetDBParameterGroupName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
$sel:targetDBClusterParameterGroupName:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe Text
$sel:tags:CreateBlueGreenDeployment' :: CreateBlueGreenDeployment -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateBlueGreenDeployment" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"TargetDBClusterParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
targetDBClusterParameterGroupName,
        ByteString
"TargetDBParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
targetDBParameterGroupName,
        ByteString
"TargetEngineVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
targetEngineVersion,
        ByteString
"BlueGreenDeploymentName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
blueGreenDeploymentName,
        ByteString
"Source" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
source
      ]

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

-- |
-- Create a value of 'CreateBlueGreenDeploymentResponse' 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:
--
-- 'blueGreenDeployment', 'createBlueGreenDeploymentResponse_blueGreenDeployment' - Undocumented member.
--
-- 'httpStatus', 'createBlueGreenDeploymentResponse_httpStatus' - The response's http status code.
newCreateBlueGreenDeploymentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateBlueGreenDeploymentResponse
newCreateBlueGreenDeploymentResponse :: Int -> CreateBlueGreenDeploymentResponse
newCreateBlueGreenDeploymentResponse Int
pHttpStatus_ =
  CreateBlueGreenDeploymentResponse'
    { $sel:blueGreenDeployment:CreateBlueGreenDeploymentResponse' :: Maybe BlueGreenDeployment
blueGreenDeployment =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateBlueGreenDeploymentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createBlueGreenDeploymentResponse_blueGreenDeployment :: Lens.Lens' CreateBlueGreenDeploymentResponse (Prelude.Maybe BlueGreenDeployment)
createBlueGreenDeploymentResponse_blueGreenDeployment :: Lens' CreateBlueGreenDeploymentResponse (Maybe BlueGreenDeployment)
createBlueGreenDeploymentResponse_blueGreenDeployment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBlueGreenDeploymentResponse' {Maybe BlueGreenDeployment
blueGreenDeployment :: Maybe BlueGreenDeployment
$sel:blueGreenDeployment:CreateBlueGreenDeploymentResponse' :: CreateBlueGreenDeploymentResponse -> Maybe BlueGreenDeployment
blueGreenDeployment} -> Maybe BlueGreenDeployment
blueGreenDeployment) (\s :: CreateBlueGreenDeploymentResponse
s@CreateBlueGreenDeploymentResponse' {} Maybe BlueGreenDeployment
a -> CreateBlueGreenDeploymentResponse
s {$sel:blueGreenDeployment:CreateBlueGreenDeploymentResponse' :: Maybe BlueGreenDeployment
blueGreenDeployment = Maybe BlueGreenDeployment
a} :: CreateBlueGreenDeploymentResponse)

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

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