{-# 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.DeleteObjectsOnCancel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- For a specific governed table, provides a list of Amazon S3 objects that
-- will be written during the current transaction and that can be
-- automatically deleted if the transaction is canceled. Without this call,
-- no Amazon S3 objects are automatically deleted when a transaction
-- cancels.
--
-- The Glue ETL library function @write_dynamic_frame.from_catalog()@
-- includes an option to automatically call @DeleteObjectsOnCancel@ before
-- writes. For more information, see
-- <https://docs.aws.amazon.com/lake-formation/latest/dg/transactions-data-operations.html#rolling-back-writes Rolling Back Amazon S3 Writes>.
module Amazonka.LakeFormation.DeleteObjectsOnCancel
  ( -- * Creating a Request
    DeleteObjectsOnCancel (..),
    newDeleteObjectsOnCancel,

    -- * Request Lenses
    deleteObjectsOnCancel_catalogId,
    deleteObjectsOnCancel_databaseName,
    deleteObjectsOnCancel_tableName,
    deleteObjectsOnCancel_transactionId,
    deleteObjectsOnCancel_objects,

    -- * Destructuring the Response
    DeleteObjectsOnCancelResponse (..),
    newDeleteObjectsOnCancelResponse,

    -- * Response Lenses
    deleteObjectsOnCancelResponse_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:/ 'newDeleteObjectsOnCancel' smart constructor.
data DeleteObjectsOnCancel = DeleteObjectsOnCancel'
  { -- | The Glue data catalog that contains the governed table. Defaults to the
    -- current account ID.
    DeleteObjectsOnCancel -> Maybe Text
catalogId :: Prelude.Maybe Prelude.Text,
    -- | The database that contains the governed table.
    DeleteObjectsOnCancel -> Text
databaseName :: Prelude.Text,
    -- | The name of the governed table.
    DeleteObjectsOnCancel -> Text
tableName :: Prelude.Text,
    -- | ID of the transaction that the writes occur in.
    DeleteObjectsOnCancel -> Text
transactionId :: Prelude.Text,
    -- | A list of VirtualObject structures, which indicates the Amazon S3
    -- objects to be deleted if the transaction cancels.
    DeleteObjectsOnCancel -> NonEmpty VirtualObject
objects :: Prelude.NonEmpty VirtualObject
  }
  deriving (DeleteObjectsOnCancel -> DeleteObjectsOnCancel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteObjectsOnCancel -> DeleteObjectsOnCancel -> Bool
$c/= :: DeleteObjectsOnCancel -> DeleteObjectsOnCancel -> Bool
== :: DeleteObjectsOnCancel -> DeleteObjectsOnCancel -> Bool
$c== :: DeleteObjectsOnCancel -> DeleteObjectsOnCancel -> Bool
Prelude.Eq, ReadPrec [DeleteObjectsOnCancel]
ReadPrec DeleteObjectsOnCancel
Int -> ReadS DeleteObjectsOnCancel
ReadS [DeleteObjectsOnCancel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteObjectsOnCancel]
$creadListPrec :: ReadPrec [DeleteObjectsOnCancel]
readPrec :: ReadPrec DeleteObjectsOnCancel
$creadPrec :: ReadPrec DeleteObjectsOnCancel
readList :: ReadS [DeleteObjectsOnCancel]
$creadList :: ReadS [DeleteObjectsOnCancel]
readsPrec :: Int -> ReadS DeleteObjectsOnCancel
$creadsPrec :: Int -> ReadS DeleteObjectsOnCancel
Prelude.Read, Int -> DeleteObjectsOnCancel -> ShowS
[DeleteObjectsOnCancel] -> ShowS
DeleteObjectsOnCancel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteObjectsOnCancel] -> ShowS
$cshowList :: [DeleteObjectsOnCancel] -> ShowS
show :: DeleteObjectsOnCancel -> String
$cshow :: DeleteObjectsOnCancel -> String
showsPrec :: Int -> DeleteObjectsOnCancel -> ShowS
$cshowsPrec :: Int -> DeleteObjectsOnCancel -> ShowS
Prelude.Show, forall x. Rep DeleteObjectsOnCancel x -> DeleteObjectsOnCancel
forall x. DeleteObjectsOnCancel -> Rep DeleteObjectsOnCancel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteObjectsOnCancel x -> DeleteObjectsOnCancel
$cfrom :: forall x. DeleteObjectsOnCancel -> Rep DeleteObjectsOnCancel x
Prelude.Generic)

-- |
-- Create a value of 'DeleteObjectsOnCancel' 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', 'deleteObjectsOnCancel_catalogId' - The Glue data catalog that contains the governed table. Defaults to the
-- current account ID.
--
-- 'databaseName', 'deleteObjectsOnCancel_databaseName' - The database that contains the governed table.
--
-- 'tableName', 'deleteObjectsOnCancel_tableName' - The name of the governed table.
--
-- 'transactionId', 'deleteObjectsOnCancel_transactionId' - ID of the transaction that the writes occur in.
--
-- 'objects', 'deleteObjectsOnCancel_objects' - A list of VirtualObject structures, which indicates the Amazon S3
-- objects to be deleted if the transaction cancels.
newDeleteObjectsOnCancel ::
  -- | 'databaseName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  -- | 'transactionId'
  Prelude.Text ->
  -- | 'objects'
  Prelude.NonEmpty VirtualObject ->
  DeleteObjectsOnCancel
newDeleteObjectsOnCancel :: Text
-> Text -> Text -> NonEmpty VirtualObject -> DeleteObjectsOnCancel
newDeleteObjectsOnCancel
  Text
pDatabaseName_
  Text
pTableName_
  Text
pTransactionId_
  NonEmpty VirtualObject
pObjects_ =
    DeleteObjectsOnCancel'
      { $sel:catalogId:DeleteObjectsOnCancel' :: Maybe Text
catalogId = forall a. Maybe a
Prelude.Nothing,
        $sel:databaseName:DeleteObjectsOnCancel' :: Text
databaseName = Text
pDatabaseName_,
        $sel:tableName:DeleteObjectsOnCancel' :: Text
tableName = Text
pTableName_,
        $sel:transactionId:DeleteObjectsOnCancel' :: Text
transactionId = Text
pTransactionId_,
        $sel:objects:DeleteObjectsOnCancel' :: NonEmpty VirtualObject
objects = 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 VirtualObject
pObjects_
      }

-- | The Glue data catalog that contains the governed table. Defaults to the
-- current account ID.
deleteObjectsOnCancel_catalogId :: Lens.Lens' DeleteObjectsOnCancel (Prelude.Maybe Prelude.Text)
deleteObjectsOnCancel_catalogId :: Lens' DeleteObjectsOnCancel (Maybe Text)
deleteObjectsOnCancel_catalogId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteObjectsOnCancel' {Maybe Text
catalogId :: Maybe Text
$sel:catalogId:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Maybe Text
catalogId} -> Maybe Text
catalogId) (\s :: DeleteObjectsOnCancel
s@DeleteObjectsOnCancel' {} Maybe Text
a -> DeleteObjectsOnCancel
s {$sel:catalogId:DeleteObjectsOnCancel' :: Maybe Text
catalogId = Maybe Text
a} :: DeleteObjectsOnCancel)

-- | The database that contains the governed table.
deleteObjectsOnCancel_databaseName :: Lens.Lens' DeleteObjectsOnCancel Prelude.Text
deleteObjectsOnCancel_databaseName :: Lens' DeleteObjectsOnCancel Text
deleteObjectsOnCancel_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteObjectsOnCancel' {Text
databaseName :: Text
$sel:databaseName:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
databaseName} -> Text
databaseName) (\s :: DeleteObjectsOnCancel
s@DeleteObjectsOnCancel' {} Text
a -> DeleteObjectsOnCancel
s {$sel:databaseName:DeleteObjectsOnCancel' :: Text
databaseName = Text
a} :: DeleteObjectsOnCancel)

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

-- | ID of the transaction that the writes occur in.
deleteObjectsOnCancel_transactionId :: Lens.Lens' DeleteObjectsOnCancel Prelude.Text
deleteObjectsOnCancel_transactionId :: Lens' DeleteObjectsOnCancel Text
deleteObjectsOnCancel_transactionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteObjectsOnCancel' {Text
transactionId :: Text
$sel:transactionId:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
transactionId} -> Text
transactionId) (\s :: DeleteObjectsOnCancel
s@DeleteObjectsOnCancel' {} Text
a -> DeleteObjectsOnCancel
s {$sel:transactionId:DeleteObjectsOnCancel' :: Text
transactionId = Text
a} :: DeleteObjectsOnCancel)

-- | A list of VirtualObject structures, which indicates the Amazon S3
-- objects to be deleted if the transaction cancels.
deleteObjectsOnCancel_objects :: Lens.Lens' DeleteObjectsOnCancel (Prelude.NonEmpty VirtualObject)
deleteObjectsOnCancel_objects :: Lens' DeleteObjectsOnCancel (NonEmpty VirtualObject)
deleteObjectsOnCancel_objects = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteObjectsOnCancel' {NonEmpty VirtualObject
objects :: NonEmpty VirtualObject
$sel:objects:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> NonEmpty VirtualObject
objects} -> NonEmpty VirtualObject
objects) (\s :: DeleteObjectsOnCancel
s@DeleteObjectsOnCancel' {} NonEmpty VirtualObject
a -> DeleteObjectsOnCancel
s {$sel:objects:DeleteObjectsOnCancel' :: NonEmpty VirtualObject
objects = NonEmpty VirtualObject
a} :: DeleteObjectsOnCancel) 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 DeleteObjectsOnCancel where
  type
    AWSResponse DeleteObjectsOnCancel =
      DeleteObjectsOnCancelResponse
  request :: (Service -> Service)
-> DeleteObjectsOnCancel -> Request DeleteObjectsOnCancel
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 DeleteObjectsOnCancel
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteObjectsOnCancel)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> DeleteObjectsOnCancelResponse
DeleteObjectsOnCancelResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DeleteObjectsOnCancel where
  hashWithSalt :: Int -> DeleteObjectsOnCancel -> Int
hashWithSalt Int
_salt DeleteObjectsOnCancel' {Maybe Text
NonEmpty VirtualObject
Text
objects :: NonEmpty VirtualObject
transactionId :: Text
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:objects:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> NonEmpty VirtualObject
$sel:transactionId:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
$sel:tableName:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
$sel:databaseName:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
$sel:catalogId:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> 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` Text
transactionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty VirtualObject
objects

instance Prelude.NFData DeleteObjectsOnCancel where
  rnf :: DeleteObjectsOnCancel -> ()
rnf DeleteObjectsOnCancel' {Maybe Text
NonEmpty VirtualObject
Text
objects :: NonEmpty VirtualObject
transactionId :: Text
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:objects:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> NonEmpty VirtualObject
$sel:transactionId:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
$sel:tableName:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
$sel:databaseName:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
$sel:catalogId:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> 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 Text
transactionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty VirtualObject
objects

instance Data.ToHeaders DeleteObjectsOnCancel where
  toHeaders :: DeleteObjectsOnCancel -> 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 DeleteObjectsOnCancel where
  toJSON :: DeleteObjectsOnCancel -> Value
toJSON DeleteObjectsOnCancel' {Maybe Text
NonEmpty VirtualObject
Text
objects :: NonEmpty VirtualObject
transactionId :: Text
tableName :: Text
databaseName :: Text
catalogId :: Maybe Text
$sel:objects:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> NonEmpty VirtualObject
$sel:transactionId:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
$sel:tableName:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
$sel:databaseName:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> Text
$sel:catalogId:DeleteObjectsOnCancel' :: DeleteObjectsOnCancel -> 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
"TransactionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
transactionId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Objects" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty VirtualObject
objects)
          ]
      )

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

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

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

-- |
-- Create a value of 'DeleteObjectsOnCancelResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'deleteObjectsOnCancelResponse_httpStatus' - The response's http status code.
newDeleteObjectsOnCancelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteObjectsOnCancelResponse
newDeleteObjectsOnCancelResponse :: Int -> DeleteObjectsOnCancelResponse
newDeleteObjectsOnCancelResponse Int
pHttpStatus_ =
  DeleteObjectsOnCancelResponse'
    { $sel:httpStatus:DeleteObjectsOnCancelResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

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