{-# 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.SDB.BatchDeleteAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Performs multiple DeleteAttributes operations in a single call, which
-- reduces round trips and latencies. This enables Amazon SimpleDB to
-- optimize requests, which generally yields better throughput.
--
-- The following limitations are enforced for this operation:
--
-- -   1 MB request size
-- -   25 item limit per BatchDeleteAttributes operation
module Amazonka.SDB.BatchDeleteAttributes
  ( -- * Creating a Request
    BatchDeleteAttributes (..),
    newBatchDeleteAttributes,

    -- * Request Lenses
    batchDeleteAttributes_domainName,
    batchDeleteAttributes_items,

    -- * Destructuring the Response
    BatchDeleteAttributesResponse (..),
    newBatchDeleteAttributesResponse,
  )
where

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

-- | /See:/ 'newBatchDeleteAttributes' smart constructor.
data BatchDeleteAttributes = BatchDeleteAttributes'
  { -- | The name of the domain in which the attributes are being deleted.
    BatchDeleteAttributes -> Text
domainName :: Prelude.Text,
    -- | A list of items on which to perform the operation.
    BatchDeleteAttributes -> [DeletableItem]
items :: [DeletableItem]
  }
  deriving (BatchDeleteAttributes -> BatchDeleteAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchDeleteAttributes -> BatchDeleteAttributes -> Bool
$c/= :: BatchDeleteAttributes -> BatchDeleteAttributes -> Bool
== :: BatchDeleteAttributes -> BatchDeleteAttributes -> Bool
$c== :: BatchDeleteAttributes -> BatchDeleteAttributes -> Bool
Prelude.Eq, ReadPrec [BatchDeleteAttributes]
ReadPrec BatchDeleteAttributes
Int -> ReadS BatchDeleteAttributes
ReadS [BatchDeleteAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchDeleteAttributes]
$creadListPrec :: ReadPrec [BatchDeleteAttributes]
readPrec :: ReadPrec BatchDeleteAttributes
$creadPrec :: ReadPrec BatchDeleteAttributes
readList :: ReadS [BatchDeleteAttributes]
$creadList :: ReadS [BatchDeleteAttributes]
readsPrec :: Int -> ReadS BatchDeleteAttributes
$creadsPrec :: Int -> ReadS BatchDeleteAttributes
Prelude.Read, Int -> BatchDeleteAttributes -> ShowS
[BatchDeleteAttributes] -> ShowS
BatchDeleteAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchDeleteAttributes] -> ShowS
$cshowList :: [BatchDeleteAttributes] -> ShowS
show :: BatchDeleteAttributes -> String
$cshow :: BatchDeleteAttributes -> String
showsPrec :: Int -> BatchDeleteAttributes -> ShowS
$cshowsPrec :: Int -> BatchDeleteAttributes -> ShowS
Prelude.Show, forall x. Rep BatchDeleteAttributes x -> BatchDeleteAttributes
forall x. BatchDeleteAttributes -> Rep BatchDeleteAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchDeleteAttributes x -> BatchDeleteAttributes
$cfrom :: forall x. BatchDeleteAttributes -> Rep BatchDeleteAttributes x
Prelude.Generic)

-- |
-- Create a value of 'BatchDeleteAttributes' 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:
--
-- 'domainName', 'batchDeleteAttributes_domainName' - The name of the domain in which the attributes are being deleted.
--
-- 'items', 'batchDeleteAttributes_items' - A list of items on which to perform the operation.
newBatchDeleteAttributes ::
  -- | 'domainName'
  Prelude.Text ->
  BatchDeleteAttributes
newBatchDeleteAttributes :: Text -> BatchDeleteAttributes
newBatchDeleteAttributes Text
pDomainName_ =
  BatchDeleteAttributes'
    { $sel:domainName:BatchDeleteAttributes' :: Text
domainName = Text
pDomainName_,
      $sel:items:BatchDeleteAttributes' :: [DeletableItem]
items = forall a. Monoid a => a
Prelude.mempty
    }

-- | The name of the domain in which the attributes are being deleted.
batchDeleteAttributes_domainName :: Lens.Lens' BatchDeleteAttributes Prelude.Text
batchDeleteAttributes_domainName :: Lens' BatchDeleteAttributes Text
batchDeleteAttributes_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteAttributes' {Text
domainName :: Text
$sel:domainName:BatchDeleteAttributes' :: BatchDeleteAttributes -> Text
domainName} -> Text
domainName) (\s :: BatchDeleteAttributes
s@BatchDeleteAttributes' {} Text
a -> BatchDeleteAttributes
s {$sel:domainName:BatchDeleteAttributes' :: Text
domainName = Text
a} :: BatchDeleteAttributes)

-- | A list of items on which to perform the operation.
batchDeleteAttributes_items :: Lens.Lens' BatchDeleteAttributes [DeletableItem]
batchDeleteAttributes_items :: Lens' BatchDeleteAttributes [DeletableItem]
batchDeleteAttributes_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchDeleteAttributes' {[DeletableItem]
items :: [DeletableItem]
$sel:items:BatchDeleteAttributes' :: BatchDeleteAttributes -> [DeletableItem]
items} -> [DeletableItem]
items) (\s :: BatchDeleteAttributes
s@BatchDeleteAttributes' {} [DeletableItem]
a -> BatchDeleteAttributes
s {$sel:items:BatchDeleteAttributes' :: [DeletableItem]
items = [DeletableItem]
a} :: BatchDeleteAttributes) 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 BatchDeleteAttributes where
  type
    AWSResponse BatchDeleteAttributes =
      BatchDeleteAttributesResponse
  request :: (Service -> Service)
-> BatchDeleteAttributes -> Request BatchDeleteAttributes
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy BatchDeleteAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchDeleteAttributes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull BatchDeleteAttributesResponse
BatchDeleteAttributesResponse'

instance Prelude.Hashable BatchDeleteAttributes where
  hashWithSalt :: Int -> BatchDeleteAttributes -> Int
hashWithSalt Int
_salt BatchDeleteAttributes' {[DeletableItem]
Text
items :: [DeletableItem]
domainName :: Text
$sel:items:BatchDeleteAttributes' :: BatchDeleteAttributes -> [DeletableItem]
$sel:domainName:BatchDeleteAttributes' :: BatchDeleteAttributes -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [DeletableItem]
items

instance Prelude.NFData BatchDeleteAttributes where
  rnf :: BatchDeleteAttributes -> ()
rnf BatchDeleteAttributes' {[DeletableItem]
Text
items :: [DeletableItem]
domainName :: Text
$sel:items:BatchDeleteAttributes' :: BatchDeleteAttributes -> [DeletableItem]
$sel:domainName:BatchDeleteAttributes' :: BatchDeleteAttributes -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [DeletableItem]
items

instance Data.ToHeaders BatchDeleteAttributes where
  toHeaders :: BatchDeleteAttributes -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery BatchDeleteAttributes where
  toQuery :: BatchDeleteAttributes -> QueryString
toQuery BatchDeleteAttributes' {[DeletableItem]
Text
items :: [DeletableItem]
domainName :: Text
$sel:items:BatchDeleteAttributes' :: BatchDeleteAttributes -> [DeletableItem]
$sel:domainName:BatchDeleteAttributes' :: BatchDeleteAttributes -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"BatchDeleteAttributes" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2009-04-15" :: Prelude.ByteString),
        ByteString
"DomainName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
domainName,
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Item" [DeletableItem]
items
      ]

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

-- |
-- Create a value of 'BatchDeleteAttributesResponse' 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.
newBatchDeleteAttributesResponse ::
  BatchDeleteAttributesResponse
newBatchDeleteAttributesResponse :: BatchDeleteAttributesResponse
newBatchDeleteAttributesResponse =
  BatchDeleteAttributesResponse
BatchDeleteAttributesResponse'

instance Prelude.NFData BatchDeleteAttributesResponse where
  rnf :: BatchDeleteAttributesResponse -> ()
rnf BatchDeleteAttributesResponse
_ = ()