{-# 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.CloudFormation.CreateStackInstances
-- 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 stack instances for the specified accounts, within the specified
-- Amazon Web Services Regions. A stack instance refers to a stack in a
-- specific account and Region. You must specify at least one value for
-- either @Accounts@ or @DeploymentTargets@, and you must specify at least
-- one value for @Regions@.
module Amazonka.CloudFormation.CreateStackInstances
  ( -- * Creating a Request
    CreateStackInstances (..),
    newCreateStackInstances,

    -- * Request Lenses
    createStackInstances_accounts,
    createStackInstances_callAs,
    createStackInstances_deploymentTargets,
    createStackInstances_operationId,
    createStackInstances_operationPreferences,
    createStackInstances_parameterOverrides,
    createStackInstances_stackSetName,
    createStackInstances_regions,

    -- * Destructuring the Response
    CreateStackInstancesResponse (..),
    newCreateStackInstancesResponse,

    -- * Response Lenses
    createStackInstancesResponse_operationId,
    createStackInstancesResponse_httpStatus,
  )
where

import Amazonka.CloudFormation.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:/ 'newCreateStackInstances' smart constructor.
data CreateStackInstances = CreateStackInstances'
  { -- | [Self-managed permissions] The names of one or more Amazon Web Services
    -- accounts that you want to create stack instances in the specified
    -- Region(s) for.
    --
    -- You can specify @Accounts@ or @DeploymentTargets@, but not both.
    CreateStackInstances -> Maybe [Text]
accounts :: Prelude.Maybe [Prelude.Text],
    -- | [Service-managed permissions] Specifies whether you are acting as an
    -- account administrator in the organization\'s management account or as a
    -- delegated administrator in a member account.
    --
    -- By default, @SELF@ is specified. Use @SELF@ for stack sets with
    -- self-managed permissions.
    --
    -- -   If you are signed in to the management account, specify @SELF@.
    --
    -- -   If you are signed in to a delegated administrator account, specify
    --     @DELEGATED_ADMIN@.
    --
    --     Your Amazon Web Services account must be registered as a delegated
    --     administrator in the management account. For more information, see
    --     <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-orgs-delegated-admin.html Register a delegated administrator>
    --     in the /CloudFormation User Guide/.
    CreateStackInstances -> Maybe CallAs
callAs :: Prelude.Maybe CallAs,
    -- | [Service-managed permissions] The Organizations accounts for which to
    -- create stack instances in the specified Amazon Web Services Regions.
    --
    -- You can specify @Accounts@ or @DeploymentTargets@, but not both.
    CreateStackInstances -> Maybe DeploymentTargets
deploymentTargets :: Prelude.Maybe DeploymentTargets,
    -- | The unique identifier for this stack set operation.
    --
    -- The operation ID also functions as an idempotency token, to ensure that
    -- CloudFormation performs the stack set operation only once, even if you
    -- retry the request multiple times. You might retry stack set operation
    -- requests to ensure that CloudFormation successfully received them.
    --
    -- If you don\'t specify an operation ID, the SDK generates one
    -- automatically.
    --
    -- Repeating this stack set operation with a new operation ID retries all
    -- stack instances whose status is @OUTDATED@.
    CreateStackInstances -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    -- | Preferences for how CloudFormation performs this stack set operation.
    CreateStackInstances -> Maybe StackSetOperationPreferences
operationPreferences :: Prelude.Maybe StackSetOperationPreferences,
    -- | A list of stack set parameters whose values you want to override in the
    -- selected stack instances.
    --
    -- Any overridden parameter values will be applied to all stack instances
    -- in the specified accounts and Amazon Web Services Regions. When
    -- specifying parameters and their values, be aware of how CloudFormation
    -- sets parameter values during stack instance operations:
    --
    -- -   To override the current value for a parameter, include the parameter
    --     and specify its value.
    --
    -- -   To leave an overridden parameter set to its present value, include
    --     the parameter and specify @UsePreviousValue@ as @true@. (You can\'t
    --     specify both a value and set @UsePreviousValue@ to @true@.)
    --
    -- -   To set an overridden parameter back to the value specified in the
    --     stack set, specify a parameter list but don\'t include the parameter
    --     in the list.
    --
    -- -   To leave all parameters set to their present values, don\'t specify
    --     this property at all.
    --
    -- During stack set updates, any parameter values overridden for a stack
    -- instance aren\'t updated, but retain their overridden value.
    --
    -- You can only override the parameter /values/ that are specified in the
    -- stack set; to add or delete a parameter itself, use
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_UpdateStackSet.html UpdateStackSet>
    -- to update the stack set template.
    CreateStackInstances -> Maybe [Parameter]
parameterOverrides :: Prelude.Maybe [Parameter],
    -- | The name or unique ID of the stack set that you want to create stack
    -- instances from.
    CreateStackInstances -> Text
stackSetName :: Prelude.Text,
    -- | The names of one or more Amazon Web Services Regions where you want to
    -- create stack instances using the specified Amazon Web Services accounts.
    CreateStackInstances -> [Text]
regions :: [Prelude.Text]
  }
  deriving (CreateStackInstances -> CreateStackInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateStackInstances -> CreateStackInstances -> Bool
$c/= :: CreateStackInstances -> CreateStackInstances -> Bool
== :: CreateStackInstances -> CreateStackInstances -> Bool
$c== :: CreateStackInstances -> CreateStackInstances -> Bool
Prelude.Eq, ReadPrec [CreateStackInstances]
ReadPrec CreateStackInstances
Int -> ReadS CreateStackInstances
ReadS [CreateStackInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateStackInstances]
$creadListPrec :: ReadPrec [CreateStackInstances]
readPrec :: ReadPrec CreateStackInstances
$creadPrec :: ReadPrec CreateStackInstances
readList :: ReadS [CreateStackInstances]
$creadList :: ReadS [CreateStackInstances]
readsPrec :: Int -> ReadS CreateStackInstances
$creadsPrec :: Int -> ReadS CreateStackInstances
Prelude.Read, Int -> CreateStackInstances -> ShowS
[CreateStackInstances] -> ShowS
CreateStackInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateStackInstances] -> ShowS
$cshowList :: [CreateStackInstances] -> ShowS
show :: CreateStackInstances -> String
$cshow :: CreateStackInstances -> String
showsPrec :: Int -> CreateStackInstances -> ShowS
$cshowsPrec :: Int -> CreateStackInstances -> ShowS
Prelude.Show, forall x. Rep CreateStackInstances x -> CreateStackInstances
forall x. CreateStackInstances -> Rep CreateStackInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateStackInstances x -> CreateStackInstances
$cfrom :: forall x. CreateStackInstances -> Rep CreateStackInstances x
Prelude.Generic)

-- |
-- Create a value of 'CreateStackInstances' 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:
--
-- 'accounts', 'createStackInstances_accounts' - [Self-managed permissions] The names of one or more Amazon Web Services
-- accounts that you want to create stack instances in the specified
-- Region(s) for.
--
-- You can specify @Accounts@ or @DeploymentTargets@, but not both.
--
-- 'callAs', 'createStackInstances_callAs' - [Service-managed permissions] Specifies whether you are acting as an
-- account administrator in the organization\'s management account or as a
-- delegated administrator in a member account.
--
-- By default, @SELF@ is specified. Use @SELF@ for stack sets with
-- self-managed permissions.
--
-- -   If you are signed in to the management account, specify @SELF@.
--
-- -   If you are signed in to a delegated administrator account, specify
--     @DELEGATED_ADMIN@.
--
--     Your Amazon Web Services account must be registered as a delegated
--     administrator in the management account. For more information, see
--     <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-orgs-delegated-admin.html Register a delegated administrator>
--     in the /CloudFormation User Guide/.
--
-- 'deploymentTargets', 'createStackInstances_deploymentTargets' - [Service-managed permissions] The Organizations accounts for which to
-- create stack instances in the specified Amazon Web Services Regions.
--
-- You can specify @Accounts@ or @DeploymentTargets@, but not both.
--
-- 'operationId', 'createStackInstances_operationId' - The unique identifier for this stack set operation.
--
-- The operation ID also functions as an idempotency token, to ensure that
-- CloudFormation performs the stack set operation only once, even if you
-- retry the request multiple times. You might retry stack set operation
-- requests to ensure that CloudFormation successfully received them.
--
-- If you don\'t specify an operation ID, the SDK generates one
-- automatically.
--
-- Repeating this stack set operation with a new operation ID retries all
-- stack instances whose status is @OUTDATED@.
--
-- 'operationPreferences', 'createStackInstances_operationPreferences' - Preferences for how CloudFormation performs this stack set operation.
--
-- 'parameterOverrides', 'createStackInstances_parameterOverrides' - A list of stack set parameters whose values you want to override in the
-- selected stack instances.
--
-- Any overridden parameter values will be applied to all stack instances
-- in the specified accounts and Amazon Web Services Regions. When
-- specifying parameters and their values, be aware of how CloudFormation
-- sets parameter values during stack instance operations:
--
-- -   To override the current value for a parameter, include the parameter
--     and specify its value.
--
-- -   To leave an overridden parameter set to its present value, include
--     the parameter and specify @UsePreviousValue@ as @true@. (You can\'t
--     specify both a value and set @UsePreviousValue@ to @true@.)
--
-- -   To set an overridden parameter back to the value specified in the
--     stack set, specify a parameter list but don\'t include the parameter
--     in the list.
--
-- -   To leave all parameters set to their present values, don\'t specify
--     this property at all.
--
-- During stack set updates, any parameter values overridden for a stack
-- instance aren\'t updated, but retain their overridden value.
--
-- You can only override the parameter /values/ that are specified in the
-- stack set; to add or delete a parameter itself, use
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_UpdateStackSet.html UpdateStackSet>
-- to update the stack set template.
--
-- 'stackSetName', 'createStackInstances_stackSetName' - The name or unique ID of the stack set that you want to create stack
-- instances from.
--
-- 'regions', 'createStackInstances_regions' - The names of one or more Amazon Web Services Regions where you want to
-- create stack instances using the specified Amazon Web Services accounts.
newCreateStackInstances ::
  -- | 'stackSetName'
  Prelude.Text ->
  CreateStackInstances
newCreateStackInstances :: Text -> CreateStackInstances
newCreateStackInstances Text
pStackSetName_ =
  CreateStackInstances'
    { $sel:accounts:CreateStackInstances' :: Maybe [Text]
accounts = forall a. Maybe a
Prelude.Nothing,
      $sel:callAs:CreateStackInstances' :: Maybe CallAs
callAs = forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentTargets:CreateStackInstances' :: Maybe DeploymentTargets
deploymentTargets = forall a. Maybe a
Prelude.Nothing,
      $sel:operationId:CreateStackInstances' :: Maybe Text
operationId = forall a. Maybe a
Prelude.Nothing,
      $sel:operationPreferences:CreateStackInstances' :: Maybe StackSetOperationPreferences
operationPreferences = forall a. Maybe a
Prelude.Nothing,
      $sel:parameterOverrides:CreateStackInstances' :: Maybe [Parameter]
parameterOverrides = forall a. Maybe a
Prelude.Nothing,
      $sel:stackSetName:CreateStackInstances' :: Text
stackSetName = Text
pStackSetName_,
      $sel:regions:CreateStackInstances' :: [Text]
regions = forall a. Monoid a => a
Prelude.mempty
    }

-- | [Self-managed permissions] The names of one or more Amazon Web Services
-- accounts that you want to create stack instances in the specified
-- Region(s) for.
--
-- You can specify @Accounts@ or @DeploymentTargets@, but not both.
createStackInstances_accounts :: Lens.Lens' CreateStackInstances (Prelude.Maybe [Prelude.Text])
createStackInstances_accounts :: Lens' CreateStackInstances (Maybe [Text])
createStackInstances_accounts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStackInstances' {Maybe [Text]
accounts :: Maybe [Text]
$sel:accounts:CreateStackInstances' :: CreateStackInstances -> Maybe [Text]
accounts} -> Maybe [Text]
accounts) (\s :: CreateStackInstances
s@CreateStackInstances' {} Maybe [Text]
a -> CreateStackInstances
s {$sel:accounts:CreateStackInstances' :: Maybe [Text]
accounts = Maybe [Text]
a} :: CreateStackInstances) 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

-- | [Service-managed permissions] Specifies whether you are acting as an
-- account administrator in the organization\'s management account or as a
-- delegated administrator in a member account.
--
-- By default, @SELF@ is specified. Use @SELF@ for stack sets with
-- self-managed permissions.
--
-- -   If you are signed in to the management account, specify @SELF@.
--
-- -   If you are signed in to a delegated administrator account, specify
--     @DELEGATED_ADMIN@.
--
--     Your Amazon Web Services account must be registered as a delegated
--     administrator in the management account. For more information, see
--     <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-orgs-delegated-admin.html Register a delegated administrator>
--     in the /CloudFormation User Guide/.
createStackInstances_callAs :: Lens.Lens' CreateStackInstances (Prelude.Maybe CallAs)
createStackInstances_callAs :: Lens' CreateStackInstances (Maybe CallAs)
createStackInstances_callAs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStackInstances' {Maybe CallAs
callAs :: Maybe CallAs
$sel:callAs:CreateStackInstances' :: CreateStackInstances -> Maybe CallAs
callAs} -> Maybe CallAs
callAs) (\s :: CreateStackInstances
s@CreateStackInstances' {} Maybe CallAs
a -> CreateStackInstances
s {$sel:callAs:CreateStackInstances' :: Maybe CallAs
callAs = Maybe CallAs
a} :: CreateStackInstances)

-- | [Service-managed permissions] The Organizations accounts for which to
-- create stack instances in the specified Amazon Web Services Regions.
--
-- You can specify @Accounts@ or @DeploymentTargets@, but not both.
createStackInstances_deploymentTargets :: Lens.Lens' CreateStackInstances (Prelude.Maybe DeploymentTargets)
createStackInstances_deploymentTargets :: Lens' CreateStackInstances (Maybe DeploymentTargets)
createStackInstances_deploymentTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStackInstances' {Maybe DeploymentTargets
deploymentTargets :: Maybe DeploymentTargets
$sel:deploymentTargets:CreateStackInstances' :: CreateStackInstances -> Maybe DeploymentTargets
deploymentTargets} -> Maybe DeploymentTargets
deploymentTargets) (\s :: CreateStackInstances
s@CreateStackInstances' {} Maybe DeploymentTargets
a -> CreateStackInstances
s {$sel:deploymentTargets:CreateStackInstances' :: Maybe DeploymentTargets
deploymentTargets = Maybe DeploymentTargets
a} :: CreateStackInstances)

-- | The unique identifier for this stack set operation.
--
-- The operation ID also functions as an idempotency token, to ensure that
-- CloudFormation performs the stack set operation only once, even if you
-- retry the request multiple times. You might retry stack set operation
-- requests to ensure that CloudFormation successfully received them.
--
-- If you don\'t specify an operation ID, the SDK generates one
-- automatically.
--
-- Repeating this stack set operation with a new operation ID retries all
-- stack instances whose status is @OUTDATED@.
createStackInstances_operationId :: Lens.Lens' CreateStackInstances (Prelude.Maybe Prelude.Text)
createStackInstances_operationId :: Lens' CreateStackInstances (Maybe Text)
createStackInstances_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStackInstances' {Maybe Text
operationId :: Maybe Text
$sel:operationId:CreateStackInstances' :: CreateStackInstances -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: CreateStackInstances
s@CreateStackInstances' {} Maybe Text
a -> CreateStackInstances
s {$sel:operationId:CreateStackInstances' :: Maybe Text
operationId = Maybe Text
a} :: CreateStackInstances)

-- | Preferences for how CloudFormation performs this stack set operation.
createStackInstances_operationPreferences :: Lens.Lens' CreateStackInstances (Prelude.Maybe StackSetOperationPreferences)
createStackInstances_operationPreferences :: Lens' CreateStackInstances (Maybe StackSetOperationPreferences)
createStackInstances_operationPreferences = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStackInstances' {Maybe StackSetOperationPreferences
operationPreferences :: Maybe StackSetOperationPreferences
$sel:operationPreferences:CreateStackInstances' :: CreateStackInstances -> Maybe StackSetOperationPreferences
operationPreferences} -> Maybe StackSetOperationPreferences
operationPreferences) (\s :: CreateStackInstances
s@CreateStackInstances' {} Maybe StackSetOperationPreferences
a -> CreateStackInstances
s {$sel:operationPreferences:CreateStackInstances' :: Maybe StackSetOperationPreferences
operationPreferences = Maybe StackSetOperationPreferences
a} :: CreateStackInstances)

-- | A list of stack set parameters whose values you want to override in the
-- selected stack instances.
--
-- Any overridden parameter values will be applied to all stack instances
-- in the specified accounts and Amazon Web Services Regions. When
-- specifying parameters and their values, be aware of how CloudFormation
-- sets parameter values during stack instance operations:
--
-- -   To override the current value for a parameter, include the parameter
--     and specify its value.
--
-- -   To leave an overridden parameter set to its present value, include
--     the parameter and specify @UsePreviousValue@ as @true@. (You can\'t
--     specify both a value and set @UsePreviousValue@ to @true@.)
--
-- -   To set an overridden parameter back to the value specified in the
--     stack set, specify a parameter list but don\'t include the parameter
--     in the list.
--
-- -   To leave all parameters set to their present values, don\'t specify
--     this property at all.
--
-- During stack set updates, any parameter values overridden for a stack
-- instance aren\'t updated, but retain their overridden value.
--
-- You can only override the parameter /values/ that are specified in the
-- stack set; to add or delete a parameter itself, use
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/APIReference/API_UpdateStackSet.html UpdateStackSet>
-- to update the stack set template.
createStackInstances_parameterOverrides :: Lens.Lens' CreateStackInstances (Prelude.Maybe [Parameter])
createStackInstances_parameterOverrides :: Lens' CreateStackInstances (Maybe [Parameter])
createStackInstances_parameterOverrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStackInstances' {Maybe [Parameter]
parameterOverrides :: Maybe [Parameter]
$sel:parameterOverrides:CreateStackInstances' :: CreateStackInstances -> Maybe [Parameter]
parameterOverrides} -> Maybe [Parameter]
parameterOverrides) (\s :: CreateStackInstances
s@CreateStackInstances' {} Maybe [Parameter]
a -> CreateStackInstances
s {$sel:parameterOverrides:CreateStackInstances' :: Maybe [Parameter]
parameterOverrides = Maybe [Parameter]
a} :: CreateStackInstances) 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 name or unique ID of the stack set that you want to create stack
-- instances from.
createStackInstances_stackSetName :: Lens.Lens' CreateStackInstances Prelude.Text
createStackInstances_stackSetName :: Lens' CreateStackInstances Text
createStackInstances_stackSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStackInstances' {Text
stackSetName :: Text
$sel:stackSetName:CreateStackInstances' :: CreateStackInstances -> Text
stackSetName} -> Text
stackSetName) (\s :: CreateStackInstances
s@CreateStackInstances' {} Text
a -> CreateStackInstances
s {$sel:stackSetName:CreateStackInstances' :: Text
stackSetName = Text
a} :: CreateStackInstances)

-- | The names of one or more Amazon Web Services Regions where you want to
-- create stack instances using the specified Amazon Web Services accounts.
createStackInstances_regions :: Lens.Lens' CreateStackInstances [Prelude.Text]
createStackInstances_regions :: Lens' CreateStackInstances [Text]
createStackInstances_regions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStackInstances' {[Text]
regions :: [Text]
$sel:regions:CreateStackInstances' :: CreateStackInstances -> [Text]
regions} -> [Text]
regions) (\s :: CreateStackInstances
s@CreateStackInstances' {} [Text]
a -> CreateStackInstances
s {$sel:regions:CreateStackInstances' :: [Text]
regions = [Text]
a} :: CreateStackInstances) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateStackInstances where
  type
    AWSResponse CreateStackInstances =
      CreateStackInstancesResponse
  request :: (Service -> Service)
-> CreateStackInstances -> Request CreateStackInstances
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateStackInstances
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateStackInstances)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"CreateStackInstancesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> CreateStackInstancesResponse
CreateStackInstancesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"OperationId")
            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 CreateStackInstances where
  hashWithSalt :: Int -> CreateStackInstances -> Int
hashWithSalt Int
_salt CreateStackInstances' {[Text]
Maybe [Text]
Maybe [Parameter]
Maybe Text
Maybe CallAs
Maybe DeploymentTargets
Maybe StackSetOperationPreferences
Text
regions :: [Text]
stackSetName :: Text
parameterOverrides :: Maybe [Parameter]
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
deploymentTargets :: Maybe DeploymentTargets
callAs :: Maybe CallAs
accounts :: Maybe [Text]
$sel:regions:CreateStackInstances' :: CreateStackInstances -> [Text]
$sel:stackSetName:CreateStackInstances' :: CreateStackInstances -> Text
$sel:parameterOverrides:CreateStackInstances' :: CreateStackInstances -> Maybe [Parameter]
$sel:operationPreferences:CreateStackInstances' :: CreateStackInstances -> Maybe StackSetOperationPreferences
$sel:operationId:CreateStackInstances' :: CreateStackInstances -> Maybe Text
$sel:deploymentTargets:CreateStackInstances' :: CreateStackInstances -> Maybe DeploymentTargets
$sel:callAs:CreateStackInstances' :: CreateStackInstances -> Maybe CallAs
$sel:accounts:CreateStackInstances' :: CreateStackInstances -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
accounts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CallAs
callAs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeploymentTargets
deploymentTargets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
operationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StackSetOperationPreferences
operationPreferences
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Parameter]
parameterOverrides
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackSetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
regions

instance Prelude.NFData CreateStackInstances where
  rnf :: CreateStackInstances -> ()
rnf CreateStackInstances' {[Text]
Maybe [Text]
Maybe [Parameter]
Maybe Text
Maybe CallAs
Maybe DeploymentTargets
Maybe StackSetOperationPreferences
Text
regions :: [Text]
stackSetName :: Text
parameterOverrides :: Maybe [Parameter]
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
deploymentTargets :: Maybe DeploymentTargets
callAs :: Maybe CallAs
accounts :: Maybe [Text]
$sel:regions:CreateStackInstances' :: CreateStackInstances -> [Text]
$sel:stackSetName:CreateStackInstances' :: CreateStackInstances -> Text
$sel:parameterOverrides:CreateStackInstances' :: CreateStackInstances -> Maybe [Parameter]
$sel:operationPreferences:CreateStackInstances' :: CreateStackInstances -> Maybe StackSetOperationPreferences
$sel:operationId:CreateStackInstances' :: CreateStackInstances -> Maybe Text
$sel:deploymentTargets:CreateStackInstances' :: CreateStackInstances -> Maybe DeploymentTargets
$sel:callAs:CreateStackInstances' :: CreateStackInstances -> Maybe CallAs
$sel:accounts:CreateStackInstances' :: CreateStackInstances -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
accounts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CallAs
callAs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeploymentTargets
deploymentTargets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
operationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StackSetOperationPreferences
operationPreferences
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Parameter]
parameterOverrides
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackSetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
regions

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

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

instance Data.ToQuery CreateStackInstances where
  toQuery :: CreateStackInstances -> QueryString
toQuery CreateStackInstances' {[Text]
Maybe [Text]
Maybe [Parameter]
Maybe Text
Maybe CallAs
Maybe DeploymentTargets
Maybe StackSetOperationPreferences
Text
regions :: [Text]
stackSetName :: Text
parameterOverrides :: Maybe [Parameter]
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
deploymentTargets :: Maybe DeploymentTargets
callAs :: Maybe CallAs
accounts :: Maybe [Text]
$sel:regions:CreateStackInstances' :: CreateStackInstances -> [Text]
$sel:stackSetName:CreateStackInstances' :: CreateStackInstances -> Text
$sel:parameterOverrides:CreateStackInstances' :: CreateStackInstances -> Maybe [Parameter]
$sel:operationPreferences:CreateStackInstances' :: CreateStackInstances -> Maybe StackSetOperationPreferences
$sel:operationId:CreateStackInstances' :: CreateStackInstances -> Maybe Text
$sel:deploymentTargets:CreateStackInstances' :: CreateStackInstances -> Maybe DeploymentTargets
$sel:callAs:CreateStackInstances' :: CreateStackInstances -> Maybe CallAs
$sel:accounts:CreateStackInstances' :: CreateStackInstances -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateStackInstances" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"Accounts"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
accounts),
        ByteString
"CallAs" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CallAs
callAs,
        ByteString
"DeploymentTargets" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe DeploymentTargets
deploymentTargets,
        ByteString
"OperationId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
operationId,
        ByteString
"OperationPreferences" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe StackSetOperationPreferences
operationPreferences,
        ByteString
"ParameterOverrides"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Parameter]
parameterOverrides
            ),
        ByteString
"StackSetName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stackSetName,
        ByteString
"Regions" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Text]
regions
      ]

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

-- |
-- Create a value of 'CreateStackInstancesResponse' 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:
--
-- 'operationId', 'createStackInstancesResponse_operationId' - The unique identifier for this stack set operation.
--
-- 'httpStatus', 'createStackInstancesResponse_httpStatus' - The response's http status code.
newCreateStackInstancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateStackInstancesResponse
newCreateStackInstancesResponse :: Int -> CreateStackInstancesResponse
newCreateStackInstancesResponse Int
pHttpStatus_ =
  CreateStackInstancesResponse'
    { $sel:operationId:CreateStackInstancesResponse' :: Maybe Text
operationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateStackInstancesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique identifier for this stack set operation.
createStackInstancesResponse_operationId :: Lens.Lens' CreateStackInstancesResponse (Prelude.Maybe Prelude.Text)
createStackInstancesResponse_operationId :: Lens' CreateStackInstancesResponse (Maybe Text)
createStackInstancesResponse_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateStackInstancesResponse' {Maybe Text
operationId :: Maybe Text
$sel:operationId:CreateStackInstancesResponse' :: CreateStackInstancesResponse -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: CreateStackInstancesResponse
s@CreateStackInstancesResponse' {} Maybe Text
a -> CreateStackInstancesResponse
s {$sel:operationId:CreateStackInstancesResponse' :: Maybe Text
operationId = Maybe Text
a} :: CreateStackInstancesResponse)

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

instance Prelude.NFData CreateStackInstancesResponse where
  rnf :: CreateStackInstancesResponse -> ()
rnf CreateStackInstancesResponse' {Int
Maybe Text
httpStatus :: Int
operationId :: Maybe Text
$sel:httpStatus:CreateStackInstancesResponse' :: CreateStackInstancesResponse -> Int
$sel:operationId:CreateStackInstancesResponse' :: CreateStackInstancesResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
operationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus