{-# 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.Chime.SendChannelMessage
-- 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 a message to a particular channel that the member is a part of.
--
-- The @x-amz-chime-bearer@ request header is mandatory. Use the
-- @AppInstanceUserArn@ of the user that makes the API call as the value in
-- the header.
--
-- Also, @STANDARD@ messages can contain 4KB of data and the 1KB of
-- metadata. @CONTROL@ messages can contain 30 bytes of data and no
-- metadata.
module Amazonka.Chime.SendChannelMessage
  ( -- * Creating a Request
    SendChannelMessage (..),
    newSendChannelMessage,

    -- * Request Lenses
    sendChannelMessage_chimeBearer,
    sendChannelMessage_metadata,
    sendChannelMessage_channelArn,
    sendChannelMessage_content,
    sendChannelMessage_type,
    sendChannelMessage_persistence,
    sendChannelMessage_clientRequestToken,

    -- * Destructuring the Response
    SendChannelMessageResponse (..),
    newSendChannelMessageResponse,

    -- * Response Lenses
    sendChannelMessageResponse_channelArn,
    sendChannelMessageResponse_messageId,
    sendChannelMessageResponse_httpStatus,
  )
where

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

-- | /See:/ 'newSendChannelMessage' smart constructor.
data SendChannelMessage = SendChannelMessage'
  { -- | The @AppInstanceUserArn@ of the user that makes the API call.
    SendChannelMessage -> Maybe Text
chimeBearer :: Prelude.Maybe Prelude.Text,
    -- | The optional metadata for each message.
    SendChannelMessage -> Maybe (Sensitive Text)
metadata :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The ARN of the channel.
    SendChannelMessage -> Text
channelArn :: Prelude.Text,
    -- | The content of the message.
    SendChannelMessage -> Sensitive Text
content :: Data.Sensitive Prelude.Text,
    -- | The type of message, @STANDARD@ or @CONTROL@.
    SendChannelMessage -> ChannelMessageType
type' :: ChannelMessageType,
    -- | Boolean that controls whether the message is persisted on the back end.
    -- Required.
    SendChannelMessage -> ChannelMessagePersistenceType
persistence :: ChannelMessagePersistenceType,
    -- | The @Idempotency@ token for each client request.
    SendChannelMessage -> Sensitive Text
clientRequestToken :: Data.Sensitive Prelude.Text
  }
  deriving (SendChannelMessage -> SendChannelMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendChannelMessage -> SendChannelMessage -> Bool
$c/= :: SendChannelMessage -> SendChannelMessage -> Bool
== :: SendChannelMessage -> SendChannelMessage -> Bool
$c== :: SendChannelMessage -> SendChannelMessage -> Bool
Prelude.Eq, Int -> SendChannelMessage -> ShowS
[SendChannelMessage] -> ShowS
SendChannelMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendChannelMessage] -> ShowS
$cshowList :: [SendChannelMessage] -> ShowS
show :: SendChannelMessage -> String
$cshow :: SendChannelMessage -> String
showsPrec :: Int -> SendChannelMessage -> ShowS
$cshowsPrec :: Int -> SendChannelMessage -> ShowS
Prelude.Show, forall x. Rep SendChannelMessage x -> SendChannelMessage
forall x. SendChannelMessage -> Rep SendChannelMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendChannelMessage x -> SendChannelMessage
$cfrom :: forall x. SendChannelMessage -> Rep SendChannelMessage x
Prelude.Generic)

-- |
-- Create a value of 'SendChannelMessage' 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:
--
-- 'chimeBearer', 'sendChannelMessage_chimeBearer' - The @AppInstanceUserArn@ of the user that makes the API call.
--
-- 'metadata', 'sendChannelMessage_metadata' - The optional metadata for each message.
--
-- 'channelArn', 'sendChannelMessage_channelArn' - The ARN of the channel.
--
-- 'content', 'sendChannelMessage_content' - The content of the message.
--
-- 'type'', 'sendChannelMessage_type' - The type of message, @STANDARD@ or @CONTROL@.
--
-- 'persistence', 'sendChannelMessage_persistence' - Boolean that controls whether the message is persisted on the back end.
-- Required.
--
-- 'clientRequestToken', 'sendChannelMessage_clientRequestToken' - The @Idempotency@ token for each client request.
newSendChannelMessage ::
  -- | 'channelArn'
  Prelude.Text ->
  -- | 'content'
  Prelude.Text ->
  -- | 'type''
  ChannelMessageType ->
  -- | 'persistence'
  ChannelMessagePersistenceType ->
  -- | 'clientRequestToken'
  Prelude.Text ->
  SendChannelMessage
newSendChannelMessage :: Text
-> Text
-> ChannelMessageType
-> ChannelMessagePersistenceType
-> Text
-> SendChannelMessage
newSendChannelMessage
  Text
pChannelArn_
  Text
pContent_
  ChannelMessageType
pType_
  ChannelMessagePersistenceType
pPersistence_
  Text
pClientRequestToken_ =
    SendChannelMessage'
      { $sel:chimeBearer:SendChannelMessage' :: Maybe Text
chimeBearer = forall a. Maybe a
Prelude.Nothing,
        $sel:metadata:SendChannelMessage' :: Maybe (Sensitive Text)
metadata = forall a. Maybe a
Prelude.Nothing,
        $sel:channelArn:SendChannelMessage' :: Text
channelArn = Text
pChannelArn_,
        $sel:content:SendChannelMessage' :: Sensitive Text
content = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pContent_,
        $sel:type':SendChannelMessage' :: ChannelMessageType
type' = ChannelMessageType
pType_,
        $sel:persistence:SendChannelMessage' :: ChannelMessagePersistenceType
persistence = ChannelMessagePersistenceType
pPersistence_,
        $sel:clientRequestToken:SendChannelMessage' :: Sensitive Text
clientRequestToken =
          forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pClientRequestToken_
      }

-- | The @AppInstanceUserArn@ of the user that makes the API call.
sendChannelMessage_chimeBearer :: Lens.Lens' SendChannelMessage (Prelude.Maybe Prelude.Text)
sendChannelMessage_chimeBearer :: Lens' SendChannelMessage (Maybe Text)
sendChannelMessage_chimeBearer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendChannelMessage' {Maybe Text
chimeBearer :: Maybe Text
$sel:chimeBearer:SendChannelMessage' :: SendChannelMessage -> Maybe Text
chimeBearer} -> Maybe Text
chimeBearer) (\s :: SendChannelMessage
s@SendChannelMessage' {} Maybe Text
a -> SendChannelMessage
s {$sel:chimeBearer:SendChannelMessage' :: Maybe Text
chimeBearer = Maybe Text
a} :: SendChannelMessage)

-- | The optional metadata for each message.
sendChannelMessage_metadata :: Lens.Lens' SendChannelMessage (Prelude.Maybe Prelude.Text)
sendChannelMessage_metadata :: Lens' SendChannelMessage (Maybe Text)
sendChannelMessage_metadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendChannelMessage' {Maybe (Sensitive Text)
metadata :: Maybe (Sensitive Text)
$sel:metadata:SendChannelMessage' :: SendChannelMessage -> Maybe (Sensitive Text)
metadata} -> Maybe (Sensitive Text)
metadata) (\s :: SendChannelMessage
s@SendChannelMessage' {} Maybe (Sensitive Text)
a -> SendChannelMessage
s {$sel:metadata:SendChannelMessage' :: Maybe (Sensitive Text)
metadata = Maybe (Sensitive Text)
a} :: SendChannelMessage) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The ARN of the channel.
sendChannelMessage_channelArn :: Lens.Lens' SendChannelMessage Prelude.Text
sendChannelMessage_channelArn :: Lens' SendChannelMessage Text
sendChannelMessage_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendChannelMessage' {Text
channelArn :: Text
$sel:channelArn:SendChannelMessage' :: SendChannelMessage -> Text
channelArn} -> Text
channelArn) (\s :: SendChannelMessage
s@SendChannelMessage' {} Text
a -> SendChannelMessage
s {$sel:channelArn:SendChannelMessage' :: Text
channelArn = Text
a} :: SendChannelMessage)

-- | The content of the message.
sendChannelMessage_content :: Lens.Lens' SendChannelMessage Prelude.Text
sendChannelMessage_content :: Lens' SendChannelMessage Text
sendChannelMessage_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendChannelMessage' {Sensitive Text
content :: Sensitive Text
$sel:content:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
content} -> Sensitive Text
content) (\s :: SendChannelMessage
s@SendChannelMessage' {} Sensitive Text
a -> SendChannelMessage
s {$sel:content:SendChannelMessage' :: Sensitive Text
content = Sensitive Text
a} :: SendChannelMessage) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The type of message, @STANDARD@ or @CONTROL@.
sendChannelMessage_type :: Lens.Lens' SendChannelMessage ChannelMessageType
sendChannelMessage_type :: Lens' SendChannelMessage ChannelMessageType
sendChannelMessage_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendChannelMessage' {ChannelMessageType
type' :: ChannelMessageType
$sel:type':SendChannelMessage' :: SendChannelMessage -> ChannelMessageType
type'} -> ChannelMessageType
type') (\s :: SendChannelMessage
s@SendChannelMessage' {} ChannelMessageType
a -> SendChannelMessage
s {$sel:type':SendChannelMessage' :: ChannelMessageType
type' = ChannelMessageType
a} :: SendChannelMessage)

-- | Boolean that controls whether the message is persisted on the back end.
-- Required.
sendChannelMessage_persistence :: Lens.Lens' SendChannelMessage ChannelMessagePersistenceType
sendChannelMessage_persistence :: Lens' SendChannelMessage ChannelMessagePersistenceType
sendChannelMessage_persistence = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendChannelMessage' {ChannelMessagePersistenceType
persistence :: ChannelMessagePersistenceType
$sel:persistence:SendChannelMessage' :: SendChannelMessage -> ChannelMessagePersistenceType
persistence} -> ChannelMessagePersistenceType
persistence) (\s :: SendChannelMessage
s@SendChannelMessage' {} ChannelMessagePersistenceType
a -> SendChannelMessage
s {$sel:persistence:SendChannelMessage' :: ChannelMessagePersistenceType
persistence = ChannelMessagePersistenceType
a} :: SendChannelMessage)

-- | The @Idempotency@ token for each client request.
sendChannelMessage_clientRequestToken :: Lens.Lens' SendChannelMessage Prelude.Text
sendChannelMessage_clientRequestToken :: Lens' SendChannelMessage Text
sendChannelMessage_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendChannelMessage' {Sensitive Text
clientRequestToken :: Sensitive Text
$sel:clientRequestToken:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
clientRequestToken} -> Sensitive Text
clientRequestToken) (\s :: SendChannelMessage
s@SendChannelMessage' {} Sensitive Text
a -> SendChannelMessage
s {$sel:clientRequestToken:SendChannelMessage' :: Sensitive Text
clientRequestToken = Sensitive Text
a} :: SendChannelMessage) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest SendChannelMessage where
  type
    AWSResponse SendChannelMessage =
      SendChannelMessageResponse
  request :: (Service -> Service)
-> SendChannelMessage -> Request SendChannelMessage
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 SendChannelMessage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SendChannelMessage)))
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 -> Maybe Text -> Int -> SendChannelMessageResponse
SendChannelMessageResponse'
            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
"ChannelArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"MessageId")
            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 SendChannelMessage where
  hashWithSalt :: Int -> SendChannelMessage -> Int
hashWithSalt Int
_salt SendChannelMessage' {Maybe Text
Maybe (Sensitive Text)
Text
Sensitive Text
ChannelMessagePersistenceType
ChannelMessageType
clientRequestToken :: Sensitive Text
persistence :: ChannelMessagePersistenceType
type' :: ChannelMessageType
content :: Sensitive Text
channelArn :: Text
metadata :: Maybe (Sensitive Text)
chimeBearer :: Maybe Text
$sel:clientRequestToken:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
$sel:persistence:SendChannelMessage' :: SendChannelMessage -> ChannelMessagePersistenceType
$sel:type':SendChannelMessage' :: SendChannelMessage -> ChannelMessageType
$sel:content:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
$sel:channelArn:SendChannelMessage' :: SendChannelMessage -> Text
$sel:metadata:SendChannelMessage' :: SendChannelMessage -> Maybe (Sensitive Text)
$sel:chimeBearer:SendChannelMessage' :: SendChannelMessage -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
chimeBearer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
metadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channelArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
content
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ChannelMessageType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ChannelMessagePersistenceType
persistence
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
clientRequestToken

instance Prelude.NFData SendChannelMessage where
  rnf :: SendChannelMessage -> ()
rnf SendChannelMessage' {Maybe Text
Maybe (Sensitive Text)
Text
Sensitive Text
ChannelMessagePersistenceType
ChannelMessageType
clientRequestToken :: Sensitive Text
persistence :: ChannelMessagePersistenceType
type' :: ChannelMessageType
content :: Sensitive Text
channelArn :: Text
metadata :: Maybe (Sensitive Text)
chimeBearer :: Maybe Text
$sel:clientRequestToken:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
$sel:persistence:SendChannelMessage' :: SendChannelMessage -> ChannelMessagePersistenceType
$sel:type':SendChannelMessage' :: SendChannelMessage -> ChannelMessageType
$sel:content:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
$sel:channelArn:SendChannelMessage' :: SendChannelMessage -> Text
$sel:metadata:SendChannelMessage' :: SendChannelMessage -> Maybe (Sensitive Text)
$sel:chimeBearer:SendChannelMessage' :: SendChannelMessage -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
chimeBearer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
metadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
channelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
content
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ChannelMessageType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ChannelMessagePersistenceType
persistence
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
clientRequestToken

instance Data.ToHeaders SendChannelMessage where
  toHeaders :: SendChannelMessage -> ResponseHeaders
toHeaders SendChannelMessage' {Maybe Text
Maybe (Sensitive Text)
Text
Sensitive Text
ChannelMessagePersistenceType
ChannelMessageType
clientRequestToken :: Sensitive Text
persistence :: ChannelMessagePersistenceType
type' :: ChannelMessageType
content :: Sensitive Text
channelArn :: Text
metadata :: Maybe (Sensitive Text)
chimeBearer :: Maybe Text
$sel:clientRequestToken:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
$sel:persistence:SendChannelMessage' :: SendChannelMessage -> ChannelMessagePersistenceType
$sel:type':SendChannelMessage' :: SendChannelMessage -> ChannelMessageType
$sel:content:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
$sel:channelArn:SendChannelMessage' :: SendChannelMessage -> Text
$sel:metadata:SendChannelMessage' :: SendChannelMessage -> Maybe (Sensitive Text)
$sel:chimeBearer:SendChannelMessage' :: SendChannelMessage -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [HeaderName
"x-amz-chime-bearer" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
chimeBearer]

instance Data.ToJSON SendChannelMessage where
  toJSON :: SendChannelMessage -> Value
toJSON SendChannelMessage' {Maybe Text
Maybe (Sensitive Text)
Text
Sensitive Text
ChannelMessagePersistenceType
ChannelMessageType
clientRequestToken :: Sensitive Text
persistence :: ChannelMessagePersistenceType
type' :: ChannelMessageType
content :: Sensitive Text
channelArn :: Text
metadata :: Maybe (Sensitive Text)
chimeBearer :: Maybe Text
$sel:clientRequestToken:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
$sel:persistence:SendChannelMessage' :: SendChannelMessage -> ChannelMessagePersistenceType
$sel:type':SendChannelMessage' :: SendChannelMessage -> ChannelMessageType
$sel:content:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
$sel:channelArn:SendChannelMessage' :: SendChannelMessage -> Text
$sel:metadata:SendChannelMessage' :: SendChannelMessage -> Maybe (Sensitive Text)
$sel:chimeBearer:SendChannelMessage' :: SendChannelMessage -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Metadata" 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 (Sensitive Text)
metadata,
            forall a. a -> Maybe a
Prelude.Just (Key
"Content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
content),
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ChannelMessageType
type'),
            forall a. a -> Maybe a
Prelude.Just (Key
"Persistence" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ChannelMessagePersistenceType
persistence),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
clientRequestToken)
          ]
      )

instance Data.ToPath SendChannelMessage where
  toPath :: SendChannelMessage -> ByteString
toPath SendChannelMessage' {Maybe Text
Maybe (Sensitive Text)
Text
Sensitive Text
ChannelMessagePersistenceType
ChannelMessageType
clientRequestToken :: Sensitive Text
persistence :: ChannelMessagePersistenceType
type' :: ChannelMessageType
content :: Sensitive Text
channelArn :: Text
metadata :: Maybe (Sensitive Text)
chimeBearer :: Maybe Text
$sel:clientRequestToken:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
$sel:persistence:SendChannelMessage' :: SendChannelMessage -> ChannelMessagePersistenceType
$sel:type':SendChannelMessage' :: SendChannelMessage -> ChannelMessageType
$sel:content:SendChannelMessage' :: SendChannelMessage -> Sensitive Text
$sel:channelArn:SendChannelMessage' :: SendChannelMessage -> Text
$sel:metadata:SendChannelMessage' :: SendChannelMessage -> Maybe (Sensitive Text)
$sel:chimeBearer:SendChannelMessage' :: SendChannelMessage -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/channels/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
channelArn, ByteString
"/messages"]

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

-- | /See:/ 'newSendChannelMessageResponse' smart constructor.
data SendChannelMessageResponse = SendChannelMessageResponse'
  { -- | The ARN of the channel.
    SendChannelMessageResponse -> Maybe Text
channelArn :: Prelude.Maybe Prelude.Text,
    -- | The ID string assigned to each message.
    SendChannelMessageResponse -> Maybe Text
messageId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    SendChannelMessageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SendChannelMessageResponse -> SendChannelMessageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendChannelMessageResponse -> SendChannelMessageResponse -> Bool
$c/= :: SendChannelMessageResponse -> SendChannelMessageResponse -> Bool
== :: SendChannelMessageResponse -> SendChannelMessageResponse -> Bool
$c== :: SendChannelMessageResponse -> SendChannelMessageResponse -> Bool
Prelude.Eq, ReadPrec [SendChannelMessageResponse]
ReadPrec SendChannelMessageResponse
Int -> ReadS SendChannelMessageResponse
ReadS [SendChannelMessageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendChannelMessageResponse]
$creadListPrec :: ReadPrec [SendChannelMessageResponse]
readPrec :: ReadPrec SendChannelMessageResponse
$creadPrec :: ReadPrec SendChannelMessageResponse
readList :: ReadS [SendChannelMessageResponse]
$creadList :: ReadS [SendChannelMessageResponse]
readsPrec :: Int -> ReadS SendChannelMessageResponse
$creadsPrec :: Int -> ReadS SendChannelMessageResponse
Prelude.Read, Int -> SendChannelMessageResponse -> ShowS
[SendChannelMessageResponse] -> ShowS
SendChannelMessageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendChannelMessageResponse] -> ShowS
$cshowList :: [SendChannelMessageResponse] -> ShowS
show :: SendChannelMessageResponse -> String
$cshow :: SendChannelMessageResponse -> String
showsPrec :: Int -> SendChannelMessageResponse -> ShowS
$cshowsPrec :: Int -> SendChannelMessageResponse -> ShowS
Prelude.Show, forall x.
Rep SendChannelMessageResponse x -> SendChannelMessageResponse
forall x.
SendChannelMessageResponse -> Rep SendChannelMessageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SendChannelMessageResponse x -> SendChannelMessageResponse
$cfrom :: forall x.
SendChannelMessageResponse -> Rep SendChannelMessageResponse x
Prelude.Generic)

-- |
-- Create a value of 'SendChannelMessageResponse' 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:
--
-- 'channelArn', 'sendChannelMessageResponse_channelArn' - The ARN of the channel.
--
-- 'messageId', 'sendChannelMessageResponse_messageId' - The ID string assigned to each message.
--
-- 'httpStatus', 'sendChannelMessageResponse_httpStatus' - The response's http status code.
newSendChannelMessageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SendChannelMessageResponse
newSendChannelMessageResponse :: Int -> SendChannelMessageResponse
newSendChannelMessageResponse Int
pHttpStatus_ =
  SendChannelMessageResponse'
    { $sel:channelArn:SendChannelMessageResponse' :: Maybe Text
channelArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:messageId:SendChannelMessageResponse' :: Maybe Text
messageId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SendChannelMessageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the channel.
sendChannelMessageResponse_channelArn :: Lens.Lens' SendChannelMessageResponse (Prelude.Maybe Prelude.Text)
sendChannelMessageResponse_channelArn :: Lens' SendChannelMessageResponse (Maybe Text)
sendChannelMessageResponse_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendChannelMessageResponse' {Maybe Text
channelArn :: Maybe Text
$sel:channelArn:SendChannelMessageResponse' :: SendChannelMessageResponse -> Maybe Text
channelArn} -> Maybe Text
channelArn) (\s :: SendChannelMessageResponse
s@SendChannelMessageResponse' {} Maybe Text
a -> SendChannelMessageResponse
s {$sel:channelArn:SendChannelMessageResponse' :: Maybe Text
channelArn = Maybe Text
a} :: SendChannelMessageResponse)

-- | The ID string assigned to each message.
sendChannelMessageResponse_messageId :: Lens.Lens' SendChannelMessageResponse (Prelude.Maybe Prelude.Text)
sendChannelMessageResponse_messageId :: Lens' SendChannelMessageResponse (Maybe Text)
sendChannelMessageResponse_messageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendChannelMessageResponse' {Maybe Text
messageId :: Maybe Text
$sel:messageId:SendChannelMessageResponse' :: SendChannelMessageResponse -> Maybe Text
messageId} -> Maybe Text
messageId) (\s :: SendChannelMessageResponse
s@SendChannelMessageResponse' {} Maybe Text
a -> SendChannelMessageResponse
s {$sel:messageId:SendChannelMessageResponse' :: Maybe Text
messageId = Maybe Text
a} :: SendChannelMessageResponse)

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

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