{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.SQS.Types
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.SQS.Types
  ( -- * Service Configuration
    defaultService,

    -- * Errors
    _BatchEntryIdsNotDistinct,
    _BatchRequestTooLong,
    _EmptyBatchRequest,
    _InvalidAttributeName,
    _InvalidBatchEntryId,
    _InvalidIdFormat,
    _InvalidMessageContents,
    _MessageNotInflight,
    _OverLimit,
    _PurgeQueueInProgress,
    _QueueDeletedRecently,
    _QueueDoesNotExist,
    _QueueNameExists,
    _ReceiptHandleIsInvalid,
    _TooManyEntriesInBatchRequest,
    _UnsupportedOperation,

    -- * MessageAttribute
    MessageAttribute (..),

    -- * MessageSystemAttributeNameForSends
    MessageSystemAttributeNameForSends (..),

    -- * QueueAttributeName
    QueueAttributeName (..),

    -- * BatchResultErrorEntry
    BatchResultErrorEntry (..),
    newBatchResultErrorEntry,
    batchResultErrorEntry_message,
    batchResultErrorEntry_id,
    batchResultErrorEntry_senderFault,
    batchResultErrorEntry_code,

    -- * ChangeMessageVisibilityBatchRequestEntry
    ChangeMessageVisibilityBatchRequestEntry (..),
    newChangeMessageVisibilityBatchRequestEntry,
    changeMessageVisibilityBatchRequestEntry_visibilityTimeout,
    changeMessageVisibilityBatchRequestEntry_id,
    changeMessageVisibilityBatchRequestEntry_receiptHandle,

    -- * ChangeMessageVisibilityBatchResultEntry
    ChangeMessageVisibilityBatchResultEntry (..),
    newChangeMessageVisibilityBatchResultEntry,
    changeMessageVisibilityBatchResultEntry_id,

    -- * DeleteMessageBatchRequestEntry
    DeleteMessageBatchRequestEntry (..),
    newDeleteMessageBatchRequestEntry,
    deleteMessageBatchRequestEntry_id,
    deleteMessageBatchRequestEntry_receiptHandle,

    -- * DeleteMessageBatchResultEntry
    DeleteMessageBatchResultEntry (..),
    newDeleteMessageBatchResultEntry,
    deleteMessageBatchResultEntry_id,

    -- * Message
    Message (..),
    newMessage,
    message_attributes,
    message_body,
    message_mD5OfBody,
    message_mD5OfMessageAttributes,
    message_messageAttributes,
    message_messageId,
    message_receiptHandle,

    -- * MessageAttributeValue
    MessageAttributeValue (..),
    newMessageAttributeValue,
    messageAttributeValue_binaryListValues,
    messageAttributeValue_binaryValue,
    messageAttributeValue_stringListValues,
    messageAttributeValue_stringValue,
    messageAttributeValue_dataType,

    -- * MessageSystemAttributeValue
    MessageSystemAttributeValue (..),
    newMessageSystemAttributeValue,
    messageSystemAttributeValue_binaryListValues,
    messageSystemAttributeValue_binaryValue,
    messageSystemAttributeValue_stringListValues,
    messageSystemAttributeValue_stringValue,
    messageSystemAttributeValue_dataType,

    -- * SendMessageBatchRequestEntry
    SendMessageBatchRequestEntry (..),
    newSendMessageBatchRequestEntry,
    sendMessageBatchRequestEntry_delaySeconds,
    sendMessageBatchRequestEntry_messageAttributes,
    sendMessageBatchRequestEntry_messageDeduplicationId,
    sendMessageBatchRequestEntry_messageGroupId,
    sendMessageBatchRequestEntry_messageSystemAttributes,
    sendMessageBatchRequestEntry_id,
    sendMessageBatchRequestEntry_messageBody,

    -- * SendMessageBatchResultEntry
    SendMessageBatchResultEntry (..),
    newSendMessageBatchResultEntry,
    sendMessageBatchResultEntry_mD5OfMessageAttributes,
    sendMessageBatchResultEntry_mD5OfMessageSystemAttributes,
    sendMessageBatchResultEntry_sequenceNumber,
    sendMessageBatchResultEntry_id,
    sendMessageBatchResultEntry_messageId,
    sendMessageBatchResultEntry_mD5OfMessageBody,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Prelude as Prelude
import Amazonka.SQS.Types.BatchResultErrorEntry
import Amazonka.SQS.Types.ChangeMessageVisibilityBatchRequestEntry
import Amazonka.SQS.Types.ChangeMessageVisibilityBatchResultEntry
import Amazonka.SQS.Types.DeleteMessageBatchRequestEntry
import Amazonka.SQS.Types.DeleteMessageBatchResultEntry
import Amazonka.SQS.Types.Message
import Amazonka.SQS.Types.MessageAttribute
import Amazonka.SQS.Types.MessageAttributeValue
import Amazonka.SQS.Types.MessageSystemAttributeNameForSends
import Amazonka.SQS.Types.MessageSystemAttributeValue
import Amazonka.SQS.Types.QueueAttributeName
import Amazonka.SQS.Types.SendMessageBatchRequestEntry
import Amazonka.SQS.Types.SendMessageBatchResultEntry
import qualified Amazonka.Sign.V4 as Sign

-- | API version @2012-11-05@ of the Amazon Simple Queue Service SDK configuration.
defaultService :: Core.Service
defaultService :: Service
defaultService =
  Core.Service
    { $sel:abbrev:Service :: Abbrev
Core.abbrev = Abbrev
"SQS",
      $sel:signer:Service :: Signer
Core.signer = Signer
Sign.v4,
      $sel:endpointPrefix:Service :: ByteString
Core.endpointPrefix = ByteString
"sqs",
      $sel:signingName:Service :: ByteString
Core.signingName = ByteString
"sqs",
      $sel:version:Service :: ByteString
Core.version = ByteString
"2012-11-05",
      $sel:s3AddressingStyle:Service :: S3AddressingStyle
Core.s3AddressingStyle = S3AddressingStyle
Core.S3AddressingStyleAuto,
      $sel:endpoint:Service :: Region -> Endpoint
Core.endpoint = Service -> Region -> Endpoint
Core.defaultEndpoint Service
defaultService,
      $sel:timeout:Service :: Maybe Seconds
Core.timeout = forall a. a -> Maybe a
Prelude.Just Seconds
70,
      $sel:check:Service :: Status -> Bool
Core.check = Status -> Bool
Core.statusSuccess,
      $sel:error:Service :: Status -> [Header] -> ByteStringLazy -> Error
Core.error = Abbrev -> Status -> [Header] -> ByteStringLazy -> Error
Core.parseXMLError Abbrev
"SQS",
      $sel:retry:Service :: Retry
Core.retry = Retry
retry
    }
  where
    retry :: Retry
retry =
      Core.Exponential
        { $sel:base:Exponential :: Double
Core.base = Double
5.0e-2,
          $sel:growth:Exponential :: Int
Core.growth = Int
2,
          $sel:attempts:Exponential :: Int
Core.attempts = Int
5,
          $sel:check:Exponential :: ServiceError -> Maybe Text
Core.check = forall {a}. IsString a => ServiceError -> Maybe a
check
        }
    check :: ServiceError -> Maybe a
check ServiceError
e
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
502) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"bad_gateway"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
504) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"gateway_timeout"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
500) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"general_server_error"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
509) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"limit_exceeded"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode ErrorCode
"RequestThrottled"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
403
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"request_limit_exceeded"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode ErrorCode
"RequestThrottledException"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"request_throttled_exception"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
503) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"service_unavailable"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode ErrorCode
"ThrottledException"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"throttled_exception"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode ErrorCode
"Throttling"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"throttling"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode ErrorCode
"ThrottlingException"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"throttling_exception"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has
          ( forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
ErrorCode -> Optic' p f ServiceError ServiceError
Core.hasCode
              ErrorCode
"ProvisionedThroughputExceededException"
              forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400
          )
          ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"throughput_exceeded"
      | forall s a. Getting Any s a -> s -> Bool
Lens.has (forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
429) ServiceError
e =
          forall a. a -> Maybe a
Prelude.Just a
"too_many_requests"
      | Bool
Prelude.otherwise = forall a. Maybe a
Prelude.Nothing

-- | Two or more batch entries in the request have the same @Id@.
_BatchEntryIdsNotDistinct :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_BatchEntryIdsNotDistinct :: forall a. AsError a => Fold a ServiceError
_BatchEntryIdsNotDistinct =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AWS.SimpleQueueService.BatchEntryIdsNotDistinct"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The length of all the messages put together is more than the limit.
_BatchRequestTooLong :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_BatchRequestTooLong :: forall a. AsError a => Fold a ServiceError
_BatchRequestTooLong =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AWS.SimpleQueueService.BatchRequestTooLong"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The batch request doesn\'t contain any entries.
_EmptyBatchRequest :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_EmptyBatchRequest :: forall a. AsError a => Fold a ServiceError
_EmptyBatchRequest =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AWS.SimpleQueueService.EmptyBatchRequest"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The specified attribute doesn\'t exist.
_InvalidAttributeName :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidAttributeName :: forall a. AsError a => Fold a ServiceError
_InvalidAttributeName =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidAttributeName"

-- | The @Id@ of a batch entry in a batch request doesn\'t abide by the
-- specification.
_InvalidBatchEntryId :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidBatchEntryId :: forall a. AsError a => Fold a ServiceError
_InvalidBatchEntryId =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AWS.SimpleQueueService.InvalidBatchEntryId"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The specified receipt handle isn\'t valid for the current version.
_InvalidIdFormat :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidIdFormat :: forall a. AsError a => Fold a ServiceError
_InvalidIdFormat =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidIdFormat"

-- | The message contains characters outside the allowed set.
_InvalidMessageContents :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_InvalidMessageContents :: forall a. AsError a => Fold a ServiceError
_InvalidMessageContents =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"InvalidMessageContents"

-- | The specified message isn\'t in flight.
_MessageNotInflight :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_MessageNotInflight :: forall a. AsError a => Fold a ServiceError
_MessageNotInflight =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AWS.SimpleQueueService.MessageNotInflight"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The specified action violates a limit. For example, @ReceiveMessage@
-- returns this error if the maximum number of inflight messages is reached
-- and @AddPermission@ returns this error if the maximum number of
-- permissions for the queue is reached.
_OverLimit :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_OverLimit :: forall a. AsError a => Fold a ServiceError
_OverLimit =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError Service
defaultService ErrorCode
"OverLimit"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
403

-- | Indicates that the specified queue previously received a @PurgeQueue@
-- request within the last 60 seconds (the time it can take to delete the
-- messages in the queue).
_PurgeQueueInProgress :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_PurgeQueueInProgress :: forall a. AsError a => Fold a ServiceError
_PurgeQueueInProgress =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AWS.SimpleQueueService.PurgeQueueInProgress"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
403

-- | You must wait 60 seconds after deleting a queue before you can create
-- another queue with the same name.
_QueueDeletedRecently :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_QueueDeletedRecently :: forall a. AsError a => Fold a ServiceError
_QueueDeletedRecently =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AWS.SimpleQueueService.QueueDeletedRecently"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The specified queue doesn\'t exist.
_QueueDoesNotExist :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_QueueDoesNotExist :: forall a. AsError a => Fold a ServiceError
_QueueDoesNotExist =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AWS.SimpleQueueService.NonExistentQueue"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | A queue with this name already exists. Amazon SQS returns this error
-- only if the request includes attributes whose values differ from those
-- of the existing queue.
_QueueNameExists :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_QueueNameExists :: forall a. AsError a => Fold a ServiceError
_QueueNameExists =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"QueueAlreadyExists"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | The specified receipt handle isn\'t valid.
_ReceiptHandleIsInvalid :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_ReceiptHandleIsInvalid :: forall a. AsError a => Fold a ServiceError
_ReceiptHandleIsInvalid =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"ReceiptHandleIsInvalid"

-- | The batch request contains more entries than permissible.
_TooManyEntriesInBatchRequest :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_TooManyEntriesInBatchRequest :: forall a. AsError a => Fold a ServiceError
_TooManyEntriesInBatchRequest =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AWS.SimpleQueueService.TooManyEntriesInBatchRequest"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400

-- | Error code 400. Unsupported operation.
_UnsupportedOperation :: (Core.AsError a) => Lens.Fold a Core.ServiceError
_UnsupportedOperation :: forall a. AsError a => Fold a ServiceError
_UnsupportedOperation =
  forall a. AsError a => Service -> ErrorCode -> Fold a ServiceError
Core._MatchServiceError
    Service
defaultService
    ErrorCode
"AWS.SimpleQueueService.UnsupportedOperation"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (p :: * -> * -> *).
(Applicative f, Choice p) =>
Int -> Optic' p f ServiceError ServiceError
Core.hasStatus Int
400