{-# 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.Config.DeleteConfigurationAggregator
-- 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 configuration aggregator and the aggregated data
-- associated with the aggregator.
module Amazonka.Config.DeleteConfigurationAggregator
  ( -- * Creating a Request
    DeleteConfigurationAggregator (..),
    newDeleteConfigurationAggregator,

    -- * Request Lenses
    deleteConfigurationAggregator_configurationAggregatorName,

    -- * Destructuring the Response
    DeleteConfigurationAggregatorResponse (..),
    newDeleteConfigurationAggregatorResponse,
  )
where

import Amazonka.Config.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:/ 'newDeleteConfigurationAggregator' smart constructor.
data DeleteConfigurationAggregator = DeleteConfigurationAggregator'
  { -- | The name of the configuration aggregator.
    DeleteConfigurationAggregator -> Text
configurationAggregatorName :: Prelude.Text
  }
  deriving (DeleteConfigurationAggregator
-> DeleteConfigurationAggregator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteConfigurationAggregator
-> DeleteConfigurationAggregator -> Bool
$c/= :: DeleteConfigurationAggregator
-> DeleteConfigurationAggregator -> Bool
== :: DeleteConfigurationAggregator
-> DeleteConfigurationAggregator -> Bool
$c== :: DeleteConfigurationAggregator
-> DeleteConfigurationAggregator -> Bool
Prelude.Eq, ReadPrec [DeleteConfigurationAggregator]
ReadPrec DeleteConfigurationAggregator
Int -> ReadS DeleteConfigurationAggregator
ReadS [DeleteConfigurationAggregator]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteConfigurationAggregator]
$creadListPrec :: ReadPrec [DeleteConfigurationAggregator]
readPrec :: ReadPrec DeleteConfigurationAggregator
$creadPrec :: ReadPrec DeleteConfigurationAggregator
readList :: ReadS [DeleteConfigurationAggregator]
$creadList :: ReadS [DeleteConfigurationAggregator]
readsPrec :: Int -> ReadS DeleteConfigurationAggregator
$creadsPrec :: Int -> ReadS DeleteConfigurationAggregator
Prelude.Read, Int -> DeleteConfigurationAggregator -> ShowS
[DeleteConfigurationAggregator] -> ShowS
DeleteConfigurationAggregator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteConfigurationAggregator] -> ShowS
$cshowList :: [DeleteConfigurationAggregator] -> ShowS
show :: DeleteConfigurationAggregator -> String
$cshow :: DeleteConfigurationAggregator -> String
showsPrec :: Int -> DeleteConfigurationAggregator -> ShowS
$cshowsPrec :: Int -> DeleteConfigurationAggregator -> ShowS
Prelude.Show, forall x.
Rep DeleteConfigurationAggregator x
-> DeleteConfigurationAggregator
forall x.
DeleteConfigurationAggregator
-> Rep DeleteConfigurationAggregator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteConfigurationAggregator x
-> DeleteConfigurationAggregator
$cfrom :: forall x.
DeleteConfigurationAggregator
-> Rep DeleteConfigurationAggregator x
Prelude.Generic)

-- |
-- Create a value of 'DeleteConfigurationAggregator' 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:
--
-- 'configurationAggregatorName', 'deleteConfigurationAggregator_configurationAggregatorName' - The name of the configuration aggregator.
newDeleteConfigurationAggregator ::
  -- | 'configurationAggregatorName'
  Prelude.Text ->
  DeleteConfigurationAggregator
newDeleteConfigurationAggregator :: Text -> DeleteConfigurationAggregator
newDeleteConfigurationAggregator
  Text
pConfigurationAggregatorName_ =
    DeleteConfigurationAggregator'
      { $sel:configurationAggregatorName:DeleteConfigurationAggregator' :: Text
configurationAggregatorName =
          Text
pConfigurationAggregatorName_
      }

-- | The name of the configuration aggregator.
deleteConfigurationAggregator_configurationAggregatorName :: Lens.Lens' DeleteConfigurationAggregator Prelude.Text
deleteConfigurationAggregator_configurationAggregatorName :: Lens' DeleteConfigurationAggregator Text
deleteConfigurationAggregator_configurationAggregatorName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteConfigurationAggregator' {Text
configurationAggregatorName :: Text
$sel:configurationAggregatorName:DeleteConfigurationAggregator' :: DeleteConfigurationAggregator -> Text
configurationAggregatorName} -> Text
configurationAggregatorName) (\s :: DeleteConfigurationAggregator
s@DeleteConfigurationAggregator' {} Text
a -> DeleteConfigurationAggregator
s {$sel:configurationAggregatorName:DeleteConfigurationAggregator' :: Text
configurationAggregatorName = Text
a} :: DeleteConfigurationAggregator)

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

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

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

instance Data.ToHeaders DeleteConfigurationAggregator where
  toHeaders :: DeleteConfigurationAggregator -> [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
"StarlingDoveService.DeleteConfigurationAggregator" ::
                          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 DeleteConfigurationAggregator where
  toJSON :: DeleteConfigurationAggregator -> Value
toJSON DeleteConfigurationAggregator' {Text
configurationAggregatorName :: Text
$sel:configurationAggregatorName:DeleteConfigurationAggregator' :: DeleteConfigurationAggregator -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"ConfigurationAggregatorName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
configurationAggregatorName
              )
          ]
      )

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

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

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

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

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