{-# 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.CloudWatchEvents.PutPermission
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Running @PutPermission@ permits the specified Amazon Web Services
-- account or Amazon Web Services organization to put events to the
-- specified /event bus/. Amazon EventBridge (CloudWatch Events) rules in
-- your account are triggered by these events arriving to an event bus in
-- your account.
--
-- For another account to send events to your account, that external
-- account must have an EventBridge rule with your account\'s event bus as
-- a target.
--
-- To enable multiple Amazon Web Services accounts to put events to your
-- event bus, run @PutPermission@ once for each of these accounts. Or, if
-- all the accounts are members of the same Amazon Web Services
-- organization, you can run @PutPermission@ once specifying @Principal@ as
-- \"*\" and specifying the Amazon Web Services organization ID in
-- @Condition@, to grant permissions to all accounts in that organization.
--
-- If you grant permissions using an organization, then accounts in that
-- organization must specify a @RoleArn@ with proper permissions when they
-- use @PutTarget@ to add your account\'s event bus as a target. For more
-- information, see
-- <https://docs.aws.amazon.com/eventbridge/latest/userguide/eventbridge-cross-account-event-delivery.html Sending and Receiving Events Between Amazon Web Services Accounts>
-- in the /Amazon EventBridge User Guide/.
--
-- The permission policy on the event bus cannot exceed 10 KB in size.
module Amazonka.CloudWatchEvents.PutPermission
  ( -- * Creating a Request
    PutPermission (..),
    newPutPermission,

    -- * Request Lenses
    putPermission_action,
    putPermission_condition,
    putPermission_eventBusName,
    putPermission_policy,
    putPermission_principal,
    putPermission_statementId,

    -- * Destructuring the Response
    PutPermissionResponse (..),
    newPutPermissionResponse,
  )
where

import Amazonka.CloudWatchEvents.Types
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

-- | /See:/ 'newPutPermission' smart constructor.
data PutPermission = PutPermission'
  { -- | The action that you are enabling the other account to perform.
    PutPermission -> Maybe Text
action :: Prelude.Maybe Prelude.Text,
    -- | This parameter enables you to limit the permission to accounts that
    -- fulfill a certain condition, such as being a member of a certain Amazon
    -- Web Services organization. For more information about Amazon Web
    -- Services Organizations, see
    -- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_introduction.html What Is Amazon Web Services Organizations>
    -- in the /Amazon Web Services Organizations User Guide/.
    --
    -- If you specify @Condition@ with an Amazon Web Services organization ID,
    -- and specify \"*\" as the value for @Principal@, you grant permission to
    -- all the accounts in the named organization.
    --
    -- The @Condition@ is a JSON string which must contain @Type@, @Key@, and
    -- @Value@ fields.
    PutPermission -> Maybe Condition
condition :: Prelude.Maybe Condition,
    -- | The name of the event bus associated with the rule. If you omit this,
    -- the default event bus is used.
    PutPermission -> Maybe Text
eventBusName :: Prelude.Maybe Prelude.Text,
    -- | A JSON string that describes the permission policy statement. You can
    -- include a @Policy@ parameter in the request instead of using the
    -- @StatementId@, @Action@, @Principal@, or @Condition@ parameters.
    PutPermission -> Maybe Text
policy :: Prelude.Maybe Prelude.Text,
    -- | The 12-digit Amazon Web Services account ID that you are permitting to
    -- put events to your default event bus. Specify \"*\" to permit any
    -- account to put events to your default event bus.
    --
    -- If you specify \"*\" without specifying @Condition@, avoid creating
    -- rules that may match undesirable events. To create more secure rules,
    -- make sure that the event pattern for each rule contains an @account@
    -- field with a specific account ID from which to receive events. Rules
    -- with an account field do not match any events sent from other accounts.
    PutPermission -> Maybe Text
principal :: Prelude.Maybe Prelude.Text,
    -- | An identifier string for the external account that you are granting
    -- permissions to. If you later want to revoke the permission for this
    -- external account, specify this @StatementId@ when you run
    -- <https://docs.aws.amazon.com/eventbridge/latest/APIReference/API_RemovePermission.html RemovePermission>.
    --
    -- Each @StatementId@ must be unique.
    PutPermission -> Maybe Text
statementId :: Prelude.Maybe Prelude.Text
  }
  deriving (PutPermission -> PutPermission -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutPermission -> PutPermission -> Bool
$c/= :: PutPermission -> PutPermission -> Bool
== :: PutPermission -> PutPermission -> Bool
$c== :: PutPermission -> PutPermission -> Bool
Prelude.Eq, ReadPrec [PutPermission]
ReadPrec PutPermission
Int -> ReadS PutPermission
ReadS [PutPermission]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutPermission]
$creadListPrec :: ReadPrec [PutPermission]
readPrec :: ReadPrec PutPermission
$creadPrec :: ReadPrec PutPermission
readList :: ReadS [PutPermission]
$creadList :: ReadS [PutPermission]
readsPrec :: Int -> ReadS PutPermission
$creadsPrec :: Int -> ReadS PutPermission
Prelude.Read, Int -> PutPermission -> ShowS
[PutPermission] -> ShowS
PutPermission -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutPermission] -> ShowS
$cshowList :: [PutPermission] -> ShowS
show :: PutPermission -> String
$cshow :: PutPermission -> String
showsPrec :: Int -> PutPermission -> ShowS
$cshowsPrec :: Int -> PutPermission -> ShowS
Prelude.Show, forall x. Rep PutPermission x -> PutPermission
forall x. PutPermission -> Rep PutPermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutPermission x -> PutPermission
$cfrom :: forall x. PutPermission -> Rep PutPermission x
Prelude.Generic)

-- |
-- Create a value of 'PutPermission' 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:
--
-- 'action', 'putPermission_action' - The action that you are enabling the other account to perform.
--
-- 'condition', 'putPermission_condition' - This parameter enables you to limit the permission to accounts that
-- fulfill a certain condition, such as being a member of a certain Amazon
-- Web Services organization. For more information about Amazon Web
-- Services Organizations, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_introduction.html What Is Amazon Web Services Organizations>
-- in the /Amazon Web Services Organizations User Guide/.
--
-- If you specify @Condition@ with an Amazon Web Services organization ID,
-- and specify \"*\" as the value for @Principal@, you grant permission to
-- all the accounts in the named organization.
--
-- The @Condition@ is a JSON string which must contain @Type@, @Key@, and
-- @Value@ fields.
--
-- 'eventBusName', 'putPermission_eventBusName' - The name of the event bus associated with the rule. If you omit this,
-- the default event bus is used.
--
-- 'policy', 'putPermission_policy' - A JSON string that describes the permission policy statement. You can
-- include a @Policy@ parameter in the request instead of using the
-- @StatementId@, @Action@, @Principal@, or @Condition@ parameters.
--
-- 'principal', 'putPermission_principal' - The 12-digit Amazon Web Services account ID that you are permitting to
-- put events to your default event bus. Specify \"*\" to permit any
-- account to put events to your default event bus.
--
-- If you specify \"*\" without specifying @Condition@, avoid creating
-- rules that may match undesirable events. To create more secure rules,
-- make sure that the event pattern for each rule contains an @account@
-- field with a specific account ID from which to receive events. Rules
-- with an account field do not match any events sent from other accounts.
--
-- 'statementId', 'putPermission_statementId' - An identifier string for the external account that you are granting
-- permissions to. If you later want to revoke the permission for this
-- external account, specify this @StatementId@ when you run
-- <https://docs.aws.amazon.com/eventbridge/latest/APIReference/API_RemovePermission.html RemovePermission>.
--
-- Each @StatementId@ must be unique.
newPutPermission ::
  PutPermission
newPutPermission :: PutPermission
newPutPermission =
  PutPermission'
    { $sel:action:PutPermission' :: Maybe Text
action = forall a. Maybe a
Prelude.Nothing,
      $sel:condition:PutPermission' :: Maybe Condition
condition = forall a. Maybe a
Prelude.Nothing,
      $sel:eventBusName:PutPermission' :: Maybe Text
eventBusName = forall a. Maybe a
Prelude.Nothing,
      $sel:policy:PutPermission' :: Maybe Text
policy = forall a. Maybe a
Prelude.Nothing,
      $sel:principal:PutPermission' :: Maybe Text
principal = forall a. Maybe a
Prelude.Nothing,
      $sel:statementId:PutPermission' :: Maybe Text
statementId = forall a. Maybe a
Prelude.Nothing
    }

-- | The action that you are enabling the other account to perform.
putPermission_action :: Lens.Lens' PutPermission (Prelude.Maybe Prelude.Text)
putPermission_action :: Lens' PutPermission (Maybe Text)
putPermission_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermission' {Maybe Text
action :: Maybe Text
$sel:action:PutPermission' :: PutPermission -> Maybe Text
action} -> Maybe Text
action) (\s :: PutPermission
s@PutPermission' {} Maybe Text
a -> PutPermission
s {$sel:action:PutPermission' :: Maybe Text
action = Maybe Text
a} :: PutPermission)

-- | This parameter enables you to limit the permission to accounts that
-- fulfill a certain condition, such as being a member of a certain Amazon
-- Web Services organization. For more information about Amazon Web
-- Services Organizations, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_introduction.html What Is Amazon Web Services Organizations>
-- in the /Amazon Web Services Organizations User Guide/.
--
-- If you specify @Condition@ with an Amazon Web Services organization ID,
-- and specify \"*\" as the value for @Principal@, you grant permission to
-- all the accounts in the named organization.
--
-- The @Condition@ is a JSON string which must contain @Type@, @Key@, and
-- @Value@ fields.
putPermission_condition :: Lens.Lens' PutPermission (Prelude.Maybe Condition)
putPermission_condition :: Lens' PutPermission (Maybe Condition)
putPermission_condition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermission' {Maybe Condition
condition :: Maybe Condition
$sel:condition:PutPermission' :: PutPermission -> Maybe Condition
condition} -> Maybe Condition
condition) (\s :: PutPermission
s@PutPermission' {} Maybe Condition
a -> PutPermission
s {$sel:condition:PutPermission' :: Maybe Condition
condition = Maybe Condition
a} :: PutPermission)

-- | The name of the event bus associated with the rule. If you omit this,
-- the default event bus is used.
putPermission_eventBusName :: Lens.Lens' PutPermission (Prelude.Maybe Prelude.Text)
putPermission_eventBusName :: Lens' PutPermission (Maybe Text)
putPermission_eventBusName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermission' {Maybe Text
eventBusName :: Maybe Text
$sel:eventBusName:PutPermission' :: PutPermission -> Maybe Text
eventBusName} -> Maybe Text
eventBusName) (\s :: PutPermission
s@PutPermission' {} Maybe Text
a -> PutPermission
s {$sel:eventBusName:PutPermission' :: Maybe Text
eventBusName = Maybe Text
a} :: PutPermission)

-- | A JSON string that describes the permission policy statement. You can
-- include a @Policy@ parameter in the request instead of using the
-- @StatementId@, @Action@, @Principal@, or @Condition@ parameters.
putPermission_policy :: Lens.Lens' PutPermission (Prelude.Maybe Prelude.Text)
putPermission_policy :: Lens' PutPermission (Maybe Text)
putPermission_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermission' {Maybe Text
policy :: Maybe Text
$sel:policy:PutPermission' :: PutPermission -> Maybe Text
policy} -> Maybe Text
policy) (\s :: PutPermission
s@PutPermission' {} Maybe Text
a -> PutPermission
s {$sel:policy:PutPermission' :: Maybe Text
policy = Maybe Text
a} :: PutPermission)

-- | The 12-digit Amazon Web Services account ID that you are permitting to
-- put events to your default event bus. Specify \"*\" to permit any
-- account to put events to your default event bus.
--
-- If you specify \"*\" without specifying @Condition@, avoid creating
-- rules that may match undesirable events. To create more secure rules,
-- make sure that the event pattern for each rule contains an @account@
-- field with a specific account ID from which to receive events. Rules
-- with an account field do not match any events sent from other accounts.
putPermission_principal :: Lens.Lens' PutPermission (Prelude.Maybe Prelude.Text)
putPermission_principal :: Lens' PutPermission (Maybe Text)
putPermission_principal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermission' {Maybe Text
principal :: Maybe Text
$sel:principal:PutPermission' :: PutPermission -> Maybe Text
principal} -> Maybe Text
principal) (\s :: PutPermission
s@PutPermission' {} Maybe Text
a -> PutPermission
s {$sel:principal:PutPermission' :: Maybe Text
principal = Maybe Text
a} :: PutPermission)

-- | An identifier string for the external account that you are granting
-- permissions to. If you later want to revoke the permission for this
-- external account, specify this @StatementId@ when you run
-- <https://docs.aws.amazon.com/eventbridge/latest/APIReference/API_RemovePermission.html RemovePermission>.
--
-- Each @StatementId@ must be unique.
putPermission_statementId :: Lens.Lens' PutPermission (Prelude.Maybe Prelude.Text)
putPermission_statementId :: Lens' PutPermission (Maybe Text)
putPermission_statementId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermission' {Maybe Text
statementId :: Maybe Text
$sel:statementId:PutPermission' :: PutPermission -> Maybe Text
statementId} -> Maybe Text
statementId) (\s :: PutPermission
s@PutPermission' {} Maybe Text
a -> PutPermission
s {$sel:statementId:PutPermission' :: Maybe Text
statementId = Maybe Text
a} :: PutPermission)

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

instance Prelude.Hashable PutPermission where
  hashWithSalt :: Int -> PutPermission -> Int
hashWithSalt Int
_salt PutPermission' {Maybe Text
Maybe Condition
statementId :: Maybe Text
principal :: Maybe Text
policy :: Maybe Text
eventBusName :: Maybe Text
condition :: Maybe Condition
action :: Maybe Text
$sel:statementId:PutPermission' :: PutPermission -> Maybe Text
$sel:principal:PutPermission' :: PutPermission -> Maybe Text
$sel:policy:PutPermission' :: PutPermission -> Maybe Text
$sel:eventBusName:PutPermission' :: PutPermission -> Maybe Text
$sel:condition:PutPermission' :: PutPermission -> Maybe Condition
$sel:action:PutPermission' :: PutPermission -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Condition
condition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
eventBusName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
policy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
principal
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statementId

instance Prelude.NFData PutPermission where
  rnf :: PutPermission -> ()
rnf PutPermission' {Maybe Text
Maybe Condition
statementId :: Maybe Text
principal :: Maybe Text
policy :: Maybe Text
eventBusName :: Maybe Text
condition :: Maybe Condition
action :: Maybe Text
$sel:statementId:PutPermission' :: PutPermission -> Maybe Text
$sel:principal:PutPermission' :: PutPermission -> Maybe Text
$sel:policy:PutPermission' :: PutPermission -> Maybe Text
$sel:eventBusName:PutPermission' :: PutPermission -> Maybe Text
$sel:condition:PutPermission' :: PutPermission -> Maybe Condition
$sel:action:PutPermission' :: PutPermission -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Condition
condition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eventBusName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
principal
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statementId

instance Data.ToHeaders PutPermission where
  toHeaders :: PutPermission -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# (ByteString
"AWSEvents.PutPermission" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutPermission where
  toJSON :: PutPermission -> Value
toJSON PutPermission' {Maybe Text
Maybe Condition
statementId :: Maybe Text
principal :: Maybe Text
policy :: Maybe Text
eventBusName :: Maybe Text
condition :: Maybe Condition
action :: Maybe Text
$sel:statementId:PutPermission' :: PutPermission -> Maybe Text
$sel:principal:PutPermission' :: PutPermission -> Maybe Text
$sel:policy:PutPermission' :: PutPermission -> Maybe Text
$sel:eventBusName:PutPermission' :: PutPermission -> Maybe Text
$sel:condition:PutPermission' :: PutPermission -> Maybe Condition
$sel:action:PutPermission' :: PutPermission -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Action" 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
action,
            (Key
"Condition" 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 Condition
condition,
            (Key
"EventBusName" 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
eventBusName,
            (Key
"Policy" 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
policy,
            (Key
"Principal" 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
principal,
            (Key
"StatementId" 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
statementId
          ]
      )

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

instance Data.ToQuery PutPermission where
  toQuery :: PutPermission -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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