{-# 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.CreateQualificationType
-- 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 @CreateQualificationType@ operation creates a new Qualification
-- type, which is represented by a @QualificationType@ data structure.
module Amazonka.MechanicalTurk.CreateQualificationType
  ( -- * Creating a Request
    CreateQualificationType (..),
    newCreateQualificationType,

    -- * Request Lenses
    createQualificationType_answerKey,
    createQualificationType_autoGranted,
    createQualificationType_autoGrantedValue,
    createQualificationType_keywords,
    createQualificationType_retryDelayInSeconds,
    createQualificationType_test,
    createQualificationType_testDurationInSeconds,
    createQualificationType_name,
    createQualificationType_description,
    createQualificationType_qualificationTypeStatus,

    -- * Destructuring the Response
    CreateQualificationTypeResponse (..),
    newCreateQualificationTypeResponse,

    -- * Response Lenses
    createQualificationTypeResponse_qualificationType,
    createQualificationTypeResponse_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:/ 'newCreateQualificationType' smart constructor.
data CreateQualificationType = CreateQualificationType'
  { -- | The answers to the Qualification test specified in the Test parameter,
    -- in the form of an AnswerKey data structure.
    --
    -- Constraints: Must not be longer than 65535 bytes.
    --
    -- Constraints: None. If not specified, you must process Qualification
    -- requests manually.
    CreateQualificationType -> 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.
    CreateQualificationType -> 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.
    CreateQualificationType -> Maybe Int
autoGrantedValue :: Prelude.Maybe Prelude.Int,
    -- | One or more words or phrases that describe the Qualification type,
    -- separated by commas. The keywords of a type make the type easier to find
    -- during a search.
    CreateQualificationType -> Maybe Text
keywords :: Prelude.Maybe Prelude.Text,
    -- | The number of seconds that a Worker must wait after requesting a
    -- Qualification of the Qualification type before the worker can retry the
    -- Qualification request.
    --
    -- Constraints: None. If not specified, retries are disabled and Workers
    -- can request a Qualification of this type only once, even if the Worker
    -- has not been granted the Qualification. 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 delete existing
    -- retry-enabled Qualification type and then create a new Qualification
    -- type with retries disabled.
    CreateQualificationType -> 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.
    CreateQualificationType -> 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.
    CreateQualificationType -> Maybe Integer
testDurationInSeconds :: Prelude.Maybe Prelude.Integer,
    -- | The name you give to the Qualification type. The type name is used to
    -- represent the Qualification to Workers, and to find the type using a
    -- Qualification type search. It must be unique across all of your
    -- Qualification types.
    CreateQualificationType -> Text
name :: Prelude.Text,
    -- | A long description for the Qualification type. On the Amazon Mechanical
    -- Turk website, the long description is displayed when a Worker examines a
    -- Qualification type.
    CreateQualificationType -> Text
description :: Prelude.Text,
    -- | The initial status of the Qualification type.
    --
    -- Constraints: Valid values are: Active | Inactive
    CreateQualificationType -> QualificationTypeStatus
qualificationTypeStatus :: QualificationTypeStatus
  }
  deriving (CreateQualificationType -> CreateQualificationType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateQualificationType -> CreateQualificationType -> Bool
$c/= :: CreateQualificationType -> CreateQualificationType -> Bool
== :: CreateQualificationType -> CreateQualificationType -> Bool
$c== :: CreateQualificationType -> CreateQualificationType -> Bool
Prelude.Eq, ReadPrec [CreateQualificationType]
ReadPrec CreateQualificationType
Int -> ReadS CreateQualificationType
ReadS [CreateQualificationType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateQualificationType]
$creadListPrec :: ReadPrec [CreateQualificationType]
readPrec :: ReadPrec CreateQualificationType
$creadPrec :: ReadPrec CreateQualificationType
readList :: ReadS [CreateQualificationType]
$creadList :: ReadS [CreateQualificationType]
readsPrec :: Int -> ReadS CreateQualificationType
$creadsPrec :: Int -> ReadS CreateQualificationType
Prelude.Read, Int -> CreateQualificationType -> ShowS
[CreateQualificationType] -> ShowS
CreateQualificationType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateQualificationType] -> ShowS
$cshowList :: [CreateQualificationType] -> ShowS
show :: CreateQualificationType -> String
$cshow :: CreateQualificationType -> String
showsPrec :: Int -> CreateQualificationType -> ShowS
$cshowsPrec :: Int -> CreateQualificationType -> ShowS
Prelude.Show, forall x. Rep CreateQualificationType x -> CreateQualificationType
forall x. CreateQualificationType -> Rep CreateQualificationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateQualificationType x -> CreateQualificationType
$cfrom :: forall x. CreateQualificationType -> Rep CreateQualificationType x
Prelude.Generic)

-- |
-- Create a value of 'CreateQualificationType' 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', 'createQualificationType_answerKey' - The answers to the Qualification test specified in the Test parameter,
-- in the form of an AnswerKey data structure.
--
-- Constraints: Must not be longer than 65535 bytes.
--
-- Constraints: None. If not specified, you must process Qualification
-- requests manually.
--
-- 'autoGranted', 'createQualificationType_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', 'createQualificationType_autoGrantedValue' - The Qualification value to use for automatically granted Qualifications.
-- This parameter is used only if the AutoGranted parameter is true.
--
-- 'keywords', 'createQualificationType_keywords' - One or more words or phrases that describe the Qualification type,
-- separated by commas. The keywords of a type make the type easier to find
-- during a search.
--
-- 'retryDelayInSeconds', 'createQualificationType_retryDelayInSeconds' - The number of seconds that a Worker must wait after requesting a
-- Qualification of the Qualification type before the worker can retry the
-- Qualification request.
--
-- Constraints: None. If not specified, retries are disabled and Workers
-- can request a Qualification of this type only once, even if the Worker
-- has not been granted the Qualification. 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 delete existing
-- retry-enabled Qualification type and then create a new Qualification
-- type with retries disabled.
--
-- 'test', 'createQualificationType_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', 'createQualificationType_testDurationInSeconds' - The number of seconds the Worker has to complete the Qualification test,
-- starting from the time the Worker requests the Qualification.
--
-- 'name', 'createQualificationType_name' - The name you give to the Qualification type. The type name is used to
-- represent the Qualification to Workers, and to find the type using a
-- Qualification type search. It must be unique across all of your
-- Qualification types.
--
-- 'description', 'createQualificationType_description' - A long description for the Qualification type. On the Amazon Mechanical
-- Turk website, the long description is displayed when a Worker examines a
-- Qualification type.
--
-- 'qualificationTypeStatus', 'createQualificationType_qualificationTypeStatus' - The initial status of the Qualification type.
--
-- Constraints: Valid values are: Active | Inactive
newCreateQualificationType ::
  -- | 'name'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  -- | 'qualificationTypeStatus'
  QualificationTypeStatus ->
  CreateQualificationType
newCreateQualificationType :: Text -> Text -> QualificationTypeStatus -> CreateQualificationType
newCreateQualificationType
  Text
pName_
  Text
pDescription_
  QualificationTypeStatus
pQualificationTypeStatus_ =
    CreateQualificationType'
      { $sel:answerKey:CreateQualificationType' :: Maybe Text
answerKey =
          forall a. Maybe a
Prelude.Nothing,
        $sel:autoGranted:CreateQualificationType' :: Maybe Bool
autoGranted = forall a. Maybe a
Prelude.Nothing,
        $sel:autoGrantedValue:CreateQualificationType' :: Maybe Int
autoGrantedValue = forall a. Maybe a
Prelude.Nothing,
        $sel:keywords:CreateQualificationType' :: Maybe Text
keywords = forall a. Maybe a
Prelude.Nothing,
        $sel:retryDelayInSeconds:CreateQualificationType' :: Maybe Integer
retryDelayInSeconds = forall a. Maybe a
Prelude.Nothing,
        $sel:test:CreateQualificationType' :: Maybe Text
test = forall a. Maybe a
Prelude.Nothing,
        $sel:testDurationInSeconds:CreateQualificationType' :: Maybe Integer
testDurationInSeconds = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateQualificationType' :: Text
name = Text
pName_,
        $sel:description:CreateQualificationType' :: Text
description = Text
pDescription_,
        $sel:qualificationTypeStatus:CreateQualificationType' :: QualificationTypeStatus
qualificationTypeStatus =
          QualificationTypeStatus
pQualificationTypeStatus_
      }

-- | The answers to the Qualification test specified in the Test parameter,
-- in the form of an AnswerKey data structure.
--
-- Constraints: Must not be longer than 65535 bytes.
--
-- Constraints: None. If not specified, you must process Qualification
-- requests manually.
createQualificationType_answerKey :: Lens.Lens' CreateQualificationType (Prelude.Maybe Prelude.Text)
createQualificationType_answerKey :: Lens' CreateQualificationType (Maybe Text)
createQualificationType_answerKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQualificationType' {Maybe Text
answerKey :: Maybe Text
$sel:answerKey:CreateQualificationType' :: CreateQualificationType -> Maybe Text
answerKey} -> Maybe Text
answerKey) (\s :: CreateQualificationType
s@CreateQualificationType' {} Maybe Text
a -> CreateQualificationType
s {$sel:answerKey:CreateQualificationType' :: Maybe Text
answerKey = Maybe Text
a} :: CreateQualificationType)

-- | 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.
createQualificationType_autoGranted :: Lens.Lens' CreateQualificationType (Prelude.Maybe Prelude.Bool)
createQualificationType_autoGranted :: Lens' CreateQualificationType (Maybe Bool)
createQualificationType_autoGranted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQualificationType' {Maybe Bool
autoGranted :: Maybe Bool
$sel:autoGranted:CreateQualificationType' :: CreateQualificationType -> Maybe Bool
autoGranted} -> Maybe Bool
autoGranted) (\s :: CreateQualificationType
s@CreateQualificationType' {} Maybe Bool
a -> CreateQualificationType
s {$sel:autoGranted:CreateQualificationType' :: Maybe Bool
autoGranted = Maybe Bool
a} :: CreateQualificationType)

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

-- | One or more words or phrases that describe the Qualification type,
-- separated by commas. The keywords of a type make the type easier to find
-- during a search.
createQualificationType_keywords :: Lens.Lens' CreateQualificationType (Prelude.Maybe Prelude.Text)
createQualificationType_keywords :: Lens' CreateQualificationType (Maybe Text)
createQualificationType_keywords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQualificationType' {Maybe Text
keywords :: Maybe Text
$sel:keywords:CreateQualificationType' :: CreateQualificationType -> Maybe Text
keywords} -> Maybe Text
keywords) (\s :: CreateQualificationType
s@CreateQualificationType' {} Maybe Text
a -> CreateQualificationType
s {$sel:keywords:CreateQualificationType' :: Maybe Text
keywords = Maybe Text
a} :: CreateQualificationType)

-- | The number of seconds that a Worker must wait after requesting a
-- Qualification of the Qualification type before the worker can retry the
-- Qualification request.
--
-- Constraints: None. If not specified, retries are disabled and Workers
-- can request a Qualification of this type only once, even if the Worker
-- has not been granted the Qualification. 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 delete existing
-- retry-enabled Qualification type and then create a new Qualification
-- type with retries disabled.
createQualificationType_retryDelayInSeconds :: Lens.Lens' CreateQualificationType (Prelude.Maybe Prelude.Integer)
createQualificationType_retryDelayInSeconds :: Lens' CreateQualificationType (Maybe Integer)
createQualificationType_retryDelayInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQualificationType' {Maybe Integer
retryDelayInSeconds :: Maybe Integer
$sel:retryDelayInSeconds:CreateQualificationType' :: CreateQualificationType -> Maybe Integer
retryDelayInSeconds} -> Maybe Integer
retryDelayInSeconds) (\s :: CreateQualificationType
s@CreateQualificationType' {} Maybe Integer
a -> CreateQualificationType
s {$sel:retryDelayInSeconds:CreateQualificationType' :: Maybe Integer
retryDelayInSeconds = Maybe Integer
a} :: CreateQualificationType)

-- | 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.
createQualificationType_test :: Lens.Lens' CreateQualificationType (Prelude.Maybe Prelude.Text)
createQualificationType_test :: Lens' CreateQualificationType (Maybe Text)
createQualificationType_test = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQualificationType' {Maybe Text
test :: Maybe Text
$sel:test:CreateQualificationType' :: CreateQualificationType -> Maybe Text
test} -> Maybe Text
test) (\s :: CreateQualificationType
s@CreateQualificationType' {} Maybe Text
a -> CreateQualificationType
s {$sel:test:CreateQualificationType' :: Maybe Text
test = Maybe Text
a} :: CreateQualificationType)

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

-- | The name you give to the Qualification type. The type name is used to
-- represent the Qualification to Workers, and to find the type using a
-- Qualification type search. It must be unique across all of your
-- Qualification types.
createQualificationType_name :: Lens.Lens' CreateQualificationType Prelude.Text
createQualificationType_name :: Lens' CreateQualificationType Text
createQualificationType_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQualificationType' {Text
name :: Text
$sel:name:CreateQualificationType' :: CreateQualificationType -> Text
name} -> Text
name) (\s :: CreateQualificationType
s@CreateQualificationType' {} Text
a -> CreateQualificationType
s {$sel:name:CreateQualificationType' :: Text
name = Text
a} :: CreateQualificationType)

-- | A long description for the Qualification type. On the Amazon Mechanical
-- Turk website, the long description is displayed when a Worker examines a
-- Qualification type.
createQualificationType_description :: Lens.Lens' CreateQualificationType Prelude.Text
createQualificationType_description :: Lens' CreateQualificationType Text
createQualificationType_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQualificationType' {Text
description :: Text
$sel:description:CreateQualificationType' :: CreateQualificationType -> Text
description} -> Text
description) (\s :: CreateQualificationType
s@CreateQualificationType' {} Text
a -> CreateQualificationType
s {$sel:description:CreateQualificationType' :: Text
description = Text
a} :: CreateQualificationType)

-- | The initial status of the Qualification type.
--
-- Constraints: Valid values are: Active | Inactive
createQualificationType_qualificationTypeStatus :: Lens.Lens' CreateQualificationType QualificationTypeStatus
createQualificationType_qualificationTypeStatus :: Lens' CreateQualificationType QualificationTypeStatus
createQualificationType_qualificationTypeStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQualificationType' {QualificationTypeStatus
qualificationTypeStatus :: QualificationTypeStatus
$sel:qualificationTypeStatus:CreateQualificationType' :: CreateQualificationType -> QualificationTypeStatus
qualificationTypeStatus} -> QualificationTypeStatus
qualificationTypeStatus) (\s :: CreateQualificationType
s@CreateQualificationType' {} QualificationTypeStatus
a -> CreateQualificationType
s {$sel:qualificationTypeStatus:CreateQualificationType' :: QualificationTypeStatus
qualificationTypeStatus = QualificationTypeStatus
a} :: CreateQualificationType)

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

instance Prelude.NFData CreateQualificationType where
  rnf :: CreateQualificationType -> ()
rnf CreateQualificationType' {Maybe Bool
Maybe Int
Maybe Integer
Maybe Text
Text
QualificationTypeStatus
qualificationTypeStatus :: QualificationTypeStatus
description :: Text
name :: Text
testDurationInSeconds :: Maybe Integer
test :: Maybe Text
retryDelayInSeconds :: Maybe Integer
keywords :: Maybe Text
autoGrantedValue :: Maybe Int
autoGranted :: Maybe Bool
answerKey :: Maybe Text
$sel:qualificationTypeStatus:CreateQualificationType' :: CreateQualificationType -> QualificationTypeStatus
$sel:description:CreateQualificationType' :: CreateQualificationType -> Text
$sel:name:CreateQualificationType' :: CreateQualificationType -> Text
$sel:testDurationInSeconds:CreateQualificationType' :: CreateQualificationType -> Maybe Integer
$sel:test:CreateQualificationType' :: CreateQualificationType -> Maybe Text
$sel:retryDelayInSeconds:CreateQualificationType' :: CreateQualificationType -> Maybe Integer
$sel:keywords:CreateQualificationType' :: CreateQualificationType -> Maybe Text
$sel:autoGrantedValue:CreateQualificationType' :: CreateQualificationType -> Maybe Int
$sel:autoGranted:CreateQualificationType' :: CreateQualificationType -> Maybe Bool
$sel:answerKey:CreateQualificationType' :: CreateQualificationType -> 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
keywords
      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
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf QualificationTypeStatus
qualificationTypeStatus

instance Data.ToHeaders CreateQualificationType where
  toHeaders :: CreateQualificationType -> 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.CreateQualificationType" ::
                          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 CreateQualificationType where
  toJSON :: CreateQualificationType -> Value
toJSON CreateQualificationType' {Maybe Bool
Maybe Int
Maybe Integer
Maybe Text
Text
QualificationTypeStatus
qualificationTypeStatus :: QualificationTypeStatus
description :: Text
name :: Text
testDurationInSeconds :: Maybe Integer
test :: Maybe Text
retryDelayInSeconds :: Maybe Integer
keywords :: Maybe Text
autoGrantedValue :: Maybe Int
autoGranted :: Maybe Bool
answerKey :: Maybe Text
$sel:qualificationTypeStatus:CreateQualificationType' :: CreateQualificationType -> QualificationTypeStatus
$sel:description:CreateQualificationType' :: CreateQualificationType -> Text
$sel:name:CreateQualificationType' :: CreateQualificationType -> Text
$sel:testDurationInSeconds:CreateQualificationType' :: CreateQualificationType -> Maybe Integer
$sel:test:CreateQualificationType' :: CreateQualificationType -> Maybe Text
$sel:retryDelayInSeconds:CreateQualificationType' :: CreateQualificationType -> Maybe Integer
$sel:keywords:CreateQualificationType' :: CreateQualificationType -> Maybe Text
$sel:autoGrantedValue:CreateQualificationType' :: CreateQualificationType -> Maybe Int
$sel:autoGranted:CreateQualificationType' :: CreateQualificationType -> Maybe Bool
$sel:answerKey:CreateQualificationType' :: CreateQualificationType -> 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
"Keywords" 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
keywords,
            (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
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
description),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"QualificationTypeStatus"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= QualificationTypeStatus
qualificationTypeStatus
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateQualificationTypeResponse' 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', 'createQualificationTypeResponse_qualificationType' - The created Qualification type, returned as a QualificationType data
-- structure.
--
-- 'httpStatus', 'createQualificationTypeResponse_httpStatus' - The response's http status code.
newCreateQualificationTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateQualificationTypeResponse
newCreateQualificationTypeResponse :: Int -> CreateQualificationTypeResponse
newCreateQualificationTypeResponse Int
pHttpStatus_ =
  CreateQualificationTypeResponse'
    { $sel:qualificationType:CreateQualificationTypeResponse' :: Maybe QualificationType
qualificationType =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateQualificationTypeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The created Qualification type, returned as a QualificationType data
-- structure.
createQualificationTypeResponse_qualificationType :: Lens.Lens' CreateQualificationTypeResponse (Prelude.Maybe QualificationType)
createQualificationTypeResponse_qualificationType :: Lens' CreateQualificationTypeResponse (Maybe QualificationType)
createQualificationTypeResponse_qualificationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateQualificationTypeResponse' {Maybe QualificationType
qualificationType :: Maybe QualificationType
$sel:qualificationType:CreateQualificationTypeResponse' :: CreateQualificationTypeResponse -> Maybe QualificationType
qualificationType} -> Maybe QualificationType
qualificationType) (\s :: CreateQualificationTypeResponse
s@CreateQualificationTypeResponse' {} Maybe QualificationType
a -> CreateQualificationTypeResponse
s {$sel:qualificationType:CreateQualificationTypeResponse' :: Maybe QualificationType
qualificationType = Maybe QualificationType
a} :: CreateQualificationTypeResponse)

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

instance
  Prelude.NFData
    CreateQualificationTypeResponse
  where
  rnf :: CreateQualificationTypeResponse -> ()
rnf CreateQualificationTypeResponse' {Int
Maybe QualificationType
httpStatus :: Int
qualificationType :: Maybe QualificationType
$sel:httpStatus:CreateQualificationTypeResponse' :: CreateQualificationTypeResponse -> Int
$sel:qualificationType:CreateQualificationTypeResponse' :: CreateQualificationTypeResponse -> 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