{-# 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.DeleteConfigRule
-- 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 Config rule and all of its evaluation results.
--
-- Config sets the state of a rule to @DELETING@ until the deletion is
-- complete. You cannot update a rule while it is in this state. If you
-- make a @PutConfigRule@ or @DeleteConfigRule@ request for the rule, you
-- will receive a @ResourceInUseException@.
--
-- You can check the state of a rule by using the @DescribeConfigRules@
-- request.
module Amazonka.Config.DeleteConfigRule
  ( -- * Creating a Request
    DeleteConfigRule (..),
    newDeleteConfigRule,

    -- * Request Lenses
    deleteConfigRule_configRuleName,

    -- * Destructuring the Response
    DeleteConfigRuleResponse (..),
    newDeleteConfigRuleResponse,
  )
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:/ 'newDeleteConfigRule' smart constructor.
data DeleteConfigRule = DeleteConfigRule'
  { -- | The name of the Config rule that you want to delete.
    DeleteConfigRule -> Text
configRuleName :: Prelude.Text
  }
  deriving (DeleteConfigRule -> DeleteConfigRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteConfigRule -> DeleteConfigRule -> Bool
$c/= :: DeleteConfigRule -> DeleteConfigRule -> Bool
== :: DeleteConfigRule -> DeleteConfigRule -> Bool
$c== :: DeleteConfigRule -> DeleteConfigRule -> Bool
Prelude.Eq, ReadPrec [DeleteConfigRule]
ReadPrec DeleteConfigRule
Int -> ReadS DeleteConfigRule
ReadS [DeleteConfigRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteConfigRule]
$creadListPrec :: ReadPrec [DeleteConfigRule]
readPrec :: ReadPrec DeleteConfigRule
$creadPrec :: ReadPrec DeleteConfigRule
readList :: ReadS [DeleteConfigRule]
$creadList :: ReadS [DeleteConfigRule]
readsPrec :: Int -> ReadS DeleteConfigRule
$creadsPrec :: Int -> ReadS DeleteConfigRule
Prelude.Read, Int -> DeleteConfigRule -> ShowS
[DeleteConfigRule] -> ShowS
DeleteConfigRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteConfigRule] -> ShowS
$cshowList :: [DeleteConfigRule] -> ShowS
show :: DeleteConfigRule -> String
$cshow :: DeleteConfigRule -> String
showsPrec :: Int -> DeleteConfigRule -> ShowS
$cshowsPrec :: Int -> DeleteConfigRule -> ShowS
Prelude.Show, forall x. Rep DeleteConfigRule x -> DeleteConfigRule
forall x. DeleteConfigRule -> Rep DeleteConfigRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteConfigRule x -> DeleteConfigRule
$cfrom :: forall x. DeleteConfigRule -> Rep DeleteConfigRule x
Prelude.Generic)

-- |
-- Create a value of 'DeleteConfigRule' 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:
--
-- 'configRuleName', 'deleteConfigRule_configRuleName' - The name of the Config rule that you want to delete.
newDeleteConfigRule ::
  -- | 'configRuleName'
  Prelude.Text ->
  DeleteConfigRule
newDeleteConfigRule :: Text -> DeleteConfigRule
newDeleteConfigRule Text
pConfigRuleName_ =
  DeleteConfigRule'
    { $sel:configRuleName:DeleteConfigRule' :: Text
configRuleName =
        Text
pConfigRuleName_
    }

-- | The name of the Config rule that you want to delete.
deleteConfigRule_configRuleName :: Lens.Lens' DeleteConfigRule Prelude.Text
deleteConfigRule_configRuleName :: Lens' DeleteConfigRule Text
deleteConfigRule_configRuleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteConfigRule' {Text
configRuleName :: Text
$sel:configRuleName:DeleteConfigRule' :: DeleteConfigRule -> Text
configRuleName} -> Text
configRuleName) (\s :: DeleteConfigRule
s@DeleteConfigRule' {} Text
a -> DeleteConfigRule
s {$sel:configRuleName:DeleteConfigRule' :: Text
configRuleName = Text
a} :: DeleteConfigRule)

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

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

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

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

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

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

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

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

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