{-# 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.GetTemporaryGluePartitionCredentials
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This API is identical to @GetTemporaryTableCredentials@ except that this
-- is used when the target Data Catalog resource is of type Partition. Lake
-- Formation restricts the permission of the vended credentials with the
-- same scope down policy which restricts access to a single Amazon S3
-- prefix.
module Amazonka.LakeFormation.GetTemporaryGluePartitionCredentials
  ( -- * Creating a Request
    GetTemporaryGluePartitionCredentials (..),
    newGetTemporaryGluePartitionCredentials,

    -- * Request Lenses
    getTemporaryGluePartitionCredentials_auditContext,
    getTemporaryGluePartitionCredentials_durationSeconds,
    getTemporaryGluePartitionCredentials_permissions,
    getTemporaryGluePartitionCredentials_tableArn,
    getTemporaryGluePartitionCredentials_partition,
    getTemporaryGluePartitionCredentials_supportedPermissionTypes,

    -- * Destructuring the Response
    GetTemporaryGluePartitionCredentialsResponse (..),
    newGetTemporaryGluePartitionCredentialsResponse,

    -- * Response Lenses
    getTemporaryGluePartitionCredentialsResponse_accessKeyId,
    getTemporaryGluePartitionCredentialsResponse_expiration,
    getTemporaryGluePartitionCredentialsResponse_secretAccessKey,
    getTemporaryGluePartitionCredentialsResponse_sessionToken,
    getTemporaryGluePartitionCredentialsResponse_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:/ 'newGetTemporaryGluePartitionCredentials' smart constructor.
data GetTemporaryGluePartitionCredentials = GetTemporaryGluePartitionCredentials'
  { -- | A structure representing context to access a resource (column names,
    -- query ID, etc).
    GetTemporaryGluePartitionCredentials -> Maybe AuditContext
auditContext :: Prelude.Maybe AuditContext,
    -- | The time period, between 900 and 21,600 seconds, for the timeout of the
    -- temporary credentials.
    GetTemporaryGluePartitionCredentials -> Maybe Natural
durationSeconds :: Prelude.Maybe Prelude.Natural,
    -- | Filters the request based on the user having been granted a list of
    -- specified permissions on the requested resource(s).
    GetTemporaryGluePartitionCredentials -> Maybe [Permission]
permissions :: Prelude.Maybe [Permission],
    -- | The ARN of the partitions\' table.
    GetTemporaryGluePartitionCredentials -> Text
tableArn :: Prelude.Text,
    -- | A list of partition values identifying a single partition.
    GetTemporaryGluePartitionCredentials -> PartitionValueList
partition :: PartitionValueList,
    -- | A list of supported permission types for the partition. Valid values are
    -- @COLUMN_PERMISSION@ and @CELL_FILTER_PERMISSION@.
    GetTemporaryGluePartitionCredentials -> NonEmpty PermissionType
supportedPermissionTypes :: Prelude.NonEmpty PermissionType
  }
  deriving (GetTemporaryGluePartitionCredentials
-> GetTemporaryGluePartitionCredentials -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTemporaryGluePartitionCredentials
-> GetTemporaryGluePartitionCredentials -> Bool
$c/= :: GetTemporaryGluePartitionCredentials
-> GetTemporaryGluePartitionCredentials -> Bool
== :: GetTemporaryGluePartitionCredentials
-> GetTemporaryGluePartitionCredentials -> Bool
$c== :: GetTemporaryGluePartitionCredentials
-> GetTemporaryGluePartitionCredentials -> Bool
Prelude.Eq, ReadPrec [GetTemporaryGluePartitionCredentials]
ReadPrec GetTemporaryGluePartitionCredentials
Int -> ReadS GetTemporaryGluePartitionCredentials
ReadS [GetTemporaryGluePartitionCredentials]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTemporaryGluePartitionCredentials]
$creadListPrec :: ReadPrec [GetTemporaryGluePartitionCredentials]
readPrec :: ReadPrec GetTemporaryGluePartitionCredentials
$creadPrec :: ReadPrec GetTemporaryGluePartitionCredentials
readList :: ReadS [GetTemporaryGluePartitionCredentials]
$creadList :: ReadS [GetTemporaryGluePartitionCredentials]
readsPrec :: Int -> ReadS GetTemporaryGluePartitionCredentials
$creadsPrec :: Int -> ReadS GetTemporaryGluePartitionCredentials
Prelude.Read, Int -> GetTemporaryGluePartitionCredentials -> ShowS
[GetTemporaryGluePartitionCredentials] -> ShowS
GetTemporaryGluePartitionCredentials -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTemporaryGluePartitionCredentials] -> ShowS
$cshowList :: [GetTemporaryGluePartitionCredentials] -> ShowS
show :: GetTemporaryGluePartitionCredentials -> String
$cshow :: GetTemporaryGluePartitionCredentials -> String
showsPrec :: Int -> GetTemporaryGluePartitionCredentials -> ShowS
$cshowsPrec :: Int -> GetTemporaryGluePartitionCredentials -> ShowS
Prelude.Show, forall x.
Rep GetTemporaryGluePartitionCredentials x
-> GetTemporaryGluePartitionCredentials
forall x.
GetTemporaryGluePartitionCredentials
-> Rep GetTemporaryGluePartitionCredentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetTemporaryGluePartitionCredentials x
-> GetTemporaryGluePartitionCredentials
$cfrom :: forall x.
GetTemporaryGluePartitionCredentials
-> Rep GetTemporaryGluePartitionCredentials x
Prelude.Generic)

-- |
-- Create a value of 'GetTemporaryGluePartitionCredentials' 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', 'getTemporaryGluePartitionCredentials_auditContext' - A structure representing context to access a resource (column names,
-- query ID, etc).
--
-- 'durationSeconds', 'getTemporaryGluePartitionCredentials_durationSeconds' - The time period, between 900 and 21,600 seconds, for the timeout of the
-- temporary credentials.
--
-- 'permissions', 'getTemporaryGluePartitionCredentials_permissions' - Filters the request based on the user having been granted a list of
-- specified permissions on the requested resource(s).
--
-- 'tableArn', 'getTemporaryGluePartitionCredentials_tableArn' - The ARN of the partitions\' table.
--
-- 'partition', 'getTemporaryGluePartitionCredentials_partition' - A list of partition values identifying a single partition.
--
-- 'supportedPermissionTypes', 'getTemporaryGluePartitionCredentials_supportedPermissionTypes' - A list of supported permission types for the partition. Valid values are
-- @COLUMN_PERMISSION@ and @CELL_FILTER_PERMISSION@.
newGetTemporaryGluePartitionCredentials ::
  -- | 'tableArn'
  Prelude.Text ->
  -- | 'partition'
  PartitionValueList ->
  -- | 'supportedPermissionTypes'
  Prelude.NonEmpty PermissionType ->
  GetTemporaryGluePartitionCredentials
newGetTemporaryGluePartitionCredentials :: Text
-> PartitionValueList
-> NonEmpty PermissionType
-> GetTemporaryGluePartitionCredentials
newGetTemporaryGluePartitionCredentials
  Text
pTableArn_
  PartitionValueList
pPartition_
  NonEmpty PermissionType
pSupportedPermissionTypes_ =
    GetTemporaryGluePartitionCredentials'
      { $sel:auditContext:GetTemporaryGluePartitionCredentials' :: Maybe AuditContext
auditContext =
          forall a. Maybe a
Prelude.Nothing,
        $sel:durationSeconds:GetTemporaryGluePartitionCredentials' :: Maybe Natural
durationSeconds = forall a. Maybe a
Prelude.Nothing,
        $sel:permissions:GetTemporaryGluePartitionCredentials' :: Maybe [Permission]
permissions = forall a. Maybe a
Prelude.Nothing,
        $sel:tableArn:GetTemporaryGluePartitionCredentials' :: Text
tableArn = Text
pTableArn_,
        $sel:partition:GetTemporaryGluePartitionCredentials' :: PartitionValueList
partition = PartitionValueList
pPartition_,
        $sel:supportedPermissionTypes:GetTemporaryGluePartitionCredentials' :: 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_
      }

-- | A structure representing context to access a resource (column names,
-- query ID, etc).
getTemporaryGluePartitionCredentials_auditContext :: Lens.Lens' GetTemporaryGluePartitionCredentials (Prelude.Maybe AuditContext)
getTemporaryGluePartitionCredentials_auditContext :: Lens' GetTemporaryGluePartitionCredentials (Maybe AuditContext)
getTemporaryGluePartitionCredentials_auditContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemporaryGluePartitionCredentials' {Maybe AuditContext
auditContext :: Maybe AuditContext
$sel:auditContext:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Maybe AuditContext
auditContext} -> Maybe AuditContext
auditContext) (\s :: GetTemporaryGluePartitionCredentials
s@GetTemporaryGluePartitionCredentials' {} Maybe AuditContext
a -> GetTemporaryGluePartitionCredentials
s {$sel:auditContext:GetTemporaryGluePartitionCredentials' :: Maybe AuditContext
auditContext = Maybe AuditContext
a} :: GetTemporaryGluePartitionCredentials)

-- | The time period, between 900 and 21,600 seconds, for the timeout of the
-- temporary credentials.
getTemporaryGluePartitionCredentials_durationSeconds :: Lens.Lens' GetTemporaryGluePartitionCredentials (Prelude.Maybe Prelude.Natural)
getTemporaryGluePartitionCredentials_durationSeconds :: Lens' GetTemporaryGluePartitionCredentials (Maybe Natural)
getTemporaryGluePartitionCredentials_durationSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemporaryGluePartitionCredentials' {Maybe Natural
durationSeconds :: Maybe Natural
$sel:durationSeconds:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Maybe Natural
durationSeconds} -> Maybe Natural
durationSeconds) (\s :: GetTemporaryGluePartitionCredentials
s@GetTemporaryGluePartitionCredentials' {} Maybe Natural
a -> GetTemporaryGluePartitionCredentials
s {$sel:durationSeconds:GetTemporaryGluePartitionCredentials' :: Maybe Natural
durationSeconds = Maybe Natural
a} :: GetTemporaryGluePartitionCredentials)

-- | Filters the request based on the user having been granted a list of
-- specified permissions on the requested resource(s).
getTemporaryGluePartitionCredentials_permissions :: Lens.Lens' GetTemporaryGluePartitionCredentials (Prelude.Maybe [Permission])
getTemporaryGluePartitionCredentials_permissions :: Lens' GetTemporaryGluePartitionCredentials (Maybe [Permission])
getTemporaryGluePartitionCredentials_permissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemporaryGluePartitionCredentials' {Maybe [Permission]
permissions :: Maybe [Permission]
$sel:permissions:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Maybe [Permission]
permissions} -> Maybe [Permission]
permissions) (\s :: GetTemporaryGluePartitionCredentials
s@GetTemporaryGluePartitionCredentials' {} Maybe [Permission]
a -> GetTemporaryGluePartitionCredentials
s {$sel:permissions:GetTemporaryGluePartitionCredentials' :: Maybe [Permission]
permissions = Maybe [Permission]
a} :: GetTemporaryGluePartitionCredentials) 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 ARN of the partitions\' table.
getTemporaryGluePartitionCredentials_tableArn :: Lens.Lens' GetTemporaryGluePartitionCredentials Prelude.Text
getTemporaryGluePartitionCredentials_tableArn :: Lens' GetTemporaryGluePartitionCredentials Text
getTemporaryGluePartitionCredentials_tableArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemporaryGluePartitionCredentials' {Text
tableArn :: Text
$sel:tableArn:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Text
tableArn} -> Text
tableArn) (\s :: GetTemporaryGluePartitionCredentials
s@GetTemporaryGluePartitionCredentials' {} Text
a -> GetTemporaryGluePartitionCredentials
s {$sel:tableArn:GetTemporaryGluePartitionCredentials' :: Text
tableArn = Text
a} :: GetTemporaryGluePartitionCredentials)

-- | A list of partition values identifying a single partition.
getTemporaryGluePartitionCredentials_partition :: Lens.Lens' GetTemporaryGluePartitionCredentials PartitionValueList
getTemporaryGluePartitionCredentials_partition :: Lens' GetTemporaryGluePartitionCredentials PartitionValueList
getTemporaryGluePartitionCredentials_partition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemporaryGluePartitionCredentials' {PartitionValueList
partition :: PartitionValueList
$sel:partition:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> PartitionValueList
partition} -> PartitionValueList
partition) (\s :: GetTemporaryGluePartitionCredentials
s@GetTemporaryGluePartitionCredentials' {} PartitionValueList
a -> GetTemporaryGluePartitionCredentials
s {$sel:partition:GetTemporaryGluePartitionCredentials' :: PartitionValueList
partition = PartitionValueList
a} :: GetTemporaryGluePartitionCredentials)

-- | A list of supported permission types for the partition. Valid values are
-- @COLUMN_PERMISSION@ and @CELL_FILTER_PERMISSION@.
getTemporaryGluePartitionCredentials_supportedPermissionTypes :: Lens.Lens' GetTemporaryGluePartitionCredentials (Prelude.NonEmpty PermissionType)
getTemporaryGluePartitionCredentials_supportedPermissionTypes :: Lens'
  GetTemporaryGluePartitionCredentials (NonEmpty PermissionType)
getTemporaryGluePartitionCredentials_supportedPermissionTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemporaryGluePartitionCredentials' {NonEmpty PermissionType
supportedPermissionTypes :: NonEmpty PermissionType
$sel:supportedPermissionTypes:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> NonEmpty PermissionType
supportedPermissionTypes} -> NonEmpty PermissionType
supportedPermissionTypes) (\s :: GetTemporaryGluePartitionCredentials
s@GetTemporaryGluePartitionCredentials' {} NonEmpty PermissionType
a -> GetTemporaryGluePartitionCredentials
s {$sel:supportedPermissionTypes:GetTemporaryGluePartitionCredentials' :: NonEmpty PermissionType
supportedPermissionTypes = NonEmpty PermissionType
a} :: GetTemporaryGluePartitionCredentials) 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
    GetTemporaryGluePartitionCredentials
  where
  type
    AWSResponse GetTemporaryGluePartitionCredentials =
      GetTemporaryGluePartitionCredentialsResponse
  request :: (Service -> Service)
-> GetTemporaryGluePartitionCredentials
-> Request GetTemporaryGluePartitionCredentials
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 GetTemporaryGluePartitionCredentials
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse GetTemporaryGluePartitionCredentials)))
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 POSIX
-> Maybe Text
-> Maybe Text
-> Int
-> GetTemporaryGluePartitionCredentialsResponse
GetTemporaryGluePartitionCredentialsResponse'
            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
"AccessKeyId")
            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
"Expiration")
            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
"SecretAccessKey")
            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
"SessionToken")
            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
    GetTemporaryGluePartitionCredentials
  where
  hashWithSalt :: Int -> GetTemporaryGluePartitionCredentials -> Int
hashWithSalt
    Int
_salt
    GetTemporaryGluePartitionCredentials' {Maybe Natural
Maybe [Permission]
Maybe AuditContext
NonEmpty PermissionType
Text
PartitionValueList
supportedPermissionTypes :: NonEmpty PermissionType
partition :: PartitionValueList
tableArn :: Text
permissions :: Maybe [Permission]
durationSeconds :: Maybe Natural
auditContext :: Maybe AuditContext
$sel:supportedPermissionTypes:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> NonEmpty PermissionType
$sel:partition:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> PartitionValueList
$sel:tableArn:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Text
$sel:permissions:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Maybe [Permission]
$sel:durationSeconds:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Maybe Natural
$sel:auditContext:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> 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` Maybe Natural
durationSeconds
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Permission]
permissions
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PartitionValueList
partition
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty PermissionType
supportedPermissionTypes

instance
  Prelude.NFData
    GetTemporaryGluePartitionCredentials
  where
  rnf :: GetTemporaryGluePartitionCredentials -> ()
rnf GetTemporaryGluePartitionCredentials' {Maybe Natural
Maybe [Permission]
Maybe AuditContext
NonEmpty PermissionType
Text
PartitionValueList
supportedPermissionTypes :: NonEmpty PermissionType
partition :: PartitionValueList
tableArn :: Text
permissions :: Maybe [Permission]
durationSeconds :: Maybe Natural
auditContext :: Maybe AuditContext
$sel:supportedPermissionTypes:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> NonEmpty PermissionType
$sel:partition:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> PartitionValueList
$sel:tableArn:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Text
$sel:permissions:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Maybe [Permission]
$sel:durationSeconds:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Maybe Natural
$sel:auditContext:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> 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 Maybe Natural
durationSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Permission]
permissions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
tableArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PartitionValueList
partition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty PermissionType
supportedPermissionTypes

instance
  Data.ToHeaders
    GetTemporaryGluePartitionCredentials
  where
  toHeaders :: GetTemporaryGluePartitionCredentials -> 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
    GetTemporaryGluePartitionCredentials
  where
  toJSON :: GetTemporaryGluePartitionCredentials -> Value
toJSON GetTemporaryGluePartitionCredentials' {Maybe Natural
Maybe [Permission]
Maybe AuditContext
NonEmpty PermissionType
Text
PartitionValueList
supportedPermissionTypes :: NonEmpty PermissionType
partition :: PartitionValueList
tableArn :: Text
permissions :: Maybe [Permission]
durationSeconds :: Maybe Natural
auditContext :: Maybe AuditContext
$sel:supportedPermissionTypes:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> NonEmpty PermissionType
$sel:partition:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> PartitionValueList
$sel:tableArn:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Text
$sel:permissions:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Maybe [Permission]
$sel:durationSeconds:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> Maybe Natural
$sel:auditContext:GetTemporaryGluePartitionCredentials' :: GetTemporaryGluePartitionCredentials -> 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,
            (Key
"DurationSeconds" 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 Natural
durationSeconds,
            (Key
"Permissions" 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]
permissions,
            forall a. a -> Maybe a
Prelude.Just (Key
"TableArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
tableArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"Partition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PartitionValueList
partition),
            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
    GetTemporaryGluePartitionCredentials
  where
  toPath :: GetTemporaryGluePartitionCredentials -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/GetTemporaryGluePartitionCredentials"

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

-- | /See:/ 'newGetTemporaryGluePartitionCredentialsResponse' smart constructor.
data GetTemporaryGluePartitionCredentialsResponse = GetTemporaryGluePartitionCredentialsResponse'
  { -- | The access key ID for the temporary credentials.
    GetTemporaryGluePartitionCredentialsResponse -> Maybe Text
accessKeyId :: Prelude.Maybe Prelude.Text,
    -- | The date and time when the temporary credentials expire.
    GetTemporaryGluePartitionCredentialsResponse -> Maybe POSIX
expiration :: Prelude.Maybe Data.POSIX,
    -- | The secret key for the temporary credentials.
    GetTemporaryGluePartitionCredentialsResponse -> Maybe Text
secretAccessKey :: Prelude.Maybe Prelude.Text,
    -- | The session token for the temporary credentials.
    GetTemporaryGluePartitionCredentialsResponse -> Maybe Text
sessionToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetTemporaryGluePartitionCredentialsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetTemporaryGluePartitionCredentialsResponse
-> GetTemporaryGluePartitionCredentialsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTemporaryGluePartitionCredentialsResponse
-> GetTemporaryGluePartitionCredentialsResponse -> Bool
$c/= :: GetTemporaryGluePartitionCredentialsResponse
-> GetTemporaryGluePartitionCredentialsResponse -> Bool
== :: GetTemporaryGluePartitionCredentialsResponse
-> GetTemporaryGluePartitionCredentialsResponse -> Bool
$c== :: GetTemporaryGluePartitionCredentialsResponse
-> GetTemporaryGluePartitionCredentialsResponse -> Bool
Prelude.Eq, ReadPrec [GetTemporaryGluePartitionCredentialsResponse]
ReadPrec GetTemporaryGluePartitionCredentialsResponse
Int -> ReadS GetTemporaryGluePartitionCredentialsResponse
ReadS [GetTemporaryGluePartitionCredentialsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTemporaryGluePartitionCredentialsResponse]
$creadListPrec :: ReadPrec [GetTemporaryGluePartitionCredentialsResponse]
readPrec :: ReadPrec GetTemporaryGluePartitionCredentialsResponse
$creadPrec :: ReadPrec GetTemporaryGluePartitionCredentialsResponse
readList :: ReadS [GetTemporaryGluePartitionCredentialsResponse]
$creadList :: ReadS [GetTemporaryGluePartitionCredentialsResponse]
readsPrec :: Int -> ReadS GetTemporaryGluePartitionCredentialsResponse
$creadsPrec :: Int -> ReadS GetTemporaryGluePartitionCredentialsResponse
Prelude.Read, Int -> GetTemporaryGluePartitionCredentialsResponse -> ShowS
[GetTemporaryGluePartitionCredentialsResponse] -> ShowS
GetTemporaryGluePartitionCredentialsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTemporaryGluePartitionCredentialsResponse] -> ShowS
$cshowList :: [GetTemporaryGluePartitionCredentialsResponse] -> ShowS
show :: GetTemporaryGluePartitionCredentialsResponse -> String
$cshow :: GetTemporaryGluePartitionCredentialsResponse -> String
showsPrec :: Int -> GetTemporaryGluePartitionCredentialsResponse -> ShowS
$cshowsPrec :: Int -> GetTemporaryGluePartitionCredentialsResponse -> ShowS
Prelude.Show, forall x.
Rep GetTemporaryGluePartitionCredentialsResponse x
-> GetTemporaryGluePartitionCredentialsResponse
forall x.
GetTemporaryGluePartitionCredentialsResponse
-> Rep GetTemporaryGluePartitionCredentialsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetTemporaryGluePartitionCredentialsResponse x
-> GetTemporaryGluePartitionCredentialsResponse
$cfrom :: forall x.
GetTemporaryGluePartitionCredentialsResponse
-> Rep GetTemporaryGluePartitionCredentialsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTemporaryGluePartitionCredentialsResponse' 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:
--
-- 'accessKeyId', 'getTemporaryGluePartitionCredentialsResponse_accessKeyId' - The access key ID for the temporary credentials.
--
-- 'expiration', 'getTemporaryGluePartitionCredentialsResponse_expiration' - The date and time when the temporary credentials expire.
--
-- 'secretAccessKey', 'getTemporaryGluePartitionCredentialsResponse_secretAccessKey' - The secret key for the temporary credentials.
--
-- 'sessionToken', 'getTemporaryGluePartitionCredentialsResponse_sessionToken' - The session token for the temporary credentials.
--
-- 'httpStatus', 'getTemporaryGluePartitionCredentialsResponse_httpStatus' - The response's http status code.
newGetTemporaryGluePartitionCredentialsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTemporaryGluePartitionCredentialsResponse
newGetTemporaryGluePartitionCredentialsResponse :: Int -> GetTemporaryGluePartitionCredentialsResponse
newGetTemporaryGluePartitionCredentialsResponse
  Int
pHttpStatus_ =
    GetTemporaryGluePartitionCredentialsResponse'
      { $sel:accessKeyId:GetTemporaryGluePartitionCredentialsResponse' :: Maybe Text
accessKeyId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:expiration:GetTemporaryGluePartitionCredentialsResponse' :: Maybe POSIX
expiration = forall a. Maybe a
Prelude.Nothing,
        $sel:secretAccessKey:GetTemporaryGluePartitionCredentialsResponse' :: Maybe Text
secretAccessKey =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sessionToken:GetTemporaryGluePartitionCredentialsResponse' :: Maybe Text
sessionToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetTemporaryGluePartitionCredentialsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The access key ID for the temporary credentials.
getTemporaryGluePartitionCredentialsResponse_accessKeyId :: Lens.Lens' GetTemporaryGluePartitionCredentialsResponse (Prelude.Maybe Prelude.Text)
getTemporaryGluePartitionCredentialsResponse_accessKeyId :: Lens' GetTemporaryGluePartitionCredentialsResponse (Maybe Text)
getTemporaryGluePartitionCredentialsResponse_accessKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemporaryGluePartitionCredentialsResponse' {Maybe Text
accessKeyId :: Maybe Text
$sel:accessKeyId:GetTemporaryGluePartitionCredentialsResponse' :: GetTemporaryGluePartitionCredentialsResponse -> Maybe Text
accessKeyId} -> Maybe Text
accessKeyId) (\s :: GetTemporaryGluePartitionCredentialsResponse
s@GetTemporaryGluePartitionCredentialsResponse' {} Maybe Text
a -> GetTemporaryGluePartitionCredentialsResponse
s {$sel:accessKeyId:GetTemporaryGluePartitionCredentialsResponse' :: Maybe Text
accessKeyId = Maybe Text
a} :: GetTemporaryGluePartitionCredentialsResponse)

-- | The date and time when the temporary credentials expire.
getTemporaryGluePartitionCredentialsResponse_expiration :: Lens.Lens' GetTemporaryGluePartitionCredentialsResponse (Prelude.Maybe Prelude.UTCTime)
getTemporaryGluePartitionCredentialsResponse_expiration :: Lens' GetTemporaryGluePartitionCredentialsResponse (Maybe UTCTime)
getTemporaryGluePartitionCredentialsResponse_expiration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemporaryGluePartitionCredentialsResponse' {Maybe POSIX
expiration :: Maybe POSIX
$sel:expiration:GetTemporaryGluePartitionCredentialsResponse' :: GetTemporaryGluePartitionCredentialsResponse -> Maybe POSIX
expiration} -> Maybe POSIX
expiration) (\s :: GetTemporaryGluePartitionCredentialsResponse
s@GetTemporaryGluePartitionCredentialsResponse' {} Maybe POSIX
a -> GetTemporaryGluePartitionCredentialsResponse
s {$sel:expiration:GetTemporaryGluePartitionCredentialsResponse' :: Maybe POSIX
expiration = Maybe POSIX
a} :: GetTemporaryGluePartitionCredentialsResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The secret key for the temporary credentials.
getTemporaryGluePartitionCredentialsResponse_secretAccessKey :: Lens.Lens' GetTemporaryGluePartitionCredentialsResponse (Prelude.Maybe Prelude.Text)
getTemporaryGluePartitionCredentialsResponse_secretAccessKey :: Lens' GetTemporaryGluePartitionCredentialsResponse (Maybe Text)
getTemporaryGluePartitionCredentialsResponse_secretAccessKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemporaryGluePartitionCredentialsResponse' {Maybe Text
secretAccessKey :: Maybe Text
$sel:secretAccessKey:GetTemporaryGluePartitionCredentialsResponse' :: GetTemporaryGluePartitionCredentialsResponse -> Maybe Text
secretAccessKey} -> Maybe Text
secretAccessKey) (\s :: GetTemporaryGluePartitionCredentialsResponse
s@GetTemporaryGluePartitionCredentialsResponse' {} Maybe Text
a -> GetTemporaryGluePartitionCredentialsResponse
s {$sel:secretAccessKey:GetTemporaryGluePartitionCredentialsResponse' :: Maybe Text
secretAccessKey = Maybe Text
a} :: GetTemporaryGluePartitionCredentialsResponse)

-- | The session token for the temporary credentials.
getTemporaryGluePartitionCredentialsResponse_sessionToken :: Lens.Lens' GetTemporaryGluePartitionCredentialsResponse (Prelude.Maybe Prelude.Text)
getTemporaryGluePartitionCredentialsResponse_sessionToken :: Lens' GetTemporaryGluePartitionCredentialsResponse (Maybe Text)
getTemporaryGluePartitionCredentialsResponse_sessionToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTemporaryGluePartitionCredentialsResponse' {Maybe Text
sessionToken :: Maybe Text
$sel:sessionToken:GetTemporaryGluePartitionCredentialsResponse' :: GetTemporaryGluePartitionCredentialsResponse -> Maybe Text
sessionToken} -> Maybe Text
sessionToken) (\s :: GetTemporaryGluePartitionCredentialsResponse
s@GetTemporaryGluePartitionCredentialsResponse' {} Maybe Text
a -> GetTemporaryGluePartitionCredentialsResponse
s {$sel:sessionToken:GetTemporaryGluePartitionCredentialsResponse' :: Maybe Text
sessionToken = Maybe Text
a} :: GetTemporaryGluePartitionCredentialsResponse)

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

instance
  Prelude.NFData
    GetTemporaryGluePartitionCredentialsResponse
  where
  rnf :: GetTemporaryGluePartitionCredentialsResponse -> ()
rnf GetTemporaryGluePartitionCredentialsResponse' {Int
Maybe Text
Maybe POSIX
httpStatus :: Int
sessionToken :: Maybe Text
secretAccessKey :: Maybe Text
expiration :: Maybe POSIX
accessKeyId :: Maybe Text
$sel:httpStatus:GetTemporaryGluePartitionCredentialsResponse' :: GetTemporaryGluePartitionCredentialsResponse -> Int
$sel:sessionToken:GetTemporaryGluePartitionCredentialsResponse' :: GetTemporaryGluePartitionCredentialsResponse -> Maybe Text
$sel:secretAccessKey:GetTemporaryGluePartitionCredentialsResponse' :: GetTemporaryGluePartitionCredentialsResponse -> Maybe Text
$sel:expiration:GetTemporaryGluePartitionCredentialsResponse' :: GetTemporaryGluePartitionCredentialsResponse -> Maybe POSIX
$sel:accessKeyId:GetTemporaryGluePartitionCredentialsResponse' :: GetTemporaryGluePartitionCredentialsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accessKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
expiration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
secretAccessKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sessionToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus