{-# 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.GetQualificationScore
-- 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 @GetQualificationScore@ operation returns the value of a Worker\'s
-- Qualification for a given Qualification type.
--
-- To get a Worker\'s Qualification, you must know the Worker\'s ID. The
-- Worker\'s ID is included in the assignment data returned by the
-- @ListAssignmentsForHIT@ operation.
--
-- Only the owner of a Qualification type can query the value of a
-- Worker\'s Qualification of that type.
module Amazonka.MechanicalTurk.GetQualificationScore
  ( -- * Creating a Request
    GetQualificationScore (..),
    newGetQualificationScore,

    -- * Request Lenses
    getQualificationScore_qualificationTypeId,
    getQualificationScore_workerId,

    -- * Destructuring the Response
    GetQualificationScoreResponse (..),
    newGetQualificationScoreResponse,

    -- * Response Lenses
    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

-- | /See:/ 'newGetQualificationScore' smart constructor.
data GetQualificationScore = GetQualificationScore'
  { -- | The ID of the QualificationType.
    GetQualificationScore -> Text
qualificationTypeId :: Prelude.Text,
    -- | The ID of the Worker whose Qualification is being updated.
    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)

-- |
-- Create a value of 'GetQualificationScore' 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:
--
-- 'qualificationTypeId', 'getQualificationScore_qualificationTypeId' - The ID of the QualificationType.
--
-- 'workerId', 'getQualificationScore_workerId' - The ID of the Worker whose Qualification is being updated.
newGetQualificationScore ::
  -- | 'qualificationTypeId'
  Prelude.Text ->
  -- | 'workerId'
  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_
      }

-- | The ID of the QualificationType.
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)

-- | The ID of the Worker whose Qualification is being updated.
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

-- | /See:/ 'newGetQualificationScoreResponse' smart constructor.
data GetQualificationScoreResponse = GetQualificationScoreResponse'
  { -- | The Qualification data structure of the Qualification assigned to a
    -- user, including the Qualification type and the value (score).
    GetQualificationScoreResponse -> Maybe Qualification
qualification :: Prelude.Maybe Qualification,
    -- | The response's http status code.
    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)

-- |
-- Create a value of 'GetQualificationScoreResponse' 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:
--
-- 'qualification', 'getQualificationScoreResponse_qualification' - The Qualification data structure of the Qualification assigned to a
-- user, including the Qualification type and the value (score).
--
-- 'httpStatus', 'getQualificationScoreResponse_httpStatus' - The response's http status code.
newGetQualificationScoreResponse ::
  -- | 'httpStatus'
  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_
    }

-- | The Qualification data structure of the Qualification assigned to a
-- user, including the Qualification type and the value (score).
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)

-- | The response's http status code.
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