{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wall -Werror #-}

-- |
-- Module      : Amazonka.DynamoDB.AttributeValue
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
module Amazonka.DynamoDB.Types.AttributeValue where

import Amazonka.Data
import Amazonka.Prelude
import Data.Aeson (pairs)
import Data.Hashable
import Data.Map (Map)
import Data.Vector (Vector)

#if MIN_VERSION_aeson(2,0,0)
import qualified  Data.Aeson.KeyMap as KeyMap
#else
import qualified  Data.HashMap.Strict as KeyMap
#endif

-- | Represents the data for an attribute.
--
-- DynamoDB sends and receives JSON objects which contain a single
-- item whose key is a data type and the value is the data itself. We
-- provide an actual sum type to interact with these.
--
-- 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/.
data AttributeValue
  = -- | An attribute of type List. For example:
    --
    -- @\"L\": [{\"S\": \"Cookies\"} , {\"S\": \"Coffee\"}, {\"N\", \"3.14159\"}]@
    L (Vector AttributeValue)
  | -- | An attribute of type Number Set. For example:
    --
    -- @\"NS\": [\"42.2\", \"-19\", \"7.5\", \"3.14\"]@
    --
    -- Numbers are sent across the network to DynamoDB as strings, to maximize
    -- compatibility across languages and libraries. However, DynamoDB treats
    -- them as number type attributes for mathematical operations.
    NS (Vector Text)
  | -- | An attribute of type Map. For example:
    --
    -- @\"M\": {\"Name\": {\"S\": \"Joe\"}, \"Age\": {\"N\": \"35\"}}@
    M (Map Text AttributeValue)
  | -- | An attribute of type Null. For example:
    --
    -- @\"NULL\": true@
    NULL
  | -- | An attribute of type Number. For example:
    --
    -- @\"N\": \"123.45\"@
    --
    -- Numbers are sent across the network to DynamoDB as strings, to maximize
    -- compatibility across languages and libraries. However, DynamoDB treats
    -- them as number type attributes for mathematical operations.
    N Text
  | -- | An attribute of type Binary Set. For example:
    --
    -- @\"BS\": [\"U3Vubnk=\", \"UmFpbnk=\", \"U25vd3k=\"]@
    BS (Vector Base64)
  | -- | An attribute of type Binary. For example:
    --
    -- @\"B\": \"dGhpcyB0ZXh0IGlzIGJhc2U2NC1lbmNvZGVk\"@
    B Base64
  | -- | An attribute of type String Set. For example:
    --
    -- @\"SS\": [\"Giraffe\", \"Hippo\" ,\"Zebra\"]@
    SS (Vector Text)
  | -- | An attribute of type String. For example:
    --
    -- @\"S\": \"Hello\"@
    S Text
  | -- | An attribute of type Boolean. For example:
    --
    -- @\"BOOL\": true@
    BOOL Bool
  deriving stock (AttributeValue -> AttributeValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeValue -> AttributeValue -> Bool
$c/= :: AttributeValue -> AttributeValue -> Bool
== :: AttributeValue -> AttributeValue -> Bool
$c== :: AttributeValue -> AttributeValue -> Bool
Eq, ReadPrec [AttributeValue]
ReadPrec AttributeValue
Int -> ReadS AttributeValue
ReadS [AttributeValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttributeValue]
$creadListPrec :: ReadPrec [AttributeValue]
readPrec :: ReadPrec AttributeValue
$creadPrec :: ReadPrec AttributeValue
readList :: ReadS [AttributeValue]
$creadList :: ReadS [AttributeValue]
readsPrec :: Int -> ReadS AttributeValue
$creadsPrec :: Int -> ReadS AttributeValue
Read, Int -> AttributeValue -> ShowS
[AttributeValue] -> ShowS
AttributeValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeValue] -> ShowS
$cshowList :: [AttributeValue] -> ShowS
show :: AttributeValue -> String
$cshow :: AttributeValue -> String
showsPrec :: Int -> AttributeValue -> ShowS
$cshowsPrec :: Int -> AttributeValue -> ShowS
Show, forall x. Rep AttributeValue x -> AttributeValue
forall x. AttributeValue -> Rep AttributeValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeValue x -> AttributeValue
$cfrom :: forall x. AttributeValue -> Rep AttributeValue x
Generic)
  deriving anyclass (AttributeValue -> ()
forall a. (a -> ()) -> NFData a
rnf :: AttributeValue -> ()
$crnf :: AttributeValue -> ()
NFData)

instance Hashable AttributeValue where
  hashWithSalt :: Int -> AttributeValue -> Int
hashWithSalt Int
salt = \case
    L Vector AttributeValue
avs -> Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
0 :: Int) forall a. Hashable a => Int -> Vector a -> Int
`hashVector` Vector AttributeValue
avs
    NS Vector Text
ns -> Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1 :: Int) forall a. Hashable a => Int -> Vector a -> Int
`hashVector` Vector Text
ns
    M Map Text AttributeValue
m -> Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Map Text AttributeValue
m
    AttributeValue
NULL -> Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
3 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` ()
    N Text
n -> Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
4 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
n
    BS Vector Base64
bs -> Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
5 :: Int) forall a. Hashable a => Int -> Vector a -> Int
`hashVector` Vector Base64
bs
    B Base64
b -> Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
6 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Base64
b
    SS Vector Text
ss -> Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
7 :: Int) forall a. Hashable a => Int -> Vector a -> Int
`hashVector` Vector Text
ss
    S Text
s -> Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
8 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
s
    BOOL Bool
b -> Int
salt forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
9 :: Int) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
b
    where
      hashVector :: Hashable a => Int -> Vector a -> Int
      hashVector :: forall a. Hashable a => Int -> Vector a -> Int
hashVector = forall b a. Hashable b => (a -> b) -> Int -> a -> Int
hashUsing forall l. IsList l => l -> [Item l]
toList

instance FromJSON AttributeValue where
  parseJSON :: Value -> Parser AttributeValue
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AttributeValue" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    case forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
o of
      [(Key
"L", Value
v)] -> Vector AttributeValue -> AttributeValue
L forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [(Key
"NS", Value
v)] -> Vector Text -> AttributeValue
NS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [(Key
"M", Value
v)] -> Map Text AttributeValue -> AttributeValue
M forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [(Key
"NULL", Value
_)] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AttributeValue
NULL
      [(Key
"N", Value
v)] -> Text -> AttributeValue
N forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [(Key
"BS", Value
v)] -> Vector Base64 -> AttributeValue
BS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [(Key
"B", Value
v)] -> Base64 -> AttributeValue
B forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [(Key
"SS", Value
v)] -> Vector Text -> AttributeValue
SS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [(Key
"S", Value
v)] -> Text -> AttributeValue
S forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [(Key
"BOOL", Value
v)] -> Bool -> AttributeValue
BOOL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No keys"
      [(Key, Value)]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Multiple or unrecognized keys: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall v. KeyMap v -> [Key]
KeyMap.keys Object
o)

instance ToJSON AttributeValue where
  toJSON :: AttributeValue -> Value
toJSON =
    [(Key, Value)] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      L Vector AttributeValue
avs -> Key
"L" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector AttributeValue
avs
      NS Vector Text
ns -> Key
"NS" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Text
ns
      M Map Text AttributeValue
m -> Key
"M" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text AttributeValue
m
      AttributeValue
NULL -> Key
"NULL" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True
      N Text
n -> Key
"N" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
n
      BS Vector Base64
bs -> Key
"BS" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Base64
bs
      B Base64
b -> Key
"B" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64
b
      SS Vector Text
ss -> Key
"SS" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Text
ss
      S Text
s -> Key
"S" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
      BOOL Bool
b -> Key
"BOOL" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
  toEncoding :: AttributeValue -> Encoding
toEncoding =
    Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      L Vector AttributeValue
avs -> Key
"L" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector AttributeValue
avs
      NS Vector Text
ns -> Key
"NS" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Text
ns
      M Map Text AttributeValue
m -> Key
"M" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text AttributeValue
m
      AttributeValue
NULL -> Key
"NULL" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True
      N Text
n -> Key
"N" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
n
      BS Vector Base64
bs -> Key
"BS" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Base64
bs
      B Base64
b -> Key
"B" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Base64
b
      SS Vector Text
ss -> Key
"SS" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Text
ss
      S Text
s -> Key
"S" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s
      BOOL Bool
b -> Key
"BOOL" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b