{-# 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.LakeFormation.GrantPermissions
-- 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 permissions to the principal to access metadata in the Data
-- Catalog and data organized in underlying data storage such as Amazon S3.
--
-- For information about permissions, see
-- <https://docs-aws.amazon.com/lake-formation/latest/dg/security-data-access.html Security and Access Control to Metadata and Data>.
module Amazonka.LakeFormation.GrantPermissions
  ( -- * Creating a Request
    GrantPermissions (..),
    newGrantPermissions,

    -- * Request Lenses
    grantPermissions_catalogId,
    grantPermissions_permissionsWithGrantOption,
    grantPermissions_principal,
    grantPermissions_resource,
    grantPermissions_permissions,

    -- * Destructuring the Response
    GrantPermissionsResponse (..),
    newGrantPermissionsResponse,

    -- * Response Lenses
    grantPermissionsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGrantPermissions' smart constructor.
data GrantPermissions = GrantPermissions'
  { -- | The identifier for the Data Catalog. By default, the account ID. The
    -- Data Catalog is the persistent metadata store. It contains database
    -- definitions, table definitions, and other control information to manage
    -- your Lake Formation environment.
    GrantPermissions -> Maybe Text
catalogId :: Prelude.Maybe Prelude.Text,
    -- | Indicates a list of the granted permissions that the principal may pass
    -- to other users. These permissions may only be a subset of the
    -- permissions granted in the @Privileges@.
    GrantPermissions -> Maybe [Permission]
permissionsWithGrantOption :: Prelude.Maybe [Permission],
    -- | The principal to be granted the permissions on the resource. Supported
    -- principals are IAM users or IAM roles, and they are defined by their
    -- principal type and their ARN.
    --
    -- Note that if you define a resource with a particular ARN, then later
    -- delete, and recreate a resource with that same ARN, the resource
    -- maintains the permissions already granted.
    GrantPermissions -> DataLakePrincipal
principal :: DataLakePrincipal,
    -- | The resource to which permissions are to be granted. Resources in Lake
    -- Formation are the Data Catalog, databases, and tables.
    GrantPermissions -> Resource
resource :: Resource,
    -- | The permissions granted to the principal on the resource. Lake Formation
    -- defines privileges to grant and revoke access to metadata in the Data
    -- Catalog and data organized in underlying data storage such as Amazon S3.
    -- Lake Formation requires that each principal be authorized to perform a
    -- specific task on Lake Formation resources.
    GrantPermissions -> [Permission]
permissions :: [Permission]
  }
  deriving (GrantPermissions -> GrantPermissions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrantPermissions -> GrantPermissions -> Bool
$c/= :: GrantPermissions -> GrantPermissions -> Bool
== :: GrantPermissions -> GrantPermissions -> Bool
$c== :: GrantPermissions -> GrantPermissions -> Bool
Prelude.Eq, ReadPrec [GrantPermissions]
ReadPrec GrantPermissions
Int -> ReadS GrantPermissions
ReadS [GrantPermissions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GrantPermissions]
$creadListPrec :: ReadPrec [GrantPermissions]
readPrec :: ReadPrec GrantPermissions
$creadPrec :: ReadPrec GrantPermissions
readList :: ReadS [GrantPermissions]
$creadList :: ReadS [GrantPermissions]
readsPrec :: Int -> ReadS GrantPermissions
$creadsPrec :: Int -> ReadS GrantPermissions
Prelude.Read, Int -> GrantPermissions -> ShowS
[GrantPermissions] -> ShowS
GrantPermissions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrantPermissions] -> ShowS
$cshowList :: [GrantPermissions] -> ShowS
show :: GrantPermissions -> String
$cshow :: GrantPermissions -> String
showsPrec :: Int -> GrantPermissions -> ShowS
$cshowsPrec :: Int -> GrantPermissions -> ShowS
Prelude.Show, forall x. Rep GrantPermissions x -> GrantPermissions
forall x. GrantPermissions -> Rep GrantPermissions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GrantPermissions x -> GrantPermissions
$cfrom :: forall x. GrantPermissions -> Rep GrantPermissions x
Prelude.Generic)

-- |
-- Create a value of 'GrantPermissions' 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:
--
-- 'catalogId', 'grantPermissions_catalogId' - The identifier for the Data Catalog. By default, the account ID. The
-- Data Catalog is the persistent metadata store. It contains database
-- definitions, table definitions, and other control information to manage
-- your Lake Formation environment.
--
-- 'permissionsWithGrantOption', 'grantPermissions_permissionsWithGrantOption' - Indicates a list of the granted permissions that the principal may pass
-- to other users. These permissions may only be a subset of the
-- permissions granted in the @Privileges@.
--
-- 'principal', 'grantPermissions_principal' - The principal to be granted the permissions on the resource. Supported
-- principals are IAM users or IAM roles, and they are defined by their
-- principal type and their ARN.
--
-- Note that if you define a resource with a particular ARN, then later
-- delete, and recreate a resource with that same ARN, the resource
-- maintains the permissions already granted.
--
-- 'resource', 'grantPermissions_resource' - The resource to which permissions are to be granted. Resources in Lake
-- Formation are the Data Catalog, databases, and tables.
--
-- 'permissions', 'grantPermissions_permissions' - The permissions granted to the principal on the resource. Lake Formation
-- defines privileges to grant and revoke access to metadata in the Data
-- Catalog and data organized in underlying data storage such as Amazon S3.
-- Lake Formation requires that each principal be authorized to perform a
-- specific task on Lake Formation resources.
newGrantPermissions ::
  -- | 'principal'
  DataLakePrincipal ->
  -- | 'resource'
  Resource ->
  GrantPermissions
newGrantPermissions :: DataLakePrincipal -> Resource -> GrantPermissions
newGrantPermissions DataLakePrincipal
pPrincipal_ Resource
pResource_ =
  GrantPermissions'
    { $sel:catalogId:GrantPermissions' :: Maybe Text
catalogId = forall a. Maybe a
Prelude.Nothing,
      $sel:permissionsWithGrantOption:GrantPermissions' :: Maybe [Permission]
permissionsWithGrantOption = forall a. Maybe a
Prelude.Nothing,
      $sel:principal:GrantPermissions' :: DataLakePrincipal
principal = DataLakePrincipal
pPrincipal_,
      $sel:resource:GrantPermissions' :: Resource
resource = Resource
pResource_,
      $sel:permissions:GrantPermissions' :: [Permission]
permissions = forall a. Monoid a => a
Prelude.mempty
    }

-- | The identifier for the Data Catalog. By default, the account ID. The
-- Data Catalog is the persistent metadata store. It contains database
-- definitions, table definitions, and other control information to manage
-- your Lake Formation environment.
grantPermissions_catalogId :: Lens.Lens' GrantPermissions (Prelude.Maybe Prelude.Text)
grantPermissions_catalogId :: Lens' GrantPermissions (Maybe Text)
grantPermissions_catalogId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrantPermissions' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:GrantPermissions' :: GrantPermissions -> Maybe Text
catalogId} -> Maybe Text
catalogId) (\s :: GrantPermissions
s@GrantPermissions' {} Maybe Text
a -> GrantPermissions
s {$sel:catalogId:GrantPermissions' :: Maybe Text
catalogId = Maybe Text
a} :: GrantPermissions)

-- | Indicates a list of the granted permissions that the principal may pass
-- to other users. These permissions may only be a subset of the
-- permissions granted in the @Privileges@.
grantPermissions_permissionsWithGrantOption :: Lens.Lens' GrantPermissions (Prelude.Maybe [Permission])
grantPermissions_permissionsWithGrantOption :: Lens' GrantPermissions (Maybe [Permission])
grantPermissions_permissionsWithGrantOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrantPermissions' {Maybe [Permission]
permissionsWithGrantOption :: Maybe [Permission]
$sel:permissionsWithGrantOption:GrantPermissions' :: GrantPermissions -> Maybe [Permission]
permissionsWithGrantOption} -> Maybe [Permission]
permissionsWithGrantOption) (\s :: GrantPermissions
s@GrantPermissions' {} Maybe [Permission]
a -> GrantPermissions
s {$sel:permissionsWithGrantOption:GrantPermissions' :: Maybe [Permission]
permissionsWithGrantOption = Maybe [Permission]
a} :: GrantPermissions) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The principal to be granted the permissions on the resource. Supported
-- principals are IAM users or IAM roles, and they are defined by their
-- principal type and their ARN.
--
-- Note that if you define a resource with a particular ARN, then later
-- delete, and recreate a resource with that same ARN, the resource
-- maintains the permissions already granted.
grantPermissions_principal :: Lens.Lens' GrantPermissions DataLakePrincipal
grantPermissions_principal :: Lens' GrantPermissions DataLakePrincipal
grantPermissions_principal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrantPermissions' {DataLakePrincipal
principal :: DataLakePrincipal
$sel:principal:GrantPermissions' :: GrantPermissions -> DataLakePrincipal
principal} -> DataLakePrincipal
principal) (\s :: GrantPermissions
s@GrantPermissions' {} DataLakePrincipal
a -> GrantPermissions
s {$sel:principal:GrantPermissions' :: DataLakePrincipal
principal = DataLakePrincipal
a} :: GrantPermissions)

-- | The resource to which permissions are to be granted. Resources in Lake
-- Formation are the Data Catalog, databases, and tables.
grantPermissions_resource :: Lens.Lens' GrantPermissions Resource
grantPermissions_resource :: Lens' GrantPermissions Resource
grantPermissions_resource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrantPermissions' {Resource
resource :: Resource
$sel:resource:GrantPermissions' :: GrantPermissions -> Resource
resource} -> Resource
resource) (\s :: GrantPermissions
s@GrantPermissions' {} Resource
a -> GrantPermissions
s {$sel:resource:GrantPermissions' :: Resource
resource = Resource
a} :: GrantPermissions)

-- | The permissions granted to the principal on the resource. Lake Formation
-- defines privileges to grant and revoke access to metadata in the Data
-- Catalog and data organized in underlying data storage such as Amazon S3.
-- Lake Formation requires that each principal be authorized to perform a
-- specific task on Lake Formation resources.
grantPermissions_permissions :: Lens.Lens' GrantPermissions [Permission]
grantPermissions_permissions :: Lens' GrantPermissions [Permission]
grantPermissions_permissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GrantPermissions' {[Permission]
permissions :: [Permission]
$sel:permissions:GrantPermissions' :: GrantPermissions -> [Permission]
permissions} -> [Permission]
permissions) (\s :: GrantPermissions
s@GrantPermissions' {} [Permission]
a -> GrantPermissions
s {$sel:permissions:GrantPermissions' :: [Permission]
permissions = [Permission]
a} :: GrantPermissions) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest GrantPermissions where
  type
    AWSResponse GrantPermissions =
      GrantPermissionsResponse
  request :: (Service -> Service)
-> GrantPermissions -> Request GrantPermissions
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 GrantPermissions
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GrantPermissions)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> GrantPermissionsResponse
GrantPermissionsResponse'
            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))
      )

instance Prelude.Hashable GrantPermissions where
  hashWithSalt :: Int -> GrantPermissions -> Int
hashWithSalt Int
_salt GrantPermissions' {[Permission]
Maybe [Permission]
Maybe Text
DataLakePrincipal
Resource
permissions :: [Permission]
resource :: Resource
principal :: DataLakePrincipal
permissionsWithGrantOption :: Maybe [Permission]
catalogId :: Maybe Text
$sel:permissions:GrantPermissions' :: GrantPermissions -> [Permission]
$sel:resource:GrantPermissions' :: GrantPermissions -> Resource
$sel:principal:GrantPermissions' :: GrantPermissions -> DataLakePrincipal
$sel:permissionsWithGrantOption:GrantPermissions' :: GrantPermissions -> Maybe [Permission]
$sel:catalogId:GrantPermissions' :: GrantPermissions -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
catalogId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Permission]
permissionsWithGrantOption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DataLakePrincipal
principal
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Resource
resource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Permission]
permissions

instance Prelude.NFData GrantPermissions where
  rnf :: GrantPermissions -> ()
rnf GrantPermissions' {[Permission]
Maybe [Permission]
Maybe Text
DataLakePrincipal
Resource
permissions :: [Permission]
resource :: Resource
principal :: DataLakePrincipal
permissionsWithGrantOption :: Maybe [Permission]
catalogId :: Maybe Text
$sel:permissions:GrantPermissions' :: GrantPermissions -> [Permission]
$sel:resource:GrantPermissions' :: GrantPermissions -> Resource
$sel:principal:GrantPermissions' :: GrantPermissions -> DataLakePrincipal
$sel:permissionsWithGrantOption:GrantPermissions' :: GrantPermissions -> Maybe [Permission]
$sel:catalogId:GrantPermissions' :: GrantPermissions -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
catalogId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Permission]
permissionsWithGrantOption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DataLakePrincipal
principal
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Resource
resource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Permission]
permissions

instance Data.ToHeaders GrantPermissions where
  toHeaders :: GrantPermissions -> 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 GrantPermissions where
  toJSON :: GrantPermissions -> Value
toJSON GrantPermissions' {[Permission]
Maybe [Permission]
Maybe Text
DataLakePrincipal
Resource
permissions :: [Permission]
resource :: Resource
principal :: DataLakePrincipal
permissionsWithGrantOption :: Maybe [Permission]
catalogId :: Maybe Text
$sel:permissions:GrantPermissions' :: GrantPermissions -> [Permission]
$sel:resource:GrantPermissions' :: GrantPermissions -> Resource
$sel:principal:GrantPermissions' :: GrantPermissions -> DataLakePrincipal
$sel:permissionsWithGrantOption:GrantPermissions' :: GrantPermissions -> Maybe [Permission]
$sel:catalogId:GrantPermissions' :: GrantPermissions -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CatalogId" 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
catalogId,
            (Key
"PermissionsWithGrantOption" 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 [Permission]
permissionsWithGrantOption,
            forall a. a -> Maybe a
Prelude.Just (Key
"Principal" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DataLakePrincipal
principal),
            forall a. a -> Maybe a
Prelude.Just (Key
"Resource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Resource
resource),
            forall a. a -> Maybe a
Prelude.Just (Key
"Permissions" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Permission]
permissions)
          ]
      )

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

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

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

-- |
-- Create a value of 'GrantPermissionsResponse' 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', 'grantPermissionsResponse_httpStatus' - The response's http status code.
newGrantPermissionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GrantPermissionsResponse
newGrantPermissionsResponse :: Int -> GrantPermissionsResponse
newGrantPermissionsResponse Int
pHttpStatus_ =
  GrantPermissionsResponse'
    { $sel:httpStatus:GrantPermissionsResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData GrantPermissionsResponse where
  rnf :: GrantPermissionsResponse -> ()
rnf GrantPermissionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:GrantPermissionsResponse' :: GrantPermissionsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus