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

    -- * Request Lenses
    batchUpdatePartition_catalogId,
    batchUpdatePartition_databaseName,
    batchUpdatePartition_tableName,
    batchUpdatePartition_entries,

    -- * Destructuring the Response
    BatchUpdatePartitionResponse (..),
    newBatchUpdatePartitionResponse,

    -- * Response Lenses
    batchUpdatePartitionResponse_errors,
    batchUpdatePartitionResponse_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:/ 'newBatchUpdatePartition' smart constructor.
data BatchUpdatePartition = BatchUpdatePartition'
  { -- | The ID of the catalog in which the partition is to be updated.
    -- Currently, this should be the Amazon Web Services account ID.
    BatchUpdatePartition -> Maybe Text
catalogId :: Prelude.Maybe Prelude.Text,
    -- | The name of the metadata database in which the partition is to be
    -- updated.
    BatchUpdatePartition -> Text
databaseName :: Prelude.Text,
    -- | The name of the metadata table in which the partition is to be updated.
    BatchUpdatePartition -> Text
tableName :: Prelude.Text,
    -- | A list of up to 100 @BatchUpdatePartitionRequestEntry@ objects to
    -- update.
    BatchUpdatePartition -> NonEmpty BatchUpdatePartitionRequestEntry
entries :: Prelude.NonEmpty BatchUpdatePartitionRequestEntry
  }
  deriving (BatchUpdatePartition -> BatchUpdatePartition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchUpdatePartition -> BatchUpdatePartition -> Bool
$c/= :: BatchUpdatePartition -> BatchUpdatePartition -> Bool
== :: BatchUpdatePartition -> BatchUpdatePartition -> Bool
$c== :: BatchUpdatePartition -> BatchUpdatePartition -> Bool
Prelude.Eq, ReadPrec [BatchUpdatePartition]
ReadPrec BatchUpdatePartition
Int -> ReadS BatchUpdatePartition
ReadS [BatchUpdatePartition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchUpdatePartition]
$creadListPrec :: ReadPrec [BatchUpdatePartition]
readPrec :: ReadPrec BatchUpdatePartition
$creadPrec :: ReadPrec BatchUpdatePartition
readList :: ReadS [BatchUpdatePartition]
$creadList :: ReadS [BatchUpdatePartition]
readsPrec :: Int -> ReadS BatchUpdatePartition
$creadsPrec :: Int -> ReadS BatchUpdatePartition
Prelude.Read, Int -> BatchUpdatePartition -> ShowS
[BatchUpdatePartition] -> ShowS
BatchUpdatePartition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchUpdatePartition] -> ShowS
$cshowList :: [BatchUpdatePartition] -> ShowS
show :: BatchUpdatePartition -> String
$cshow :: BatchUpdatePartition -> String
showsPrec :: Int -> BatchUpdatePartition -> ShowS
$cshowsPrec :: Int -> BatchUpdatePartition -> ShowS
Prelude.Show, forall x. Rep BatchUpdatePartition x -> BatchUpdatePartition
forall x. BatchUpdatePartition -> Rep BatchUpdatePartition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchUpdatePartition x -> BatchUpdatePartition
$cfrom :: forall x. BatchUpdatePartition -> Rep BatchUpdatePartition x
Prelude.Generic)

-- |
-- Create a value of 'BatchUpdatePartition' 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', 'batchUpdatePartition_catalogId' - The ID of the catalog in which the partition is to be updated.
-- Currently, this should be the Amazon Web Services account ID.
--
-- 'databaseName', 'batchUpdatePartition_databaseName' - The name of the metadata database in which the partition is to be
-- updated.
--
-- 'tableName', 'batchUpdatePartition_tableName' - The name of the metadata table in which the partition is to be updated.
--
-- 'entries', 'batchUpdatePartition_entries' - A list of up to 100 @BatchUpdatePartitionRequestEntry@ objects to
-- update.
newBatchUpdatePartition ::
  -- | 'databaseName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  -- | 'entries'
  Prelude.NonEmpty BatchUpdatePartitionRequestEntry ->
  BatchUpdatePartition
newBatchUpdatePartition :: Text
-> Text
-> NonEmpty BatchUpdatePartitionRequestEntry
-> BatchUpdatePartition
newBatchUpdatePartition
  Text
pDatabaseName_
  Text
pTableName_
  NonEmpty BatchUpdatePartitionRequestEntry
pEntries_ =
    BatchUpdatePartition'
      { $sel:catalogId:BatchUpdatePartition' :: Maybe Text
catalogId = forall a. Maybe a
Prelude.Nothing,
        $sel:databaseName:BatchUpdatePartition' :: Text
databaseName = Text
pDatabaseName_,
        $sel:tableName:BatchUpdatePartition' :: Text
tableName = Text
pTableName_,
        $sel:entries:BatchUpdatePartition' :: NonEmpty BatchUpdatePartitionRequestEntry
entries = 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 BatchUpdatePartitionRequestEntry
pEntries_
      }

-- | The ID of the catalog in which the partition is to be updated.
-- Currently, this should be the Amazon Web Services account ID.
batchUpdatePartition_catalogId :: Lens.Lens' BatchUpdatePartition (Prelude.Maybe Prelude.Text)
batchUpdatePartition_catalogId :: Lens' BatchUpdatePartition (Maybe Text)
batchUpdatePartition_catalogId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdatePartition' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:BatchUpdatePartition' :: BatchUpdatePartition -> Maybe Text
catalogId} -> Maybe Text
catalogId) (\s :: BatchUpdatePartition
s@BatchUpdatePartition' {} Maybe Text
a -> BatchUpdatePartition
s {$sel:catalogId:BatchUpdatePartition' :: Maybe Text
catalogId = Maybe Text
a} :: BatchUpdatePartition)

-- | The name of the metadata database in which the partition is to be
-- updated.
batchUpdatePartition_databaseName :: Lens.Lens' BatchUpdatePartition Prelude.Text
batchUpdatePartition_databaseName :: Lens' BatchUpdatePartition Text
batchUpdatePartition_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdatePartition' {Text
databaseName :: Text
$sel:databaseName:BatchUpdatePartition' :: BatchUpdatePartition -> Text
databaseName} -> Text
databaseName) (\s :: BatchUpdatePartition
s@BatchUpdatePartition' {} Text
a -> BatchUpdatePartition
s {$sel:databaseName:BatchUpdatePartition' :: Text
databaseName = Text
a} :: BatchUpdatePartition)

-- | The name of the metadata table in which the partition is to be updated.
batchUpdatePartition_tableName :: Lens.Lens' BatchUpdatePartition Prelude.Text
batchUpdatePartition_tableName :: Lens' BatchUpdatePartition Text
batchUpdatePartition_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdatePartition' {Text
tableName :: Text
$sel:tableName:BatchUpdatePartition' :: BatchUpdatePartition -> Text
tableName} -> Text
tableName) (\s :: BatchUpdatePartition
s@BatchUpdatePartition' {} Text
a -> BatchUpdatePartition
s {$sel:tableName:BatchUpdatePartition' :: Text
tableName = Text
a} :: BatchUpdatePartition)

-- | A list of up to 100 @BatchUpdatePartitionRequestEntry@ objects to
-- update.
batchUpdatePartition_entries :: Lens.Lens' BatchUpdatePartition (Prelude.NonEmpty BatchUpdatePartitionRequestEntry)
batchUpdatePartition_entries :: Lens'
  BatchUpdatePartition (NonEmpty BatchUpdatePartitionRequestEntry)
batchUpdatePartition_entries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdatePartition' {NonEmpty BatchUpdatePartitionRequestEntry
entries :: NonEmpty BatchUpdatePartitionRequestEntry
$sel:entries:BatchUpdatePartition' :: BatchUpdatePartition -> NonEmpty BatchUpdatePartitionRequestEntry
entries} -> NonEmpty BatchUpdatePartitionRequestEntry
entries) (\s :: BatchUpdatePartition
s@BatchUpdatePartition' {} NonEmpty BatchUpdatePartitionRequestEntry
a -> BatchUpdatePartition
s {$sel:entries:BatchUpdatePartition' :: NonEmpty BatchUpdatePartitionRequestEntry
entries = NonEmpty BatchUpdatePartitionRequestEntry
a} :: BatchUpdatePartition) 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 BatchUpdatePartition where
  type
    AWSResponse BatchUpdatePartition =
      BatchUpdatePartitionResponse
  request :: (Service -> Service)
-> BatchUpdatePartition -> Request BatchUpdatePartition
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 BatchUpdatePartition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchUpdatePartition)))
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 [BatchUpdatePartitionFailureEntry]
-> Int -> BatchUpdatePartitionResponse
BatchUpdatePartitionResponse'
            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
"Errors" 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 BatchUpdatePartition where
  hashWithSalt :: Int -> BatchUpdatePartition -> Int
hashWithSalt Int
_salt BatchUpdatePartition' {Maybe Text
NonEmpty BatchUpdatePartitionRequestEntry
Text
entries :: NonEmpty BatchUpdatePartitionRequestEntry
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:entries:BatchUpdatePartition' :: BatchUpdatePartition -> NonEmpty BatchUpdatePartitionRequestEntry
$sel:tableName:BatchUpdatePartition' :: BatchUpdatePartition -> Text
$sel:databaseName:BatchUpdatePartition' :: BatchUpdatePartition -> Text
$sel:catalogId:BatchUpdatePartition' :: BatchUpdatePartition -> 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` NonEmpty BatchUpdatePartitionRequestEntry
entries

instance Prelude.NFData BatchUpdatePartition where
  rnf :: BatchUpdatePartition -> ()
rnf BatchUpdatePartition' {Maybe Text
NonEmpty BatchUpdatePartitionRequestEntry
Text
entries :: NonEmpty BatchUpdatePartitionRequestEntry
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:entries:BatchUpdatePartition' :: BatchUpdatePartition -> NonEmpty BatchUpdatePartitionRequestEntry
$sel:tableName:BatchUpdatePartition' :: BatchUpdatePartition -> Text
$sel:databaseName:BatchUpdatePartition' :: BatchUpdatePartition -> Text
$sel:catalogId:BatchUpdatePartition' :: BatchUpdatePartition -> 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 NonEmpty BatchUpdatePartitionRequestEntry
entries

instance Data.ToHeaders BatchUpdatePartition where
  toHeaders :: BatchUpdatePartition -> 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.BatchUpdatePartition" ::
                          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 BatchUpdatePartition where
  toJSON :: BatchUpdatePartition -> Value
toJSON BatchUpdatePartition' {Maybe Text
NonEmpty BatchUpdatePartitionRequestEntry
Text
entries :: NonEmpty BatchUpdatePartitionRequestEntry
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:entries:BatchUpdatePartition' :: BatchUpdatePartition -> NonEmpty BatchUpdatePartitionRequestEntry
$sel:tableName:BatchUpdatePartition' :: BatchUpdatePartition -> Text
$sel:databaseName:BatchUpdatePartition' :: BatchUpdatePartition -> Text
$sel:catalogId:BatchUpdatePartition' :: BatchUpdatePartition -> 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
"Entries" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty BatchUpdatePartitionRequestEntry
entries)
          ]
      )

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

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

-- | /See:/ 'newBatchUpdatePartitionResponse' smart constructor.
data BatchUpdatePartitionResponse = BatchUpdatePartitionResponse'
  { -- | The errors encountered when trying to update the requested partitions. A
    -- list of @BatchUpdatePartitionFailureEntry@ objects.
    BatchUpdatePartitionResponse
-> Maybe [BatchUpdatePartitionFailureEntry]
errors :: Prelude.Maybe [BatchUpdatePartitionFailureEntry],
    -- | The response's http status code.
    BatchUpdatePartitionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchUpdatePartitionResponse
-> BatchUpdatePartitionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchUpdatePartitionResponse
-> BatchUpdatePartitionResponse -> Bool
$c/= :: BatchUpdatePartitionResponse
-> BatchUpdatePartitionResponse -> Bool
== :: BatchUpdatePartitionResponse
-> BatchUpdatePartitionResponse -> Bool
$c== :: BatchUpdatePartitionResponse
-> BatchUpdatePartitionResponse -> Bool
Prelude.Eq, ReadPrec [BatchUpdatePartitionResponse]
ReadPrec BatchUpdatePartitionResponse
Int -> ReadS BatchUpdatePartitionResponse
ReadS [BatchUpdatePartitionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchUpdatePartitionResponse]
$creadListPrec :: ReadPrec [BatchUpdatePartitionResponse]
readPrec :: ReadPrec BatchUpdatePartitionResponse
$creadPrec :: ReadPrec BatchUpdatePartitionResponse
readList :: ReadS [BatchUpdatePartitionResponse]
$creadList :: ReadS [BatchUpdatePartitionResponse]
readsPrec :: Int -> ReadS BatchUpdatePartitionResponse
$creadsPrec :: Int -> ReadS BatchUpdatePartitionResponse
Prelude.Read, Int -> BatchUpdatePartitionResponse -> ShowS
[BatchUpdatePartitionResponse] -> ShowS
BatchUpdatePartitionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchUpdatePartitionResponse] -> ShowS
$cshowList :: [BatchUpdatePartitionResponse] -> ShowS
show :: BatchUpdatePartitionResponse -> String
$cshow :: BatchUpdatePartitionResponse -> String
showsPrec :: Int -> BatchUpdatePartitionResponse -> ShowS
$cshowsPrec :: Int -> BatchUpdatePartitionResponse -> ShowS
Prelude.Show, forall x.
Rep BatchUpdatePartitionResponse x -> BatchUpdatePartitionResponse
forall x.
BatchUpdatePartitionResponse -> Rep BatchUpdatePartitionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchUpdatePartitionResponse x -> BatchUpdatePartitionResponse
$cfrom :: forall x.
BatchUpdatePartitionResponse -> Rep BatchUpdatePartitionResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchUpdatePartitionResponse' 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:
--
-- 'errors', 'batchUpdatePartitionResponse_errors' - The errors encountered when trying to update the requested partitions. A
-- list of @BatchUpdatePartitionFailureEntry@ objects.
--
-- 'httpStatus', 'batchUpdatePartitionResponse_httpStatus' - The response's http status code.
newBatchUpdatePartitionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchUpdatePartitionResponse
newBatchUpdatePartitionResponse :: Int -> BatchUpdatePartitionResponse
newBatchUpdatePartitionResponse Int
pHttpStatus_ =
  BatchUpdatePartitionResponse'
    { $sel:errors:BatchUpdatePartitionResponse' :: Maybe [BatchUpdatePartitionFailureEntry]
errors =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchUpdatePartitionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The errors encountered when trying to update the requested partitions. A
-- list of @BatchUpdatePartitionFailureEntry@ objects.
batchUpdatePartitionResponse_errors :: Lens.Lens' BatchUpdatePartitionResponse (Prelude.Maybe [BatchUpdatePartitionFailureEntry])
batchUpdatePartitionResponse_errors :: Lens'
  BatchUpdatePartitionResponse
  (Maybe [BatchUpdatePartitionFailureEntry])
batchUpdatePartitionResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdatePartitionResponse' {Maybe [BatchUpdatePartitionFailureEntry]
errors :: Maybe [BatchUpdatePartitionFailureEntry]
$sel:errors:BatchUpdatePartitionResponse' :: BatchUpdatePartitionResponse
-> Maybe [BatchUpdatePartitionFailureEntry]
errors} -> Maybe [BatchUpdatePartitionFailureEntry]
errors) (\s :: BatchUpdatePartitionResponse
s@BatchUpdatePartitionResponse' {} Maybe [BatchUpdatePartitionFailureEntry]
a -> BatchUpdatePartitionResponse
s {$sel:errors:BatchUpdatePartitionResponse' :: Maybe [BatchUpdatePartitionFailureEntry]
errors = Maybe [BatchUpdatePartitionFailureEntry]
a} :: BatchUpdatePartitionResponse) 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.
batchUpdatePartitionResponse_httpStatus :: Lens.Lens' BatchUpdatePartitionResponse Prelude.Int
batchUpdatePartitionResponse_httpStatus :: Lens' BatchUpdatePartitionResponse Int
batchUpdatePartitionResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdatePartitionResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchUpdatePartitionResponse' :: BatchUpdatePartitionResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchUpdatePartitionResponse
s@BatchUpdatePartitionResponse' {} Int
a -> BatchUpdatePartitionResponse
s {$sel:httpStatus:BatchUpdatePartitionResponse' :: Int
httpStatus = Int
a} :: BatchUpdatePartitionResponse)

instance Prelude.NFData BatchUpdatePartitionResponse where
  rnf :: BatchUpdatePartitionResponse -> ()
rnf BatchUpdatePartitionResponse' {Int
Maybe [BatchUpdatePartitionFailureEntry]
httpStatus :: Int
errors :: Maybe [BatchUpdatePartitionFailureEntry]
$sel:httpStatus:BatchUpdatePartitionResponse' :: BatchUpdatePartitionResponse -> Int
$sel:errors:BatchUpdatePartitionResponse' :: BatchUpdatePartitionResponse
-> Maybe [BatchUpdatePartitionFailureEntry]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BatchUpdatePartitionFailureEntry]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus