{-# 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.UpdateQualificationType
-- 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 @UpdateQualificationType@ operation modifies the attributes of an
-- existing Qualification type, which is represented by a QualificationType
-- data structure. Only the owner of a Qualification type can modify its
-- attributes.
--
-- Most attributes of a Qualification type can be changed after the type
-- has been created. However, the Name and Keywords fields cannot be
-- modified. The RetryDelayInSeconds parameter can be modified or added to
-- change the delay or to enable retries, but RetryDelayInSeconds cannot be
-- used to disable retries.
--
-- You can use this operation to update the test for a Qualification type.
-- The test is updated based on the values specified for the Test,
-- TestDurationInSeconds and AnswerKey parameters. All three parameters
-- specify the updated test. If you are updating the test for a type, you
-- must specify the Test and TestDurationInSeconds parameters. The
-- AnswerKey parameter is optional; omitting it specifies that the updated
-- test does not have an answer key.
--
-- If you omit the Test parameter, the test for the Qualification type is
-- unchanged. There is no way to remove a test from a Qualification type
-- that has one. If the type already has a test, you cannot update it to be
-- AutoGranted. If the Qualification type does not have a test and one is
-- provided by an update, the type will henceforth have a test.
--
-- If you want to update the test duration or answer key for an existing
-- test without changing the questions, you must specify a Test parameter
-- with the original questions, along with the updated values.
--
-- If you provide an updated Test but no AnswerKey, the new test will not
-- have an answer key. Requests for such Qualifications must be granted
-- manually.
--
-- You can also update the AutoGranted and AutoGrantedValue attributes of
-- the Qualification type.
module Amazonka.MechanicalTurk.UpdateQualificationType
  ( -- * Creating a Request
    UpdateQualificationType (..),
    newUpdateQualificationType,

    -- * Request Lenses
    updateQualificationType_answerKey,
    updateQualificationType_autoGranted,
    updateQualificationType_autoGrantedValue,
    updateQualificationType_description,
    updateQualificationType_qualificationTypeStatus,
    updateQualificationType_retryDelayInSeconds,
    updateQualificationType_test,
    updateQualificationType_testDurationInSeconds,
    updateQualificationType_qualificationTypeId,

    -- * Destructuring the Response
    UpdateQualificationTypeResponse (..),
    newUpdateQualificationTypeResponse,

    -- * Response Lenses
    updateQualificationTypeResponse_qualificationType,
    updateQualificationTypeResponse_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:/ 'newUpdateQualificationType' smart constructor.
data UpdateQualificationType = UpdateQualificationType'
  { -- | The answers to the Qualification test specified in the Test parameter,
    -- in the form of an AnswerKey data structure.
    UpdateQualificationType -> Maybe Text
answerKey :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether requests for the Qualification type are granted
    -- immediately, without prompting the Worker with a Qualification test.
    --
    -- Constraints: If the Test parameter is specified, this parameter cannot
    -- be true.
    UpdateQualificationType -> Maybe Bool
autoGranted :: Prelude.Maybe Prelude.Bool,
    -- | The Qualification value to use for automatically granted Qualifications.
    -- This parameter is used only if the AutoGranted parameter is true.
    UpdateQualificationType -> Maybe Int
autoGrantedValue :: Prelude.Maybe Prelude.Int,
    -- | The new description of the Qualification type.
    UpdateQualificationType -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The new status of the Qualification type - Active | Inactive
    UpdateQualificationType -> Maybe QualificationTypeStatus
qualificationTypeStatus :: Prelude.Maybe QualificationTypeStatus,
    -- | The amount of time, in seconds, that Workers must wait after requesting
    -- a Qualification of the specified Qualification type before they can
    -- retry the Qualification request. It is not possible to disable retries
    -- for a Qualification type after it has been created with retries enabled.
    -- If you want to disable retries, you must dispose of the existing
    -- retry-enabled Qualification type using DisposeQualificationType and then
    -- create a new Qualification type with retries disabled using
    -- CreateQualificationType.
    UpdateQualificationType -> Maybe Integer
retryDelayInSeconds :: Prelude.Maybe Prelude.Integer,
    -- | The questions for the Qualification test a Worker must answer correctly
    -- to obtain a Qualification of this type. If this parameter is specified,
    -- @TestDurationInSeconds@ must also be specified.
    --
    -- Constraints: Must not be longer than 65535 bytes. Must be a QuestionForm
    -- data structure. This parameter cannot be specified if AutoGranted is
    -- true.
    --
    -- Constraints: None. If not specified, the Worker may request the
    -- Qualification without answering any questions.
    UpdateQualificationType -> Maybe Text
test :: Prelude.Maybe Prelude.Text,
    -- | The number of seconds the Worker has to complete the Qualification test,
    -- starting from the time the Worker requests the Qualification.
    UpdateQualificationType -> Maybe Integer
testDurationInSeconds :: Prelude.Maybe Prelude.Integer,
    -- | The ID of the Qualification type to update.
    UpdateQualificationType -> Text
qualificationTypeId :: Prelude.Text
  }
  deriving (UpdateQualificationType -> UpdateQualificationType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateQualificationType -> UpdateQualificationType -> Bool
$c/= :: UpdateQualificationType -> UpdateQualificationType -> Bool
== :: UpdateQualificationType -> UpdateQualificationType -> Bool
$c== :: UpdateQualificationType -> UpdateQualificationType -> Bool
Prelude.Eq, ReadPrec [UpdateQualificationType]
ReadPrec UpdateQualificationType
Int -> ReadS UpdateQualificationType
ReadS [UpdateQualificationType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateQualificationType]
$creadListPrec :: ReadPrec [UpdateQualificationType]
readPrec :: ReadPrec UpdateQualificationType
$creadPrec :: ReadPrec UpdateQualificationType
readList :: ReadS [UpdateQualificationType]
$creadList :: ReadS [UpdateQualificationType]
readsPrec :: Int -> ReadS UpdateQualificationType
$creadsPrec :: Int -> ReadS UpdateQualificationType
Prelude.Read, Int -> UpdateQualificationType -> ShowS
[UpdateQualificationType] -> ShowS
UpdateQualificationType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateQualificationType] -> ShowS
$cshowList :: [UpdateQualificationType] -> ShowS
show :: UpdateQualificationType -> String
$cshow :: UpdateQualificationType -> String
showsPrec :: Int -> UpdateQualificationType -> ShowS
$cshowsPrec :: Int -> UpdateQualificationType -> ShowS
Prelude.Show, forall x. Rep UpdateQualificationType x -> UpdateQualificationType
forall x. UpdateQualificationType -> Rep UpdateQualificationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateQualificationType x -> UpdateQualificationType
$cfrom :: forall x. UpdateQualificationType -> Rep UpdateQualificationType x
Prelude.Generic)

-- |
-- Create a value of 'UpdateQualificationType' 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:
--
-- 'answerKey', 'updateQualificationType_answerKey' - The answers to the Qualification test specified in the Test parameter,
-- in the form of an AnswerKey data structure.
--
-- 'autoGranted', 'updateQualificationType_autoGranted' - Specifies whether requests for the Qualification type are granted
-- immediately, without prompting the Worker with a Qualification test.
--
-- Constraints: If the Test parameter is specified, this parameter cannot
-- be true.
--
-- 'autoGrantedValue', 'updateQualificationType_autoGrantedValue' - The Qualification value to use for automatically granted Qualifications.
-- This parameter is used only if the AutoGranted parameter is true.
--
-- 'description', 'updateQualificationType_description' - The new description of the Qualification type.
--
-- 'qualificationTypeStatus', 'updateQualificationType_qualificationTypeStatus' - The new status of the Qualification type - Active | Inactive
--
-- 'retryDelayInSeconds', 'updateQualificationType_retryDelayInSeconds' - The amount of time, in seconds, that Workers must wait after requesting
-- a Qualification of the specified Qualification type before they can
-- retry the Qualification request. It is not possible to disable retries
-- for a Qualification type after it has been created with retries enabled.
-- If you want to disable retries, you must dispose of the existing
-- retry-enabled Qualification type using DisposeQualificationType and then
-- create a new Qualification type with retries disabled using
-- CreateQualificationType.
--
-- 'test', 'updateQualificationType_test' - The questions for the Qualification test a Worker must answer correctly
-- to obtain a Qualification of this type. If this parameter is specified,
-- @TestDurationInSeconds@ must also be specified.
--
-- Constraints: Must not be longer than 65535 bytes. Must be a QuestionForm
-- data structure. This parameter cannot be specified if AutoGranted is
-- true.
--
-- Constraints: None. If not specified, the Worker may request the
-- Qualification without answering any questions.
--
-- 'testDurationInSeconds', 'updateQualificationType_testDurationInSeconds' - The number of seconds the Worker has to complete the Qualification test,
-- starting from the time the Worker requests the Qualification.
--
-- 'qualificationTypeId', 'updateQualificationType_qualificationTypeId' - The ID of the Qualification type to update.
newUpdateQualificationType ::
  -- | 'qualificationTypeId'
  Prelude.Text ->
  UpdateQualificationType
newUpdateQualificationType :: Text -> UpdateQualificationType
newUpdateQualificationType Text
pQualificationTypeId_ =
  UpdateQualificationType'
    { $sel:answerKey:UpdateQualificationType' :: Maybe Text
answerKey =
        forall a. Maybe a
Prelude.Nothing,
      $sel:autoGranted:UpdateQualificationType' :: Maybe Bool
autoGranted = forall a. Maybe a
Prelude.Nothing,
      $sel:autoGrantedValue:UpdateQualificationType' :: Maybe Int
autoGrantedValue = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateQualificationType' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:qualificationTypeStatus:UpdateQualificationType' :: Maybe QualificationTypeStatus
qualificationTypeStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:retryDelayInSeconds:UpdateQualificationType' :: Maybe Integer
retryDelayInSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:test:UpdateQualificationType' :: Maybe Text
test = forall a. Maybe a
Prelude.Nothing,
      $sel:testDurationInSeconds:UpdateQualificationType' :: Maybe Integer
testDurationInSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:qualificationTypeId:UpdateQualificationType' :: Text
qualificationTypeId = Text
pQualificationTypeId_
    }

-- | The answers to the Qualification test specified in the Test parameter,
-- in the form of an AnswerKey data structure.
updateQualificationType_answerKey :: Lens.Lens' UpdateQualificationType (Prelude.Maybe Prelude.Text)
updateQualificationType_answerKey :: Lens' UpdateQualificationType (Maybe Text)
updateQualificationType_answerKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQualificationType' {Maybe Text
answerKey :: Maybe Text
$sel:answerKey:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
answerKey} -> Maybe Text
answerKey) (\s :: UpdateQualificationType
s@UpdateQualificationType' {} Maybe Text
a -> UpdateQualificationType
s {$sel:answerKey:UpdateQualificationType' :: Maybe Text
answerKey = Maybe Text
a} :: UpdateQualificationType)

-- | Specifies whether requests for the Qualification type are granted
-- immediately, without prompting the Worker with a Qualification test.
--
-- Constraints: If the Test parameter is specified, this parameter cannot
-- be true.
updateQualificationType_autoGranted :: Lens.Lens' UpdateQualificationType (Prelude.Maybe Prelude.Bool)
updateQualificationType_autoGranted :: Lens' UpdateQualificationType (Maybe Bool)
updateQualificationType_autoGranted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQualificationType' {Maybe Bool
autoGranted :: Maybe Bool
$sel:autoGranted:UpdateQualificationType' :: UpdateQualificationType -> Maybe Bool
autoGranted} -> Maybe Bool
autoGranted) (\s :: UpdateQualificationType
s@UpdateQualificationType' {} Maybe Bool
a -> UpdateQualificationType
s {$sel:autoGranted:UpdateQualificationType' :: Maybe Bool
autoGranted = Maybe Bool
a} :: UpdateQualificationType)

-- | The Qualification value to use for automatically granted Qualifications.
-- This parameter is used only if the AutoGranted parameter is true.
updateQualificationType_autoGrantedValue :: Lens.Lens' UpdateQualificationType (Prelude.Maybe Prelude.Int)
updateQualificationType_autoGrantedValue :: Lens' UpdateQualificationType (Maybe Int)
updateQualificationType_autoGrantedValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQualificationType' {Maybe Int
autoGrantedValue :: Maybe Int
$sel:autoGrantedValue:UpdateQualificationType' :: UpdateQualificationType -> Maybe Int
autoGrantedValue} -> Maybe Int
autoGrantedValue) (\s :: UpdateQualificationType
s@UpdateQualificationType' {} Maybe Int
a -> UpdateQualificationType
s {$sel:autoGrantedValue:UpdateQualificationType' :: Maybe Int
autoGrantedValue = Maybe Int
a} :: UpdateQualificationType)

-- | The new description of the Qualification type.
updateQualificationType_description :: Lens.Lens' UpdateQualificationType (Prelude.Maybe Prelude.Text)
updateQualificationType_description :: Lens' UpdateQualificationType (Maybe Text)
updateQualificationType_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQualificationType' {Maybe Text
description :: Maybe Text
$sel:description:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateQualificationType
s@UpdateQualificationType' {} Maybe Text
a -> UpdateQualificationType
s {$sel:description:UpdateQualificationType' :: Maybe Text
description = Maybe Text
a} :: UpdateQualificationType)

-- | The new status of the Qualification type - Active | Inactive
updateQualificationType_qualificationTypeStatus :: Lens.Lens' UpdateQualificationType (Prelude.Maybe QualificationTypeStatus)
updateQualificationType_qualificationTypeStatus :: Lens' UpdateQualificationType (Maybe QualificationTypeStatus)
updateQualificationType_qualificationTypeStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQualificationType' {Maybe QualificationTypeStatus
qualificationTypeStatus :: Maybe QualificationTypeStatus
$sel:qualificationTypeStatus:UpdateQualificationType' :: UpdateQualificationType -> Maybe QualificationTypeStatus
qualificationTypeStatus} -> Maybe QualificationTypeStatus
qualificationTypeStatus) (\s :: UpdateQualificationType
s@UpdateQualificationType' {} Maybe QualificationTypeStatus
a -> UpdateQualificationType
s {$sel:qualificationTypeStatus:UpdateQualificationType' :: Maybe QualificationTypeStatus
qualificationTypeStatus = Maybe QualificationTypeStatus
a} :: UpdateQualificationType)

-- | The amount of time, in seconds, that Workers must wait after requesting
-- a Qualification of the specified Qualification type before they can
-- retry the Qualification request. It is not possible to disable retries
-- for a Qualification type after it has been created with retries enabled.
-- If you want to disable retries, you must dispose of the existing
-- retry-enabled Qualification type using DisposeQualificationType and then
-- create a new Qualification type with retries disabled using
-- CreateQualificationType.
updateQualificationType_retryDelayInSeconds :: Lens.Lens' UpdateQualificationType (Prelude.Maybe Prelude.Integer)
updateQualificationType_retryDelayInSeconds :: Lens' UpdateQualificationType (Maybe Integer)
updateQualificationType_retryDelayInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQualificationType' {Maybe Integer
retryDelayInSeconds :: Maybe Integer
$sel:retryDelayInSeconds:UpdateQualificationType' :: UpdateQualificationType -> Maybe Integer
retryDelayInSeconds} -> Maybe Integer
retryDelayInSeconds) (\s :: UpdateQualificationType
s@UpdateQualificationType' {} Maybe Integer
a -> UpdateQualificationType
s {$sel:retryDelayInSeconds:UpdateQualificationType' :: Maybe Integer
retryDelayInSeconds = Maybe Integer
a} :: UpdateQualificationType)

-- | The questions for the Qualification test a Worker must answer correctly
-- to obtain a Qualification of this type. If this parameter is specified,
-- @TestDurationInSeconds@ must also be specified.
--
-- Constraints: Must not be longer than 65535 bytes. Must be a QuestionForm
-- data structure. This parameter cannot be specified if AutoGranted is
-- true.
--
-- Constraints: None. If not specified, the Worker may request the
-- Qualification without answering any questions.
updateQualificationType_test :: Lens.Lens' UpdateQualificationType (Prelude.Maybe Prelude.Text)
updateQualificationType_test :: Lens' UpdateQualificationType (Maybe Text)
updateQualificationType_test = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQualificationType' {Maybe Text
test :: Maybe Text
$sel:test:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
test} -> Maybe Text
test) (\s :: UpdateQualificationType
s@UpdateQualificationType' {} Maybe Text
a -> UpdateQualificationType
s {$sel:test:UpdateQualificationType' :: Maybe Text
test = Maybe Text
a} :: UpdateQualificationType)

-- | The number of seconds the Worker has to complete the Qualification test,
-- starting from the time the Worker requests the Qualification.
updateQualificationType_testDurationInSeconds :: Lens.Lens' UpdateQualificationType (Prelude.Maybe Prelude.Integer)
updateQualificationType_testDurationInSeconds :: Lens' UpdateQualificationType (Maybe Integer)
updateQualificationType_testDurationInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQualificationType' {Maybe Integer
testDurationInSeconds :: Maybe Integer
$sel:testDurationInSeconds:UpdateQualificationType' :: UpdateQualificationType -> Maybe Integer
testDurationInSeconds} -> Maybe Integer
testDurationInSeconds) (\s :: UpdateQualificationType
s@UpdateQualificationType' {} Maybe Integer
a -> UpdateQualificationType
s {$sel:testDurationInSeconds:UpdateQualificationType' :: Maybe Integer
testDurationInSeconds = Maybe Integer
a} :: UpdateQualificationType)

-- | The ID of the Qualification type to update.
updateQualificationType_qualificationTypeId :: Lens.Lens' UpdateQualificationType Prelude.Text
updateQualificationType_qualificationTypeId :: Lens' UpdateQualificationType Text
updateQualificationType_qualificationTypeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQualificationType' {Text
qualificationTypeId :: Text
$sel:qualificationTypeId:UpdateQualificationType' :: UpdateQualificationType -> Text
qualificationTypeId} -> Text
qualificationTypeId) (\s :: UpdateQualificationType
s@UpdateQualificationType' {} Text
a -> UpdateQualificationType
s {$sel:qualificationTypeId:UpdateQualificationType' :: Text
qualificationTypeId = Text
a} :: UpdateQualificationType)

instance Core.AWSRequest UpdateQualificationType where
  type
    AWSResponse UpdateQualificationType =
      UpdateQualificationTypeResponse
  request :: (Service -> Service)
-> UpdateQualificationType -> Request UpdateQualificationType
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 UpdateQualificationType
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateQualificationType)))
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 QualificationType -> Int -> UpdateQualificationTypeResponse
UpdateQualificationTypeResponse'
            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
"QualificationType")
            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 UpdateQualificationType where
  hashWithSalt :: Int -> UpdateQualificationType -> Int
hashWithSalt Int
_salt UpdateQualificationType' {Maybe Bool
Maybe Int
Maybe Integer
Maybe Text
Maybe QualificationTypeStatus
Text
qualificationTypeId :: Text
testDurationInSeconds :: Maybe Integer
test :: Maybe Text
retryDelayInSeconds :: Maybe Integer
qualificationTypeStatus :: Maybe QualificationTypeStatus
description :: Maybe Text
autoGrantedValue :: Maybe Int
autoGranted :: Maybe Bool
answerKey :: Maybe Text
$sel:qualificationTypeId:UpdateQualificationType' :: UpdateQualificationType -> Text
$sel:testDurationInSeconds:UpdateQualificationType' :: UpdateQualificationType -> Maybe Integer
$sel:test:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
$sel:retryDelayInSeconds:UpdateQualificationType' :: UpdateQualificationType -> Maybe Integer
$sel:qualificationTypeStatus:UpdateQualificationType' :: UpdateQualificationType -> Maybe QualificationTypeStatus
$sel:description:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
$sel:autoGrantedValue:UpdateQualificationType' :: UpdateQualificationType -> Maybe Int
$sel:autoGranted:UpdateQualificationType' :: UpdateQualificationType -> Maybe Bool
$sel:answerKey:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
answerKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoGranted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
autoGrantedValue
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe QualificationTypeStatus
qualificationTypeStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
retryDelayInSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
test
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
testDurationInSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
qualificationTypeId

instance Prelude.NFData UpdateQualificationType where
  rnf :: UpdateQualificationType -> ()
rnf UpdateQualificationType' {Maybe Bool
Maybe Int
Maybe Integer
Maybe Text
Maybe QualificationTypeStatus
Text
qualificationTypeId :: Text
testDurationInSeconds :: Maybe Integer
test :: Maybe Text
retryDelayInSeconds :: Maybe Integer
qualificationTypeStatus :: Maybe QualificationTypeStatus
description :: Maybe Text
autoGrantedValue :: Maybe Int
autoGranted :: Maybe Bool
answerKey :: Maybe Text
$sel:qualificationTypeId:UpdateQualificationType' :: UpdateQualificationType -> Text
$sel:testDurationInSeconds:UpdateQualificationType' :: UpdateQualificationType -> Maybe Integer
$sel:test:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
$sel:retryDelayInSeconds:UpdateQualificationType' :: UpdateQualificationType -> Maybe Integer
$sel:qualificationTypeStatus:UpdateQualificationType' :: UpdateQualificationType -> Maybe QualificationTypeStatus
$sel:description:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
$sel:autoGrantedValue:UpdateQualificationType' :: UpdateQualificationType -> Maybe Int
$sel:autoGranted:UpdateQualificationType' :: UpdateQualificationType -> Maybe Bool
$sel:answerKey:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
answerKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoGranted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
autoGrantedValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe QualificationTypeStatus
qualificationTypeStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
retryDelayInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
test
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
testDurationInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
qualificationTypeId

instance Data.ToHeaders UpdateQualificationType where
  toHeaders :: UpdateQualificationType -> 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.UpdateQualificationType" ::
                          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 UpdateQualificationType where
  toJSON :: UpdateQualificationType -> Value
toJSON UpdateQualificationType' {Maybe Bool
Maybe Int
Maybe Integer
Maybe Text
Maybe QualificationTypeStatus
Text
qualificationTypeId :: Text
testDurationInSeconds :: Maybe Integer
test :: Maybe Text
retryDelayInSeconds :: Maybe Integer
qualificationTypeStatus :: Maybe QualificationTypeStatus
description :: Maybe Text
autoGrantedValue :: Maybe Int
autoGranted :: Maybe Bool
answerKey :: Maybe Text
$sel:qualificationTypeId:UpdateQualificationType' :: UpdateQualificationType -> Text
$sel:testDurationInSeconds:UpdateQualificationType' :: UpdateQualificationType -> Maybe Integer
$sel:test:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
$sel:retryDelayInSeconds:UpdateQualificationType' :: UpdateQualificationType -> Maybe Integer
$sel:qualificationTypeStatus:UpdateQualificationType' :: UpdateQualificationType -> Maybe QualificationTypeStatus
$sel:description:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
$sel:autoGrantedValue:UpdateQualificationType' :: UpdateQualificationType -> Maybe Int
$sel:autoGranted:UpdateQualificationType' :: UpdateQualificationType -> Maybe Bool
$sel:answerKey:UpdateQualificationType' :: UpdateQualificationType -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AnswerKey" 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
answerKey,
            (Key
"AutoGranted" 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
autoGranted,
            (Key
"AutoGrantedValue" 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 Int
autoGrantedValue,
            (Key
"Description" 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
description,
            (Key
"QualificationTypeStatus" 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 QualificationTypeStatus
qualificationTypeStatus,
            (Key
"RetryDelayInSeconds" 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 Integer
retryDelayInSeconds,
            (Key
"Test" 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
test,
            (Key
"TestDurationInSeconds" 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 Integer
testDurationInSeconds,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"QualificationTypeId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
qualificationTypeId)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateQualificationTypeResponse' 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:
--
-- 'qualificationType', 'updateQualificationTypeResponse_qualificationType' - Contains a QualificationType data structure.
--
-- 'httpStatus', 'updateQualificationTypeResponse_httpStatus' - The response's http status code.
newUpdateQualificationTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateQualificationTypeResponse
newUpdateQualificationTypeResponse :: Int -> UpdateQualificationTypeResponse
newUpdateQualificationTypeResponse Int
pHttpStatus_ =
  UpdateQualificationTypeResponse'
    { $sel:qualificationType:UpdateQualificationTypeResponse' :: Maybe QualificationType
qualificationType =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateQualificationTypeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains a QualificationType data structure.
updateQualificationTypeResponse_qualificationType :: Lens.Lens' UpdateQualificationTypeResponse (Prelude.Maybe QualificationType)
updateQualificationTypeResponse_qualificationType :: Lens' UpdateQualificationTypeResponse (Maybe QualificationType)
updateQualificationTypeResponse_qualificationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQualificationTypeResponse' {Maybe QualificationType
qualificationType :: Maybe QualificationType
$sel:qualificationType:UpdateQualificationTypeResponse' :: UpdateQualificationTypeResponse -> Maybe QualificationType
qualificationType} -> Maybe QualificationType
qualificationType) (\s :: UpdateQualificationTypeResponse
s@UpdateQualificationTypeResponse' {} Maybe QualificationType
a -> UpdateQualificationTypeResponse
s {$sel:qualificationType:UpdateQualificationTypeResponse' :: Maybe QualificationType
qualificationType = Maybe QualificationType
a} :: UpdateQualificationTypeResponse)

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

instance
  Prelude.NFData
    UpdateQualificationTypeResponse
  where
  rnf :: UpdateQualificationTypeResponse -> ()
rnf UpdateQualificationTypeResponse' {Int
Maybe QualificationType
httpStatus :: Int
qualificationType :: Maybe QualificationType
$sel:httpStatus:UpdateQualificationTypeResponse' :: UpdateQualificationTypeResponse -> Int
$sel:qualificationType:UpdateQualificationTypeResponse' :: UpdateQualificationTypeResponse -> Maybe QualificationType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe QualificationType
qualificationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus