{-# 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.DeleteWorkerBlock
-- 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 @DeleteWorkerBlock@ operation allows you to reinstate a blocked
-- Worker to work on your HITs. This operation reverses the effects of the
-- CreateWorkerBlock operation. You need the Worker ID to use this
-- operation. If the Worker ID is missing or invalid, this operation fails
-- and returns the message “WorkerId is invalid.” If the specified Worker
-- is not blocked, this operation returns successfully.
module Amazonka.MechanicalTurk.DeleteWorkerBlock
  ( -- * Creating a Request
    DeleteWorkerBlock (..),
    newDeleteWorkerBlock,

    -- * Request Lenses
    deleteWorkerBlock_reason,
    deleteWorkerBlock_workerId,

    -- * Destructuring the Response
    DeleteWorkerBlockResponse (..),
    newDeleteWorkerBlockResponse,

    -- * Response Lenses
    deleteWorkerBlockResponse_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:/ 'newDeleteWorkerBlock' smart constructor.
data DeleteWorkerBlock = DeleteWorkerBlock'
  { -- | A message that explains the reason for unblocking the Worker. The Worker
    -- does not see this message.
    DeleteWorkerBlock -> Maybe Text
reason :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Worker to unblock.
    DeleteWorkerBlock -> Text
workerId :: Prelude.Text
  }
  deriving (DeleteWorkerBlock -> DeleteWorkerBlock -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteWorkerBlock -> DeleteWorkerBlock -> Bool
$c/= :: DeleteWorkerBlock -> DeleteWorkerBlock -> Bool
== :: DeleteWorkerBlock -> DeleteWorkerBlock -> Bool
$c== :: DeleteWorkerBlock -> DeleteWorkerBlock -> Bool
Prelude.Eq, ReadPrec [DeleteWorkerBlock]
ReadPrec DeleteWorkerBlock
Int -> ReadS DeleteWorkerBlock
ReadS [DeleteWorkerBlock]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteWorkerBlock]
$creadListPrec :: ReadPrec [DeleteWorkerBlock]
readPrec :: ReadPrec DeleteWorkerBlock
$creadPrec :: ReadPrec DeleteWorkerBlock
readList :: ReadS [DeleteWorkerBlock]
$creadList :: ReadS [DeleteWorkerBlock]
readsPrec :: Int -> ReadS DeleteWorkerBlock
$creadsPrec :: Int -> ReadS DeleteWorkerBlock
Prelude.Read, Int -> DeleteWorkerBlock -> ShowS
[DeleteWorkerBlock] -> ShowS
DeleteWorkerBlock -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteWorkerBlock] -> ShowS
$cshowList :: [DeleteWorkerBlock] -> ShowS
show :: DeleteWorkerBlock -> String
$cshow :: DeleteWorkerBlock -> String
showsPrec :: Int -> DeleteWorkerBlock -> ShowS
$cshowsPrec :: Int -> DeleteWorkerBlock -> ShowS
Prelude.Show, forall x. Rep DeleteWorkerBlock x -> DeleteWorkerBlock
forall x. DeleteWorkerBlock -> Rep DeleteWorkerBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteWorkerBlock x -> DeleteWorkerBlock
$cfrom :: forall x. DeleteWorkerBlock -> Rep DeleteWorkerBlock x
Prelude.Generic)

-- |
-- Create a value of 'DeleteWorkerBlock' 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:
--
-- 'reason', 'deleteWorkerBlock_reason' - A message that explains the reason for unblocking the Worker. The Worker
-- does not see this message.
--
-- 'workerId', 'deleteWorkerBlock_workerId' - The ID of the Worker to unblock.
newDeleteWorkerBlock ::
  -- | 'workerId'
  Prelude.Text ->
  DeleteWorkerBlock
newDeleteWorkerBlock :: Text -> DeleteWorkerBlock
newDeleteWorkerBlock Text
pWorkerId_ =
  DeleteWorkerBlock'
    { $sel:reason:DeleteWorkerBlock' :: Maybe Text
reason = forall a. Maybe a
Prelude.Nothing,
      $sel:workerId:DeleteWorkerBlock' :: Text
workerId = Text
pWorkerId_
    }

-- | A message that explains the reason for unblocking the Worker. The Worker
-- does not see this message.
deleteWorkerBlock_reason :: Lens.Lens' DeleteWorkerBlock (Prelude.Maybe Prelude.Text)
deleteWorkerBlock_reason :: Lens' DeleteWorkerBlock (Maybe Text)
deleteWorkerBlock_reason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteWorkerBlock' {Maybe Text
reason :: Maybe Text
$sel:reason:DeleteWorkerBlock' :: DeleteWorkerBlock -> Maybe Text
reason} -> Maybe Text
reason) (\s :: DeleteWorkerBlock
s@DeleteWorkerBlock' {} Maybe Text
a -> DeleteWorkerBlock
s {$sel:reason:DeleteWorkerBlock' :: Maybe Text
reason = Maybe Text
a} :: DeleteWorkerBlock)

-- | The ID of the Worker to unblock.
deleteWorkerBlock_workerId :: Lens.Lens' DeleteWorkerBlock Prelude.Text
deleteWorkerBlock_workerId :: Lens' DeleteWorkerBlock Text
deleteWorkerBlock_workerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteWorkerBlock' {Text
workerId :: Text
$sel:workerId:DeleteWorkerBlock' :: DeleteWorkerBlock -> Text
workerId} -> Text
workerId) (\s :: DeleteWorkerBlock
s@DeleteWorkerBlock' {} Text
a -> DeleteWorkerBlock
s {$sel:workerId:DeleteWorkerBlock' :: Text
workerId = Text
a} :: DeleteWorkerBlock)

instance Core.AWSRequest DeleteWorkerBlock where
  type
    AWSResponse DeleteWorkerBlock =
      DeleteWorkerBlockResponse
  request :: (Service -> Service)
-> DeleteWorkerBlock -> Request DeleteWorkerBlock
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 DeleteWorkerBlock
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteWorkerBlock)))
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 -> DeleteWorkerBlockResponse
DeleteWorkerBlockResponse'
            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 DeleteWorkerBlock where
  hashWithSalt :: Int -> DeleteWorkerBlock -> Int
hashWithSalt Int
_salt DeleteWorkerBlock' {Maybe Text
Text
workerId :: Text
reason :: Maybe Text
$sel:workerId:DeleteWorkerBlock' :: DeleteWorkerBlock -> Text
$sel:reason:DeleteWorkerBlock' :: DeleteWorkerBlock -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workerId

instance Prelude.NFData DeleteWorkerBlock where
  rnf :: DeleteWorkerBlock -> ()
rnf DeleteWorkerBlock' {Maybe Text
Text
workerId :: Text
reason :: Maybe Text
$sel:workerId:DeleteWorkerBlock' :: DeleteWorkerBlock -> Text
$sel:reason:DeleteWorkerBlock' :: DeleteWorkerBlock -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
reason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workerId

instance Data.ToHeaders DeleteWorkerBlock where
  toHeaders :: DeleteWorkerBlock -> 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.DeleteWorkerBlock" ::
                          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 DeleteWorkerBlock where
  toJSON :: DeleteWorkerBlock -> Value
toJSON DeleteWorkerBlock' {Maybe Text
Text
workerId :: Text
reason :: Maybe Text
$sel:workerId:DeleteWorkerBlock' :: DeleteWorkerBlock -> Text
$sel:reason:DeleteWorkerBlock' :: DeleteWorkerBlock -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Reason" 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
reason,
            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 DeleteWorkerBlock where
  toPath :: DeleteWorkerBlock -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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