{-# 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.MechanicalTurk.SendTestEventNotification
(
SendTestEventNotification (..),
newSendTestEventNotification,
sendTestEventNotification_notification,
sendTestEventNotification_testEventType,
SendTestEventNotificationResponse (..),
newSendTestEventNotificationResponse,
sendTestEventNotificationResponse_httpStatus,
)
where
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MechanicalTurk.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
data SendTestEventNotification = SendTestEventNotification'
{
SendTestEventNotification -> NotificationSpecification
notification :: NotificationSpecification,
SendTestEventNotification -> EventType
testEventType :: EventType
}
deriving (SendTestEventNotification -> SendTestEventNotification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendTestEventNotification -> SendTestEventNotification -> Bool
$c/= :: SendTestEventNotification -> SendTestEventNotification -> Bool
== :: SendTestEventNotification -> SendTestEventNotification -> Bool
$c== :: SendTestEventNotification -> SendTestEventNotification -> Bool
Prelude.Eq, ReadPrec [SendTestEventNotification]
ReadPrec SendTestEventNotification
Int -> ReadS SendTestEventNotification
ReadS [SendTestEventNotification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendTestEventNotification]
$creadListPrec :: ReadPrec [SendTestEventNotification]
readPrec :: ReadPrec SendTestEventNotification
$creadPrec :: ReadPrec SendTestEventNotification
readList :: ReadS [SendTestEventNotification]
$creadList :: ReadS [SendTestEventNotification]
readsPrec :: Int -> ReadS SendTestEventNotification
$creadsPrec :: Int -> ReadS SendTestEventNotification
Prelude.Read, Int -> SendTestEventNotification -> ShowS
[SendTestEventNotification] -> ShowS
SendTestEventNotification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendTestEventNotification] -> ShowS
$cshowList :: [SendTestEventNotification] -> ShowS
show :: SendTestEventNotification -> String
$cshow :: SendTestEventNotification -> String
showsPrec :: Int -> SendTestEventNotification -> ShowS
$cshowsPrec :: Int -> SendTestEventNotification -> ShowS
Prelude.Show, forall x.
Rep SendTestEventNotification x -> SendTestEventNotification
forall x.
SendTestEventNotification -> Rep SendTestEventNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SendTestEventNotification x -> SendTestEventNotification
$cfrom :: forall x.
SendTestEventNotification -> Rep SendTestEventNotification x
Prelude.Generic)
newSendTestEventNotification ::
NotificationSpecification ->
EventType ->
SendTestEventNotification
newSendTestEventNotification :: NotificationSpecification -> EventType -> SendTestEventNotification
newSendTestEventNotification
NotificationSpecification
pNotification_
EventType
pTestEventType_ =
SendTestEventNotification'
{ $sel:notification:SendTestEventNotification' :: NotificationSpecification
notification =
NotificationSpecification
pNotification_,
$sel:testEventType:SendTestEventNotification' :: EventType
testEventType = EventType
pTestEventType_
}
sendTestEventNotification_notification :: Lens.Lens' SendTestEventNotification NotificationSpecification
sendTestEventNotification_notification :: Lens' SendTestEventNotification NotificationSpecification
sendTestEventNotification_notification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendTestEventNotification' {NotificationSpecification
notification :: NotificationSpecification
$sel:notification:SendTestEventNotification' :: SendTestEventNotification -> NotificationSpecification
notification} -> NotificationSpecification
notification) (\s :: SendTestEventNotification
s@SendTestEventNotification' {} NotificationSpecification
a -> SendTestEventNotification
s {$sel:notification:SendTestEventNotification' :: NotificationSpecification
notification = NotificationSpecification
a} :: SendTestEventNotification)
sendTestEventNotification_testEventType :: Lens.Lens' SendTestEventNotification EventType
sendTestEventNotification_testEventType :: Lens' SendTestEventNotification EventType
sendTestEventNotification_testEventType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendTestEventNotification' {EventType
testEventType :: EventType
$sel:testEventType:SendTestEventNotification' :: SendTestEventNotification -> EventType
testEventType} -> EventType
testEventType) (\s :: SendTestEventNotification
s@SendTestEventNotification' {} EventType
a -> SendTestEventNotification
s {$sel:testEventType:SendTestEventNotification' :: EventType
testEventType = EventType
a} :: SendTestEventNotification)
instance Core.AWSRequest SendTestEventNotification where
type
AWSResponse SendTestEventNotification =
SendTestEventNotificationResponse
request :: (Service -> Service)
-> SendTestEventNotification -> Request SendTestEventNotification
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 SendTestEventNotification
-> ClientResponse ClientBody
-> m (Either
Error (ClientResponse (AWSResponse SendTestEventNotification)))
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 -> SendTestEventNotificationResponse
SendTestEventNotificationResponse'
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 SendTestEventNotification where
hashWithSalt :: Int -> SendTestEventNotification -> Int
hashWithSalt Int
_salt SendTestEventNotification' {EventType
NotificationSpecification
testEventType :: EventType
notification :: NotificationSpecification
$sel:testEventType:SendTestEventNotification' :: SendTestEventNotification -> EventType
$sel:notification:SendTestEventNotification' :: SendTestEventNotification -> NotificationSpecification
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NotificationSpecification
notification
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EventType
testEventType
instance Prelude.NFData SendTestEventNotification where
rnf :: SendTestEventNotification -> ()
rnf SendTestEventNotification' {EventType
NotificationSpecification
testEventType :: EventType
notification :: NotificationSpecification
$sel:testEventType:SendTestEventNotification' :: SendTestEventNotification -> EventType
$sel:notification:SendTestEventNotification' :: SendTestEventNotification -> NotificationSpecification
..} =
forall a. NFData a => a -> ()
Prelude.rnf NotificationSpecification
notification
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EventType
testEventType
instance Data.ToHeaders SendTestEventNotification where
toHeaders :: SendTestEventNotification -> 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
"MTurkRequesterServiceV20170117.SendTestEventNotification" ::
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 SendTestEventNotification where
toJSON :: SendTestEventNotification -> Value
toJSON SendTestEventNotification' {EventType
NotificationSpecification
testEventType :: EventType
notification :: NotificationSpecification
$sel:testEventType:SendTestEventNotification' :: SendTestEventNotification -> EventType
$sel:notification:SendTestEventNotification' :: SendTestEventNotification -> NotificationSpecification
..} =
[Pair] -> Value
Data.object
( forall a. [Maybe a] -> [a]
Prelude.catMaybes
[ forall a. a -> Maybe a
Prelude.Just (Key
"Notification" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NotificationSpecification
notification),
forall a. a -> Maybe a
Prelude.Just
(Key
"TestEventType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= EventType
testEventType)
]
)
instance Data.ToPath SendTestEventNotification where
toPath :: SendTestEventNotification -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"
instance Data.ToQuery SendTestEventNotification where
toQuery :: SendTestEventNotification -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
data SendTestEventNotificationResponse = SendTestEventNotificationResponse'
{
SendTestEventNotificationResponse -> Int
httpStatus :: Prelude.Int
}
deriving (SendTestEventNotificationResponse
-> SendTestEventNotificationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendTestEventNotificationResponse
-> SendTestEventNotificationResponse -> Bool
$c/= :: SendTestEventNotificationResponse
-> SendTestEventNotificationResponse -> Bool
== :: SendTestEventNotificationResponse
-> SendTestEventNotificationResponse -> Bool
$c== :: SendTestEventNotificationResponse
-> SendTestEventNotificationResponse -> Bool
Prelude.Eq, ReadPrec [SendTestEventNotificationResponse]
ReadPrec SendTestEventNotificationResponse
Int -> ReadS SendTestEventNotificationResponse
ReadS [SendTestEventNotificationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendTestEventNotificationResponse]
$creadListPrec :: ReadPrec [SendTestEventNotificationResponse]
readPrec :: ReadPrec SendTestEventNotificationResponse
$creadPrec :: ReadPrec SendTestEventNotificationResponse
readList :: ReadS [SendTestEventNotificationResponse]
$creadList :: ReadS [SendTestEventNotificationResponse]
readsPrec :: Int -> ReadS SendTestEventNotificationResponse
$creadsPrec :: Int -> ReadS SendTestEventNotificationResponse
Prelude.Read, Int -> SendTestEventNotificationResponse -> ShowS
[SendTestEventNotificationResponse] -> ShowS
SendTestEventNotificationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendTestEventNotificationResponse] -> ShowS
$cshowList :: [SendTestEventNotificationResponse] -> ShowS
show :: SendTestEventNotificationResponse -> String
$cshow :: SendTestEventNotificationResponse -> String
showsPrec :: Int -> SendTestEventNotificationResponse -> ShowS
$cshowsPrec :: Int -> SendTestEventNotificationResponse -> ShowS
Prelude.Show, forall x.
Rep SendTestEventNotificationResponse x
-> SendTestEventNotificationResponse
forall x.
SendTestEventNotificationResponse
-> Rep SendTestEventNotificationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SendTestEventNotificationResponse x
-> SendTestEventNotificationResponse
$cfrom :: forall x.
SendTestEventNotificationResponse
-> Rep SendTestEventNotificationResponse x
Prelude.Generic)
newSendTestEventNotificationResponse ::
Prelude.Int ->
SendTestEventNotificationResponse
newSendTestEventNotificationResponse :: Int -> SendTestEventNotificationResponse
newSendTestEventNotificationResponse Int
pHttpStatus_ =
SendTestEventNotificationResponse'
{ $sel:httpStatus:SendTestEventNotificationResponse' :: Int
httpStatus =
Int
pHttpStatus_
}
sendTestEventNotificationResponse_httpStatus :: Lens.Lens' SendTestEventNotificationResponse Prelude.Int
sendTestEventNotificationResponse_httpStatus :: Lens' SendTestEventNotificationResponse Int
sendTestEventNotificationResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendTestEventNotificationResponse' {Int
httpStatus :: Int
$sel:httpStatus:SendTestEventNotificationResponse' :: SendTestEventNotificationResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: SendTestEventNotificationResponse
s@SendTestEventNotificationResponse' {} Int
a -> SendTestEventNotificationResponse
s {$sel:httpStatus:SendTestEventNotificationResponse' :: Int
httpStatus = Int
a} :: SendTestEventNotificationResponse)
instance
Prelude.NFData
SendTestEventNotificationResponse
where
rnf :: SendTestEventNotificationResponse -> ()
rnf SendTestEventNotificationResponse' {Int
httpStatus :: Int
$sel:httpStatus:SendTestEventNotificationResponse' :: SendTestEventNotificationResponse -> Int
..} =
forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus