{-# 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.AutoScaling.DeleteAutoScalingGroup
-- 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 the specified Auto Scaling group.
--
-- If the group has instances or scaling activities in progress, you must
-- specify the option to force the deletion in order for it to succeed. The
-- force delete operation will also terminate the EC2 instances. If the
-- group has a warm pool, the force delete option also deletes the warm
-- pool.
--
-- To remove instances from the Auto Scaling group before deleting it, call
-- the DetachInstances API with the list of instances and the option to
-- decrement the desired capacity. This ensures that Amazon EC2 Auto
-- Scaling does not launch replacement instances.
--
-- To terminate all instances before deleting the Auto Scaling group, call
-- the UpdateAutoScalingGroup API and set the minimum size and desired
-- capacity of the Auto Scaling group to zero.
--
-- If the group has scaling policies, deleting the group deletes the
-- policies, the underlying alarm actions, and any alarm that no longer has
-- an associated action.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/as-process-shutdown.html Delete your Auto Scaling infrastructure>
-- in the /Amazon EC2 Auto Scaling User Guide/.
module Amazonka.AutoScaling.DeleteAutoScalingGroup
  ( -- * Creating a Request
    DeleteAutoScalingGroup (..),
    newDeleteAutoScalingGroup,

    -- * Request Lenses
    deleteAutoScalingGroup_forceDelete,
    deleteAutoScalingGroup_autoScalingGroupName,

    -- * Destructuring the Response
    DeleteAutoScalingGroupResponse (..),
    newDeleteAutoScalingGroupResponse,
  )
where

import Amazonka.AutoScaling.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:/ 'newDeleteAutoScalingGroup' smart constructor.
data DeleteAutoScalingGroup = DeleteAutoScalingGroup'
  { -- | Specifies that the group is to be deleted along with all instances
    -- associated with the group, without waiting for all instances to be
    -- terminated. This action also deletes any outstanding lifecycle actions
    -- associated with the group.
    DeleteAutoScalingGroup -> Maybe Bool
forceDelete :: Prelude.Maybe Prelude.Bool,
    -- | The name of the Auto Scaling group.
    DeleteAutoScalingGroup -> Text
autoScalingGroupName :: Prelude.Text
  }
  deriving (DeleteAutoScalingGroup -> DeleteAutoScalingGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteAutoScalingGroup -> DeleteAutoScalingGroup -> Bool
$c/= :: DeleteAutoScalingGroup -> DeleteAutoScalingGroup -> Bool
== :: DeleteAutoScalingGroup -> DeleteAutoScalingGroup -> Bool
$c== :: DeleteAutoScalingGroup -> DeleteAutoScalingGroup -> Bool
Prelude.Eq, ReadPrec [DeleteAutoScalingGroup]
ReadPrec DeleteAutoScalingGroup
Int -> ReadS DeleteAutoScalingGroup
ReadS [DeleteAutoScalingGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteAutoScalingGroup]
$creadListPrec :: ReadPrec [DeleteAutoScalingGroup]
readPrec :: ReadPrec DeleteAutoScalingGroup
$creadPrec :: ReadPrec DeleteAutoScalingGroup
readList :: ReadS [DeleteAutoScalingGroup]
$creadList :: ReadS [DeleteAutoScalingGroup]
readsPrec :: Int -> ReadS DeleteAutoScalingGroup
$creadsPrec :: Int -> ReadS DeleteAutoScalingGroup
Prelude.Read, Int -> DeleteAutoScalingGroup -> ShowS
[DeleteAutoScalingGroup] -> ShowS
DeleteAutoScalingGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteAutoScalingGroup] -> ShowS
$cshowList :: [DeleteAutoScalingGroup] -> ShowS
show :: DeleteAutoScalingGroup -> String
$cshow :: DeleteAutoScalingGroup -> String
showsPrec :: Int -> DeleteAutoScalingGroup -> ShowS
$cshowsPrec :: Int -> DeleteAutoScalingGroup -> ShowS
Prelude.Show, forall x. Rep DeleteAutoScalingGroup x -> DeleteAutoScalingGroup
forall x. DeleteAutoScalingGroup -> Rep DeleteAutoScalingGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteAutoScalingGroup x -> DeleteAutoScalingGroup
$cfrom :: forall x. DeleteAutoScalingGroup -> Rep DeleteAutoScalingGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteAutoScalingGroup' 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:
--
-- 'forceDelete', 'deleteAutoScalingGroup_forceDelete' - Specifies that the group is to be deleted along with all instances
-- associated with the group, without waiting for all instances to be
-- terminated. This action also deletes any outstanding lifecycle actions
-- associated with the group.
--
-- 'autoScalingGroupName', 'deleteAutoScalingGroup_autoScalingGroupName' - The name of the Auto Scaling group.
newDeleteAutoScalingGroup ::
  -- | 'autoScalingGroupName'
  Prelude.Text ->
  DeleteAutoScalingGroup
newDeleteAutoScalingGroup :: Text -> DeleteAutoScalingGroup
newDeleteAutoScalingGroup Text
pAutoScalingGroupName_ =
  DeleteAutoScalingGroup'
    { $sel:forceDelete:DeleteAutoScalingGroup' :: Maybe Bool
forceDelete =
        forall a. Maybe a
Prelude.Nothing,
      $sel:autoScalingGroupName:DeleteAutoScalingGroup' :: Text
autoScalingGroupName = Text
pAutoScalingGroupName_
    }

-- | Specifies that the group is to be deleted along with all instances
-- associated with the group, without waiting for all instances to be
-- terminated. This action also deletes any outstanding lifecycle actions
-- associated with the group.
deleteAutoScalingGroup_forceDelete :: Lens.Lens' DeleteAutoScalingGroup (Prelude.Maybe Prelude.Bool)
deleteAutoScalingGroup_forceDelete :: Lens' DeleteAutoScalingGroup (Maybe Bool)
deleteAutoScalingGroup_forceDelete = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAutoScalingGroup' {Maybe Bool
forceDelete :: Maybe Bool
$sel:forceDelete:DeleteAutoScalingGroup' :: DeleteAutoScalingGroup -> Maybe Bool
forceDelete} -> Maybe Bool
forceDelete) (\s :: DeleteAutoScalingGroup
s@DeleteAutoScalingGroup' {} Maybe Bool
a -> DeleteAutoScalingGroup
s {$sel:forceDelete:DeleteAutoScalingGroup' :: Maybe Bool
forceDelete = Maybe Bool
a} :: DeleteAutoScalingGroup)

-- | The name of the Auto Scaling group.
deleteAutoScalingGroup_autoScalingGroupName :: Lens.Lens' DeleteAutoScalingGroup Prelude.Text
deleteAutoScalingGroup_autoScalingGroupName :: Lens' DeleteAutoScalingGroup Text
deleteAutoScalingGroup_autoScalingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAutoScalingGroup' {Text
autoScalingGroupName :: Text
$sel:autoScalingGroupName:DeleteAutoScalingGroup' :: DeleteAutoScalingGroup -> Text
autoScalingGroupName} -> Text
autoScalingGroupName) (\s :: DeleteAutoScalingGroup
s@DeleteAutoScalingGroup' {} Text
a -> DeleteAutoScalingGroup
s {$sel:autoScalingGroupName:DeleteAutoScalingGroup' :: Text
autoScalingGroupName = Text
a} :: DeleteAutoScalingGroup)

instance Core.AWSRequest DeleteAutoScalingGroup where
  type
    AWSResponse DeleteAutoScalingGroup =
      DeleteAutoScalingGroupResponse
  request :: (Service -> Service)
-> DeleteAutoScalingGroup -> Request DeleteAutoScalingGroup
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 DeleteAutoScalingGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteAutoScalingGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteAutoScalingGroupResponse
DeleteAutoScalingGroupResponse'

instance Prelude.Hashable DeleteAutoScalingGroup where
  hashWithSalt :: Int -> DeleteAutoScalingGroup -> Int
hashWithSalt Int
_salt DeleteAutoScalingGroup' {Maybe Bool
Text
autoScalingGroupName :: Text
forceDelete :: Maybe Bool
$sel:autoScalingGroupName:DeleteAutoScalingGroup' :: DeleteAutoScalingGroup -> Text
$sel:forceDelete:DeleteAutoScalingGroup' :: DeleteAutoScalingGroup -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
forceDelete
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
autoScalingGroupName

instance Prelude.NFData DeleteAutoScalingGroup where
  rnf :: DeleteAutoScalingGroup -> ()
rnf DeleteAutoScalingGroup' {Maybe Bool
Text
autoScalingGroupName :: Text
forceDelete :: Maybe Bool
$sel:autoScalingGroupName:DeleteAutoScalingGroup' :: DeleteAutoScalingGroup -> Text
$sel:forceDelete:DeleteAutoScalingGroup' :: DeleteAutoScalingGroup -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
forceDelete
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
autoScalingGroupName

instance Data.ToHeaders DeleteAutoScalingGroup where
  toHeaders :: DeleteAutoScalingGroup -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DeleteAutoScalingGroup where
  toQuery :: DeleteAutoScalingGroup -> QueryString
toQuery DeleteAutoScalingGroup' {Maybe Bool
Text
autoScalingGroupName :: Text
forceDelete :: Maybe Bool
$sel:autoScalingGroupName:DeleteAutoScalingGroup' :: DeleteAutoScalingGroup -> Text
$sel:forceDelete:DeleteAutoScalingGroup' :: DeleteAutoScalingGroup -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteAutoScalingGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2011-01-01" :: Prelude.ByteString),
        ByteString
"ForceDelete" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
forceDelete,
        ByteString
"AutoScalingGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
autoScalingGroupName
      ]

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

-- |
-- Create a value of 'DeleteAutoScalingGroupResponse' 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.
newDeleteAutoScalingGroupResponse ::
  DeleteAutoScalingGroupResponse
newDeleteAutoScalingGroupResponse :: DeleteAutoScalingGroupResponse
newDeleteAutoScalingGroupResponse =
  DeleteAutoScalingGroupResponse
DeleteAutoScalingGroupResponse'

instance
  Prelude.NFData
    DeleteAutoScalingGroupResponse
  where
  rnf :: DeleteAutoScalingGroupResponse -> ()
rnf DeleteAutoScalingGroupResponse
_ = ()