{-# 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.SendBonus
-- 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 @SendBonus@ operation issues a payment of money from your account to
-- a Worker. This payment happens separately from the reward you pay to the
-- Worker when you approve the Worker\'s assignment. The SendBonus
-- operation requires the Worker\'s ID and the assignment ID as parameters
-- to initiate payment of the bonus. You must include a message that
-- explains the reason for the bonus payment, as the Worker may not be
-- expecting the payment. Amazon Mechanical Turk collects a fee for bonus
-- payments, similar to the HIT listing fee. This operation fails if your
-- account does not have enough funds to pay for both the bonus and the
-- fees.
module Amazonka.MechanicalTurk.SendBonus
  ( -- * Creating a Request
    SendBonus (..),
    newSendBonus,

    -- * Request Lenses
    sendBonus_uniqueRequestToken,
    sendBonus_workerId,
    sendBonus_bonusAmount,
    sendBonus_assignmentId,
    sendBonus_reason,

    -- * Destructuring the Response
    SendBonusResponse (..),
    newSendBonusResponse,

    -- * Response Lenses
    sendBonusResponse_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:/ 'newSendBonus' smart constructor.
data SendBonus = SendBonus'
  { -- | A unique identifier for this request, which allows you to retry the call
    -- on error without granting multiple bonuses. This is useful in cases such
    -- as network timeouts where it is unclear whether or not the call
    -- succeeded on the server. If the bonus already exists in the system from
    -- a previous call using the same UniqueRequestToken, subsequent calls will
    -- return an error with a message containing the request ID.
    SendBonus -> Maybe Text
uniqueRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Worker being paid the bonus.
    SendBonus -> Text
workerId :: Prelude.Text,
    -- | The Bonus amount is a US Dollar amount specified using a string (for
    -- example, \"5\" represents $5.00 USD and \"101.42\" represents $101.42
    -- USD). Do not include currency symbols or currency codes.
    SendBonus -> Text
bonusAmount :: Prelude.Text,
    -- | The ID of the assignment for which this bonus is paid.
    SendBonus -> Text
assignmentId :: Prelude.Text,
    -- | A message that explains the reason for the bonus payment. The Worker
    -- receiving the bonus can see this message.
    SendBonus -> Text
reason :: Prelude.Text
  }
  deriving (SendBonus -> SendBonus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendBonus -> SendBonus -> Bool
$c/= :: SendBonus -> SendBonus -> Bool
== :: SendBonus -> SendBonus -> Bool
$c== :: SendBonus -> SendBonus -> Bool
Prelude.Eq, ReadPrec [SendBonus]
ReadPrec SendBonus
Int -> ReadS SendBonus
ReadS [SendBonus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendBonus]
$creadListPrec :: ReadPrec [SendBonus]
readPrec :: ReadPrec SendBonus
$creadPrec :: ReadPrec SendBonus
readList :: ReadS [SendBonus]
$creadList :: ReadS [SendBonus]
readsPrec :: Int -> ReadS SendBonus
$creadsPrec :: Int -> ReadS SendBonus
Prelude.Read, Int -> SendBonus -> ShowS
[SendBonus] -> ShowS
SendBonus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendBonus] -> ShowS
$cshowList :: [SendBonus] -> ShowS
show :: SendBonus -> String
$cshow :: SendBonus -> String
showsPrec :: Int -> SendBonus -> ShowS
$cshowsPrec :: Int -> SendBonus -> ShowS
Prelude.Show, forall x. Rep SendBonus x -> SendBonus
forall x. SendBonus -> Rep SendBonus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendBonus x -> SendBonus
$cfrom :: forall x. SendBonus -> Rep SendBonus x
Prelude.Generic)

-- |
-- Create a value of 'SendBonus' 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:
--
-- 'uniqueRequestToken', 'sendBonus_uniqueRequestToken' - A unique identifier for this request, which allows you to retry the call
-- on error without granting multiple bonuses. This is useful in cases such
-- as network timeouts where it is unclear whether or not the call
-- succeeded on the server. If the bonus already exists in the system from
-- a previous call using the same UniqueRequestToken, subsequent calls will
-- return an error with a message containing the request ID.
--
-- 'workerId', 'sendBonus_workerId' - The ID of the Worker being paid the bonus.
--
-- 'bonusAmount', 'sendBonus_bonusAmount' - The Bonus amount is a US Dollar amount specified using a string (for
-- example, \"5\" represents $5.00 USD and \"101.42\" represents $101.42
-- USD). Do not include currency symbols or currency codes.
--
-- 'assignmentId', 'sendBonus_assignmentId' - The ID of the assignment for which this bonus is paid.
--
-- 'reason', 'sendBonus_reason' - A message that explains the reason for the bonus payment. The Worker
-- receiving the bonus can see this message.
newSendBonus ::
  -- | 'workerId'
  Prelude.Text ->
  -- | 'bonusAmount'
  Prelude.Text ->
  -- | 'assignmentId'
  Prelude.Text ->
  -- | 'reason'
  Prelude.Text ->
  SendBonus
newSendBonus :: Text -> Text -> Text -> Text -> SendBonus
newSendBonus
  Text
pWorkerId_
  Text
pBonusAmount_
  Text
pAssignmentId_
  Text
pReason_ =
    SendBonus'
      { $sel:uniqueRequestToken:SendBonus' :: Maybe Text
uniqueRequestToken = forall a. Maybe a
Prelude.Nothing,
        $sel:workerId:SendBonus' :: Text
workerId = Text
pWorkerId_,
        $sel:bonusAmount:SendBonus' :: Text
bonusAmount = Text
pBonusAmount_,
        $sel:assignmentId:SendBonus' :: Text
assignmentId = Text
pAssignmentId_,
        $sel:reason:SendBonus' :: Text
reason = Text
pReason_
      }

-- | A unique identifier for this request, which allows you to retry the call
-- on error without granting multiple bonuses. This is useful in cases such
-- as network timeouts where it is unclear whether or not the call
-- succeeded on the server. If the bonus already exists in the system from
-- a previous call using the same UniqueRequestToken, subsequent calls will
-- return an error with a message containing the request ID.
sendBonus_uniqueRequestToken :: Lens.Lens' SendBonus (Prelude.Maybe Prelude.Text)
sendBonus_uniqueRequestToken :: Lens' SendBonus (Maybe Text)
sendBonus_uniqueRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBonus' {Maybe Text
uniqueRequestToken :: Maybe Text
$sel:uniqueRequestToken:SendBonus' :: SendBonus -> Maybe Text
uniqueRequestToken} -> Maybe Text
uniqueRequestToken) (\s :: SendBonus
s@SendBonus' {} Maybe Text
a -> SendBonus
s {$sel:uniqueRequestToken:SendBonus' :: Maybe Text
uniqueRequestToken = Maybe Text
a} :: SendBonus)

-- | The ID of the Worker being paid the bonus.
sendBonus_workerId :: Lens.Lens' SendBonus Prelude.Text
sendBonus_workerId :: Lens' SendBonus Text
sendBonus_workerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBonus' {Text
workerId :: Text
$sel:workerId:SendBonus' :: SendBonus -> Text
workerId} -> Text
workerId) (\s :: SendBonus
s@SendBonus' {} Text
a -> SendBonus
s {$sel:workerId:SendBonus' :: Text
workerId = Text
a} :: SendBonus)

-- | The Bonus amount is a US Dollar amount specified using a string (for
-- example, \"5\" represents $5.00 USD and \"101.42\" represents $101.42
-- USD). Do not include currency symbols or currency codes.
sendBonus_bonusAmount :: Lens.Lens' SendBonus Prelude.Text
sendBonus_bonusAmount :: Lens' SendBonus Text
sendBonus_bonusAmount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBonus' {Text
bonusAmount :: Text
$sel:bonusAmount:SendBonus' :: SendBonus -> Text
bonusAmount} -> Text
bonusAmount) (\s :: SendBonus
s@SendBonus' {} Text
a -> SendBonus
s {$sel:bonusAmount:SendBonus' :: Text
bonusAmount = Text
a} :: SendBonus)

-- | The ID of the assignment for which this bonus is paid.
sendBonus_assignmentId :: Lens.Lens' SendBonus Prelude.Text
sendBonus_assignmentId :: Lens' SendBonus Text
sendBonus_assignmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBonus' {Text
assignmentId :: Text
$sel:assignmentId:SendBonus' :: SendBonus -> Text
assignmentId} -> Text
assignmentId) (\s :: SendBonus
s@SendBonus' {} Text
a -> SendBonus
s {$sel:assignmentId:SendBonus' :: Text
assignmentId = Text
a} :: SendBonus)

-- | A message that explains the reason for the bonus payment. The Worker
-- receiving the bonus can see this message.
sendBonus_reason :: Lens.Lens' SendBonus Prelude.Text
sendBonus_reason :: Lens' SendBonus Text
sendBonus_reason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendBonus' {Text
reason :: Text
$sel:reason:SendBonus' :: SendBonus -> Text
reason} -> Text
reason) (\s :: SendBonus
s@SendBonus' {} Text
a -> SendBonus
s {$sel:reason:SendBonus' :: Text
reason = Text
a} :: SendBonus)

instance Core.AWSRequest SendBonus where
  type AWSResponse SendBonus = SendBonusResponse
  request :: (Service -> Service) -> SendBonus -> Request SendBonus
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 SendBonus
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SendBonus)))
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 -> SendBonusResponse
SendBonusResponse'
            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 SendBonus where
  hashWithSalt :: Int -> SendBonus -> Int
hashWithSalt Int
_salt SendBonus' {Maybe Text
Text
reason :: Text
assignmentId :: Text
bonusAmount :: Text
workerId :: Text
uniqueRequestToken :: Maybe Text
$sel:reason:SendBonus' :: SendBonus -> Text
$sel:assignmentId:SendBonus' :: SendBonus -> Text
$sel:bonusAmount:SendBonus' :: SendBonus -> Text
$sel:workerId:SendBonus' :: SendBonus -> Text
$sel:uniqueRequestToken:SendBonus' :: SendBonus -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
uniqueRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bonusAmount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
assignmentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
reason

instance Prelude.NFData SendBonus where
  rnf :: SendBonus -> ()
rnf SendBonus' {Maybe Text
Text
reason :: Text
assignmentId :: Text
bonusAmount :: Text
workerId :: Text
uniqueRequestToken :: Maybe Text
$sel:reason:SendBonus' :: SendBonus -> Text
$sel:assignmentId:SendBonus' :: SendBonus -> Text
$sel:bonusAmount:SendBonus' :: SendBonus -> Text
$sel:workerId:SendBonus' :: SendBonus -> Text
$sel:uniqueRequestToken:SendBonus' :: SendBonus -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
uniqueRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bonusAmount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
assignmentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
reason

instance Data.ToHeaders SendBonus where
  toHeaders :: SendBonus -> 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.SendBonus" ::
                          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 SendBonus where
  toJSON :: SendBonus -> Value
toJSON SendBonus' {Maybe Text
Text
reason :: Text
assignmentId :: Text
bonusAmount :: Text
workerId :: Text
uniqueRequestToken :: Maybe Text
$sel:reason:SendBonus' :: SendBonus -> Text
$sel:assignmentId:SendBonus' :: SendBonus -> Text
$sel:bonusAmount:SendBonus' :: SendBonus -> Text
$sel:workerId:SendBonus' :: SendBonus -> Text
$sel:uniqueRequestToken:SendBonus' :: SendBonus -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"UniqueRequestToken" 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 Text
uniqueRequestToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"WorkerId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workerId),
            forall a. a -> Maybe a
Prelude.Just (Key
"BonusAmount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
bonusAmount),
            forall a. a -> Maybe a
Prelude.Just (Key
"AssignmentId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
assignmentId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Reason" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
reason)
          ]
      )

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

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

-- | /See:/ 'newSendBonusResponse' smart constructor.
data SendBonusResponse = SendBonusResponse'
  { -- | The response's http status code.
    SendBonusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SendBonusResponse -> SendBonusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendBonusResponse -> SendBonusResponse -> Bool
$c/= :: SendBonusResponse -> SendBonusResponse -> Bool
== :: SendBonusResponse -> SendBonusResponse -> Bool
$c== :: SendBonusResponse -> SendBonusResponse -> Bool
Prelude.Eq, ReadPrec [SendBonusResponse]
ReadPrec SendBonusResponse
Int -> ReadS SendBonusResponse
ReadS [SendBonusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendBonusResponse]
$creadListPrec :: ReadPrec [SendBonusResponse]
readPrec :: ReadPrec SendBonusResponse
$creadPrec :: ReadPrec SendBonusResponse
readList :: ReadS [SendBonusResponse]
$creadList :: ReadS [SendBonusResponse]
readsPrec :: Int -> ReadS SendBonusResponse
$creadsPrec :: Int -> ReadS SendBonusResponse
Prelude.Read, Int -> SendBonusResponse -> ShowS
[SendBonusResponse] -> ShowS
SendBonusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendBonusResponse] -> ShowS
$cshowList :: [SendBonusResponse] -> ShowS
show :: SendBonusResponse -> String
$cshow :: SendBonusResponse -> String
showsPrec :: Int -> SendBonusResponse -> ShowS
$cshowsPrec :: Int -> SendBonusResponse -> ShowS
Prelude.Show, forall x. Rep SendBonusResponse x -> SendBonusResponse
forall x. SendBonusResponse -> Rep SendBonusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendBonusResponse x -> SendBonusResponse
$cfrom :: forall x. SendBonusResponse -> Rep SendBonusResponse x
Prelude.Generic)

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

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

instance Prelude.NFData SendBonusResponse where
  rnf :: SendBonusResponse -> ()
rnf SendBonusResponse' {Int
httpStatus :: Int
$sel:httpStatus:SendBonusResponse' :: SendBonusResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus