{-# 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.AppConfig.UpdateDeploymentStrategy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a deployment strategy.
module Amazonka.AppConfig.UpdateDeploymentStrategy
  ( -- * Creating a Request
    UpdateDeploymentStrategy (..),
    newUpdateDeploymentStrategy,

    -- * Request Lenses
    updateDeploymentStrategy_deploymentDurationInMinutes,
    updateDeploymentStrategy_description,
    updateDeploymentStrategy_finalBakeTimeInMinutes,
    updateDeploymentStrategy_growthFactor,
    updateDeploymentStrategy_growthType,
    updateDeploymentStrategy_deploymentStrategyId,

    -- * Destructuring the Response
    DeploymentStrategy (..),
    newDeploymentStrategy,

    -- * Response Lenses
    deploymentStrategy_deploymentDurationInMinutes,
    deploymentStrategy_description,
    deploymentStrategy_finalBakeTimeInMinutes,
    deploymentStrategy_growthFactor,
    deploymentStrategy_growthType,
    deploymentStrategy_id,
    deploymentStrategy_name,
    deploymentStrategy_replicateTo,
  )
where

import Amazonka.AppConfig.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:/ 'newUpdateDeploymentStrategy' smart constructor.
data UpdateDeploymentStrategy = UpdateDeploymentStrategy'
  { -- | Total amount of time for a deployment to last.
    UpdateDeploymentStrategy -> Maybe Natural
deploymentDurationInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | A description of the deployment strategy.
    UpdateDeploymentStrategy -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The amount of time that AppConfig monitors for alarms before considering
    -- the deployment to be complete and no longer eligible for automatic
    -- rollback.
    UpdateDeploymentStrategy -> Maybe Natural
finalBakeTimeInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | The percentage of targets to receive a deployed configuration during
    -- each interval.
    UpdateDeploymentStrategy -> Maybe Double
growthFactor :: Prelude.Maybe Prelude.Double,
    -- | The algorithm used to define how percentage grows over time. AppConfig
    -- supports the following growth types:
    --
    -- __Linear__: For this type, AppConfig processes the deployment by
    -- increments of the growth factor evenly distributed over the deployment
    -- time. For example, a linear deployment that uses a growth factor of 20
    -- initially makes the configuration available to 20 percent of the
    -- targets. After 1\/5th of the deployment time has passed, the system
    -- updates the percentage to 40 percent. This continues until 100% of the
    -- targets are set to receive the deployed configuration.
    --
    -- __Exponential__: For this type, AppConfig processes the deployment
    -- exponentially using the following formula: @G*(2^N)@. In this formula,
    -- @G@ is the growth factor specified by the user and @N@ is the number of
    -- steps until the configuration is deployed to all targets. For example,
    -- if you specify a growth factor of 2, then the system rolls out the
    -- configuration as follows:
    --
    -- @2*(2^0)@
    --
    -- @2*(2^1)@
    --
    -- @2*(2^2)@
    --
    -- Expressed numerically, the deployment rolls out as follows: 2% of the
    -- targets, 4% of the targets, 8% of the targets, and continues until the
    -- configuration has been deployed to all targets.
    UpdateDeploymentStrategy -> Maybe GrowthType
growthType :: Prelude.Maybe GrowthType,
    -- | The deployment strategy ID.
    UpdateDeploymentStrategy -> Text
deploymentStrategyId :: Prelude.Text
  }
  deriving (UpdateDeploymentStrategy -> UpdateDeploymentStrategy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDeploymentStrategy -> UpdateDeploymentStrategy -> Bool
$c/= :: UpdateDeploymentStrategy -> UpdateDeploymentStrategy -> Bool
== :: UpdateDeploymentStrategy -> UpdateDeploymentStrategy -> Bool
$c== :: UpdateDeploymentStrategy -> UpdateDeploymentStrategy -> Bool
Prelude.Eq, ReadPrec [UpdateDeploymentStrategy]
ReadPrec UpdateDeploymentStrategy
Int -> ReadS UpdateDeploymentStrategy
ReadS [UpdateDeploymentStrategy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDeploymentStrategy]
$creadListPrec :: ReadPrec [UpdateDeploymentStrategy]
readPrec :: ReadPrec UpdateDeploymentStrategy
$creadPrec :: ReadPrec UpdateDeploymentStrategy
readList :: ReadS [UpdateDeploymentStrategy]
$creadList :: ReadS [UpdateDeploymentStrategy]
readsPrec :: Int -> ReadS UpdateDeploymentStrategy
$creadsPrec :: Int -> ReadS UpdateDeploymentStrategy
Prelude.Read, Int -> UpdateDeploymentStrategy -> ShowS
[UpdateDeploymentStrategy] -> ShowS
UpdateDeploymentStrategy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDeploymentStrategy] -> ShowS
$cshowList :: [UpdateDeploymentStrategy] -> ShowS
show :: UpdateDeploymentStrategy -> String
$cshow :: UpdateDeploymentStrategy -> String
showsPrec :: Int -> UpdateDeploymentStrategy -> ShowS
$cshowsPrec :: Int -> UpdateDeploymentStrategy -> ShowS
Prelude.Show, forall x.
Rep UpdateDeploymentStrategy x -> UpdateDeploymentStrategy
forall x.
UpdateDeploymentStrategy -> Rep UpdateDeploymentStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateDeploymentStrategy x -> UpdateDeploymentStrategy
$cfrom :: forall x.
UpdateDeploymentStrategy -> Rep UpdateDeploymentStrategy x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDeploymentStrategy' 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:
--
-- 'deploymentDurationInMinutes', 'updateDeploymentStrategy_deploymentDurationInMinutes' - Total amount of time for a deployment to last.
--
-- 'description', 'updateDeploymentStrategy_description' - A description of the deployment strategy.
--
-- 'finalBakeTimeInMinutes', 'updateDeploymentStrategy_finalBakeTimeInMinutes' - The amount of time that AppConfig monitors for alarms before considering
-- the deployment to be complete and no longer eligible for automatic
-- rollback.
--
-- 'growthFactor', 'updateDeploymentStrategy_growthFactor' - The percentage of targets to receive a deployed configuration during
-- each interval.
--
-- 'growthType', 'updateDeploymentStrategy_growthType' - The algorithm used to define how percentage grows over time. AppConfig
-- supports the following growth types:
--
-- __Linear__: For this type, AppConfig processes the deployment by
-- increments of the growth factor evenly distributed over the deployment
-- time. For example, a linear deployment that uses a growth factor of 20
-- initially makes the configuration available to 20 percent of the
-- targets. After 1\/5th of the deployment time has passed, the system
-- updates the percentage to 40 percent. This continues until 100% of the
-- targets are set to receive the deployed configuration.
--
-- __Exponential__: For this type, AppConfig processes the deployment
-- exponentially using the following formula: @G*(2^N)@. In this formula,
-- @G@ is the growth factor specified by the user and @N@ is the number of
-- steps until the configuration is deployed to all targets. For example,
-- if you specify a growth factor of 2, then the system rolls out the
-- configuration as follows:
--
-- @2*(2^0)@
--
-- @2*(2^1)@
--
-- @2*(2^2)@
--
-- Expressed numerically, the deployment rolls out as follows: 2% of the
-- targets, 4% of the targets, 8% of the targets, and continues until the
-- configuration has been deployed to all targets.
--
-- 'deploymentStrategyId', 'updateDeploymentStrategy_deploymentStrategyId' - The deployment strategy ID.
newUpdateDeploymentStrategy ::
  -- | 'deploymentStrategyId'
  Prelude.Text ->
  UpdateDeploymentStrategy
newUpdateDeploymentStrategy :: Text -> UpdateDeploymentStrategy
newUpdateDeploymentStrategy Text
pDeploymentStrategyId_ =
  UpdateDeploymentStrategy'
    { $sel:deploymentDurationInMinutes:UpdateDeploymentStrategy' :: Maybe Natural
deploymentDurationInMinutes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateDeploymentStrategy' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:finalBakeTimeInMinutes:UpdateDeploymentStrategy' :: Maybe Natural
finalBakeTimeInMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:growthFactor:UpdateDeploymentStrategy' :: Maybe Double
growthFactor = forall a. Maybe a
Prelude.Nothing,
      $sel:growthType:UpdateDeploymentStrategy' :: Maybe GrowthType
growthType = forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentStrategyId:UpdateDeploymentStrategy' :: Text
deploymentStrategyId = Text
pDeploymentStrategyId_
    }

-- | Total amount of time for a deployment to last.
updateDeploymentStrategy_deploymentDurationInMinutes :: Lens.Lens' UpdateDeploymentStrategy (Prelude.Maybe Prelude.Natural)
updateDeploymentStrategy_deploymentDurationInMinutes :: Lens' UpdateDeploymentStrategy (Maybe Natural)
updateDeploymentStrategy_deploymentDurationInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentStrategy' {Maybe Natural
deploymentDurationInMinutes :: Maybe Natural
$sel:deploymentDurationInMinutes:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Natural
deploymentDurationInMinutes} -> Maybe Natural
deploymentDurationInMinutes) (\s :: UpdateDeploymentStrategy
s@UpdateDeploymentStrategy' {} Maybe Natural
a -> UpdateDeploymentStrategy
s {$sel:deploymentDurationInMinutes:UpdateDeploymentStrategy' :: Maybe Natural
deploymentDurationInMinutes = Maybe Natural
a} :: UpdateDeploymentStrategy)

-- | A description of the deployment strategy.
updateDeploymentStrategy_description :: Lens.Lens' UpdateDeploymentStrategy (Prelude.Maybe Prelude.Text)
updateDeploymentStrategy_description :: Lens' UpdateDeploymentStrategy (Maybe Text)
updateDeploymentStrategy_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentStrategy' {Maybe Text
description :: Maybe Text
$sel:description:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateDeploymentStrategy
s@UpdateDeploymentStrategy' {} Maybe Text
a -> UpdateDeploymentStrategy
s {$sel:description:UpdateDeploymentStrategy' :: Maybe Text
description = Maybe Text
a} :: UpdateDeploymentStrategy)

-- | The amount of time that AppConfig monitors for alarms before considering
-- the deployment to be complete and no longer eligible for automatic
-- rollback.
updateDeploymentStrategy_finalBakeTimeInMinutes :: Lens.Lens' UpdateDeploymentStrategy (Prelude.Maybe Prelude.Natural)
updateDeploymentStrategy_finalBakeTimeInMinutes :: Lens' UpdateDeploymentStrategy (Maybe Natural)
updateDeploymentStrategy_finalBakeTimeInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentStrategy' {Maybe Natural
finalBakeTimeInMinutes :: Maybe Natural
$sel:finalBakeTimeInMinutes:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Natural
finalBakeTimeInMinutes} -> Maybe Natural
finalBakeTimeInMinutes) (\s :: UpdateDeploymentStrategy
s@UpdateDeploymentStrategy' {} Maybe Natural
a -> UpdateDeploymentStrategy
s {$sel:finalBakeTimeInMinutes:UpdateDeploymentStrategy' :: Maybe Natural
finalBakeTimeInMinutes = Maybe Natural
a} :: UpdateDeploymentStrategy)

-- | The percentage of targets to receive a deployed configuration during
-- each interval.
updateDeploymentStrategy_growthFactor :: Lens.Lens' UpdateDeploymentStrategy (Prelude.Maybe Prelude.Double)
updateDeploymentStrategy_growthFactor :: Lens' UpdateDeploymentStrategy (Maybe Double)
updateDeploymentStrategy_growthFactor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentStrategy' {Maybe Double
growthFactor :: Maybe Double
$sel:growthFactor:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Double
growthFactor} -> Maybe Double
growthFactor) (\s :: UpdateDeploymentStrategy
s@UpdateDeploymentStrategy' {} Maybe Double
a -> UpdateDeploymentStrategy
s {$sel:growthFactor:UpdateDeploymentStrategy' :: Maybe Double
growthFactor = Maybe Double
a} :: UpdateDeploymentStrategy)

-- | The algorithm used to define how percentage grows over time. AppConfig
-- supports the following growth types:
--
-- __Linear__: For this type, AppConfig processes the deployment by
-- increments of the growth factor evenly distributed over the deployment
-- time. For example, a linear deployment that uses a growth factor of 20
-- initially makes the configuration available to 20 percent of the
-- targets. After 1\/5th of the deployment time has passed, the system
-- updates the percentage to 40 percent. This continues until 100% of the
-- targets are set to receive the deployed configuration.
--
-- __Exponential__: For this type, AppConfig processes the deployment
-- exponentially using the following formula: @G*(2^N)@. In this formula,
-- @G@ is the growth factor specified by the user and @N@ is the number of
-- steps until the configuration is deployed to all targets. For example,
-- if you specify a growth factor of 2, then the system rolls out the
-- configuration as follows:
--
-- @2*(2^0)@
--
-- @2*(2^1)@
--
-- @2*(2^2)@
--
-- Expressed numerically, the deployment rolls out as follows: 2% of the
-- targets, 4% of the targets, 8% of the targets, and continues until the
-- configuration has been deployed to all targets.
updateDeploymentStrategy_growthType :: Lens.Lens' UpdateDeploymentStrategy (Prelude.Maybe GrowthType)
updateDeploymentStrategy_growthType :: Lens' UpdateDeploymentStrategy (Maybe GrowthType)
updateDeploymentStrategy_growthType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentStrategy' {Maybe GrowthType
growthType :: Maybe GrowthType
$sel:growthType:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe GrowthType
growthType} -> Maybe GrowthType
growthType) (\s :: UpdateDeploymentStrategy
s@UpdateDeploymentStrategy' {} Maybe GrowthType
a -> UpdateDeploymentStrategy
s {$sel:growthType:UpdateDeploymentStrategy' :: Maybe GrowthType
growthType = Maybe GrowthType
a} :: UpdateDeploymentStrategy)

-- | The deployment strategy ID.
updateDeploymentStrategy_deploymentStrategyId :: Lens.Lens' UpdateDeploymentStrategy Prelude.Text
updateDeploymentStrategy_deploymentStrategyId :: Lens' UpdateDeploymentStrategy Text
updateDeploymentStrategy_deploymentStrategyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeploymentStrategy' {Text
deploymentStrategyId :: Text
$sel:deploymentStrategyId:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Text
deploymentStrategyId} -> Text
deploymentStrategyId) (\s :: UpdateDeploymentStrategy
s@UpdateDeploymentStrategy' {} Text
a -> UpdateDeploymentStrategy
s {$sel:deploymentStrategyId:UpdateDeploymentStrategy' :: Text
deploymentStrategyId = Text
a} :: UpdateDeploymentStrategy)

instance Core.AWSRequest UpdateDeploymentStrategy where
  type
    AWSResponse UpdateDeploymentStrategy =
      DeploymentStrategy
  request :: (Service -> Service)
-> UpdateDeploymentStrategy -> Request UpdateDeploymentStrategy
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateDeploymentStrategy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateDeploymentStrategy)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      (\Int
s ResponseHeaders
h Object
x -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable UpdateDeploymentStrategy where
  hashWithSalt :: Int -> UpdateDeploymentStrategy -> Int
hashWithSalt Int
_salt UpdateDeploymentStrategy' {Maybe Double
Maybe Natural
Maybe Text
Maybe GrowthType
Text
deploymentStrategyId :: Text
growthType :: Maybe GrowthType
growthFactor :: Maybe Double
finalBakeTimeInMinutes :: Maybe Natural
description :: Maybe Text
deploymentDurationInMinutes :: Maybe Natural
$sel:deploymentStrategyId:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Text
$sel:growthType:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe GrowthType
$sel:growthFactor:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Double
$sel:finalBakeTimeInMinutes:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Natural
$sel:description:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Text
$sel:deploymentDurationInMinutes:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
deploymentDurationInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
finalBakeTimeInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
growthFactor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GrowthType
growthType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deploymentStrategyId

instance Prelude.NFData UpdateDeploymentStrategy where
  rnf :: UpdateDeploymentStrategy -> ()
rnf UpdateDeploymentStrategy' {Maybe Double
Maybe Natural
Maybe Text
Maybe GrowthType
Text
deploymentStrategyId :: Text
growthType :: Maybe GrowthType
growthFactor :: Maybe Double
finalBakeTimeInMinutes :: Maybe Natural
description :: Maybe Text
deploymentDurationInMinutes :: Maybe Natural
$sel:deploymentStrategyId:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Text
$sel:growthType:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe GrowthType
$sel:growthFactor:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Double
$sel:finalBakeTimeInMinutes:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Natural
$sel:description:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Text
$sel:deploymentDurationInMinutes:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
deploymentDurationInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
finalBakeTimeInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
growthFactor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GrowthType
growthType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deploymentStrategyId

instance Data.ToHeaders UpdateDeploymentStrategy where
  toHeaders :: UpdateDeploymentStrategy -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateDeploymentStrategy where
  toJSON :: UpdateDeploymentStrategy -> Value
toJSON UpdateDeploymentStrategy' {Maybe Double
Maybe Natural
Maybe Text
Maybe GrowthType
Text
deploymentStrategyId :: Text
growthType :: Maybe GrowthType
growthFactor :: Maybe Double
finalBakeTimeInMinutes :: Maybe Natural
description :: Maybe Text
deploymentDurationInMinutes :: Maybe Natural
$sel:deploymentStrategyId:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Text
$sel:growthType:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe GrowthType
$sel:growthFactor:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Double
$sel:finalBakeTimeInMinutes:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Natural
$sel:description:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Text
$sel:deploymentDurationInMinutes:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeploymentDurationInMinutes" 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 Natural
deploymentDurationInMinutes,
            (Key
"Description" 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
description,
            (Key
"FinalBakeTimeInMinutes" 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 Natural
finalBakeTimeInMinutes,
            (Key
"GrowthFactor" 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 Double
growthFactor,
            (Key
"GrowthType" 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 GrowthType
growthType
          ]
      )

instance Data.ToPath UpdateDeploymentStrategy where
  toPath :: UpdateDeploymentStrategy -> ByteString
toPath UpdateDeploymentStrategy' {Maybe Double
Maybe Natural
Maybe Text
Maybe GrowthType
Text
deploymentStrategyId :: Text
growthType :: Maybe GrowthType
growthFactor :: Maybe Double
finalBakeTimeInMinutes :: Maybe Natural
description :: Maybe Text
deploymentDurationInMinutes :: Maybe Natural
$sel:deploymentStrategyId:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Text
$sel:growthType:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe GrowthType
$sel:growthFactor:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Double
$sel:finalBakeTimeInMinutes:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Natural
$sel:description:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Text
$sel:deploymentDurationInMinutes:UpdateDeploymentStrategy' :: UpdateDeploymentStrategy -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/deploymentstrategies/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
deploymentStrategyId
      ]

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