{-# 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.BatchGetPartition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves partitions in a batch request.
module Amazonka.Glue.BatchGetPartition
  ( -- * Creating a Request
    BatchGetPartition (..),
    newBatchGetPartition,

    -- * Request Lenses
    batchGetPartition_catalogId,
    batchGetPartition_databaseName,
    batchGetPartition_tableName,
    batchGetPartition_partitionsToGet,

    -- * Destructuring the Response
    BatchGetPartitionResponse (..),
    newBatchGetPartitionResponse,

    -- * Response Lenses
    batchGetPartitionResponse_partitions,
    batchGetPartitionResponse_unprocessedKeys,
    batchGetPartitionResponse_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:/ 'newBatchGetPartition' smart constructor.
data BatchGetPartition = BatchGetPartition'
  { -- | The ID of the Data Catalog where the partitions in question reside. If
    -- none is supplied, the Amazon Web Services account ID is used by default.
    BatchGetPartition -> Maybe Text
catalogId :: Prelude.Maybe Prelude.Text,
    -- | The name of the catalog database where the partitions reside.
    BatchGetPartition -> Text
databaseName :: Prelude.Text,
    -- | The name of the partitions\' table.
    BatchGetPartition -> Text
tableName :: Prelude.Text,
    -- | A list of partition values identifying the partitions to retrieve.
    BatchGetPartition -> [PartitionValueList]
partitionsToGet :: [PartitionValueList]
  }
  deriving (BatchGetPartition -> BatchGetPartition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetPartition -> BatchGetPartition -> Bool
$c/= :: BatchGetPartition -> BatchGetPartition -> Bool
== :: BatchGetPartition -> BatchGetPartition -> Bool
$c== :: BatchGetPartition -> BatchGetPartition -> Bool
Prelude.Eq, ReadPrec [BatchGetPartition]
ReadPrec BatchGetPartition
Int -> ReadS BatchGetPartition
ReadS [BatchGetPartition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetPartition]
$creadListPrec :: ReadPrec [BatchGetPartition]
readPrec :: ReadPrec BatchGetPartition
$creadPrec :: ReadPrec BatchGetPartition
readList :: ReadS [BatchGetPartition]
$creadList :: ReadS [BatchGetPartition]
readsPrec :: Int -> ReadS BatchGetPartition
$creadsPrec :: Int -> ReadS BatchGetPartition
Prelude.Read, Int -> BatchGetPartition -> ShowS
[BatchGetPartition] -> ShowS
BatchGetPartition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetPartition] -> ShowS
$cshowList :: [BatchGetPartition] -> ShowS
show :: BatchGetPartition -> String
$cshow :: BatchGetPartition -> String
showsPrec :: Int -> BatchGetPartition -> ShowS
$cshowsPrec :: Int -> BatchGetPartition -> ShowS
Prelude.Show, forall x. Rep BatchGetPartition x -> BatchGetPartition
forall x. BatchGetPartition -> Rep BatchGetPartition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetPartition x -> BatchGetPartition
$cfrom :: forall x. BatchGetPartition -> Rep BatchGetPartition x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetPartition' 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', 'batchGetPartition_catalogId' - The ID of the Data Catalog where the partitions in question reside. If
-- none is supplied, the Amazon Web Services account ID is used by default.
--
-- 'databaseName', 'batchGetPartition_databaseName' - The name of the catalog database where the partitions reside.
--
-- 'tableName', 'batchGetPartition_tableName' - The name of the partitions\' table.
--
-- 'partitionsToGet', 'batchGetPartition_partitionsToGet' - A list of partition values identifying the partitions to retrieve.
newBatchGetPartition ::
  -- | 'databaseName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  BatchGetPartition
newBatchGetPartition :: Text -> Text -> BatchGetPartition
newBatchGetPartition Text
pDatabaseName_ Text
pTableName_ =
  BatchGetPartition'
    { $sel:catalogId:BatchGetPartition' :: Maybe Text
catalogId = forall a. Maybe a
Prelude.Nothing,
      $sel:databaseName:BatchGetPartition' :: Text
databaseName = Text
pDatabaseName_,
      $sel:tableName:BatchGetPartition' :: Text
tableName = Text
pTableName_,
      $sel:partitionsToGet:BatchGetPartition' :: [PartitionValueList]
partitionsToGet = forall a. Monoid a => a
Prelude.mempty
    }

-- | The ID of the Data Catalog where the partitions in question reside. If
-- none is supplied, the Amazon Web Services account ID is used by default.
batchGetPartition_catalogId :: Lens.Lens' BatchGetPartition (Prelude.Maybe Prelude.Text)
batchGetPartition_catalogId :: Lens' BatchGetPartition (Maybe Text)
batchGetPartition_catalogId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetPartition' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:BatchGetPartition' :: BatchGetPartition -> Maybe Text
catalogId} -> Maybe Text
catalogId) (\s :: BatchGetPartition
s@BatchGetPartition' {} Maybe Text
a -> BatchGetPartition
s {$sel:catalogId:BatchGetPartition' :: Maybe Text
catalogId = Maybe Text
a} :: BatchGetPartition)

-- | The name of the catalog database where the partitions reside.
batchGetPartition_databaseName :: Lens.Lens' BatchGetPartition Prelude.Text
batchGetPartition_databaseName :: Lens' BatchGetPartition Text
batchGetPartition_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetPartition' {Text
databaseName :: Text
$sel:databaseName:BatchGetPartition' :: BatchGetPartition -> Text
databaseName} -> Text
databaseName) (\s :: BatchGetPartition
s@BatchGetPartition' {} Text
a -> BatchGetPartition
s {$sel:databaseName:BatchGetPartition' :: Text
databaseName = Text
a} :: BatchGetPartition)

-- | The name of the partitions\' table.
batchGetPartition_tableName :: Lens.Lens' BatchGetPartition Prelude.Text
batchGetPartition_tableName :: Lens' BatchGetPartition Text
batchGetPartition_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetPartition' {Text
tableName :: Text
$sel:tableName:BatchGetPartition' :: BatchGetPartition -> Text
tableName} -> Text
tableName) (\s :: BatchGetPartition
s@BatchGetPartition' {} Text
a -> BatchGetPartition
s {$sel:tableName:BatchGetPartition' :: Text
tableName = Text
a} :: BatchGetPartition)

-- | A list of partition values identifying the partitions to retrieve.
batchGetPartition_partitionsToGet :: Lens.Lens' BatchGetPartition [PartitionValueList]
batchGetPartition_partitionsToGet :: Lens' BatchGetPartition [PartitionValueList]
batchGetPartition_partitionsToGet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetPartition' {[PartitionValueList]
partitionsToGet :: [PartitionValueList]
$sel:partitionsToGet:BatchGetPartition' :: BatchGetPartition -> [PartitionValueList]
partitionsToGet} -> [PartitionValueList]
partitionsToGet) (\s :: BatchGetPartition
s@BatchGetPartition' {} [PartitionValueList]
a -> BatchGetPartition
s {$sel:partitionsToGet:BatchGetPartition' :: [PartitionValueList]
partitionsToGet = [PartitionValueList]
a} :: BatchGetPartition) 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 BatchGetPartition where
  type
    AWSResponse BatchGetPartition =
      BatchGetPartitionResponse
  request :: (Service -> Service)
-> BatchGetPartition -> Request BatchGetPartition
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 BatchGetPartition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetPartition)))
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 [Partition]
-> Maybe [PartitionValueList] -> Int -> BatchGetPartitionResponse
BatchGetPartitionResponse'
            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
"Partitions" 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
"UnprocessedKeys"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable BatchGetPartition where
  hashWithSalt :: Int -> BatchGetPartition -> Int
hashWithSalt Int
_salt BatchGetPartition' {[PartitionValueList]
Maybe Text
Text
partitionsToGet :: [PartitionValueList]
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:partitionsToGet:BatchGetPartition' :: BatchGetPartition -> [PartitionValueList]
$sel:tableName:BatchGetPartition' :: BatchGetPartition -> Text
$sel:databaseName:BatchGetPartition' :: BatchGetPartition -> Text
$sel:catalogId:BatchGetPartition' :: BatchGetPartition -> 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` Text
databaseName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [PartitionValueList]
partitionsToGet

instance Prelude.NFData BatchGetPartition where
  rnf :: BatchGetPartition -> ()
rnf BatchGetPartition' {[PartitionValueList]
Maybe Text
Text
partitionsToGet :: [PartitionValueList]
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:partitionsToGet:BatchGetPartition' :: BatchGetPartition -> [PartitionValueList]
$sel:tableName:BatchGetPartition' :: BatchGetPartition -> Text
$sel:databaseName:BatchGetPartition' :: BatchGetPartition -> Text
$sel:catalogId:BatchGetPartition' :: BatchGetPartition -> 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 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 [PartitionValueList]
partitionsToGet

instance Data.ToHeaders BatchGetPartition where
  toHeaders :: BatchGetPartition -> 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.BatchGetPartition" :: 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 BatchGetPartition where
  toJSON :: BatchGetPartition -> Value
toJSON BatchGetPartition' {[PartitionValueList]
Maybe Text
Text
partitionsToGet :: [PartitionValueList]
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:partitionsToGet:BatchGetPartition' :: BatchGetPartition -> [PartitionValueList]
$sel:tableName:BatchGetPartition' :: BatchGetPartition -> Text
$sel:databaseName:BatchGetPartition' :: BatchGetPartition -> Text
$sel:catalogId:BatchGetPartition' :: BatchGetPartition -> 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,
            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
"PartitionsToGet" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [PartitionValueList]
partitionsToGet)
          ]
      )

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

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

-- | /See:/ 'newBatchGetPartitionResponse' smart constructor.
data BatchGetPartitionResponse = BatchGetPartitionResponse'
  { -- | A list of the requested partitions.
    BatchGetPartitionResponse -> Maybe [Partition]
partitions :: Prelude.Maybe [Partition],
    -- | A list of the partition values in the request for which partitions were
    -- not returned.
    BatchGetPartitionResponse -> Maybe [PartitionValueList]
unprocessedKeys :: Prelude.Maybe [PartitionValueList],
    -- | The response's http status code.
    BatchGetPartitionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetPartitionResponse -> BatchGetPartitionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetPartitionResponse -> BatchGetPartitionResponse -> Bool
$c/= :: BatchGetPartitionResponse -> BatchGetPartitionResponse -> Bool
== :: BatchGetPartitionResponse -> BatchGetPartitionResponse -> Bool
$c== :: BatchGetPartitionResponse -> BatchGetPartitionResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetPartitionResponse]
ReadPrec BatchGetPartitionResponse
Int -> ReadS BatchGetPartitionResponse
ReadS [BatchGetPartitionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetPartitionResponse]
$creadListPrec :: ReadPrec [BatchGetPartitionResponse]
readPrec :: ReadPrec BatchGetPartitionResponse
$creadPrec :: ReadPrec BatchGetPartitionResponse
readList :: ReadS [BatchGetPartitionResponse]
$creadList :: ReadS [BatchGetPartitionResponse]
readsPrec :: Int -> ReadS BatchGetPartitionResponse
$creadsPrec :: Int -> ReadS BatchGetPartitionResponse
Prelude.Read, Int -> BatchGetPartitionResponse -> ShowS
[BatchGetPartitionResponse] -> ShowS
BatchGetPartitionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetPartitionResponse] -> ShowS
$cshowList :: [BatchGetPartitionResponse] -> ShowS
show :: BatchGetPartitionResponse -> String
$cshow :: BatchGetPartitionResponse -> String
showsPrec :: Int -> BatchGetPartitionResponse -> ShowS
$cshowsPrec :: Int -> BatchGetPartitionResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetPartitionResponse x -> BatchGetPartitionResponse
forall x.
BatchGetPartitionResponse -> Rep BatchGetPartitionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetPartitionResponse x -> BatchGetPartitionResponse
$cfrom :: forall x.
BatchGetPartitionResponse -> Rep BatchGetPartitionResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetPartitionResponse' 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:
--
-- 'partitions', 'batchGetPartitionResponse_partitions' - A list of the requested partitions.
--
-- 'unprocessedKeys', 'batchGetPartitionResponse_unprocessedKeys' - A list of the partition values in the request for which partitions were
-- not returned.
--
-- 'httpStatus', 'batchGetPartitionResponse_httpStatus' - The response's http status code.
newBatchGetPartitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetPartitionResponse
newBatchGetPartitionResponse :: Int -> BatchGetPartitionResponse
newBatchGetPartitionResponse Int
pHttpStatus_ =
  BatchGetPartitionResponse'
    { $sel:partitions:BatchGetPartitionResponse' :: Maybe [Partition]
partitions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:unprocessedKeys:BatchGetPartitionResponse' :: Maybe [PartitionValueList]
unprocessedKeys = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetPartitionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of the requested partitions.
batchGetPartitionResponse_partitions :: Lens.Lens' BatchGetPartitionResponse (Prelude.Maybe [Partition])
batchGetPartitionResponse_partitions :: Lens' BatchGetPartitionResponse (Maybe [Partition])
batchGetPartitionResponse_partitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetPartitionResponse' {Maybe [Partition]
partitions :: Maybe [Partition]
$sel:partitions:BatchGetPartitionResponse' :: BatchGetPartitionResponse -> Maybe [Partition]
partitions} -> Maybe [Partition]
partitions) (\s :: BatchGetPartitionResponse
s@BatchGetPartitionResponse' {} Maybe [Partition]
a -> BatchGetPartitionResponse
s {$sel:partitions:BatchGetPartitionResponse' :: Maybe [Partition]
partitions = Maybe [Partition]
a} :: BatchGetPartitionResponse) 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

-- | A list of the partition values in the request for which partitions were
-- not returned.
batchGetPartitionResponse_unprocessedKeys :: Lens.Lens' BatchGetPartitionResponse (Prelude.Maybe [PartitionValueList])
batchGetPartitionResponse_unprocessedKeys :: Lens' BatchGetPartitionResponse (Maybe [PartitionValueList])
batchGetPartitionResponse_unprocessedKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetPartitionResponse' {Maybe [PartitionValueList]
unprocessedKeys :: Maybe [PartitionValueList]
$sel:unprocessedKeys:BatchGetPartitionResponse' :: BatchGetPartitionResponse -> Maybe [PartitionValueList]
unprocessedKeys} -> Maybe [PartitionValueList]
unprocessedKeys) (\s :: BatchGetPartitionResponse
s@BatchGetPartitionResponse' {} Maybe [PartitionValueList]
a -> BatchGetPartitionResponse
s {$sel:unprocessedKeys:BatchGetPartitionResponse' :: Maybe [PartitionValueList]
unprocessedKeys = Maybe [PartitionValueList]
a} :: BatchGetPartitionResponse) 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 response's http status code.
batchGetPartitionResponse_httpStatus :: Lens.Lens' BatchGetPartitionResponse Prelude.Int
batchGetPartitionResponse_httpStatus :: Lens' BatchGetPartitionResponse Int
batchGetPartitionResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetPartitionResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetPartitionResponse' :: BatchGetPartitionResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetPartitionResponse
s@BatchGetPartitionResponse' {} Int
a -> BatchGetPartitionResponse
s {$sel:httpStatus:BatchGetPartitionResponse' :: Int
httpStatus = Int
a} :: BatchGetPartitionResponse)

instance Prelude.NFData BatchGetPartitionResponse where
  rnf :: BatchGetPartitionResponse -> ()
rnf BatchGetPartitionResponse' {Int
Maybe [PartitionValueList]
Maybe [Partition]
httpStatus :: Int
unprocessedKeys :: Maybe [PartitionValueList]
partitions :: Maybe [Partition]
$sel:httpStatus:BatchGetPartitionResponse' :: BatchGetPartitionResponse -> Int
$sel:unprocessedKeys:BatchGetPartitionResponse' :: BatchGetPartitionResponse -> Maybe [PartitionValueList]
$sel:partitions:BatchGetPartitionResponse' :: BatchGetPartitionResponse -> Maybe [Partition]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Partition]
partitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PartitionValueList]
unprocessedKeys
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus