{-# 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.ServerlessApplicationRepository.CreateCloudFormationChangeSet
-- 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 an AWS CloudFormation change set for the given application.
module Amazonka.ServerlessApplicationRepository.CreateCloudFormationChangeSet
  ( -- * Creating a Request
    CreateCloudFormationChangeSet (..),
    newCreateCloudFormationChangeSet,

    -- * Request Lenses
    createCloudFormationChangeSet_capabilities,
    createCloudFormationChangeSet_changeSetName,
    createCloudFormationChangeSet_clientToken,
    createCloudFormationChangeSet_description,
    createCloudFormationChangeSet_notificationArns,
    createCloudFormationChangeSet_parameterOverrides,
    createCloudFormationChangeSet_resourceTypes,
    createCloudFormationChangeSet_rollbackConfiguration,
    createCloudFormationChangeSet_semanticVersion,
    createCloudFormationChangeSet_tags,
    createCloudFormationChangeSet_templateId,
    createCloudFormationChangeSet_applicationId,
    createCloudFormationChangeSet_stackName,

    -- * Destructuring the Response
    CreateCloudFormationChangeSetResponse (..),
    newCreateCloudFormationChangeSetResponse,

    -- * Response Lenses
    createCloudFormationChangeSetResponse_applicationId,
    createCloudFormationChangeSetResponse_changeSetId,
    createCloudFormationChangeSetResponse_semanticVersion,
    createCloudFormationChangeSetResponse_stackId,
    createCloudFormationChangeSetResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.ServerlessApplicationRepository.Types

-- | /See:/ 'newCreateCloudFormationChangeSet' smart constructor.
data CreateCloudFormationChangeSet = CreateCloudFormationChangeSet'
  { -- | A list of values that you must specify before you can deploy certain
    -- applications. Some applications might include resources that can affect
    -- permissions in your AWS account, for example, by creating new AWS
    -- Identity and Access Management (IAM) users. For those applications, you
    -- must explicitly acknowledge their capabilities by specifying this
    -- parameter.
    --
    -- The only valid values are CAPABILITY_IAM, CAPABILITY_NAMED_IAM,
    -- CAPABILITY_RESOURCE_POLICY, and CAPABILITY_AUTO_EXPAND.
    --
    -- The following resources require you to specify CAPABILITY_IAM or
    -- CAPABILITY_NAMED_IAM:
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iam-group.html AWS::IAM::Group>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-instanceprofile.html AWS::IAM::InstanceProfile>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM::Policy>,
    -- and
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-role.html AWS::IAM::Role>.
    -- If the application contains IAM resources, you can specify either
    -- CAPABILITY_IAM or CAPABILITY_NAMED_IAM. If the application contains IAM
    -- resources with custom names, you must specify CAPABILITY_NAMED_IAM.
    --
    -- The following resources require you to specify
    -- CAPABILITY_RESOURCE_POLICY:
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lambda-permission.html AWS::Lambda::Permission>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM:Policy>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-applicationautoscaling-scalingpolicy.html AWS::ApplicationAutoScaling::ScalingPolicy>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-s3-policy.html AWS::S3::BucketPolicy>,
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sqs-policy.html AWS::SQS::QueuePolicy>,
    -- and
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sns-policy.html AWS::SNS:TopicPolicy>.
    --
    -- Applications that contain one or more nested applications require you to
    -- specify CAPABILITY_AUTO_EXPAND.
    --
    -- If your application template contains any of the above resources, we
    -- recommend that you review all permissions associated with the
    -- application before deploying. If you don\'t specify this parameter for
    -- an application that requires capabilities, the call will fail.
    CreateCloudFormationChangeSet -> Maybe [Text]
capabilities :: Prelude.Maybe [Prelude.Text],
    -- | This property corresponds to the parameter of the same name for the /AWS
    -- CloudFormation
    -- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
    -- API.
    CreateCloudFormationChangeSet -> Maybe Text
changeSetName :: Prelude.Maybe Prelude.Text,
    -- | This property corresponds to the parameter of the same name for the /AWS
    -- CloudFormation
    -- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
    -- API.
    CreateCloudFormationChangeSet -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | This property corresponds to the parameter of the same name for the /AWS
    -- CloudFormation
    -- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
    -- API.
    CreateCloudFormationChangeSet -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | This property corresponds to the parameter of the same name for the /AWS
    -- CloudFormation
    -- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
    -- API.
    CreateCloudFormationChangeSet -> Maybe [Text]
notificationArns :: Prelude.Maybe [Prelude.Text],
    -- | A list of parameter values for the parameters of the application.
    CreateCloudFormationChangeSet -> Maybe [ParameterValue]
parameterOverrides :: Prelude.Maybe [ParameterValue],
    -- | This property corresponds to the parameter of the same name for the /AWS
    -- CloudFormation
    -- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
    -- API.
    CreateCloudFormationChangeSet -> Maybe [Text]
resourceTypes :: Prelude.Maybe [Prelude.Text],
    -- | This property corresponds to the parameter of the same name for the /AWS
    -- CloudFormation
    -- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
    -- API.
    CreateCloudFormationChangeSet -> Maybe RollbackConfiguration
rollbackConfiguration :: Prelude.Maybe RollbackConfiguration,
    -- | The semantic version of the application:
    --
    -- <https://semver.org/>
    CreateCloudFormationChangeSet -> Maybe Text
semanticVersion :: Prelude.Maybe Prelude.Text,
    -- | This property corresponds to the parameter of the same name for the /AWS
    -- CloudFormation
    -- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
    -- API.
    CreateCloudFormationChangeSet -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The UUID returned by CreateCloudFormationTemplate.
    --
    -- Pattern:
    -- [0-9a-fA-F]{8}\\-[0-9a-fA-F]{4}\\-[0-9a-fA-F]{4}\\-[0-9a-fA-F]{4}\\-[0-9a-fA-F]{12}
    CreateCloudFormationChangeSet -> Maybe Text
templateId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the application.
    CreateCloudFormationChangeSet -> Text
applicationId :: Prelude.Text,
    -- | This property corresponds to the parameter of the same name for the /AWS
    -- CloudFormation
    -- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
    -- API.
    CreateCloudFormationChangeSet -> Text
stackName :: Prelude.Text
  }
  deriving (CreateCloudFormationChangeSet
-> CreateCloudFormationChangeSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCloudFormationChangeSet
-> CreateCloudFormationChangeSet -> Bool
$c/= :: CreateCloudFormationChangeSet
-> CreateCloudFormationChangeSet -> Bool
== :: CreateCloudFormationChangeSet
-> CreateCloudFormationChangeSet -> Bool
$c== :: CreateCloudFormationChangeSet
-> CreateCloudFormationChangeSet -> Bool
Prelude.Eq, ReadPrec [CreateCloudFormationChangeSet]
ReadPrec CreateCloudFormationChangeSet
Int -> ReadS CreateCloudFormationChangeSet
ReadS [CreateCloudFormationChangeSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCloudFormationChangeSet]
$creadListPrec :: ReadPrec [CreateCloudFormationChangeSet]
readPrec :: ReadPrec CreateCloudFormationChangeSet
$creadPrec :: ReadPrec CreateCloudFormationChangeSet
readList :: ReadS [CreateCloudFormationChangeSet]
$creadList :: ReadS [CreateCloudFormationChangeSet]
readsPrec :: Int -> ReadS CreateCloudFormationChangeSet
$creadsPrec :: Int -> ReadS CreateCloudFormationChangeSet
Prelude.Read, Int -> CreateCloudFormationChangeSet -> ShowS
[CreateCloudFormationChangeSet] -> ShowS
CreateCloudFormationChangeSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCloudFormationChangeSet] -> ShowS
$cshowList :: [CreateCloudFormationChangeSet] -> ShowS
show :: CreateCloudFormationChangeSet -> String
$cshow :: CreateCloudFormationChangeSet -> String
showsPrec :: Int -> CreateCloudFormationChangeSet -> ShowS
$cshowsPrec :: Int -> CreateCloudFormationChangeSet -> ShowS
Prelude.Show, forall x.
Rep CreateCloudFormationChangeSet x
-> CreateCloudFormationChangeSet
forall x.
CreateCloudFormationChangeSet
-> Rep CreateCloudFormationChangeSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCloudFormationChangeSet x
-> CreateCloudFormationChangeSet
$cfrom :: forall x.
CreateCloudFormationChangeSet
-> Rep CreateCloudFormationChangeSet x
Prelude.Generic)

-- |
-- Create a value of 'CreateCloudFormationChangeSet' 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:
--
-- 'capabilities', 'createCloudFormationChangeSet_capabilities' - A list of values that you must specify before you can deploy certain
-- applications. Some applications might include resources that can affect
-- permissions in your AWS account, for example, by creating new AWS
-- Identity and Access Management (IAM) users. For those applications, you
-- must explicitly acknowledge their capabilities by specifying this
-- parameter.
--
-- The only valid values are CAPABILITY_IAM, CAPABILITY_NAMED_IAM,
-- CAPABILITY_RESOURCE_POLICY, and CAPABILITY_AUTO_EXPAND.
--
-- The following resources require you to specify CAPABILITY_IAM or
-- CAPABILITY_NAMED_IAM:
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iam-group.html AWS::IAM::Group>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-instanceprofile.html AWS::IAM::InstanceProfile>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM::Policy>,
-- and
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-role.html AWS::IAM::Role>.
-- If the application contains IAM resources, you can specify either
-- CAPABILITY_IAM or CAPABILITY_NAMED_IAM. If the application contains IAM
-- resources with custom names, you must specify CAPABILITY_NAMED_IAM.
--
-- The following resources require you to specify
-- CAPABILITY_RESOURCE_POLICY:
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lambda-permission.html AWS::Lambda::Permission>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM:Policy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-applicationautoscaling-scalingpolicy.html AWS::ApplicationAutoScaling::ScalingPolicy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-s3-policy.html AWS::S3::BucketPolicy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sqs-policy.html AWS::SQS::QueuePolicy>,
-- and
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sns-policy.html AWS::SNS:TopicPolicy>.
--
-- Applications that contain one or more nested applications require you to
-- specify CAPABILITY_AUTO_EXPAND.
--
-- If your application template contains any of the above resources, we
-- recommend that you review all permissions associated with the
-- application before deploying. If you don\'t specify this parameter for
-- an application that requires capabilities, the call will fail.
--
-- 'changeSetName', 'createCloudFormationChangeSet_changeSetName' - This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
--
-- 'clientToken', 'createCloudFormationChangeSet_clientToken' - This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
--
-- 'description', 'createCloudFormationChangeSet_description' - This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
--
-- 'notificationArns', 'createCloudFormationChangeSet_notificationArns' - This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
--
-- 'parameterOverrides', 'createCloudFormationChangeSet_parameterOverrides' - A list of parameter values for the parameters of the application.
--
-- 'resourceTypes', 'createCloudFormationChangeSet_resourceTypes' - This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
--
-- 'rollbackConfiguration', 'createCloudFormationChangeSet_rollbackConfiguration' - This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
--
-- 'semanticVersion', 'createCloudFormationChangeSet_semanticVersion' - The semantic version of the application:
--
-- <https://semver.org/>
--
-- 'tags', 'createCloudFormationChangeSet_tags' - This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
--
-- 'templateId', 'createCloudFormationChangeSet_templateId' - The UUID returned by CreateCloudFormationTemplate.
--
-- Pattern:
-- [0-9a-fA-F]{8}\\-[0-9a-fA-F]{4}\\-[0-9a-fA-F]{4}\\-[0-9a-fA-F]{4}\\-[0-9a-fA-F]{12}
--
-- 'applicationId', 'createCloudFormationChangeSet_applicationId' - The Amazon Resource Name (ARN) of the application.
--
-- 'stackName', 'createCloudFormationChangeSet_stackName' - This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
newCreateCloudFormationChangeSet ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'stackName'
  Prelude.Text ->
  CreateCloudFormationChangeSet
newCreateCloudFormationChangeSet :: Text -> Text -> CreateCloudFormationChangeSet
newCreateCloudFormationChangeSet
  Text
pApplicationId_
  Text
pStackName_ =
    CreateCloudFormationChangeSet'
      { $sel:capabilities:CreateCloudFormationChangeSet' :: Maybe [Text]
capabilities =
          forall a. Maybe a
Prelude.Nothing,
        $sel:changeSetName:CreateCloudFormationChangeSet' :: Maybe Text
changeSetName = forall a. Maybe a
Prelude.Nothing,
        $sel:clientToken:CreateCloudFormationChangeSet' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateCloudFormationChangeSet' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:notificationArns:CreateCloudFormationChangeSet' :: Maybe [Text]
notificationArns = forall a. Maybe a
Prelude.Nothing,
        $sel:parameterOverrides:CreateCloudFormationChangeSet' :: Maybe [ParameterValue]
parameterOverrides = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceTypes:CreateCloudFormationChangeSet' :: Maybe [Text]
resourceTypes = forall a. Maybe a
Prelude.Nothing,
        $sel:rollbackConfiguration:CreateCloudFormationChangeSet' :: Maybe RollbackConfiguration
rollbackConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:semanticVersion:CreateCloudFormationChangeSet' :: Maybe Text
semanticVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateCloudFormationChangeSet' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:templateId:CreateCloudFormationChangeSet' :: Maybe Text
templateId = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationId:CreateCloudFormationChangeSet' :: Text
applicationId = Text
pApplicationId_,
        $sel:stackName:CreateCloudFormationChangeSet' :: Text
stackName = Text
pStackName_
      }

-- | A list of values that you must specify before you can deploy certain
-- applications. Some applications might include resources that can affect
-- permissions in your AWS account, for example, by creating new AWS
-- Identity and Access Management (IAM) users. For those applications, you
-- must explicitly acknowledge their capabilities by specifying this
-- parameter.
--
-- The only valid values are CAPABILITY_IAM, CAPABILITY_NAMED_IAM,
-- CAPABILITY_RESOURCE_POLICY, and CAPABILITY_AUTO_EXPAND.
--
-- The following resources require you to specify CAPABILITY_IAM or
-- CAPABILITY_NAMED_IAM:
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-iam-group.html AWS::IAM::Group>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-instanceprofile.html AWS::IAM::InstanceProfile>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM::Policy>,
-- and
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-role.html AWS::IAM::Role>.
-- If the application contains IAM resources, you can specify either
-- CAPABILITY_IAM or CAPABILITY_NAMED_IAM. If the application contains IAM
-- resources with custom names, you must specify CAPABILITY_NAMED_IAM.
--
-- The following resources require you to specify
-- CAPABILITY_RESOURCE_POLICY:
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-lambda-permission.html AWS::Lambda::Permission>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-iam-policy.html AWS::IAM:Policy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-applicationautoscaling-scalingpolicy.html AWS::ApplicationAutoScaling::ScalingPolicy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-s3-policy.html AWS::S3::BucketPolicy>,
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sqs-policy.html AWS::SQS::QueuePolicy>,
-- and
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-sns-policy.html AWS::SNS:TopicPolicy>.
--
-- Applications that contain one or more nested applications require you to
-- specify CAPABILITY_AUTO_EXPAND.
--
-- If your application template contains any of the above resources, we
-- recommend that you review all permissions associated with the
-- application before deploying. If you don\'t specify this parameter for
-- an application that requires capabilities, the call will fail.
createCloudFormationChangeSet_capabilities :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe [Prelude.Text])
createCloudFormationChangeSet_capabilities :: Lens' CreateCloudFormationChangeSet (Maybe [Text])
createCloudFormationChangeSet_capabilities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe [Text]
capabilities :: Maybe [Text]
$sel:capabilities:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
capabilities} -> Maybe [Text]
capabilities) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe [Text]
a -> CreateCloudFormationChangeSet
s {$sel:capabilities:CreateCloudFormationChangeSet' :: Maybe [Text]
capabilities = Maybe [Text]
a} :: CreateCloudFormationChangeSet) 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

-- | This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
createCloudFormationChangeSet_changeSetName :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe Prelude.Text)
createCloudFormationChangeSet_changeSetName :: Lens' CreateCloudFormationChangeSet (Maybe Text)
createCloudFormationChangeSet_changeSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe Text
changeSetName :: Maybe Text
$sel:changeSetName:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
changeSetName} -> Maybe Text
changeSetName) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe Text
a -> CreateCloudFormationChangeSet
s {$sel:changeSetName:CreateCloudFormationChangeSet' :: Maybe Text
changeSetName = Maybe Text
a} :: CreateCloudFormationChangeSet)

-- | This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
createCloudFormationChangeSet_clientToken :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe Prelude.Text)
createCloudFormationChangeSet_clientToken :: Lens' CreateCloudFormationChangeSet (Maybe Text)
createCloudFormationChangeSet_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe Text
a -> CreateCloudFormationChangeSet
s {$sel:clientToken:CreateCloudFormationChangeSet' :: Maybe Text
clientToken = Maybe Text
a} :: CreateCloudFormationChangeSet)

-- | This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
createCloudFormationChangeSet_description :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe Prelude.Text)
createCloudFormationChangeSet_description :: Lens' CreateCloudFormationChangeSet (Maybe Text)
createCloudFormationChangeSet_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe Text
description :: Maybe Text
$sel:description:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe Text
a -> CreateCloudFormationChangeSet
s {$sel:description:CreateCloudFormationChangeSet' :: Maybe Text
description = Maybe Text
a} :: CreateCloudFormationChangeSet)

-- | This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
createCloudFormationChangeSet_notificationArns :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe [Prelude.Text])
createCloudFormationChangeSet_notificationArns :: Lens' CreateCloudFormationChangeSet (Maybe [Text])
createCloudFormationChangeSet_notificationArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe [Text]
notificationArns :: Maybe [Text]
$sel:notificationArns:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
notificationArns} -> Maybe [Text]
notificationArns) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe [Text]
a -> CreateCloudFormationChangeSet
s {$sel:notificationArns:CreateCloudFormationChangeSet' :: Maybe [Text]
notificationArns = Maybe [Text]
a} :: CreateCloudFormationChangeSet) 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 list of parameter values for the parameters of the application.
createCloudFormationChangeSet_parameterOverrides :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe [ParameterValue])
createCloudFormationChangeSet_parameterOverrides :: Lens' CreateCloudFormationChangeSet (Maybe [ParameterValue])
createCloudFormationChangeSet_parameterOverrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe [ParameterValue]
parameterOverrides :: Maybe [ParameterValue]
$sel:parameterOverrides:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [ParameterValue]
parameterOverrides} -> Maybe [ParameterValue]
parameterOverrides) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe [ParameterValue]
a -> CreateCloudFormationChangeSet
s {$sel:parameterOverrides:CreateCloudFormationChangeSet' :: Maybe [ParameterValue]
parameterOverrides = Maybe [ParameterValue]
a} :: CreateCloudFormationChangeSet) 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

-- | This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
createCloudFormationChangeSet_resourceTypes :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe [Prelude.Text])
createCloudFormationChangeSet_resourceTypes :: Lens' CreateCloudFormationChangeSet (Maybe [Text])
createCloudFormationChangeSet_resourceTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe [Text]
resourceTypes :: Maybe [Text]
$sel:resourceTypes:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
resourceTypes} -> Maybe [Text]
resourceTypes) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe [Text]
a -> CreateCloudFormationChangeSet
s {$sel:resourceTypes:CreateCloudFormationChangeSet' :: Maybe [Text]
resourceTypes = Maybe [Text]
a} :: CreateCloudFormationChangeSet) 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

-- | This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
createCloudFormationChangeSet_rollbackConfiguration :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe RollbackConfiguration)
createCloudFormationChangeSet_rollbackConfiguration :: Lens' CreateCloudFormationChangeSet (Maybe RollbackConfiguration)
createCloudFormationChangeSet_rollbackConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe RollbackConfiguration
rollbackConfiguration :: Maybe RollbackConfiguration
$sel:rollbackConfiguration:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe RollbackConfiguration
rollbackConfiguration} -> Maybe RollbackConfiguration
rollbackConfiguration) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe RollbackConfiguration
a -> CreateCloudFormationChangeSet
s {$sel:rollbackConfiguration:CreateCloudFormationChangeSet' :: Maybe RollbackConfiguration
rollbackConfiguration = Maybe RollbackConfiguration
a} :: CreateCloudFormationChangeSet)

-- | The semantic version of the application:
--
-- <https://semver.org/>
createCloudFormationChangeSet_semanticVersion :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe Prelude.Text)
createCloudFormationChangeSet_semanticVersion :: Lens' CreateCloudFormationChangeSet (Maybe Text)
createCloudFormationChangeSet_semanticVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe Text
semanticVersion :: Maybe Text
$sel:semanticVersion:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
semanticVersion} -> Maybe Text
semanticVersion) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe Text
a -> CreateCloudFormationChangeSet
s {$sel:semanticVersion:CreateCloudFormationChangeSet' :: Maybe Text
semanticVersion = Maybe Text
a} :: CreateCloudFormationChangeSet)

-- | This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
createCloudFormationChangeSet_tags :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe [Tag])
createCloudFormationChangeSet_tags :: Lens' CreateCloudFormationChangeSet (Maybe [Tag])
createCloudFormationChangeSet_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe [Tag]
a -> CreateCloudFormationChangeSet
s {$sel:tags:CreateCloudFormationChangeSet' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateCloudFormationChangeSet) 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 UUID returned by CreateCloudFormationTemplate.
--
-- Pattern:
-- [0-9a-fA-F]{8}\\-[0-9a-fA-F]{4}\\-[0-9a-fA-F]{4}\\-[0-9a-fA-F]{4}\\-[0-9a-fA-F]{12}
createCloudFormationChangeSet_templateId :: Lens.Lens' CreateCloudFormationChangeSet (Prelude.Maybe Prelude.Text)
createCloudFormationChangeSet_templateId :: Lens' CreateCloudFormationChangeSet (Maybe Text)
createCloudFormationChangeSet_templateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Maybe Text
templateId :: Maybe Text
$sel:templateId:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
templateId} -> Maybe Text
templateId) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Maybe Text
a -> CreateCloudFormationChangeSet
s {$sel:templateId:CreateCloudFormationChangeSet' :: Maybe Text
templateId = Maybe Text
a} :: CreateCloudFormationChangeSet)

-- | The Amazon Resource Name (ARN) of the application.
createCloudFormationChangeSet_applicationId :: Lens.Lens' CreateCloudFormationChangeSet Prelude.Text
createCloudFormationChangeSet_applicationId :: Lens' CreateCloudFormationChangeSet Text
createCloudFormationChangeSet_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Text
applicationId :: Text
$sel:applicationId:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Text
applicationId} -> Text
applicationId) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Text
a -> CreateCloudFormationChangeSet
s {$sel:applicationId:CreateCloudFormationChangeSet' :: Text
applicationId = Text
a} :: CreateCloudFormationChangeSet)

-- | This property corresponds to the parameter of the same name for the /AWS
-- CloudFormation
-- <https://docs.aws.amazon.com/goto/WebAPI/cloudformation-2010-05-15/CreateChangeSet CreateChangeSet>/
-- API.
createCloudFormationChangeSet_stackName :: Lens.Lens' CreateCloudFormationChangeSet Prelude.Text
createCloudFormationChangeSet_stackName :: Lens' CreateCloudFormationChangeSet Text
createCloudFormationChangeSet_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSet' {Text
stackName :: Text
$sel:stackName:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Text
stackName} -> Text
stackName) (\s :: CreateCloudFormationChangeSet
s@CreateCloudFormationChangeSet' {} Text
a -> CreateCloudFormationChangeSet
s {$sel:stackName:CreateCloudFormationChangeSet' :: Text
stackName = Text
a} :: CreateCloudFormationChangeSet)

instance
  Core.AWSRequest
    CreateCloudFormationChangeSet
  where
  type
    AWSResponse CreateCloudFormationChangeSet =
      CreateCloudFormationChangeSetResponse
  request :: (Service -> Service)
-> CreateCloudFormationChangeSet
-> Request CreateCloudFormationChangeSet
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 CreateCloudFormationChangeSet
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateCloudFormationChangeSet)))
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 ->
          Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> CreateCloudFormationChangeSetResponse
CreateCloudFormationChangeSetResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"applicationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"changeSetId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"semanticVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"stackId")
            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
    CreateCloudFormationChangeSet
  where
  hashWithSalt :: Int -> CreateCloudFormationChangeSet -> Int
hashWithSalt Int
_salt CreateCloudFormationChangeSet' {Maybe [Text]
Maybe [ParameterValue]
Maybe [Tag]
Maybe Text
Maybe RollbackConfiguration
Text
stackName :: Text
applicationId :: Text
templateId :: Maybe Text
tags :: Maybe [Tag]
semanticVersion :: Maybe Text
rollbackConfiguration :: Maybe RollbackConfiguration
resourceTypes :: Maybe [Text]
parameterOverrides :: Maybe [ParameterValue]
notificationArns :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
changeSetName :: Maybe Text
capabilities :: Maybe [Text]
$sel:stackName:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Text
$sel:applicationId:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Text
$sel:templateId:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:tags:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Tag]
$sel:semanticVersion:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:rollbackConfiguration:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe RollbackConfiguration
$sel:resourceTypes:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
$sel:parameterOverrides:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [ParameterValue]
$sel:notificationArns:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
$sel:description:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:clientToken:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:changeSetName:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:capabilities:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
capabilities
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
changeSetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
notificationArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ParameterValue]
parameterOverrides
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
resourceTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RollbackConfiguration
rollbackConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
semanticVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackName

instance Prelude.NFData CreateCloudFormationChangeSet where
  rnf :: CreateCloudFormationChangeSet -> ()
rnf CreateCloudFormationChangeSet' {Maybe [Text]
Maybe [ParameterValue]
Maybe [Tag]
Maybe Text
Maybe RollbackConfiguration
Text
stackName :: Text
applicationId :: Text
templateId :: Maybe Text
tags :: Maybe [Tag]
semanticVersion :: Maybe Text
rollbackConfiguration :: Maybe RollbackConfiguration
resourceTypes :: Maybe [Text]
parameterOverrides :: Maybe [ParameterValue]
notificationArns :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
changeSetName :: Maybe Text
capabilities :: Maybe [Text]
$sel:stackName:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Text
$sel:applicationId:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Text
$sel:templateId:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:tags:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Tag]
$sel:semanticVersion:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:rollbackConfiguration:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe RollbackConfiguration
$sel:resourceTypes:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
$sel:parameterOverrides:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [ParameterValue]
$sel:notificationArns:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
$sel:description:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:clientToken:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:changeSetName:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:capabilities:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
capabilities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
changeSetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      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 [Text]
notificationArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ParameterValue]
parameterOverrides
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
resourceTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RollbackConfiguration
rollbackConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
semanticVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
templateId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackName

instance Data.ToHeaders CreateCloudFormationChangeSet where
  toHeaders :: CreateCloudFormationChangeSet -> 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 CreateCloudFormationChangeSet where
  toJSON :: CreateCloudFormationChangeSet -> Value
toJSON CreateCloudFormationChangeSet' {Maybe [Text]
Maybe [ParameterValue]
Maybe [Tag]
Maybe Text
Maybe RollbackConfiguration
Text
stackName :: Text
applicationId :: Text
templateId :: Maybe Text
tags :: Maybe [Tag]
semanticVersion :: Maybe Text
rollbackConfiguration :: Maybe RollbackConfiguration
resourceTypes :: Maybe [Text]
parameterOverrides :: Maybe [ParameterValue]
notificationArns :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
changeSetName :: Maybe Text
capabilities :: Maybe [Text]
$sel:stackName:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Text
$sel:applicationId:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Text
$sel:templateId:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:tags:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Tag]
$sel:semanticVersion:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:rollbackConfiguration:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe RollbackConfiguration
$sel:resourceTypes:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
$sel:parameterOverrides:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [ParameterValue]
$sel:notificationArns:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
$sel:description:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:clientToken:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:changeSetName:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:capabilities:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"capabilities" 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]
capabilities,
            (Key
"changeSetName" 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
changeSetName,
            (Key
"clientToken" 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
clientToken,
            (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
"notificationArns" 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]
notificationArns,
            (Key
"parameterOverrides" 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 [ParameterValue]
parameterOverrides,
            (Key
"resourceTypes" 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]
resourceTypes,
            (Key
"rollbackConfiguration" 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 RollbackConfiguration
rollbackConfiguration,
            (Key
"semanticVersion" 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
semanticVersion,
            (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 [Tag]
tags,
            (Key
"templateId" 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
templateId,
            forall a. a -> Maybe a
Prelude.Just (Key
"stackName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stackName)
          ]
      )

instance Data.ToPath CreateCloudFormationChangeSet where
  toPath :: CreateCloudFormationChangeSet -> ByteString
toPath CreateCloudFormationChangeSet' {Maybe [Text]
Maybe [ParameterValue]
Maybe [Tag]
Maybe Text
Maybe RollbackConfiguration
Text
stackName :: Text
applicationId :: Text
templateId :: Maybe Text
tags :: Maybe [Tag]
semanticVersion :: Maybe Text
rollbackConfiguration :: Maybe RollbackConfiguration
resourceTypes :: Maybe [Text]
parameterOverrides :: Maybe [ParameterValue]
notificationArns :: Maybe [Text]
description :: Maybe Text
clientToken :: Maybe Text
changeSetName :: Maybe Text
capabilities :: Maybe [Text]
$sel:stackName:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Text
$sel:applicationId:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Text
$sel:templateId:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:tags:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Tag]
$sel:semanticVersion:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:rollbackConfiguration:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe RollbackConfiguration
$sel:resourceTypes:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
$sel:parameterOverrides:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [ParameterValue]
$sel:notificationArns:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
$sel:description:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:clientToken:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:changeSetName:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe Text
$sel:capabilities:CreateCloudFormationChangeSet' :: CreateCloudFormationChangeSet -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/changesets"
      ]

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

-- | /See:/ 'newCreateCloudFormationChangeSetResponse' smart constructor.
data CreateCloudFormationChangeSetResponse = CreateCloudFormationChangeSetResponse'
  { -- | The application Amazon Resource Name (ARN).
    CreateCloudFormationChangeSetResponse -> Maybe Text
applicationId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the change set.
    --
    -- Length constraints: Minimum length of 1.
    --
    -- Pattern: ARN:[-a-zA-Z0-9:\/]*
    CreateCloudFormationChangeSetResponse -> Maybe Text
changeSetId :: Prelude.Maybe Prelude.Text,
    -- | The semantic version of the application:
    --
    -- <https://semver.org/>
    CreateCloudFormationChangeSetResponse -> Maybe Text
semanticVersion :: Prelude.Maybe Prelude.Text,
    -- | The unique ID of the stack.
    CreateCloudFormationChangeSetResponse -> Maybe Text
stackId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateCloudFormationChangeSetResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateCloudFormationChangeSetResponse
-> CreateCloudFormationChangeSetResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCloudFormationChangeSetResponse
-> CreateCloudFormationChangeSetResponse -> Bool
$c/= :: CreateCloudFormationChangeSetResponse
-> CreateCloudFormationChangeSetResponse -> Bool
== :: CreateCloudFormationChangeSetResponse
-> CreateCloudFormationChangeSetResponse -> Bool
$c== :: CreateCloudFormationChangeSetResponse
-> CreateCloudFormationChangeSetResponse -> Bool
Prelude.Eq, ReadPrec [CreateCloudFormationChangeSetResponse]
ReadPrec CreateCloudFormationChangeSetResponse
Int -> ReadS CreateCloudFormationChangeSetResponse
ReadS [CreateCloudFormationChangeSetResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCloudFormationChangeSetResponse]
$creadListPrec :: ReadPrec [CreateCloudFormationChangeSetResponse]
readPrec :: ReadPrec CreateCloudFormationChangeSetResponse
$creadPrec :: ReadPrec CreateCloudFormationChangeSetResponse
readList :: ReadS [CreateCloudFormationChangeSetResponse]
$creadList :: ReadS [CreateCloudFormationChangeSetResponse]
readsPrec :: Int -> ReadS CreateCloudFormationChangeSetResponse
$creadsPrec :: Int -> ReadS CreateCloudFormationChangeSetResponse
Prelude.Read, Int -> CreateCloudFormationChangeSetResponse -> ShowS
[CreateCloudFormationChangeSetResponse] -> ShowS
CreateCloudFormationChangeSetResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCloudFormationChangeSetResponse] -> ShowS
$cshowList :: [CreateCloudFormationChangeSetResponse] -> ShowS
show :: CreateCloudFormationChangeSetResponse -> String
$cshow :: CreateCloudFormationChangeSetResponse -> String
showsPrec :: Int -> CreateCloudFormationChangeSetResponse -> ShowS
$cshowsPrec :: Int -> CreateCloudFormationChangeSetResponse -> ShowS
Prelude.Show, forall x.
Rep CreateCloudFormationChangeSetResponse x
-> CreateCloudFormationChangeSetResponse
forall x.
CreateCloudFormationChangeSetResponse
-> Rep CreateCloudFormationChangeSetResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCloudFormationChangeSetResponse x
-> CreateCloudFormationChangeSetResponse
$cfrom :: forall x.
CreateCloudFormationChangeSetResponse
-> Rep CreateCloudFormationChangeSetResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCloudFormationChangeSetResponse' 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:
--
-- 'applicationId', 'createCloudFormationChangeSetResponse_applicationId' - The application Amazon Resource Name (ARN).
--
-- 'changeSetId', 'createCloudFormationChangeSetResponse_changeSetId' - The Amazon Resource Name (ARN) of the change set.
--
-- Length constraints: Minimum length of 1.
--
-- Pattern: ARN:[-a-zA-Z0-9:\/]*
--
-- 'semanticVersion', 'createCloudFormationChangeSetResponse_semanticVersion' - The semantic version of the application:
--
-- <https://semver.org/>
--
-- 'stackId', 'createCloudFormationChangeSetResponse_stackId' - The unique ID of the stack.
--
-- 'httpStatus', 'createCloudFormationChangeSetResponse_httpStatus' - The response's http status code.
newCreateCloudFormationChangeSetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCloudFormationChangeSetResponse
newCreateCloudFormationChangeSetResponse :: Int -> CreateCloudFormationChangeSetResponse
newCreateCloudFormationChangeSetResponse Int
pHttpStatus_ =
  CreateCloudFormationChangeSetResponse'
    { $sel:applicationId:CreateCloudFormationChangeSetResponse' :: Maybe Text
applicationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:changeSetId:CreateCloudFormationChangeSetResponse' :: Maybe Text
changeSetId = forall a. Maybe a
Prelude.Nothing,
      $sel:semanticVersion:CreateCloudFormationChangeSetResponse' :: Maybe Text
semanticVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:stackId:CreateCloudFormationChangeSetResponse' :: Maybe Text
stackId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCloudFormationChangeSetResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The application Amazon Resource Name (ARN).
createCloudFormationChangeSetResponse_applicationId :: Lens.Lens' CreateCloudFormationChangeSetResponse (Prelude.Maybe Prelude.Text)
createCloudFormationChangeSetResponse_applicationId :: Lens' CreateCloudFormationChangeSetResponse (Maybe Text)
createCloudFormationChangeSetResponse_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSetResponse' {Maybe Text
applicationId :: Maybe Text
$sel:applicationId:CreateCloudFormationChangeSetResponse' :: CreateCloudFormationChangeSetResponse -> Maybe Text
applicationId} -> Maybe Text
applicationId) (\s :: CreateCloudFormationChangeSetResponse
s@CreateCloudFormationChangeSetResponse' {} Maybe Text
a -> CreateCloudFormationChangeSetResponse
s {$sel:applicationId:CreateCloudFormationChangeSetResponse' :: Maybe Text
applicationId = Maybe Text
a} :: CreateCloudFormationChangeSetResponse)

-- | The Amazon Resource Name (ARN) of the change set.
--
-- Length constraints: Minimum length of 1.
--
-- Pattern: ARN:[-a-zA-Z0-9:\/]*
createCloudFormationChangeSetResponse_changeSetId :: Lens.Lens' CreateCloudFormationChangeSetResponse (Prelude.Maybe Prelude.Text)
createCloudFormationChangeSetResponse_changeSetId :: Lens' CreateCloudFormationChangeSetResponse (Maybe Text)
createCloudFormationChangeSetResponse_changeSetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSetResponse' {Maybe Text
changeSetId :: Maybe Text
$sel:changeSetId:CreateCloudFormationChangeSetResponse' :: CreateCloudFormationChangeSetResponse -> Maybe Text
changeSetId} -> Maybe Text
changeSetId) (\s :: CreateCloudFormationChangeSetResponse
s@CreateCloudFormationChangeSetResponse' {} Maybe Text
a -> CreateCloudFormationChangeSetResponse
s {$sel:changeSetId:CreateCloudFormationChangeSetResponse' :: Maybe Text
changeSetId = Maybe Text
a} :: CreateCloudFormationChangeSetResponse)

-- | The semantic version of the application:
--
-- <https://semver.org/>
createCloudFormationChangeSetResponse_semanticVersion :: Lens.Lens' CreateCloudFormationChangeSetResponse (Prelude.Maybe Prelude.Text)
createCloudFormationChangeSetResponse_semanticVersion :: Lens' CreateCloudFormationChangeSetResponse (Maybe Text)
createCloudFormationChangeSetResponse_semanticVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSetResponse' {Maybe Text
semanticVersion :: Maybe Text
$sel:semanticVersion:CreateCloudFormationChangeSetResponse' :: CreateCloudFormationChangeSetResponse -> Maybe Text
semanticVersion} -> Maybe Text
semanticVersion) (\s :: CreateCloudFormationChangeSetResponse
s@CreateCloudFormationChangeSetResponse' {} Maybe Text
a -> CreateCloudFormationChangeSetResponse
s {$sel:semanticVersion:CreateCloudFormationChangeSetResponse' :: Maybe Text
semanticVersion = Maybe Text
a} :: CreateCloudFormationChangeSetResponse)

-- | The unique ID of the stack.
createCloudFormationChangeSetResponse_stackId :: Lens.Lens' CreateCloudFormationChangeSetResponse (Prelude.Maybe Prelude.Text)
createCloudFormationChangeSetResponse_stackId :: Lens' CreateCloudFormationChangeSetResponse (Maybe Text)
createCloudFormationChangeSetResponse_stackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCloudFormationChangeSetResponse' {Maybe Text
stackId :: Maybe Text
$sel:stackId:CreateCloudFormationChangeSetResponse' :: CreateCloudFormationChangeSetResponse -> Maybe Text
stackId} -> Maybe Text
stackId) (\s :: CreateCloudFormationChangeSetResponse
s@CreateCloudFormationChangeSetResponse' {} Maybe Text
a -> CreateCloudFormationChangeSetResponse
s {$sel:stackId:CreateCloudFormationChangeSetResponse' :: Maybe Text
stackId = Maybe Text
a} :: CreateCloudFormationChangeSetResponse)

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

instance
  Prelude.NFData
    CreateCloudFormationChangeSetResponse
  where
  rnf :: CreateCloudFormationChangeSetResponse -> ()
rnf CreateCloudFormationChangeSetResponse' {Int
Maybe Text
httpStatus :: Int
stackId :: Maybe Text
semanticVersion :: Maybe Text
changeSetId :: Maybe Text
applicationId :: Maybe Text
$sel:httpStatus:CreateCloudFormationChangeSetResponse' :: CreateCloudFormationChangeSetResponse -> Int
$sel:stackId:CreateCloudFormationChangeSetResponse' :: CreateCloudFormationChangeSetResponse -> Maybe Text
$sel:semanticVersion:CreateCloudFormationChangeSetResponse' :: CreateCloudFormationChangeSetResponse -> Maybe Text
$sel:changeSetId:CreateCloudFormationChangeSetResponse' :: CreateCloudFormationChangeSetResponse -> Maybe Text
$sel:applicationId:CreateCloudFormationChangeSetResponse' :: CreateCloudFormationChangeSetResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
changeSetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
semanticVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stackId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus