{-# 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.DeleteWarmPool
-- 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 warm pool for the specified Auto Scaling group.
--
-- For more information, see
-- <https://docs.aws.amazon.com/autoscaling/ec2/userguide/ec2-auto-scaling-warm-pools.html Warm pools for Amazon EC2 Auto Scaling>
-- in the /Amazon EC2 Auto Scaling User Guide/.
module Amazonka.AutoScaling.DeleteWarmPool
  ( -- * Creating a Request
    DeleteWarmPool (..),
    newDeleteWarmPool,

    -- * Request Lenses
    deleteWarmPool_forceDelete,
    deleteWarmPool_autoScalingGroupName,

    -- * Destructuring the Response
    DeleteWarmPoolResponse (..),
    newDeleteWarmPoolResponse,

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

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

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

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

instance Core.AWSRequest DeleteWarmPool where
  type
    AWSResponse DeleteWarmPool =
      DeleteWarmPoolResponse
  request :: (Service -> Service) -> DeleteWarmPool -> Request DeleteWarmPool
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 DeleteWarmPool
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteWarmPool)))
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
"DeleteWarmPoolResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> DeleteWarmPoolResponse
DeleteWarmPoolResponse'
            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 DeleteWarmPool where
  hashWithSalt :: Int -> DeleteWarmPool -> Int
hashWithSalt Int
_salt DeleteWarmPool' {Maybe Bool
Text
autoScalingGroupName :: Text
forceDelete :: Maybe Bool
$sel:autoScalingGroupName:DeleteWarmPool' :: DeleteWarmPool -> Text
$sel:forceDelete:DeleteWarmPool' :: DeleteWarmPool -> 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 DeleteWarmPool where
  rnf :: DeleteWarmPool -> ()
rnf DeleteWarmPool' {Maybe Bool
Text
autoScalingGroupName :: Text
forceDelete :: Maybe Bool
$sel:autoScalingGroupName:DeleteWarmPool' :: DeleteWarmPool -> Text
$sel:forceDelete:DeleteWarmPool' :: DeleteWarmPool -> 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 DeleteWarmPool where
  toHeaders :: DeleteWarmPool -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DeleteWarmPool where
  toQuery :: DeleteWarmPool -> QueryString
toQuery DeleteWarmPool' {Maybe Bool
Text
autoScalingGroupName :: Text
forceDelete :: Maybe Bool
$sel:autoScalingGroupName:DeleteWarmPool' :: DeleteWarmPool -> Text
$sel:forceDelete:DeleteWarmPool' :: DeleteWarmPool -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteWarmPool" :: 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:/ 'newDeleteWarmPoolResponse' smart constructor.
data DeleteWarmPoolResponse = DeleteWarmPoolResponse'
  { -- | The response's http status code.
    DeleteWarmPoolResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteWarmPoolResponse -> DeleteWarmPoolResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteWarmPoolResponse -> DeleteWarmPoolResponse -> Bool
$c/= :: DeleteWarmPoolResponse -> DeleteWarmPoolResponse -> Bool
== :: DeleteWarmPoolResponse -> DeleteWarmPoolResponse -> Bool
$c== :: DeleteWarmPoolResponse -> DeleteWarmPoolResponse -> Bool
Prelude.Eq, ReadPrec [DeleteWarmPoolResponse]
ReadPrec DeleteWarmPoolResponse
Int -> ReadS DeleteWarmPoolResponse
ReadS [DeleteWarmPoolResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteWarmPoolResponse]
$creadListPrec :: ReadPrec [DeleteWarmPoolResponse]
readPrec :: ReadPrec DeleteWarmPoolResponse
$creadPrec :: ReadPrec DeleteWarmPoolResponse
readList :: ReadS [DeleteWarmPoolResponse]
$creadList :: ReadS [DeleteWarmPoolResponse]
readsPrec :: Int -> ReadS DeleteWarmPoolResponse
$creadsPrec :: Int -> ReadS DeleteWarmPoolResponse
Prelude.Read, Int -> DeleteWarmPoolResponse -> ShowS
[DeleteWarmPoolResponse] -> ShowS
DeleteWarmPoolResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteWarmPoolResponse] -> ShowS
$cshowList :: [DeleteWarmPoolResponse] -> ShowS
show :: DeleteWarmPoolResponse -> String
$cshow :: DeleteWarmPoolResponse -> String
showsPrec :: Int -> DeleteWarmPoolResponse -> ShowS
$cshowsPrec :: Int -> DeleteWarmPoolResponse -> ShowS
Prelude.Show, forall x. Rep DeleteWarmPoolResponse x -> DeleteWarmPoolResponse
forall x. DeleteWarmPoolResponse -> Rep DeleteWarmPoolResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteWarmPoolResponse x -> DeleteWarmPoolResponse
$cfrom :: forall x. DeleteWarmPoolResponse -> Rep DeleteWarmPoolResponse x
Prelude.Generic)

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

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

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