{-# 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.DeleteStackSet
-- 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 a stack set. Before you can delete a stack set, all its member
-- stack instances must be deleted. For more information about how to
-- complete this, see DeleteStackInstances.
module Amazonka.CloudFormation.DeleteStackSet
  ( -- * Creating a Request
    DeleteStackSet (..),
    newDeleteStackSet,

    -- * Request Lenses
    deleteStackSet_callAs,
    deleteStackSet_stackSetName,

    -- * Destructuring the Response
    DeleteStackSetResponse (..),
    newDeleteStackSetResponse,

    -- * Response Lenses
    deleteStackSetResponse_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:/ 'newDeleteStackSet' smart constructor.
data DeleteStackSet = DeleteStackSet'
  { -- | [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/.
    DeleteStackSet -> Maybe CallAs
callAs :: Prelude.Maybe CallAs,
    -- | The name or unique ID of the stack set that you\'re deleting. You can
    -- obtain this value by running ListStackSets.
    DeleteStackSet -> Text
stackSetName :: Prelude.Text
  }
  deriving (DeleteStackSet -> DeleteStackSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteStackSet -> DeleteStackSet -> Bool
$c/= :: DeleteStackSet -> DeleteStackSet -> Bool
== :: DeleteStackSet -> DeleteStackSet -> Bool
$c== :: DeleteStackSet -> DeleteStackSet -> Bool
Prelude.Eq, ReadPrec [DeleteStackSet]
ReadPrec DeleteStackSet
Int -> ReadS DeleteStackSet
ReadS [DeleteStackSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteStackSet]
$creadListPrec :: ReadPrec [DeleteStackSet]
readPrec :: ReadPrec DeleteStackSet
$creadPrec :: ReadPrec DeleteStackSet
readList :: ReadS [DeleteStackSet]
$creadList :: ReadS [DeleteStackSet]
readsPrec :: Int -> ReadS DeleteStackSet
$creadsPrec :: Int -> ReadS DeleteStackSet
Prelude.Read, Int -> DeleteStackSet -> ShowS
[DeleteStackSet] -> ShowS
DeleteStackSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteStackSet] -> ShowS
$cshowList :: [DeleteStackSet] -> ShowS
show :: DeleteStackSet -> String
$cshow :: DeleteStackSet -> String
showsPrec :: Int -> DeleteStackSet -> ShowS
$cshowsPrec :: Int -> DeleteStackSet -> ShowS
Prelude.Show, forall x. Rep DeleteStackSet x -> DeleteStackSet
forall x. DeleteStackSet -> Rep DeleteStackSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteStackSet x -> DeleteStackSet
$cfrom :: forall x. DeleteStackSet -> Rep DeleteStackSet x
Prelude.Generic)

-- |
-- Create a value of 'DeleteStackSet' 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:
--
-- 'callAs', 'deleteStackSet_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/.
--
-- 'stackSetName', 'deleteStackSet_stackSetName' - The name or unique ID of the stack set that you\'re deleting. You can
-- obtain this value by running ListStackSets.
newDeleteStackSet ::
  -- | 'stackSetName'
  Prelude.Text ->
  DeleteStackSet
newDeleteStackSet :: Text -> DeleteStackSet
newDeleteStackSet Text
pStackSetName_ =
  DeleteStackSet'
    { $sel:callAs:DeleteStackSet' :: Maybe CallAs
callAs = forall a. Maybe a
Prelude.Nothing,
      $sel:stackSetName:DeleteStackSet' :: Text
stackSetName = Text
pStackSetName_
    }

-- | [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/.
deleteStackSet_callAs :: Lens.Lens' DeleteStackSet (Prelude.Maybe CallAs)
deleteStackSet_callAs :: Lens' DeleteStackSet (Maybe CallAs)
deleteStackSet_callAs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteStackSet' {Maybe CallAs
callAs :: Maybe CallAs
$sel:callAs:DeleteStackSet' :: DeleteStackSet -> Maybe CallAs
callAs} -> Maybe CallAs
callAs) (\s :: DeleteStackSet
s@DeleteStackSet' {} Maybe CallAs
a -> DeleteStackSet
s {$sel:callAs:DeleteStackSet' :: Maybe CallAs
callAs = Maybe CallAs
a} :: DeleteStackSet)

-- | The name or unique ID of the stack set that you\'re deleting. You can
-- obtain this value by running ListStackSets.
deleteStackSet_stackSetName :: Lens.Lens' DeleteStackSet Prelude.Text
deleteStackSet_stackSetName :: Lens' DeleteStackSet Text
deleteStackSet_stackSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteStackSet' {Text
stackSetName :: Text
$sel:stackSetName:DeleteStackSet' :: DeleteStackSet -> Text
stackSetName} -> Text
stackSetName) (\s :: DeleteStackSet
s@DeleteStackSet' {} Text
a -> DeleteStackSet
s {$sel:stackSetName:DeleteStackSet' :: Text
stackSetName = Text
a} :: DeleteStackSet)

instance Core.AWSRequest DeleteStackSet where
  type
    AWSResponse DeleteStackSet =
      DeleteStackSetResponse
  request :: (Service -> Service) -> DeleteStackSet -> Request DeleteStackSet
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 DeleteStackSet
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteStackSet)))
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
"DeleteStackSetResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> DeleteStackSetResponse
DeleteStackSetResponse'
            forall (f :: * -> *) a b. Functor 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 DeleteStackSet where
  hashWithSalt :: Int -> DeleteStackSet -> Int
hashWithSalt Int
_salt DeleteStackSet' {Maybe CallAs
Text
stackSetName :: Text
callAs :: Maybe CallAs
$sel:stackSetName:DeleteStackSet' :: DeleteStackSet -> Text
$sel:callAs:DeleteStackSet' :: DeleteStackSet -> Maybe CallAs
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CallAs
callAs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackSetName

instance Prelude.NFData DeleteStackSet where
  rnf :: DeleteStackSet -> ()
rnf DeleteStackSet' {Maybe CallAs
Text
stackSetName :: Text
callAs :: Maybe CallAs
$sel:stackSetName:DeleteStackSet' :: DeleteStackSet -> Text
$sel:callAs:DeleteStackSet' :: DeleteStackSet -> Maybe CallAs
..} =
    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 Text
stackSetName

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

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

instance Data.ToQuery DeleteStackSet where
  toQuery :: DeleteStackSet -> QueryString
toQuery DeleteStackSet' {Maybe CallAs
Text
stackSetName :: Text
callAs :: Maybe CallAs
$sel:stackSetName:DeleteStackSet' :: DeleteStackSet -> Text
$sel:callAs:DeleteStackSet' :: DeleteStackSet -> Maybe CallAs
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteStackSet" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"CallAs" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CallAs
callAs,
        ByteString
"StackSetName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stackSetName
      ]

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

-- |
-- Create a value of 'DeleteStackSetResponse' 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:
--
-- 'httpStatus', 'deleteStackSetResponse_httpStatus' - The response's http status code.
newDeleteStackSetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteStackSetResponse
newDeleteStackSetResponse :: Int -> DeleteStackSetResponse
newDeleteStackSetResponse Int
pHttpStatus_ =
  DeleteStackSetResponse' {$sel:httpStatus:DeleteStackSetResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData DeleteStackSetResponse where
  rnf :: DeleteStackSetResponse -> ()
rnf DeleteStackSetResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteStackSetResponse' :: DeleteStackSetResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus