{-# 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.IVSChat.SendEvent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sends an event to a room. Use this within your application’s business
-- logic to send events to clients of a room; e.g., to notify clients to
-- change the way the chat UI is rendered.
module Amazonka.IVSChat.SendEvent
  ( -- * Creating a Request
    SendEvent (..),
    newSendEvent,

    -- * Request Lenses
    sendEvent_attributes,
    sendEvent_eventName,
    sendEvent_roomIdentifier,

    -- * Destructuring the Response
    SendEventResponse (..),
    newSendEventResponse,

    -- * Response Lenses
    sendEventResponse_id,
    sendEventResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IVSChat.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newSendEvent' smart constructor.
data SendEvent = SendEvent'
  { -- | Application-defined metadata to attach to the event sent to clients. The
    -- maximum length of the metadata is 1 KB total.
    SendEvent -> Maybe (HashMap Text Text)
attributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Application-defined name of the event to send to clients.
    SendEvent -> Text
eventName :: Prelude.Text,
    -- | Identifier of the room to which the event will be sent. Currently this
    -- must be an ARN.
    SendEvent -> Text
roomIdentifier :: Prelude.Text
  }
  deriving (SendEvent -> SendEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendEvent -> SendEvent -> Bool
$c/= :: SendEvent -> SendEvent -> Bool
== :: SendEvent -> SendEvent -> Bool
$c== :: SendEvent -> SendEvent -> Bool
Prelude.Eq, ReadPrec [SendEvent]
ReadPrec SendEvent
Int -> ReadS SendEvent
ReadS [SendEvent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendEvent]
$creadListPrec :: ReadPrec [SendEvent]
readPrec :: ReadPrec SendEvent
$creadPrec :: ReadPrec SendEvent
readList :: ReadS [SendEvent]
$creadList :: ReadS [SendEvent]
readsPrec :: Int -> ReadS SendEvent
$creadsPrec :: Int -> ReadS SendEvent
Prelude.Read, Int -> SendEvent -> ShowS
[SendEvent] -> ShowS
SendEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendEvent] -> ShowS
$cshowList :: [SendEvent] -> ShowS
show :: SendEvent -> String
$cshow :: SendEvent -> String
showsPrec :: Int -> SendEvent -> ShowS
$cshowsPrec :: Int -> SendEvent -> ShowS
Prelude.Show, forall x. Rep SendEvent x -> SendEvent
forall x. SendEvent -> Rep SendEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendEvent x -> SendEvent
$cfrom :: forall x. SendEvent -> Rep SendEvent x
Prelude.Generic)

-- |
-- Create a value of 'SendEvent' 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:
--
-- 'attributes', 'sendEvent_attributes' - Application-defined metadata to attach to the event sent to clients. The
-- maximum length of the metadata is 1 KB total.
--
-- 'eventName', 'sendEvent_eventName' - Application-defined name of the event to send to clients.
--
-- 'roomIdentifier', 'sendEvent_roomIdentifier' - Identifier of the room to which the event will be sent. Currently this
-- must be an ARN.
newSendEvent ::
  -- | 'eventName'
  Prelude.Text ->
  -- | 'roomIdentifier'
  Prelude.Text ->
  SendEvent
newSendEvent :: Text -> Text -> SendEvent
newSendEvent Text
pEventName_ Text
pRoomIdentifier_ =
  SendEvent'
    { $sel:attributes:SendEvent' :: Maybe (HashMap Text Text)
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:eventName:SendEvent' :: Text
eventName = Text
pEventName_,
      $sel:roomIdentifier:SendEvent' :: Text
roomIdentifier = Text
pRoomIdentifier_
    }

-- | Application-defined metadata to attach to the event sent to clients. The
-- maximum length of the metadata is 1 KB total.
sendEvent_attributes :: Lens.Lens' SendEvent (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
sendEvent_attributes :: Lens' SendEvent (Maybe (HashMap Text Text))
sendEvent_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Maybe (HashMap Text Text)
attributes :: Maybe (HashMap Text Text)
$sel:attributes:SendEvent' :: SendEvent -> Maybe (HashMap Text Text)
attributes} -> Maybe (HashMap Text Text)
attributes) (\s :: SendEvent
s@SendEvent' {} Maybe (HashMap Text Text)
a -> SendEvent
s {$sel:attributes:SendEvent' :: Maybe (HashMap Text Text)
attributes = Maybe (HashMap Text Text)
a} :: SendEvent) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Application-defined name of the event to send to clients.
sendEvent_eventName :: Lens.Lens' SendEvent Prelude.Text
sendEvent_eventName :: Lens' SendEvent Text
sendEvent_eventName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Text
eventName :: Text
$sel:eventName:SendEvent' :: SendEvent -> Text
eventName} -> Text
eventName) (\s :: SendEvent
s@SendEvent' {} Text
a -> SendEvent
s {$sel:eventName:SendEvent' :: Text
eventName = Text
a} :: SendEvent)

-- | Identifier of the room to which the event will be sent. Currently this
-- must be an ARN.
sendEvent_roomIdentifier :: Lens.Lens' SendEvent Prelude.Text
sendEvent_roomIdentifier :: Lens' SendEvent Text
sendEvent_roomIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEvent' {Text
roomIdentifier :: Text
$sel:roomIdentifier:SendEvent' :: SendEvent -> Text
roomIdentifier} -> Text
roomIdentifier) (\s :: SendEvent
s@SendEvent' {} Text
a -> SendEvent
s {$sel:roomIdentifier:SendEvent' :: Text
roomIdentifier = Text
a} :: SendEvent)

instance Core.AWSRequest SendEvent where
  type AWSResponse SendEvent = SendEventResponse
  request :: (Service -> Service) -> SendEvent -> Request SendEvent
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 SendEvent
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SendEvent)))
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 Text -> Int -> SendEventResponse
SendEventResponse'
            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
"id")
            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 SendEvent where
  hashWithSalt :: Int -> SendEvent -> Int
hashWithSalt Int
_salt SendEvent' {Maybe (HashMap Text Text)
Text
roomIdentifier :: Text
eventName :: Text
attributes :: Maybe (HashMap Text Text)
$sel:roomIdentifier:SendEvent' :: SendEvent -> Text
$sel:eventName:SendEvent' :: SendEvent -> Text
$sel:attributes:SendEvent' :: SendEvent -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roomIdentifier

instance Prelude.NFData SendEvent where
  rnf :: SendEvent -> ()
rnf SendEvent' {Maybe (HashMap Text Text)
Text
roomIdentifier :: Text
eventName :: Text
attributes :: Maybe (HashMap Text Text)
$sel:roomIdentifier:SendEvent' :: SendEvent -> Text
$sel:eventName:SendEvent' :: SendEvent -> Text
$sel:attributes:SendEvent' :: SendEvent -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
eventName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roomIdentifier

instance Data.ToHeaders SendEvent where
  toHeaders :: SendEvent -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON SendEvent where
  toJSON :: SendEvent -> Value
toJSON SendEvent' {Maybe (HashMap Text Text)
Text
roomIdentifier :: Text
eventName :: Text
attributes :: Maybe (HashMap Text Text)
$sel:roomIdentifier:SendEvent' :: SendEvent -> Text
$sel:eventName:SendEvent' :: SendEvent -> Text
$sel:attributes:SendEvent' :: SendEvent -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"attributes" 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 (HashMap Text Text)
attributes,
            forall a. a -> Maybe a
Prelude.Just (Key
"eventName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
eventName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"roomIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roomIdentifier)
          ]
      )

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

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

-- | /See:/ 'newSendEventResponse' smart constructor.
data SendEventResponse = SendEventResponse'
  { -- | An identifier generated by Amazon IVS Chat. This identifier must be used
    -- in subsequent operations for this message, such as DeleteMessage.
    SendEventResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    SendEventResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SendEventResponse -> SendEventResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendEventResponse -> SendEventResponse -> Bool
$c/= :: SendEventResponse -> SendEventResponse -> Bool
== :: SendEventResponse -> SendEventResponse -> Bool
$c== :: SendEventResponse -> SendEventResponse -> Bool
Prelude.Eq, ReadPrec [SendEventResponse]
ReadPrec SendEventResponse
Int -> ReadS SendEventResponse
ReadS [SendEventResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendEventResponse]
$creadListPrec :: ReadPrec [SendEventResponse]
readPrec :: ReadPrec SendEventResponse
$creadPrec :: ReadPrec SendEventResponse
readList :: ReadS [SendEventResponse]
$creadList :: ReadS [SendEventResponse]
readsPrec :: Int -> ReadS SendEventResponse
$creadsPrec :: Int -> ReadS SendEventResponse
Prelude.Read, Int -> SendEventResponse -> ShowS
[SendEventResponse] -> ShowS
SendEventResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendEventResponse] -> ShowS
$cshowList :: [SendEventResponse] -> ShowS
show :: SendEventResponse -> String
$cshow :: SendEventResponse -> String
showsPrec :: Int -> SendEventResponse -> ShowS
$cshowsPrec :: Int -> SendEventResponse -> ShowS
Prelude.Show, forall x. Rep SendEventResponse x -> SendEventResponse
forall x. SendEventResponse -> Rep SendEventResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendEventResponse x -> SendEventResponse
$cfrom :: forall x. SendEventResponse -> Rep SendEventResponse x
Prelude.Generic)

-- |
-- Create a value of 'SendEventResponse' 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:
--
-- 'id', 'sendEventResponse_id' - An identifier generated by Amazon IVS Chat. This identifier must be used
-- in subsequent operations for this message, such as DeleteMessage.
--
-- 'httpStatus', 'sendEventResponse_httpStatus' - The response's http status code.
newSendEventResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SendEventResponse
newSendEventResponse :: Int -> SendEventResponse
newSendEventResponse Int
pHttpStatus_ =
  SendEventResponse'
    { $sel:id:SendEventResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SendEventResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An identifier generated by Amazon IVS Chat. This identifier must be used
-- in subsequent operations for this message, such as DeleteMessage.
sendEventResponse_id :: Lens.Lens' SendEventResponse (Prelude.Maybe Prelude.Text)
sendEventResponse_id :: Lens' SendEventResponse (Maybe Text)
sendEventResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendEventResponse' {Maybe Text
id :: Maybe Text
$sel:id:SendEventResponse' :: SendEventResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: SendEventResponse
s@SendEventResponse' {} Maybe Text
a -> SendEventResponse
s {$sel:id:SendEventResponse' :: Maybe Text
id = Maybe Text
a} :: SendEventResponse)

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

instance Prelude.NFData SendEventResponse where
  rnf :: SendEventResponse -> ()
rnf SendEventResponse' {Int
Maybe Text
httpStatus :: Int
id :: Maybe Text
$sel:httpStatus:SendEventResponse' :: SendEventResponse -> Int
$sel:id:SendEventResponse' :: SendEventResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus