{-# 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.APIGateway.DeleteApiKey
-- 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 ApiKey resource.
module Amazonka.APIGateway.DeleteApiKey
  ( -- * Creating a Request
    DeleteApiKey (..),
    newDeleteApiKey,

    -- * Request Lenses
    deleteApiKey_apiKey,

    -- * Destructuring the Response
    DeleteApiKeyResponse (..),
    newDeleteApiKeyResponse,
  )
where

import Amazonka.APIGateway.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

-- | A request to delete the ApiKey resource.
--
-- /See:/ 'newDeleteApiKey' smart constructor.
data DeleteApiKey = DeleteApiKey'
  { -- | The identifier of the ApiKey resource to be deleted.
    DeleteApiKey -> Text
apiKey :: Prelude.Text
  }
  deriving (DeleteApiKey -> DeleteApiKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteApiKey -> DeleteApiKey -> Bool
$c/= :: DeleteApiKey -> DeleteApiKey -> Bool
== :: DeleteApiKey -> DeleteApiKey -> Bool
$c== :: DeleteApiKey -> DeleteApiKey -> Bool
Prelude.Eq, ReadPrec [DeleteApiKey]
ReadPrec DeleteApiKey
Int -> ReadS DeleteApiKey
ReadS [DeleteApiKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteApiKey]
$creadListPrec :: ReadPrec [DeleteApiKey]
readPrec :: ReadPrec DeleteApiKey
$creadPrec :: ReadPrec DeleteApiKey
readList :: ReadS [DeleteApiKey]
$creadList :: ReadS [DeleteApiKey]
readsPrec :: Int -> ReadS DeleteApiKey
$creadsPrec :: Int -> ReadS DeleteApiKey
Prelude.Read, Int -> DeleteApiKey -> ShowS
[DeleteApiKey] -> ShowS
DeleteApiKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteApiKey] -> ShowS
$cshowList :: [DeleteApiKey] -> ShowS
show :: DeleteApiKey -> String
$cshow :: DeleteApiKey -> String
showsPrec :: Int -> DeleteApiKey -> ShowS
$cshowsPrec :: Int -> DeleteApiKey -> ShowS
Prelude.Show, forall x. Rep DeleteApiKey x -> DeleteApiKey
forall x. DeleteApiKey -> Rep DeleteApiKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteApiKey x -> DeleteApiKey
$cfrom :: forall x. DeleteApiKey -> Rep DeleteApiKey x
Prelude.Generic)

-- |
-- Create a value of 'DeleteApiKey' 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:
--
-- 'apiKey', 'deleteApiKey_apiKey' - The identifier of the ApiKey resource to be deleted.
newDeleteApiKey ::
  -- | 'apiKey'
  Prelude.Text ->
  DeleteApiKey
newDeleteApiKey :: Text -> DeleteApiKey
newDeleteApiKey Text
pApiKey_ =
  DeleteApiKey' {$sel:apiKey:DeleteApiKey' :: Text
apiKey = Text
pApiKey_}

-- | The identifier of the ApiKey resource to be deleted.
deleteApiKey_apiKey :: Lens.Lens' DeleteApiKey Prelude.Text
deleteApiKey_apiKey :: Lens' DeleteApiKey Text
deleteApiKey_apiKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApiKey' {Text
apiKey :: Text
$sel:apiKey:DeleteApiKey' :: DeleteApiKey -> Text
apiKey} -> Text
apiKey) (\s :: DeleteApiKey
s@DeleteApiKey' {} Text
a -> DeleteApiKey
s {$sel:apiKey:DeleteApiKey' :: Text
apiKey = Text
a} :: DeleteApiKey)

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

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

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

instance Data.ToHeaders DeleteApiKey where
  toHeaders :: DeleteApiKey -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Accept"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToPath DeleteApiKey where
  toPath :: DeleteApiKey -> ByteString
toPath DeleteApiKey' {Text
apiKey :: Text
$sel:apiKey:DeleteApiKey' :: DeleteApiKey -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/apikeys/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiKey]

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

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

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

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