{-# 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.DeleteConformancePack
-- 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 conformance pack and all the Config rules,
-- remediation actions, and all evaluation results within that conformance
-- pack.
--
-- Config sets the conformance pack to @DELETE_IN_PROGRESS@ until the
-- deletion is complete. You cannot update a conformance pack while it is
-- in this state.
module Amazonka.Config.DeleteConformancePack
  ( -- * Creating a Request
    DeleteConformancePack (..),
    newDeleteConformancePack,

    -- * Request Lenses
    deleteConformancePack_conformancePackName,

    -- * Destructuring the Response
    DeleteConformancePackResponse (..),
    newDeleteConformancePackResponse,
  )
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:/ 'newDeleteConformancePack' smart constructor.
data DeleteConformancePack = DeleteConformancePack'
  { -- | Name of the conformance pack you want to delete.
    DeleteConformancePack -> Text
conformancePackName :: Prelude.Text
  }
  deriving (DeleteConformancePack -> DeleteConformancePack -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteConformancePack -> DeleteConformancePack -> Bool
$c/= :: DeleteConformancePack -> DeleteConformancePack -> Bool
== :: DeleteConformancePack -> DeleteConformancePack -> Bool
$c== :: DeleteConformancePack -> DeleteConformancePack -> Bool
Prelude.Eq, ReadPrec [DeleteConformancePack]
ReadPrec DeleteConformancePack
Int -> ReadS DeleteConformancePack
ReadS [DeleteConformancePack]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteConformancePack]
$creadListPrec :: ReadPrec [DeleteConformancePack]
readPrec :: ReadPrec DeleteConformancePack
$creadPrec :: ReadPrec DeleteConformancePack
readList :: ReadS [DeleteConformancePack]
$creadList :: ReadS [DeleteConformancePack]
readsPrec :: Int -> ReadS DeleteConformancePack
$creadsPrec :: Int -> ReadS DeleteConformancePack
Prelude.Read, Int -> DeleteConformancePack -> ShowS
[DeleteConformancePack] -> ShowS
DeleteConformancePack -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteConformancePack] -> ShowS
$cshowList :: [DeleteConformancePack] -> ShowS
show :: DeleteConformancePack -> String
$cshow :: DeleteConformancePack -> String
showsPrec :: Int -> DeleteConformancePack -> ShowS
$cshowsPrec :: Int -> DeleteConformancePack -> ShowS
Prelude.Show, forall x. Rep DeleteConformancePack x -> DeleteConformancePack
forall x. DeleteConformancePack -> Rep DeleteConformancePack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteConformancePack x -> DeleteConformancePack
$cfrom :: forall x. DeleteConformancePack -> Rep DeleteConformancePack x
Prelude.Generic)

-- |
-- Create a value of 'DeleteConformancePack' 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:
--
-- 'conformancePackName', 'deleteConformancePack_conformancePackName' - Name of the conformance pack you want to delete.
newDeleteConformancePack ::
  -- | 'conformancePackName'
  Prelude.Text ->
  DeleteConformancePack
newDeleteConformancePack :: Text -> DeleteConformancePack
newDeleteConformancePack Text
pConformancePackName_ =
  DeleteConformancePack'
    { $sel:conformancePackName:DeleteConformancePack' :: Text
conformancePackName =
        Text
pConformancePackName_
    }

-- | Name of the conformance pack you want to delete.
deleteConformancePack_conformancePackName :: Lens.Lens' DeleteConformancePack Prelude.Text
deleteConformancePack_conformancePackName :: Lens' DeleteConformancePack Text
deleteConformancePack_conformancePackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteConformancePack' {Text
conformancePackName :: Text
$sel:conformancePackName:DeleteConformancePack' :: DeleteConformancePack -> Text
conformancePackName} -> Text
conformancePackName) (\s :: DeleteConformancePack
s@DeleteConformancePack' {} Text
a -> DeleteConformancePack
s {$sel:conformancePackName:DeleteConformancePack' :: Text
conformancePackName = Text
a} :: DeleteConformancePack)

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

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

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

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

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

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

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

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

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