{-# 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.DeleteLaunchConfiguration
-- 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 launch configuration.
--
-- The launch configuration must not be attached to an Auto Scaling group.
-- When this call completes, the launch configuration is no longer
-- available for use.
module Amazonka.AutoScaling.DeleteLaunchConfiguration
  ( -- * Creating a Request
    DeleteLaunchConfiguration (..),
    newDeleteLaunchConfiguration,

    -- * Request Lenses
    deleteLaunchConfiguration_launchConfigurationName,

    -- * Destructuring the Response
    DeleteLaunchConfigurationResponse (..),
    newDeleteLaunchConfigurationResponse,
  )
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:/ 'newDeleteLaunchConfiguration' smart constructor.
data DeleteLaunchConfiguration = DeleteLaunchConfiguration'
  { -- | The name of the launch configuration.
    DeleteLaunchConfiguration -> Text
launchConfigurationName :: Prelude.Text
  }
  deriving (DeleteLaunchConfiguration -> DeleteLaunchConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteLaunchConfiguration -> DeleteLaunchConfiguration -> Bool
$c/= :: DeleteLaunchConfiguration -> DeleteLaunchConfiguration -> Bool
== :: DeleteLaunchConfiguration -> DeleteLaunchConfiguration -> Bool
$c== :: DeleteLaunchConfiguration -> DeleteLaunchConfiguration -> Bool
Prelude.Eq, ReadPrec [DeleteLaunchConfiguration]
ReadPrec DeleteLaunchConfiguration
Int -> ReadS DeleteLaunchConfiguration
ReadS [DeleteLaunchConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteLaunchConfiguration]
$creadListPrec :: ReadPrec [DeleteLaunchConfiguration]
readPrec :: ReadPrec DeleteLaunchConfiguration
$creadPrec :: ReadPrec DeleteLaunchConfiguration
readList :: ReadS [DeleteLaunchConfiguration]
$creadList :: ReadS [DeleteLaunchConfiguration]
readsPrec :: Int -> ReadS DeleteLaunchConfiguration
$creadsPrec :: Int -> ReadS DeleteLaunchConfiguration
Prelude.Read, Int -> DeleteLaunchConfiguration -> ShowS
[DeleteLaunchConfiguration] -> ShowS
DeleteLaunchConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteLaunchConfiguration] -> ShowS
$cshowList :: [DeleteLaunchConfiguration] -> ShowS
show :: DeleteLaunchConfiguration -> String
$cshow :: DeleteLaunchConfiguration -> String
showsPrec :: Int -> DeleteLaunchConfiguration -> ShowS
$cshowsPrec :: Int -> DeleteLaunchConfiguration -> ShowS
Prelude.Show, forall x.
Rep DeleteLaunchConfiguration x -> DeleteLaunchConfiguration
forall x.
DeleteLaunchConfiguration -> Rep DeleteLaunchConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteLaunchConfiguration x -> DeleteLaunchConfiguration
$cfrom :: forall x.
DeleteLaunchConfiguration -> Rep DeleteLaunchConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'DeleteLaunchConfiguration' 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:
--
-- 'launchConfigurationName', 'deleteLaunchConfiguration_launchConfigurationName' - The name of the launch configuration.
newDeleteLaunchConfiguration ::
  -- | 'launchConfigurationName'
  Prelude.Text ->
  DeleteLaunchConfiguration
newDeleteLaunchConfiguration :: Text -> DeleteLaunchConfiguration
newDeleteLaunchConfiguration
  Text
pLaunchConfigurationName_ =
    DeleteLaunchConfiguration'
      { $sel:launchConfigurationName:DeleteLaunchConfiguration' :: Text
launchConfigurationName =
          Text
pLaunchConfigurationName_
      }

-- | The name of the launch configuration.
deleteLaunchConfiguration_launchConfigurationName :: Lens.Lens' DeleteLaunchConfiguration Prelude.Text
deleteLaunchConfiguration_launchConfigurationName :: Lens' DeleteLaunchConfiguration Text
deleteLaunchConfiguration_launchConfigurationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteLaunchConfiguration' {Text
launchConfigurationName :: Text
$sel:launchConfigurationName:DeleteLaunchConfiguration' :: DeleteLaunchConfiguration -> Text
launchConfigurationName} -> Text
launchConfigurationName) (\s :: DeleteLaunchConfiguration
s@DeleteLaunchConfiguration' {} Text
a -> DeleteLaunchConfiguration
s {$sel:launchConfigurationName:DeleteLaunchConfiguration' :: Text
launchConfigurationName = Text
a} :: DeleteLaunchConfiguration)

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

instance Prelude.Hashable DeleteLaunchConfiguration where
  hashWithSalt :: Int -> DeleteLaunchConfiguration -> Int
hashWithSalt Int
_salt DeleteLaunchConfiguration' {Text
launchConfigurationName :: Text
$sel:launchConfigurationName:DeleteLaunchConfiguration' :: DeleteLaunchConfiguration -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
launchConfigurationName

instance Prelude.NFData DeleteLaunchConfiguration where
  rnf :: DeleteLaunchConfiguration -> ()
rnf DeleteLaunchConfiguration' {Text
launchConfigurationName :: Text
$sel:launchConfigurationName:DeleteLaunchConfiguration' :: DeleteLaunchConfiguration -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
launchConfigurationName

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

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

instance Data.ToQuery DeleteLaunchConfiguration where
  toQuery :: DeleteLaunchConfiguration -> QueryString
toQuery DeleteLaunchConfiguration' {Text
launchConfigurationName :: Text
$sel:launchConfigurationName:DeleteLaunchConfiguration' :: DeleteLaunchConfiguration -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteLaunchConfiguration" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2011-01-01" :: Prelude.ByteString),
        ByteString
"LaunchConfigurationName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
launchConfigurationName
      ]

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

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

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