{-# 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.CodeDeploy.ContinueDeployment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- For a blue\/green deployment, starts the process of rerouting traffic
-- from instances in the original environment to instances in the
-- replacement environment without waiting for a specified wait time to
-- elapse. (Traffic rerouting, which is achieved by registering instances
-- in the replacement environment with the load balancer, can start as soon
-- as all instances have a status of Ready.)
module Amazonka.CodeDeploy.ContinueDeployment
  ( -- * Creating a Request
    ContinueDeployment (..),
    newContinueDeployment,

    -- * Request Lenses
    continueDeployment_deploymentId,
    continueDeployment_deploymentWaitType,

    -- * Destructuring the Response
    ContinueDeploymentResponse (..),
    newContinueDeploymentResponse,
  )
where

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

-- | /See:/ 'newContinueDeployment' smart constructor.
data ContinueDeployment = ContinueDeployment'
  { -- | The unique ID of a blue\/green deployment for which you want to start
    -- rerouting traffic to the replacement environment.
    ContinueDeployment -> Maybe Text
deploymentId :: Prelude.Maybe Prelude.Text,
    -- | The status of the deployment\'s waiting period. @READY_WAIT@ indicates
    -- that the deployment is ready to start shifting traffic.
    -- @TERMINATION_WAIT@ indicates that the traffic is shifted, but the
    -- original target is not terminated.
    ContinueDeployment -> Maybe DeploymentWaitType
deploymentWaitType :: Prelude.Maybe DeploymentWaitType
  }
  deriving (ContinueDeployment -> ContinueDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContinueDeployment -> ContinueDeployment -> Bool
$c/= :: ContinueDeployment -> ContinueDeployment -> Bool
== :: ContinueDeployment -> ContinueDeployment -> Bool
$c== :: ContinueDeployment -> ContinueDeployment -> Bool
Prelude.Eq, ReadPrec [ContinueDeployment]
ReadPrec ContinueDeployment
Int -> ReadS ContinueDeployment
ReadS [ContinueDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContinueDeployment]
$creadListPrec :: ReadPrec [ContinueDeployment]
readPrec :: ReadPrec ContinueDeployment
$creadPrec :: ReadPrec ContinueDeployment
readList :: ReadS [ContinueDeployment]
$creadList :: ReadS [ContinueDeployment]
readsPrec :: Int -> ReadS ContinueDeployment
$creadsPrec :: Int -> ReadS ContinueDeployment
Prelude.Read, Int -> ContinueDeployment -> ShowS
[ContinueDeployment] -> ShowS
ContinueDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContinueDeployment] -> ShowS
$cshowList :: [ContinueDeployment] -> ShowS
show :: ContinueDeployment -> String
$cshow :: ContinueDeployment -> String
showsPrec :: Int -> ContinueDeployment -> ShowS
$cshowsPrec :: Int -> ContinueDeployment -> ShowS
Prelude.Show, forall x. Rep ContinueDeployment x -> ContinueDeployment
forall x. ContinueDeployment -> Rep ContinueDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContinueDeployment x -> ContinueDeployment
$cfrom :: forall x. ContinueDeployment -> Rep ContinueDeployment x
Prelude.Generic)

-- |
-- Create a value of 'ContinueDeployment' 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:
--
-- 'deploymentId', 'continueDeployment_deploymentId' - The unique ID of a blue\/green deployment for which you want to start
-- rerouting traffic to the replacement environment.
--
-- 'deploymentWaitType', 'continueDeployment_deploymentWaitType' - The status of the deployment\'s waiting period. @READY_WAIT@ indicates
-- that the deployment is ready to start shifting traffic.
-- @TERMINATION_WAIT@ indicates that the traffic is shifted, but the
-- original target is not terminated.
newContinueDeployment ::
  ContinueDeployment
newContinueDeployment :: ContinueDeployment
newContinueDeployment =
  ContinueDeployment'
    { $sel:deploymentId:ContinueDeployment' :: Maybe Text
deploymentId = forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentWaitType:ContinueDeployment' :: Maybe DeploymentWaitType
deploymentWaitType = forall a. Maybe a
Prelude.Nothing
    }

-- | The unique ID of a blue\/green deployment for which you want to start
-- rerouting traffic to the replacement environment.
continueDeployment_deploymentId :: Lens.Lens' ContinueDeployment (Prelude.Maybe Prelude.Text)
continueDeployment_deploymentId :: Lens' ContinueDeployment (Maybe Text)
continueDeployment_deploymentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContinueDeployment' {Maybe Text
deploymentId :: Maybe Text
$sel:deploymentId:ContinueDeployment' :: ContinueDeployment -> Maybe Text
deploymentId} -> Maybe Text
deploymentId) (\s :: ContinueDeployment
s@ContinueDeployment' {} Maybe Text
a -> ContinueDeployment
s {$sel:deploymentId:ContinueDeployment' :: Maybe Text
deploymentId = Maybe Text
a} :: ContinueDeployment)

-- | The status of the deployment\'s waiting period. @READY_WAIT@ indicates
-- that the deployment is ready to start shifting traffic.
-- @TERMINATION_WAIT@ indicates that the traffic is shifted, but the
-- original target is not terminated.
continueDeployment_deploymentWaitType :: Lens.Lens' ContinueDeployment (Prelude.Maybe DeploymentWaitType)
continueDeployment_deploymentWaitType :: Lens' ContinueDeployment (Maybe DeploymentWaitType)
continueDeployment_deploymentWaitType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContinueDeployment' {Maybe DeploymentWaitType
deploymentWaitType :: Maybe DeploymentWaitType
$sel:deploymentWaitType:ContinueDeployment' :: ContinueDeployment -> Maybe DeploymentWaitType
deploymentWaitType} -> Maybe DeploymentWaitType
deploymentWaitType) (\s :: ContinueDeployment
s@ContinueDeployment' {} Maybe DeploymentWaitType
a -> ContinueDeployment
s {$sel:deploymentWaitType:ContinueDeployment' :: Maybe DeploymentWaitType
deploymentWaitType = Maybe DeploymentWaitType
a} :: ContinueDeployment)

instance Core.AWSRequest ContinueDeployment where
  type
    AWSResponse ContinueDeployment =
      ContinueDeploymentResponse
  request :: (Service -> Service)
-> ContinueDeployment -> Request ContinueDeployment
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ContinueDeployment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ContinueDeployment)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull ContinueDeploymentResponse
ContinueDeploymentResponse'

instance Prelude.Hashable ContinueDeployment where
  hashWithSalt :: Int -> ContinueDeployment -> Int
hashWithSalt Int
_salt ContinueDeployment' {Maybe Text
Maybe DeploymentWaitType
deploymentWaitType :: Maybe DeploymentWaitType
deploymentId :: Maybe Text
$sel:deploymentWaitType:ContinueDeployment' :: ContinueDeployment -> Maybe DeploymentWaitType
$sel:deploymentId:ContinueDeployment' :: ContinueDeployment -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deploymentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeploymentWaitType
deploymentWaitType

instance Prelude.NFData ContinueDeployment where
  rnf :: ContinueDeployment -> ()
rnf ContinueDeployment' {Maybe Text
Maybe DeploymentWaitType
deploymentWaitType :: Maybe DeploymentWaitType
deploymentId :: Maybe Text
$sel:deploymentWaitType:ContinueDeployment' :: ContinueDeployment -> Maybe DeploymentWaitType
$sel:deploymentId:ContinueDeployment' :: ContinueDeployment -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deploymentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeploymentWaitType
deploymentWaitType

instance Data.ToHeaders ContinueDeployment where
  toHeaders :: ContinueDeployment -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"CodeDeploy_20141006.ContinueDeployment" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ContinueDeployment where
  toJSON :: ContinueDeployment -> Value
toJSON ContinueDeployment' {Maybe Text
Maybe DeploymentWaitType
deploymentWaitType :: Maybe DeploymentWaitType
deploymentId :: Maybe Text
$sel:deploymentWaitType:ContinueDeployment' :: ContinueDeployment -> Maybe DeploymentWaitType
$sel:deploymentId:ContinueDeployment' :: ContinueDeployment -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"deploymentId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
deploymentId,
            (Key
"deploymentWaitType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe DeploymentWaitType
deploymentWaitType
          ]
      )

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

instance Data.ToQuery ContinueDeployment where
  toQuery :: ContinueDeployment -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newContinueDeploymentResponse' smart constructor.
data ContinueDeploymentResponse = ContinueDeploymentResponse'
  {
  }
  deriving (ContinueDeploymentResponse -> ContinueDeploymentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContinueDeploymentResponse -> ContinueDeploymentResponse -> Bool
$c/= :: ContinueDeploymentResponse -> ContinueDeploymentResponse -> Bool
== :: ContinueDeploymentResponse -> ContinueDeploymentResponse -> Bool
$c== :: ContinueDeploymentResponse -> ContinueDeploymentResponse -> Bool
Prelude.Eq, ReadPrec [ContinueDeploymentResponse]
ReadPrec ContinueDeploymentResponse
Int -> ReadS ContinueDeploymentResponse
ReadS [ContinueDeploymentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContinueDeploymentResponse]
$creadListPrec :: ReadPrec [ContinueDeploymentResponse]
readPrec :: ReadPrec ContinueDeploymentResponse
$creadPrec :: ReadPrec ContinueDeploymentResponse
readList :: ReadS [ContinueDeploymentResponse]
$creadList :: ReadS [ContinueDeploymentResponse]
readsPrec :: Int -> ReadS ContinueDeploymentResponse
$creadsPrec :: Int -> ReadS ContinueDeploymentResponse
Prelude.Read, Int -> ContinueDeploymentResponse -> ShowS
[ContinueDeploymentResponse] -> ShowS
ContinueDeploymentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContinueDeploymentResponse] -> ShowS
$cshowList :: [ContinueDeploymentResponse] -> ShowS
show :: ContinueDeploymentResponse -> String
$cshow :: ContinueDeploymentResponse -> String
showsPrec :: Int -> ContinueDeploymentResponse -> ShowS
$cshowsPrec :: Int -> ContinueDeploymentResponse -> ShowS
Prelude.Show, forall x.
Rep ContinueDeploymentResponse x -> ContinueDeploymentResponse
forall x.
ContinueDeploymentResponse -> Rep ContinueDeploymentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ContinueDeploymentResponse x -> ContinueDeploymentResponse
$cfrom :: forall x.
ContinueDeploymentResponse -> Rep ContinueDeploymentResponse x
Prelude.Generic)

-- |
-- Create a value of 'ContinueDeploymentResponse' 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.
newContinueDeploymentResponse ::
  ContinueDeploymentResponse
newContinueDeploymentResponse :: ContinueDeploymentResponse
newContinueDeploymentResponse =
  ContinueDeploymentResponse
ContinueDeploymentResponse'

instance Prelude.NFData ContinueDeploymentResponse where
  rnf :: ContinueDeploymentResponse -> ()
rnf ContinueDeploymentResponse
_ = ()