{-# 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.DeleteAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes one or more attributes associated with an item. If all
-- attributes of the item are deleted, the item is deleted.
--
-- @DeleteAttributes@ is an idempotent operation; running it multiple times
-- on the same item or attribute does not result in an error response.
--
-- Because Amazon SimpleDB makes multiple copies of item data and uses an
-- eventual consistency update model, performing a GetAttributes or Select
-- operation (read) immediately after a @DeleteAttributes@ or PutAttributes
-- operation (write) might not return updated item data.
module Amazonka.SDB.DeleteAttributes
  ( -- * Creating a Request
    DeleteAttributes (..),
    newDeleteAttributes,

    -- * Request Lenses
    deleteAttributes_attributes,
    deleteAttributes_expected,
    deleteAttributes_domainName,
    deleteAttributes_itemName,

    -- * Destructuring the Response
    DeleteAttributesResponse (..),
    newDeleteAttributesResponse,
  )
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:/ 'newDeleteAttributes' smart constructor.
data DeleteAttributes = DeleteAttributes'
  { -- | A list of Attributes. Similar to columns on a spreadsheet, attributes
    -- represent categories of data that can be assigned to items.
    DeleteAttributes -> Maybe [Attribute]
attributes :: Prelude.Maybe [Attribute],
    -- | The update condition which, if specified, determines whether the
    -- specified attributes will be deleted or not. The update condition must
    -- be satisfied in order for this request to be processed and the
    -- attributes to be deleted.
    DeleteAttributes -> Maybe UpdateCondition
expected :: Prelude.Maybe UpdateCondition,
    -- | The name of the domain in which to perform the operation.
    DeleteAttributes -> Text
domainName :: Prelude.Text,
    -- | The name of the item. Similar to rows on a spreadsheet, items represent
    -- individual objects that contain one or more value-attribute pairs.
    DeleteAttributes -> Text
itemName :: Prelude.Text
  }
  deriving (DeleteAttributes -> DeleteAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteAttributes -> DeleteAttributes -> Bool
$c/= :: DeleteAttributes -> DeleteAttributes -> Bool
== :: DeleteAttributes -> DeleteAttributes -> Bool
$c== :: DeleteAttributes -> DeleteAttributes -> Bool
Prelude.Eq, ReadPrec [DeleteAttributes]
ReadPrec DeleteAttributes
Int -> ReadS DeleteAttributes
ReadS [DeleteAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteAttributes]
$creadListPrec :: ReadPrec [DeleteAttributes]
readPrec :: ReadPrec DeleteAttributes
$creadPrec :: ReadPrec DeleteAttributes
readList :: ReadS [DeleteAttributes]
$creadList :: ReadS [DeleteAttributes]
readsPrec :: Int -> ReadS DeleteAttributes
$creadsPrec :: Int -> ReadS DeleteAttributes
Prelude.Read, Int -> DeleteAttributes -> ShowS
[DeleteAttributes] -> ShowS
DeleteAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteAttributes] -> ShowS
$cshowList :: [DeleteAttributes] -> ShowS
show :: DeleteAttributes -> String
$cshow :: DeleteAttributes -> String
showsPrec :: Int -> DeleteAttributes -> ShowS
$cshowsPrec :: Int -> DeleteAttributes -> ShowS
Prelude.Show, forall x. Rep DeleteAttributes x -> DeleteAttributes
forall x. DeleteAttributes -> Rep DeleteAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteAttributes x -> DeleteAttributes
$cfrom :: forall x. DeleteAttributes -> Rep DeleteAttributes x
Prelude.Generic)

-- |
-- Create a value of 'DeleteAttributes' 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:
--
-- 'attributes', 'deleteAttributes_attributes' - A list of Attributes. Similar to columns on a spreadsheet, attributes
-- represent categories of data that can be assigned to items.
--
-- 'expected', 'deleteAttributes_expected' - The update condition which, if specified, determines whether the
-- specified attributes will be deleted or not. The update condition must
-- be satisfied in order for this request to be processed and the
-- attributes to be deleted.
--
-- 'domainName', 'deleteAttributes_domainName' - The name of the domain in which to perform the operation.
--
-- 'itemName', 'deleteAttributes_itemName' - The name of the item. Similar to rows on a spreadsheet, items represent
-- individual objects that contain one or more value-attribute pairs.
newDeleteAttributes ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'itemName'
  Prelude.Text ->
  DeleteAttributes
newDeleteAttributes :: Text -> Text -> DeleteAttributes
newDeleteAttributes Text
pDomainName_ Text
pItemName_ =
  DeleteAttributes'
    { $sel:attributes:DeleteAttributes' :: Maybe [Attribute]
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:expected:DeleteAttributes' :: Maybe UpdateCondition
expected = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:DeleteAttributes' :: Text
domainName = Text
pDomainName_,
      $sel:itemName:DeleteAttributes' :: Text
itemName = Text
pItemName_
    }

-- | A list of Attributes. Similar to columns on a spreadsheet, attributes
-- represent categories of data that can be assigned to items.
deleteAttributes_attributes :: Lens.Lens' DeleteAttributes (Prelude.Maybe [Attribute])
deleteAttributes_attributes :: Lens' DeleteAttributes (Maybe [Attribute])
deleteAttributes_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAttributes' {Maybe [Attribute]
attributes :: Maybe [Attribute]
$sel:attributes:DeleteAttributes' :: DeleteAttributes -> Maybe [Attribute]
attributes} -> Maybe [Attribute]
attributes) (\s :: DeleteAttributes
s@DeleteAttributes' {} Maybe [Attribute]
a -> DeleteAttributes
s {$sel:attributes:DeleteAttributes' :: Maybe [Attribute]
attributes = Maybe [Attribute]
a} :: DeleteAttributes) 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 update condition which, if specified, determines whether the
-- specified attributes will be deleted or not. The update condition must
-- be satisfied in order for this request to be processed and the
-- attributes to be deleted.
deleteAttributes_expected :: Lens.Lens' DeleteAttributes (Prelude.Maybe UpdateCondition)
deleteAttributes_expected :: Lens' DeleteAttributes (Maybe UpdateCondition)
deleteAttributes_expected = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAttributes' {Maybe UpdateCondition
expected :: Maybe UpdateCondition
$sel:expected:DeleteAttributes' :: DeleteAttributes -> Maybe UpdateCondition
expected} -> Maybe UpdateCondition
expected) (\s :: DeleteAttributes
s@DeleteAttributes' {} Maybe UpdateCondition
a -> DeleteAttributes
s {$sel:expected:DeleteAttributes' :: Maybe UpdateCondition
expected = Maybe UpdateCondition
a} :: DeleteAttributes)

-- | The name of the domain in which to perform the operation.
deleteAttributes_domainName :: Lens.Lens' DeleteAttributes Prelude.Text
deleteAttributes_domainName :: Lens' DeleteAttributes Text
deleteAttributes_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAttributes' {Text
domainName :: Text
$sel:domainName:DeleteAttributes' :: DeleteAttributes -> Text
domainName} -> Text
domainName) (\s :: DeleteAttributes
s@DeleteAttributes' {} Text
a -> DeleteAttributes
s {$sel:domainName:DeleteAttributes' :: Text
domainName = Text
a} :: DeleteAttributes)

-- | The name of the item. Similar to rows on a spreadsheet, items represent
-- individual objects that contain one or more value-attribute pairs.
deleteAttributes_itemName :: Lens.Lens' DeleteAttributes Prelude.Text
deleteAttributes_itemName :: Lens' DeleteAttributes Text
deleteAttributes_itemName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteAttributes' {Text
itemName :: Text
$sel:itemName:DeleteAttributes' :: DeleteAttributes -> Text
itemName} -> Text
itemName) (\s :: DeleteAttributes
s@DeleteAttributes' {} Text
a -> DeleteAttributes
s {$sel:itemName:DeleteAttributes' :: Text
itemName = Text
a} :: DeleteAttributes)

instance Core.AWSRequest DeleteAttributes where
  type
    AWSResponse DeleteAttributes =
      DeleteAttributesResponse
  request :: (Service -> Service)
-> DeleteAttributes -> Request DeleteAttributes
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 DeleteAttributes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteAttributes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteAttributesResponse
DeleteAttributesResponse'

instance Prelude.Hashable DeleteAttributes where
  hashWithSalt :: Int -> DeleteAttributes -> Int
hashWithSalt Int
_salt DeleteAttributes' {Maybe [Attribute]
Maybe UpdateCondition
Text
itemName :: Text
domainName :: Text
expected :: Maybe UpdateCondition
attributes :: Maybe [Attribute]
$sel:itemName:DeleteAttributes' :: DeleteAttributes -> Text
$sel:domainName:DeleteAttributes' :: DeleteAttributes -> Text
$sel:expected:DeleteAttributes' :: DeleteAttributes -> Maybe UpdateCondition
$sel:attributes:DeleteAttributes' :: DeleteAttributes -> Maybe [Attribute]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Attribute]
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateCondition
expected
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
itemName

instance Prelude.NFData DeleteAttributes where
  rnf :: DeleteAttributes -> ()
rnf DeleteAttributes' {Maybe [Attribute]
Maybe UpdateCondition
Text
itemName :: Text
domainName :: Text
expected :: Maybe UpdateCondition
attributes :: Maybe [Attribute]
$sel:itemName:DeleteAttributes' :: DeleteAttributes -> Text
$sel:domainName:DeleteAttributes' :: DeleteAttributes -> Text
$sel:expected:DeleteAttributes' :: DeleteAttributes -> Maybe UpdateCondition
$sel:attributes:DeleteAttributes' :: DeleteAttributes -> Maybe [Attribute]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Attribute]
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdateCondition
expected
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
itemName

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

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

instance Data.ToQuery DeleteAttributes where
  toQuery :: DeleteAttributes -> QueryString
toQuery DeleteAttributes' {Maybe [Attribute]
Maybe UpdateCondition
Text
itemName :: Text
domainName :: Text
expected :: Maybe UpdateCondition
attributes :: Maybe [Attribute]
$sel:itemName:DeleteAttributes' :: DeleteAttributes -> Text
$sel:domainName:DeleteAttributes' :: DeleteAttributes -> Text
$sel:expected:DeleteAttributes' :: DeleteAttributes -> Maybe UpdateCondition
$sel:attributes:DeleteAttributes' :: DeleteAttributes -> Maybe [Attribute]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteAttributes" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2009-04-15" :: Prelude.ByteString),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Attribute"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Attribute]
attributes
          ),
        ByteString
"Expected" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe UpdateCondition
expected,
        ByteString
"DomainName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
domainName,
        ByteString
"ItemName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
itemName
      ]

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

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

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