{-# 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.UpdateExpirationForHIT
-- 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 @UpdateExpirationForHIT@ operation allows you update the expiration
-- time of a HIT. If you update it to a time in the past, the HIT will be
-- immediately expired.
module Amazonka.MechanicalTurk.UpdateExpirationForHIT
  ( -- * Creating a Request
    UpdateExpirationForHIT (..),
    newUpdateExpirationForHIT,

    -- * Request Lenses
    updateExpirationForHIT_hITId,
    updateExpirationForHIT_expireAt,

    -- * Destructuring the Response
    UpdateExpirationForHITResponse (..),
    newUpdateExpirationForHITResponse,

    -- * Response Lenses
    updateExpirationForHITResponse_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:/ 'newUpdateExpirationForHIT' smart constructor.
data UpdateExpirationForHIT = UpdateExpirationForHIT'
  { -- | The HIT to update.
    UpdateExpirationForHIT -> Text
hITId :: Prelude.Text,
    -- | The date and time at which you want the HIT to expire
    UpdateExpirationForHIT -> POSIX
expireAt :: Data.POSIX
  }
  deriving (UpdateExpirationForHIT -> UpdateExpirationForHIT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateExpirationForHIT -> UpdateExpirationForHIT -> Bool
$c/= :: UpdateExpirationForHIT -> UpdateExpirationForHIT -> Bool
== :: UpdateExpirationForHIT -> UpdateExpirationForHIT -> Bool
$c== :: UpdateExpirationForHIT -> UpdateExpirationForHIT -> Bool
Prelude.Eq, ReadPrec [UpdateExpirationForHIT]
ReadPrec UpdateExpirationForHIT
Int -> ReadS UpdateExpirationForHIT
ReadS [UpdateExpirationForHIT]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateExpirationForHIT]
$creadListPrec :: ReadPrec [UpdateExpirationForHIT]
readPrec :: ReadPrec UpdateExpirationForHIT
$creadPrec :: ReadPrec UpdateExpirationForHIT
readList :: ReadS [UpdateExpirationForHIT]
$creadList :: ReadS [UpdateExpirationForHIT]
readsPrec :: Int -> ReadS UpdateExpirationForHIT
$creadsPrec :: Int -> ReadS UpdateExpirationForHIT
Prelude.Read, Int -> UpdateExpirationForHIT -> ShowS
[UpdateExpirationForHIT] -> ShowS
UpdateExpirationForHIT -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateExpirationForHIT] -> ShowS
$cshowList :: [UpdateExpirationForHIT] -> ShowS
show :: UpdateExpirationForHIT -> String
$cshow :: UpdateExpirationForHIT -> String
showsPrec :: Int -> UpdateExpirationForHIT -> ShowS
$cshowsPrec :: Int -> UpdateExpirationForHIT -> ShowS
Prelude.Show, forall x. Rep UpdateExpirationForHIT x -> UpdateExpirationForHIT
forall x. UpdateExpirationForHIT -> Rep UpdateExpirationForHIT x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateExpirationForHIT x -> UpdateExpirationForHIT
$cfrom :: forall x. UpdateExpirationForHIT -> Rep UpdateExpirationForHIT x
Prelude.Generic)

-- |
-- Create a value of 'UpdateExpirationForHIT' 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:
--
-- 'hITId', 'updateExpirationForHIT_hITId' - The HIT to update.
--
-- 'expireAt', 'updateExpirationForHIT_expireAt' - The date and time at which you want the HIT to expire
newUpdateExpirationForHIT ::
  -- | 'hITId'
  Prelude.Text ->
  -- | 'expireAt'
  Prelude.UTCTime ->
  UpdateExpirationForHIT
newUpdateExpirationForHIT :: Text -> UTCTime -> UpdateExpirationForHIT
newUpdateExpirationForHIT Text
pHITId_ UTCTime
pExpireAt_ =
  UpdateExpirationForHIT'
    { $sel:hITId:UpdateExpirationForHIT' :: Text
hITId = Text
pHITId_,
      $sel:expireAt:UpdateExpirationForHIT' :: POSIX
expireAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pExpireAt_
    }

-- | The HIT to update.
updateExpirationForHIT_hITId :: Lens.Lens' UpdateExpirationForHIT Prelude.Text
updateExpirationForHIT_hITId :: Lens' UpdateExpirationForHIT Text
updateExpirationForHIT_hITId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateExpirationForHIT' {Text
hITId :: Text
$sel:hITId:UpdateExpirationForHIT' :: UpdateExpirationForHIT -> Text
hITId} -> Text
hITId) (\s :: UpdateExpirationForHIT
s@UpdateExpirationForHIT' {} Text
a -> UpdateExpirationForHIT
s {$sel:hITId:UpdateExpirationForHIT' :: Text
hITId = Text
a} :: UpdateExpirationForHIT)

-- | The date and time at which you want the HIT to expire
updateExpirationForHIT_expireAt :: Lens.Lens' UpdateExpirationForHIT Prelude.UTCTime
updateExpirationForHIT_expireAt :: Lens' UpdateExpirationForHIT UTCTime
updateExpirationForHIT_expireAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateExpirationForHIT' {POSIX
expireAt :: POSIX
$sel:expireAt:UpdateExpirationForHIT' :: UpdateExpirationForHIT -> POSIX
expireAt} -> POSIX
expireAt) (\s :: UpdateExpirationForHIT
s@UpdateExpirationForHIT' {} POSIX
a -> UpdateExpirationForHIT
s {$sel:expireAt:UpdateExpirationForHIT' :: POSIX
expireAt = POSIX
a} :: UpdateExpirationForHIT) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

instance Prelude.NFData UpdateExpirationForHIT where
  rnf :: UpdateExpirationForHIT -> ()
rnf UpdateExpirationForHIT' {Text
POSIX
expireAt :: POSIX
hITId :: Text
$sel:expireAt:UpdateExpirationForHIT' :: UpdateExpirationForHIT -> POSIX
$sel:hITId:UpdateExpirationForHIT' :: UpdateExpirationForHIT -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
hITId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
expireAt

instance Data.ToHeaders UpdateExpirationForHIT where
  toHeaders :: UpdateExpirationForHIT -> 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.UpdateExpirationForHIT" ::
                          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 UpdateExpirationForHIT where
  toJSON :: UpdateExpirationForHIT -> Value
toJSON UpdateExpirationForHIT' {Text
POSIX
expireAt :: POSIX
hITId :: Text
$sel:expireAt:UpdateExpirationForHIT' :: UpdateExpirationForHIT -> POSIX
$sel:hITId:UpdateExpirationForHIT' :: UpdateExpirationForHIT -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"HITId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hITId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ExpireAt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
expireAt)
          ]
      )

instance Data.ToPath UpdateExpirationForHIT where
  toPath :: UpdateExpirationForHIT -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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