{-# 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.AssociateQualificationWithWorker
-- 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 @AssociateQualificationWithWorker@ operation gives a Worker a
-- Qualification. @AssociateQualificationWithWorker@ does not require that
-- the Worker submit a Qualification request. It gives the Qualification
-- directly to the Worker.
--
-- You can only assign a Qualification of a Qualification type that you
-- created (using the @CreateQualificationType@ operation).
--
-- Note: @AssociateQualificationWithWorker@ does not affect any pending
-- Qualification requests for the Qualification by the Worker. If you
-- assign a Qualification to a Worker, then later grant a Qualification
-- request made by the Worker, the granting of the request may modify the
-- Qualification score. To resolve a pending Qualification request without
-- affecting the Qualification the Worker already has, reject the request
-- with the @RejectQualificationRequest@ operation.
module Amazonka.MechanicalTurk.AssociateQualificationWithWorker
  ( -- * Creating a Request
    AssociateQualificationWithWorker (..),
    newAssociateQualificationWithWorker,

    -- * Request Lenses
    associateQualificationWithWorker_integerValue,
    associateQualificationWithWorker_sendNotification,
    associateQualificationWithWorker_qualificationTypeId,
    associateQualificationWithWorker_workerId,

    -- * Destructuring the Response
    AssociateQualificationWithWorkerResponse (..),
    newAssociateQualificationWithWorkerResponse,

    -- * Response Lenses
    associateQualificationWithWorkerResponse_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:/ 'newAssociateQualificationWithWorker' smart constructor.
data AssociateQualificationWithWorker = AssociateQualificationWithWorker'
  { -- | The value of the Qualification to assign.
    AssociateQualificationWithWorker -> Maybe Int
integerValue :: Prelude.Maybe Prelude.Int,
    -- | Specifies whether to send a notification email message to the Worker
    -- saying that the qualification was assigned to the Worker. Note: this is
    -- true by default.
    AssociateQualificationWithWorker -> Maybe Bool
sendNotification :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Qualification type to use for the assigned Qualification.
    AssociateQualificationWithWorker -> Text
qualificationTypeId :: Prelude.Text,
    -- | The ID of the Worker to whom the Qualification is being assigned. Worker
    -- IDs are included with submitted HIT assignments and Qualification
    -- requests.
    AssociateQualificationWithWorker -> Text
workerId :: Prelude.Text
  }
  deriving (AssociateQualificationWithWorker
-> AssociateQualificationWithWorker -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateQualificationWithWorker
-> AssociateQualificationWithWorker -> Bool
$c/= :: AssociateQualificationWithWorker
-> AssociateQualificationWithWorker -> Bool
== :: AssociateQualificationWithWorker
-> AssociateQualificationWithWorker -> Bool
$c== :: AssociateQualificationWithWorker
-> AssociateQualificationWithWorker -> Bool
Prelude.Eq, ReadPrec [AssociateQualificationWithWorker]
ReadPrec AssociateQualificationWithWorker
Int -> ReadS AssociateQualificationWithWorker
ReadS [AssociateQualificationWithWorker]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateQualificationWithWorker]
$creadListPrec :: ReadPrec [AssociateQualificationWithWorker]
readPrec :: ReadPrec AssociateQualificationWithWorker
$creadPrec :: ReadPrec AssociateQualificationWithWorker
readList :: ReadS [AssociateQualificationWithWorker]
$creadList :: ReadS [AssociateQualificationWithWorker]
readsPrec :: Int -> ReadS AssociateQualificationWithWorker
$creadsPrec :: Int -> ReadS AssociateQualificationWithWorker
Prelude.Read, Int -> AssociateQualificationWithWorker -> ShowS
[AssociateQualificationWithWorker] -> ShowS
AssociateQualificationWithWorker -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateQualificationWithWorker] -> ShowS
$cshowList :: [AssociateQualificationWithWorker] -> ShowS
show :: AssociateQualificationWithWorker -> String
$cshow :: AssociateQualificationWithWorker -> String
showsPrec :: Int -> AssociateQualificationWithWorker -> ShowS
$cshowsPrec :: Int -> AssociateQualificationWithWorker -> ShowS
Prelude.Show, forall x.
Rep AssociateQualificationWithWorker x
-> AssociateQualificationWithWorker
forall x.
AssociateQualificationWithWorker
-> Rep AssociateQualificationWithWorker x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateQualificationWithWorker x
-> AssociateQualificationWithWorker
$cfrom :: forall x.
AssociateQualificationWithWorker
-> Rep AssociateQualificationWithWorker x
Prelude.Generic)

-- |
-- Create a value of 'AssociateQualificationWithWorker' 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:
--
-- 'integerValue', 'associateQualificationWithWorker_integerValue' - The value of the Qualification to assign.
--
-- 'sendNotification', 'associateQualificationWithWorker_sendNotification' - Specifies whether to send a notification email message to the Worker
-- saying that the qualification was assigned to the Worker. Note: this is
-- true by default.
--
-- 'qualificationTypeId', 'associateQualificationWithWorker_qualificationTypeId' - The ID of the Qualification type to use for the assigned Qualification.
--
-- 'workerId', 'associateQualificationWithWorker_workerId' - The ID of the Worker to whom the Qualification is being assigned. Worker
-- IDs are included with submitted HIT assignments and Qualification
-- requests.
newAssociateQualificationWithWorker ::
  -- | 'qualificationTypeId'
  Prelude.Text ->
  -- | 'workerId'
  Prelude.Text ->
  AssociateQualificationWithWorker
newAssociateQualificationWithWorker :: Text -> Text -> AssociateQualificationWithWorker
newAssociateQualificationWithWorker
  Text
pQualificationTypeId_
  Text
pWorkerId_ =
    AssociateQualificationWithWorker'
      { $sel:integerValue:AssociateQualificationWithWorker' :: Maybe Int
integerValue =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sendNotification:AssociateQualificationWithWorker' :: Maybe Bool
sendNotification = forall a. Maybe a
Prelude.Nothing,
        $sel:qualificationTypeId:AssociateQualificationWithWorker' :: Text
qualificationTypeId =
          Text
pQualificationTypeId_,
        $sel:workerId:AssociateQualificationWithWorker' :: Text
workerId = Text
pWorkerId_
      }

-- | The value of the Qualification to assign.
associateQualificationWithWorker_integerValue :: Lens.Lens' AssociateQualificationWithWorker (Prelude.Maybe Prelude.Int)
associateQualificationWithWorker_integerValue :: Lens' AssociateQualificationWithWorker (Maybe Int)
associateQualificationWithWorker_integerValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateQualificationWithWorker' {Maybe Int
integerValue :: Maybe Int
$sel:integerValue:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Maybe Int
integerValue} -> Maybe Int
integerValue) (\s :: AssociateQualificationWithWorker
s@AssociateQualificationWithWorker' {} Maybe Int
a -> AssociateQualificationWithWorker
s {$sel:integerValue:AssociateQualificationWithWorker' :: Maybe Int
integerValue = Maybe Int
a} :: AssociateQualificationWithWorker)

-- | Specifies whether to send a notification email message to the Worker
-- saying that the qualification was assigned to the Worker. Note: this is
-- true by default.
associateQualificationWithWorker_sendNotification :: Lens.Lens' AssociateQualificationWithWorker (Prelude.Maybe Prelude.Bool)
associateQualificationWithWorker_sendNotification :: Lens' AssociateQualificationWithWorker (Maybe Bool)
associateQualificationWithWorker_sendNotification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateQualificationWithWorker' {Maybe Bool
sendNotification :: Maybe Bool
$sel:sendNotification:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Maybe Bool
sendNotification} -> Maybe Bool
sendNotification) (\s :: AssociateQualificationWithWorker
s@AssociateQualificationWithWorker' {} Maybe Bool
a -> AssociateQualificationWithWorker
s {$sel:sendNotification:AssociateQualificationWithWorker' :: Maybe Bool
sendNotification = Maybe Bool
a} :: AssociateQualificationWithWorker)

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

-- | The ID of the Worker to whom the Qualification is being assigned. Worker
-- IDs are included with submitted HIT assignments and Qualification
-- requests.
associateQualificationWithWorker_workerId :: Lens.Lens' AssociateQualificationWithWorker Prelude.Text
associateQualificationWithWorker_workerId :: Lens' AssociateQualificationWithWorker Text
associateQualificationWithWorker_workerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateQualificationWithWorker' {Text
workerId :: Text
$sel:workerId:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Text
workerId} -> Text
workerId) (\s :: AssociateQualificationWithWorker
s@AssociateQualificationWithWorker' {} Text
a -> AssociateQualificationWithWorker
s {$sel:workerId:AssociateQualificationWithWorker' :: Text
workerId = Text
a} :: AssociateQualificationWithWorker)

instance
  Core.AWSRequest
    AssociateQualificationWithWorker
  where
  type
    AWSResponse AssociateQualificationWithWorker =
      AssociateQualificationWithWorkerResponse
  request :: (Service -> Service)
-> AssociateQualificationWithWorker
-> Request AssociateQualificationWithWorker
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 AssociateQualificationWithWorker
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AssociateQualificationWithWorker)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AssociateQualificationWithWorkerResponse
AssociateQualificationWithWorkerResponse'
            forall (f :: * -> *) a b. Functor 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
    AssociateQualificationWithWorker
  where
  hashWithSalt :: Int -> AssociateQualificationWithWorker -> Int
hashWithSalt
    Int
_salt
    AssociateQualificationWithWorker' {Maybe Bool
Maybe Int
Text
workerId :: Text
qualificationTypeId :: Text
sendNotification :: Maybe Bool
integerValue :: Maybe Int
$sel:workerId:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Text
$sel:qualificationTypeId:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Text
$sel:sendNotification:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Maybe Bool
$sel:integerValue:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Maybe Int
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
integerValue
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
sendNotification
        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
    AssociateQualificationWithWorker
  where
  rnf :: AssociateQualificationWithWorker -> ()
rnf AssociateQualificationWithWorker' {Maybe Bool
Maybe Int
Text
workerId :: Text
qualificationTypeId :: Text
sendNotification :: Maybe Bool
integerValue :: Maybe Int
$sel:workerId:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Text
$sel:qualificationTypeId:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Text
$sel:sendNotification:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Maybe Bool
$sel:integerValue:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
integerValue
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
sendNotification
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
    AssociateQualificationWithWorker
  where
  toHeaders :: AssociateQualificationWithWorker -> 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.AssociateQualificationWithWorker" ::
                          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 AssociateQualificationWithWorker where
  toJSON :: AssociateQualificationWithWorker -> Value
toJSON AssociateQualificationWithWorker' {Maybe Bool
Maybe Int
Text
workerId :: Text
qualificationTypeId :: Text
sendNotification :: Maybe Bool
integerValue :: Maybe Int
$sel:workerId:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Text
$sel:qualificationTypeId:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Text
$sel:sendNotification:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Maybe Bool
$sel:integerValue:AssociateQualificationWithWorker' :: AssociateQualificationWithWorker -> Maybe Int
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IntegerValue" 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
integerValue,
            (Key
"SendNotification" 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
sendNotification,
            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 AssociateQualificationWithWorker where
  toPath :: AssociateQualificationWithWorker -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'AssociateQualificationWithWorkerResponse' 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:
--
-- 'httpStatus', 'associateQualificationWithWorkerResponse_httpStatus' - The response's http status code.
newAssociateQualificationWithWorkerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateQualificationWithWorkerResponse
newAssociateQualificationWithWorkerResponse :: Int -> AssociateQualificationWithWorkerResponse
newAssociateQualificationWithWorkerResponse
  Int
pHttpStatus_ =
    AssociateQualificationWithWorkerResponse'
      { $sel:httpStatus:AssociateQualificationWithWorkerResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

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

instance
  Prelude.NFData
    AssociateQualificationWithWorkerResponse
  where
  rnf :: AssociateQualificationWithWorkerResponse -> ()
rnf AssociateQualificationWithWorkerResponse' {Int
httpStatus :: Int
$sel:httpStatus:AssociateQualificationWithWorkerResponse' :: AssociateQualificationWithWorkerResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus