{-# 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.AddPermission
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds a permission to a queue for a specific
-- <https://docs.aws.amazon.com/general/latest/gr/glos-chap.html#P principal>.
-- This allows sharing access to the queue.
--
-- When you create a queue, you have full control access rights for the
-- queue. Only you, the owner of the queue, can grant or deny permissions
-- to the queue. For more information about these permissions, see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-writing-an-sqs-policy.html#write-messages-to-shared-queue Allow Developers to Write Messages to a Shared Queue>
-- in the /Amazon SQS Developer Guide/.
--
-- -   @AddPermission@ generates a policy for you. You can use
--     @ @@SetQueueAttributes@@ @ to upload your policy. For more
--     information, see
--     <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-creating-custom-policies.html Using Custom Policies with the Amazon SQS Access Policy Language>
--     in the /Amazon SQS Developer Guide/.
--
-- -   An Amazon SQS policy can have a maximum of 7 actions.
--
-- -   To remove the ability to change queue permissions, you must deny
--     permission to the @AddPermission@, @RemovePermission@, and
--     @SetQueueAttributes@ actions in your IAM policy.
--
-- Some actions take lists of parameters. These lists are specified using
-- the @param.n@ notation. Values of @n@ are integers starting from 1. For
-- example, a parameter list with two elements looks like this:
--
-- @&AttributeName.1=first@
--
-- @&AttributeName.2=second@
--
-- 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.AddPermission
  ( -- * Creating a Request
    AddPermission (..),
    newAddPermission,

    -- * Request Lenses
    addPermission_queueUrl,
    addPermission_label,
    addPermission_aWSAccountIds,
    addPermission_actions,

    -- * Destructuring the Response
    AddPermissionResponse (..),
    newAddPermissionResponse,
  )
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:/ 'newAddPermission' smart constructor.
data AddPermission = AddPermission'
  { -- | The URL of the Amazon SQS queue to which permissions are added.
    --
    -- Queue URLs and names are case-sensitive.
    AddPermission -> Text
queueUrl :: Prelude.Text,
    -- | The unique identification of the permission you\'re setting (for
    -- example, @AliceSendMessage@). Maximum 80 characters. Allowed characters
    -- include alphanumeric characters, hyphens (@-@), and underscores (@_@).
    AddPermission -> Text
label :: Prelude.Text,
    -- | The Amazon Web Services account numbers of the
    -- <https://docs.aws.amazon.com/general/latest/gr/glos-chap.html#P principals>
    -- who are to receive permission. For information about locating the Amazon
    -- Web Services account identification, see
    -- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-making-api-requests.html#sqs-api-request-authentication Your Amazon Web Services Identifiers>
    -- in the /Amazon SQS Developer Guide/.
    AddPermission -> [Text]
aWSAccountIds :: [Prelude.Text],
    -- | The action the client wants to allow for the specified principal. Valid
    -- values: the name of any action or @*@.
    --
    -- For more information about these actions, see
    -- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-overview-of-managing-access.html Overview of Managing Access Permissions to Your Amazon Simple Queue Service Resource>
    -- in the /Amazon SQS Developer Guide/.
    --
    -- Specifying @SendMessage@, @DeleteMessage@, or @ChangeMessageVisibility@
    -- for @ActionName.n@ also grants permissions for the corresponding batch
    -- versions of those actions: @SendMessageBatch@, @DeleteMessageBatch@, and
    -- @ChangeMessageVisibilityBatch@.
    AddPermission -> [Text]
actions :: [Prelude.Text]
  }
  deriving (AddPermission -> AddPermission -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddPermission -> AddPermission -> Bool
$c/= :: AddPermission -> AddPermission -> Bool
== :: AddPermission -> AddPermission -> Bool
$c== :: AddPermission -> AddPermission -> Bool
Prelude.Eq, ReadPrec [AddPermission]
ReadPrec AddPermission
Int -> ReadS AddPermission
ReadS [AddPermission]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddPermission]
$creadListPrec :: ReadPrec [AddPermission]
readPrec :: ReadPrec AddPermission
$creadPrec :: ReadPrec AddPermission
readList :: ReadS [AddPermission]
$creadList :: ReadS [AddPermission]
readsPrec :: Int -> ReadS AddPermission
$creadsPrec :: Int -> ReadS AddPermission
Prelude.Read, Int -> AddPermission -> ShowS
[AddPermission] -> ShowS
AddPermission -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddPermission] -> ShowS
$cshowList :: [AddPermission] -> ShowS
show :: AddPermission -> String
$cshow :: AddPermission -> String
showsPrec :: Int -> AddPermission -> ShowS
$cshowsPrec :: Int -> AddPermission -> ShowS
Prelude.Show, forall x. Rep AddPermission x -> AddPermission
forall x. AddPermission -> Rep AddPermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddPermission x -> AddPermission
$cfrom :: forall x. AddPermission -> Rep AddPermission x
Prelude.Generic)

-- |
-- Create a value of 'AddPermission' 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', 'addPermission_queueUrl' - The URL of the Amazon SQS queue to which permissions are added.
--
-- Queue URLs and names are case-sensitive.
--
-- 'label', 'addPermission_label' - The unique identification of the permission you\'re setting (for
-- example, @AliceSendMessage@). Maximum 80 characters. Allowed characters
-- include alphanumeric characters, hyphens (@-@), and underscores (@_@).
--
-- 'aWSAccountIds', 'addPermission_aWSAccountIds' - The Amazon Web Services account numbers of the
-- <https://docs.aws.amazon.com/general/latest/gr/glos-chap.html#P principals>
-- who are to receive permission. For information about locating the Amazon
-- Web Services account identification, see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-making-api-requests.html#sqs-api-request-authentication Your Amazon Web Services Identifiers>
-- in the /Amazon SQS Developer Guide/.
--
-- 'actions', 'addPermission_actions' - The action the client wants to allow for the specified principal. Valid
-- values: the name of any action or @*@.
--
-- For more information about these actions, see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-overview-of-managing-access.html Overview of Managing Access Permissions to Your Amazon Simple Queue Service Resource>
-- in the /Amazon SQS Developer Guide/.
--
-- Specifying @SendMessage@, @DeleteMessage@, or @ChangeMessageVisibility@
-- for @ActionName.n@ also grants permissions for the corresponding batch
-- versions of those actions: @SendMessageBatch@, @DeleteMessageBatch@, and
-- @ChangeMessageVisibilityBatch@.
newAddPermission ::
  -- | 'queueUrl'
  Prelude.Text ->
  -- | 'label'
  Prelude.Text ->
  AddPermission
newAddPermission :: Text -> Text -> AddPermission
newAddPermission Text
pQueueUrl_ Text
pLabel_ =
  AddPermission'
    { $sel:queueUrl:AddPermission' :: Text
queueUrl = Text
pQueueUrl_,
      $sel:label:AddPermission' :: Text
label = Text
pLabel_,
      $sel:aWSAccountIds:AddPermission' :: [Text]
aWSAccountIds = forall a. Monoid a => a
Prelude.mempty,
      $sel:actions:AddPermission' :: [Text]
actions = forall a. Monoid a => a
Prelude.mempty
    }

-- | The URL of the Amazon SQS queue to which permissions are added.
--
-- Queue URLs and names are case-sensitive.
addPermission_queueUrl :: Lens.Lens' AddPermission Prelude.Text
addPermission_queueUrl :: Lens' AddPermission Text
addPermission_queueUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Text
queueUrl :: Text
$sel:queueUrl:AddPermission' :: AddPermission -> Text
queueUrl} -> Text
queueUrl) (\s :: AddPermission
s@AddPermission' {} Text
a -> AddPermission
s {$sel:queueUrl:AddPermission' :: Text
queueUrl = Text
a} :: AddPermission)

-- | The unique identification of the permission you\'re setting (for
-- example, @AliceSendMessage@). Maximum 80 characters. Allowed characters
-- include alphanumeric characters, hyphens (@-@), and underscores (@_@).
addPermission_label :: Lens.Lens' AddPermission Prelude.Text
addPermission_label :: Lens' AddPermission Text
addPermission_label = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Text
label :: Text
$sel:label:AddPermission' :: AddPermission -> Text
label} -> Text
label) (\s :: AddPermission
s@AddPermission' {} Text
a -> AddPermission
s {$sel:label:AddPermission' :: Text
label = Text
a} :: AddPermission)

-- | The Amazon Web Services account numbers of the
-- <https://docs.aws.amazon.com/general/latest/gr/glos-chap.html#P principals>
-- who are to receive permission. For information about locating the Amazon
-- Web Services account identification, see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-making-api-requests.html#sqs-api-request-authentication Your Amazon Web Services Identifiers>
-- in the /Amazon SQS Developer Guide/.
addPermission_aWSAccountIds :: Lens.Lens' AddPermission [Prelude.Text]
addPermission_aWSAccountIds :: Lens' AddPermission [Text]
addPermission_aWSAccountIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {[Text]
aWSAccountIds :: [Text]
$sel:aWSAccountIds:AddPermission' :: AddPermission -> [Text]
aWSAccountIds} -> [Text]
aWSAccountIds) (\s :: AddPermission
s@AddPermission' {} [Text]
a -> AddPermission
s {$sel:aWSAccountIds:AddPermission' :: [Text]
aWSAccountIds = [Text]
a} :: AddPermission) 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

-- | The action the client wants to allow for the specified principal. Valid
-- values: the name of any action or @*@.
--
-- For more information about these actions, see
-- <https://docs.aws.amazon.com/AWSSimpleQueueService/latest/SQSDeveloperGuide/sqs-overview-of-managing-access.html Overview of Managing Access Permissions to Your Amazon Simple Queue Service Resource>
-- in the /Amazon SQS Developer Guide/.
--
-- Specifying @SendMessage@, @DeleteMessage@, or @ChangeMessageVisibility@
-- for @ActionName.n@ also grants permissions for the corresponding batch
-- versions of those actions: @SendMessageBatch@, @DeleteMessageBatch@, and
-- @ChangeMessageVisibilityBatch@.
addPermission_actions :: Lens.Lens' AddPermission [Prelude.Text]
addPermission_actions :: Lens' AddPermission [Text]
addPermission_actions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {[Text]
actions :: [Text]
$sel:actions:AddPermission' :: AddPermission -> [Text]
actions} -> [Text]
actions) (\s :: AddPermission
s@AddPermission' {} [Text]
a -> AddPermission
s {$sel:actions:AddPermission' :: [Text]
actions = [Text]
a} :: AddPermission) 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 AddPermission where
  type
    AWSResponse AddPermission =
      AddPermissionResponse
  request :: (Service -> Service) -> AddPermission -> Request AddPermission
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 AddPermission
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AddPermission)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull AddPermissionResponse
AddPermissionResponse'

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

instance Prelude.NFData AddPermission where
  rnf :: AddPermission -> ()
rnf AddPermission' {[Text]
Text
actions :: [Text]
aWSAccountIds :: [Text]
label :: Text
queueUrl :: Text
$sel:actions:AddPermission' :: AddPermission -> [Text]
$sel:aWSAccountIds:AddPermission' :: AddPermission -> [Text]
$sel:label:AddPermission' :: AddPermission -> Text
$sel:queueUrl:AddPermission' :: AddPermission -> 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
label
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
aWSAccountIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
actions

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

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

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

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

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

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