{-# 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.Lambda.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)
--
-- Grants an Amazon Web Service, Amazon Web Services account, or Amazon Web
-- Services organization permission to use a function. You can apply the
-- policy at the function level, or specify a qualifier to restrict access
-- to a single version or alias. If you use a qualifier, the invoker must
-- use the full Amazon Resource Name (ARN) of that version or alias to
-- invoke the function. Note: Lambda does not support adding policies to
-- version $LATEST.
--
-- To grant permission to another account, specify the account ID as the
-- @Principal@. To grant permission to an organization defined in
-- Organizations, specify the organization ID as the @PrincipalOrgID@. For
-- Amazon Web Services, the principal is a domain-style identifier that the
-- service defines, such as @s3.amazonaws.com@ or @sns.amazonaws.com@. For
-- Amazon Web Services, you can also specify the ARN of the associated
-- resource as the @SourceArn@. If you grant permission to a service
-- principal without specifying the source, other accounts could
-- potentially configure resources in their account to invoke your Lambda
-- function.
--
-- This operation adds a statement to a resource-based permissions policy
-- for the function. For more information about function policies, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/access-control-resource-based.html Using resource-based policies for Lambda>.
module Amazonka.Lambda.AddPermission
  ( -- * Creating a Request
    AddPermission (..),
    newAddPermission,

    -- * Request Lenses
    addPermission_eventSourceToken,
    addPermission_functionUrlAuthType,
    addPermission_principalOrgID,
    addPermission_qualifier,
    addPermission_revisionId,
    addPermission_sourceAccount,
    addPermission_sourceArn,
    addPermission_functionName,
    addPermission_statementId,
    addPermission_action,
    addPermission_principal,

    -- * Destructuring the Response
    AddPermissionResponse (..),
    newAddPermissionResponse,

    -- * Response Lenses
    addPermissionResponse_statement,
    addPermissionResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Lambda.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newAddPermission' smart constructor.
data AddPermission = AddPermission'
  { -- | For Alexa Smart Home functions, a token that the invoker must supply.
    AddPermission -> Maybe Text
eventSourceToken :: Prelude.Maybe Prelude.Text,
    -- | The type of authentication that your function URL uses. Set to @AWS_IAM@
    -- if you want to restrict access to authenticated IAM users only. Set to
    -- @NONE@ if you want to bypass IAM authentication to create a public
    -- endpoint. For more information, see
    -- <https://docs.aws.amazon.com/lambda/latest/dg/urls-auth.html Security and auth model for Lambda function URLs>.
    AddPermission -> Maybe FunctionUrlAuthType
functionUrlAuthType :: Prelude.Maybe FunctionUrlAuthType,
    -- | The identifier for your organization in Organizations. Use this to grant
    -- permissions to all the Amazon Web Services accounts under this
    -- organization.
    AddPermission -> Maybe Text
principalOrgID :: Prelude.Maybe Prelude.Text,
    -- | Specify a version or alias to add permissions to a published version of
    -- the function.
    AddPermission -> Maybe Text
qualifier :: Prelude.Maybe Prelude.Text,
    -- | Update the policy only if the revision ID matches the ID that\'s
    -- specified. Use this option to avoid modifying a policy that has changed
    -- since you last read it.
    AddPermission -> Maybe Text
revisionId :: Prelude.Maybe Prelude.Text,
    -- | For Amazon Web Service, the ID of the Amazon Web Services account that
    -- owns the resource. Use this together with @SourceArn@ to ensure that the
    -- specified account owns the resource. It is possible for an Amazon S3
    -- bucket to be deleted by its owner and recreated by another account.
    AddPermission -> Maybe Text
sourceAccount :: Prelude.Maybe Prelude.Text,
    -- | For Amazon Web Services, the ARN of the Amazon Web Services resource
    -- that invokes the function. For example, an Amazon S3 bucket or Amazon
    -- SNS topic.
    --
    -- Note that Lambda configures the comparison using the @StringLike@
    -- operator.
    AddPermission -> Maybe Text
sourceArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the Lambda function, version, or alias.
    --
    -- __Name formats__
    --
    -- -   __Function name__ – @my-function@ (name-only), @my-function:v1@
    --     (with alias).
    --
    -- -   __Function ARN__ –
    --     @arn:aws:lambda:us-west-2:123456789012:function:my-function@.
    --
    -- -   __Partial ARN__ – @123456789012:function:my-function@.
    --
    -- You can append a version number or alias to any of the formats. The
    -- length constraint applies only to the full ARN. If you specify only the
    -- function name, it is limited to 64 characters in length.
    AddPermission -> Text
functionName :: Prelude.Text,
    -- | A statement identifier that differentiates the statement from others in
    -- the same policy.
    AddPermission -> Text
statementId :: Prelude.Text,
    -- | The action that the principal can use on the function. For example,
    -- @lambda:InvokeFunction@ or @lambda:GetFunction@.
    AddPermission -> Text
action :: Prelude.Text,
    -- | The Amazon Web Service or Amazon Web Services account that invokes the
    -- function. If you specify a service, use @SourceArn@ or @SourceAccount@
    -- to limit who can invoke the function through that service.
    AddPermission -> Text
principal :: 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:
--
-- 'eventSourceToken', 'addPermission_eventSourceToken' - For Alexa Smart Home functions, a token that the invoker must supply.
--
-- 'functionUrlAuthType', 'addPermission_functionUrlAuthType' - The type of authentication that your function URL uses. Set to @AWS_IAM@
-- if you want to restrict access to authenticated IAM users only. Set to
-- @NONE@ if you want to bypass IAM authentication to create a public
-- endpoint. For more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/urls-auth.html Security and auth model for Lambda function URLs>.
--
-- 'principalOrgID', 'addPermission_principalOrgID' - The identifier for your organization in Organizations. Use this to grant
-- permissions to all the Amazon Web Services accounts under this
-- organization.
--
-- 'qualifier', 'addPermission_qualifier' - Specify a version or alias to add permissions to a published version of
-- the function.
--
-- 'revisionId', 'addPermission_revisionId' - Update the policy only if the revision ID matches the ID that\'s
-- specified. Use this option to avoid modifying a policy that has changed
-- since you last read it.
--
-- 'sourceAccount', 'addPermission_sourceAccount' - For Amazon Web Service, the ID of the Amazon Web Services account that
-- owns the resource. Use this together with @SourceArn@ to ensure that the
-- specified account owns the resource. It is possible for an Amazon S3
-- bucket to be deleted by its owner and recreated by another account.
--
-- 'sourceArn', 'addPermission_sourceArn' - For Amazon Web Services, the ARN of the Amazon Web Services resource
-- that invokes the function. For example, an Amazon S3 bucket or Amazon
-- SNS topic.
--
-- Note that Lambda configures the comparison using the @StringLike@
-- operator.
--
-- 'functionName', 'addPermission_functionName' - The name of the Lambda function, version, or alias.
--
-- __Name formats__
--
-- -   __Function name__ – @my-function@ (name-only), @my-function:v1@
--     (with alias).
--
-- -   __Function ARN__ –
--     @arn:aws:lambda:us-west-2:123456789012:function:my-function@.
--
-- -   __Partial ARN__ – @123456789012:function:my-function@.
--
-- You can append a version number or alias to any of the formats. The
-- length constraint applies only to the full ARN. If you specify only the
-- function name, it is limited to 64 characters in length.
--
-- 'statementId', 'addPermission_statementId' - A statement identifier that differentiates the statement from others in
-- the same policy.
--
-- 'action', 'addPermission_action' - The action that the principal can use on the function. For example,
-- @lambda:InvokeFunction@ or @lambda:GetFunction@.
--
-- 'principal', 'addPermission_principal' - The Amazon Web Service or Amazon Web Services account that invokes the
-- function. If you specify a service, use @SourceArn@ or @SourceAccount@
-- to limit who can invoke the function through that service.
newAddPermission ::
  -- | 'functionName'
  Prelude.Text ->
  -- | 'statementId'
  Prelude.Text ->
  -- | 'action'
  Prelude.Text ->
  -- | 'principal'
  Prelude.Text ->
  AddPermission
newAddPermission :: Text -> Text -> Text -> Text -> AddPermission
newAddPermission
  Text
pFunctionName_
  Text
pStatementId_
  Text
pAction_
  Text
pPrincipal_ =
    AddPermission'
      { $sel:eventSourceToken:AddPermission' :: Maybe Text
eventSourceToken = forall a. Maybe a
Prelude.Nothing,
        $sel:functionUrlAuthType:AddPermission' :: Maybe FunctionUrlAuthType
functionUrlAuthType = forall a. Maybe a
Prelude.Nothing,
        $sel:principalOrgID:AddPermission' :: Maybe Text
principalOrgID = forall a. Maybe a
Prelude.Nothing,
        $sel:qualifier:AddPermission' :: Maybe Text
qualifier = forall a. Maybe a
Prelude.Nothing,
        $sel:revisionId:AddPermission' :: Maybe Text
revisionId = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceAccount:AddPermission' :: Maybe Text
sourceAccount = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceArn:AddPermission' :: Maybe Text
sourceArn = forall a. Maybe a
Prelude.Nothing,
        $sel:functionName:AddPermission' :: Text
functionName = Text
pFunctionName_,
        $sel:statementId:AddPermission' :: Text
statementId = Text
pStatementId_,
        $sel:action:AddPermission' :: Text
action = Text
pAction_,
        $sel:principal:AddPermission' :: Text
principal = Text
pPrincipal_
      }

-- | For Alexa Smart Home functions, a token that the invoker must supply.
addPermission_eventSourceToken :: Lens.Lens' AddPermission (Prelude.Maybe Prelude.Text)
addPermission_eventSourceToken :: Lens' AddPermission (Maybe Text)
addPermission_eventSourceToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Maybe Text
eventSourceToken :: Maybe Text
$sel:eventSourceToken:AddPermission' :: AddPermission -> Maybe Text
eventSourceToken} -> Maybe Text
eventSourceToken) (\s :: AddPermission
s@AddPermission' {} Maybe Text
a -> AddPermission
s {$sel:eventSourceToken:AddPermission' :: Maybe Text
eventSourceToken = Maybe Text
a} :: AddPermission)

-- | The type of authentication that your function URL uses. Set to @AWS_IAM@
-- if you want to restrict access to authenticated IAM users only. Set to
-- @NONE@ if you want to bypass IAM authentication to create a public
-- endpoint. For more information, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/urls-auth.html Security and auth model for Lambda function URLs>.
addPermission_functionUrlAuthType :: Lens.Lens' AddPermission (Prelude.Maybe FunctionUrlAuthType)
addPermission_functionUrlAuthType :: Lens' AddPermission (Maybe FunctionUrlAuthType)
addPermission_functionUrlAuthType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Maybe FunctionUrlAuthType
functionUrlAuthType :: Maybe FunctionUrlAuthType
$sel:functionUrlAuthType:AddPermission' :: AddPermission -> Maybe FunctionUrlAuthType
functionUrlAuthType} -> Maybe FunctionUrlAuthType
functionUrlAuthType) (\s :: AddPermission
s@AddPermission' {} Maybe FunctionUrlAuthType
a -> AddPermission
s {$sel:functionUrlAuthType:AddPermission' :: Maybe FunctionUrlAuthType
functionUrlAuthType = Maybe FunctionUrlAuthType
a} :: AddPermission)

-- | The identifier for your organization in Organizations. Use this to grant
-- permissions to all the Amazon Web Services accounts under this
-- organization.
addPermission_principalOrgID :: Lens.Lens' AddPermission (Prelude.Maybe Prelude.Text)
addPermission_principalOrgID :: Lens' AddPermission (Maybe Text)
addPermission_principalOrgID = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Maybe Text
principalOrgID :: Maybe Text
$sel:principalOrgID:AddPermission' :: AddPermission -> Maybe Text
principalOrgID} -> Maybe Text
principalOrgID) (\s :: AddPermission
s@AddPermission' {} Maybe Text
a -> AddPermission
s {$sel:principalOrgID:AddPermission' :: Maybe Text
principalOrgID = Maybe Text
a} :: AddPermission)

-- | Specify a version or alias to add permissions to a published version of
-- the function.
addPermission_qualifier :: Lens.Lens' AddPermission (Prelude.Maybe Prelude.Text)
addPermission_qualifier :: Lens' AddPermission (Maybe Text)
addPermission_qualifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Maybe Text
qualifier :: Maybe Text
$sel:qualifier:AddPermission' :: AddPermission -> Maybe Text
qualifier} -> Maybe Text
qualifier) (\s :: AddPermission
s@AddPermission' {} Maybe Text
a -> AddPermission
s {$sel:qualifier:AddPermission' :: Maybe Text
qualifier = Maybe Text
a} :: AddPermission)

-- | Update the policy only if the revision ID matches the ID that\'s
-- specified. Use this option to avoid modifying a policy that has changed
-- since you last read it.
addPermission_revisionId :: Lens.Lens' AddPermission (Prelude.Maybe Prelude.Text)
addPermission_revisionId :: Lens' AddPermission (Maybe Text)
addPermission_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Maybe Text
revisionId :: Maybe Text
$sel:revisionId:AddPermission' :: AddPermission -> Maybe Text
revisionId} -> Maybe Text
revisionId) (\s :: AddPermission
s@AddPermission' {} Maybe Text
a -> AddPermission
s {$sel:revisionId:AddPermission' :: Maybe Text
revisionId = Maybe Text
a} :: AddPermission)

-- | For Amazon Web Service, the ID of the Amazon Web Services account that
-- owns the resource. Use this together with @SourceArn@ to ensure that the
-- specified account owns the resource. It is possible for an Amazon S3
-- bucket to be deleted by its owner and recreated by another account.
addPermission_sourceAccount :: Lens.Lens' AddPermission (Prelude.Maybe Prelude.Text)
addPermission_sourceAccount :: Lens' AddPermission (Maybe Text)
addPermission_sourceAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Maybe Text
sourceAccount :: Maybe Text
$sel:sourceAccount:AddPermission' :: AddPermission -> Maybe Text
sourceAccount} -> Maybe Text
sourceAccount) (\s :: AddPermission
s@AddPermission' {} Maybe Text
a -> AddPermission
s {$sel:sourceAccount:AddPermission' :: Maybe Text
sourceAccount = Maybe Text
a} :: AddPermission)

-- | For Amazon Web Services, the ARN of the Amazon Web Services resource
-- that invokes the function. For example, an Amazon S3 bucket or Amazon
-- SNS topic.
--
-- Note that Lambda configures the comparison using the @StringLike@
-- operator.
addPermission_sourceArn :: Lens.Lens' AddPermission (Prelude.Maybe Prelude.Text)
addPermission_sourceArn :: Lens' AddPermission (Maybe Text)
addPermission_sourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Maybe Text
sourceArn :: Maybe Text
$sel:sourceArn:AddPermission' :: AddPermission -> Maybe Text
sourceArn} -> Maybe Text
sourceArn) (\s :: AddPermission
s@AddPermission' {} Maybe Text
a -> AddPermission
s {$sel:sourceArn:AddPermission' :: Maybe Text
sourceArn = Maybe Text
a} :: AddPermission)

-- | The name of the Lambda function, version, or alias.
--
-- __Name formats__
--
-- -   __Function name__ – @my-function@ (name-only), @my-function:v1@
--     (with alias).
--
-- -   __Function ARN__ –
--     @arn:aws:lambda:us-west-2:123456789012:function:my-function@.
--
-- -   __Partial ARN__ – @123456789012:function:my-function@.
--
-- You can append a version number or alias to any of the formats. The
-- length constraint applies only to the full ARN. If you specify only the
-- function name, it is limited to 64 characters in length.
addPermission_functionName :: Lens.Lens' AddPermission Prelude.Text
addPermission_functionName :: Lens' AddPermission Text
addPermission_functionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Text
functionName :: Text
$sel:functionName:AddPermission' :: AddPermission -> Text
functionName} -> Text
functionName) (\s :: AddPermission
s@AddPermission' {} Text
a -> AddPermission
s {$sel:functionName:AddPermission' :: Text
functionName = Text
a} :: AddPermission)

-- | A statement identifier that differentiates the statement from others in
-- the same policy.
addPermission_statementId :: Lens.Lens' AddPermission Prelude.Text
addPermission_statementId :: Lens' AddPermission Text
addPermission_statementId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Text
statementId :: Text
$sel:statementId:AddPermission' :: AddPermission -> Text
statementId} -> Text
statementId) (\s :: AddPermission
s@AddPermission' {} Text
a -> AddPermission
s {$sel:statementId:AddPermission' :: Text
statementId = Text
a} :: AddPermission)

-- | The action that the principal can use on the function. For example,
-- @lambda:InvokeFunction@ or @lambda:GetFunction@.
addPermission_action :: Lens.Lens' AddPermission Prelude.Text
addPermission_action :: Lens' AddPermission Text
addPermission_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Text
action :: Text
$sel:action:AddPermission' :: AddPermission -> Text
action} -> Text
action) (\s :: AddPermission
s@AddPermission' {} Text
a -> AddPermission
s {$sel:action:AddPermission' :: Text
action = Text
a} :: AddPermission)

-- | The Amazon Web Service or Amazon Web Services account that invokes the
-- function. If you specify a service, use @SourceArn@ or @SourceAccount@
-- to limit who can invoke the function through that service.
addPermission_principal :: Lens.Lens' AddPermission Prelude.Text
addPermission_principal :: Lens' AddPermission Text
addPermission_principal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermission' {Text
principal :: Text
$sel:principal:AddPermission' :: AddPermission -> Text
principal} -> Text
principal) (\s :: AddPermission
s@AddPermission' {} Text
a -> AddPermission
s {$sel:principal:AddPermission' :: Text
principal = Text
a} :: AddPermission)

instance Core.AWSRequest AddPermission where
  type
    AWSResponse AddPermission =
      AddPermissionResponse
  request :: (Service -> Service) -> AddPermission -> Request AddPermission
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (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 =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> AddPermissionResponse
AddPermissionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Statement")
            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 AddPermission where
  hashWithSalt :: Int -> AddPermission -> Int
hashWithSalt Int
_salt AddPermission' {Maybe Text
Maybe FunctionUrlAuthType
Text
principal :: Text
action :: Text
statementId :: Text
functionName :: Text
sourceArn :: Maybe Text
sourceAccount :: Maybe Text
revisionId :: Maybe Text
qualifier :: Maybe Text
principalOrgID :: Maybe Text
functionUrlAuthType :: Maybe FunctionUrlAuthType
eventSourceToken :: Maybe Text
$sel:principal:AddPermission' :: AddPermission -> Text
$sel:action:AddPermission' :: AddPermission -> Text
$sel:statementId:AddPermission' :: AddPermission -> Text
$sel:functionName:AddPermission' :: AddPermission -> Text
$sel:sourceArn:AddPermission' :: AddPermission -> Maybe Text
$sel:sourceAccount:AddPermission' :: AddPermission -> Maybe Text
$sel:revisionId:AddPermission' :: AddPermission -> Maybe Text
$sel:qualifier:AddPermission' :: AddPermission -> Maybe Text
$sel:principalOrgID:AddPermission' :: AddPermission -> Maybe Text
$sel:functionUrlAuthType:AddPermission' :: AddPermission -> Maybe FunctionUrlAuthType
$sel:eventSourceToken:AddPermission' :: AddPermission -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eventSourceToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FunctionUrlAuthType
functionUrlAuthType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
principalOrgID
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
qualifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
revisionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceAccount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
functionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
statementId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
principal

instance Prelude.NFData AddPermission where
  rnf :: AddPermission -> ()
rnf AddPermission' {Maybe Text
Maybe FunctionUrlAuthType
Text
principal :: Text
action :: Text
statementId :: Text
functionName :: Text
sourceArn :: Maybe Text
sourceAccount :: Maybe Text
revisionId :: Maybe Text
qualifier :: Maybe Text
principalOrgID :: Maybe Text
functionUrlAuthType :: Maybe FunctionUrlAuthType
eventSourceToken :: Maybe Text
$sel:principal:AddPermission' :: AddPermission -> Text
$sel:action:AddPermission' :: AddPermission -> Text
$sel:statementId:AddPermission' :: AddPermission -> Text
$sel:functionName:AddPermission' :: AddPermission -> Text
$sel:sourceArn:AddPermission' :: AddPermission -> Maybe Text
$sel:sourceAccount:AddPermission' :: AddPermission -> Maybe Text
$sel:revisionId:AddPermission' :: AddPermission -> Maybe Text
$sel:qualifier:AddPermission' :: AddPermission -> Maybe Text
$sel:principalOrgID:AddPermission' :: AddPermission -> Maybe Text
$sel:functionUrlAuthType:AddPermission' :: AddPermission -> Maybe FunctionUrlAuthType
$sel:eventSourceToken:AddPermission' :: AddPermission -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eventSourceToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FunctionUrlAuthType
functionUrlAuthType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
principalOrgID
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
qualifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
revisionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceAccount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
functionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
statementId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
principal

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

instance Data.ToJSON AddPermission where
  toJSON :: AddPermission -> Value
toJSON AddPermission' {Maybe Text
Maybe FunctionUrlAuthType
Text
principal :: Text
action :: Text
statementId :: Text
functionName :: Text
sourceArn :: Maybe Text
sourceAccount :: Maybe Text
revisionId :: Maybe Text
qualifier :: Maybe Text
principalOrgID :: Maybe Text
functionUrlAuthType :: Maybe FunctionUrlAuthType
eventSourceToken :: Maybe Text
$sel:principal:AddPermission' :: AddPermission -> Text
$sel:action:AddPermission' :: AddPermission -> Text
$sel:statementId:AddPermission' :: AddPermission -> Text
$sel:functionName:AddPermission' :: AddPermission -> Text
$sel:sourceArn:AddPermission' :: AddPermission -> Maybe Text
$sel:sourceAccount:AddPermission' :: AddPermission -> Maybe Text
$sel:revisionId:AddPermission' :: AddPermission -> Maybe Text
$sel:qualifier:AddPermission' :: AddPermission -> Maybe Text
$sel:principalOrgID:AddPermission' :: AddPermission -> Maybe Text
$sel:functionUrlAuthType:AddPermission' :: AddPermission -> Maybe FunctionUrlAuthType
$sel:eventSourceToken:AddPermission' :: AddPermission -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EventSourceToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
eventSourceToken,
            (Key
"FunctionUrlAuthType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe FunctionUrlAuthType
functionUrlAuthType,
            (Key
"PrincipalOrgID" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
principalOrgID,
            (Key
"RevisionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
revisionId,
            (Key
"SourceAccount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
sourceAccount,
            (Key
"SourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
sourceArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"StatementId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
statementId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Action" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
action),
            forall a. a -> Maybe a
Prelude.Just (Key
"Principal" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
principal)
          ]
      )

instance Data.ToPath AddPermission where
  toPath :: AddPermission -> ByteString
toPath AddPermission' {Maybe Text
Maybe FunctionUrlAuthType
Text
principal :: Text
action :: Text
statementId :: Text
functionName :: Text
sourceArn :: Maybe Text
sourceAccount :: Maybe Text
revisionId :: Maybe Text
qualifier :: Maybe Text
principalOrgID :: Maybe Text
functionUrlAuthType :: Maybe FunctionUrlAuthType
eventSourceToken :: Maybe Text
$sel:principal:AddPermission' :: AddPermission -> Text
$sel:action:AddPermission' :: AddPermission -> Text
$sel:statementId:AddPermission' :: AddPermission -> Text
$sel:functionName:AddPermission' :: AddPermission -> Text
$sel:sourceArn:AddPermission' :: AddPermission -> Maybe Text
$sel:sourceAccount:AddPermission' :: AddPermission -> Maybe Text
$sel:revisionId:AddPermission' :: AddPermission -> Maybe Text
$sel:qualifier:AddPermission' :: AddPermission -> Maybe Text
$sel:principalOrgID:AddPermission' :: AddPermission -> Maybe Text
$sel:functionUrlAuthType:AddPermission' :: AddPermission -> Maybe FunctionUrlAuthType
$sel:eventSourceToken:AddPermission' :: AddPermission -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2015-03-31/functions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
functionName,
        ByteString
"/policy"
      ]

instance Data.ToQuery AddPermission where
  toQuery :: AddPermission -> QueryString
toQuery AddPermission' {Maybe Text
Maybe FunctionUrlAuthType
Text
principal :: Text
action :: Text
statementId :: Text
functionName :: Text
sourceArn :: Maybe Text
sourceAccount :: Maybe Text
revisionId :: Maybe Text
qualifier :: Maybe Text
principalOrgID :: Maybe Text
functionUrlAuthType :: Maybe FunctionUrlAuthType
eventSourceToken :: Maybe Text
$sel:principal:AddPermission' :: AddPermission -> Text
$sel:action:AddPermission' :: AddPermission -> Text
$sel:statementId:AddPermission' :: AddPermission -> Text
$sel:functionName:AddPermission' :: AddPermission -> Text
$sel:sourceArn:AddPermission' :: AddPermission -> Maybe Text
$sel:sourceAccount:AddPermission' :: AddPermission -> Maybe Text
$sel:revisionId:AddPermission' :: AddPermission -> Maybe Text
$sel:qualifier:AddPermission' :: AddPermission -> Maybe Text
$sel:principalOrgID:AddPermission' :: AddPermission -> Maybe Text
$sel:functionUrlAuthType:AddPermission' :: AddPermission -> Maybe FunctionUrlAuthType
$sel:eventSourceToken:AddPermission' :: AddPermission -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"Qualifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
qualifier]

-- | /See:/ 'newAddPermissionResponse' smart constructor.
data AddPermissionResponse = AddPermissionResponse'
  { -- | The permission statement that\'s added to the function policy.
    AddPermissionResponse -> Maybe Text
statement :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    AddPermissionResponse -> Int
httpStatus :: Prelude.Int
  }
  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.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'statement', 'addPermissionResponse_statement' - The permission statement that\'s added to the function policy.
--
-- 'httpStatus', 'addPermissionResponse_httpStatus' - The response's http status code.
newAddPermissionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddPermissionResponse
newAddPermissionResponse :: Int -> AddPermissionResponse
newAddPermissionResponse Int
pHttpStatus_ =
  AddPermissionResponse'
    { $sel:statement:AddPermissionResponse' :: Maybe Text
statement = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddPermissionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The permission statement that\'s added to the function policy.
addPermissionResponse_statement :: Lens.Lens' AddPermissionResponse (Prelude.Maybe Prelude.Text)
addPermissionResponse_statement :: Lens' AddPermissionResponse (Maybe Text)
addPermissionResponse_statement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddPermissionResponse' {Maybe Text
statement :: Maybe Text
$sel:statement:AddPermissionResponse' :: AddPermissionResponse -> Maybe Text
statement} -> Maybe Text
statement) (\s :: AddPermissionResponse
s@AddPermissionResponse' {} Maybe Text
a -> AddPermissionResponse
s {$sel:statement:AddPermissionResponse' :: Maybe Text
statement = Maybe Text
a} :: AddPermissionResponse)

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

instance Prelude.NFData AddPermissionResponse where
  rnf :: AddPermissionResponse -> ()
rnf AddPermissionResponse' {Int
Maybe Text
httpStatus :: Int
statement :: Maybe Text
$sel:httpStatus:AddPermissionResponse' :: AddPermissionResponse -> Int
$sel:statement:AddPermissionResponse' :: AddPermissionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statement
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus