{-# 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.DeleteUsagePlan
-- 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 usage plan of a given plan Id.
module Amazonka.APIGateway.DeleteUsagePlan
  ( -- * Creating a Request
    DeleteUsagePlan (..),
    newDeleteUsagePlan,

    -- * Request Lenses
    deleteUsagePlan_usagePlanId,

    -- * Destructuring the Response
    DeleteUsagePlanResponse (..),
    newDeleteUsagePlanResponse,
  )
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

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

-- |
-- Create a value of 'DeleteUsagePlan' 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:
--
-- 'usagePlanId', 'deleteUsagePlan_usagePlanId' - The Id of the to-be-deleted usage plan.
newDeleteUsagePlan ::
  -- | 'usagePlanId'
  Prelude.Text ->
  DeleteUsagePlan
newDeleteUsagePlan :: Text -> DeleteUsagePlan
newDeleteUsagePlan Text
pUsagePlanId_ =
  DeleteUsagePlan' {$sel:usagePlanId:DeleteUsagePlan' :: Text
usagePlanId = Text
pUsagePlanId_}

-- | The Id of the to-be-deleted usage plan.
deleteUsagePlan_usagePlanId :: Lens.Lens' DeleteUsagePlan Prelude.Text
deleteUsagePlan_usagePlanId :: Lens' DeleteUsagePlan Text
deleteUsagePlan_usagePlanId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteUsagePlan' {Text
usagePlanId :: Text
$sel:usagePlanId:DeleteUsagePlan' :: DeleteUsagePlan -> Text
usagePlanId} -> Text
usagePlanId) (\s :: DeleteUsagePlan
s@DeleteUsagePlan' {} Text
a -> DeleteUsagePlan
s {$sel:usagePlanId:DeleteUsagePlan' :: Text
usagePlanId = Text
a} :: DeleteUsagePlan)

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

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

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

instance Data.ToHeaders DeleteUsagePlan where
  toHeaders :: DeleteUsagePlan -> [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 DeleteUsagePlan where
  toPath :: DeleteUsagePlan -> ByteString
toPath DeleteUsagePlan' {Text
usagePlanId :: Text
$sel:usagePlanId:DeleteUsagePlan' :: DeleteUsagePlan -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/usageplans/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
usagePlanId]

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

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

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

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