{-# 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.AppConfig.DeleteConfigurationProfile
-- 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 configuration profile. Deleting a configuration profile does
-- not delete a configuration from a host.
module Amazonka.AppConfig.DeleteConfigurationProfile
  ( -- * Creating a Request
    DeleteConfigurationProfile (..),
    newDeleteConfigurationProfile,

    -- * Request Lenses
    deleteConfigurationProfile_applicationId,
    deleteConfigurationProfile_configurationProfileId,

    -- * Destructuring the Response
    DeleteConfigurationProfileResponse (..),
    newDeleteConfigurationProfileResponse,
  )
where

import Amazonka.AppConfig.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:/ 'newDeleteConfigurationProfile' smart constructor.
data DeleteConfigurationProfile = DeleteConfigurationProfile'
  { -- | The application ID that includes the configuration profile you want to
    -- delete.
    DeleteConfigurationProfile -> Text
applicationId :: Prelude.Text,
    -- | The ID of the configuration profile you want to delete.
    DeleteConfigurationProfile -> Text
configurationProfileId :: Prelude.Text
  }
  deriving (DeleteConfigurationProfile -> DeleteConfigurationProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteConfigurationProfile -> DeleteConfigurationProfile -> Bool
$c/= :: DeleteConfigurationProfile -> DeleteConfigurationProfile -> Bool
== :: DeleteConfigurationProfile -> DeleteConfigurationProfile -> Bool
$c== :: DeleteConfigurationProfile -> DeleteConfigurationProfile -> Bool
Prelude.Eq, ReadPrec [DeleteConfigurationProfile]
ReadPrec DeleteConfigurationProfile
Int -> ReadS DeleteConfigurationProfile
ReadS [DeleteConfigurationProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteConfigurationProfile]
$creadListPrec :: ReadPrec [DeleteConfigurationProfile]
readPrec :: ReadPrec DeleteConfigurationProfile
$creadPrec :: ReadPrec DeleteConfigurationProfile
readList :: ReadS [DeleteConfigurationProfile]
$creadList :: ReadS [DeleteConfigurationProfile]
readsPrec :: Int -> ReadS DeleteConfigurationProfile
$creadsPrec :: Int -> ReadS DeleteConfigurationProfile
Prelude.Read, Int -> DeleteConfigurationProfile -> ShowS
[DeleteConfigurationProfile] -> ShowS
DeleteConfigurationProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteConfigurationProfile] -> ShowS
$cshowList :: [DeleteConfigurationProfile] -> ShowS
show :: DeleteConfigurationProfile -> String
$cshow :: DeleteConfigurationProfile -> String
showsPrec :: Int -> DeleteConfigurationProfile -> ShowS
$cshowsPrec :: Int -> DeleteConfigurationProfile -> ShowS
Prelude.Show, forall x.
Rep DeleteConfigurationProfile x -> DeleteConfigurationProfile
forall x.
DeleteConfigurationProfile -> Rep DeleteConfigurationProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteConfigurationProfile x -> DeleteConfigurationProfile
$cfrom :: forall x.
DeleteConfigurationProfile -> Rep DeleteConfigurationProfile x
Prelude.Generic)

-- |
-- Create a value of 'DeleteConfigurationProfile' 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:
--
-- 'applicationId', 'deleteConfigurationProfile_applicationId' - The application ID that includes the configuration profile you want to
-- delete.
--
-- 'configurationProfileId', 'deleteConfigurationProfile_configurationProfileId' - The ID of the configuration profile you want to delete.
newDeleteConfigurationProfile ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'configurationProfileId'
  Prelude.Text ->
  DeleteConfigurationProfile
newDeleteConfigurationProfile :: Text -> Text -> DeleteConfigurationProfile
newDeleteConfigurationProfile
  Text
pApplicationId_
  Text
pConfigurationProfileId_ =
    DeleteConfigurationProfile'
      { $sel:applicationId:DeleteConfigurationProfile' :: Text
applicationId =
          Text
pApplicationId_,
        $sel:configurationProfileId:DeleteConfigurationProfile' :: Text
configurationProfileId =
          Text
pConfigurationProfileId_
      }

-- | The application ID that includes the configuration profile you want to
-- delete.
deleteConfigurationProfile_applicationId :: Lens.Lens' DeleteConfigurationProfile Prelude.Text
deleteConfigurationProfile_applicationId :: Lens' DeleteConfigurationProfile Text
deleteConfigurationProfile_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteConfigurationProfile' {Text
applicationId :: Text
$sel:applicationId:DeleteConfigurationProfile' :: DeleteConfigurationProfile -> Text
applicationId} -> Text
applicationId) (\s :: DeleteConfigurationProfile
s@DeleteConfigurationProfile' {} Text
a -> DeleteConfigurationProfile
s {$sel:applicationId:DeleteConfigurationProfile' :: Text
applicationId = Text
a} :: DeleteConfigurationProfile)

-- | The ID of the configuration profile you want to delete.
deleteConfigurationProfile_configurationProfileId :: Lens.Lens' DeleteConfigurationProfile Prelude.Text
deleteConfigurationProfile_configurationProfileId :: Lens' DeleteConfigurationProfile Text
deleteConfigurationProfile_configurationProfileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteConfigurationProfile' {Text
configurationProfileId :: Text
$sel:configurationProfileId:DeleteConfigurationProfile' :: DeleteConfigurationProfile -> Text
configurationProfileId} -> Text
configurationProfileId) (\s :: DeleteConfigurationProfile
s@DeleteConfigurationProfile' {} Text
a -> DeleteConfigurationProfile
s {$sel:configurationProfileId:DeleteConfigurationProfile' :: Text
configurationProfileId = Text
a} :: DeleteConfigurationProfile)

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

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

instance Prelude.NFData DeleteConfigurationProfile where
  rnf :: DeleteConfigurationProfile -> ()
rnf DeleteConfigurationProfile' {Text
configurationProfileId :: Text
applicationId :: Text
$sel:configurationProfileId:DeleteConfigurationProfile' :: DeleteConfigurationProfile -> Text
$sel:applicationId:DeleteConfigurationProfile' :: DeleteConfigurationProfile -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
configurationProfileId

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

instance Data.ToPath DeleteConfigurationProfile where
  toPath :: DeleteConfigurationProfile -> ByteString
toPath DeleteConfigurationProfile' {Text
configurationProfileId :: Text
applicationId :: Text
$sel:configurationProfileId:DeleteConfigurationProfile' :: DeleteConfigurationProfile -> Text
$sel:applicationId:DeleteConfigurationProfile' :: DeleteConfigurationProfile -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/configurationprofiles/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
configurationProfileId
      ]

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

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

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

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