{-# 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.GetQualificationScore
(
GetQualificationScore (..),
newGetQualificationScore,
getQualificationScore_qualificationTypeId,
getQualificationScore_workerId,
GetQualificationScoreResponse (..),
newGetQualificationScoreResponse,
getQualificationScoreResponse_qualification,
getQualificationScoreResponse_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 GetQualificationScore = GetQualificationScore'
{
GetQualificationScore -> Text
qualificationTypeId :: Prelude.Text,
GetQualificationScore -> Text
workerId :: Prelude.Text
}
deriving (GetQualificationScore -> GetQualificationScore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetQualificationScore -> GetQualificationScore -> Bool
$c/= :: GetQualificationScore -> GetQualificationScore -> Bool
== :: GetQualificationScore -> GetQualificationScore -> Bool
$c== :: GetQualificationScore -> GetQualificationScore -> Bool
Prelude.Eq, ReadPrec [GetQualificationScore]
ReadPrec GetQualificationScore
Int -> ReadS GetQualificationScore
ReadS [GetQualificationScore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetQualificationScore]
$creadListPrec :: ReadPrec [GetQualificationScore]
readPrec :: ReadPrec GetQualificationScore
$creadPrec :: ReadPrec GetQualificationScore
readList :: ReadS [GetQualificationScore]
$creadList :: ReadS [GetQualificationScore]
readsPrec :: Int -> ReadS GetQualificationScore
$creadsPrec :: Int -> ReadS GetQualificationScore
Prelude.Read, Int -> GetQualificationScore -> ShowS
[GetQualificationScore] -> ShowS
GetQualificationScore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetQualificationScore] -> ShowS
$cshowList :: [GetQualificationScore] -> ShowS
show :: GetQualificationScore -> String
$cshow :: GetQualificationScore -> String
showsPrec :: Int -> GetQualificationScore -> ShowS
$cshowsPrec :: Int -> GetQualificationScore -> ShowS
Prelude.Show, forall x. Rep GetQualificationScore x -> GetQualificationScore
forall x. GetQualificationScore -> Rep GetQualificationScore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetQualificationScore x -> GetQualificationScore
$cfrom :: forall x. GetQualificationScore -> Rep GetQualificationScore x
Prelude.Generic)
newGetQualificationScore ::
Prelude.Text ->
Prelude.Text ->
GetQualificationScore
newGetQualificationScore :: Text -> Text -> GetQualificationScore
newGetQualificationScore
Text
pQualificationTypeId_
Text
pWorkerId_ =
GetQualificationScore'
{ $sel:qualificationTypeId:GetQualificationScore' :: Text
qualificationTypeId =
Text
pQualificationTypeId_,
$sel:workerId:GetQualificationScore' :: Text
workerId = Text
pWorkerId_
}
getQualificationScore_qualificationTypeId :: Lens.Lens' GetQualificationScore Prelude.Text
getQualificationScore_qualificationTypeId :: Lens' GetQualificationScore Text
getQualificationScore_qualificationTypeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQualificationScore' {Text
qualificationTypeId :: Text
$sel:qualificationTypeId:GetQualificationScore' :: GetQualificationScore -> Text
qualificationTypeId} -> Text
qualificationTypeId) (\s :: GetQualificationScore
s@GetQualificationScore' {} Text
a -> GetQualificationScore
s {$sel:qualificationTypeId:GetQualificationScore' :: Text
qualificationTypeId = Text
a} :: GetQualificationScore)
getQualificationScore_workerId :: Lens.Lens' GetQualificationScore Prelude.Text
getQualificationScore_workerId :: Lens' GetQualificationScore Text
getQualificationScore_workerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQualificationScore' {Text
workerId :: Text
$sel:workerId:GetQualificationScore' :: GetQualificationScore -> Text
workerId} -> Text
workerId) (\s :: GetQualificationScore
s@GetQualificationScore' {} Text
a -> GetQualificationScore
s {$sel:workerId:GetQualificationScore' :: Text
workerId = Text
a} :: GetQualificationScore)
instance Core.AWSRequest GetQualificationScore where
type
AWSResponse GetQualificationScore =
GetQualificationScoreResponse
request :: (Service -> Service)
-> GetQualificationScore -> Request GetQualificationScore
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 GetQualificationScore
-> ClientResponse ClientBody
-> m (Either
Error (ClientResponse (AWSResponse GetQualificationScore)))
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 Qualification -> Int -> GetQualificationScoreResponse
GetQualificationScoreResponse'
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
"Qualification")
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 GetQualificationScore where
hashWithSalt :: Int -> GetQualificationScore -> Int
hashWithSalt Int
_salt GetQualificationScore' {Text
workerId :: Text
qualificationTypeId :: Text
$sel:workerId:GetQualificationScore' :: GetQualificationScore -> Text
$sel:qualificationTypeId:GetQualificationScore' :: GetQualificationScore -> Text
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
qualificationTypeId
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workerId
instance Prelude.NFData GetQualificationScore where
rnf :: GetQualificationScore -> ()
rnf GetQualificationScore' {Text
workerId :: Text
qualificationTypeId :: Text
$sel:workerId:GetQualificationScore' :: GetQualificationScore -> Text
$sel:qualificationTypeId:GetQualificationScore' :: GetQualificationScore -> Text
..} =
forall a. NFData a => a -> ()
Prelude.rnf Text
qualificationTypeId
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workerId
instance Data.ToHeaders GetQualificationScore where
toHeaders :: GetQualificationScore -> 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.GetQualificationScore" ::
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 GetQualificationScore where
toJSON :: GetQualificationScore -> Value
toJSON GetQualificationScore' {Text
workerId :: Text
qualificationTypeId :: Text
$sel:workerId:GetQualificationScore' :: GetQualificationScore -> Text
$sel:qualificationTypeId:GetQualificationScore' :: GetQualificationScore -> Text
..} =
[Pair] -> Value
Data.object
( forall a. [Maybe a] -> [a]
Prelude.catMaybes
[ forall a. a -> Maybe a
Prelude.Just
(Key
"QualificationTypeId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
qualificationTypeId),
forall a. a -> Maybe a
Prelude.Just (Key
"WorkerId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workerId)
]
)
instance Data.ToPath GetQualificationScore where
toPath :: GetQualificationScore -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"
instance Data.ToQuery GetQualificationScore where
toQuery :: GetQualificationScore -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
data GetQualificationScoreResponse = GetQualificationScoreResponse'
{
GetQualificationScoreResponse -> Maybe Qualification
qualification :: Prelude.Maybe Qualification,
GetQualificationScoreResponse -> Int
httpStatus :: Prelude.Int
}
deriving (GetQualificationScoreResponse
-> GetQualificationScoreResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetQualificationScoreResponse
-> GetQualificationScoreResponse -> Bool
$c/= :: GetQualificationScoreResponse
-> GetQualificationScoreResponse -> Bool
== :: GetQualificationScoreResponse
-> GetQualificationScoreResponse -> Bool
$c== :: GetQualificationScoreResponse
-> GetQualificationScoreResponse -> Bool
Prelude.Eq, ReadPrec [GetQualificationScoreResponse]
ReadPrec GetQualificationScoreResponse
Int -> ReadS GetQualificationScoreResponse
ReadS [GetQualificationScoreResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetQualificationScoreResponse]
$creadListPrec :: ReadPrec [GetQualificationScoreResponse]
readPrec :: ReadPrec GetQualificationScoreResponse
$creadPrec :: ReadPrec GetQualificationScoreResponse
readList :: ReadS [GetQualificationScoreResponse]
$creadList :: ReadS [GetQualificationScoreResponse]
readsPrec :: Int -> ReadS GetQualificationScoreResponse
$creadsPrec :: Int -> ReadS GetQualificationScoreResponse
Prelude.Read, Int -> GetQualificationScoreResponse -> ShowS
[GetQualificationScoreResponse] -> ShowS
GetQualificationScoreResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetQualificationScoreResponse] -> ShowS
$cshowList :: [GetQualificationScoreResponse] -> ShowS
show :: GetQualificationScoreResponse -> String
$cshow :: GetQualificationScoreResponse -> String
showsPrec :: Int -> GetQualificationScoreResponse -> ShowS
$cshowsPrec :: Int -> GetQualificationScoreResponse -> ShowS
Prelude.Show, forall x.
Rep GetQualificationScoreResponse x
-> GetQualificationScoreResponse
forall x.
GetQualificationScoreResponse
-> Rep GetQualificationScoreResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetQualificationScoreResponse x
-> GetQualificationScoreResponse
$cfrom :: forall x.
GetQualificationScoreResponse
-> Rep GetQualificationScoreResponse x
Prelude.Generic)
newGetQualificationScoreResponse ::
Prelude.Int ->
GetQualificationScoreResponse
newGetQualificationScoreResponse :: Int -> GetQualificationScoreResponse
newGetQualificationScoreResponse Int
pHttpStatus_ =
GetQualificationScoreResponse'
{ $sel:qualification:GetQualificationScoreResponse' :: Maybe Qualification
qualification =
forall a. Maybe a
Prelude.Nothing,
$sel:httpStatus:GetQualificationScoreResponse' :: Int
httpStatus = Int
pHttpStatus_
}
getQualificationScoreResponse_qualification :: Lens.Lens' GetQualificationScoreResponse (Prelude.Maybe Qualification)
getQualificationScoreResponse_qualification :: Lens' GetQualificationScoreResponse (Maybe Qualification)
getQualificationScoreResponse_qualification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQualificationScoreResponse' {Maybe Qualification
qualification :: Maybe Qualification
$sel:qualification:GetQualificationScoreResponse' :: GetQualificationScoreResponse -> Maybe Qualification
qualification} -> Maybe Qualification
qualification) (\s :: GetQualificationScoreResponse
s@GetQualificationScoreResponse' {} Maybe Qualification
a -> GetQualificationScoreResponse
s {$sel:qualification:GetQualificationScoreResponse' :: Maybe Qualification
qualification = Maybe Qualification
a} :: GetQualificationScoreResponse)
getQualificationScoreResponse_httpStatus :: Lens.Lens' GetQualificationScoreResponse Prelude.Int
getQualificationScoreResponse_httpStatus :: Lens' GetQualificationScoreResponse Int
getQualificationScoreResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetQualificationScoreResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetQualificationScoreResponse' :: GetQualificationScoreResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetQualificationScoreResponse
s@GetQualificationScoreResponse' {} Int
a -> GetQualificationScoreResponse
s {$sel:httpStatus:GetQualificationScoreResponse' :: Int
httpStatus = Int
a} :: GetQualificationScoreResponse)
instance Prelude.NFData GetQualificationScoreResponse where
rnf :: GetQualificationScoreResponse -> ()
rnf GetQualificationScoreResponse' {Int
Maybe Qualification
httpStatus :: Int
qualification :: Maybe Qualification
$sel:httpStatus:GetQualificationScoreResponse' :: GetQualificationScoreResponse -> Int
$sel:qualification:GetQualificationScoreResponse' :: GetQualificationScoreResponse -> Maybe Qualification
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Qualification
qualification
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus