{-# 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.DirectoryService.DeleteLogSubscription
(
DeleteLogSubscription (..),
newDeleteLogSubscription,
deleteLogSubscription_directoryId,
DeleteLogSubscriptionResponse (..),
newDeleteLogSubscriptionResponse,
deleteLogSubscriptionResponse_httpStatus,
)
where
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DirectoryService.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
data DeleteLogSubscription = DeleteLogSubscription'
{
DeleteLogSubscription -> Text
directoryId :: Prelude.Text
}
deriving (DeleteLogSubscription -> DeleteLogSubscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteLogSubscription -> DeleteLogSubscription -> Bool
$c/= :: DeleteLogSubscription -> DeleteLogSubscription -> Bool
== :: DeleteLogSubscription -> DeleteLogSubscription -> Bool
$c== :: DeleteLogSubscription -> DeleteLogSubscription -> Bool
Prelude.Eq, ReadPrec [DeleteLogSubscription]
ReadPrec DeleteLogSubscription
Int -> ReadS DeleteLogSubscription
ReadS [DeleteLogSubscription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteLogSubscription]
$creadListPrec :: ReadPrec [DeleteLogSubscription]
readPrec :: ReadPrec DeleteLogSubscription
$creadPrec :: ReadPrec DeleteLogSubscription
readList :: ReadS [DeleteLogSubscription]
$creadList :: ReadS [DeleteLogSubscription]
readsPrec :: Int -> ReadS DeleteLogSubscription
$creadsPrec :: Int -> ReadS DeleteLogSubscription
Prelude.Read, Int -> DeleteLogSubscription -> ShowS
[DeleteLogSubscription] -> ShowS
DeleteLogSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteLogSubscription] -> ShowS
$cshowList :: [DeleteLogSubscription] -> ShowS
show :: DeleteLogSubscription -> String
$cshow :: DeleteLogSubscription -> String
showsPrec :: Int -> DeleteLogSubscription -> ShowS
$cshowsPrec :: Int -> DeleteLogSubscription -> ShowS
Prelude.Show, forall x. Rep DeleteLogSubscription x -> DeleteLogSubscription
forall x. DeleteLogSubscription -> Rep DeleteLogSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteLogSubscription x -> DeleteLogSubscription
$cfrom :: forall x. DeleteLogSubscription -> Rep DeleteLogSubscription x
Prelude.Generic)
newDeleteLogSubscription ::
Prelude.Text ->
DeleteLogSubscription
newDeleteLogSubscription :: Text -> DeleteLogSubscription
newDeleteLogSubscription Text
pDirectoryId_ =
DeleteLogSubscription' {$sel:directoryId:DeleteLogSubscription' :: Text
directoryId = Text
pDirectoryId_}
deleteLogSubscription_directoryId :: Lens.Lens' DeleteLogSubscription Prelude.Text
deleteLogSubscription_directoryId :: Lens' DeleteLogSubscription Text
deleteLogSubscription_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteLogSubscription' {Text
directoryId :: Text
$sel:directoryId:DeleteLogSubscription' :: DeleteLogSubscription -> Text
directoryId} -> Text
directoryId) (\s :: DeleteLogSubscription
s@DeleteLogSubscription' {} Text
a -> DeleteLogSubscription
s {$sel:directoryId:DeleteLogSubscription' :: Text
directoryId = Text
a} :: DeleteLogSubscription)
instance Core.AWSRequest DeleteLogSubscription where
type
AWSResponse DeleteLogSubscription =
DeleteLogSubscriptionResponse
request :: (Service -> Service)
-> DeleteLogSubscription -> Request DeleteLogSubscription
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 DeleteLogSubscription
-> ClientResponse ClientBody
-> m (Either
Error (ClientResponse (AWSResponse DeleteLogSubscription)))
response =
forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
( \Int
s ResponseHeaders
h ()
x ->
Int -> DeleteLogSubscriptionResponse
DeleteLogSubscriptionResponse'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
)
instance Prelude.Hashable DeleteLogSubscription where
hashWithSalt :: Int -> DeleteLogSubscription -> Int
hashWithSalt Int
_salt DeleteLogSubscription' {Text
directoryId :: Text
$sel:directoryId:DeleteLogSubscription' :: DeleteLogSubscription -> Text
..} =
Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
instance Prelude.NFData DeleteLogSubscription where
rnf :: DeleteLogSubscription -> ()
rnf DeleteLogSubscription' {Text
directoryId :: Text
$sel:directoryId:DeleteLogSubscription' :: DeleteLogSubscription -> Text
..} =
forall a. NFData a => a -> ()
Prelude.rnf Text
directoryId
instance Data.ToHeaders DeleteLogSubscription where
toHeaders :: DeleteLogSubscription -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"DirectoryService_20150416.DeleteLogSubscription" ::
Prelude.ByteString
),
HeaderName
"Content-Type"
forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
Prelude.ByteString
)
]
)
instance Data.ToJSON DeleteLogSubscription where
toJSON :: DeleteLogSubscription -> Value
toJSON DeleteLogSubscription' {Text
directoryId :: Text
$sel:directoryId:DeleteLogSubscription' :: DeleteLogSubscription -> Text
..} =
[Pair] -> Value
Data.object
( forall a. [Maybe a] -> [a]
Prelude.catMaybes
[forall a. a -> Maybe a
Prelude.Just (Key
"DirectoryId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
directoryId)]
)
instance Data.ToPath DeleteLogSubscription where
toPath :: DeleteLogSubscription -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"
instance Data.ToQuery DeleteLogSubscription where
toQuery :: DeleteLogSubscription -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
data DeleteLogSubscriptionResponse = DeleteLogSubscriptionResponse'
{
DeleteLogSubscriptionResponse -> Int
httpStatus :: Prelude.Int
}
deriving (DeleteLogSubscriptionResponse
-> DeleteLogSubscriptionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteLogSubscriptionResponse
-> DeleteLogSubscriptionResponse -> Bool
$c/= :: DeleteLogSubscriptionResponse
-> DeleteLogSubscriptionResponse -> Bool
== :: DeleteLogSubscriptionResponse
-> DeleteLogSubscriptionResponse -> Bool
$c== :: DeleteLogSubscriptionResponse
-> DeleteLogSubscriptionResponse -> Bool
Prelude.Eq, ReadPrec [DeleteLogSubscriptionResponse]
ReadPrec DeleteLogSubscriptionResponse
Int -> ReadS DeleteLogSubscriptionResponse
ReadS [DeleteLogSubscriptionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteLogSubscriptionResponse]
$creadListPrec :: ReadPrec [DeleteLogSubscriptionResponse]
readPrec :: ReadPrec DeleteLogSubscriptionResponse
$creadPrec :: ReadPrec DeleteLogSubscriptionResponse
readList :: ReadS [DeleteLogSubscriptionResponse]
$creadList :: ReadS [DeleteLogSubscriptionResponse]
readsPrec :: Int -> ReadS DeleteLogSubscriptionResponse
$creadsPrec :: Int -> ReadS DeleteLogSubscriptionResponse
Prelude.Read, Int -> DeleteLogSubscriptionResponse -> ShowS
[DeleteLogSubscriptionResponse] -> ShowS
DeleteLogSubscriptionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteLogSubscriptionResponse] -> ShowS
$cshowList :: [DeleteLogSubscriptionResponse] -> ShowS
show :: DeleteLogSubscriptionResponse -> String
$cshow :: DeleteLogSubscriptionResponse -> String
showsPrec :: Int -> DeleteLogSubscriptionResponse -> ShowS
$cshowsPrec :: Int -> DeleteLogSubscriptionResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteLogSubscriptionResponse x
-> DeleteLogSubscriptionResponse
forall x.
DeleteLogSubscriptionResponse
-> Rep DeleteLogSubscriptionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteLogSubscriptionResponse x
-> DeleteLogSubscriptionResponse
$cfrom :: forall x.
DeleteLogSubscriptionResponse
-> Rep DeleteLogSubscriptionResponse x
Prelude.Generic)
newDeleteLogSubscriptionResponse ::
Prelude.Int ->
DeleteLogSubscriptionResponse
newDeleteLogSubscriptionResponse :: Int -> DeleteLogSubscriptionResponse
newDeleteLogSubscriptionResponse Int
pHttpStatus_ =
DeleteLogSubscriptionResponse'
{ $sel:httpStatus:DeleteLogSubscriptionResponse' :: Int
httpStatus =
Int
pHttpStatus_
}
deleteLogSubscriptionResponse_httpStatus :: Lens.Lens' DeleteLogSubscriptionResponse Prelude.Int
deleteLogSubscriptionResponse_httpStatus :: Lens' DeleteLogSubscriptionResponse Int
deleteLogSubscriptionResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteLogSubscriptionResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteLogSubscriptionResponse' :: DeleteLogSubscriptionResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DeleteLogSubscriptionResponse
s@DeleteLogSubscriptionResponse' {} Int
a -> DeleteLogSubscriptionResponse
s {$sel:httpStatus:DeleteLogSubscriptionResponse' :: Int
httpStatus = Int
a} :: DeleteLogSubscriptionResponse)
instance Prelude.NFData DeleteLogSubscriptionResponse where
rnf :: DeleteLogSubscriptionResponse -> ()
rnf DeleteLogSubscriptionResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteLogSubscriptionResponse' :: DeleteLogSubscriptionResponse -> Int
..} =
forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus