{-# 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.SNS.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)
--
-- Sends a message to an Amazon SNS topic, a text message (SMS message)
-- directly to a phone number, or a message to a mobile platform endpoint
-- (when you specify the @TargetArn@).
--
-- If you send a message to a topic, Amazon SNS delivers the message to
-- each endpoint that is subscribed to the topic. The format of the message
-- depends on the notification protocol for each subscribed endpoint.
--
-- When a @messageId@ is returned, the message is saved and Amazon SNS
-- immediately delivers it to subscribers.
--
-- To use the @Publish@ action for publishing a message to a mobile
-- endpoint, such as an app on a Kindle device or mobile phone, you must
-- specify the EndpointArn for the TargetArn parameter. The EndpointArn is
-- returned when making a call with the @CreatePlatformEndpoint@ action.
--
-- For more information about formatting messages, see
-- <https://docs.aws.amazon.com/sns/latest/dg/mobile-push-send-custommessage.html Send Custom Platform-Specific Payloads in Messages to Mobile Devices>.
--
-- You can publish messages only to topics and endpoints in the same Amazon
-- Web Services Region.
module Amazonka.SNS.Publish
  ( -- * Creating a Request
    Publish (..),
    newPublish,

    -- * Request Lenses
    publish_messageAttributes,
    publish_messageDeduplicationId,
    publish_messageGroupId,
    publish_messageStructure,
    publish_phoneNumber,
    publish_subject,
    publish_targetArn,
    publish_topicArn,
    publish_message,

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

    -- * Response Lenses
    publishResponse_messageId,
    publishResponse_sequenceNumber,
    publishResponse_httpStatus,
  )
where

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
import Amazonka.SNS.Types

-- | Input for Publish action.
--
-- /See:/ 'newPublish' smart constructor.
data Publish = Publish'
  { -- | Message attributes for Publish action.
    Publish -> Maybe (HashMap Text MessageAttributeValue)
messageAttributes :: Prelude.Maybe (Prelude.HashMap Prelude.Text MessageAttributeValue),
    -- | This parameter applies only to FIFO (first-in-first-out) topics. The
    -- @MessageDeduplicationId@ can contain up to 128 alphanumeric characters
    -- @(a-z, A-Z, 0-9)@ and punctuation
    -- @(!\"#$%&\'()*+,-.\/:;\<=>?\@[\\]^_\`{|}~)@.
    --
    -- Every message must have a unique @MessageDeduplicationId@, which is a
    -- token used for deduplication of sent messages. If a message with a
    -- particular @MessageDeduplicationId@ is sent successfully, any message
    -- sent with the same @MessageDeduplicationId@ during the 5-minute
    -- deduplication interval is treated as a duplicate.
    --
    -- If the topic has @ContentBasedDeduplication@ set, the system generates a
    -- @MessageDeduplicationId@ based on the contents of the message. Your
    -- @MessageDeduplicationId@ overrides the generated one.
    Publish -> Maybe Text
messageDeduplicationId :: Prelude.Maybe Prelude.Text,
    -- | This parameter applies only to FIFO (first-in-first-out) topics. The
    -- @MessageGroupId@ can contain up to 128 alphanumeric characters
    -- @(a-z, A-Z, 0-9)@ and punctuation
    -- @(!\"#$%&\'()*+,-.\/:;\<=>?\@[\\]^_\`{|}~)@.
    --
    -- The @MessageGroupId@ is a tag that specifies that a message belongs to a
    -- specific message group. Messages that belong to the same message group
    -- are processed in a FIFO manner (however, messages in different message
    -- groups might be processed out of order). Every message must include a
    -- @MessageGroupId@.
    Publish -> Maybe Text
messageGroupId :: Prelude.Maybe Prelude.Text,
    -- | Set @MessageStructure@ to @json@ if you want to send a different message
    -- for each protocol. For example, using one publish action, you can send a
    -- short message to your SMS subscribers and a longer message to your email
    -- subscribers. If you set @MessageStructure@ to @json@, the value of the
    -- @Message@ parameter must:
    --
    -- -   be a syntactically valid JSON object; and
    --
    -- -   contain at least a top-level JSON key of \"default\" with a value
    --     that is a string.
    --
    -- You can define other top-level keys that define the message you want to
    -- send to a specific transport protocol (e.g., \"http\").
    --
    -- Valid value: @json@
    Publish -> Maybe Text
messageStructure :: Prelude.Maybe Prelude.Text,
    -- | The phone number to which you want to deliver an SMS message. Use E.164
    -- format.
    --
    -- If you don\'t specify a value for the @PhoneNumber@ parameter, you must
    -- specify a value for the @TargetArn@ or @TopicArn@ parameters.
    Publish -> Maybe Text
phoneNumber :: Prelude.Maybe Prelude.Text,
    -- | Optional parameter to be used as the \"Subject\" line when the message
    -- is delivered to email endpoints. This field will also be included, if
    -- present, in the standard JSON messages delivered to other endpoints.
    --
    -- Constraints: Subjects must be ASCII text that begins with a letter,
    -- number, or punctuation mark; must not include line breaks or control
    -- characters; and must be less than 100 characters long.
    Publish -> Maybe Text
subject :: Prelude.Maybe Prelude.Text,
    -- | If you don\'t specify a value for the @TargetArn@ parameter, you must
    -- specify a value for the @PhoneNumber@ or @TopicArn@ parameters.
    Publish -> Maybe Text
targetArn :: Prelude.Maybe Prelude.Text,
    -- | The topic you want to publish to.
    --
    -- If you don\'t specify a value for the @TopicArn@ parameter, you must
    -- specify a value for the @PhoneNumber@ or @TargetArn@ parameters.
    Publish -> Maybe Text
topicArn :: Prelude.Maybe Prelude.Text,
    -- | The message you want to send.
    --
    -- If you are publishing to a topic and you want to send the same message
    -- to all transport protocols, include the text of the message as a String
    -- value. If you want to send different messages for each transport
    -- protocol, set the value of the @MessageStructure@ parameter to @json@
    -- and use a JSON object for the @Message@ parameter.
    --
    -- Constraints:
    --
    -- -   With the exception of SMS, messages must be UTF-8 encoded strings
    --     and at most 256 KB in size (262,144 bytes, not 262,144 characters).
    --
    -- -   For SMS, each message can contain up to 140 characters. This
    --     character limit depends on the encoding schema. For example, an SMS
    --     message can contain 160 GSM characters, 140 ASCII characters, or 70
    --     UCS-2 characters.
    --
    --     If you publish a message that exceeds this size limit, Amazon SNS
    --     sends the message as multiple messages, each fitting within the size
    --     limit. Messages aren\'t truncated mid-word but are cut off at
    --     whole-word boundaries.
    --
    --     The total size limit for a single SMS @Publish@ action is 1,600
    --     characters.
    --
    -- JSON-specific constraints:
    --
    -- -   Keys in the JSON object that correspond to supported transport
    --     protocols must have simple JSON string values.
    --
    -- -   The values will be parsed (unescaped) before they are used in
    --     outgoing messages.
    --
    -- -   Outbound notifications are JSON encoded (meaning that the characters
    --     will be reescaped for sending).
    --
    -- -   Values have a minimum length of 0 (the empty string, \"\", is
    --     allowed).
    --
    -- -   Values have a maximum length bounded by the overall message size
    --     (so, including multiple protocols may limit message sizes).
    --
    -- -   Non-string values will cause the key to be ignored.
    --
    -- -   Keys that do not correspond to supported transport protocols are
    --     ignored.
    --
    -- -   Duplicate keys are not allowed.
    --
    -- -   Failure to parse or validate any key or value in the message will
    --     cause the @Publish@ call to return an error (no partial delivery).
    Publish -> Text
message :: 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:
--
-- 'messageAttributes', 'publish_messageAttributes' - Message attributes for Publish action.
--
-- 'messageDeduplicationId', 'publish_messageDeduplicationId' - This parameter applies only to FIFO (first-in-first-out) topics. The
-- @MessageDeduplicationId@ can contain up to 128 alphanumeric characters
-- @(a-z, A-Z, 0-9)@ and punctuation
-- @(!\"#$%&\'()*+,-.\/:;\<=>?\@[\\]^_\`{|}~)@.
--
-- Every message must have a unique @MessageDeduplicationId@, which is a
-- token used for deduplication of sent messages. If a message with a
-- particular @MessageDeduplicationId@ is sent successfully, any message
-- sent with the same @MessageDeduplicationId@ during the 5-minute
-- deduplication interval is treated as a duplicate.
--
-- If the topic has @ContentBasedDeduplication@ set, the system generates a
-- @MessageDeduplicationId@ based on the contents of the message. Your
-- @MessageDeduplicationId@ overrides the generated one.
--
-- 'messageGroupId', 'publish_messageGroupId' - This parameter applies only to FIFO (first-in-first-out) topics. The
-- @MessageGroupId@ can contain up to 128 alphanumeric characters
-- @(a-z, A-Z, 0-9)@ and punctuation
-- @(!\"#$%&\'()*+,-.\/:;\<=>?\@[\\]^_\`{|}~)@.
--
-- The @MessageGroupId@ is a tag that specifies that a message belongs to a
-- specific message group. Messages that belong to the same message group
-- are processed in a FIFO manner (however, messages in different message
-- groups might be processed out of order). Every message must include a
-- @MessageGroupId@.
--
-- 'messageStructure', 'publish_messageStructure' - Set @MessageStructure@ to @json@ if you want to send a different message
-- for each protocol. For example, using one publish action, you can send a
-- short message to your SMS subscribers and a longer message to your email
-- subscribers. If you set @MessageStructure@ to @json@, the value of the
-- @Message@ parameter must:
--
-- -   be a syntactically valid JSON object; and
--
-- -   contain at least a top-level JSON key of \"default\" with a value
--     that is a string.
--
-- You can define other top-level keys that define the message you want to
-- send to a specific transport protocol (e.g., \"http\").
--
-- Valid value: @json@
--
-- 'phoneNumber', 'publish_phoneNumber' - The phone number to which you want to deliver an SMS message. Use E.164
-- format.
--
-- If you don\'t specify a value for the @PhoneNumber@ parameter, you must
-- specify a value for the @TargetArn@ or @TopicArn@ parameters.
--
-- 'subject', 'publish_subject' - Optional parameter to be used as the \"Subject\" line when the message
-- is delivered to email endpoints. This field will also be included, if
-- present, in the standard JSON messages delivered to other endpoints.
--
-- Constraints: Subjects must be ASCII text that begins with a letter,
-- number, or punctuation mark; must not include line breaks or control
-- characters; and must be less than 100 characters long.
--
-- 'targetArn', 'publish_targetArn' - If you don\'t specify a value for the @TargetArn@ parameter, you must
-- specify a value for the @PhoneNumber@ or @TopicArn@ parameters.
--
-- 'topicArn', 'publish_topicArn' - The topic you want to publish to.
--
-- If you don\'t specify a value for the @TopicArn@ parameter, you must
-- specify a value for the @PhoneNumber@ or @TargetArn@ parameters.
--
-- 'message', 'publish_message' - The message you want to send.
--
-- If you are publishing to a topic and you want to send the same message
-- to all transport protocols, include the text of the message as a String
-- value. If you want to send different messages for each transport
-- protocol, set the value of the @MessageStructure@ parameter to @json@
-- and use a JSON object for the @Message@ parameter.
--
-- Constraints:
--
-- -   With the exception of SMS, messages must be UTF-8 encoded strings
--     and at most 256 KB in size (262,144 bytes, not 262,144 characters).
--
-- -   For SMS, each message can contain up to 140 characters. This
--     character limit depends on the encoding schema. For example, an SMS
--     message can contain 160 GSM characters, 140 ASCII characters, or 70
--     UCS-2 characters.
--
--     If you publish a message that exceeds this size limit, Amazon SNS
--     sends the message as multiple messages, each fitting within the size
--     limit. Messages aren\'t truncated mid-word but are cut off at
--     whole-word boundaries.
--
--     The total size limit for a single SMS @Publish@ action is 1,600
--     characters.
--
-- JSON-specific constraints:
--
-- -   Keys in the JSON object that correspond to supported transport
--     protocols must have simple JSON string values.
--
-- -   The values will be parsed (unescaped) before they are used in
--     outgoing messages.
--
-- -   Outbound notifications are JSON encoded (meaning that the characters
--     will be reescaped for sending).
--
-- -   Values have a minimum length of 0 (the empty string, \"\", is
--     allowed).
--
-- -   Values have a maximum length bounded by the overall message size
--     (so, including multiple protocols may limit message sizes).
--
-- -   Non-string values will cause the key to be ignored.
--
-- -   Keys that do not correspond to supported transport protocols are
--     ignored.
--
-- -   Duplicate keys are not allowed.
--
-- -   Failure to parse or validate any key or value in the message will
--     cause the @Publish@ call to return an error (no partial delivery).
newPublish ::
  -- | 'message'
  Prelude.Text ->
  Publish
newPublish :: Text -> Publish
newPublish Text
pMessage_ =
  Publish'
    { $sel:messageAttributes:Publish' :: Maybe (HashMap Text MessageAttributeValue)
messageAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:messageDeduplicationId:Publish' :: Maybe Text
messageDeduplicationId = forall a. Maybe a
Prelude.Nothing,
      $sel:messageGroupId:Publish' :: Maybe Text
messageGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:messageStructure:Publish' :: Maybe Text
messageStructure = forall a. Maybe a
Prelude.Nothing,
      $sel:phoneNumber:Publish' :: Maybe Text
phoneNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:subject:Publish' :: Maybe Text
subject = forall a. Maybe a
Prelude.Nothing,
      $sel:targetArn:Publish' :: Maybe Text
targetArn = forall a. Maybe a
Prelude.Nothing,
      $sel:topicArn:Publish' :: Maybe Text
topicArn = forall a. Maybe a
Prelude.Nothing,
      $sel:message:Publish' :: Text
message = Text
pMessage_
    }

-- | Message attributes for Publish action.
publish_messageAttributes :: Lens.Lens' Publish (Prelude.Maybe (Prelude.HashMap Prelude.Text MessageAttributeValue))
publish_messageAttributes :: Lens' Publish (Maybe (HashMap Text MessageAttributeValue))
publish_messageAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe (HashMap Text MessageAttributeValue)
messageAttributes :: Maybe (HashMap Text MessageAttributeValue)
$sel:messageAttributes:Publish' :: Publish -> Maybe (HashMap Text MessageAttributeValue)
messageAttributes} -> Maybe (HashMap Text MessageAttributeValue)
messageAttributes) (\s :: Publish
s@Publish' {} Maybe (HashMap Text MessageAttributeValue)
a -> Publish
s {$sel:messageAttributes:Publish' :: Maybe (HashMap Text MessageAttributeValue)
messageAttributes = Maybe (HashMap Text MessageAttributeValue)
a} :: Publish) 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

-- | This parameter applies only to FIFO (first-in-first-out) topics. The
-- @MessageDeduplicationId@ can contain up to 128 alphanumeric characters
-- @(a-z, A-Z, 0-9)@ and punctuation
-- @(!\"#$%&\'()*+,-.\/:;\<=>?\@[\\]^_\`{|}~)@.
--
-- Every message must have a unique @MessageDeduplicationId@, which is a
-- token used for deduplication of sent messages. If a message with a
-- particular @MessageDeduplicationId@ is sent successfully, any message
-- sent with the same @MessageDeduplicationId@ during the 5-minute
-- deduplication interval is treated as a duplicate.
--
-- If the topic has @ContentBasedDeduplication@ set, the system generates a
-- @MessageDeduplicationId@ based on the contents of the message. Your
-- @MessageDeduplicationId@ overrides the generated one.
publish_messageDeduplicationId :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_messageDeduplicationId :: Lens' Publish (Maybe Text)
publish_messageDeduplicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
messageDeduplicationId :: Maybe Text
$sel:messageDeduplicationId:Publish' :: Publish -> Maybe Text
messageDeduplicationId} -> Maybe Text
messageDeduplicationId) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:messageDeduplicationId:Publish' :: Maybe Text
messageDeduplicationId = Maybe Text
a} :: Publish)

-- | This parameter applies only to FIFO (first-in-first-out) topics. The
-- @MessageGroupId@ can contain up to 128 alphanumeric characters
-- @(a-z, A-Z, 0-9)@ and punctuation
-- @(!\"#$%&\'()*+,-.\/:;\<=>?\@[\\]^_\`{|}~)@.
--
-- The @MessageGroupId@ is a tag that specifies that a message belongs to a
-- specific message group. Messages that belong to the same message group
-- are processed in a FIFO manner (however, messages in different message
-- groups might be processed out of order). Every message must include a
-- @MessageGroupId@.
publish_messageGroupId :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_messageGroupId :: Lens' Publish (Maybe Text)
publish_messageGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
messageGroupId :: Maybe Text
$sel:messageGroupId:Publish' :: Publish -> Maybe Text
messageGroupId} -> Maybe Text
messageGroupId) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:messageGroupId:Publish' :: Maybe Text
messageGroupId = Maybe Text
a} :: Publish)

-- | Set @MessageStructure@ to @json@ if you want to send a different message
-- for each protocol. For example, using one publish action, you can send a
-- short message to your SMS subscribers and a longer message to your email
-- subscribers. If you set @MessageStructure@ to @json@, the value of the
-- @Message@ parameter must:
--
-- -   be a syntactically valid JSON object; and
--
-- -   contain at least a top-level JSON key of \"default\" with a value
--     that is a string.
--
-- You can define other top-level keys that define the message you want to
-- send to a specific transport protocol (e.g., \"http\").
--
-- Valid value: @json@
publish_messageStructure :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_messageStructure :: Lens' Publish (Maybe Text)
publish_messageStructure = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
messageStructure :: Maybe Text
$sel:messageStructure:Publish' :: Publish -> Maybe Text
messageStructure} -> Maybe Text
messageStructure) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:messageStructure:Publish' :: Maybe Text
messageStructure = Maybe Text
a} :: Publish)

-- | The phone number to which you want to deliver an SMS message. Use E.164
-- format.
--
-- If you don\'t specify a value for the @PhoneNumber@ parameter, you must
-- specify a value for the @TargetArn@ or @TopicArn@ parameters.
publish_phoneNumber :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_phoneNumber :: Lens' Publish (Maybe Text)
publish_phoneNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
phoneNumber :: Maybe Text
$sel:phoneNumber:Publish' :: Publish -> Maybe Text
phoneNumber} -> Maybe Text
phoneNumber) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:phoneNumber:Publish' :: Maybe Text
phoneNumber = Maybe Text
a} :: Publish)

-- | Optional parameter to be used as the \"Subject\" line when the message
-- is delivered to email endpoints. This field will also be included, if
-- present, in the standard JSON messages delivered to other endpoints.
--
-- Constraints: Subjects must be ASCII text that begins with a letter,
-- number, or punctuation mark; must not include line breaks or control
-- characters; and must be less than 100 characters long.
publish_subject :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_subject :: Lens' Publish (Maybe Text)
publish_subject = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
subject :: Maybe Text
$sel:subject:Publish' :: Publish -> Maybe Text
subject} -> Maybe Text
subject) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:subject:Publish' :: Maybe Text
subject = Maybe Text
a} :: Publish)

-- | If you don\'t specify a value for the @TargetArn@ parameter, you must
-- specify a value for the @PhoneNumber@ or @TopicArn@ parameters.
publish_targetArn :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_targetArn :: Lens' Publish (Maybe Text)
publish_targetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
targetArn :: Maybe Text
$sel:targetArn:Publish' :: Publish -> Maybe Text
targetArn} -> Maybe Text
targetArn) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:targetArn:Publish' :: Maybe Text
targetArn = Maybe Text
a} :: Publish)

-- | The topic you want to publish to.
--
-- If you don\'t specify a value for the @TopicArn@ parameter, you must
-- specify a value for the @PhoneNumber@ or @TargetArn@ parameters.
publish_topicArn :: Lens.Lens' Publish (Prelude.Maybe Prelude.Text)
publish_topicArn :: Lens' Publish (Maybe Text)
publish_topicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Maybe Text
topicArn :: Maybe Text
$sel:topicArn:Publish' :: Publish -> Maybe Text
topicArn} -> Maybe Text
topicArn) (\s :: Publish
s@Publish' {} Maybe Text
a -> Publish
s {$sel:topicArn:Publish' :: Maybe Text
topicArn = Maybe Text
a} :: Publish)

-- | The message you want to send.
--
-- If you are publishing to a topic and you want to send the same message
-- to all transport protocols, include the text of the message as a String
-- value. If you want to send different messages for each transport
-- protocol, set the value of the @MessageStructure@ parameter to @json@
-- and use a JSON object for the @Message@ parameter.
--
-- Constraints:
--
-- -   With the exception of SMS, messages must be UTF-8 encoded strings
--     and at most 256 KB in size (262,144 bytes, not 262,144 characters).
--
-- -   For SMS, each message can contain up to 140 characters. This
--     character limit depends on the encoding schema. For example, an SMS
--     message can contain 160 GSM characters, 140 ASCII characters, or 70
--     UCS-2 characters.
--
--     If you publish a message that exceeds this size limit, Amazon SNS
--     sends the message as multiple messages, each fitting within the size
--     limit. Messages aren\'t truncated mid-word but are cut off at
--     whole-word boundaries.
--
--     The total size limit for a single SMS @Publish@ action is 1,600
--     characters.
--
-- JSON-specific constraints:
--
-- -   Keys in the JSON object that correspond to supported transport
--     protocols must have simple JSON string values.
--
-- -   The values will be parsed (unescaped) before they are used in
--     outgoing messages.
--
-- -   Outbound notifications are JSON encoded (meaning that the characters
--     will be reescaped for sending).
--
-- -   Values have a minimum length of 0 (the empty string, \"\", is
--     allowed).
--
-- -   Values have a maximum length bounded by the overall message size
--     (so, including multiple protocols may limit message sizes).
--
-- -   Non-string values will cause the key to be ignored.
--
-- -   Keys that do not correspond to supported transport protocols are
--     ignored.
--
-- -   Duplicate keys are not allowed.
--
-- -   Failure to parse or validate any key or value in the message will
--     cause the @Publish@ call to return an error (no partial delivery).
publish_message :: Lens.Lens' Publish Prelude.Text
publish_message :: Lens' Publish Text
publish_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Publish' {Text
message :: Text
$sel:message:Publish' :: Publish -> Text
message} -> Text
message) (\s :: Publish
s@Publish' {} Text
a -> Publish
s {$sel:message:Publish' :: Text
message = 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 => Service -> a -> Request a
Request.postQuery (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 =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"PublishResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Maybe Text -> Int -> PublishResponse
PublishResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"MessageId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SequenceNumber")
            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 Publish where
  hashWithSalt :: Int -> Publish -> Int
hashWithSalt Int
_salt Publish' {Maybe Text
Maybe (HashMap Text MessageAttributeValue)
Text
message :: Text
topicArn :: Maybe Text
targetArn :: Maybe Text
subject :: Maybe Text
phoneNumber :: Maybe Text
messageStructure :: Maybe Text
messageGroupId :: Maybe Text
messageDeduplicationId :: Maybe Text
messageAttributes :: Maybe (HashMap Text MessageAttributeValue)
$sel:message:Publish' :: Publish -> Text
$sel:topicArn:Publish' :: Publish -> Maybe Text
$sel:targetArn:Publish' :: Publish -> Maybe Text
$sel:subject:Publish' :: Publish -> Maybe Text
$sel:phoneNumber:Publish' :: Publish -> Maybe Text
$sel:messageStructure:Publish' :: Publish -> Maybe Text
$sel:messageGroupId:Publish' :: Publish -> Maybe Text
$sel:messageDeduplicationId:Publish' :: Publish -> Maybe Text
$sel:messageAttributes:Publish' :: Publish -> Maybe (HashMap Text MessageAttributeValue)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text MessageAttributeValue)
messageAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
messageDeduplicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
messageGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
messageStructure
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
phoneNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subject
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
topicArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
message

instance Prelude.NFData Publish where
  rnf :: Publish -> ()
rnf Publish' {Maybe Text
Maybe (HashMap Text MessageAttributeValue)
Text
message :: Text
topicArn :: Maybe Text
targetArn :: Maybe Text
subject :: Maybe Text
phoneNumber :: Maybe Text
messageStructure :: Maybe Text
messageGroupId :: Maybe Text
messageDeduplicationId :: Maybe Text
messageAttributes :: Maybe (HashMap Text MessageAttributeValue)
$sel:message:Publish' :: Publish -> Text
$sel:topicArn:Publish' :: Publish -> Maybe Text
$sel:targetArn:Publish' :: Publish -> Maybe Text
$sel:subject:Publish' :: Publish -> Maybe Text
$sel:phoneNumber:Publish' :: Publish -> Maybe Text
$sel:messageStructure:Publish' :: Publish -> Maybe Text
$sel:messageGroupId:Publish' :: Publish -> Maybe Text
$sel:messageDeduplicationId:Publish' :: Publish -> Maybe Text
$sel:messageAttributes:Publish' :: Publish -> Maybe (HashMap Text MessageAttributeValue)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text MessageAttributeValue)
messageAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
messageDeduplicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
messageGroupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
messageStructure
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
phoneNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subject
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
topicArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
message

instance Data.ToHeaders Publish where
  toHeaders :: Publish -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery Publish where
  toQuery :: Publish -> QueryString
toQuery Publish' {Maybe Text
Maybe (HashMap Text MessageAttributeValue)
Text
message :: Text
topicArn :: Maybe Text
targetArn :: Maybe Text
subject :: Maybe Text
phoneNumber :: Maybe Text
messageStructure :: Maybe Text
messageGroupId :: Maybe Text
messageDeduplicationId :: Maybe Text
messageAttributes :: Maybe (HashMap Text MessageAttributeValue)
$sel:message:Publish' :: Publish -> Text
$sel:topicArn:Publish' :: Publish -> Maybe Text
$sel:targetArn:Publish' :: Publish -> Maybe Text
$sel:subject:Publish' :: Publish -> Maybe Text
$sel:phoneNumber:Publish' :: Publish -> Maybe Text
$sel:messageStructure:Publish' :: Publish -> Maybe Text
$sel:messageGroupId:Publish' :: Publish -> Maybe Text
$sel:messageDeduplicationId:Publish' :: Publish -> Maybe Text
$sel:messageAttributes:Publish' :: Publish -> Maybe (HashMap Text MessageAttributeValue)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"Publish" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-03-31" :: Prelude.ByteString),
        ByteString
"MessageAttributes"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall k v.
(ToQuery k, ToQuery v) =>
ByteString
-> ByteString -> ByteString -> HashMap k v -> QueryString
Data.toQueryMap ByteString
"entry" ByteString
"Name" ByteString
"Value"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text MessageAttributeValue)
messageAttributes
            ),
        ByteString
"MessageDeduplicationId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
messageDeduplicationId,
        ByteString
"MessageGroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
messageGroupId,
        ByteString
"MessageStructure" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
messageStructure,
        ByteString
"PhoneNumber" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
phoneNumber,
        ByteString
"Subject" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
subject,
        ByteString
"TargetArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
targetArn,
        ByteString
"TopicArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
topicArn,
        ByteString
"Message" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
message
      ]

-- | Response for Publish action.
--
-- /See:/ 'newPublishResponse' smart constructor.
data PublishResponse = PublishResponse'
  { -- | Unique identifier assigned to the published message.
    --
    -- Length Constraint: Maximum 100 characters
    PublishResponse -> Maybe Text
messageId :: Prelude.Maybe Prelude.Text,
    -- | This response element applies only to FIFO (first-in-first-out) topics.
    --
    -- The sequence number is a large, non-consecutive number that Amazon SNS
    -- assigns to each message. The length of @SequenceNumber@ is 128 bits.
    -- @SequenceNumber@ continues to increase for each @MessageGroupId@.
    PublishResponse -> Maybe Text
sequenceNumber :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PublishResponse -> Int
httpStatus :: Prelude.Int
  }
  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.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'messageId', 'publishResponse_messageId' - Unique identifier assigned to the published message.
--
-- Length Constraint: Maximum 100 characters
--
-- 'sequenceNumber', 'publishResponse_sequenceNumber' - This response element applies only to FIFO (first-in-first-out) topics.
--
-- The sequence number is a large, non-consecutive number that Amazon SNS
-- assigns to each message. The length of @SequenceNumber@ is 128 bits.
-- @SequenceNumber@ continues to increase for each @MessageGroupId@.
--
-- 'httpStatus', 'publishResponse_httpStatus' - The response's http status code.
newPublishResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PublishResponse
newPublishResponse :: Int -> PublishResponse
newPublishResponse Int
pHttpStatus_ =
  PublishResponse'
    { $sel:messageId:PublishResponse' :: Maybe Text
messageId = forall a. Maybe a
Prelude.Nothing,
      $sel:sequenceNumber:PublishResponse' :: Maybe Text
sequenceNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PublishResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Unique identifier assigned to the published message.
--
-- Length Constraint: Maximum 100 characters
publishResponse_messageId :: Lens.Lens' PublishResponse (Prelude.Maybe Prelude.Text)
publishResponse_messageId :: Lens' PublishResponse (Maybe Text)
publishResponse_messageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublishResponse' {Maybe Text
messageId :: Maybe Text
$sel:messageId:PublishResponse' :: PublishResponse -> Maybe Text
messageId} -> Maybe Text
messageId) (\s :: PublishResponse
s@PublishResponse' {} Maybe Text
a -> PublishResponse
s {$sel:messageId:PublishResponse' :: Maybe Text
messageId = Maybe Text
a} :: PublishResponse)

-- | This response element applies only to FIFO (first-in-first-out) topics.
--
-- The sequence number is a large, non-consecutive number that Amazon SNS
-- assigns to each message. The length of @SequenceNumber@ is 128 bits.
-- @SequenceNumber@ continues to increase for each @MessageGroupId@.
publishResponse_sequenceNumber :: Lens.Lens' PublishResponse (Prelude.Maybe Prelude.Text)
publishResponse_sequenceNumber :: Lens' PublishResponse (Maybe Text)
publishResponse_sequenceNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PublishResponse' {Maybe Text
sequenceNumber :: Maybe Text
$sel:sequenceNumber:PublishResponse' :: PublishResponse -> Maybe Text
sequenceNumber} -> Maybe Text
sequenceNumber) (\s :: PublishResponse
s@PublishResponse' {} Maybe Text
a -> PublishResponse
s {$sel:sequenceNumber:PublishResponse' :: Maybe Text
sequenceNumber = Maybe Text
a} :: PublishResponse)

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

instance Prelude.NFData PublishResponse where
  rnf :: PublishResponse -> ()
rnf PublishResponse' {Int
Maybe Text
httpStatus :: Int
sequenceNumber :: Maybe Text
messageId :: Maybe Text
$sel:httpStatus:PublishResponse' :: PublishResponse -> Int
$sel:sequenceNumber:PublishResponse' :: PublishResponse -> Maybe Text
$sel:messageId:PublishResponse' :: PublishResponse -> Maybe Text
..} =
    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 Maybe Text
sequenceNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus