{-# 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.CloudFront.DeleteKeyGroup
-- 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 a key group.
--
-- You cannot delete a key group that is referenced in a cache behavior.
-- First update your distributions to remove the key group from all cache
-- behaviors, then delete the key group.
--
-- To delete a key group, you must provide the key group\'s identifier and
-- version. To get these values, use @ListKeyGroups@ followed by
-- @GetKeyGroup@ or @GetKeyGroupConfig@.
module Amazonka.CloudFront.DeleteKeyGroup
  ( -- * Creating a Request
    DeleteKeyGroup (..),
    newDeleteKeyGroup,

    -- * Request Lenses
    deleteKeyGroup_ifMatch,
    deleteKeyGroup_id,

    -- * Destructuring the Response
    DeleteKeyGroupResponse (..),
    newDeleteKeyGroupResponse,
  )
where

import Amazonka.CloudFront.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:/ 'newDeleteKeyGroup' smart constructor.
data DeleteKeyGroup = DeleteKeyGroup'
  { -- | The version of the key group that you are deleting. The version is the
    -- key group\'s @ETag@ value. To get the @ETag@, use @GetKeyGroup@ or
    -- @GetKeyGroupConfig@.
    DeleteKeyGroup -> Maybe Text
ifMatch :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the key group that you are deleting. To get the
    -- identifier, use @ListKeyGroups@.
    DeleteKeyGroup -> Text
id :: Prelude.Text
  }
  deriving (DeleteKeyGroup -> DeleteKeyGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteKeyGroup -> DeleteKeyGroup -> Bool
$c/= :: DeleteKeyGroup -> DeleteKeyGroup -> Bool
== :: DeleteKeyGroup -> DeleteKeyGroup -> Bool
$c== :: DeleteKeyGroup -> DeleteKeyGroup -> Bool
Prelude.Eq, ReadPrec [DeleteKeyGroup]
ReadPrec DeleteKeyGroup
Int -> ReadS DeleteKeyGroup
ReadS [DeleteKeyGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteKeyGroup]
$creadListPrec :: ReadPrec [DeleteKeyGroup]
readPrec :: ReadPrec DeleteKeyGroup
$creadPrec :: ReadPrec DeleteKeyGroup
readList :: ReadS [DeleteKeyGroup]
$creadList :: ReadS [DeleteKeyGroup]
readsPrec :: Int -> ReadS DeleteKeyGroup
$creadsPrec :: Int -> ReadS DeleteKeyGroup
Prelude.Read, Int -> DeleteKeyGroup -> ShowS
[DeleteKeyGroup] -> ShowS
DeleteKeyGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteKeyGroup] -> ShowS
$cshowList :: [DeleteKeyGroup] -> ShowS
show :: DeleteKeyGroup -> String
$cshow :: DeleteKeyGroup -> String
showsPrec :: Int -> DeleteKeyGroup -> ShowS
$cshowsPrec :: Int -> DeleteKeyGroup -> ShowS
Prelude.Show, forall x. Rep DeleteKeyGroup x -> DeleteKeyGroup
forall x. DeleteKeyGroup -> Rep DeleteKeyGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteKeyGroup x -> DeleteKeyGroup
$cfrom :: forall x. DeleteKeyGroup -> Rep DeleteKeyGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteKeyGroup' 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:
--
-- 'ifMatch', 'deleteKeyGroup_ifMatch' - The version of the key group that you are deleting. The version is the
-- key group\'s @ETag@ value. To get the @ETag@, use @GetKeyGroup@ or
-- @GetKeyGroupConfig@.
--
-- 'id', 'deleteKeyGroup_id' - The identifier of the key group that you are deleting. To get the
-- identifier, use @ListKeyGroups@.
newDeleteKeyGroup ::
  -- | 'id'
  Prelude.Text ->
  DeleteKeyGroup
newDeleteKeyGroup :: Text -> DeleteKeyGroup
newDeleteKeyGroup Text
pId_ =
  DeleteKeyGroup'
    { $sel:ifMatch:DeleteKeyGroup' :: Maybe Text
ifMatch = forall a. Maybe a
Prelude.Nothing,
      $sel:id:DeleteKeyGroup' :: Text
id = Text
pId_
    }

-- | The version of the key group that you are deleting. The version is the
-- key group\'s @ETag@ value. To get the @ETag@, use @GetKeyGroup@ or
-- @GetKeyGroupConfig@.
deleteKeyGroup_ifMatch :: Lens.Lens' DeleteKeyGroup (Prelude.Maybe Prelude.Text)
deleteKeyGroup_ifMatch :: Lens' DeleteKeyGroup (Maybe Text)
deleteKeyGroup_ifMatch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteKeyGroup' {Maybe Text
ifMatch :: Maybe Text
$sel:ifMatch:DeleteKeyGroup' :: DeleteKeyGroup -> Maybe Text
ifMatch} -> Maybe Text
ifMatch) (\s :: DeleteKeyGroup
s@DeleteKeyGroup' {} Maybe Text
a -> DeleteKeyGroup
s {$sel:ifMatch:DeleteKeyGroup' :: Maybe Text
ifMatch = Maybe Text
a} :: DeleteKeyGroup)

-- | The identifier of the key group that you are deleting. To get the
-- identifier, use @ListKeyGroups@.
deleteKeyGroup_id :: Lens.Lens' DeleteKeyGroup Prelude.Text
deleteKeyGroup_id :: Lens' DeleteKeyGroup Text
deleteKeyGroup_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteKeyGroup' {Text
id :: Text
$sel:id:DeleteKeyGroup' :: DeleteKeyGroup -> Text
id} -> Text
id) (\s :: DeleteKeyGroup
s@DeleteKeyGroup' {} Text
a -> DeleteKeyGroup
s {$sel:id:DeleteKeyGroup' :: Text
id = Text
a} :: DeleteKeyGroup)

instance Core.AWSRequest DeleteKeyGroup where
  type
    AWSResponse DeleteKeyGroup =
      DeleteKeyGroupResponse
  request :: (Service -> Service) -> DeleteKeyGroup -> Request DeleteKeyGroup
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteKeyGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteKeyGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteKeyGroupResponse
DeleteKeyGroupResponse'

instance Prelude.Hashable DeleteKeyGroup where
  hashWithSalt :: Int -> DeleteKeyGroup -> Int
hashWithSalt Int
_salt DeleteKeyGroup' {Maybe Text
Text
id :: Text
ifMatch :: Maybe Text
$sel:id:DeleteKeyGroup' :: DeleteKeyGroup -> Text
$sel:ifMatch:DeleteKeyGroup' :: DeleteKeyGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ifMatch
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData DeleteKeyGroup where
  rnf :: DeleteKeyGroup -> ()
rnf DeleteKeyGroup' {Maybe Text
Text
id :: Text
ifMatch :: Maybe Text
$sel:id:DeleteKeyGroup' :: DeleteKeyGroup -> Text
$sel:ifMatch:DeleteKeyGroup' :: DeleteKeyGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ifMatch seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders DeleteKeyGroup where
  toHeaders :: DeleteKeyGroup -> [Header]
toHeaders DeleteKeyGroup' {Maybe Text
Text
id :: Text
ifMatch :: Maybe Text
$sel:id:DeleteKeyGroup' :: DeleteKeyGroup -> Text
$sel:ifMatch:DeleteKeyGroup' :: DeleteKeyGroup -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [HeaderName
"If-Match" forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe Text
ifMatch]

instance Data.ToPath DeleteKeyGroup where
  toPath :: DeleteKeyGroup -> ByteString
toPath DeleteKeyGroup' {Maybe Text
Text
id :: Text
ifMatch :: Maybe Text
$sel:id:DeleteKeyGroup' :: DeleteKeyGroup -> Text
$sel:ifMatch:DeleteKeyGroup' :: DeleteKeyGroup -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/2020-05-31/key-group/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

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

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

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