{-# 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.PutAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The PutAttributes operation creates or replaces attributes in an item.
-- The client may specify new attributes using a combination of the
-- @Attribute.X.Name@ and @Attribute.X.Value@ parameters. The client
-- specifies the first attribute by the parameters @Attribute.0.Name@ and
-- @Attribute.0.Value@, the second attribute by the parameters
-- @Attribute.1.Name@ and @Attribute.1.Value@, and so on.
--
-- Attributes are uniquely identified in an item by their name\/value
-- combination. For example, a single item can have the attributes
-- @{ \"first_name\", \"first_value\" }@ and
-- @{ \"first_name\", second_value\" }@. However, it cannot have two
-- attribute instances where both the @Attribute.X.Name@ and
-- @Attribute.X.Value@ are the same.
--
-- Optionally, the requestor can supply the @Replace@ parameter for each
-- individual attribute. Setting this value to @true@ causes the new
-- attribute value to replace the existing attribute value(s). For example,
-- if an item has the attributes @{ \'a\', \'1\' }@, @{ \'b\', \'2\'}@ and
-- @{ \'b\', \'3\' }@ and the requestor calls @PutAttributes@ using the
-- attributes @{ \'b\', \'4\' }@ with the @Replace@ parameter set to true,
-- the final attributes of the item are changed to @{ \'a\', \'1\' }@ and
-- @{ \'b\', \'4\' }@, which replaces the previous values of the \'b\'
-- attribute with the new value.
--
-- You cannot specify an empty string as an attribute name.
--
-- Because Amazon SimpleDB makes multiple copies of client data and uses an
-- eventual consistency update model, an immediate GetAttributes or Select
-- operation (read) immediately after a PutAttributes or DeleteAttributes
-- operation (write) might not return the updated data.
--
-- The following limitations are enforced for this operation:
--
-- -   256 total attribute name-value pairs per item
-- -   One billion attributes per domain
-- -   10 GB of total user data storage per domain
module Amazonka.SDB.PutAttributes
  ( -- * Creating a Request
    PutAttributes (..),
    newPutAttributes,

    -- * Request Lenses
    putAttributes_expected,
    putAttributes_domainName,
    putAttributes_itemName,
    putAttributes_attributes,

    -- * Destructuring the Response
    PutAttributesResponse (..),
    newPutAttributesResponse,
  )
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:/ 'newPutAttributes' smart constructor.
data PutAttributes = PutAttributes'
  { -- | The update condition which, if specified, determines whether the
    -- specified attributes will be updated or not. The update condition must
    -- be satisfied in order for this request to be processed and the
    -- attributes to be updated.
    PutAttributes -> Maybe UpdateCondition
expected :: Prelude.Maybe UpdateCondition,
    -- | The name of the domain in which to perform the operation.
    PutAttributes -> Text
domainName :: Prelude.Text,
    -- | The name of the item.
    PutAttributes -> Text
itemName :: Prelude.Text,
    -- | The list of attributes.
    PutAttributes -> [ReplaceableAttribute]
attributes :: [ReplaceableAttribute]
  }
  deriving (PutAttributes -> PutAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutAttributes -> PutAttributes -> Bool
$c/= :: PutAttributes -> PutAttributes -> Bool
== :: PutAttributes -> PutAttributes -> Bool
$c== :: PutAttributes -> PutAttributes -> Bool
Prelude.Eq, ReadPrec [PutAttributes]
ReadPrec PutAttributes
Int -> ReadS PutAttributes
ReadS [PutAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutAttributes]
$creadListPrec :: ReadPrec [PutAttributes]
readPrec :: ReadPrec PutAttributes
$creadPrec :: ReadPrec PutAttributes
readList :: ReadS [PutAttributes]
$creadList :: ReadS [PutAttributes]
readsPrec :: Int -> ReadS PutAttributes
$creadsPrec :: Int -> ReadS PutAttributes
Prelude.Read, Int -> PutAttributes -> ShowS
[PutAttributes] -> ShowS
PutAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutAttributes] -> ShowS
$cshowList :: [PutAttributes] -> ShowS
show :: PutAttributes -> String
$cshow :: PutAttributes -> String
showsPrec :: Int -> PutAttributes -> ShowS
$cshowsPrec :: Int -> PutAttributes -> ShowS
Prelude.Show, forall x. Rep PutAttributes x -> PutAttributes
forall x. PutAttributes -> Rep PutAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutAttributes x -> PutAttributes
$cfrom :: forall x. PutAttributes -> Rep PutAttributes x
Prelude.Generic)

-- |
-- Create a value of 'PutAttributes' 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:
--
-- 'expected', 'putAttributes_expected' - The update condition which, if specified, determines whether the
-- specified attributes will be updated or not. The update condition must
-- be satisfied in order for this request to be processed and the
-- attributes to be updated.
--
-- 'domainName', 'putAttributes_domainName' - The name of the domain in which to perform the operation.
--
-- 'itemName', 'putAttributes_itemName' - The name of the item.
--
-- 'attributes', 'putAttributes_attributes' - The list of attributes.
newPutAttributes ::
  -- | 'domainName'
  Prelude.Text ->
  -- | 'itemName'
  Prelude.Text ->
  PutAttributes
newPutAttributes :: Text -> Text -> PutAttributes
newPutAttributes Text
pDomainName_ Text
pItemName_ =
  PutAttributes'
    { $sel:expected:PutAttributes' :: Maybe UpdateCondition
expected = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:PutAttributes' :: Text
domainName = Text
pDomainName_,
      $sel:itemName:PutAttributes' :: Text
itemName = Text
pItemName_,
      $sel:attributes:PutAttributes' :: [ReplaceableAttribute]
attributes = forall a. Monoid a => a
Prelude.mempty
    }

-- | The update condition which, if specified, determines whether the
-- specified attributes will be updated or not. The update condition must
-- be satisfied in order for this request to be processed and the
-- attributes to be updated.
putAttributes_expected :: Lens.Lens' PutAttributes (Prelude.Maybe UpdateCondition)
putAttributes_expected :: Lens' PutAttributes (Maybe UpdateCondition)
putAttributes_expected = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAttributes' {Maybe UpdateCondition
expected :: Maybe UpdateCondition
$sel:expected:PutAttributes' :: PutAttributes -> Maybe UpdateCondition
expected} -> Maybe UpdateCondition
expected) (\s :: PutAttributes
s@PutAttributes' {} Maybe UpdateCondition
a -> PutAttributes
s {$sel:expected:PutAttributes' :: Maybe UpdateCondition
expected = Maybe UpdateCondition
a} :: PutAttributes)

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

-- | The name of the item.
putAttributes_itemName :: Lens.Lens' PutAttributes Prelude.Text
putAttributes_itemName :: Lens' PutAttributes Text
putAttributes_itemName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAttributes' {Text
itemName :: Text
$sel:itemName:PutAttributes' :: PutAttributes -> Text
itemName} -> Text
itemName) (\s :: PutAttributes
s@PutAttributes' {} Text
a -> PutAttributes
s {$sel:itemName:PutAttributes' :: Text
itemName = Text
a} :: PutAttributes)

-- | The list of attributes.
putAttributes_attributes :: Lens.Lens' PutAttributes [ReplaceableAttribute]
putAttributes_attributes :: Lens' PutAttributes [ReplaceableAttribute]
putAttributes_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutAttributes' {[ReplaceableAttribute]
attributes :: [ReplaceableAttribute]
$sel:attributes:PutAttributes' :: PutAttributes -> [ReplaceableAttribute]
attributes} -> [ReplaceableAttribute]
attributes) (\s :: PutAttributes
s@PutAttributes' {} [ReplaceableAttribute]
a -> PutAttributes
s {$sel:attributes:PutAttributes' :: [ReplaceableAttribute]
attributes = [ReplaceableAttribute]
a} :: PutAttributes) 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 PutAttributes where
  type
    AWSResponse PutAttributes =
      PutAttributesResponse
  request :: (Service -> Service) -> PutAttributes -> Request PutAttributes
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 PutAttributes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutAttributes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull PutAttributesResponse
PutAttributesResponse'

instance Prelude.Hashable PutAttributes where
  hashWithSalt :: Int -> PutAttributes -> Int
hashWithSalt Int
_salt PutAttributes' {[ReplaceableAttribute]
Maybe UpdateCondition
Text
attributes :: [ReplaceableAttribute]
itemName :: Text
domainName :: Text
expected :: Maybe UpdateCondition
$sel:attributes:PutAttributes' :: PutAttributes -> [ReplaceableAttribute]
$sel:itemName:PutAttributes' :: PutAttributes -> Text
$sel:domainName:PutAttributes' :: PutAttributes -> Text
$sel:expected:PutAttributes' :: PutAttributes -> Maybe UpdateCondition
..} =
    Int
_salt
      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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ReplaceableAttribute]
attributes

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

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

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

instance Data.ToQuery PutAttributes where
  toQuery :: PutAttributes -> QueryString
toQuery PutAttributes' {[ReplaceableAttribute]
Maybe UpdateCondition
Text
attributes :: [ReplaceableAttribute]
itemName :: Text
domainName :: Text
expected :: Maybe UpdateCondition
$sel:attributes:PutAttributes' :: PutAttributes -> [ReplaceableAttribute]
$sel:itemName:PutAttributes' :: PutAttributes -> Text
$sel:domainName:PutAttributes' :: PutAttributes -> Text
$sel:expected:PutAttributes' :: PutAttributes -> Maybe UpdateCondition
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PutAttributes" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2009-04-15" :: Prelude.ByteString),
        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,
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Attribute" [ReplaceableAttribute]
attributes
      ]

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

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

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