{-# 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.SwitchoverBlueGreenDeployment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Switches over a blue\/green deployment.
--
-- Before you switch over, production traffic is routed to the databases in
-- the blue environment. After you switch over, production traffic is
-- routed to the databases in the green environment.
--
-- 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.SwitchoverBlueGreenDeployment
  ( -- * Creating a Request
    SwitchoverBlueGreenDeployment (..),
    newSwitchoverBlueGreenDeployment,

    -- * Request Lenses
    switchoverBlueGreenDeployment_switchoverTimeout,
    switchoverBlueGreenDeployment_blueGreenDeploymentIdentifier,

    -- * Destructuring the Response
    SwitchoverBlueGreenDeploymentResponse (..),
    newSwitchoverBlueGreenDeploymentResponse,

    -- * Response Lenses
    switchoverBlueGreenDeploymentResponse_blueGreenDeployment,
    switchoverBlueGreenDeploymentResponse_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:/ 'newSwitchoverBlueGreenDeployment' smart constructor.
data SwitchoverBlueGreenDeployment = SwitchoverBlueGreenDeployment'
  { -- | The amount of time, in seconds, for the switchover to complete. The
    -- default is 300.
    --
    -- If the switchover takes longer than the specified duration, then any
    -- changes are rolled back, and no changes are made to the environments.
    SwitchoverBlueGreenDeployment -> Maybe Natural
switchoverTimeout :: Prelude.Maybe Prelude.Natural,
    -- | The blue\/green deployment identifier.
    --
    -- Constraints:
    --
    -- -   Must match an existing blue\/green deployment identifier.
    SwitchoverBlueGreenDeployment -> Text
blueGreenDeploymentIdentifier :: Prelude.Text
  }
  deriving (SwitchoverBlueGreenDeployment
-> SwitchoverBlueGreenDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwitchoverBlueGreenDeployment
-> SwitchoverBlueGreenDeployment -> Bool
$c/= :: SwitchoverBlueGreenDeployment
-> SwitchoverBlueGreenDeployment -> Bool
== :: SwitchoverBlueGreenDeployment
-> SwitchoverBlueGreenDeployment -> Bool
$c== :: SwitchoverBlueGreenDeployment
-> SwitchoverBlueGreenDeployment -> Bool
Prelude.Eq, ReadPrec [SwitchoverBlueGreenDeployment]
ReadPrec SwitchoverBlueGreenDeployment
Int -> ReadS SwitchoverBlueGreenDeployment
ReadS [SwitchoverBlueGreenDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SwitchoverBlueGreenDeployment]
$creadListPrec :: ReadPrec [SwitchoverBlueGreenDeployment]
readPrec :: ReadPrec SwitchoverBlueGreenDeployment
$creadPrec :: ReadPrec SwitchoverBlueGreenDeployment
readList :: ReadS [SwitchoverBlueGreenDeployment]
$creadList :: ReadS [SwitchoverBlueGreenDeployment]
readsPrec :: Int -> ReadS SwitchoverBlueGreenDeployment
$creadsPrec :: Int -> ReadS SwitchoverBlueGreenDeployment
Prelude.Read, Int -> SwitchoverBlueGreenDeployment -> ShowS
[SwitchoverBlueGreenDeployment] -> ShowS
SwitchoverBlueGreenDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwitchoverBlueGreenDeployment] -> ShowS
$cshowList :: [SwitchoverBlueGreenDeployment] -> ShowS
show :: SwitchoverBlueGreenDeployment -> String
$cshow :: SwitchoverBlueGreenDeployment -> String
showsPrec :: Int -> SwitchoverBlueGreenDeployment -> ShowS
$cshowsPrec :: Int -> SwitchoverBlueGreenDeployment -> ShowS
Prelude.Show, forall x.
Rep SwitchoverBlueGreenDeployment x
-> SwitchoverBlueGreenDeployment
forall x.
SwitchoverBlueGreenDeployment
-> Rep SwitchoverBlueGreenDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SwitchoverBlueGreenDeployment x
-> SwitchoverBlueGreenDeployment
$cfrom :: forall x.
SwitchoverBlueGreenDeployment
-> Rep SwitchoverBlueGreenDeployment x
Prelude.Generic)

-- |
-- Create a value of 'SwitchoverBlueGreenDeployment' 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:
--
-- 'switchoverTimeout', 'switchoverBlueGreenDeployment_switchoverTimeout' - The amount of time, in seconds, for the switchover to complete. The
-- default is 300.
--
-- If the switchover takes longer than the specified duration, then any
-- changes are rolled back, and no changes are made to the environments.
--
-- 'blueGreenDeploymentIdentifier', 'switchoverBlueGreenDeployment_blueGreenDeploymentIdentifier' - The blue\/green deployment identifier.
--
-- Constraints:
--
-- -   Must match an existing blue\/green deployment identifier.
newSwitchoverBlueGreenDeployment ::
  -- | 'blueGreenDeploymentIdentifier'
  Prelude.Text ->
  SwitchoverBlueGreenDeployment
newSwitchoverBlueGreenDeployment :: Text -> SwitchoverBlueGreenDeployment
newSwitchoverBlueGreenDeployment
  Text
pBlueGreenDeploymentIdentifier_ =
    SwitchoverBlueGreenDeployment'
      { $sel:switchoverTimeout:SwitchoverBlueGreenDeployment' :: Maybe Natural
switchoverTimeout =
          forall a. Maybe a
Prelude.Nothing,
        $sel:blueGreenDeploymentIdentifier:SwitchoverBlueGreenDeployment' :: Text
blueGreenDeploymentIdentifier =
          Text
pBlueGreenDeploymentIdentifier_
      }

-- | The amount of time, in seconds, for the switchover to complete. The
-- default is 300.
--
-- If the switchover takes longer than the specified duration, then any
-- changes are rolled back, and no changes are made to the environments.
switchoverBlueGreenDeployment_switchoverTimeout :: Lens.Lens' SwitchoverBlueGreenDeployment (Prelude.Maybe Prelude.Natural)
switchoverBlueGreenDeployment_switchoverTimeout :: Lens' SwitchoverBlueGreenDeployment (Maybe Natural)
switchoverBlueGreenDeployment_switchoverTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SwitchoverBlueGreenDeployment' {Maybe Natural
switchoverTimeout :: Maybe Natural
$sel:switchoverTimeout:SwitchoverBlueGreenDeployment' :: SwitchoverBlueGreenDeployment -> Maybe Natural
switchoverTimeout} -> Maybe Natural
switchoverTimeout) (\s :: SwitchoverBlueGreenDeployment
s@SwitchoverBlueGreenDeployment' {} Maybe Natural
a -> SwitchoverBlueGreenDeployment
s {$sel:switchoverTimeout:SwitchoverBlueGreenDeployment' :: Maybe Natural
switchoverTimeout = Maybe Natural
a} :: SwitchoverBlueGreenDeployment)

-- | The blue\/green deployment identifier.
--
-- Constraints:
--
-- -   Must match an existing blue\/green deployment identifier.
switchoverBlueGreenDeployment_blueGreenDeploymentIdentifier :: Lens.Lens' SwitchoverBlueGreenDeployment Prelude.Text
switchoverBlueGreenDeployment_blueGreenDeploymentIdentifier :: Lens' SwitchoverBlueGreenDeployment Text
switchoverBlueGreenDeployment_blueGreenDeploymentIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SwitchoverBlueGreenDeployment' {Text
blueGreenDeploymentIdentifier :: Text
$sel:blueGreenDeploymentIdentifier:SwitchoverBlueGreenDeployment' :: SwitchoverBlueGreenDeployment -> Text
blueGreenDeploymentIdentifier} -> Text
blueGreenDeploymentIdentifier) (\s :: SwitchoverBlueGreenDeployment
s@SwitchoverBlueGreenDeployment' {} Text
a -> SwitchoverBlueGreenDeployment
s {$sel:blueGreenDeploymentIdentifier:SwitchoverBlueGreenDeployment' :: Text
blueGreenDeploymentIdentifier = Text
a} :: SwitchoverBlueGreenDeployment)

instance
  Core.AWSRequest
    SwitchoverBlueGreenDeployment
  where
  type
    AWSResponse SwitchoverBlueGreenDeployment =
      SwitchoverBlueGreenDeploymentResponse
  request :: (Service -> Service)
-> SwitchoverBlueGreenDeployment
-> Request SwitchoverBlueGreenDeployment
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 SwitchoverBlueGreenDeployment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SwitchoverBlueGreenDeployment)))
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
"SwitchoverBlueGreenDeploymentResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe BlueGreenDeployment
-> Int -> SwitchoverBlueGreenDeploymentResponse
SwitchoverBlueGreenDeploymentResponse'
            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
    SwitchoverBlueGreenDeployment
  where
  hashWithSalt :: Int -> SwitchoverBlueGreenDeployment -> Int
hashWithSalt Int
_salt SwitchoverBlueGreenDeployment' {Maybe Natural
Text
blueGreenDeploymentIdentifier :: Text
switchoverTimeout :: Maybe Natural
$sel:blueGreenDeploymentIdentifier:SwitchoverBlueGreenDeployment' :: SwitchoverBlueGreenDeployment -> Text
$sel:switchoverTimeout:SwitchoverBlueGreenDeployment' :: SwitchoverBlueGreenDeployment -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
switchoverTimeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
blueGreenDeploymentIdentifier

instance Prelude.NFData SwitchoverBlueGreenDeployment where
  rnf :: SwitchoverBlueGreenDeployment -> ()
rnf SwitchoverBlueGreenDeployment' {Maybe Natural
Text
blueGreenDeploymentIdentifier :: Text
switchoverTimeout :: Maybe Natural
$sel:blueGreenDeploymentIdentifier:SwitchoverBlueGreenDeployment' :: SwitchoverBlueGreenDeployment -> Text
$sel:switchoverTimeout:SwitchoverBlueGreenDeployment' :: SwitchoverBlueGreenDeployment -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
switchoverTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
blueGreenDeploymentIdentifier

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

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

instance Data.ToQuery SwitchoverBlueGreenDeployment where
  toQuery :: SwitchoverBlueGreenDeployment -> QueryString
toQuery SwitchoverBlueGreenDeployment' {Maybe Natural
Text
blueGreenDeploymentIdentifier :: Text
switchoverTimeout :: Maybe Natural
$sel:blueGreenDeploymentIdentifier:SwitchoverBlueGreenDeployment' :: SwitchoverBlueGreenDeployment -> Text
$sel:switchoverTimeout:SwitchoverBlueGreenDeployment' :: SwitchoverBlueGreenDeployment -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"SwitchoverBlueGreenDeployment" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"SwitchoverTimeout" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
switchoverTimeout,
        ByteString
"BlueGreenDeploymentIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
blueGreenDeploymentIdentifier
      ]

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

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

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

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

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