{-# 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.Signer.AddProfilePermission
-- 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 cross-account permissions to a signing profile.
module Amazonka.Signer.AddProfilePermission
  ( -- * Creating a Request
    AddProfilePermission (..),
    newAddProfilePermission,

    -- * Request Lenses
    addProfilePermission_profileVersion,
    addProfilePermission_revisionId,
    addProfilePermission_action,
    addProfilePermission_principal,
    addProfilePermission_statementId,
    addProfilePermission_profileName,

    -- * Destructuring the Response
    AddProfilePermissionResponse (..),
    newAddProfilePermissionResponse,

    -- * Response Lenses
    addProfilePermissionResponse_revisionId,
    addProfilePermissionResponse_httpStatus,
  )
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.Signer.Types

-- | /See:/ 'newAddProfilePermission' smart constructor.
data AddProfilePermission = AddProfilePermission'
  { -- | The version of the signing profile.
    AddProfilePermission -> Maybe Text
profileVersion :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the current profile revision.
    AddProfilePermission -> Maybe Text
revisionId :: Prelude.Maybe Prelude.Text,
    -- | The AWS Signer action permitted as part of cross-account permissions.
    AddProfilePermission -> Text
action :: Prelude.Text,
    -- | The AWS principal receiving cross-account permissions. This may be an
    -- IAM role or another AWS account ID.
    AddProfilePermission -> Text
principal :: Prelude.Text,
    -- | A unique identifier for the cross-account permission statement.
    AddProfilePermission -> Text
statementId :: Prelude.Text,
    -- | The human-readable name of the signing profile.
    AddProfilePermission -> Text
profileName :: Prelude.Text
  }
  deriving (AddProfilePermission -> AddProfilePermission -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddProfilePermission -> AddProfilePermission -> Bool
$c/= :: AddProfilePermission -> AddProfilePermission -> Bool
== :: AddProfilePermission -> AddProfilePermission -> Bool
$c== :: AddProfilePermission -> AddProfilePermission -> Bool
Prelude.Eq, ReadPrec [AddProfilePermission]
ReadPrec AddProfilePermission
Int -> ReadS AddProfilePermission
ReadS [AddProfilePermission]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddProfilePermission]
$creadListPrec :: ReadPrec [AddProfilePermission]
readPrec :: ReadPrec AddProfilePermission
$creadPrec :: ReadPrec AddProfilePermission
readList :: ReadS [AddProfilePermission]
$creadList :: ReadS [AddProfilePermission]
readsPrec :: Int -> ReadS AddProfilePermission
$creadsPrec :: Int -> ReadS AddProfilePermission
Prelude.Read, Int -> AddProfilePermission -> ShowS
[AddProfilePermission] -> ShowS
AddProfilePermission -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddProfilePermission] -> ShowS
$cshowList :: [AddProfilePermission] -> ShowS
show :: AddProfilePermission -> String
$cshow :: AddProfilePermission -> String
showsPrec :: Int -> AddProfilePermission -> ShowS
$cshowsPrec :: Int -> AddProfilePermission -> ShowS
Prelude.Show, forall x. Rep AddProfilePermission x -> AddProfilePermission
forall x. AddProfilePermission -> Rep AddProfilePermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddProfilePermission x -> AddProfilePermission
$cfrom :: forall x. AddProfilePermission -> Rep AddProfilePermission x
Prelude.Generic)

-- |
-- Create a value of 'AddProfilePermission' 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:
--
-- 'profileVersion', 'addProfilePermission_profileVersion' - The version of the signing profile.
--
-- 'revisionId', 'addProfilePermission_revisionId' - A unique identifier for the current profile revision.
--
-- 'action', 'addProfilePermission_action' - The AWS Signer action permitted as part of cross-account permissions.
--
-- 'principal', 'addProfilePermission_principal' - The AWS principal receiving cross-account permissions. This may be an
-- IAM role or another AWS account ID.
--
-- 'statementId', 'addProfilePermission_statementId' - A unique identifier for the cross-account permission statement.
--
-- 'profileName', 'addProfilePermission_profileName' - The human-readable name of the signing profile.
newAddProfilePermission ::
  -- | 'action'
  Prelude.Text ->
  -- | 'principal'
  Prelude.Text ->
  -- | 'statementId'
  Prelude.Text ->
  -- | 'profileName'
  Prelude.Text ->
  AddProfilePermission
newAddProfilePermission :: Text -> Text -> Text -> Text -> AddProfilePermission
newAddProfilePermission
  Text
pAction_
  Text
pPrincipal_
  Text
pStatementId_
  Text
pProfileName_ =
    AddProfilePermission'
      { $sel:profileVersion:AddProfilePermission' :: Maybe Text
profileVersion =
          forall a. Maybe a
Prelude.Nothing,
        $sel:revisionId:AddProfilePermission' :: Maybe Text
revisionId = forall a. Maybe a
Prelude.Nothing,
        $sel:action:AddProfilePermission' :: Text
action = Text
pAction_,
        $sel:principal:AddProfilePermission' :: Text
principal = Text
pPrincipal_,
        $sel:statementId:AddProfilePermission' :: Text
statementId = Text
pStatementId_,
        $sel:profileName:AddProfilePermission' :: Text
profileName = Text
pProfileName_
      }

-- | The version of the signing profile.
addProfilePermission_profileVersion :: Lens.Lens' AddProfilePermission (Prelude.Maybe Prelude.Text)
addProfilePermission_profileVersion :: Lens' AddProfilePermission (Maybe Text)
addProfilePermission_profileVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfilePermission' {Maybe Text
profileVersion :: Maybe Text
$sel:profileVersion:AddProfilePermission' :: AddProfilePermission -> Maybe Text
profileVersion} -> Maybe Text
profileVersion) (\s :: AddProfilePermission
s@AddProfilePermission' {} Maybe Text
a -> AddProfilePermission
s {$sel:profileVersion:AddProfilePermission' :: Maybe Text
profileVersion = Maybe Text
a} :: AddProfilePermission)

-- | A unique identifier for the current profile revision.
addProfilePermission_revisionId :: Lens.Lens' AddProfilePermission (Prelude.Maybe Prelude.Text)
addProfilePermission_revisionId :: Lens' AddProfilePermission (Maybe Text)
addProfilePermission_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfilePermission' {Maybe Text
revisionId :: Maybe Text
$sel:revisionId:AddProfilePermission' :: AddProfilePermission -> Maybe Text
revisionId} -> Maybe Text
revisionId) (\s :: AddProfilePermission
s@AddProfilePermission' {} Maybe Text
a -> AddProfilePermission
s {$sel:revisionId:AddProfilePermission' :: Maybe Text
revisionId = Maybe Text
a} :: AddProfilePermission)

-- | The AWS Signer action permitted as part of cross-account permissions.
addProfilePermission_action :: Lens.Lens' AddProfilePermission Prelude.Text
addProfilePermission_action :: Lens' AddProfilePermission Text
addProfilePermission_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfilePermission' {Text
action :: Text
$sel:action:AddProfilePermission' :: AddProfilePermission -> Text
action} -> Text
action) (\s :: AddProfilePermission
s@AddProfilePermission' {} Text
a -> AddProfilePermission
s {$sel:action:AddProfilePermission' :: Text
action = Text
a} :: AddProfilePermission)

-- | The AWS principal receiving cross-account permissions. This may be an
-- IAM role or another AWS account ID.
addProfilePermission_principal :: Lens.Lens' AddProfilePermission Prelude.Text
addProfilePermission_principal :: Lens' AddProfilePermission Text
addProfilePermission_principal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfilePermission' {Text
principal :: Text
$sel:principal:AddProfilePermission' :: AddProfilePermission -> Text
principal} -> Text
principal) (\s :: AddProfilePermission
s@AddProfilePermission' {} Text
a -> AddProfilePermission
s {$sel:principal:AddProfilePermission' :: Text
principal = Text
a} :: AddProfilePermission)

-- | A unique identifier for the cross-account permission statement.
addProfilePermission_statementId :: Lens.Lens' AddProfilePermission Prelude.Text
addProfilePermission_statementId :: Lens' AddProfilePermission Text
addProfilePermission_statementId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfilePermission' {Text
statementId :: Text
$sel:statementId:AddProfilePermission' :: AddProfilePermission -> Text
statementId} -> Text
statementId) (\s :: AddProfilePermission
s@AddProfilePermission' {} Text
a -> AddProfilePermission
s {$sel:statementId:AddProfilePermission' :: Text
statementId = Text
a} :: AddProfilePermission)

-- | The human-readable name of the signing profile.
addProfilePermission_profileName :: Lens.Lens' AddProfilePermission Prelude.Text
addProfilePermission_profileName :: Lens' AddProfilePermission Text
addProfilePermission_profileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfilePermission' {Text
profileName :: Text
$sel:profileName:AddProfilePermission' :: AddProfilePermission -> Text
profileName} -> Text
profileName) (\s :: AddProfilePermission
s@AddProfilePermission' {} Text
a -> AddProfilePermission
s {$sel:profileName:AddProfilePermission' :: Text
profileName = Text
a} :: AddProfilePermission)

instance Core.AWSRequest AddProfilePermission where
  type
    AWSResponse AddProfilePermission =
      AddProfilePermissionResponse
  request :: (Service -> Service)
-> AddProfilePermission -> Request AddProfilePermission
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 AddProfilePermission
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddProfilePermission)))
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 -> AddProfilePermissionResponse
AddProfilePermissionResponse'
            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
"revisionId")
            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 AddProfilePermission where
  hashWithSalt :: Int -> AddProfilePermission -> Int
hashWithSalt Int
_salt AddProfilePermission' {Maybe Text
Text
profileName :: Text
statementId :: Text
principal :: Text
action :: Text
revisionId :: Maybe Text
profileVersion :: Maybe Text
$sel:profileName:AddProfilePermission' :: AddProfilePermission -> Text
$sel:statementId:AddProfilePermission' :: AddProfilePermission -> Text
$sel:principal:AddProfilePermission' :: AddProfilePermission -> Text
$sel:action:AddProfilePermission' :: AddProfilePermission -> Text
$sel:revisionId:AddProfilePermission' :: AddProfilePermission -> Maybe Text
$sel:profileVersion:AddProfilePermission' :: AddProfilePermission -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
profileVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
revisionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
principal
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
statementId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profileName

instance Prelude.NFData AddProfilePermission where
  rnf :: AddProfilePermission -> ()
rnf AddProfilePermission' {Maybe Text
Text
profileName :: Text
statementId :: Text
principal :: Text
action :: Text
revisionId :: Maybe Text
profileVersion :: Maybe Text
$sel:profileName:AddProfilePermission' :: AddProfilePermission -> Text
$sel:statementId:AddProfilePermission' :: AddProfilePermission -> Text
$sel:principal:AddProfilePermission' :: AddProfilePermission -> Text
$sel:action:AddProfilePermission' :: AddProfilePermission -> Text
$sel:revisionId:AddProfilePermission' :: AddProfilePermission -> Maybe Text
$sel:profileVersion:AddProfilePermission' :: AddProfilePermission -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
profileVersion
      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 Text
action
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
principal
      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
profileName

instance Data.ToHeaders AddProfilePermission where
  toHeaders :: AddProfilePermission -> 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 AddProfilePermission where
  toJSON :: AddProfilePermission -> Value
toJSON AddProfilePermission' {Maybe Text
Text
profileName :: Text
statementId :: Text
principal :: Text
action :: Text
revisionId :: Maybe Text
profileVersion :: Maybe Text
$sel:profileName:AddProfilePermission' :: AddProfilePermission -> Text
$sel:statementId:AddProfilePermission' :: AddProfilePermission -> Text
$sel:principal:AddProfilePermission' :: AddProfilePermission -> Text
$sel:action:AddProfilePermission' :: AddProfilePermission -> Text
$sel:revisionId:AddProfilePermission' :: AddProfilePermission -> Maybe Text
$sel:profileVersion:AddProfilePermission' :: AddProfilePermission -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"profileVersion" 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
profileVersion,
            (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
"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),
            forall a. a -> Maybe a
Prelude.Just (Key
"statementId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
statementId)
          ]
      )

instance Data.ToPath AddProfilePermission where
  toPath :: AddProfilePermission -> ByteString
toPath AddProfilePermission' {Maybe Text
Text
profileName :: Text
statementId :: Text
principal :: Text
action :: Text
revisionId :: Maybe Text
profileVersion :: Maybe Text
$sel:profileName:AddProfilePermission' :: AddProfilePermission -> Text
$sel:statementId:AddProfilePermission' :: AddProfilePermission -> Text
$sel:principal:AddProfilePermission' :: AddProfilePermission -> Text
$sel:action:AddProfilePermission' :: AddProfilePermission -> Text
$sel:revisionId:AddProfilePermission' :: AddProfilePermission -> Maybe Text
$sel:profileVersion:AddProfilePermission' :: AddProfilePermission -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/signing-profiles/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
profileName,
        ByteString
"/permissions"
      ]

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

-- | /See:/ 'newAddProfilePermissionResponse' smart constructor.
data AddProfilePermissionResponse = AddProfilePermissionResponse'
  { -- | A unique identifier for the current profile revision.
    AddProfilePermissionResponse -> Maybe Text
revisionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    AddProfilePermissionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AddProfilePermissionResponse
-> AddProfilePermissionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddProfilePermissionResponse
-> AddProfilePermissionResponse -> Bool
$c/= :: AddProfilePermissionResponse
-> AddProfilePermissionResponse -> Bool
== :: AddProfilePermissionResponse
-> AddProfilePermissionResponse -> Bool
$c== :: AddProfilePermissionResponse
-> AddProfilePermissionResponse -> Bool
Prelude.Eq, ReadPrec [AddProfilePermissionResponse]
ReadPrec AddProfilePermissionResponse
Int -> ReadS AddProfilePermissionResponse
ReadS [AddProfilePermissionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddProfilePermissionResponse]
$creadListPrec :: ReadPrec [AddProfilePermissionResponse]
readPrec :: ReadPrec AddProfilePermissionResponse
$creadPrec :: ReadPrec AddProfilePermissionResponse
readList :: ReadS [AddProfilePermissionResponse]
$creadList :: ReadS [AddProfilePermissionResponse]
readsPrec :: Int -> ReadS AddProfilePermissionResponse
$creadsPrec :: Int -> ReadS AddProfilePermissionResponse
Prelude.Read, Int -> AddProfilePermissionResponse -> ShowS
[AddProfilePermissionResponse] -> ShowS
AddProfilePermissionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddProfilePermissionResponse] -> ShowS
$cshowList :: [AddProfilePermissionResponse] -> ShowS
show :: AddProfilePermissionResponse -> String
$cshow :: AddProfilePermissionResponse -> String
showsPrec :: Int -> AddProfilePermissionResponse -> ShowS
$cshowsPrec :: Int -> AddProfilePermissionResponse -> ShowS
Prelude.Show, forall x.
Rep AddProfilePermissionResponse x -> AddProfilePermissionResponse
forall x.
AddProfilePermissionResponse -> Rep AddProfilePermissionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AddProfilePermissionResponse x -> AddProfilePermissionResponse
$cfrom :: forall x.
AddProfilePermissionResponse -> Rep AddProfilePermissionResponse x
Prelude.Generic)

-- |
-- Create a value of 'AddProfilePermissionResponse' 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', 'addProfilePermissionResponse_revisionId' - A unique identifier for the current profile revision.
--
-- 'httpStatus', 'addProfilePermissionResponse_httpStatus' - The response's http status code.
newAddProfilePermissionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddProfilePermissionResponse
newAddProfilePermissionResponse :: Int -> AddProfilePermissionResponse
newAddProfilePermissionResponse Int
pHttpStatus_ =
  AddProfilePermissionResponse'
    { $sel:revisionId:AddProfilePermissionResponse' :: Maybe Text
revisionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddProfilePermissionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique identifier for the current profile revision.
addProfilePermissionResponse_revisionId :: Lens.Lens' AddProfilePermissionResponse (Prelude.Maybe Prelude.Text)
addProfilePermissionResponse_revisionId :: Lens' AddProfilePermissionResponse (Maybe Text)
addProfilePermissionResponse_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddProfilePermissionResponse' {Maybe Text
revisionId :: Maybe Text
$sel:revisionId:AddProfilePermissionResponse' :: AddProfilePermissionResponse -> Maybe Text
revisionId} -> Maybe Text
revisionId) (\s :: AddProfilePermissionResponse
s@AddProfilePermissionResponse' {} Maybe Text
a -> AddProfilePermissionResponse
s {$sel:revisionId:AddProfilePermissionResponse' :: Maybe Text
revisionId = Maybe Text
a} :: AddProfilePermissionResponse)

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

instance Prelude.NFData AddProfilePermissionResponse where
  rnf :: AddProfilePermissionResponse -> ()
rnf AddProfilePermissionResponse' {Int
Maybe Text
httpStatus :: Int
revisionId :: Maybe Text
$sel:httpStatus:AddProfilePermissionResponse' :: AddProfilePermissionResponse -> Int
$sel:revisionId:AddProfilePermissionResponse' :: AddProfilePermissionResponse -> 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 Int
httpStatus