{-# 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.SendTestEventNotification
-- 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 @SendTestEventNotification@ operation causes Amazon Mechanical Turk
-- to send a notification message as if a HIT event occurred, according to
-- the provided notification specification. This allows you to test
-- notifications without setting up notifications for a real HIT type and
-- trying to trigger them using the website. When you call this operation,
-- the service attempts to send the test notification immediately.
module Amazonka.MechanicalTurk.SendTestEventNotification
  ( -- * Creating a Request
    SendTestEventNotification (..),
    newSendTestEventNotification,

    -- * Request Lenses
    sendTestEventNotification_notification,
    sendTestEventNotification_testEventType,

    -- * Destructuring the Response
    SendTestEventNotificationResponse (..),
    newSendTestEventNotificationResponse,

    -- * Response Lenses
    sendTestEventNotificationResponse_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:/ 'newSendTestEventNotification' smart constructor.
data SendTestEventNotification = SendTestEventNotification'
  { -- | The notification specification to test. This value is identical to the
    -- value you would provide to the UpdateNotificationSettings operation when
    -- you establish the notification specification for a HIT type.
    SendTestEventNotification -> NotificationSpecification
notification :: NotificationSpecification,
    -- | The event to simulate to test the notification specification. This event
    -- is included in the test message even if the notification specification
    -- does not include the event type. The notification specification does not
    -- filter out the test event.
    SendTestEventNotification -> EventType
testEventType :: EventType
  }
  deriving (SendTestEventNotification -> SendTestEventNotification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendTestEventNotification -> SendTestEventNotification -> Bool
$c/= :: SendTestEventNotification -> SendTestEventNotification -> Bool
== :: SendTestEventNotification -> SendTestEventNotification -> Bool
$c== :: SendTestEventNotification -> SendTestEventNotification -> Bool
Prelude.Eq, ReadPrec [SendTestEventNotification]
ReadPrec SendTestEventNotification
Int -> ReadS SendTestEventNotification
ReadS [SendTestEventNotification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendTestEventNotification]
$creadListPrec :: ReadPrec [SendTestEventNotification]
readPrec :: ReadPrec SendTestEventNotification
$creadPrec :: ReadPrec SendTestEventNotification
readList :: ReadS [SendTestEventNotification]
$creadList :: ReadS [SendTestEventNotification]
readsPrec :: Int -> ReadS SendTestEventNotification
$creadsPrec :: Int -> ReadS SendTestEventNotification
Prelude.Read, Int -> SendTestEventNotification -> ShowS
[SendTestEventNotification] -> ShowS
SendTestEventNotification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendTestEventNotification] -> ShowS
$cshowList :: [SendTestEventNotification] -> ShowS
show :: SendTestEventNotification -> String
$cshow :: SendTestEventNotification -> String
showsPrec :: Int -> SendTestEventNotification -> ShowS
$cshowsPrec :: Int -> SendTestEventNotification -> ShowS
Prelude.Show, forall x.
Rep SendTestEventNotification x -> SendTestEventNotification
forall x.
SendTestEventNotification -> Rep SendTestEventNotification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SendTestEventNotification x -> SendTestEventNotification
$cfrom :: forall x.
SendTestEventNotification -> Rep SendTestEventNotification x
Prelude.Generic)

-- |
-- Create a value of 'SendTestEventNotification' 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:
--
-- 'notification', 'sendTestEventNotification_notification' - The notification specification to test. This value is identical to the
-- value you would provide to the UpdateNotificationSettings operation when
-- you establish the notification specification for a HIT type.
--
-- 'testEventType', 'sendTestEventNotification_testEventType' - The event to simulate to test the notification specification. This event
-- is included in the test message even if the notification specification
-- does not include the event type. The notification specification does not
-- filter out the test event.
newSendTestEventNotification ::
  -- | 'notification'
  NotificationSpecification ->
  -- | 'testEventType'
  EventType ->
  SendTestEventNotification
newSendTestEventNotification :: NotificationSpecification -> EventType -> SendTestEventNotification
newSendTestEventNotification
  NotificationSpecification
pNotification_
  EventType
pTestEventType_ =
    SendTestEventNotification'
      { $sel:notification:SendTestEventNotification' :: NotificationSpecification
notification =
          NotificationSpecification
pNotification_,
        $sel:testEventType:SendTestEventNotification' :: EventType
testEventType = EventType
pTestEventType_
      }

-- | The notification specification to test. This value is identical to the
-- value you would provide to the UpdateNotificationSettings operation when
-- you establish the notification specification for a HIT type.
sendTestEventNotification_notification :: Lens.Lens' SendTestEventNotification NotificationSpecification
sendTestEventNotification_notification :: Lens' SendTestEventNotification NotificationSpecification
sendTestEventNotification_notification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendTestEventNotification' {NotificationSpecification
notification :: NotificationSpecification
$sel:notification:SendTestEventNotification' :: SendTestEventNotification -> NotificationSpecification
notification} -> NotificationSpecification
notification) (\s :: SendTestEventNotification
s@SendTestEventNotification' {} NotificationSpecification
a -> SendTestEventNotification
s {$sel:notification:SendTestEventNotification' :: NotificationSpecification
notification = NotificationSpecification
a} :: SendTestEventNotification)

-- | The event to simulate to test the notification specification. This event
-- is included in the test message even if the notification specification
-- does not include the event type. The notification specification does not
-- filter out the test event.
sendTestEventNotification_testEventType :: Lens.Lens' SendTestEventNotification EventType
sendTestEventNotification_testEventType :: Lens' SendTestEventNotification EventType
sendTestEventNotification_testEventType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendTestEventNotification' {EventType
testEventType :: EventType
$sel:testEventType:SendTestEventNotification' :: SendTestEventNotification -> EventType
testEventType} -> EventType
testEventType) (\s :: SendTestEventNotification
s@SendTestEventNotification' {} EventType
a -> SendTestEventNotification
s {$sel:testEventType:SendTestEventNotification' :: EventType
testEventType = EventType
a} :: SendTestEventNotification)

instance Core.AWSRequest SendTestEventNotification where
  type
    AWSResponse SendTestEventNotification =
      SendTestEventNotificationResponse
  request :: (Service -> Service)
-> SendTestEventNotification -> Request SendTestEventNotification
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 SendTestEventNotification
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SendTestEventNotification)))
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 -> SendTestEventNotificationResponse
SendTestEventNotificationResponse'
            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 SendTestEventNotification where
  hashWithSalt :: Int -> SendTestEventNotification -> Int
hashWithSalt Int
_salt SendTestEventNotification' {EventType
NotificationSpecification
testEventType :: EventType
notification :: NotificationSpecification
$sel:testEventType:SendTestEventNotification' :: SendTestEventNotification -> EventType
$sel:notification:SendTestEventNotification' :: SendTestEventNotification -> NotificationSpecification
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NotificationSpecification
notification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EventType
testEventType

instance Prelude.NFData SendTestEventNotification where
  rnf :: SendTestEventNotification -> ()
rnf SendTestEventNotification' {EventType
NotificationSpecification
testEventType :: EventType
notification :: NotificationSpecification
$sel:testEventType:SendTestEventNotification' :: SendTestEventNotification -> EventType
$sel:notification:SendTestEventNotification' :: SendTestEventNotification -> NotificationSpecification
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NotificationSpecification
notification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EventType
testEventType

instance Data.ToHeaders SendTestEventNotification where
  toHeaders :: SendTestEventNotification -> 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.SendTestEventNotification" ::
                          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 SendTestEventNotification where
  toJSON :: SendTestEventNotification -> Value
toJSON SendTestEventNotification' {EventType
NotificationSpecification
testEventType :: EventType
notification :: NotificationSpecification
$sel:testEventType:SendTestEventNotification' :: SendTestEventNotification -> EventType
$sel:notification:SendTestEventNotification' :: SendTestEventNotification -> NotificationSpecification
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Notification" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NotificationSpecification
notification),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TestEventType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= EventType
testEventType)
          ]
      )

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

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

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

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

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

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