{-# 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.DeleteStackInstances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes stack instances for the specified accounts, in the specified
-- Amazon Web Services Regions.
module Amazonka.CloudFormation.DeleteStackInstances
  ( -- * Creating a Request
    DeleteStackInstances (..),
    newDeleteStackInstances,

    -- * Request Lenses
    deleteStackInstances_accounts,
    deleteStackInstances_callAs,
    deleteStackInstances_deploymentTargets,
    deleteStackInstances_operationId,
    deleteStackInstances_operationPreferences,
    deleteStackInstances_stackSetName,
    deleteStackInstances_regions,
    deleteStackInstances_retainStacks,

    -- * Destructuring the Response
    DeleteStackInstancesResponse (..),
    newDeleteStackInstancesResponse,

    -- * Response Lenses
    deleteStackInstancesResponse_operationId,
    deleteStackInstancesResponse_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:/ 'newDeleteStackInstances' smart constructor.
data DeleteStackInstances = DeleteStackInstances'
  { -- | [Self-managed permissions] The names of the Amazon Web Services accounts
    -- that you want to delete stack instances for.
    --
    -- You can specify @Accounts@ or @DeploymentTargets@, but not both.
    DeleteStackInstances -> 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/.
    DeleteStackInstances -> Maybe CallAs
callAs :: Prelude.Maybe CallAs,
    -- | [Service-managed permissions] The Organizations accounts from which to
    -- delete stack instances.
    --
    -- You can specify @Accounts@ or @DeploymentTargets@, but not both.
    DeleteStackInstances -> Maybe DeploymentTargets
deploymentTargets :: Prelude.Maybe DeploymentTargets,
    -- | The unique identifier for this stack set operation.
    --
    -- If you don\'t specify an operation ID, the SDK generates one
    -- automatically.
    --
    -- 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 can retry stack set operation
    -- requests to ensure that CloudFormation successfully received them.
    --
    -- Repeating this stack set operation with a new operation ID retries all
    -- stack instances whose status is @OUTDATED@.
    DeleteStackInstances -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    -- | Preferences for how CloudFormation performs this stack set operation.
    DeleteStackInstances -> Maybe StackSetOperationPreferences
operationPreferences :: Prelude.Maybe StackSetOperationPreferences,
    -- | The name or unique ID of the stack set that you want to delete stack
    -- instances for.
    DeleteStackInstances -> Text
stackSetName :: Prelude.Text,
    -- | The Amazon Web Services Regions where you want to delete stack set
    -- instances.
    DeleteStackInstances -> [Text]
regions :: [Prelude.Text],
    -- | Removes the stack instances from the specified stack set, but doesn\'t
    -- delete the stacks. You can\'t reassociate a retained stack or add an
    -- existing, saved stack to a new stack set.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-concepts.html#stackset-ops-options Stack set operation options>.
    DeleteStackInstances -> Bool
retainStacks :: Prelude.Bool
  }
  deriving (DeleteStackInstances -> DeleteStackInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteStackInstances -> DeleteStackInstances -> Bool
$c/= :: DeleteStackInstances -> DeleteStackInstances -> Bool
== :: DeleteStackInstances -> DeleteStackInstances -> Bool
$c== :: DeleteStackInstances -> DeleteStackInstances -> Bool
Prelude.Eq, ReadPrec [DeleteStackInstances]
ReadPrec DeleteStackInstances
Int -> ReadS DeleteStackInstances
ReadS [DeleteStackInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteStackInstances]
$creadListPrec :: ReadPrec [DeleteStackInstances]
readPrec :: ReadPrec DeleteStackInstances
$creadPrec :: ReadPrec DeleteStackInstances
readList :: ReadS [DeleteStackInstances]
$creadList :: ReadS [DeleteStackInstances]
readsPrec :: Int -> ReadS DeleteStackInstances
$creadsPrec :: Int -> ReadS DeleteStackInstances
Prelude.Read, Int -> DeleteStackInstances -> ShowS
[DeleteStackInstances] -> ShowS
DeleteStackInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteStackInstances] -> ShowS
$cshowList :: [DeleteStackInstances] -> ShowS
show :: DeleteStackInstances -> String
$cshow :: DeleteStackInstances -> String
showsPrec :: Int -> DeleteStackInstances -> ShowS
$cshowsPrec :: Int -> DeleteStackInstances -> ShowS
Prelude.Show, forall x. Rep DeleteStackInstances x -> DeleteStackInstances
forall x. DeleteStackInstances -> Rep DeleteStackInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteStackInstances x -> DeleteStackInstances
$cfrom :: forall x. DeleteStackInstances -> Rep DeleteStackInstances x
Prelude.Generic)

-- |
-- Create a value of 'DeleteStackInstances' 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', 'deleteStackInstances_accounts' - [Self-managed permissions] The names of the Amazon Web Services accounts
-- that you want to delete stack instances for.
--
-- You can specify @Accounts@ or @DeploymentTargets@, but not both.
--
-- 'callAs', 'deleteStackInstances_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', 'deleteStackInstances_deploymentTargets' - [Service-managed permissions] The Organizations accounts from which to
-- delete stack instances.
--
-- You can specify @Accounts@ or @DeploymentTargets@, but not both.
--
-- 'operationId', 'deleteStackInstances_operationId' - The unique identifier for this stack set operation.
--
-- If you don\'t specify an operation ID, the SDK generates one
-- automatically.
--
-- 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 can retry stack set operation
-- requests to ensure that CloudFormation successfully received them.
--
-- Repeating this stack set operation with a new operation ID retries all
-- stack instances whose status is @OUTDATED@.
--
-- 'operationPreferences', 'deleteStackInstances_operationPreferences' - Preferences for how CloudFormation performs this stack set operation.
--
-- 'stackSetName', 'deleteStackInstances_stackSetName' - The name or unique ID of the stack set that you want to delete stack
-- instances for.
--
-- 'regions', 'deleteStackInstances_regions' - The Amazon Web Services Regions where you want to delete stack set
-- instances.
--
-- 'retainStacks', 'deleteStackInstances_retainStacks' - Removes the stack instances from the specified stack set, but doesn\'t
-- delete the stacks. You can\'t reassociate a retained stack or add an
-- existing, saved stack to a new stack set.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-concepts.html#stackset-ops-options Stack set operation options>.
newDeleteStackInstances ::
  -- | 'stackSetName'
  Prelude.Text ->
  -- | 'retainStacks'
  Prelude.Bool ->
  DeleteStackInstances
newDeleteStackInstances :: Text -> Bool -> DeleteStackInstances
newDeleteStackInstances Text
pStackSetName_ Bool
pRetainStacks_ =
  DeleteStackInstances'
    { $sel:accounts:DeleteStackInstances' :: Maybe [Text]
accounts = forall a. Maybe a
Prelude.Nothing,
      $sel:callAs:DeleteStackInstances' :: Maybe CallAs
callAs = forall a. Maybe a
Prelude.Nothing,
      $sel:deploymentTargets:DeleteStackInstances' :: Maybe DeploymentTargets
deploymentTargets = forall a. Maybe a
Prelude.Nothing,
      $sel:operationId:DeleteStackInstances' :: Maybe Text
operationId = forall a. Maybe a
Prelude.Nothing,
      $sel:operationPreferences:DeleteStackInstances' :: Maybe StackSetOperationPreferences
operationPreferences = forall a. Maybe a
Prelude.Nothing,
      $sel:stackSetName:DeleteStackInstances' :: Text
stackSetName = Text
pStackSetName_,
      $sel:regions:DeleteStackInstances' :: [Text]
regions = forall a. Monoid a => a
Prelude.mempty,
      $sel:retainStacks:DeleteStackInstances' :: Bool
retainStacks = Bool
pRetainStacks_
    }

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

-- | [Service-managed permissions] The Organizations accounts from which to
-- delete stack instances.
--
-- You can specify @Accounts@ or @DeploymentTargets@, but not both.
deleteStackInstances_deploymentTargets :: Lens.Lens' DeleteStackInstances (Prelude.Maybe DeploymentTargets)
deleteStackInstances_deploymentTargets :: Lens' DeleteStackInstances (Maybe DeploymentTargets)
deleteStackInstances_deploymentTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteStackInstances' {Maybe DeploymentTargets
deploymentTargets :: Maybe DeploymentTargets
$sel:deploymentTargets:DeleteStackInstances' :: DeleteStackInstances -> Maybe DeploymentTargets
deploymentTargets} -> Maybe DeploymentTargets
deploymentTargets) (\s :: DeleteStackInstances
s@DeleteStackInstances' {} Maybe DeploymentTargets
a -> DeleteStackInstances
s {$sel:deploymentTargets:DeleteStackInstances' :: Maybe DeploymentTargets
deploymentTargets = Maybe DeploymentTargets
a} :: DeleteStackInstances)

-- | The unique identifier for this stack set operation.
--
-- If you don\'t specify an operation ID, the SDK generates one
-- automatically.
--
-- 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 can retry stack set operation
-- requests to ensure that CloudFormation successfully received them.
--
-- Repeating this stack set operation with a new operation ID retries all
-- stack instances whose status is @OUTDATED@.
deleteStackInstances_operationId :: Lens.Lens' DeleteStackInstances (Prelude.Maybe Prelude.Text)
deleteStackInstances_operationId :: Lens' DeleteStackInstances (Maybe Text)
deleteStackInstances_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteStackInstances' {Maybe Text
operationId :: Maybe Text
$sel:operationId:DeleteStackInstances' :: DeleteStackInstances -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: DeleteStackInstances
s@DeleteStackInstances' {} Maybe Text
a -> DeleteStackInstances
s {$sel:operationId:DeleteStackInstances' :: Maybe Text
operationId = Maybe Text
a} :: DeleteStackInstances)

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

-- | The name or unique ID of the stack set that you want to delete stack
-- instances for.
deleteStackInstances_stackSetName :: Lens.Lens' DeleteStackInstances Prelude.Text
deleteStackInstances_stackSetName :: Lens' DeleteStackInstances Text
deleteStackInstances_stackSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteStackInstances' {Text
stackSetName :: Text
$sel:stackSetName:DeleteStackInstances' :: DeleteStackInstances -> Text
stackSetName} -> Text
stackSetName) (\s :: DeleteStackInstances
s@DeleteStackInstances' {} Text
a -> DeleteStackInstances
s {$sel:stackSetName:DeleteStackInstances' :: Text
stackSetName = Text
a} :: DeleteStackInstances)

-- | The Amazon Web Services Regions where you want to delete stack set
-- instances.
deleteStackInstances_regions :: Lens.Lens' DeleteStackInstances [Prelude.Text]
deleteStackInstances_regions :: Lens' DeleteStackInstances [Text]
deleteStackInstances_regions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteStackInstances' {[Text]
regions :: [Text]
$sel:regions:DeleteStackInstances' :: DeleteStackInstances -> [Text]
regions} -> [Text]
regions) (\s :: DeleteStackInstances
s@DeleteStackInstances' {} [Text]
a -> DeleteStackInstances
s {$sel:regions:DeleteStackInstances' :: [Text]
regions = [Text]
a} :: DeleteStackInstances) 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

-- | Removes the stack instances from the specified stack set, but doesn\'t
-- delete the stacks. You can\'t reassociate a retained stack or add an
-- existing, saved stack to a new stack set.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/stacksets-concepts.html#stackset-ops-options Stack set operation options>.
deleteStackInstances_retainStacks :: Lens.Lens' DeleteStackInstances Prelude.Bool
deleteStackInstances_retainStacks :: Lens' DeleteStackInstances Bool
deleteStackInstances_retainStacks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteStackInstances' {Bool
retainStacks :: Bool
$sel:retainStacks:DeleteStackInstances' :: DeleteStackInstances -> Bool
retainStacks} -> Bool
retainStacks) (\s :: DeleteStackInstances
s@DeleteStackInstances' {} Bool
a -> DeleteStackInstances
s {$sel:retainStacks:DeleteStackInstances' :: Bool
retainStacks = Bool
a} :: DeleteStackInstances)

instance Core.AWSRequest DeleteStackInstances where
  type
    AWSResponse DeleteStackInstances =
      DeleteStackInstancesResponse
  request :: (Service -> Service)
-> DeleteStackInstances -> Request DeleteStackInstances
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 DeleteStackInstances
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteStackInstances)))
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
"DeleteStackInstancesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> DeleteStackInstancesResponse
DeleteStackInstancesResponse'
            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 DeleteStackInstances where
  hashWithSalt :: Int -> DeleteStackInstances -> Int
hashWithSalt Int
_salt DeleteStackInstances' {Bool
[Text]
Maybe [Text]
Maybe Text
Maybe CallAs
Maybe DeploymentTargets
Maybe StackSetOperationPreferences
Text
retainStacks :: Bool
regions :: [Text]
stackSetName :: Text
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
deploymentTargets :: Maybe DeploymentTargets
callAs :: Maybe CallAs
accounts :: Maybe [Text]
$sel:retainStacks:DeleteStackInstances' :: DeleteStackInstances -> Bool
$sel:regions:DeleteStackInstances' :: DeleteStackInstances -> [Text]
$sel:stackSetName:DeleteStackInstances' :: DeleteStackInstances -> Text
$sel:operationPreferences:DeleteStackInstances' :: DeleteStackInstances -> Maybe StackSetOperationPreferences
$sel:operationId:DeleteStackInstances' :: DeleteStackInstances -> Maybe Text
$sel:deploymentTargets:DeleteStackInstances' :: DeleteStackInstances -> Maybe DeploymentTargets
$sel:callAs:DeleteStackInstances' :: DeleteStackInstances -> Maybe CallAs
$sel:accounts:DeleteStackInstances' :: DeleteStackInstances -> 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` Text
stackSetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
regions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
retainStacks

instance Prelude.NFData DeleteStackInstances where
  rnf :: DeleteStackInstances -> ()
rnf DeleteStackInstances' {Bool
[Text]
Maybe [Text]
Maybe Text
Maybe CallAs
Maybe DeploymentTargets
Maybe StackSetOperationPreferences
Text
retainStacks :: Bool
regions :: [Text]
stackSetName :: Text
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
deploymentTargets :: Maybe DeploymentTargets
callAs :: Maybe CallAs
accounts :: Maybe [Text]
$sel:retainStacks:DeleteStackInstances' :: DeleteStackInstances -> Bool
$sel:regions:DeleteStackInstances' :: DeleteStackInstances -> [Text]
$sel:stackSetName:DeleteStackInstances' :: DeleteStackInstances -> Text
$sel:operationPreferences:DeleteStackInstances' :: DeleteStackInstances -> Maybe StackSetOperationPreferences
$sel:operationId:DeleteStackInstances' :: DeleteStackInstances -> Maybe Text
$sel:deploymentTargets:DeleteStackInstances' :: DeleteStackInstances -> Maybe DeploymentTargets
$sel:callAs:DeleteStackInstances' :: DeleteStackInstances -> Maybe CallAs
$sel:accounts:DeleteStackInstances' :: DeleteStackInstances -> 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 Text
stackSetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
regions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
retainStacks

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

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

instance Data.ToQuery DeleteStackInstances where
  toQuery :: DeleteStackInstances -> QueryString
toQuery DeleteStackInstances' {Bool
[Text]
Maybe [Text]
Maybe Text
Maybe CallAs
Maybe DeploymentTargets
Maybe StackSetOperationPreferences
Text
retainStacks :: Bool
regions :: [Text]
stackSetName :: Text
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
deploymentTargets :: Maybe DeploymentTargets
callAs :: Maybe CallAs
accounts :: Maybe [Text]
$sel:retainStacks:DeleteStackInstances' :: DeleteStackInstances -> Bool
$sel:regions:DeleteStackInstances' :: DeleteStackInstances -> [Text]
$sel:stackSetName:DeleteStackInstances' :: DeleteStackInstances -> Text
$sel:operationPreferences:DeleteStackInstances' :: DeleteStackInstances -> Maybe StackSetOperationPreferences
$sel:operationId:DeleteStackInstances' :: DeleteStackInstances -> Maybe Text
$sel:deploymentTargets:DeleteStackInstances' :: DeleteStackInstances -> Maybe DeploymentTargets
$sel:callAs:DeleteStackInstances' :: DeleteStackInstances -> Maybe CallAs
$sel:accounts:DeleteStackInstances' :: DeleteStackInstances -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteStackInstances" :: 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
"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,
        ByteString
"RetainStacks" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Bool
retainStacks
      ]

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

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

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

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

instance Prelude.NFData DeleteStackInstancesResponse where
  rnf :: DeleteStackInstancesResponse -> ()
rnf DeleteStackInstancesResponse' {Int
Maybe Text
httpStatus :: Int
operationId :: Maybe Text
$sel:httpStatus:DeleteStackInstancesResponse' :: DeleteStackInstancesResponse -> Int
$sel:operationId:DeleteStackInstancesResponse' :: DeleteStackInstancesResponse -> 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