{-# 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.DeleteRemediationExceptions
-- 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 one or more remediation exceptions mentioned in the resource
-- keys.
--
-- Config generates a remediation exception when a problem occurs executing
-- a remediation action to a specific resource. Remediation exceptions
-- blocks auto-remediation until the exception is cleared.
module Amazonka.Config.DeleteRemediationExceptions
  ( -- * Creating a Request
    DeleteRemediationExceptions (..),
    newDeleteRemediationExceptions,

    -- * Request Lenses
    deleteRemediationExceptions_configRuleName,
    deleteRemediationExceptions_resourceKeys,

    -- * Destructuring the Response
    DeleteRemediationExceptionsResponse (..),
    newDeleteRemediationExceptionsResponse,

    -- * Response Lenses
    deleteRemediationExceptionsResponse_failedBatches,
    deleteRemediationExceptionsResponse_httpStatus,
  )
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:/ 'newDeleteRemediationExceptions' smart constructor.
data DeleteRemediationExceptions = DeleteRemediationExceptions'
  { -- | The name of the Config rule for which you want to delete remediation
    -- exception configuration.
    DeleteRemediationExceptions -> Text
configRuleName :: Prelude.Text,
    -- | An exception list of resource exception keys to be processed with the
    -- current request. Config adds exception for each resource key. For
    -- example, Config adds 3 exceptions for 3 resource keys.
    DeleteRemediationExceptions
-> NonEmpty RemediationExceptionResourceKey
resourceKeys :: Prelude.NonEmpty RemediationExceptionResourceKey
  }
  deriving (DeleteRemediationExceptions -> DeleteRemediationExceptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteRemediationExceptions -> DeleteRemediationExceptions -> Bool
$c/= :: DeleteRemediationExceptions -> DeleteRemediationExceptions -> Bool
== :: DeleteRemediationExceptions -> DeleteRemediationExceptions -> Bool
$c== :: DeleteRemediationExceptions -> DeleteRemediationExceptions -> Bool
Prelude.Eq, ReadPrec [DeleteRemediationExceptions]
ReadPrec DeleteRemediationExceptions
Int -> ReadS DeleteRemediationExceptions
ReadS [DeleteRemediationExceptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteRemediationExceptions]
$creadListPrec :: ReadPrec [DeleteRemediationExceptions]
readPrec :: ReadPrec DeleteRemediationExceptions
$creadPrec :: ReadPrec DeleteRemediationExceptions
readList :: ReadS [DeleteRemediationExceptions]
$creadList :: ReadS [DeleteRemediationExceptions]
readsPrec :: Int -> ReadS DeleteRemediationExceptions
$creadsPrec :: Int -> ReadS DeleteRemediationExceptions
Prelude.Read, Int -> DeleteRemediationExceptions -> ShowS
[DeleteRemediationExceptions] -> ShowS
DeleteRemediationExceptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteRemediationExceptions] -> ShowS
$cshowList :: [DeleteRemediationExceptions] -> ShowS
show :: DeleteRemediationExceptions -> String
$cshow :: DeleteRemediationExceptions -> String
showsPrec :: Int -> DeleteRemediationExceptions -> ShowS
$cshowsPrec :: Int -> DeleteRemediationExceptions -> ShowS
Prelude.Show, forall x.
Rep DeleteRemediationExceptions x -> DeleteRemediationExceptions
forall x.
DeleteRemediationExceptions -> Rep DeleteRemediationExceptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteRemediationExceptions x -> DeleteRemediationExceptions
$cfrom :: forall x.
DeleteRemediationExceptions -> Rep DeleteRemediationExceptions x
Prelude.Generic)

-- |
-- Create a value of 'DeleteRemediationExceptions' 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', 'deleteRemediationExceptions_configRuleName' - The name of the Config rule for which you want to delete remediation
-- exception configuration.
--
-- 'resourceKeys', 'deleteRemediationExceptions_resourceKeys' - An exception list of resource exception keys to be processed with the
-- current request. Config adds exception for each resource key. For
-- example, Config adds 3 exceptions for 3 resource keys.
newDeleteRemediationExceptions ::
  -- | 'configRuleName'
  Prelude.Text ->
  -- | 'resourceKeys'
  Prelude.NonEmpty RemediationExceptionResourceKey ->
  DeleteRemediationExceptions
newDeleteRemediationExceptions :: Text
-> NonEmpty RemediationExceptionResourceKey
-> DeleteRemediationExceptions
newDeleteRemediationExceptions
  Text
pConfigRuleName_
  NonEmpty RemediationExceptionResourceKey
pResourceKeys_ =
    DeleteRemediationExceptions'
      { $sel:configRuleName:DeleteRemediationExceptions' :: Text
configRuleName =
          Text
pConfigRuleName_,
        $sel:resourceKeys:DeleteRemediationExceptions' :: NonEmpty RemediationExceptionResourceKey
resourceKeys =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty RemediationExceptionResourceKey
pResourceKeys_
      }

-- | The name of the Config rule for which you want to delete remediation
-- exception configuration.
deleteRemediationExceptions_configRuleName :: Lens.Lens' DeleteRemediationExceptions Prelude.Text
deleteRemediationExceptions_configRuleName :: Lens' DeleteRemediationExceptions Text
deleteRemediationExceptions_configRuleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteRemediationExceptions' {Text
configRuleName :: Text
$sel:configRuleName:DeleteRemediationExceptions' :: DeleteRemediationExceptions -> Text
configRuleName} -> Text
configRuleName) (\s :: DeleteRemediationExceptions
s@DeleteRemediationExceptions' {} Text
a -> DeleteRemediationExceptions
s {$sel:configRuleName:DeleteRemediationExceptions' :: Text
configRuleName = Text
a} :: DeleteRemediationExceptions)

-- | An exception list of resource exception keys to be processed with the
-- current request. Config adds exception for each resource key. For
-- example, Config adds 3 exceptions for 3 resource keys.
deleteRemediationExceptions_resourceKeys :: Lens.Lens' DeleteRemediationExceptions (Prelude.NonEmpty RemediationExceptionResourceKey)
deleteRemediationExceptions_resourceKeys :: Lens'
  DeleteRemediationExceptions
  (NonEmpty RemediationExceptionResourceKey)
deleteRemediationExceptions_resourceKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteRemediationExceptions' {NonEmpty RemediationExceptionResourceKey
resourceKeys :: NonEmpty RemediationExceptionResourceKey
$sel:resourceKeys:DeleteRemediationExceptions' :: DeleteRemediationExceptions
-> NonEmpty RemediationExceptionResourceKey
resourceKeys} -> NonEmpty RemediationExceptionResourceKey
resourceKeys) (\s :: DeleteRemediationExceptions
s@DeleteRemediationExceptions' {} NonEmpty RemediationExceptionResourceKey
a -> DeleteRemediationExceptions
s {$sel:resourceKeys:DeleteRemediationExceptions' :: NonEmpty RemediationExceptionResourceKey
resourceKeys = NonEmpty RemediationExceptionResourceKey
a} :: DeleteRemediationExceptions) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest DeleteRemediationExceptions where
  type
    AWSResponse DeleteRemediationExceptions =
      DeleteRemediationExceptionsResponse
  request :: (Service -> Service)
-> DeleteRemediationExceptions
-> Request DeleteRemediationExceptions
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 DeleteRemediationExceptions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteRemediationExceptions)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [FailedDeleteRemediationExceptionsBatch]
-> Int -> DeleteRemediationExceptionsResponse
DeleteRemediationExceptionsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FailedBatches" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

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

instance Prelude.NFData DeleteRemediationExceptions where
  rnf :: DeleteRemediationExceptions -> ()
rnf DeleteRemediationExceptions' {NonEmpty RemediationExceptionResourceKey
Text
resourceKeys :: NonEmpty RemediationExceptionResourceKey
configRuleName :: Text
$sel:resourceKeys:DeleteRemediationExceptions' :: DeleteRemediationExceptions
-> NonEmpty RemediationExceptionResourceKey
$sel:configRuleName:DeleteRemediationExceptions' :: DeleteRemediationExceptions -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
configRuleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty RemediationExceptionResourceKey
resourceKeys

instance Data.ToHeaders DeleteRemediationExceptions where
  toHeaders :: DeleteRemediationExceptions -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"StarlingDoveService.DeleteRemediationExceptions" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeleteRemediationExceptions where
  toJSON :: DeleteRemediationExceptions -> Value
toJSON DeleteRemediationExceptions' {NonEmpty RemediationExceptionResourceKey
Text
resourceKeys :: NonEmpty RemediationExceptionResourceKey
configRuleName :: Text
$sel:resourceKeys:DeleteRemediationExceptions' :: DeleteRemediationExceptions
-> NonEmpty RemediationExceptionResourceKey
$sel:configRuleName:DeleteRemediationExceptions' :: DeleteRemediationExceptions -> 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),
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceKeys" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty RemediationExceptionResourceKey
resourceKeys)
          ]
      )

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

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

-- | /See:/ 'newDeleteRemediationExceptionsResponse' smart constructor.
data DeleteRemediationExceptionsResponse = DeleteRemediationExceptionsResponse'
  { -- | Returns a list of failed delete remediation exceptions batch objects.
    -- Each object in the batch consists of a list of failed items and failure
    -- messages.
    DeleteRemediationExceptionsResponse
-> Maybe [FailedDeleteRemediationExceptionsBatch]
failedBatches :: Prelude.Maybe [FailedDeleteRemediationExceptionsBatch],
    -- | The response's http status code.
    DeleteRemediationExceptionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteRemediationExceptionsResponse
-> DeleteRemediationExceptionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteRemediationExceptionsResponse
-> DeleteRemediationExceptionsResponse -> Bool
$c/= :: DeleteRemediationExceptionsResponse
-> DeleteRemediationExceptionsResponse -> Bool
== :: DeleteRemediationExceptionsResponse
-> DeleteRemediationExceptionsResponse -> Bool
$c== :: DeleteRemediationExceptionsResponse
-> DeleteRemediationExceptionsResponse -> Bool
Prelude.Eq, ReadPrec [DeleteRemediationExceptionsResponse]
ReadPrec DeleteRemediationExceptionsResponse
Int -> ReadS DeleteRemediationExceptionsResponse
ReadS [DeleteRemediationExceptionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteRemediationExceptionsResponse]
$creadListPrec :: ReadPrec [DeleteRemediationExceptionsResponse]
readPrec :: ReadPrec DeleteRemediationExceptionsResponse
$creadPrec :: ReadPrec DeleteRemediationExceptionsResponse
readList :: ReadS [DeleteRemediationExceptionsResponse]
$creadList :: ReadS [DeleteRemediationExceptionsResponse]
readsPrec :: Int -> ReadS DeleteRemediationExceptionsResponse
$creadsPrec :: Int -> ReadS DeleteRemediationExceptionsResponse
Prelude.Read, Int -> DeleteRemediationExceptionsResponse -> ShowS
[DeleteRemediationExceptionsResponse] -> ShowS
DeleteRemediationExceptionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteRemediationExceptionsResponse] -> ShowS
$cshowList :: [DeleteRemediationExceptionsResponse] -> ShowS
show :: DeleteRemediationExceptionsResponse -> String
$cshow :: DeleteRemediationExceptionsResponse -> String
showsPrec :: Int -> DeleteRemediationExceptionsResponse -> ShowS
$cshowsPrec :: Int -> DeleteRemediationExceptionsResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteRemediationExceptionsResponse x
-> DeleteRemediationExceptionsResponse
forall x.
DeleteRemediationExceptionsResponse
-> Rep DeleteRemediationExceptionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteRemediationExceptionsResponse x
-> DeleteRemediationExceptionsResponse
$cfrom :: forall x.
DeleteRemediationExceptionsResponse
-> Rep DeleteRemediationExceptionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteRemediationExceptionsResponse' 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:
--
-- 'failedBatches', 'deleteRemediationExceptionsResponse_failedBatches' - Returns a list of failed delete remediation exceptions batch objects.
-- Each object in the batch consists of a list of failed items and failure
-- messages.
--
-- 'httpStatus', 'deleteRemediationExceptionsResponse_httpStatus' - The response's http status code.
newDeleteRemediationExceptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteRemediationExceptionsResponse
newDeleteRemediationExceptionsResponse :: Int -> DeleteRemediationExceptionsResponse
newDeleteRemediationExceptionsResponse Int
pHttpStatus_ =
  DeleteRemediationExceptionsResponse'
    { $sel:failedBatches:DeleteRemediationExceptionsResponse' :: Maybe [FailedDeleteRemediationExceptionsBatch]
failedBatches =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteRemediationExceptionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns a list of failed delete remediation exceptions batch objects.
-- Each object in the batch consists of a list of failed items and failure
-- messages.
deleteRemediationExceptionsResponse_failedBatches :: Lens.Lens' DeleteRemediationExceptionsResponse (Prelude.Maybe [FailedDeleteRemediationExceptionsBatch])
deleteRemediationExceptionsResponse_failedBatches :: Lens'
  DeleteRemediationExceptionsResponse
  (Maybe [FailedDeleteRemediationExceptionsBatch])
deleteRemediationExceptionsResponse_failedBatches = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteRemediationExceptionsResponse' {Maybe [FailedDeleteRemediationExceptionsBatch]
failedBatches :: Maybe [FailedDeleteRemediationExceptionsBatch]
$sel:failedBatches:DeleteRemediationExceptionsResponse' :: DeleteRemediationExceptionsResponse
-> Maybe [FailedDeleteRemediationExceptionsBatch]
failedBatches} -> Maybe [FailedDeleteRemediationExceptionsBatch]
failedBatches) (\s :: DeleteRemediationExceptionsResponse
s@DeleteRemediationExceptionsResponse' {} Maybe [FailedDeleteRemediationExceptionsBatch]
a -> DeleteRemediationExceptionsResponse
s {$sel:failedBatches:DeleteRemediationExceptionsResponse' :: Maybe [FailedDeleteRemediationExceptionsBatch]
failedBatches = Maybe [FailedDeleteRemediationExceptionsBatch]
a} :: DeleteRemediationExceptionsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The response's http status code.
deleteRemediationExceptionsResponse_httpStatus :: Lens.Lens' DeleteRemediationExceptionsResponse Prelude.Int
deleteRemediationExceptionsResponse_httpStatus :: Lens' DeleteRemediationExceptionsResponse Int
deleteRemediationExceptionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteRemediationExceptionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteRemediationExceptionsResponse' :: DeleteRemediationExceptionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DeleteRemediationExceptionsResponse
s@DeleteRemediationExceptionsResponse' {} Int
a -> DeleteRemediationExceptionsResponse
s {$sel:httpStatus:DeleteRemediationExceptionsResponse' :: Int
httpStatus = Int
a} :: DeleteRemediationExceptionsResponse)

instance
  Prelude.NFData
    DeleteRemediationExceptionsResponse
  where
  rnf :: DeleteRemediationExceptionsResponse -> ()
rnf DeleteRemediationExceptionsResponse' {Int
Maybe [FailedDeleteRemediationExceptionsBatch]
httpStatus :: Int
failedBatches :: Maybe [FailedDeleteRemediationExceptionsBatch]
$sel:httpStatus:DeleteRemediationExceptionsResponse' :: DeleteRemediationExceptionsResponse -> Int
$sel:failedBatches:DeleteRemediationExceptionsResponse' :: DeleteRemediationExceptionsResponse
-> Maybe [FailedDeleteRemediationExceptionsBatch]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FailedDeleteRemediationExceptionsBatch]
failedBatches
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus