{-# 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.RevokePermissions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Revokes permissions to the principal to access metadata in the Data
-- Catalog and data organized in underlying data storage such as Amazon S3.
module Amazonka.LakeFormation.RevokePermissions
  ( -- * Creating a Request
    RevokePermissions (..),
    newRevokePermissions,

    -- * Request Lenses
    revokePermissions_catalogId,
    revokePermissions_permissionsWithGrantOption,
    revokePermissions_principal,
    revokePermissions_resource,
    revokePermissions_permissions,

    -- * Destructuring the Response
    RevokePermissionsResponse (..),
    newRevokePermissionsResponse,

    -- * Response Lenses
    revokePermissionsResponse_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:/ 'newRevokePermissions' smart constructor.
data RevokePermissions = RevokePermissions'
  { -- | 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.
    RevokePermissions -> Maybe Text
catalogId :: Prelude.Maybe Prelude.Text,
    -- | Indicates a list of permissions for which to revoke the grant option
    -- allowing the principal to pass permissions to other principals.
    RevokePermissions -> Maybe [Permission]
permissionsWithGrantOption :: Prelude.Maybe [Permission],
    -- | The principal to be revoked permissions on the resource.
    RevokePermissions -> DataLakePrincipal
principal :: DataLakePrincipal,
    -- | The resource to which permissions are to be revoked.
    RevokePermissions -> Resource
resource :: Resource,
    -- | The permissions revoked to the principal on the resource. 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>.
    RevokePermissions -> [Permission]
permissions :: [Permission]
  }
  deriving (RevokePermissions -> RevokePermissions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokePermissions -> RevokePermissions -> Bool
$c/= :: RevokePermissions -> RevokePermissions -> Bool
== :: RevokePermissions -> RevokePermissions -> Bool
$c== :: RevokePermissions -> RevokePermissions -> Bool
Prelude.Eq, ReadPrec [RevokePermissions]
ReadPrec RevokePermissions
Int -> ReadS RevokePermissions
ReadS [RevokePermissions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RevokePermissions]
$creadListPrec :: ReadPrec [RevokePermissions]
readPrec :: ReadPrec RevokePermissions
$creadPrec :: ReadPrec RevokePermissions
readList :: ReadS [RevokePermissions]
$creadList :: ReadS [RevokePermissions]
readsPrec :: Int -> ReadS RevokePermissions
$creadsPrec :: Int -> ReadS RevokePermissions
Prelude.Read, Int -> RevokePermissions -> ShowS
[RevokePermissions] -> ShowS
RevokePermissions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokePermissions] -> ShowS
$cshowList :: [RevokePermissions] -> ShowS
show :: RevokePermissions -> String
$cshow :: RevokePermissions -> String
showsPrec :: Int -> RevokePermissions -> ShowS
$cshowsPrec :: Int -> RevokePermissions -> ShowS
Prelude.Show, forall x. Rep RevokePermissions x -> RevokePermissions
forall x. RevokePermissions -> Rep RevokePermissions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RevokePermissions x -> RevokePermissions
$cfrom :: forall x. RevokePermissions -> Rep RevokePermissions x
Prelude.Generic)

-- |
-- Create a value of 'RevokePermissions' 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', 'revokePermissions_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', 'revokePermissions_permissionsWithGrantOption' - Indicates a list of permissions for which to revoke the grant option
-- allowing the principal to pass permissions to other principals.
--
-- 'principal', 'revokePermissions_principal' - The principal to be revoked permissions on the resource.
--
-- 'resource', 'revokePermissions_resource' - The resource to which permissions are to be revoked.
--
-- 'permissions', 'revokePermissions_permissions' - The permissions revoked to the principal on the resource. 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>.
newRevokePermissions ::
  -- | 'principal'
  DataLakePrincipal ->
  -- | 'resource'
  Resource ->
  RevokePermissions
newRevokePermissions :: DataLakePrincipal -> Resource -> RevokePermissions
newRevokePermissions DataLakePrincipal
pPrincipal_ Resource
pResource_ =
  RevokePermissions'
    { $sel:catalogId:RevokePermissions' :: Maybe Text
catalogId = forall a. Maybe a
Prelude.Nothing,
      $sel:permissionsWithGrantOption:RevokePermissions' :: Maybe [Permission]
permissionsWithGrantOption = forall a. Maybe a
Prelude.Nothing,
      $sel:principal:RevokePermissions' :: DataLakePrincipal
principal = DataLakePrincipal
pPrincipal_,
      $sel:resource:RevokePermissions' :: Resource
resource = Resource
pResource_,
      $sel:permissions:RevokePermissions' :: [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.
revokePermissions_catalogId :: Lens.Lens' RevokePermissions (Prelude.Maybe Prelude.Text)
revokePermissions_catalogId :: Lens' RevokePermissions (Maybe Text)
revokePermissions_catalogId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokePermissions' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:RevokePermissions' :: RevokePermissions -> Maybe Text
catalogId} -> Maybe Text
catalogId) (\s :: RevokePermissions
s@RevokePermissions' {} Maybe Text
a -> RevokePermissions
s {$sel:catalogId:RevokePermissions' :: Maybe Text
catalogId = Maybe Text
a} :: RevokePermissions)

-- | Indicates a list of permissions for which to revoke the grant option
-- allowing the principal to pass permissions to other principals.
revokePermissions_permissionsWithGrantOption :: Lens.Lens' RevokePermissions (Prelude.Maybe [Permission])
revokePermissions_permissionsWithGrantOption :: Lens' RevokePermissions (Maybe [Permission])
revokePermissions_permissionsWithGrantOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokePermissions' {Maybe [Permission]
permissionsWithGrantOption :: Maybe [Permission]
$sel:permissionsWithGrantOption:RevokePermissions' :: RevokePermissions -> Maybe [Permission]
permissionsWithGrantOption} -> Maybe [Permission]
permissionsWithGrantOption) (\s :: RevokePermissions
s@RevokePermissions' {} Maybe [Permission]
a -> RevokePermissions
s {$sel:permissionsWithGrantOption:RevokePermissions' :: Maybe [Permission]
permissionsWithGrantOption = Maybe [Permission]
a} :: RevokePermissions) 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 revoked permissions on the resource.
revokePermissions_principal :: Lens.Lens' RevokePermissions DataLakePrincipal
revokePermissions_principal :: Lens' RevokePermissions DataLakePrincipal
revokePermissions_principal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokePermissions' {DataLakePrincipal
principal :: DataLakePrincipal
$sel:principal:RevokePermissions' :: RevokePermissions -> DataLakePrincipal
principal} -> DataLakePrincipal
principal) (\s :: RevokePermissions
s@RevokePermissions' {} DataLakePrincipal
a -> RevokePermissions
s {$sel:principal:RevokePermissions' :: DataLakePrincipal
principal = DataLakePrincipal
a} :: RevokePermissions)

-- | The resource to which permissions are to be revoked.
revokePermissions_resource :: Lens.Lens' RevokePermissions Resource
revokePermissions_resource :: Lens' RevokePermissions Resource
revokePermissions_resource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokePermissions' {Resource
resource :: Resource
$sel:resource:RevokePermissions' :: RevokePermissions -> Resource
resource} -> Resource
resource) (\s :: RevokePermissions
s@RevokePermissions' {} Resource
a -> RevokePermissions
s {$sel:resource:RevokePermissions' :: Resource
resource = Resource
a} :: RevokePermissions)

-- | The permissions revoked to the principal on the resource. 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>.
revokePermissions_permissions :: Lens.Lens' RevokePermissions [Permission]
revokePermissions_permissions :: Lens' RevokePermissions [Permission]
revokePermissions_permissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RevokePermissions' {[Permission]
permissions :: [Permission]
$sel:permissions:RevokePermissions' :: RevokePermissions -> [Permission]
permissions} -> [Permission]
permissions) (\s :: RevokePermissions
s@RevokePermissions' {} [Permission]
a -> RevokePermissions
s {$sel:permissions:RevokePermissions' :: [Permission]
permissions = [Permission]
a} :: RevokePermissions) 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 RevokePermissions where
  type
    AWSResponse RevokePermissions =
      RevokePermissionsResponse
  request :: (Service -> Service)
-> RevokePermissions -> Request RevokePermissions
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 RevokePermissions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RevokePermissions)))
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 -> RevokePermissionsResponse
RevokePermissionsResponse'
            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 RevokePermissions where
  hashWithSalt :: Int -> RevokePermissions -> Int
hashWithSalt Int
_salt RevokePermissions' {[Permission]
Maybe [Permission]
Maybe Text
DataLakePrincipal
Resource
permissions :: [Permission]
resource :: Resource
principal :: DataLakePrincipal
permissionsWithGrantOption :: Maybe [Permission]
catalogId :: Maybe Text
$sel:permissions:RevokePermissions' :: RevokePermissions -> [Permission]
$sel:resource:RevokePermissions' :: RevokePermissions -> Resource
$sel:principal:RevokePermissions' :: RevokePermissions -> DataLakePrincipal
$sel:permissionsWithGrantOption:RevokePermissions' :: RevokePermissions -> Maybe [Permission]
$sel:catalogId:RevokePermissions' :: RevokePermissions -> 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 RevokePermissions where
  rnf :: RevokePermissions -> ()
rnf RevokePermissions' {[Permission]
Maybe [Permission]
Maybe Text
DataLakePrincipal
Resource
permissions :: [Permission]
resource :: Resource
principal :: DataLakePrincipal
permissionsWithGrantOption :: Maybe [Permission]
catalogId :: Maybe Text
$sel:permissions:RevokePermissions' :: RevokePermissions -> [Permission]
$sel:resource:RevokePermissions' :: RevokePermissions -> Resource
$sel:principal:RevokePermissions' :: RevokePermissions -> DataLakePrincipal
$sel:permissionsWithGrantOption:RevokePermissions' :: RevokePermissions -> Maybe [Permission]
$sel:catalogId:RevokePermissions' :: RevokePermissions -> 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 RevokePermissions where
  toHeaders :: RevokePermissions -> 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 RevokePermissions where
  toJSON :: RevokePermissions -> Value
toJSON RevokePermissions' {[Permission]
Maybe [Permission]
Maybe Text
DataLakePrincipal
Resource
permissions :: [Permission]
resource :: Resource
principal :: DataLakePrincipal
permissionsWithGrantOption :: Maybe [Permission]
catalogId :: Maybe Text
$sel:permissions:RevokePermissions' :: RevokePermissions -> [Permission]
$sel:resource:RevokePermissions' :: RevokePermissions -> Resource
$sel:principal:RevokePermissions' :: RevokePermissions -> DataLakePrincipal
$sel:permissionsWithGrantOption:RevokePermissions' :: RevokePermissions -> Maybe [Permission]
$sel:catalogId:RevokePermissions' :: RevokePermissions -> 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 RevokePermissions where
  toPath :: RevokePermissions -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/RevokePermissions"

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

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

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

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

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