{-# 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.UpdateNotificationSettings
(
UpdateNotificationSettings (..),
newUpdateNotificationSettings,
updateNotificationSettings_active,
updateNotificationSettings_notification,
updateNotificationSettings_hITTypeId,
UpdateNotificationSettingsResponse (..),
newUpdateNotificationSettingsResponse,
updateNotificationSettingsResponse_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 UpdateNotificationSettings = UpdateNotificationSettings'
{
UpdateNotificationSettings -> Maybe Bool
active :: Prelude.Maybe Prelude.Bool,
UpdateNotificationSettings -> Maybe NotificationSpecification
notification :: Prelude.Maybe NotificationSpecification,
UpdateNotificationSettings -> Text
hITTypeId :: Prelude.Text
}
deriving (UpdateNotificationSettings -> UpdateNotificationSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateNotificationSettings -> UpdateNotificationSettings -> Bool
$c/= :: UpdateNotificationSettings -> UpdateNotificationSettings -> Bool
== :: UpdateNotificationSettings -> UpdateNotificationSettings -> Bool
$c== :: UpdateNotificationSettings -> UpdateNotificationSettings -> Bool
Prelude.Eq, ReadPrec [UpdateNotificationSettings]
ReadPrec UpdateNotificationSettings
Int -> ReadS UpdateNotificationSettings
ReadS [UpdateNotificationSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateNotificationSettings]
$creadListPrec :: ReadPrec [UpdateNotificationSettings]
readPrec :: ReadPrec UpdateNotificationSettings
$creadPrec :: ReadPrec UpdateNotificationSettings
readList :: ReadS [UpdateNotificationSettings]
$creadList :: ReadS [UpdateNotificationSettings]
readsPrec :: Int -> ReadS UpdateNotificationSettings
$creadsPrec :: Int -> ReadS UpdateNotificationSettings
Prelude.Read, Int -> UpdateNotificationSettings -> ShowS
[UpdateNotificationSettings] -> ShowS
UpdateNotificationSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateNotificationSettings] -> ShowS
$cshowList :: [UpdateNotificationSettings] -> ShowS
show :: UpdateNotificationSettings -> String
$cshow :: UpdateNotificationSettings -> String
showsPrec :: Int -> UpdateNotificationSettings -> ShowS
$cshowsPrec :: Int -> UpdateNotificationSettings -> ShowS
Prelude.Show, forall x.
Rep UpdateNotificationSettings x -> UpdateNotificationSettings
forall x.
UpdateNotificationSettings -> Rep UpdateNotificationSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateNotificationSettings x -> UpdateNotificationSettings
$cfrom :: forall x.
UpdateNotificationSettings -> Rep UpdateNotificationSettings x
Prelude.Generic)
newUpdateNotificationSettings ::
Prelude.Text ->
UpdateNotificationSettings
newUpdateNotificationSettings :: Text -> UpdateNotificationSettings
newUpdateNotificationSettings Text
pHITTypeId_ =
UpdateNotificationSettings'
{ $sel:active:UpdateNotificationSettings' :: Maybe Bool
active =
forall a. Maybe a
Prelude.Nothing,
$sel:notification:UpdateNotificationSettings' :: Maybe NotificationSpecification
notification = forall a. Maybe a
Prelude.Nothing,
$sel:hITTypeId:UpdateNotificationSettings' :: Text
hITTypeId = Text
pHITTypeId_
}
updateNotificationSettings_active :: Lens.Lens' UpdateNotificationSettings (Prelude.Maybe Prelude.Bool)
updateNotificationSettings_active :: Lens' UpdateNotificationSettings (Maybe Bool)
updateNotificationSettings_active = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotificationSettings' {Maybe Bool
active :: Maybe Bool
$sel:active:UpdateNotificationSettings' :: UpdateNotificationSettings -> Maybe Bool
active} -> Maybe Bool
active) (\s :: UpdateNotificationSettings
s@UpdateNotificationSettings' {} Maybe Bool
a -> UpdateNotificationSettings
s {$sel:active:UpdateNotificationSettings' :: Maybe Bool
active = Maybe Bool
a} :: UpdateNotificationSettings)
updateNotificationSettings_notification :: Lens.Lens' UpdateNotificationSettings (Prelude.Maybe NotificationSpecification)
updateNotificationSettings_notification :: Lens' UpdateNotificationSettings (Maybe NotificationSpecification)
updateNotificationSettings_notification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotificationSettings' {Maybe NotificationSpecification
notification :: Maybe NotificationSpecification
$sel:notification:UpdateNotificationSettings' :: UpdateNotificationSettings -> Maybe NotificationSpecification
notification} -> Maybe NotificationSpecification
notification) (\s :: UpdateNotificationSettings
s@UpdateNotificationSettings' {} Maybe NotificationSpecification
a -> UpdateNotificationSettings
s {$sel:notification:UpdateNotificationSettings' :: Maybe NotificationSpecification
notification = Maybe NotificationSpecification
a} :: UpdateNotificationSettings)
updateNotificationSettings_hITTypeId :: Lens.Lens' UpdateNotificationSettings Prelude.Text
updateNotificationSettings_hITTypeId :: Lens' UpdateNotificationSettings Text
updateNotificationSettings_hITTypeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotificationSettings' {Text
hITTypeId :: Text
$sel:hITTypeId:UpdateNotificationSettings' :: UpdateNotificationSettings -> Text
hITTypeId} -> Text
hITTypeId) (\s :: UpdateNotificationSettings
s@UpdateNotificationSettings' {} Text
a -> UpdateNotificationSettings
s {$sel:hITTypeId:UpdateNotificationSettings' :: Text
hITTypeId = Text
a} :: UpdateNotificationSettings)
instance Core.AWSRequest UpdateNotificationSettings where
type
AWSResponse UpdateNotificationSettings =
UpdateNotificationSettingsResponse
request :: (Service -> Service)
-> UpdateNotificationSettings -> Request UpdateNotificationSettings
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 UpdateNotificationSettings
-> ClientResponse ClientBody
-> m (Either
Error (ClientResponse (AWSResponse UpdateNotificationSettings)))
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 -> UpdateNotificationSettingsResponse
UpdateNotificationSettingsResponse'
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 UpdateNotificationSettings where
hashWithSalt :: Int -> UpdateNotificationSettings -> Int
hashWithSalt Int
_salt UpdateNotificationSettings' {Maybe Bool
Maybe NotificationSpecification
Text
hITTypeId :: Text
notification :: Maybe NotificationSpecification
active :: Maybe Bool
$sel:hITTypeId:UpdateNotificationSettings' :: UpdateNotificationSettings -> Text
$sel:notification:UpdateNotificationSettings' :: UpdateNotificationSettings -> Maybe NotificationSpecification
$sel:active:UpdateNotificationSettings' :: UpdateNotificationSettings -> Maybe Bool
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
active
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NotificationSpecification
notification
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hITTypeId
instance Prelude.NFData UpdateNotificationSettings where
rnf :: UpdateNotificationSettings -> ()
rnf UpdateNotificationSettings' {Maybe Bool
Maybe NotificationSpecification
Text
hITTypeId :: Text
notification :: Maybe NotificationSpecification
active :: Maybe Bool
$sel:hITTypeId:UpdateNotificationSettings' :: UpdateNotificationSettings -> Text
$sel:notification:UpdateNotificationSettings' :: UpdateNotificationSettings -> Maybe NotificationSpecification
$sel:active:UpdateNotificationSettings' :: UpdateNotificationSettings -> Maybe Bool
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
active
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NotificationSpecification
notification
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hITTypeId
instance Data.ToHeaders UpdateNotificationSettings where
toHeaders :: UpdateNotificationSettings -> 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.UpdateNotificationSettings" ::
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 UpdateNotificationSettings where
toJSON :: UpdateNotificationSettings -> Value
toJSON UpdateNotificationSettings' {Maybe Bool
Maybe NotificationSpecification
Text
hITTypeId :: Text
notification :: Maybe NotificationSpecification
active :: Maybe Bool
$sel:hITTypeId:UpdateNotificationSettings' :: UpdateNotificationSettings -> Text
$sel:notification:UpdateNotificationSettings' :: UpdateNotificationSettings -> Maybe NotificationSpecification
$sel:active:UpdateNotificationSettings' :: UpdateNotificationSettings -> Maybe Bool
..} =
[Pair] -> Value
Data.object
( forall a. [Maybe a] -> [a]
Prelude.catMaybes
[ (Key
"Active" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
active,
(Key
"Notification" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe NotificationSpecification
notification,
forall a. a -> Maybe a
Prelude.Just (Key
"HITTypeId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hITTypeId)
]
)
instance Data.ToPath UpdateNotificationSettings where
toPath :: UpdateNotificationSettings -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"
instance Data.ToQuery UpdateNotificationSettings where
toQuery :: UpdateNotificationSettings -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
data UpdateNotificationSettingsResponse = UpdateNotificationSettingsResponse'
{
UpdateNotificationSettingsResponse -> Int
httpStatus :: Prelude.Int
}
deriving (UpdateNotificationSettingsResponse
-> UpdateNotificationSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateNotificationSettingsResponse
-> UpdateNotificationSettingsResponse -> Bool
$c/= :: UpdateNotificationSettingsResponse
-> UpdateNotificationSettingsResponse -> Bool
== :: UpdateNotificationSettingsResponse
-> UpdateNotificationSettingsResponse -> Bool
$c== :: UpdateNotificationSettingsResponse
-> UpdateNotificationSettingsResponse -> Bool
Prelude.Eq, ReadPrec [UpdateNotificationSettingsResponse]
ReadPrec UpdateNotificationSettingsResponse
Int -> ReadS UpdateNotificationSettingsResponse
ReadS [UpdateNotificationSettingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateNotificationSettingsResponse]
$creadListPrec :: ReadPrec [UpdateNotificationSettingsResponse]
readPrec :: ReadPrec UpdateNotificationSettingsResponse
$creadPrec :: ReadPrec UpdateNotificationSettingsResponse
readList :: ReadS [UpdateNotificationSettingsResponse]
$creadList :: ReadS [UpdateNotificationSettingsResponse]
readsPrec :: Int -> ReadS UpdateNotificationSettingsResponse
$creadsPrec :: Int -> ReadS UpdateNotificationSettingsResponse
Prelude.Read, Int -> UpdateNotificationSettingsResponse -> ShowS
[UpdateNotificationSettingsResponse] -> ShowS
UpdateNotificationSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateNotificationSettingsResponse] -> ShowS
$cshowList :: [UpdateNotificationSettingsResponse] -> ShowS
show :: UpdateNotificationSettingsResponse -> String
$cshow :: UpdateNotificationSettingsResponse -> String
showsPrec :: Int -> UpdateNotificationSettingsResponse -> ShowS
$cshowsPrec :: Int -> UpdateNotificationSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateNotificationSettingsResponse x
-> UpdateNotificationSettingsResponse
forall x.
UpdateNotificationSettingsResponse
-> Rep UpdateNotificationSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateNotificationSettingsResponse x
-> UpdateNotificationSettingsResponse
$cfrom :: forall x.
UpdateNotificationSettingsResponse
-> Rep UpdateNotificationSettingsResponse x
Prelude.Generic)
newUpdateNotificationSettingsResponse ::
Prelude.Int ->
UpdateNotificationSettingsResponse
newUpdateNotificationSettingsResponse :: Int -> UpdateNotificationSettingsResponse
newUpdateNotificationSettingsResponse Int
pHttpStatus_ =
UpdateNotificationSettingsResponse'
{ $sel:httpStatus:UpdateNotificationSettingsResponse' :: Int
httpStatus =
Int
pHttpStatus_
}
updateNotificationSettingsResponse_httpStatus :: Lens.Lens' UpdateNotificationSettingsResponse Prelude.Int
updateNotificationSettingsResponse_httpStatus :: Lens' UpdateNotificationSettingsResponse Int
updateNotificationSettingsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotificationSettingsResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateNotificationSettingsResponse' :: UpdateNotificationSettingsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateNotificationSettingsResponse
s@UpdateNotificationSettingsResponse' {} Int
a -> UpdateNotificationSettingsResponse
s {$sel:httpStatus:UpdateNotificationSettingsResponse' :: Int
httpStatus = Int
a} :: UpdateNotificationSettingsResponse)
instance
Prelude.NFData
UpdateNotificationSettingsResponse
where
rnf :: UpdateNotificationSettingsResponse -> ()
rnf UpdateNotificationSettingsResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateNotificationSettingsResponse' :: UpdateNotificationSettingsResponse -> Int
..} =
forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus