{-# 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.CreateDeploymentStrategy
-- 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 deployment strategy that defines important criteria for
-- rolling out your configuration to the designated targets. A deployment
-- strategy includes the overall duration required, a percentage of targets
-- to receive the deployment during each interval, an algorithm that
-- defines how percentage grows, and bake time.
module Amazonka.AppConfig.CreateDeploymentStrategy
  ( -- * Creating a Request
    CreateDeploymentStrategy (..),
    newCreateDeploymentStrategy,

    -- * Request Lenses
    createDeploymentStrategy_description,
    createDeploymentStrategy_finalBakeTimeInMinutes,
    createDeploymentStrategy_growthType,
    createDeploymentStrategy_replicateTo,
    createDeploymentStrategy_tags,
    createDeploymentStrategy_name,
    createDeploymentStrategy_deploymentDurationInMinutes,
    createDeploymentStrategy_growthFactor,

    -- * 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:/ 'newCreateDeploymentStrategy' smart constructor.
data CreateDeploymentStrategy = CreateDeploymentStrategy'
  { -- | A description of the deployment strategy.
    CreateDeploymentStrategy -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Specifies the amount of time AppConfig monitors for Amazon CloudWatch
    -- alarms after the configuration has been deployed to 100% of its targets,
    -- before considering the deployment to be complete. If an alarm is
    -- triggered during this time, AppConfig rolls back the deployment. You
    -- must configure permissions for AppConfig to roll back based on
    -- CloudWatch alarms. For more information, see
    -- <https://docs.aws.amazon.com/appconfig/latest/userguide/getting-started-with-appconfig-cloudwatch-alarms-permissions.html Configuring permissions for rollback based on Amazon CloudWatch alarms>
    -- in the /AppConfig User Guide/.
    CreateDeploymentStrategy -> Maybe Natural
finalBakeTimeInMinutes :: Prelude.Maybe Prelude.Natural,
    -- | 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
    -- dividing the total number of targets by the value specified for
    -- @Step percentage@. For example, a linear deployment that uses a
    -- @Step percentage@ of 10 deploys the configuration to 10 percent of the
    -- hosts. After those deployments are complete, the system deploys the
    -- configuration to the next 10 percent. This continues until 100% of the
    -- targets have successfully received the 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.
    CreateDeploymentStrategy -> Maybe GrowthType
growthType :: Prelude.Maybe GrowthType,
    -- | Save the deployment strategy to a Systems Manager (SSM) document.
    CreateDeploymentStrategy -> Maybe ReplicateTo
replicateTo :: Prelude.Maybe ReplicateTo,
    -- | Metadata to assign to the deployment strategy. Tags help organize and
    -- categorize your AppConfig resources. Each tag consists of a key and an
    -- optional value, both of which you define.
    CreateDeploymentStrategy -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A name for the deployment strategy.
    CreateDeploymentStrategy -> Text
name :: Prelude.Text,
    -- | Total amount of time for a deployment to last.
    CreateDeploymentStrategy -> Natural
deploymentDurationInMinutes :: Prelude.Natural,
    -- | The percentage of targets to receive a deployed configuration during
    -- each interval.
    CreateDeploymentStrategy -> Double
growthFactor :: Prelude.Double
  }
  deriving (CreateDeploymentStrategy -> CreateDeploymentStrategy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeploymentStrategy -> CreateDeploymentStrategy -> Bool
$c/= :: CreateDeploymentStrategy -> CreateDeploymentStrategy -> Bool
== :: CreateDeploymentStrategy -> CreateDeploymentStrategy -> Bool
$c== :: CreateDeploymentStrategy -> CreateDeploymentStrategy -> Bool
Prelude.Eq, ReadPrec [CreateDeploymentStrategy]
ReadPrec CreateDeploymentStrategy
Int -> ReadS CreateDeploymentStrategy
ReadS [CreateDeploymentStrategy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDeploymentStrategy]
$creadListPrec :: ReadPrec [CreateDeploymentStrategy]
readPrec :: ReadPrec CreateDeploymentStrategy
$creadPrec :: ReadPrec CreateDeploymentStrategy
readList :: ReadS [CreateDeploymentStrategy]
$creadList :: ReadS [CreateDeploymentStrategy]
readsPrec :: Int -> ReadS CreateDeploymentStrategy
$creadsPrec :: Int -> ReadS CreateDeploymentStrategy
Prelude.Read, Int -> CreateDeploymentStrategy -> ShowS
[CreateDeploymentStrategy] -> ShowS
CreateDeploymentStrategy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeploymentStrategy] -> ShowS
$cshowList :: [CreateDeploymentStrategy] -> ShowS
show :: CreateDeploymentStrategy -> String
$cshow :: CreateDeploymentStrategy -> String
showsPrec :: Int -> CreateDeploymentStrategy -> ShowS
$cshowsPrec :: Int -> CreateDeploymentStrategy -> ShowS
Prelude.Show, forall x.
Rep CreateDeploymentStrategy x -> CreateDeploymentStrategy
forall x.
CreateDeploymentStrategy -> Rep CreateDeploymentStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDeploymentStrategy x -> CreateDeploymentStrategy
$cfrom :: forall x.
CreateDeploymentStrategy -> Rep CreateDeploymentStrategy x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeploymentStrategy' 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:
--
-- 'description', 'createDeploymentStrategy_description' - A description of the deployment strategy.
--
-- 'finalBakeTimeInMinutes', 'createDeploymentStrategy_finalBakeTimeInMinutes' - Specifies the amount of time AppConfig monitors for Amazon CloudWatch
-- alarms after the configuration has been deployed to 100% of its targets,
-- before considering the deployment to be complete. If an alarm is
-- triggered during this time, AppConfig rolls back the deployment. You
-- must configure permissions for AppConfig to roll back based on
-- CloudWatch alarms. For more information, see
-- <https://docs.aws.amazon.com/appconfig/latest/userguide/getting-started-with-appconfig-cloudwatch-alarms-permissions.html Configuring permissions for rollback based on Amazon CloudWatch alarms>
-- in the /AppConfig User Guide/.
--
-- 'growthType', 'createDeploymentStrategy_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
-- dividing the total number of targets by the value specified for
-- @Step percentage@. For example, a linear deployment that uses a
-- @Step percentage@ of 10 deploys the configuration to 10 percent of the
-- hosts. After those deployments are complete, the system deploys the
-- configuration to the next 10 percent. This continues until 100% of the
-- targets have successfully received the 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.
--
-- 'replicateTo', 'createDeploymentStrategy_replicateTo' - Save the deployment strategy to a Systems Manager (SSM) document.
--
-- 'tags', 'createDeploymentStrategy_tags' - Metadata to assign to the deployment strategy. Tags help organize and
-- categorize your AppConfig resources. Each tag consists of a key and an
-- optional value, both of which you define.
--
-- 'name', 'createDeploymentStrategy_name' - A name for the deployment strategy.
--
-- 'deploymentDurationInMinutes', 'createDeploymentStrategy_deploymentDurationInMinutes' - Total amount of time for a deployment to last.
--
-- 'growthFactor', 'createDeploymentStrategy_growthFactor' - The percentage of targets to receive a deployed configuration during
-- each interval.
newCreateDeploymentStrategy ::
  -- | 'name'
  Prelude.Text ->
  -- | 'deploymentDurationInMinutes'
  Prelude.Natural ->
  -- | 'growthFactor'
  Prelude.Double ->
  CreateDeploymentStrategy
newCreateDeploymentStrategy :: Text -> Natural -> Double -> CreateDeploymentStrategy
newCreateDeploymentStrategy
  Text
pName_
  Natural
pDeploymentDurationInMinutes_
  Double
pGrowthFactor_ =
    CreateDeploymentStrategy'
      { $sel:description:CreateDeploymentStrategy' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:finalBakeTimeInMinutes:CreateDeploymentStrategy' :: Maybe Natural
finalBakeTimeInMinutes = forall a. Maybe a
Prelude.Nothing,
        $sel:growthType:CreateDeploymentStrategy' :: Maybe GrowthType
growthType = forall a. Maybe a
Prelude.Nothing,
        $sel:replicateTo:CreateDeploymentStrategy' :: Maybe ReplicateTo
replicateTo = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDeploymentStrategy' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateDeploymentStrategy' :: Text
name = Text
pName_,
        $sel:deploymentDurationInMinutes:CreateDeploymentStrategy' :: Natural
deploymentDurationInMinutes =
          Natural
pDeploymentDurationInMinutes_,
        $sel:growthFactor:CreateDeploymentStrategy' :: Double
growthFactor = Double
pGrowthFactor_
      }

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

-- | Specifies the amount of time AppConfig monitors for Amazon CloudWatch
-- alarms after the configuration has been deployed to 100% of its targets,
-- before considering the deployment to be complete. If an alarm is
-- triggered during this time, AppConfig rolls back the deployment. You
-- must configure permissions for AppConfig to roll back based on
-- CloudWatch alarms. For more information, see
-- <https://docs.aws.amazon.com/appconfig/latest/userguide/getting-started-with-appconfig-cloudwatch-alarms-permissions.html Configuring permissions for rollback based on Amazon CloudWatch alarms>
-- in the /AppConfig User Guide/.
createDeploymentStrategy_finalBakeTimeInMinutes :: Lens.Lens' CreateDeploymentStrategy (Prelude.Maybe Prelude.Natural)
createDeploymentStrategy_finalBakeTimeInMinutes :: Lens' CreateDeploymentStrategy (Maybe Natural)
createDeploymentStrategy_finalBakeTimeInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentStrategy' {Maybe Natural
finalBakeTimeInMinutes :: Maybe Natural
$sel:finalBakeTimeInMinutes:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe Natural
finalBakeTimeInMinutes} -> Maybe Natural
finalBakeTimeInMinutes) (\s :: CreateDeploymentStrategy
s@CreateDeploymentStrategy' {} Maybe Natural
a -> CreateDeploymentStrategy
s {$sel:finalBakeTimeInMinutes:CreateDeploymentStrategy' :: Maybe Natural
finalBakeTimeInMinutes = Maybe Natural
a} :: CreateDeploymentStrategy)

-- | 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
-- dividing the total number of targets by the value specified for
-- @Step percentage@. For example, a linear deployment that uses a
-- @Step percentage@ of 10 deploys the configuration to 10 percent of the
-- hosts. After those deployments are complete, the system deploys the
-- configuration to the next 10 percent. This continues until 100% of the
-- targets have successfully received the 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.
createDeploymentStrategy_growthType :: Lens.Lens' CreateDeploymentStrategy (Prelude.Maybe GrowthType)
createDeploymentStrategy_growthType :: Lens' CreateDeploymentStrategy (Maybe GrowthType)
createDeploymentStrategy_growthType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentStrategy' {Maybe GrowthType
growthType :: Maybe GrowthType
$sel:growthType:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe GrowthType
growthType} -> Maybe GrowthType
growthType) (\s :: CreateDeploymentStrategy
s@CreateDeploymentStrategy' {} Maybe GrowthType
a -> CreateDeploymentStrategy
s {$sel:growthType:CreateDeploymentStrategy' :: Maybe GrowthType
growthType = Maybe GrowthType
a} :: CreateDeploymentStrategy)

-- | Save the deployment strategy to a Systems Manager (SSM) document.
createDeploymentStrategy_replicateTo :: Lens.Lens' CreateDeploymentStrategy (Prelude.Maybe ReplicateTo)
createDeploymentStrategy_replicateTo :: Lens' CreateDeploymentStrategy (Maybe ReplicateTo)
createDeploymentStrategy_replicateTo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentStrategy' {Maybe ReplicateTo
replicateTo :: Maybe ReplicateTo
$sel:replicateTo:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe ReplicateTo
replicateTo} -> Maybe ReplicateTo
replicateTo) (\s :: CreateDeploymentStrategy
s@CreateDeploymentStrategy' {} Maybe ReplicateTo
a -> CreateDeploymentStrategy
s {$sel:replicateTo:CreateDeploymentStrategy' :: Maybe ReplicateTo
replicateTo = Maybe ReplicateTo
a} :: CreateDeploymentStrategy)

-- | Metadata to assign to the deployment strategy. Tags help organize and
-- categorize your AppConfig resources. Each tag consists of a key and an
-- optional value, both of which you define.
createDeploymentStrategy_tags :: Lens.Lens' CreateDeploymentStrategy (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createDeploymentStrategy_tags :: Lens' CreateDeploymentStrategy (Maybe (HashMap Text Text))
createDeploymentStrategy_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentStrategy' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateDeploymentStrategy
s@CreateDeploymentStrategy' {} Maybe (HashMap Text Text)
a -> CreateDeploymentStrategy
s {$sel:tags:CreateDeploymentStrategy' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateDeploymentStrategy) 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

-- | A name for the deployment strategy.
createDeploymentStrategy_name :: Lens.Lens' CreateDeploymentStrategy Prelude.Text
createDeploymentStrategy_name :: Lens' CreateDeploymentStrategy Text
createDeploymentStrategy_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentStrategy' {Text
name :: Text
$sel:name:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Text
name} -> Text
name) (\s :: CreateDeploymentStrategy
s@CreateDeploymentStrategy' {} Text
a -> CreateDeploymentStrategy
s {$sel:name:CreateDeploymentStrategy' :: Text
name = Text
a} :: CreateDeploymentStrategy)

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

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

instance Core.AWSRequest CreateDeploymentStrategy where
  type
    AWSResponse CreateDeploymentStrategy =
      DeploymentStrategy
  request :: (Service -> Service)
-> CreateDeploymentStrategy -> Request CreateDeploymentStrategy
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 CreateDeploymentStrategy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDeploymentStrategy)))
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 CreateDeploymentStrategy where
  hashWithSalt :: Int -> CreateDeploymentStrategy -> Int
hashWithSalt Int
_salt CreateDeploymentStrategy' {Double
Natural
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe GrowthType
Maybe ReplicateTo
Text
growthFactor :: Double
deploymentDurationInMinutes :: Natural
name :: Text
tags :: Maybe (HashMap Text Text)
replicateTo :: Maybe ReplicateTo
growthType :: Maybe GrowthType
finalBakeTimeInMinutes :: Maybe Natural
description :: Maybe Text
$sel:growthFactor:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Double
$sel:deploymentDurationInMinutes:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Natural
$sel:name:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Text
$sel:tags:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe (HashMap Text Text)
$sel:replicateTo:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe ReplicateTo
$sel:growthType:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe GrowthType
$sel:finalBakeTimeInMinutes:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe Natural
$sel:description:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe Text
..} =
    Int
_salt
      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 GrowthType
growthType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReplicateTo
replicateTo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
deploymentDurationInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Double
growthFactor

instance Prelude.NFData CreateDeploymentStrategy where
  rnf :: CreateDeploymentStrategy -> ()
rnf CreateDeploymentStrategy' {Double
Natural
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe GrowthType
Maybe ReplicateTo
Text
growthFactor :: Double
deploymentDurationInMinutes :: Natural
name :: Text
tags :: Maybe (HashMap Text Text)
replicateTo :: Maybe ReplicateTo
growthType :: Maybe GrowthType
finalBakeTimeInMinutes :: Maybe Natural
description :: Maybe Text
$sel:growthFactor:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Double
$sel:deploymentDurationInMinutes:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Natural
$sel:name:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Text
$sel:tags:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe (HashMap Text Text)
$sel:replicateTo:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe ReplicateTo
$sel:growthType:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe GrowthType
$sel:finalBakeTimeInMinutes:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe Natural
$sel:description:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe Text
..} =
    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 GrowthType
growthType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReplicateTo
replicateTo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
deploymentDurationInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Double
growthFactor

instance Data.ToHeaders CreateDeploymentStrategy where
  toHeaders :: CreateDeploymentStrategy -> 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 CreateDeploymentStrategy where
  toJSON :: CreateDeploymentStrategy -> Value
toJSON CreateDeploymentStrategy' {Double
Natural
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe GrowthType
Maybe ReplicateTo
Text
growthFactor :: Double
deploymentDurationInMinutes :: Natural
name :: Text
tags :: Maybe (HashMap Text Text)
replicateTo :: Maybe ReplicateTo
growthType :: Maybe GrowthType
finalBakeTimeInMinutes :: Maybe Natural
description :: Maybe Text
$sel:growthFactor:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Double
$sel:deploymentDurationInMinutes:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Natural
$sel:name:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Text
$sel:tags:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe (HashMap Text Text)
$sel:replicateTo:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe ReplicateTo
$sel:growthType:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe GrowthType
$sel:finalBakeTimeInMinutes:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe Natural
$sel:description:CreateDeploymentStrategy' :: CreateDeploymentStrategy -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"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,
            (Key
"ReplicateTo" 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 ReplicateTo
replicateTo,
            (Key
"Tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"DeploymentDurationInMinutes"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
deploymentDurationInMinutes
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"GrowthFactor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Double
growthFactor)
          ]
      )

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

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