{-# 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.NotifyWorkers
-- 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 @NotifyWorkers@ operation sends an email to one or more Workers that
-- you specify with the Worker ID. You can specify up to 100 Worker IDs to
-- send the same message with a single call to the NotifyWorkers operation.
-- The NotifyWorkers operation will send a notification email to a Worker
-- only if you have previously approved or rejected work from the Worker.
module Amazonka.MechanicalTurk.NotifyWorkers
  ( -- * Creating a Request
    NotifyWorkers (..),
    newNotifyWorkers,

    -- * Request Lenses
    notifyWorkers_subject,
    notifyWorkers_messageText,
    notifyWorkers_workerIds,

    -- * Destructuring the Response
    NotifyWorkersResponse (..),
    newNotifyWorkersResponse,

    -- * Response Lenses
    notifyWorkersResponse_notifyWorkersFailureStatuses,
    notifyWorkersResponse_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:/ 'newNotifyWorkers' smart constructor.
data NotifyWorkers = NotifyWorkers'
  { -- | The subject line of the email message to send. Can include up to 200
    -- characters.
    NotifyWorkers -> Text
subject :: Prelude.Text,
    -- | The text of the email message to send. Can include up to 4,096
    -- characters
    NotifyWorkers -> Text
messageText :: Prelude.Text,
    -- | A list of Worker IDs you wish to notify. You can notify upto 100 Workers
    -- at a time.
    NotifyWorkers -> [Text]
workerIds :: [Prelude.Text]
  }
  deriving (NotifyWorkers -> NotifyWorkers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotifyWorkers -> NotifyWorkers -> Bool
$c/= :: NotifyWorkers -> NotifyWorkers -> Bool
== :: NotifyWorkers -> NotifyWorkers -> Bool
$c== :: NotifyWorkers -> NotifyWorkers -> Bool
Prelude.Eq, ReadPrec [NotifyWorkers]
ReadPrec NotifyWorkers
Int -> ReadS NotifyWorkers
ReadS [NotifyWorkers]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NotifyWorkers]
$creadListPrec :: ReadPrec [NotifyWorkers]
readPrec :: ReadPrec NotifyWorkers
$creadPrec :: ReadPrec NotifyWorkers
readList :: ReadS [NotifyWorkers]
$creadList :: ReadS [NotifyWorkers]
readsPrec :: Int -> ReadS NotifyWorkers
$creadsPrec :: Int -> ReadS NotifyWorkers
Prelude.Read, Int -> NotifyWorkers -> ShowS
[NotifyWorkers] -> ShowS
NotifyWorkers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotifyWorkers] -> ShowS
$cshowList :: [NotifyWorkers] -> ShowS
show :: NotifyWorkers -> String
$cshow :: NotifyWorkers -> String
showsPrec :: Int -> NotifyWorkers -> ShowS
$cshowsPrec :: Int -> NotifyWorkers -> ShowS
Prelude.Show, forall x. Rep NotifyWorkers x -> NotifyWorkers
forall x. NotifyWorkers -> Rep NotifyWorkers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NotifyWorkers x -> NotifyWorkers
$cfrom :: forall x. NotifyWorkers -> Rep NotifyWorkers x
Prelude.Generic)

-- |
-- Create a value of 'NotifyWorkers' 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:
--
-- 'subject', 'notifyWorkers_subject' - The subject line of the email message to send. Can include up to 200
-- characters.
--
-- 'messageText', 'notifyWorkers_messageText' - The text of the email message to send. Can include up to 4,096
-- characters
--
-- 'workerIds', 'notifyWorkers_workerIds' - A list of Worker IDs you wish to notify. You can notify upto 100 Workers
-- at a time.
newNotifyWorkers ::
  -- | 'subject'
  Prelude.Text ->
  -- | 'messageText'
  Prelude.Text ->
  NotifyWorkers
newNotifyWorkers :: Text -> Text -> NotifyWorkers
newNotifyWorkers Text
pSubject_ Text
pMessageText_ =
  NotifyWorkers'
    { $sel:subject:NotifyWorkers' :: Text
subject = Text
pSubject_,
      $sel:messageText:NotifyWorkers' :: Text
messageText = Text
pMessageText_,
      $sel:workerIds:NotifyWorkers' :: [Text]
workerIds = forall a. Monoid a => a
Prelude.mempty
    }

-- | The subject line of the email message to send. Can include up to 200
-- characters.
notifyWorkers_subject :: Lens.Lens' NotifyWorkers Prelude.Text
notifyWorkers_subject :: Lens' NotifyWorkers Text
notifyWorkers_subject = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NotifyWorkers' {Text
subject :: Text
$sel:subject:NotifyWorkers' :: NotifyWorkers -> Text
subject} -> Text
subject) (\s :: NotifyWorkers
s@NotifyWorkers' {} Text
a -> NotifyWorkers
s {$sel:subject:NotifyWorkers' :: Text
subject = Text
a} :: NotifyWorkers)

-- | The text of the email message to send. Can include up to 4,096
-- characters
notifyWorkers_messageText :: Lens.Lens' NotifyWorkers Prelude.Text
notifyWorkers_messageText :: Lens' NotifyWorkers Text
notifyWorkers_messageText = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NotifyWorkers' {Text
messageText :: Text
$sel:messageText:NotifyWorkers' :: NotifyWorkers -> Text
messageText} -> Text
messageText) (\s :: NotifyWorkers
s@NotifyWorkers' {} Text
a -> NotifyWorkers
s {$sel:messageText:NotifyWorkers' :: Text
messageText = Text
a} :: NotifyWorkers)

-- | A list of Worker IDs you wish to notify. You can notify upto 100 Workers
-- at a time.
notifyWorkers_workerIds :: Lens.Lens' NotifyWorkers [Prelude.Text]
notifyWorkers_workerIds :: Lens' NotifyWorkers [Text]
notifyWorkers_workerIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NotifyWorkers' {[Text]
workerIds :: [Text]
$sel:workerIds:NotifyWorkers' :: NotifyWorkers -> [Text]
workerIds} -> [Text]
workerIds) (\s :: NotifyWorkers
s@NotifyWorkers' {} [Text]
a -> NotifyWorkers
s {$sel:workerIds:NotifyWorkers' :: [Text]
workerIds = [Text]
a} :: NotifyWorkers) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest NotifyWorkers where
  type
    AWSResponse NotifyWorkers =
      NotifyWorkersResponse
  request :: (Service -> Service) -> NotifyWorkers -> Request NotifyWorkers
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 NotifyWorkers
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse NotifyWorkers)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [NotifyWorkersFailureStatus] -> Int -> NotifyWorkersResponse
NotifyWorkersResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NotifyWorkersFailureStatuses"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => 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 NotifyWorkers where
  hashWithSalt :: Int -> NotifyWorkers -> Int
hashWithSalt Int
_salt NotifyWorkers' {[Text]
Text
workerIds :: [Text]
messageText :: Text
subject :: Text
$sel:workerIds:NotifyWorkers' :: NotifyWorkers -> [Text]
$sel:messageText:NotifyWorkers' :: NotifyWorkers -> Text
$sel:subject:NotifyWorkers' :: NotifyWorkers -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
subject
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
messageText
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
workerIds

instance Prelude.NFData NotifyWorkers where
  rnf :: NotifyWorkers -> ()
rnf NotifyWorkers' {[Text]
Text
workerIds :: [Text]
messageText :: Text
subject :: Text
$sel:workerIds:NotifyWorkers' :: NotifyWorkers -> [Text]
$sel:messageText:NotifyWorkers' :: NotifyWorkers -> Text
$sel:subject:NotifyWorkers' :: NotifyWorkers -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
subject
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
messageText
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
workerIds

instance Data.ToHeaders NotifyWorkers where
  toHeaders :: NotifyWorkers -> 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.NotifyWorkers" ::
                          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 NotifyWorkers where
  toJSON :: NotifyWorkers -> Value
toJSON NotifyWorkers' {[Text]
Text
workerIds :: [Text]
messageText :: Text
subject :: Text
$sel:workerIds:NotifyWorkers' :: NotifyWorkers -> [Text]
$sel:messageText:NotifyWorkers' :: NotifyWorkers -> Text
$sel:subject:NotifyWorkers' :: NotifyWorkers -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Subject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
subject),
            forall a. a -> Maybe a
Prelude.Just (Key
"MessageText" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
messageText),
            forall a. a -> Maybe a
Prelude.Just (Key
"WorkerIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
workerIds)
          ]
      )

instance Data.ToPath NotifyWorkers where
  toPath :: NotifyWorkers -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery NotifyWorkers where
  toQuery :: NotifyWorkers -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newNotifyWorkersResponse' smart constructor.
data NotifyWorkersResponse = NotifyWorkersResponse'
  { -- | When MTurk sends notifications to the list of Workers, it returns back
    -- any failures it encounters in this list of NotifyWorkersFailureStatus
    -- objects.
    NotifyWorkersResponse -> Maybe [NotifyWorkersFailureStatus]
notifyWorkersFailureStatuses :: Prelude.Maybe [NotifyWorkersFailureStatus],
    -- | The response's http status code.
    NotifyWorkersResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (NotifyWorkersResponse -> NotifyWorkersResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotifyWorkersResponse -> NotifyWorkersResponse -> Bool
$c/= :: NotifyWorkersResponse -> NotifyWorkersResponse -> Bool
== :: NotifyWorkersResponse -> NotifyWorkersResponse -> Bool
$c== :: NotifyWorkersResponse -> NotifyWorkersResponse -> Bool
Prelude.Eq, ReadPrec [NotifyWorkersResponse]
ReadPrec NotifyWorkersResponse
Int -> ReadS NotifyWorkersResponse
ReadS [NotifyWorkersResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NotifyWorkersResponse]
$creadListPrec :: ReadPrec [NotifyWorkersResponse]
readPrec :: ReadPrec NotifyWorkersResponse
$creadPrec :: ReadPrec NotifyWorkersResponse
readList :: ReadS [NotifyWorkersResponse]
$creadList :: ReadS [NotifyWorkersResponse]
readsPrec :: Int -> ReadS NotifyWorkersResponse
$creadsPrec :: Int -> ReadS NotifyWorkersResponse
Prelude.Read, Int -> NotifyWorkersResponse -> ShowS
[NotifyWorkersResponse] -> ShowS
NotifyWorkersResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotifyWorkersResponse] -> ShowS
$cshowList :: [NotifyWorkersResponse] -> ShowS
show :: NotifyWorkersResponse -> String
$cshow :: NotifyWorkersResponse -> String
showsPrec :: Int -> NotifyWorkersResponse -> ShowS
$cshowsPrec :: Int -> NotifyWorkersResponse -> ShowS
Prelude.Show, forall x. Rep NotifyWorkersResponse x -> NotifyWorkersResponse
forall x. NotifyWorkersResponse -> Rep NotifyWorkersResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NotifyWorkersResponse x -> NotifyWorkersResponse
$cfrom :: forall x. NotifyWorkersResponse -> Rep NotifyWorkersResponse x
Prelude.Generic)

-- |
-- Create a value of 'NotifyWorkersResponse' 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:
--
-- 'notifyWorkersFailureStatuses', 'notifyWorkersResponse_notifyWorkersFailureStatuses' - When MTurk sends notifications to the list of Workers, it returns back
-- any failures it encounters in this list of NotifyWorkersFailureStatus
-- objects.
--
-- 'httpStatus', 'notifyWorkersResponse_httpStatus' - The response's http status code.
newNotifyWorkersResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  NotifyWorkersResponse
newNotifyWorkersResponse :: Int -> NotifyWorkersResponse
newNotifyWorkersResponse Int
pHttpStatus_ =
  NotifyWorkersResponse'
    { $sel:notifyWorkersFailureStatuses:NotifyWorkersResponse' :: Maybe [NotifyWorkersFailureStatus]
notifyWorkersFailureStatuses =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:NotifyWorkersResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | When MTurk sends notifications to the list of Workers, it returns back
-- any failures it encounters in this list of NotifyWorkersFailureStatus
-- objects.
notifyWorkersResponse_notifyWorkersFailureStatuses :: Lens.Lens' NotifyWorkersResponse (Prelude.Maybe [NotifyWorkersFailureStatus])
notifyWorkersResponse_notifyWorkersFailureStatuses :: Lens' NotifyWorkersResponse (Maybe [NotifyWorkersFailureStatus])
notifyWorkersResponse_notifyWorkersFailureStatuses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NotifyWorkersResponse' {Maybe [NotifyWorkersFailureStatus]
notifyWorkersFailureStatuses :: Maybe [NotifyWorkersFailureStatus]
$sel:notifyWorkersFailureStatuses:NotifyWorkersResponse' :: NotifyWorkersResponse -> Maybe [NotifyWorkersFailureStatus]
notifyWorkersFailureStatuses} -> Maybe [NotifyWorkersFailureStatus]
notifyWorkersFailureStatuses) (\s :: NotifyWorkersResponse
s@NotifyWorkersResponse' {} Maybe [NotifyWorkersFailureStatus]
a -> NotifyWorkersResponse
s {$sel:notifyWorkersFailureStatuses:NotifyWorkersResponse' :: Maybe [NotifyWorkersFailureStatus]
notifyWorkersFailureStatuses = Maybe [NotifyWorkersFailureStatus]
a} :: NotifyWorkersResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The response's http status code.
notifyWorkersResponse_httpStatus :: Lens.Lens' NotifyWorkersResponse Prelude.Int
notifyWorkersResponse_httpStatus :: Lens' NotifyWorkersResponse Int
notifyWorkersResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\NotifyWorkersResponse' {Int
httpStatus :: Int
$sel:httpStatus:NotifyWorkersResponse' :: NotifyWorkersResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: NotifyWorkersResponse
s@NotifyWorkersResponse' {} Int
a -> NotifyWorkersResponse
s {$sel:httpStatus:NotifyWorkersResponse' :: Int
httpStatus = Int
a} :: NotifyWorkersResponse)

instance Prelude.NFData NotifyWorkersResponse where
  rnf :: NotifyWorkersResponse -> ()
rnf NotifyWorkersResponse' {Int
Maybe [NotifyWorkersFailureStatus]
httpStatus :: Int
notifyWorkersFailureStatuses :: Maybe [NotifyWorkersFailureStatus]
$sel:httpStatus:NotifyWorkersResponse' :: NotifyWorkersResponse -> Int
$sel:notifyWorkersFailureStatuses:NotifyWorkersResponse' :: NotifyWorkersResponse -> Maybe [NotifyWorkersFailureStatus]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [NotifyWorkersFailureStatus]
notifyWorkersFailureStatuses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus