{-# 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.UntagQueue
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Remove cost allocation tags from 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/.
--
-- 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.UntagQueue
  ( -- * Creating a Request
    UntagQueue (..),
    newUntagQueue,

    -- * Request Lenses
    untagQueue_queueUrl,
    untagQueue_tagKeys,

    -- * Destructuring the Response
    UntagQueueResponse (..),
    newUntagQueueResponse,
  )
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:/ 'newUntagQueue' smart constructor.
data UntagQueue = UntagQueue'
  { -- | The URL of the queue.
    UntagQueue -> Text
queueUrl :: Prelude.Text,
    -- | The list of tags to be removed from the specified queue.
    UntagQueue -> [Text]
tagKeys :: [Prelude.Text]
  }
  deriving (UntagQueue -> UntagQueue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UntagQueue -> UntagQueue -> Bool
$c/= :: UntagQueue -> UntagQueue -> Bool
== :: UntagQueue -> UntagQueue -> Bool
$c== :: UntagQueue -> UntagQueue -> Bool
Prelude.Eq, ReadPrec [UntagQueue]
ReadPrec UntagQueue
Int -> ReadS UntagQueue
ReadS [UntagQueue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UntagQueue]
$creadListPrec :: ReadPrec [UntagQueue]
readPrec :: ReadPrec UntagQueue
$creadPrec :: ReadPrec UntagQueue
readList :: ReadS [UntagQueue]
$creadList :: ReadS [UntagQueue]
readsPrec :: Int -> ReadS UntagQueue
$creadsPrec :: Int -> ReadS UntagQueue
Prelude.Read, Int -> UntagQueue -> ShowS
[UntagQueue] -> ShowS
UntagQueue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UntagQueue] -> ShowS
$cshowList :: [UntagQueue] -> ShowS
show :: UntagQueue -> String
$cshow :: UntagQueue -> String
showsPrec :: Int -> UntagQueue -> ShowS
$cshowsPrec :: Int -> UntagQueue -> ShowS
Prelude.Show, forall x. Rep UntagQueue x -> UntagQueue
forall x. UntagQueue -> Rep UntagQueue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UntagQueue x -> UntagQueue
$cfrom :: forall x. UntagQueue -> Rep UntagQueue x
Prelude.Generic)

-- |
-- Create a value of 'UntagQueue' 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', 'untagQueue_queueUrl' - The URL of the queue.
--
-- 'tagKeys', 'untagQueue_tagKeys' - The list of tags to be removed from the specified queue.
newUntagQueue ::
  -- | 'queueUrl'
  Prelude.Text ->
  UntagQueue
newUntagQueue :: Text -> UntagQueue
newUntagQueue Text
pQueueUrl_ =
  UntagQueue'
    { $sel:queueUrl:UntagQueue' :: Text
queueUrl = Text
pQueueUrl_,
      $sel:tagKeys:UntagQueue' :: [Text]
tagKeys = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | The list of tags to be removed from the specified queue.
untagQueue_tagKeys :: Lens.Lens' UntagQueue [Prelude.Text]
untagQueue_tagKeys :: Lens' UntagQueue [Text]
untagQueue_tagKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UntagQueue' {[Text]
tagKeys :: [Text]
$sel:tagKeys:UntagQueue' :: UntagQueue -> [Text]
tagKeys} -> [Text]
tagKeys) (\s :: UntagQueue
s@UntagQueue' {} [Text]
a -> UntagQueue
s {$sel:tagKeys:UntagQueue' :: [Text]
tagKeys = [Text]
a} :: UntagQueue) 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 UntagQueue where
  type AWSResponse UntagQueue = UntagQueueResponse
  request :: (Service -> Service) -> UntagQueue -> Request UntagQueue
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 UntagQueue
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UntagQueue)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UntagQueueResponse
UntagQueueResponse'

instance Prelude.Hashable UntagQueue where
  hashWithSalt :: Int -> UntagQueue -> Int
hashWithSalt Int
_salt UntagQueue' {[Text]
Text
tagKeys :: [Text]
queueUrl :: Text
$sel:tagKeys:UntagQueue' :: UntagQueue -> [Text]
$sel:queueUrl:UntagQueue' :: UntagQueue -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
queueUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
tagKeys

instance Prelude.NFData UntagQueue where
  rnf :: UntagQueue -> ()
rnf UntagQueue' {[Text]
Text
tagKeys :: [Text]
queueUrl :: Text
$sel:tagKeys:UntagQueue' :: UntagQueue -> [Text]
$sel:queueUrl:UntagQueue' :: UntagQueue -> 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 [Text]
tagKeys

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

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

instance Data.ToQuery UntagQueue where
  toQuery :: UntagQueue -> QueryString
toQuery UntagQueue' {[Text]
Text
tagKeys :: [Text]
queueUrl :: Text
$sel:tagKeys:UntagQueue' :: UntagQueue -> [Text]
$sel:queueUrl:UntagQueue' :: UntagQueue -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"UntagQueue" :: 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 a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagKey" [Text]
tagKeys
      ]

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

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

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