{-# 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 #-}
module Amazonka.MechanicalTurk.UpdateQualificationType
(
UpdateQualificationType (..),
newUpdateQualificationType,
updateQualificationType_answerKey,
updateQualificationType_autoGranted,
updateQualificationType_autoGrantedValue,
updateQualificationType_description,
updateQualificationType_qualificationTypeStatus,
updateQualificationType_retryDelayInSeconds,
updateQualificationType_test,
updateQualificationType_testDurationInSeconds,
updateQualificationType_qualificationTypeId,
UpdateQualificationTypeResponse (..),
newUpdateQualificationTypeResponse,
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
data UpdateQualificationType = UpdateQualificationType'
{
UpdateQualificationType -> Maybe Text
answerKey :: Prelude.Maybe Prelude.Text,
UpdateQualificationType -> Maybe Bool
autoGranted :: Prelude.Maybe Prelude.Bool,
UpdateQualificationType -> Maybe Int
autoGrantedValue :: Prelude.Maybe Prelude.Int,
UpdateQualificationType -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
UpdateQualificationType -> Maybe QualificationTypeStatus
qualificationTypeStatus :: Prelude.Maybe QualificationTypeStatus,
UpdateQualificationType -> Maybe Integer
retryDelayInSeconds :: Prelude.Maybe Prelude.Integer,
UpdateQualificationType -> Maybe Text
test :: Prelude.Maybe Prelude.Text,
UpdateQualificationType -> Maybe Integer
testDurationInSeconds :: Prelude.Maybe Prelude.Integer,
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)
newUpdateQualificationType ::
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_
}
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)
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)
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)
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)
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)
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)
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)
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)
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
data UpdateQualificationTypeResponse = UpdateQualificationTypeResponse'
{
UpdateQualificationTypeResponse -> Maybe QualificationType
qualificationType :: Prelude.Maybe QualificationType,
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)
newUpdateQualificationTypeResponse ::
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_
}
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)
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