{-# 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.Glue.GetUnfilteredPartitionMetadata
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- -- | Undocumented operation.
module Amazonka.Glue.GetUnfilteredPartitionMetadata
  ( -- * Creating a Request
    GetUnfilteredPartitionMetadata (..),
    newGetUnfilteredPartitionMetadata,

    -- * Request Lenses
    getUnfilteredPartitionMetadata_auditContext,
    getUnfilteredPartitionMetadata_catalogId,
    getUnfilteredPartitionMetadata_databaseName,
    getUnfilteredPartitionMetadata_tableName,
    getUnfilteredPartitionMetadata_partitionValues,
    getUnfilteredPartitionMetadata_supportedPermissionTypes,

    -- * Destructuring the Response
    GetUnfilteredPartitionMetadataResponse (..),
    newGetUnfilteredPartitionMetadataResponse,

    -- * Response Lenses
    getUnfilteredPartitionMetadataResponse_authorizedColumns,
    getUnfilteredPartitionMetadataResponse_isRegisteredWithLakeFormation,
    getUnfilteredPartitionMetadataResponse_partition,
    getUnfilteredPartitionMetadataResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetUnfilteredPartitionMetadata' smart constructor.
data GetUnfilteredPartitionMetadata = GetUnfilteredPartitionMetadata'
  { GetUnfilteredPartitionMetadata -> Maybe AuditContext
auditContext :: Prelude.Maybe AuditContext,
    GetUnfilteredPartitionMetadata -> Text
catalogId :: Prelude.Text,
    GetUnfilteredPartitionMetadata -> Text
databaseName :: Prelude.Text,
    GetUnfilteredPartitionMetadata -> Text
tableName :: Prelude.Text,
    GetUnfilteredPartitionMetadata -> [Text]
partitionValues :: [Prelude.Text],
    GetUnfilteredPartitionMetadata -> NonEmpty PermissionType
supportedPermissionTypes :: Prelude.NonEmpty PermissionType
  }
  deriving (GetUnfilteredPartitionMetadata
-> GetUnfilteredPartitionMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUnfilteredPartitionMetadata
-> GetUnfilteredPartitionMetadata -> Bool
$c/= :: GetUnfilteredPartitionMetadata
-> GetUnfilteredPartitionMetadata -> Bool
== :: GetUnfilteredPartitionMetadata
-> GetUnfilteredPartitionMetadata -> Bool
$c== :: GetUnfilteredPartitionMetadata
-> GetUnfilteredPartitionMetadata -> Bool
Prelude.Eq, ReadPrec [GetUnfilteredPartitionMetadata]
ReadPrec GetUnfilteredPartitionMetadata
Int -> ReadS GetUnfilteredPartitionMetadata
ReadS [GetUnfilteredPartitionMetadata]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUnfilteredPartitionMetadata]
$creadListPrec :: ReadPrec [GetUnfilteredPartitionMetadata]
readPrec :: ReadPrec GetUnfilteredPartitionMetadata
$creadPrec :: ReadPrec GetUnfilteredPartitionMetadata
readList :: ReadS [GetUnfilteredPartitionMetadata]
$creadList :: ReadS [GetUnfilteredPartitionMetadata]
readsPrec :: Int -> ReadS GetUnfilteredPartitionMetadata
$creadsPrec :: Int -> ReadS GetUnfilteredPartitionMetadata
Prelude.Read, Int -> GetUnfilteredPartitionMetadata -> ShowS
[GetUnfilteredPartitionMetadata] -> ShowS
GetUnfilteredPartitionMetadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUnfilteredPartitionMetadata] -> ShowS
$cshowList :: [GetUnfilteredPartitionMetadata] -> ShowS
show :: GetUnfilteredPartitionMetadata -> String
$cshow :: GetUnfilteredPartitionMetadata -> String
showsPrec :: Int -> GetUnfilteredPartitionMetadata -> ShowS
$cshowsPrec :: Int -> GetUnfilteredPartitionMetadata -> ShowS
Prelude.Show, forall x.
Rep GetUnfilteredPartitionMetadata x
-> GetUnfilteredPartitionMetadata
forall x.
GetUnfilteredPartitionMetadata
-> Rep GetUnfilteredPartitionMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetUnfilteredPartitionMetadata x
-> GetUnfilteredPartitionMetadata
$cfrom :: forall x.
GetUnfilteredPartitionMetadata
-> Rep GetUnfilteredPartitionMetadata x
Prelude.Generic)

-- |
-- Create a value of 'GetUnfilteredPartitionMetadata' 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:
--
-- 'auditContext', 'getUnfilteredPartitionMetadata_auditContext' - Undocumented member.
--
-- 'catalogId', 'getUnfilteredPartitionMetadata_catalogId' - Undocumented member.
--
-- 'databaseName', 'getUnfilteredPartitionMetadata_databaseName' - Undocumented member.
--
-- 'tableName', 'getUnfilteredPartitionMetadata_tableName' - Undocumented member.
--
-- 'partitionValues', 'getUnfilteredPartitionMetadata_partitionValues' - Undocumented member.
--
-- 'supportedPermissionTypes', 'getUnfilteredPartitionMetadata_supportedPermissionTypes' - Undocumented member.
newGetUnfilteredPartitionMetadata ::
  -- | 'catalogId'
  Prelude.Text ->
  -- | 'databaseName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  -- | 'supportedPermissionTypes'
  Prelude.NonEmpty PermissionType ->
  GetUnfilteredPartitionMetadata
newGetUnfilteredPartitionMetadata :: Text
-> Text
-> Text
-> NonEmpty PermissionType
-> GetUnfilteredPartitionMetadata
newGetUnfilteredPartitionMetadata
  Text
pCatalogId_
  Text
pDatabaseName_
  Text
pTableName_
  NonEmpty PermissionType
pSupportedPermissionTypes_ =
    GetUnfilteredPartitionMetadata'
      { $sel:auditContext:GetUnfilteredPartitionMetadata' :: Maybe AuditContext
auditContext =
          forall a. Maybe a
Prelude.Nothing,
        $sel:catalogId:GetUnfilteredPartitionMetadata' :: Text
catalogId = Text
pCatalogId_,
        $sel:databaseName:GetUnfilteredPartitionMetadata' :: Text
databaseName = Text
pDatabaseName_,
        $sel:tableName:GetUnfilteredPartitionMetadata' :: Text
tableName = Text
pTableName_,
        $sel:partitionValues:GetUnfilteredPartitionMetadata' :: [Text]
partitionValues = forall a. Monoid a => a
Prelude.mempty,
        $sel:supportedPermissionTypes:GetUnfilteredPartitionMetadata' :: NonEmpty PermissionType
supportedPermissionTypes =
          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 PermissionType
pSupportedPermissionTypes_
      }

-- | Undocumented member.
getUnfilteredPartitionMetadata_auditContext :: Lens.Lens' GetUnfilteredPartitionMetadata (Prelude.Maybe AuditContext)
getUnfilteredPartitionMetadata_auditContext :: Lens' GetUnfilteredPartitionMetadata (Maybe AuditContext)
getUnfilteredPartitionMetadata_auditContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUnfilteredPartitionMetadata' {Maybe AuditContext
auditContext :: Maybe AuditContext
$sel:auditContext:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Maybe AuditContext
auditContext} -> Maybe AuditContext
auditContext) (\s :: GetUnfilteredPartitionMetadata
s@GetUnfilteredPartitionMetadata' {} Maybe AuditContext
a -> GetUnfilteredPartitionMetadata
s {$sel:auditContext:GetUnfilteredPartitionMetadata' :: Maybe AuditContext
auditContext = Maybe AuditContext
a} :: GetUnfilteredPartitionMetadata)

-- | Undocumented member.
getUnfilteredPartitionMetadata_catalogId :: Lens.Lens' GetUnfilteredPartitionMetadata Prelude.Text
getUnfilteredPartitionMetadata_catalogId :: Lens' GetUnfilteredPartitionMetadata Text
getUnfilteredPartitionMetadata_catalogId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUnfilteredPartitionMetadata' {Text
catalogId :: Text
$sel:catalogId:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
catalogId} -> Text
catalogId) (\s :: GetUnfilteredPartitionMetadata
s@GetUnfilteredPartitionMetadata' {} Text
a -> GetUnfilteredPartitionMetadata
s {$sel:catalogId:GetUnfilteredPartitionMetadata' :: Text
catalogId = Text
a} :: GetUnfilteredPartitionMetadata)

-- | Undocumented member.
getUnfilteredPartitionMetadata_databaseName :: Lens.Lens' GetUnfilteredPartitionMetadata Prelude.Text
getUnfilteredPartitionMetadata_databaseName :: Lens' GetUnfilteredPartitionMetadata Text
getUnfilteredPartitionMetadata_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUnfilteredPartitionMetadata' {Text
databaseName :: Text
$sel:databaseName:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
databaseName} -> Text
databaseName) (\s :: GetUnfilteredPartitionMetadata
s@GetUnfilteredPartitionMetadata' {} Text
a -> GetUnfilteredPartitionMetadata
s {$sel:databaseName:GetUnfilteredPartitionMetadata' :: Text
databaseName = Text
a} :: GetUnfilteredPartitionMetadata)

-- | Undocumented member.
getUnfilteredPartitionMetadata_tableName :: Lens.Lens' GetUnfilteredPartitionMetadata Prelude.Text
getUnfilteredPartitionMetadata_tableName :: Lens' GetUnfilteredPartitionMetadata Text
getUnfilteredPartitionMetadata_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUnfilteredPartitionMetadata' {Text
tableName :: Text
$sel:tableName:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
tableName} -> Text
tableName) (\s :: GetUnfilteredPartitionMetadata
s@GetUnfilteredPartitionMetadata' {} Text
a -> GetUnfilteredPartitionMetadata
s {$sel:tableName:GetUnfilteredPartitionMetadata' :: Text
tableName = Text
a} :: GetUnfilteredPartitionMetadata)

-- | Undocumented member.
getUnfilteredPartitionMetadata_partitionValues :: Lens.Lens' GetUnfilteredPartitionMetadata [Prelude.Text]
getUnfilteredPartitionMetadata_partitionValues :: Lens' GetUnfilteredPartitionMetadata [Text]
getUnfilteredPartitionMetadata_partitionValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUnfilteredPartitionMetadata' {[Text]
partitionValues :: [Text]
$sel:partitionValues:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> [Text]
partitionValues} -> [Text]
partitionValues) (\s :: GetUnfilteredPartitionMetadata
s@GetUnfilteredPartitionMetadata' {} [Text]
a -> GetUnfilteredPartitionMetadata
s {$sel:partitionValues:GetUnfilteredPartitionMetadata' :: [Text]
partitionValues = [Text]
a} :: GetUnfilteredPartitionMetadata) 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

-- | Undocumented member.
getUnfilteredPartitionMetadata_supportedPermissionTypes :: Lens.Lens' GetUnfilteredPartitionMetadata (Prelude.NonEmpty PermissionType)
getUnfilteredPartitionMetadata_supportedPermissionTypes :: Lens' GetUnfilteredPartitionMetadata (NonEmpty PermissionType)
getUnfilteredPartitionMetadata_supportedPermissionTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUnfilteredPartitionMetadata' {NonEmpty PermissionType
supportedPermissionTypes :: NonEmpty PermissionType
$sel:supportedPermissionTypes:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> NonEmpty PermissionType
supportedPermissionTypes} -> NonEmpty PermissionType
supportedPermissionTypes) (\s :: GetUnfilteredPartitionMetadata
s@GetUnfilteredPartitionMetadata' {} NonEmpty PermissionType
a -> GetUnfilteredPartitionMetadata
s {$sel:supportedPermissionTypes:GetUnfilteredPartitionMetadata' :: NonEmpty PermissionType
supportedPermissionTypes = NonEmpty PermissionType
a} :: GetUnfilteredPartitionMetadata) 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
    GetUnfilteredPartitionMetadata
  where
  type
    AWSResponse GetUnfilteredPartitionMetadata =
      GetUnfilteredPartitionMetadataResponse
  request :: (Service -> Service)
-> GetUnfilteredPartitionMetadata
-> Request GetUnfilteredPartitionMetadata
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 GetUnfilteredPartitionMetadata
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetUnfilteredPartitionMetadata)))
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]
-> Maybe Bool
-> Maybe Partition
-> Int
-> GetUnfilteredPartitionMetadataResponse
GetUnfilteredPartitionMetadataResponse'
            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
"AuthorizedColumns"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"IsRegisteredWithLakeFormation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Partition")
            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
    GetUnfilteredPartitionMetadata
  where
  hashWithSalt :: Int -> GetUnfilteredPartitionMetadata -> Int
hashWithSalt
    Int
_salt
    GetUnfilteredPartitionMetadata' {[Text]
Maybe AuditContext
NonEmpty PermissionType
Text
supportedPermissionTypes :: NonEmpty PermissionType
partitionValues :: [Text]
tableName :: Text
databaseName :: Text
catalogId :: Text
auditContext :: Maybe AuditContext
$sel:supportedPermissionTypes:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> NonEmpty PermissionType
$sel:partitionValues:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> [Text]
$sel:tableName:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
$sel:databaseName:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
$sel:catalogId:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
$sel:auditContext:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Maybe AuditContext
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AuditContext
auditContext
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
catalogId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
databaseName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
partitionValues
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty PermissionType
supportedPermissionTypes

instance
  Prelude.NFData
    GetUnfilteredPartitionMetadata
  where
  rnf :: GetUnfilteredPartitionMetadata -> ()
rnf GetUnfilteredPartitionMetadata' {[Text]
Maybe AuditContext
NonEmpty PermissionType
Text
supportedPermissionTypes :: NonEmpty PermissionType
partitionValues :: [Text]
tableName :: Text
databaseName :: Text
catalogId :: Text
auditContext :: Maybe AuditContext
$sel:supportedPermissionTypes:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> NonEmpty PermissionType
$sel:partitionValues:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> [Text]
$sel:tableName:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
$sel:databaseName:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
$sel:catalogId:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
$sel:auditContext:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Maybe AuditContext
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AuditContext
auditContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
catalogId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
databaseName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
partitionValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty PermissionType
supportedPermissionTypes

instance
  Data.ToHeaders
    GetUnfilteredPartitionMetadata
  where
  toHeaders :: GetUnfilteredPartitionMetadata -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"AWSGlue.GetUnfilteredPartitionMetadata" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetUnfilteredPartitionMetadata where
  toJSON :: GetUnfilteredPartitionMetadata -> Value
toJSON GetUnfilteredPartitionMetadata' {[Text]
Maybe AuditContext
NonEmpty PermissionType
Text
supportedPermissionTypes :: NonEmpty PermissionType
partitionValues :: [Text]
tableName :: Text
databaseName :: Text
catalogId :: Text
auditContext :: Maybe AuditContext
$sel:supportedPermissionTypes:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> NonEmpty PermissionType
$sel:partitionValues:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> [Text]
$sel:tableName:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
$sel:databaseName:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
$sel:catalogId:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Text
$sel:auditContext:GetUnfilteredPartitionMetadata' :: GetUnfilteredPartitionMetadata -> Maybe AuditContext
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AuditContext" 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 AuditContext
auditContext,
            forall a. a -> Maybe a
Prelude.Just (Key
"CatalogId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
catalogId),
            forall a. a -> Maybe a
Prelude.Just (Key
"DatabaseName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
databaseName),
            forall a. a -> Maybe a
Prelude.Just (Key
"TableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
tableName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PartitionValues" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
partitionValues),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"SupportedPermissionTypes"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty PermissionType
supportedPermissionTypes
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'GetUnfilteredPartitionMetadataResponse' 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:
--
-- 'authorizedColumns', 'getUnfilteredPartitionMetadataResponse_authorizedColumns' - Undocumented member.
--
-- 'isRegisteredWithLakeFormation', 'getUnfilteredPartitionMetadataResponse_isRegisteredWithLakeFormation' - Undocumented member.
--
-- 'partition', 'getUnfilteredPartitionMetadataResponse_partition' - Undocumented member.
--
-- 'httpStatus', 'getUnfilteredPartitionMetadataResponse_httpStatus' - The response's http status code.
newGetUnfilteredPartitionMetadataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetUnfilteredPartitionMetadataResponse
newGetUnfilteredPartitionMetadataResponse :: Int -> GetUnfilteredPartitionMetadataResponse
newGetUnfilteredPartitionMetadataResponse
  Int
pHttpStatus_ =
    GetUnfilteredPartitionMetadataResponse'
      { $sel:authorizedColumns:GetUnfilteredPartitionMetadataResponse' :: Maybe [Text]
authorizedColumns =
          forall a. Maybe a
Prelude.Nothing,
        $sel:isRegisteredWithLakeFormation:GetUnfilteredPartitionMetadataResponse' :: Maybe Bool
isRegisteredWithLakeFormation =
          forall a. Maybe a
Prelude.Nothing,
        $sel:partition:GetUnfilteredPartitionMetadataResponse' :: Maybe Partition
partition = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetUnfilteredPartitionMetadataResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Undocumented member.
getUnfilteredPartitionMetadataResponse_authorizedColumns :: Lens.Lens' GetUnfilteredPartitionMetadataResponse (Prelude.Maybe [Prelude.Text])
getUnfilteredPartitionMetadataResponse_authorizedColumns :: Lens' GetUnfilteredPartitionMetadataResponse (Maybe [Text])
getUnfilteredPartitionMetadataResponse_authorizedColumns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUnfilteredPartitionMetadataResponse' {Maybe [Text]
authorizedColumns :: Maybe [Text]
$sel:authorizedColumns:GetUnfilteredPartitionMetadataResponse' :: GetUnfilteredPartitionMetadataResponse -> Maybe [Text]
authorizedColumns} -> Maybe [Text]
authorizedColumns) (\s :: GetUnfilteredPartitionMetadataResponse
s@GetUnfilteredPartitionMetadataResponse' {} Maybe [Text]
a -> GetUnfilteredPartitionMetadataResponse
s {$sel:authorizedColumns:GetUnfilteredPartitionMetadataResponse' :: Maybe [Text]
authorizedColumns = Maybe [Text]
a} :: GetUnfilteredPartitionMetadataResponse) 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

-- | Undocumented member.
getUnfilteredPartitionMetadataResponse_isRegisteredWithLakeFormation :: Lens.Lens' GetUnfilteredPartitionMetadataResponse (Prelude.Maybe Prelude.Bool)
getUnfilteredPartitionMetadataResponse_isRegisteredWithLakeFormation :: Lens' GetUnfilteredPartitionMetadataResponse (Maybe Bool)
getUnfilteredPartitionMetadataResponse_isRegisteredWithLakeFormation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUnfilteredPartitionMetadataResponse' {Maybe Bool
isRegisteredWithLakeFormation :: Maybe Bool
$sel:isRegisteredWithLakeFormation:GetUnfilteredPartitionMetadataResponse' :: GetUnfilteredPartitionMetadataResponse -> Maybe Bool
isRegisteredWithLakeFormation} -> Maybe Bool
isRegisteredWithLakeFormation) (\s :: GetUnfilteredPartitionMetadataResponse
s@GetUnfilteredPartitionMetadataResponse' {} Maybe Bool
a -> GetUnfilteredPartitionMetadataResponse
s {$sel:isRegisteredWithLakeFormation:GetUnfilteredPartitionMetadataResponse' :: Maybe Bool
isRegisteredWithLakeFormation = Maybe Bool
a} :: GetUnfilteredPartitionMetadataResponse)

-- | Undocumented member.
getUnfilteredPartitionMetadataResponse_partition :: Lens.Lens' GetUnfilteredPartitionMetadataResponse (Prelude.Maybe Partition)
getUnfilteredPartitionMetadataResponse_partition :: Lens' GetUnfilteredPartitionMetadataResponse (Maybe Partition)
getUnfilteredPartitionMetadataResponse_partition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUnfilteredPartitionMetadataResponse' {Maybe Partition
partition :: Maybe Partition
$sel:partition:GetUnfilteredPartitionMetadataResponse' :: GetUnfilteredPartitionMetadataResponse -> Maybe Partition
partition} -> Maybe Partition
partition) (\s :: GetUnfilteredPartitionMetadataResponse
s@GetUnfilteredPartitionMetadataResponse' {} Maybe Partition
a -> GetUnfilteredPartitionMetadataResponse
s {$sel:partition:GetUnfilteredPartitionMetadataResponse' :: Maybe Partition
partition = Maybe Partition
a} :: GetUnfilteredPartitionMetadataResponse)

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

instance
  Prelude.NFData
    GetUnfilteredPartitionMetadataResponse
  where
  rnf :: GetUnfilteredPartitionMetadataResponse -> ()
rnf GetUnfilteredPartitionMetadataResponse' {Int
Maybe Bool
Maybe [Text]
Maybe Partition
httpStatus :: Int
partition :: Maybe Partition
isRegisteredWithLakeFormation :: Maybe Bool
authorizedColumns :: Maybe [Text]
$sel:httpStatus:GetUnfilteredPartitionMetadataResponse' :: GetUnfilteredPartitionMetadataResponse -> Int
$sel:partition:GetUnfilteredPartitionMetadataResponse' :: GetUnfilteredPartitionMetadataResponse -> Maybe Partition
$sel:isRegisteredWithLakeFormation:GetUnfilteredPartitionMetadataResponse' :: GetUnfilteredPartitionMetadataResponse -> Maybe Bool
$sel:authorizedColumns:GetUnfilteredPartitionMetadataResponse' :: GetUnfilteredPartitionMetadataResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
authorizedColumns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isRegisteredWithLakeFormation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Partition
partition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus