{-# 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.DeleteConfigurationRecorder
-- 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 configuration recorder.
--
-- After the configuration recorder is deleted, Config will not record
-- resource configuration changes until you create a new configuration
-- recorder.
--
-- This action does not delete the configuration information that was
-- previously recorded. You will be able to access the previously recorded
-- information by using the @GetResourceConfigHistory@ action, but you will
-- not be able to access this information in the Config console until you
-- create a new configuration recorder.
module Amazonka.Config.DeleteConfigurationRecorder
  ( -- * Creating a Request
    DeleteConfigurationRecorder (..),
    newDeleteConfigurationRecorder,

    -- * Request Lenses
    deleteConfigurationRecorder_configurationRecorderName,

    -- * Destructuring the Response
    DeleteConfigurationRecorderResponse (..),
    newDeleteConfigurationRecorderResponse,
  )
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

-- | The request object for the @DeleteConfigurationRecorder@ action.
--
-- /See:/ 'newDeleteConfigurationRecorder' smart constructor.
data DeleteConfigurationRecorder = DeleteConfigurationRecorder'
  { -- | The name of the configuration recorder to be deleted. You can retrieve
    -- the name of your configuration recorder by using the
    -- @DescribeConfigurationRecorders@ action.
    DeleteConfigurationRecorder -> Text
configurationRecorderName :: Prelude.Text
  }
  deriving (DeleteConfigurationRecorder -> DeleteConfigurationRecorder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteConfigurationRecorder -> DeleteConfigurationRecorder -> Bool
$c/= :: DeleteConfigurationRecorder -> DeleteConfigurationRecorder -> Bool
== :: DeleteConfigurationRecorder -> DeleteConfigurationRecorder -> Bool
$c== :: DeleteConfigurationRecorder -> DeleteConfigurationRecorder -> Bool
Prelude.Eq, ReadPrec [DeleteConfigurationRecorder]
ReadPrec DeleteConfigurationRecorder
Int -> ReadS DeleteConfigurationRecorder
ReadS [DeleteConfigurationRecorder]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteConfigurationRecorder]
$creadListPrec :: ReadPrec [DeleteConfigurationRecorder]
readPrec :: ReadPrec DeleteConfigurationRecorder
$creadPrec :: ReadPrec DeleteConfigurationRecorder
readList :: ReadS [DeleteConfigurationRecorder]
$creadList :: ReadS [DeleteConfigurationRecorder]
readsPrec :: Int -> ReadS DeleteConfigurationRecorder
$creadsPrec :: Int -> ReadS DeleteConfigurationRecorder
Prelude.Read, Int -> DeleteConfigurationRecorder -> ShowS
[DeleteConfigurationRecorder] -> ShowS
DeleteConfigurationRecorder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteConfigurationRecorder] -> ShowS
$cshowList :: [DeleteConfigurationRecorder] -> ShowS
show :: DeleteConfigurationRecorder -> String
$cshow :: DeleteConfigurationRecorder -> String
showsPrec :: Int -> DeleteConfigurationRecorder -> ShowS
$cshowsPrec :: Int -> DeleteConfigurationRecorder -> ShowS
Prelude.Show, forall x.
Rep DeleteConfigurationRecorder x -> DeleteConfigurationRecorder
forall x.
DeleteConfigurationRecorder -> Rep DeleteConfigurationRecorder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteConfigurationRecorder x -> DeleteConfigurationRecorder
$cfrom :: forall x.
DeleteConfigurationRecorder -> Rep DeleteConfigurationRecorder x
Prelude.Generic)

-- |
-- Create a value of 'DeleteConfigurationRecorder' 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:
--
-- 'configurationRecorderName', 'deleteConfigurationRecorder_configurationRecorderName' - The name of the configuration recorder to be deleted. You can retrieve
-- the name of your configuration recorder by using the
-- @DescribeConfigurationRecorders@ action.
newDeleteConfigurationRecorder ::
  -- | 'configurationRecorderName'
  Prelude.Text ->
  DeleteConfigurationRecorder
newDeleteConfigurationRecorder :: Text -> DeleteConfigurationRecorder
newDeleteConfigurationRecorder
  Text
pConfigurationRecorderName_ =
    DeleteConfigurationRecorder'
      { $sel:configurationRecorderName:DeleteConfigurationRecorder' :: Text
configurationRecorderName =
          Text
pConfigurationRecorderName_
      }

-- | The name of the configuration recorder to be deleted. You can retrieve
-- the name of your configuration recorder by using the
-- @DescribeConfigurationRecorders@ action.
deleteConfigurationRecorder_configurationRecorderName :: Lens.Lens' DeleteConfigurationRecorder Prelude.Text
deleteConfigurationRecorder_configurationRecorderName :: Lens' DeleteConfigurationRecorder Text
deleteConfigurationRecorder_configurationRecorderName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteConfigurationRecorder' {Text
configurationRecorderName :: Text
$sel:configurationRecorderName:DeleteConfigurationRecorder' :: DeleteConfigurationRecorder -> Text
configurationRecorderName} -> Text
configurationRecorderName) (\s :: DeleteConfigurationRecorder
s@DeleteConfigurationRecorder' {} Text
a -> DeleteConfigurationRecorder
s {$sel:configurationRecorderName:DeleteConfigurationRecorder' :: Text
configurationRecorderName = Text
a} :: DeleteConfigurationRecorder)

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

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

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

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

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

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

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

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

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