{-# 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.IoTData.Publish
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Publishes an MQTT message.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions Publish>
-- action.
--
-- For more information about MQTT messages, see
-- <http://docs.aws.amazon.com/iot/latest/developerguide/mqtt.html MQTT Protocol>
-- in the IoT Developer Guide.
--
-- For more information about messaging costs, see
-- <http://aws.amazon.com/iot-core/pricing/#Messaging Amazon Web Services IoT Core pricing - Messaging>.
module Amazonka.IoTData.Publish
  ( -- * Creating a Request
    Publish (..),
    newPublish,

    -- * Request Lenses
    publish_contentType,
    publish_correlationData,
    publish_messageExpiry,
    publish_payload,
    publish_payloadFormatIndicator,
    publish_qos,
    publish_responseTopic,
    publish_retain,
    publish_userProperties,
    publish_topic,

    -- * Destructuring the Response
    PublishResponse (..),
    newPublishResponse,
  )
where

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

-- | The input for the Publish operation.
--
-- /See:/ 'newPublish' smart constructor.
data Publish = Publish'
  { -- | A UTF-8 encoded string that describes the content of the publishing
    -- message.
    Publish -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | The base64-encoded binary data used by the sender of the request message
    -- to identify which request the response message is for when it\'s
    -- received. @correlationData@ is an HTTP header value in the API.
    Publish -> Maybe Text
correlationData :: Prelude.Maybe Prelude.Text,
    -- | A user-defined integer value that represents the message expiry interval
    -- in seconds. If absent, the message doesn\'t expire. For more information
    -- about the limits of @messageExpiry@, see
    -- <https://docs.aws.amazon.com/general/latest/gr/iot-core.html#message-broker-limits Amazon Web Services IoT Core message broker and protocol limits and quotas>
    -- from the Amazon Web Services Reference Guide.
    Publish -> Maybe Integer
messageExpiry :: Prelude.Maybe Prelude.Integer,
    -- | The message body. MQTT accepts text, binary, and empty (null) message
    -- payloads.
    --
    -- Publishing an empty (null) payload with __retain__ = @true@ deletes the
    -- retained message identified by __topic__ from Amazon Web Services IoT
    -- Core.
    Publish -> Maybe ByteString
payload :: Prelude.Maybe Prelude.ByteString,
    -- | An @Enum@ string value that indicates whether the payload is formatted
    -- as UTF-8. @payloadFormatIndicator@ is an HTTP header value in the API.
    Publish -> Maybe PayloadFormatIndicator
payloadFormatIndicator :: Prelude.Maybe PayloadFormatIndicator,
    -- | The Quality of Service (QoS) level. The default QoS level is 0.
    Publish -> Maybe Natural
qos :: Prelude.Maybe Prelude.Natural,
    -- | A UTF-8 encoded string that\'s used as the topic name for a response
    -- message. The response topic is used to describe the topic which the
    -- receiver should publish to as part of the request-response flow. The
    -- topic must not contain wildcard characters.
    Publish -> Maybe Text
responseTopic :: Prelude.Maybe Prelude.Text,
    -- | A Boolean value that determines whether to set the RETAIN flag when the
    -- message is published.
    --
    -- Setting the RETAIN flag causes the message to be retained and sent to
    -- new subscribers to the topic.
    --
    -- Valid values: @true@ | @false@
    --
    -- Default value: @false@
    Publish -> Maybe Bool
retain :: Prelude.Maybe Prelude.Bool,
    -- | A JSON string that contains an array of JSON objects. If you don’t use
    -- Amazon Web Services SDK or CLI, you must encode the JSON string to
    -- base64 format before adding it to the HTTP header. @userProperties@ is
    -- an HTTP header value in the API.
    --
    -- The following example @userProperties@ parameter is a JSON string which
    -- represents two User Properties. Note that it needs to be base64-encoded:
    --
    -- @[{\"deviceName\": \"alpha\"}, {\"deviceCnt\": \"45\"}]@
    Publish -> Maybe Text
userProperties :: Prelude.Maybe Prelude.Text,
    -- | The name of the MQTT topic.
    Publish -> Text
topic :: Prelude.Text
  }
  deriving (Publish -> Publish -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Publish -> Publish -> Bool
$c/= :: Publish -> Publish -> Bool
== :: Publish -> Publish -> Bool
$c== :: Publish -> Publish -> Bool
Prelude.Eq, ReadPrec [Publish]
ReadPrec Publish
Int -> ReadS Publish
ReadS [Publish]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Publish]
$creadListPrec :: ReadPrec [Publish]
readPrec :: ReadPrec Publish
$creadPrec :: ReadPrec Publish
readList :: ReadS [Publish]
$creadList :: ReadS [Publish]
readsPrec :: Int -> ReadS Publish
$creadsPrec :: Int -> ReadS Publish
Prelude.Read, Int -> Publish -> ShowS
[Publish] -> ShowS
Publish -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Publish] -> ShowS
$cshowList :: [Publish] -> ShowS
show :: Publish -> String
$cshow :: Publish -> String
showsPrec :: Int -> Publish -> ShowS
$cshowsPrec :: Int -> Publish -> ShowS
Prelude.Show, forall x. Rep Publish x -> Publish
forall x. Publish -> Rep Publish x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Publish x -> Publish
$cfrom :: forall x. Publish -> Rep Publish x
Prelude.Generic)

-- |
-- Create a value of 'Publish' 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:
--
-- 'contentType', 'publish_contentType' - A UTF-8 encoded string that describes the content of the publishing
-- message.
--
-- 'correlationData', 'publish_correlationData' - The base64-encoded binary data used by the sender of the request message
-- to identify which request the response message is for when it\'s
-- received. @correlationData@ is an HTTP header value in the API.
--
-- 'messageExpiry', 'publish_messageExpiry' - A user-defined integer value that represents the message expiry interval
-- in seconds. If absent, the message doesn\'t expire. For more information
-- about the limits of @messageExpiry@, see
-- <https://docs.aws.amazon.com/general/latest/gr/iot-core.html#message-broker-limits Amazon Web Services IoT Core message broker and protocol limits and quotas>
-- from the Amazon Web Services Reference Guide.
--
-- 'payload', 'publish_payload' - The message body. MQTT accepts text, binary, and empty (null) message
-- payloads.
--
-- Publishing an empty (null) payload with __retain__ = @true@ deletes the
-- retained message identified by __topic__ from Amazon Web Services IoT
-- Core.
--
-- 'payloadFormatIndicator', 'publish_payloadFormatIndicator' - An @Enum@ string value that indicates whether the payload is formatted
-- as UTF-8. @payloadFormatIndicator@ is an HTTP header value in the API.
--
-- 'qos', 'publish_qos' - The Quality of Service (QoS) level. The default QoS level is 0.
--
-- 'responseTopic', 'publish_responseTopic' - A UTF-8 encoded string that\'s used as the topic name for a response
-- message. The response topic is used to describe the topic which the
-- receiver should publish to as part of the request-response flow. The
-- topic must not contain wildcard characters.
--
-- 'retain', 'publish_retain' - A Boolean value that determines whether to set the RETAIN flag when the
-- message is published.
--
-- Setting the RETAIN flag causes the message to be retained and sent to
-- new subscribers to the topic.
--
-- Valid values: @true@ | @false@
--
-- Default value: @false@
--
-- 'userProperties', 'publish_userProperties' - A JSON string that contains an array of JSON objects. If you don’t use
-- Amazon Web Services SDK or CLI, you must encode the JSON string to
-- base64 format before adding it to the HTTP header. @userProperties@ is
-- an HTTP header value in the API.
--
-- The following example @userProperties@ parameter is a JSON string which
-- represents two User Properties. Note that it needs to be base64-encoded:
--
-- @[{\"deviceName\": \"alpha\"}, {\"deviceCnt\": \"45\"}]@
--
-- 'topic', 'publish_topic' - The name of the MQTT topic.
newPublish ::
  -- | 'topic'
  Prelude.Text ->
  Publish
newPublish :: Text -> Publish
newPublish Text
pTopic_ =
  Publish'
    { $sel:contentType:Publish' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:correlationData:Publish' :: Maybe Text
correlationData = forall a. Maybe a
Prelude.Nothing,
      $sel:messageExpiry:Publish' :: Maybe Integer
messageExpiry = forall a. Maybe a
Prelude.Nothing,
      $sel:payload:Publish' :: Maybe ByteString
payload = forall a. Maybe a
Prelude.Nothing,
      $sel:payloadFormatIndicator:Publish' :: Maybe PayloadFormatIndicator
payloadFormatIndicator = forall a. Maybe a
Prelude.Nothing,
      $sel:qos:Publish' :: Maybe Natural
qos = forall a. Maybe a
Prelude.Nothing,
      $sel:responseTopic:Publish' :: Maybe Text
responseTopic = forall a. Maybe a
Prelude.Nothing,
      $sel:retain:Publish' :: Maybe Bool
retain = forall a. Maybe a
Prelude.Nothing,
      $sel:userProperties:Publish' :: Maybe Text
userProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:topic:Publish' :: Text
topic = Text
pTopic_
    }

-- | A UTF-8 encoded string that describes the content of the publishing
-- message.
publish_contentType :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_contentType :: Lens' Publish (Maybe Text)
publish_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
contentType :: Maybe Text
$sel:contentType:Publish' :: Publish -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:contentType:Publish' :: Maybe Text
contentType = Maybe Text
a} :: Publish)

-- | The base64-encoded binary data used by the sender of the request message
-- to identify which request the response message is for when it\'s
-- received. @correlationData@ is an HTTP header value in the API.
publish_correlationData :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_correlationData :: Lens' Publish (Maybe Text)
publish_correlationData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
correlationData :: Maybe Text
$sel:correlationData:Publish' :: Publish -> Maybe Text
correlationData} -> Maybe Text
correlationData) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:correlationData:Publish' :: Maybe Text
correlationData = Maybe Text
a} :: Publish)

-- | A user-defined integer value that represents the message expiry interval
-- in seconds. If absent, the message doesn\'t expire. For more information
-- about the limits of @messageExpiry@, see
-- <https://docs.aws.amazon.com/general/latest/gr/iot-core.html#message-broker-limits Amazon Web Services IoT Core message broker and protocol limits and quotas>
-- from the Amazon Web Services Reference Guide.
publish_messageExpiry :: Lens.Lens' Publish (Prelude.Maybe Prelude.Integer)
publish_messageExpiry :: Lens' Publish (Maybe Integer)
publish_messageExpiry = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Integer
messageExpiry :: Maybe Integer
$sel:messageExpiry:Publish' :: Publish -> Maybe Integer
messageExpiry} -> Maybe Integer
messageExpiry) (\s :: Publish
s@Publish' {} Maybe Integer
a -> Publish
s {$sel:messageExpiry:Publish' :: Maybe Integer
messageExpiry = Maybe Integer
a} :: Publish)

-- | The message body. MQTT accepts text, binary, and empty (null) message
-- payloads.
--
-- Publishing an empty (null) payload with __retain__ = @true@ deletes the
-- retained message identified by __topic__ from Amazon Web Services IoT
-- Core.
publish_payload :: Lens.Lens' Publish (Prelude.Maybe Prelude.ByteString)
publish_payload :: Lens' Publish (Maybe ByteString)
publish_payload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe ByteString
payload :: Maybe ByteString
$sel:payload:Publish' :: Publish -> Maybe ByteString
payload} -> Maybe ByteString
payload) (\s :: Publish
s@Publish' {} Maybe ByteString
a -> Publish
s {$sel:payload:Publish' :: Maybe ByteString
payload = Maybe ByteString
a} :: Publish)

-- | An @Enum@ string value that indicates whether the payload is formatted
-- as UTF-8. @payloadFormatIndicator@ is an HTTP header value in the API.
publish_payloadFormatIndicator :: Lens.Lens' Publish (Prelude.Maybe PayloadFormatIndicator)
publish_payloadFormatIndicator :: Lens' Publish (Maybe PayloadFormatIndicator)
publish_payloadFormatIndicator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe PayloadFormatIndicator
payloadFormatIndicator :: Maybe PayloadFormatIndicator
$sel:payloadFormatIndicator:Publish' :: Publish -> Maybe PayloadFormatIndicator
payloadFormatIndicator} -> Maybe PayloadFormatIndicator
payloadFormatIndicator) (\s :: Publish
s@Publish' {} Maybe PayloadFormatIndicator
a -> Publish
s {$sel:payloadFormatIndicator:Publish' :: Maybe PayloadFormatIndicator
payloadFormatIndicator = Maybe PayloadFormatIndicator
a} :: Publish)

-- | The Quality of Service (QoS) level. The default QoS level is 0.
publish_qos :: Lens.Lens' Publish (Prelude.Maybe Prelude.Natural)
publish_qos :: Lens' Publish (Maybe Natural)
publish_qos = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Natural
qos :: Maybe Natural
$sel:qos:Publish' :: Publish -> Maybe Natural
qos} -> Maybe Natural
qos) (\s :: Publish
s@Publish' {} Maybe Natural
a -> Publish
s {$sel:qos:Publish' :: Maybe Natural
qos = Maybe Natural
a} :: Publish)

-- | A UTF-8 encoded string that\'s used as the topic name for a response
-- message. The response topic is used to describe the topic which the
-- receiver should publish to as part of the request-response flow. The
-- topic must not contain wildcard characters.
publish_responseTopic :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_responseTopic :: Lens' Publish (Maybe Text)
publish_responseTopic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
responseTopic :: Maybe Text
$sel:responseTopic:Publish' :: Publish -> Maybe Text
responseTopic} -> Maybe Text
responseTopic) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:responseTopic:Publish' :: Maybe Text
responseTopic = Maybe Text
a} :: Publish)

-- | A Boolean value that determines whether to set the RETAIN flag when the
-- message is published.
--
-- Setting the RETAIN flag causes the message to be retained and sent to
-- new subscribers to the topic.
--
-- Valid values: @true@ | @false@
--
-- Default value: @false@
publish_retain :: Lens.Lens' Publish (Prelude.Maybe Prelude.Bool)
publish_retain :: Lens' Publish (Maybe Bool)
publish_retain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Bool
retain :: Maybe Bool
$sel:retain:Publish' :: Publish -> Maybe Bool
retain} -> Maybe Bool
retain) (\s :: Publish
s@Publish' {} Maybe Bool
a -> Publish
s {$sel:retain:Publish' :: Maybe Bool
retain = Maybe Bool
a} :: Publish)

-- | A JSON string that contains an array of JSON objects. If you don’t use
-- Amazon Web Services SDK or CLI, you must encode the JSON string to
-- base64 format before adding it to the HTTP header. @userProperties@ is
-- an HTTP header value in the API.
--
-- The following example @userProperties@ parameter is a JSON string which
-- represents two User Properties. Note that it needs to be base64-encoded:
--
-- @[{\"deviceName\": \"alpha\"}, {\"deviceCnt\": \"45\"}]@
publish_userProperties :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_userProperties :: Lens' Publish (Maybe Text)
publish_userProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
userProperties :: Maybe Text
$sel:userProperties:Publish' :: Publish -> Maybe Text
userProperties} -> Maybe Text
userProperties) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:userProperties:Publish' :: Maybe Text
userProperties = Maybe Text
a} :: Publish)

-- | The name of the MQTT topic.
publish_topic :: Lens.Lens' Publish Prelude.Text
publish_topic :: Lens' Publish Text
publish_topic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Text
topic :: Text
$sel:topic:Publish' :: Publish -> Text
topic} -> Text
topic) (\s :: Publish
s@Publish' {} Text
a -> Publish
s {$sel:topic:Publish' :: Text
topic = Text
a} :: Publish)

instance Core.AWSRequest Publish where
  type AWSResponse Publish = PublishResponse
  request :: (Service -> Service) -> Publish -> Request Publish
request Service -> Service
overrides =
    forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
Request.postBody (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy Publish
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse Publish)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PublishResponse
PublishResponse'

instance Prelude.Hashable Publish where
  hashWithSalt :: Int -> Publish -> Int
hashWithSalt Int
_salt Publish' {Maybe Bool
Maybe Integer
Maybe Natural
Maybe ByteString
Maybe Text
Maybe PayloadFormatIndicator
Text
topic :: Text
userProperties :: Maybe Text
retain :: Maybe Bool
responseTopic :: Maybe Text
qos :: Maybe Natural
payloadFormatIndicator :: Maybe PayloadFormatIndicator
payload :: Maybe ByteString
messageExpiry :: Maybe Integer
correlationData :: Maybe Text
contentType :: Maybe Text
$sel:topic:Publish' :: Publish -> Text
$sel:userProperties:Publish' :: Publish -> Maybe Text
$sel:retain:Publish' :: Publish -> Maybe Bool
$sel:responseTopic:Publish' :: Publish -> Maybe Text
$sel:qos:Publish' :: Publish -> Maybe Natural
$sel:payloadFormatIndicator:Publish' :: Publish -> Maybe PayloadFormatIndicator
$sel:payload:Publish' :: Publish -> Maybe ByteString
$sel:messageExpiry:Publish' :: Publish -> Maybe Integer
$sel:correlationData:Publish' :: Publish -> Maybe Text
$sel:contentType:Publish' :: Publish -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
contentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
correlationData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
messageExpiry
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ByteString
payload
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PayloadFormatIndicator
payloadFormatIndicator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
qos
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
responseTopic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
retain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
topic

instance Prelude.NFData Publish where
  rnf :: Publish -> ()
rnf Publish' {Maybe Bool
Maybe Integer
Maybe Natural
Maybe ByteString
Maybe Text
Maybe PayloadFormatIndicator
Text
topic :: Text
userProperties :: Maybe Text
retain :: Maybe Bool
responseTopic :: Maybe Text
qos :: Maybe Natural
payloadFormatIndicator :: Maybe PayloadFormatIndicator
payload :: Maybe ByteString
messageExpiry :: Maybe Integer
correlationData :: Maybe Text
contentType :: Maybe Text
$sel:topic:Publish' :: Publish -> Text
$sel:userProperties:Publish' :: Publish -> Maybe Text
$sel:retain:Publish' :: Publish -> Maybe Bool
$sel:responseTopic:Publish' :: Publish -> Maybe Text
$sel:qos:Publish' :: Publish -> Maybe Natural
$sel:payloadFormatIndicator:Publish' :: Publish -> Maybe PayloadFormatIndicator
$sel:payload:Publish' :: Publish -> Maybe ByteString
$sel:messageExpiry:Publish' :: Publish -> Maybe Integer
$sel:correlationData:Publish' :: Publish -> Maybe Text
$sel:contentType:Publish' :: Publish -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
correlationData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
messageExpiry
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ByteString
payload
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PayloadFormatIndicator
payloadFormatIndicator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
qos
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
responseTopic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
retain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
topic

instance Data.ToBody Publish where
  toBody :: Publish -> RequestBody
toBody Publish' {Maybe Bool
Maybe Integer
Maybe Natural
Maybe ByteString
Maybe Text
Maybe PayloadFormatIndicator
Text
topic :: Text
userProperties :: Maybe Text
retain :: Maybe Bool
responseTopic :: Maybe Text
qos :: Maybe Natural
payloadFormatIndicator :: Maybe PayloadFormatIndicator
payload :: Maybe ByteString
messageExpiry :: Maybe Integer
correlationData :: Maybe Text
contentType :: Maybe Text
$sel:topic:Publish' :: Publish -> Text
$sel:userProperties:Publish' :: Publish -> Maybe Text
$sel:retain:Publish' :: Publish -> Maybe Bool
$sel:responseTopic:Publish' :: Publish -> Maybe Text
$sel:qos:Publish' :: Publish -> Maybe Natural
$sel:payloadFormatIndicator:Publish' :: Publish -> Maybe PayloadFormatIndicator
$sel:payload:Publish' :: Publish -> Maybe ByteString
$sel:messageExpiry:Publish' :: Publish -> Maybe Integer
$sel:correlationData:Publish' :: Publish -> Maybe Text
$sel:contentType:Publish' :: Publish -> Maybe Text
..} = forall a. ToBody a => a -> RequestBody
Data.toBody Maybe ByteString
payload

instance Data.ToHeaders Publish where
  toHeaders :: Publish -> [Header]
toHeaders Publish' {Maybe Bool
Maybe Integer
Maybe Natural
Maybe ByteString
Maybe Text
Maybe PayloadFormatIndicator
Text
topic :: Text
userProperties :: Maybe Text
retain :: Maybe Bool
responseTopic :: Maybe Text
qos :: Maybe Natural
payloadFormatIndicator :: Maybe PayloadFormatIndicator
payload :: Maybe ByteString
messageExpiry :: Maybe Integer
correlationData :: Maybe Text
contentType :: Maybe Text
$sel:topic:Publish' :: Publish -> Text
$sel:userProperties:Publish' :: Publish -> Maybe Text
$sel:retain:Publish' :: Publish -> Maybe Bool
$sel:responseTopic:Publish' :: Publish -> Maybe Text
$sel:qos:Publish' :: Publish -> Maybe Natural
$sel:payloadFormatIndicator:Publish' :: Publish -> Maybe PayloadFormatIndicator
$sel:payload:Publish' :: Publish -> Maybe ByteString
$sel:messageExpiry:Publish' :: Publish -> Maybe Integer
$sel:correlationData:Publish' :: Publish -> Maybe Text
$sel:contentType:Publish' :: Publish -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-mqtt5-correlation-data"
          forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe Text
correlationData,
        HeaderName
"x-amz-mqtt5-payload-format-indicator"
          forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe PayloadFormatIndicator
payloadFormatIndicator,
        HeaderName
"x-amz-mqtt5-user-properties" forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# Maybe Text
userProperties
      ]

instance Data.ToPath Publish where
  toPath :: Publish -> ByteString
toPath Publish' {Maybe Bool
Maybe Integer
Maybe Natural
Maybe ByteString
Maybe Text
Maybe PayloadFormatIndicator
Text
topic :: Text
userProperties :: Maybe Text
retain :: Maybe Bool
responseTopic :: Maybe Text
qos :: Maybe Natural
payloadFormatIndicator :: Maybe PayloadFormatIndicator
payload :: Maybe ByteString
messageExpiry :: Maybe Integer
correlationData :: Maybe Text
contentType :: Maybe Text
$sel:topic:Publish' :: Publish -> Text
$sel:userProperties:Publish' :: Publish -> Maybe Text
$sel:retain:Publish' :: Publish -> Maybe Bool
$sel:responseTopic:Publish' :: Publish -> Maybe Text
$sel:qos:Publish' :: Publish -> Maybe Natural
$sel:payloadFormatIndicator:Publish' :: Publish -> Maybe PayloadFormatIndicator
$sel:payload:Publish' :: Publish -> Maybe ByteString
$sel:messageExpiry:Publish' :: Publish -> Maybe Integer
$sel:correlationData:Publish' :: Publish -> Maybe Text
$sel:contentType:Publish' :: Publish -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/topics/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
topic]

instance Data.ToQuery Publish where
  toQuery :: Publish -> QueryString
toQuery Publish' {Maybe Bool
Maybe Integer
Maybe Natural
Maybe ByteString
Maybe Text
Maybe PayloadFormatIndicator
Text
topic :: Text
userProperties :: Maybe Text
retain :: Maybe Bool
responseTopic :: Maybe Text
qos :: Maybe Natural
payloadFormatIndicator :: Maybe PayloadFormatIndicator
payload :: Maybe ByteString
messageExpiry :: Maybe Integer
correlationData :: Maybe Text
contentType :: Maybe Text
$sel:topic:Publish' :: Publish -> Text
$sel:userProperties:Publish' :: Publish -> Maybe Text
$sel:retain:Publish' :: Publish -> Maybe Bool
$sel:responseTopic:Publish' :: Publish -> Maybe Text
$sel:qos:Publish' :: Publish -> Maybe Natural
$sel:payloadFormatIndicator:Publish' :: Publish -> Maybe PayloadFormatIndicator
$sel:payload:Publish' :: Publish -> Maybe ByteString
$sel:messageExpiry:Publish' :: Publish -> Maybe Integer
$sel:correlationData:Publish' :: Publish -> Maybe Text
$sel:contentType:Publish' :: Publish -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"contentType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
contentType,
        ByteString
"messageExpiry" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Integer
messageExpiry,
        ByteString
"qos" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
qos,
        ByteString
"responseTopic" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
responseTopic,
        ByteString
"retain" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
retain
      ]

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

-- |
-- Create a value of 'PublishResponse' 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.
newPublishResponse ::
  PublishResponse
newPublishResponse :: PublishResponse
newPublishResponse = PublishResponse
PublishResponse'

instance Prelude.NFData PublishResponse where
  rnf :: PublishResponse -> ()
rnf PublishResponse
_ = ()