{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.DynamoDB.Types.AttributeValueUpdate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.DynamoDB.Types.AttributeValueUpdate where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DynamoDB.Types.AttributeAction
import Amazonka.DynamoDB.Types.AttributeValue
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | For the @UpdateItem@ operation, represents the attributes to be
-- modified, the action to perform on each, and the new value for each.
--
-- You cannot use @UpdateItem@ to update any primary key attributes.
-- Instead, you will need to delete the item, and then use @PutItem@ to
-- create a new item with new attributes.
--
-- Attribute values cannot be null; string and binary type attributes must
-- have lengths greater than zero; and set type attributes must not be
-- empty. Requests with empty values will be rejected with a
-- @ValidationException@ exception.
--
-- /See:/ 'newAttributeValueUpdate' smart constructor.
data AttributeValueUpdate = AttributeValueUpdate'
  { -- | Specifies how to perform the update. Valid values are @PUT@ (default),
    -- @DELETE@, and @ADD@. The behavior depends on whether the specified
    -- primary key already exists in the table.
    --
    -- __If an item with the specified /Key/ is found in the table:__
    --
    -- -   @PUT@ - Adds the specified attribute to the item. If the attribute
    --     already exists, it is replaced by the new value.
    --
    -- -   @DELETE@ - If no value is specified, the attribute and its value are
    --     removed from the item. The data type of the specified value must
    --     match the existing value\'s data type.
    --
    --     If a /set/ of values is specified, then those values are subtracted
    --     from the old set. For example, if the attribute value was the set
    --     @[a,b,c]@ and the @DELETE@ action specified @[a,c]@, then the final
    --     attribute value would be @[b]@. Specifying an empty set is an error.
    --
    -- -   @ADD@ - If the attribute does not already exist, then the attribute
    --     and its values are added to the item. If the attribute does exist,
    --     then the behavior of @ADD@ depends on the data type of the
    --     attribute:
    --
    --     -   If the existing attribute is a number, and if @Value@ is also a
    --         number, then the @Value@ is mathematically added to the existing
    --         attribute. If @Value@ is a negative number, then it is
    --         subtracted from the existing attribute.
    --
    --         If you use @ADD@ to increment or decrement a number value for an
    --         item that doesn\'t exist before the update, DynamoDB uses 0 as
    --         the initial value.
    --
    --         In addition, if you use @ADD@ to update an existing item, and
    --         intend to increment or decrement an attribute value which does
    --         not yet exist, DynamoDB uses @0@ as the initial value. For
    --         example, suppose that the item you want to update does not yet
    --         have an attribute named /itemcount/, but you decide to @ADD@ the
    --         number @3@ to this attribute anyway, even though it currently
    --         does not exist. DynamoDB will create the /itemcount/ attribute,
    --         set its initial value to @0@, and finally add @3@ to it. The
    --         result will be a new /itemcount/ attribute in the item, with a
    --         value of @3@.
    --
    --     -   If the existing data type is a set, and if the @Value@ is also a
    --         set, then the @Value@ is added to the existing set. (This is a
    --         /set/ operation, not mathematical addition.) For example, if the
    --         attribute value was the set @[1,2]@, and the @ADD@ action
    --         specified @[3]@, then the final attribute value would be
    --         @[1,2,3]@. An error occurs if an Add action is specified for a
    --         set attribute and the attribute type specified does not match
    --         the existing set type.
    --
    --         Both sets must have the same primitive data type. For example,
    --         if the existing data type is a set of strings, the @Value@ must
    --         also be a set of strings. The same holds true for number sets
    --         and binary sets.
    --
    --     This action is only valid for an existing attribute whose data type
    --     is number or is a set. Do not use @ADD@ for any other data types.
    --
    -- __If no item with the specified /Key/ is found:__
    --
    -- -   @PUT@ - DynamoDB creates a new item with the specified primary key,
    --     and then adds the attribute.
    --
    -- -   @DELETE@ - Nothing happens; there is no attribute to delete.
    --
    -- -   @ADD@ - DynamoDB creates a new item with the supplied primary key
    --     and number (or set) for the attribute value. The only data types
    --     allowed are number, number set, string set or binary set.
    AttributeValueUpdate -> Maybe AttributeAction
action :: Prelude.Maybe AttributeAction,
    -- | Represents the data for an attribute.
    --
    -- Each attribute value is described as a name-value pair. The name is the
    -- data type, and the value is the data itself.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.NamingRulesDataTypes.html#HowItWorks.DataTypes Data Types>
    -- in the /Amazon DynamoDB Developer Guide/.
    AttributeValueUpdate -> Maybe AttributeValue
value :: Prelude.Maybe AttributeValue
  }
  deriving (AttributeValueUpdate -> AttributeValueUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeValueUpdate -> AttributeValueUpdate -> Bool
$c/= :: AttributeValueUpdate -> AttributeValueUpdate -> Bool
== :: AttributeValueUpdate -> AttributeValueUpdate -> Bool
$c== :: AttributeValueUpdate -> AttributeValueUpdate -> Bool
Prelude.Eq, ReadPrec [AttributeValueUpdate]
ReadPrec AttributeValueUpdate
Int -> ReadS AttributeValueUpdate
ReadS [AttributeValueUpdate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttributeValueUpdate]
$creadListPrec :: ReadPrec [AttributeValueUpdate]
readPrec :: ReadPrec AttributeValueUpdate
$creadPrec :: ReadPrec AttributeValueUpdate
readList :: ReadS [AttributeValueUpdate]
$creadList :: ReadS [AttributeValueUpdate]
readsPrec :: Int -> ReadS AttributeValueUpdate
$creadsPrec :: Int -> ReadS AttributeValueUpdate
Prelude.Read, Int -> AttributeValueUpdate -> ShowS
[AttributeValueUpdate] -> ShowS
AttributeValueUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeValueUpdate] -> ShowS
$cshowList :: [AttributeValueUpdate] -> ShowS
show :: AttributeValueUpdate -> String
$cshow :: AttributeValueUpdate -> String
showsPrec :: Int -> AttributeValueUpdate -> ShowS
$cshowsPrec :: Int -> AttributeValueUpdate -> ShowS
Prelude.Show, forall x. Rep AttributeValueUpdate x -> AttributeValueUpdate
forall x. AttributeValueUpdate -> Rep AttributeValueUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeValueUpdate x -> AttributeValueUpdate
$cfrom :: forall x. AttributeValueUpdate -> Rep AttributeValueUpdate x
Prelude.Generic)

-- |
-- Create a value of 'AttributeValueUpdate' 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:
--
-- 'action', 'attributeValueUpdate_action' - Specifies how to perform the update. Valid values are @PUT@ (default),
-- @DELETE@, and @ADD@. The behavior depends on whether the specified
-- primary key already exists in the table.
--
-- __If an item with the specified /Key/ is found in the table:__
--
-- -   @PUT@ - Adds the specified attribute to the item. If the attribute
--     already exists, it is replaced by the new value.
--
-- -   @DELETE@ - If no value is specified, the attribute and its value are
--     removed from the item. The data type of the specified value must
--     match the existing value\'s data type.
--
--     If a /set/ of values is specified, then those values are subtracted
--     from the old set. For example, if the attribute value was the set
--     @[a,b,c]@ and the @DELETE@ action specified @[a,c]@, then the final
--     attribute value would be @[b]@. Specifying an empty set is an error.
--
-- -   @ADD@ - If the attribute does not already exist, then the attribute
--     and its values are added to the item. If the attribute does exist,
--     then the behavior of @ADD@ depends on the data type of the
--     attribute:
--
--     -   If the existing attribute is a number, and if @Value@ is also a
--         number, then the @Value@ is mathematically added to the existing
--         attribute. If @Value@ is a negative number, then it is
--         subtracted from the existing attribute.
--
--         If you use @ADD@ to increment or decrement a number value for an
--         item that doesn\'t exist before the update, DynamoDB uses 0 as
--         the initial value.
--
--         In addition, if you use @ADD@ to update an existing item, and
--         intend to increment or decrement an attribute value which does
--         not yet exist, DynamoDB uses @0@ as the initial value. For
--         example, suppose that the item you want to update does not yet
--         have an attribute named /itemcount/, but you decide to @ADD@ the
--         number @3@ to this attribute anyway, even though it currently
--         does not exist. DynamoDB will create the /itemcount/ attribute,
--         set its initial value to @0@, and finally add @3@ to it. The
--         result will be a new /itemcount/ attribute in the item, with a
--         value of @3@.
--
--     -   If the existing data type is a set, and if the @Value@ is also a
--         set, then the @Value@ is added to the existing set. (This is a
--         /set/ operation, not mathematical addition.) For example, if the
--         attribute value was the set @[1,2]@, and the @ADD@ action
--         specified @[3]@, then the final attribute value would be
--         @[1,2,3]@. An error occurs if an Add action is specified for a
--         set attribute and the attribute type specified does not match
--         the existing set type.
--
--         Both sets must have the same primitive data type. For example,
--         if the existing data type is a set of strings, the @Value@ must
--         also be a set of strings. The same holds true for number sets
--         and binary sets.
--
--     This action is only valid for an existing attribute whose data type
--     is number or is a set. Do not use @ADD@ for any other data types.
--
-- __If no item with the specified /Key/ is found:__
--
-- -   @PUT@ - DynamoDB creates a new item with the specified primary key,
--     and then adds the attribute.
--
-- -   @DELETE@ - Nothing happens; there is no attribute to delete.
--
-- -   @ADD@ - DynamoDB creates a new item with the supplied primary key
--     and number (or set) for the attribute value. The only data types
--     allowed are number, number set, string set or binary set.
--
-- 'value', 'attributeValueUpdate_value' - Represents the data for an attribute.
--
-- Each attribute value is described as a name-value pair. The name is the
-- data type, and the value is the data itself.
--
-- For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.NamingRulesDataTypes.html#HowItWorks.DataTypes Data Types>
-- in the /Amazon DynamoDB Developer Guide/.
newAttributeValueUpdate ::
  AttributeValueUpdate
newAttributeValueUpdate :: AttributeValueUpdate
newAttributeValueUpdate =
  AttributeValueUpdate'
    { $sel:action:AttributeValueUpdate' :: Maybe AttributeAction
action = forall a. Maybe a
Prelude.Nothing,
      $sel:value:AttributeValueUpdate' :: Maybe AttributeValue
value = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies how to perform the update. Valid values are @PUT@ (default),
-- @DELETE@, and @ADD@. The behavior depends on whether the specified
-- primary key already exists in the table.
--
-- __If an item with the specified /Key/ is found in the table:__
--
-- -   @PUT@ - Adds the specified attribute to the item. If the attribute
--     already exists, it is replaced by the new value.
--
-- -   @DELETE@ - If no value is specified, the attribute and its value are
--     removed from the item. The data type of the specified value must
--     match the existing value\'s data type.
--
--     If a /set/ of values is specified, then those values are subtracted
--     from the old set. For example, if the attribute value was the set
--     @[a,b,c]@ and the @DELETE@ action specified @[a,c]@, then the final
--     attribute value would be @[b]@. Specifying an empty set is an error.
--
-- -   @ADD@ - If the attribute does not already exist, then the attribute
--     and its values are added to the item. If the attribute does exist,
--     then the behavior of @ADD@ depends on the data type of the
--     attribute:
--
--     -   If the existing attribute is a number, and if @Value@ is also a
--         number, then the @Value@ is mathematically added to the existing
--         attribute. If @Value@ is a negative number, then it is
--         subtracted from the existing attribute.
--
--         If you use @ADD@ to increment or decrement a number value for an
--         item that doesn\'t exist before the update, DynamoDB uses 0 as
--         the initial value.
--
--         In addition, if you use @ADD@ to update an existing item, and
--         intend to increment or decrement an attribute value which does
--         not yet exist, DynamoDB uses @0@ as the initial value. For
--         example, suppose that the item you want to update does not yet
--         have an attribute named /itemcount/, but you decide to @ADD@ the
--         number @3@ to this attribute anyway, even though it currently
--         does not exist. DynamoDB will create the /itemcount/ attribute,
--         set its initial value to @0@, and finally add @3@ to it. The
--         result will be a new /itemcount/ attribute in the item, with a
--         value of @3@.
--
--     -   If the existing data type is a set, and if the @Value@ is also a
--         set, then the @Value@ is added to the existing set. (This is a
--         /set/ operation, not mathematical addition.) For example, if the
--         attribute value was the set @[1,2]@, and the @ADD@ action
--         specified @[3]@, then the final attribute value would be
--         @[1,2,3]@. An error occurs if an Add action is specified for a
--         set attribute and the attribute type specified does not match
--         the existing set type.
--
--         Both sets must have the same primitive data type. For example,
--         if the existing data type is a set of strings, the @Value@ must
--         also be a set of strings. The same holds true for number sets
--         and binary sets.
--
--     This action is only valid for an existing attribute whose data type
--     is number or is a set. Do not use @ADD@ for any other data types.
--
-- __If no item with the specified /Key/ is found:__
--
-- -   @PUT@ - DynamoDB creates a new item with the specified primary key,
--     and then adds the attribute.
--
-- -   @DELETE@ - Nothing happens; there is no attribute to delete.
--
-- -   @ADD@ - DynamoDB creates a new item with the supplied primary key
--     and number (or set) for the attribute value. The only data types
--     allowed are number, number set, string set or binary set.
attributeValueUpdate_action :: Lens.Lens' AttributeValueUpdate (Prelude.Maybe AttributeAction)
attributeValueUpdate_action :: Lens' AttributeValueUpdate (Maybe AttributeAction)
attributeValueUpdate_action = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttributeValueUpdate' {Maybe AttributeAction
action :: Maybe AttributeAction
$sel:action:AttributeValueUpdate' :: AttributeValueUpdate -> Maybe AttributeAction
action} -> Maybe AttributeAction
action) (\s :: AttributeValueUpdate
s@AttributeValueUpdate' {} Maybe AttributeAction
a -> AttributeValueUpdate
s {$sel:action:AttributeValueUpdate' :: Maybe AttributeAction
action = Maybe AttributeAction
a} :: AttributeValueUpdate)

-- | Represents the data for an attribute.
--
-- Each attribute value is described as a name-value pair. The name is the
-- data type, and the value is the data itself.
--
-- For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.NamingRulesDataTypes.html#HowItWorks.DataTypes Data Types>
-- in the /Amazon DynamoDB Developer Guide/.
attributeValueUpdate_value :: Lens.Lens' AttributeValueUpdate (Prelude.Maybe AttributeValue)
attributeValueUpdate_value :: Lens' AttributeValueUpdate (Maybe AttributeValue)
attributeValueUpdate_value = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttributeValueUpdate' {Maybe AttributeValue
value :: Maybe AttributeValue
$sel:value:AttributeValueUpdate' :: AttributeValueUpdate -> Maybe AttributeValue
value} -> Maybe AttributeValue
value) (\s :: AttributeValueUpdate
s@AttributeValueUpdate' {} Maybe AttributeValue
a -> AttributeValueUpdate
s {$sel:value:AttributeValueUpdate' :: Maybe AttributeValue
value = Maybe AttributeValue
a} :: AttributeValueUpdate)

instance Prelude.Hashable AttributeValueUpdate where
  hashWithSalt :: Int -> AttributeValueUpdate -> Int
hashWithSalt Int
_salt AttributeValueUpdate' {Maybe AttributeValue
Maybe AttributeAction
value :: Maybe AttributeValue
action :: Maybe AttributeAction
$sel:value:AttributeValueUpdate' :: AttributeValueUpdate -> Maybe AttributeValue
$sel:action:AttributeValueUpdate' :: AttributeValueUpdate -> Maybe AttributeAction
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeAction
action
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeValue
value

instance Prelude.NFData AttributeValueUpdate where
  rnf :: AttributeValueUpdate -> ()
rnf AttributeValueUpdate' {Maybe AttributeValue
Maybe AttributeAction
value :: Maybe AttributeValue
action :: Maybe AttributeAction
$sel:value:AttributeValueUpdate' :: AttributeValueUpdate -> Maybe AttributeValue
$sel:action:AttributeValueUpdate' :: AttributeValueUpdate -> Maybe AttributeAction
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeAction
action seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
value

instance Data.ToJSON AttributeValueUpdate where
  toJSON :: AttributeValueUpdate -> Value
toJSON AttributeValueUpdate' {Maybe AttributeValue
Maybe AttributeAction
value :: Maybe AttributeValue
action :: Maybe AttributeAction
$sel:value:AttributeValueUpdate' :: AttributeValueUpdate -> Maybe AttributeValue
$sel:action:AttributeValueUpdate' :: AttributeValueUpdate -> Maybe AttributeAction
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Action" 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 AttributeAction
action,
            (Key
"Value" 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 AttributeValue
value
          ]
      )