{-# 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.CodeGuruProfiler.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)
--
-- Adds permissions to a profiling group\'s resource-based policy that are
-- provided using an action group. If a profiling group doesn\'t have a
-- resource-based policy, one is created for it using the permissions in
-- the action group and the roles and users in the @principals@ parameter.
--
-- >  <p> The one supported action group that can be added is <code>agentPermission</code> which grants <code>ConfigureAgent</code> and <code>PostAgent</code> permissions. For more information, see <a href="https://docs.aws.amazon.com/codeguru/latest/profiler-ug/resource-based-policies.html">Resource-based policies in CodeGuru Profiler</a> in the <i>Amazon CodeGuru Profiler User Guide</i>, <a href="https://docs.aws.amazon.com/codeguru/latest/profiler-api/API_ConfigureAgent.html"> <code>ConfigureAgent</code> </a>, and <a href="https://docs.aws.amazon.com/codeguru/latest/profiler-api/API_PostAgentProfile.html"> <code>PostAgentProfile</code> </a>. </p> <p> The first time you call <code>PutPermission</code> on a profiling group, do not specify a <code>revisionId</code> because it doesn't have a resource-based policy. Subsequent calls must provide a <code>revisionId</code> to specify which revision of the resource-based policy to add the permissions to. </p> <p> The response contains the profiling group's JSON-formatted resource policy. </p>
module Amazonka.CodeGuruProfiler.PutPermission
  ( -- * Creating a Request
    PutPermission (..),
    newPutPermission,

    -- * Request Lenses
    putPermission_revisionId,
    putPermission_actionGroup,
    putPermission_principals,
    putPermission_profilingGroupName,

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

    -- * Response Lenses
    putPermissionResponse_httpStatus,
    putPermissionResponse_policy,
    putPermissionResponse_revisionId,
  )
where

import Amazonka.CodeGuruProfiler.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

-- | The structure representing the @putPermissionRequest@.
--
-- /See:/ 'newPutPermission' smart constructor.
data PutPermission = PutPermission'
  { -- | A universally unique identifier (UUID) for the revision of the policy
    -- you are adding to the profiling group. Do not specify this when you add
    -- permissions to a profiling group for the first time. If a policy already
    -- exists on the profiling group, you must specify the @revisionId@.
    PutPermission -> Maybe Text
revisionId :: Prelude.Maybe Prelude.Text,
    -- | Specifies an action group that contains permissions to add to a
    -- profiling group resource. One action group is supported,
    -- @agentPermissions@, which grants permission to perform actions required
    -- by the profiling agent, @ConfigureAgent@ and @PostAgentProfile@
    -- permissions.
    PutPermission -> ActionGroup
actionGroup :: ActionGroup,
    -- | A list ARNs for the roles and users you want to grant access to the
    -- profiling group. Wildcards are not are supported in the ARNs.
    PutPermission -> NonEmpty Text
principals :: Prelude.NonEmpty Prelude.Text,
    -- | The name of the profiling group to grant access to.
    PutPermission -> Text
profilingGroupName :: 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:
--
-- 'revisionId', 'putPermission_revisionId' - A universally unique identifier (UUID) for the revision of the policy
-- you are adding to the profiling group. Do not specify this when you add
-- permissions to a profiling group for the first time. If a policy already
-- exists on the profiling group, you must specify the @revisionId@.
--
-- 'actionGroup', 'putPermission_actionGroup' - Specifies an action group that contains permissions to add to a
-- profiling group resource. One action group is supported,
-- @agentPermissions@, which grants permission to perform actions required
-- by the profiling agent, @ConfigureAgent@ and @PostAgentProfile@
-- permissions.
--
-- 'principals', 'putPermission_principals' - A list ARNs for the roles and users you want to grant access to the
-- profiling group. Wildcards are not are supported in the ARNs.
--
-- 'profilingGroupName', 'putPermission_profilingGroupName' - The name of the profiling group to grant access to.
newPutPermission ::
  -- | 'actionGroup'
  ActionGroup ->
  -- | 'principals'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'profilingGroupName'
  Prelude.Text ->
  PutPermission
newPutPermission :: ActionGroup -> NonEmpty Text -> Text -> PutPermission
newPutPermission
  ActionGroup
pActionGroup_
  NonEmpty Text
pPrincipals_
  Text
pProfilingGroupName_ =
    PutPermission'
      { $sel:revisionId:PutPermission' :: Maybe Text
revisionId = forall a. Maybe a
Prelude.Nothing,
        $sel:actionGroup:PutPermission' :: ActionGroup
actionGroup = ActionGroup
pActionGroup_,
        $sel:principals:PutPermission' :: NonEmpty Text
principals = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pPrincipals_,
        $sel:profilingGroupName:PutPermission' :: Text
profilingGroupName = Text
pProfilingGroupName_
      }

-- | A universally unique identifier (UUID) for the revision of the policy
-- you are adding to the profiling group. Do not specify this when you add
-- permissions to a profiling group for the first time. If a policy already
-- exists on the profiling group, you must specify the @revisionId@.
putPermission_revisionId :: Lens.Lens' PutPermission (Prelude.Maybe Prelude.Text)
putPermission_revisionId :: Lens' PutPermission (Maybe Text)
putPermission_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermission' {Maybe Text
revisionId :: Maybe Text
$sel:revisionId:PutPermission' :: PutPermission -> Maybe Text
revisionId} -> Maybe Text
revisionId) (\s :: PutPermission
s@PutPermission' {} Maybe Text
a -> PutPermission
s {$sel:revisionId:PutPermission' :: Maybe Text
revisionId = Maybe Text
a} :: PutPermission)

-- | Specifies an action group that contains permissions to add to a
-- profiling group resource. One action group is supported,
-- @agentPermissions@, which grants permission to perform actions required
-- by the profiling agent, @ConfigureAgent@ and @PostAgentProfile@
-- permissions.
putPermission_actionGroup :: Lens.Lens' PutPermission ActionGroup
putPermission_actionGroup :: Lens' PutPermission ActionGroup
putPermission_actionGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermission' {ActionGroup
actionGroup :: ActionGroup
$sel:actionGroup:PutPermission' :: PutPermission -> ActionGroup
actionGroup} -> ActionGroup
actionGroup) (\s :: PutPermission
s@PutPermission' {} ActionGroup
a -> PutPermission
s {$sel:actionGroup:PutPermission' :: ActionGroup
actionGroup = ActionGroup
a} :: PutPermission)

-- | A list ARNs for the roles and users you want to grant access to the
-- profiling group. Wildcards are not are supported in the ARNs.
putPermission_principals :: Lens.Lens' PutPermission (Prelude.NonEmpty Prelude.Text)
putPermission_principals :: Lens' PutPermission (NonEmpty Text)
putPermission_principals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermission' {NonEmpty Text
principals :: NonEmpty Text
$sel:principals:PutPermission' :: PutPermission -> NonEmpty Text
principals} -> NonEmpty Text
principals) (\s :: PutPermission
s@PutPermission' {} NonEmpty Text
a -> PutPermission
s {$sel:principals:PutPermission' :: NonEmpty Text
principals = NonEmpty Text
a} :: PutPermission) 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 name of the profiling group to grant access to.
putPermission_profilingGroupName :: Lens.Lens' PutPermission Prelude.Text
putPermission_profilingGroupName :: Lens' PutPermission Text
putPermission_profilingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermission' {Text
profilingGroupName :: Text
$sel:profilingGroupName:PutPermission' :: PutPermission -> Text
profilingGroupName} -> Text
profilingGroupName) (\s :: PutPermission
s@PutPermission' {} Text
a -> PutPermission
s {$sel:profilingGroupName:PutPermission' :: Text
profilingGroupName = 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.putJSON (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 =>
(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 ->
          Int -> Text -> Text -> PutPermissionResponse
PutPermissionResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"policy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"revisionId")
      )

instance Prelude.Hashable PutPermission where
  hashWithSalt :: Int -> PutPermission -> Int
hashWithSalt Int
_salt PutPermission' {Maybe Text
NonEmpty Text
Text
ActionGroup
profilingGroupName :: Text
principals :: NonEmpty Text
actionGroup :: ActionGroup
revisionId :: Maybe Text
$sel:profilingGroupName:PutPermission' :: PutPermission -> Text
$sel:principals:PutPermission' :: PutPermission -> NonEmpty Text
$sel:actionGroup:PutPermission' :: PutPermission -> ActionGroup
$sel:revisionId:PutPermission' :: PutPermission -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
revisionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionGroup
actionGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
principals
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profilingGroupName

instance Prelude.NFData PutPermission where
  rnf :: PutPermission -> ()
rnf PutPermission' {Maybe Text
NonEmpty Text
Text
ActionGroup
profilingGroupName :: Text
principals :: NonEmpty Text
actionGroup :: ActionGroup
revisionId :: Maybe Text
$sel:profilingGroupName:PutPermission' :: PutPermission -> Text
$sel:principals:PutPermission' :: PutPermission -> NonEmpty Text
$sel:actionGroup:PutPermission' :: PutPermission -> ActionGroup
$sel:revisionId:PutPermission' :: PutPermission -> Maybe Text
..} =
    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 ActionGroup
actionGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
principals
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
profilingGroupName

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

instance Data.ToJSON PutPermission where
  toJSON :: PutPermission -> Value
toJSON PutPermission' {Maybe Text
NonEmpty Text
Text
ActionGroup
profilingGroupName :: Text
principals :: NonEmpty Text
actionGroup :: ActionGroup
revisionId :: Maybe Text
$sel:profilingGroupName:PutPermission' :: PutPermission -> Text
$sel:principals:PutPermission' :: PutPermission -> NonEmpty Text
$sel:actionGroup:PutPermission' :: PutPermission -> ActionGroup
$sel:revisionId:PutPermission' :: PutPermission -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"principals" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
principals)
          ]
      )

instance Data.ToPath PutPermission where
  toPath :: PutPermission -> ByteString
toPath PutPermission' {Maybe Text
NonEmpty Text
Text
ActionGroup
profilingGroupName :: Text
principals :: NonEmpty Text
actionGroup :: ActionGroup
revisionId :: Maybe Text
$sel:profilingGroupName:PutPermission' :: PutPermission -> Text
$sel:principals:PutPermission' :: PutPermission -> NonEmpty Text
$sel:actionGroup:PutPermission' :: PutPermission -> ActionGroup
$sel:revisionId:PutPermission' :: PutPermission -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/profilingGroups/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
profilingGroupName,
        ByteString
"/policy/",
        forall a. ToByteString a => a -> ByteString
Data.toBS ActionGroup
actionGroup
      ]

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

-- | The structure representing the @putPermissionResponse@.
--
-- /See:/ 'newPutPermissionResponse' smart constructor.
data PutPermissionResponse = PutPermissionResponse'
  { -- | The response's http status code.
    PutPermissionResponse -> Int
httpStatus :: Prelude.Int,
    -- | The JSON-formatted resource-based policy on the profiling group that
    -- includes the added permissions.
    PutPermissionResponse -> Text
policy :: Prelude.Text,
    -- | A universally unique identifier (UUID) for the revision of the
    -- resource-based policy that includes the added permissions. The
    -- JSON-formatted policy is in the @policy@ element of the response.
    PutPermissionResponse -> Text
revisionId :: Prelude.Text
  }
  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.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'putPermissionResponse_httpStatus' - The response's http status code.
--
-- 'policy', 'putPermissionResponse_policy' - The JSON-formatted resource-based policy on the profiling group that
-- includes the added permissions.
--
-- 'revisionId', 'putPermissionResponse_revisionId' - A universally unique identifier (UUID) for the revision of the
-- resource-based policy that includes the added permissions. The
-- JSON-formatted policy is in the @policy@ element of the response.
newPutPermissionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'policy'
  Prelude.Text ->
  -- | 'revisionId'
  Prelude.Text ->
  PutPermissionResponse
newPutPermissionResponse :: Int -> Text -> Text -> PutPermissionResponse
newPutPermissionResponse
  Int
pHttpStatus_
  Text
pPolicy_
  Text
pRevisionId_ =
    PutPermissionResponse'
      { $sel:httpStatus:PutPermissionResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:policy:PutPermissionResponse' :: Text
policy = Text
pPolicy_,
        $sel:revisionId:PutPermissionResponse' :: Text
revisionId = Text
pRevisionId_
      }

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

-- | The JSON-formatted resource-based policy on the profiling group that
-- includes the added permissions.
putPermissionResponse_policy :: Lens.Lens' PutPermissionResponse Prelude.Text
putPermissionResponse_policy :: Lens' PutPermissionResponse Text
putPermissionResponse_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermissionResponse' {Text
policy :: Text
$sel:policy:PutPermissionResponse' :: PutPermissionResponse -> Text
policy} -> Text
policy) (\s :: PutPermissionResponse
s@PutPermissionResponse' {} Text
a -> PutPermissionResponse
s {$sel:policy:PutPermissionResponse' :: Text
policy = Text
a} :: PutPermissionResponse)

-- | A universally unique identifier (UUID) for the revision of the
-- resource-based policy that includes the added permissions. The
-- JSON-formatted policy is in the @policy@ element of the response.
putPermissionResponse_revisionId :: Lens.Lens' PutPermissionResponse Prelude.Text
putPermissionResponse_revisionId :: Lens' PutPermissionResponse Text
putPermissionResponse_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutPermissionResponse' {Text
revisionId :: Text
$sel:revisionId:PutPermissionResponse' :: PutPermissionResponse -> Text
revisionId} -> Text
revisionId) (\s :: PutPermissionResponse
s@PutPermissionResponse' {} Text
a -> PutPermissionResponse
s {$sel:revisionId:PutPermissionResponse' :: Text
revisionId = Text
a} :: PutPermissionResponse)

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