{-# 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 #-}
module Amazonka.APIGateway.DeleteUsagePlan
(
DeleteUsagePlan (..),
newDeleteUsagePlan,
deleteUsagePlan_usagePlanId,
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
data DeleteUsagePlan = DeleteUsagePlan'
{
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)
newDeleteUsagePlan ::
Prelude.Text ->
DeleteUsagePlan
newDeleteUsagePlan :: Text -> DeleteUsagePlan
newDeleteUsagePlan Text
pUsagePlanId_ =
DeleteUsagePlan' {$sel:usagePlanId:DeleteUsagePlan' :: Text
usagePlanId = Text
pUsagePlanId_}
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
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)
newDeleteUsagePlanResponse ::
DeleteUsagePlanResponse
newDeleteUsagePlanResponse :: DeleteUsagePlanResponse
newDeleteUsagePlanResponse = DeleteUsagePlanResponse
DeleteUsagePlanResponse'
instance Prelude.NFData DeleteUsagePlanResponse where
rnf :: DeleteUsagePlanResponse -> ()
rnf DeleteUsagePlanResponse
_ = ()