{-# 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.ApproveAssignment
-- 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 @ApproveAssignment@ operation approves the results of a completed
-- assignment.
--
-- Approving an assignment initiates two payments from the Requester\'s
-- Amazon.com account
--
-- -   The Worker who submitted the results is paid the reward specified in
--     the HIT.
--
-- -   Amazon Mechanical Turk fees are debited.
--
-- If the Requester\'s account does not have adequate funds for these
-- payments, the call to ApproveAssignment returns an exception, and the
-- approval is not processed. You can include an optional feedback message
-- with the approval, which the Worker can see in the Status section of the
-- web site.
--
-- You can also call this operation for assignments that were previous
-- rejected and approve them by explicitly overriding the previous
-- rejection. This only works on rejected assignments that were submitted
-- within the previous 30 days and only if the assignment\'s related HIT
-- has not been deleted.
module Amazonka.MechanicalTurk.ApproveAssignment
  ( -- * Creating a Request
    ApproveAssignment (..),
    newApproveAssignment,

    -- * Request Lenses
    approveAssignment_overrideRejection,
    approveAssignment_requesterFeedback,
    approveAssignment_assignmentId,

    -- * Destructuring the Response
    ApproveAssignmentResponse (..),
    newApproveAssignmentResponse,

    -- * Response Lenses
    approveAssignmentResponse_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:/ 'newApproveAssignment' smart constructor.
data ApproveAssignment = ApproveAssignment'
  { -- | A flag indicating that an assignment should be approved even if it was
    -- previously rejected. Defaults to @False@.
    ApproveAssignment -> Maybe Bool
overrideRejection :: Prelude.Maybe Prelude.Bool,
    -- | A message for the Worker, which the Worker can see in the Status section
    -- of the web site.
    ApproveAssignment -> Maybe Text
requesterFeedback :: Prelude.Maybe Prelude.Text,
    -- | The ID of the assignment. The assignment must correspond to a HIT
    -- created by the Requester.
    ApproveAssignment -> Text
assignmentId :: Prelude.Text
  }
  deriving (ApproveAssignment -> ApproveAssignment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApproveAssignment -> ApproveAssignment -> Bool
$c/= :: ApproveAssignment -> ApproveAssignment -> Bool
== :: ApproveAssignment -> ApproveAssignment -> Bool
$c== :: ApproveAssignment -> ApproveAssignment -> Bool
Prelude.Eq, ReadPrec [ApproveAssignment]
ReadPrec ApproveAssignment
Int -> ReadS ApproveAssignment
ReadS [ApproveAssignment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApproveAssignment]
$creadListPrec :: ReadPrec [ApproveAssignment]
readPrec :: ReadPrec ApproveAssignment
$creadPrec :: ReadPrec ApproveAssignment
readList :: ReadS [ApproveAssignment]
$creadList :: ReadS [ApproveAssignment]
readsPrec :: Int -> ReadS ApproveAssignment
$creadsPrec :: Int -> ReadS ApproveAssignment
Prelude.Read, Int -> ApproveAssignment -> ShowS
[ApproveAssignment] -> ShowS
ApproveAssignment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApproveAssignment] -> ShowS
$cshowList :: [ApproveAssignment] -> ShowS
show :: ApproveAssignment -> String
$cshow :: ApproveAssignment -> String
showsPrec :: Int -> ApproveAssignment -> ShowS
$cshowsPrec :: Int -> ApproveAssignment -> ShowS
Prelude.Show, forall x. Rep ApproveAssignment x -> ApproveAssignment
forall x. ApproveAssignment -> Rep ApproveAssignment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApproveAssignment x -> ApproveAssignment
$cfrom :: forall x. ApproveAssignment -> Rep ApproveAssignment x
Prelude.Generic)

-- |
-- Create a value of 'ApproveAssignment' 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:
--
-- 'overrideRejection', 'approveAssignment_overrideRejection' - A flag indicating that an assignment should be approved even if it was
-- previously rejected. Defaults to @False@.
--
-- 'requesterFeedback', 'approveAssignment_requesterFeedback' - A message for the Worker, which the Worker can see in the Status section
-- of the web site.
--
-- 'assignmentId', 'approveAssignment_assignmentId' - The ID of the assignment. The assignment must correspond to a HIT
-- created by the Requester.
newApproveAssignment ::
  -- | 'assignmentId'
  Prelude.Text ->
  ApproveAssignment
newApproveAssignment :: Text -> ApproveAssignment
newApproveAssignment Text
pAssignmentId_ =
  ApproveAssignment'
    { $sel:overrideRejection:ApproveAssignment' :: Maybe Bool
overrideRejection =
        forall a. Maybe a
Prelude.Nothing,
      $sel:requesterFeedback:ApproveAssignment' :: Maybe Text
requesterFeedback = forall a. Maybe a
Prelude.Nothing,
      $sel:assignmentId:ApproveAssignment' :: Text
assignmentId = Text
pAssignmentId_
    }

-- | A flag indicating that an assignment should be approved even if it was
-- previously rejected. Defaults to @False@.
approveAssignment_overrideRejection :: Lens.Lens' ApproveAssignment (Prelude.Maybe Prelude.Bool)
approveAssignment_overrideRejection :: Lens' ApproveAssignment (Maybe Bool)
approveAssignment_overrideRejection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApproveAssignment' {Maybe Bool
overrideRejection :: Maybe Bool
$sel:overrideRejection:ApproveAssignment' :: ApproveAssignment -> Maybe Bool
overrideRejection} -> Maybe Bool
overrideRejection) (\s :: ApproveAssignment
s@ApproveAssignment' {} Maybe Bool
a -> ApproveAssignment
s {$sel:overrideRejection:ApproveAssignment' :: Maybe Bool
overrideRejection = Maybe Bool
a} :: ApproveAssignment)

-- | A message for the Worker, which the Worker can see in the Status section
-- of the web site.
approveAssignment_requesterFeedback :: Lens.Lens' ApproveAssignment (Prelude.Maybe Prelude.Text)
approveAssignment_requesterFeedback :: Lens' ApproveAssignment (Maybe Text)
approveAssignment_requesterFeedback = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApproveAssignment' {Maybe Text
requesterFeedback :: Maybe Text
$sel:requesterFeedback:ApproveAssignment' :: ApproveAssignment -> Maybe Text
requesterFeedback} -> Maybe Text
requesterFeedback) (\s :: ApproveAssignment
s@ApproveAssignment' {} Maybe Text
a -> ApproveAssignment
s {$sel:requesterFeedback:ApproveAssignment' :: Maybe Text
requesterFeedback = Maybe Text
a} :: ApproveAssignment)

-- | The ID of the assignment. The assignment must correspond to a HIT
-- created by the Requester.
approveAssignment_assignmentId :: Lens.Lens' ApproveAssignment Prelude.Text
approveAssignment_assignmentId :: Lens' ApproveAssignment Text
approveAssignment_assignmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApproveAssignment' {Text
assignmentId :: Text
$sel:assignmentId:ApproveAssignment' :: ApproveAssignment -> Text
assignmentId} -> Text
assignmentId) (\s :: ApproveAssignment
s@ApproveAssignment' {} Text
a -> ApproveAssignment
s {$sel:assignmentId:ApproveAssignment' :: Text
assignmentId = Text
a} :: ApproveAssignment)

instance Core.AWSRequest ApproveAssignment where
  type
    AWSResponse ApproveAssignment =
      ApproveAssignmentResponse
  request :: (Service -> Service)
-> ApproveAssignment -> Request ApproveAssignment
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 ApproveAssignment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ApproveAssignment)))
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 -> ApproveAssignmentResponse
ApproveAssignmentResponse'
            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 ApproveAssignment where
  hashWithSalt :: Int -> ApproveAssignment -> Int
hashWithSalt Int
_salt ApproveAssignment' {Maybe Bool
Maybe Text
Text
assignmentId :: Text
requesterFeedback :: Maybe Text
overrideRejection :: Maybe Bool
$sel:assignmentId:ApproveAssignment' :: ApproveAssignment -> Text
$sel:requesterFeedback:ApproveAssignment' :: ApproveAssignment -> Maybe Text
$sel:overrideRejection:ApproveAssignment' :: ApproveAssignment -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
overrideRejection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requesterFeedback
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
assignmentId

instance Prelude.NFData ApproveAssignment where
  rnf :: ApproveAssignment -> ()
rnf ApproveAssignment' {Maybe Bool
Maybe Text
Text
assignmentId :: Text
requesterFeedback :: Maybe Text
overrideRejection :: Maybe Bool
$sel:assignmentId:ApproveAssignment' :: ApproveAssignment -> Text
$sel:requesterFeedback:ApproveAssignment' :: ApproveAssignment -> Maybe Text
$sel:overrideRejection:ApproveAssignment' :: ApproveAssignment -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
overrideRejection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requesterFeedback
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
assignmentId

instance Data.ToHeaders ApproveAssignment where
  toHeaders :: ApproveAssignment -> 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.ApproveAssignment" ::
                          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 ApproveAssignment where
  toJSON :: ApproveAssignment -> Value
toJSON ApproveAssignment' {Maybe Bool
Maybe Text
Text
assignmentId :: Text
requesterFeedback :: Maybe Text
overrideRejection :: Maybe Bool
$sel:assignmentId:ApproveAssignment' :: ApproveAssignment -> Text
$sel:requesterFeedback:ApproveAssignment' :: ApproveAssignment -> Maybe Text
$sel:overrideRejection:ApproveAssignment' :: ApproveAssignment -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"OverrideRejection" 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
overrideRejection,
            (Key
"RequesterFeedback" 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
requesterFeedback,
            forall a. a -> Maybe a
Prelude.Just (Key
"AssignmentId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
assignmentId)
          ]
      )

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

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

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

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

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

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