{-# 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.MechanicalTurk.UpdateNotificationSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The @UpdateNotificationSettings@ operation creates, updates, disables or
-- re-enables notifications for a HIT type. If you call the
-- UpdateNotificationSettings operation for a HIT type that already has a
-- notification specification, the operation replaces the old specification
-- with a new one. You can call the UpdateNotificationSettings operation to
-- enable or disable notifications for the HIT type, without having to
-- modify the notification specification itself by providing updates to the
-- Active status without specifying a new notification specification. To
-- change the Active status of a HIT type\'s notifications, the HIT type
-- must already have a notification specification, or one must be provided
-- in the same call to @UpdateNotificationSettings@.
module Amazonka.MechanicalTurk.UpdateNotificationSettings
  ( -- * Creating a Request
    UpdateNotificationSettings (..),
    newUpdateNotificationSettings,

    -- * Request Lenses
    updateNotificationSettings_active,
    updateNotificationSettings_notification,
    updateNotificationSettings_hITTypeId,

    -- * Destructuring the Response
    UpdateNotificationSettingsResponse (..),
    newUpdateNotificationSettingsResponse,

    -- * Response Lenses
    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

-- | /See:/ 'newUpdateNotificationSettings' smart constructor.
data UpdateNotificationSettings = UpdateNotificationSettings'
  { -- | Specifies whether notifications are sent for HITs of this HIT type,
    -- according to the notification specification. You must specify either the
    -- Notification parameter or the Active parameter for the call to
    -- UpdateNotificationSettings to succeed.
    UpdateNotificationSettings -> Maybe Bool
active :: Prelude.Maybe Prelude.Bool,
    -- | The notification specification for the HIT type.
    UpdateNotificationSettings -> Maybe NotificationSpecification
notification :: Prelude.Maybe NotificationSpecification,
    -- | The ID of the HIT type whose notification specification is being
    -- updated.
    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)

-- |
-- Create a value of 'UpdateNotificationSettings' 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:
--
-- 'active', 'updateNotificationSettings_active' - Specifies whether notifications are sent for HITs of this HIT type,
-- according to the notification specification. You must specify either the
-- Notification parameter or the Active parameter for the call to
-- UpdateNotificationSettings to succeed.
--
-- 'notification', 'updateNotificationSettings_notification' - The notification specification for the HIT type.
--
-- 'hITTypeId', 'updateNotificationSettings_hITTypeId' - The ID of the HIT type whose notification specification is being
-- updated.
newUpdateNotificationSettings ::
  -- | 'hITTypeId'
  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_
    }

-- | Specifies whether notifications are sent for HITs of this HIT type,
-- according to the notification specification. You must specify either the
-- Notification parameter or the Active parameter for the call to
-- UpdateNotificationSettings to succeed.
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)

-- | The notification specification for the HIT type.
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)

-- | The ID of the HIT type whose notification specification is being
-- updated.
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

-- | /See:/ 'newUpdateNotificationSettingsResponse' smart constructor.
data UpdateNotificationSettingsResponse = UpdateNotificationSettingsResponse'
  { -- | The response's http status code.
    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)

-- |
-- Create a value of 'UpdateNotificationSettingsResponse' 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:
--
-- 'httpStatus', 'updateNotificationSettingsResponse_httpStatus' - The response's http status code.
newUpdateNotificationSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateNotificationSettingsResponse
newUpdateNotificationSettingsResponse :: Int -> UpdateNotificationSettingsResponse
newUpdateNotificationSettingsResponse Int
pHttpStatus_ =
  UpdateNotificationSettingsResponse'
    { $sel:httpStatus:UpdateNotificationSettingsResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

-- | The response's http status code.
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