{-# 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.SQS.TagQueue
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Add cost allocation tags to the specified Amazon SQS queue. For an
-- overview, see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-queue-tags.html Tagging Your Amazon SQS Queues>
-- in the /Amazon SQS Developer Guide/.
--
-- When you use queue tags, keep the following guidelines in mind:
--
-- -   Adding more than 50 tags to a queue isn\'t recommended.
--
-- -   Tags don\'t have any semantic meaning. Amazon SQS interprets tags as
--     character strings.
--
-- -   Tags are case-sensitive.
--
-- -   A new tag with a key identical to that of an existing tag overwrites
--     the existing tag.
--
-- For a full list of tag restrictions, see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-limits.html#limits-queues Quotas related to queues>
-- in the /Amazon SQS Developer Guide/.
--
-- Cross-account permissions don\'t apply to this action. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-customer-managed-policy-examples.html#grant-cross-account-permissions-to-role-and-user-name Grant cross-account permissions to a role and a user name>
-- in the /Amazon SQS Developer Guide/.
module Amazonka.SQS.TagQueue
  ( -- * Creating a Request
    TagQueue (..),
    newTagQueue,

    -- * Request Lenses
    tagQueue_queueUrl,
    tagQueue_tags,

    -- * Destructuring the Response
    TagQueueResponse (..),
    newTagQueueResponse,
  )
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.SQS.Types

-- | /See:/ 'newTagQueue' smart constructor.
data TagQueue = TagQueue'
  { -- | The URL of the queue.
    TagQueue -> Text
queueUrl :: Prelude.Text,
    -- | The list of tags to be added to the specified queue.
    TagQueue -> HashMap Text Text
tags :: Prelude.HashMap Prelude.Text Prelude.Text
  }
  deriving (TagQueue -> TagQueue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagQueue -> TagQueue -> Bool
$c/= :: TagQueue -> TagQueue -> Bool
== :: TagQueue -> TagQueue -> Bool
$c== :: TagQueue -> TagQueue -> Bool
Prelude.Eq, ReadPrec [TagQueue]
ReadPrec TagQueue
Int -> ReadS TagQueue
ReadS [TagQueue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TagQueue]
$creadListPrec :: ReadPrec [TagQueue]
readPrec :: ReadPrec TagQueue
$creadPrec :: ReadPrec TagQueue
readList :: ReadS [TagQueue]
$creadList :: ReadS [TagQueue]
readsPrec :: Int -> ReadS TagQueue
$creadsPrec :: Int -> ReadS TagQueue
Prelude.Read, Int -> TagQueue -> ShowS
[TagQueue] -> ShowS
TagQueue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagQueue] -> ShowS
$cshowList :: [TagQueue] -> ShowS
show :: TagQueue -> String
$cshow :: TagQueue -> String
showsPrec :: Int -> TagQueue -> ShowS
$cshowsPrec :: Int -> TagQueue -> ShowS
Prelude.Show, forall x. Rep TagQueue x -> TagQueue
forall x. TagQueue -> Rep TagQueue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagQueue x -> TagQueue
$cfrom :: forall x. TagQueue -> Rep TagQueue x
Prelude.Generic)

-- |
-- Create a value of 'TagQueue' 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:
--
-- 'queueUrl', 'tagQueue_queueUrl' - The URL of the queue.
--
-- 'tags', 'tagQueue_tags' - The list of tags to be added to the specified queue.
newTagQueue ::
  -- | 'queueUrl'
  Prelude.Text ->
  TagQueue
newTagQueue :: Text -> TagQueue
newTagQueue Text
pQueueUrl_ =
  TagQueue'
    { $sel:queueUrl:TagQueue' :: Text
queueUrl = Text
pQueueUrl_,
      $sel:tags:TagQueue' :: HashMap Text Text
tags = forall a. Monoid a => a
Prelude.mempty
    }

-- | The URL of the queue.
tagQueue_queueUrl :: Lens.Lens' TagQueue Prelude.Text
tagQueue_queueUrl :: Lens' TagQueue Text
tagQueue_queueUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagQueue' {Text
queueUrl :: Text
$sel:queueUrl:TagQueue' :: TagQueue -> Text
queueUrl} -> Text
queueUrl) (\s :: TagQueue
s@TagQueue' {} Text
a -> TagQueue
s {$sel:queueUrl:TagQueue' :: Text
queueUrl = Text
a} :: TagQueue)

-- | The list of tags to be added to the specified queue.
tagQueue_tags :: Lens.Lens' TagQueue (Prelude.HashMap Prelude.Text Prelude.Text)
tagQueue_tags :: Lens' TagQueue (HashMap Text Text)
tagQueue_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TagQueue' {HashMap Text Text
tags :: HashMap Text Text
$sel:tags:TagQueue' :: TagQueue -> HashMap Text Text
tags} -> HashMap Text Text
tags) (\s :: TagQueue
s@TagQueue' {} HashMap Text Text
a -> TagQueue
s {$sel:tags:TagQueue' :: HashMap Text Text
tags = HashMap Text Text
a} :: TagQueue) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest TagQueue where
  type AWSResponse TagQueue = TagQueueResponse
  request :: (Service -> Service) -> TagQueue -> Request TagQueue
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 TagQueue
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TagQueue)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull TagQueueResponse
TagQueueResponse'

instance Prelude.Hashable TagQueue where
  hashWithSalt :: Int -> TagQueue -> Int
hashWithSalt Int
_salt TagQueue' {Text
HashMap Text Text
tags :: HashMap Text Text
queueUrl :: Text
$sel:tags:TagQueue' :: TagQueue -> HashMap Text Text
$sel:queueUrl:TagQueue' :: TagQueue -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
queueUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Text
tags

instance Prelude.NFData TagQueue where
  rnf :: TagQueue -> ()
rnf TagQueue' {Text
HashMap Text Text
tags :: HashMap Text Text
queueUrl :: Text
$sel:tags:TagQueue' :: TagQueue -> HashMap Text Text
$sel:queueUrl:TagQueue' :: TagQueue -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
queueUrl seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text Text
tags

instance Data.ToHeaders TagQueue where
  toHeaders :: TagQueue -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery TagQueue where
  toQuery :: TagQueue -> QueryString
toQuery TagQueue' {Text
HashMap Text Text
tags :: HashMap Text Text
queueUrl :: Text
$sel:tags:TagQueue' :: TagQueue -> HashMap Text Text
$sel:queueUrl:TagQueue' :: TagQueue -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"TagQueue" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-11-05" :: Prelude.ByteString),
        ByteString
"QueueUrl" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
queueUrl,
        forall k v.
(ToQuery k, ToQuery v) =>
ByteString
-> ByteString -> ByteString -> HashMap k v -> QueryString
Data.toQueryMap ByteString
"Tags" ByteString
"Key" ByteString
"Value" HashMap Text Text
tags
      ]

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

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

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