{-# 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.CodeDeploy.DeleteDeploymentConfig
-- 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 deployment configuration.
--
-- A deployment configuration cannot be deleted if it is currently in use.
-- Predefined configurations cannot be deleted.
module Amazonka.CodeDeploy.DeleteDeploymentConfig
  ( -- * Creating a Request
    DeleteDeploymentConfig (..),
    newDeleteDeploymentConfig,

    -- * Request Lenses
    deleteDeploymentConfig_deploymentConfigName,

    -- * Destructuring the Response
    DeleteDeploymentConfigResponse (..),
    newDeleteDeploymentConfigResponse,
  )
where

import Amazonka.CodeDeploy.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

-- | Represents the input of a @DeleteDeploymentConfig@ operation.
--
-- /See:/ 'newDeleteDeploymentConfig' smart constructor.
data DeleteDeploymentConfig = DeleteDeploymentConfig'
  { -- | The name of a deployment configuration associated with the IAM user or
    -- Amazon Web Services account.
    DeleteDeploymentConfig -> Text
deploymentConfigName :: Prelude.Text
  }
  deriving (DeleteDeploymentConfig -> DeleteDeploymentConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteDeploymentConfig -> DeleteDeploymentConfig -> Bool
$c/= :: DeleteDeploymentConfig -> DeleteDeploymentConfig -> Bool
== :: DeleteDeploymentConfig -> DeleteDeploymentConfig -> Bool
$c== :: DeleteDeploymentConfig -> DeleteDeploymentConfig -> Bool
Prelude.Eq, ReadPrec [DeleteDeploymentConfig]
ReadPrec DeleteDeploymentConfig
Int -> ReadS DeleteDeploymentConfig
ReadS [DeleteDeploymentConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteDeploymentConfig]
$creadListPrec :: ReadPrec [DeleteDeploymentConfig]
readPrec :: ReadPrec DeleteDeploymentConfig
$creadPrec :: ReadPrec DeleteDeploymentConfig
readList :: ReadS [DeleteDeploymentConfig]
$creadList :: ReadS [DeleteDeploymentConfig]
readsPrec :: Int -> ReadS DeleteDeploymentConfig
$creadsPrec :: Int -> ReadS DeleteDeploymentConfig
Prelude.Read, Int -> DeleteDeploymentConfig -> ShowS
[DeleteDeploymentConfig] -> ShowS
DeleteDeploymentConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteDeploymentConfig] -> ShowS
$cshowList :: [DeleteDeploymentConfig] -> ShowS
show :: DeleteDeploymentConfig -> String
$cshow :: DeleteDeploymentConfig -> String
showsPrec :: Int -> DeleteDeploymentConfig -> ShowS
$cshowsPrec :: Int -> DeleteDeploymentConfig -> ShowS
Prelude.Show, forall x. Rep DeleteDeploymentConfig x -> DeleteDeploymentConfig
forall x. DeleteDeploymentConfig -> Rep DeleteDeploymentConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteDeploymentConfig x -> DeleteDeploymentConfig
$cfrom :: forall x. DeleteDeploymentConfig -> Rep DeleteDeploymentConfig x
Prelude.Generic)

-- |
-- Create a value of 'DeleteDeploymentConfig' 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:
--
-- 'deploymentConfigName', 'deleteDeploymentConfig_deploymentConfigName' - The name of a deployment configuration associated with the IAM user or
-- Amazon Web Services account.
newDeleteDeploymentConfig ::
  -- | 'deploymentConfigName'
  Prelude.Text ->
  DeleteDeploymentConfig
newDeleteDeploymentConfig :: Text -> DeleteDeploymentConfig
newDeleteDeploymentConfig Text
pDeploymentConfigName_ =
  DeleteDeploymentConfig'
    { $sel:deploymentConfigName:DeleteDeploymentConfig' :: Text
deploymentConfigName =
        Text
pDeploymentConfigName_
    }

-- | The name of a deployment configuration associated with the IAM user or
-- Amazon Web Services account.
deleteDeploymentConfig_deploymentConfigName :: Lens.Lens' DeleteDeploymentConfig Prelude.Text
deleteDeploymentConfig_deploymentConfigName :: Lens' DeleteDeploymentConfig Text
deleteDeploymentConfig_deploymentConfigName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDeploymentConfig' {Text
deploymentConfigName :: Text
$sel:deploymentConfigName:DeleteDeploymentConfig' :: DeleteDeploymentConfig -> Text
deploymentConfigName} -> Text
deploymentConfigName) (\s :: DeleteDeploymentConfig
s@DeleteDeploymentConfig' {} Text
a -> DeleteDeploymentConfig
s {$sel:deploymentConfigName:DeleteDeploymentConfig' :: Text
deploymentConfigName = Text
a} :: DeleteDeploymentConfig)

instance Core.AWSRequest DeleteDeploymentConfig where
  type
    AWSResponse DeleteDeploymentConfig =
      DeleteDeploymentConfigResponse
  request :: (Service -> Service)
-> DeleteDeploymentConfig -> Request DeleteDeploymentConfig
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteDeploymentConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteDeploymentConfig)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteDeploymentConfigResponse
DeleteDeploymentConfigResponse'

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

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

instance Data.ToHeaders DeleteDeploymentConfig where
  toHeaders :: DeleteDeploymentConfig -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"CodeDeploy_20141006.DeleteDeploymentConfig" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeleteDeploymentConfig where
  toJSON :: DeleteDeploymentConfig -> Value
toJSON DeleteDeploymentConfig' {Text
deploymentConfigName :: Text
$sel:deploymentConfigName:DeleteDeploymentConfig' :: DeleteDeploymentConfig -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"deploymentConfigName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
deploymentConfigName
              )
          ]
      )

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

instance Data.ToQuery DeleteDeploymentConfig where
  toQuery :: DeleteDeploymentConfig -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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