module Aws.DynamoDb.Commands.Table(
CreateTable(..)
, CreateTableResult(..)
, DescribeTable(..)
, DescribeTableResult(..)
, UpdateTable(..)
, UpdateTableResult(..)
, DeleteTable(..)
, DeleteTableResult(..)
, ListTables(..)
, ListTablesResult(..)
, KeyAttributeType(..)
, KeyAttributeDefinition(..)
, KeySchema(..)
, Projection(..)
, LocalSecondaryIndex(..)
, LocalSecondaryIndexStatus(..)
, ProvisionedThroughput(..)
, ProvisionedThroughputStatus(..)
, GlobalSecondaryIndex(..)
, GlobalSecondaryIndexStatus(..)
, GlobalSecondaryIndexUpdate(..)
, TableDescription(..)
) where
import Aws.Core
import Aws.DynamoDb.Core
import Control.Applicative
import Data.Aeson ((.=), (.:), (.!=), (.:?))
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import Data.Char (toUpper)
import Data.Time
import Data.Time.Clock.POSIX
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as M
import GHC.Generics (Generic)
capitalizeOpt :: A.Options
capitalizeOpt = A.defaultOptions { A.fieldLabelModifier = \x -> case x of
(c:cs) -> toUpper c : cs
[] -> []
}
dropOpt :: Int -> A.Options
dropOpt d = A.defaultOptions { A.fieldLabelModifier = drop d }
data KeyAttributeType = AttrStringT | AttrNumberT | AttrBinaryT
deriving (Show, Eq, Enum, Bounded, Generic)
instance A.ToJSON KeyAttributeType where
toJSON AttrStringT = A.String "S"
toJSON AttrNumberT = A.String "N"
toJSON AttrBinaryT = A.String "B"
instance A.FromJSON KeyAttributeType where
parseJSON (A.String str) =
case str of
"S" -> return AttrStringT
"N" -> return AttrNumberT
"B" -> return AttrBinaryT
_ -> fail $ "Invalid attribute type " ++ T.unpack str
parseJSON _ = fail "Attribute type must be a string"
data KeyAttributeDefinition
= KeyAttributeDefinition {
attributeName :: T.Text
, attributeType :: KeyAttributeType
}
deriving (Show, Generic)
instance A.ToJSON KeyAttributeDefinition where
toJSON = A.genericToJSON capitalizeOpt
instance A.FromJSON KeyAttributeDefinition where
parseJSON = A.genericParseJSON capitalizeOpt
data KeySchema = KeyHashOnly T.Text
| KeyHashAndRange T.Text T.Text
deriving (Show)
instance A.ToJSON KeySchema where
toJSON (KeyHashOnly attr)
= A.Array $ V.fromList [ A.object [ "AttributeName" .= attr
, "KeyType" .= ("HASH" :: T.Text)
]
]
toJSON (KeyHashAndRange hash range)
= A.Array $ V.fromList [ A.object [ "AttributeName" .= hash
, "KeyType" .= ("HASH" :: T.Text)
]
, A.object [ "AttributeName" .= range
, "KeyType" .= ("RANGE" :: T.Text)
]
]
instance A.FromJSON KeySchema where
parseJSON (A.Array v) =
case V.length v of
1 -> do obj <- A.parseJSON (v V.! 0)
kt <- obj .: "KeyType"
if kt /= ("HASH" :: T.Text)
then fail "With only one key, the type must be HASH"
else KeyHashOnly <$> obj .: "AttributeName"
2 -> do hash <- A.parseJSON (v V.! 0)
range <- A.parseJSON (v V.! 1)
hkt <- hash .: "KeyType"
rkt <- range .: "KeyType"
if hkt /= ("HASH" :: T.Text) || rkt /= ("RANGE" :: T.Text)
then fail "With two keys, one must be HASH and the other RANGE"
else KeyHashAndRange <$> hash .: "AttributeName"
<*> range .: "AttributeName"
_ -> fail "Key schema must have one or two entries"
parseJSON _ = fail "Key schema must be an array"
data Projection = ProjectKeysOnly
| ProjectAll
| ProjectInclude [T.Text]
deriving Show
instance A.ToJSON Projection where
toJSON ProjectKeysOnly = A.object [ "ProjectionType" .= ("KEYS_ONLY" :: T.Text) ]
toJSON ProjectAll = A.object [ "ProjectionType" .= ("ALL" :: T.Text) ]
toJSON (ProjectInclude a) = A.object [ "ProjectionType" .= ("INCLUDE" :: T.Text)
, "NonKeyAttributes" .= a
]
instance A.FromJSON Projection where
parseJSON (A.Object o) = do
ty <- (o .: "ProjectionType") :: A.Parser T.Text
case ty of
"KEYS_ONLY" -> return ProjectKeysOnly
"ALL" -> return ProjectAll
"INCLUDE" -> ProjectInclude <$> o .: "NonKeyAttributes"
_ -> fail "Invalid projection type"
parseJSON _ = fail "Projection must be an object"
data LocalSecondaryIndex
= LocalSecondaryIndex {
localIndexName :: T.Text
, localKeySchema :: KeySchema
, localProjection :: Projection
}
deriving (Show, Generic)
instance A.ToJSON LocalSecondaryIndex where
toJSON = A.genericToJSON $ dropOpt 5
instance A.FromJSON LocalSecondaryIndex where
parseJSON = A.genericParseJSON $ dropOpt 5
data LocalSecondaryIndexStatus
= LocalSecondaryIndexStatus {
locStatusIndexName :: T.Text
, locStatusIndexSizeBytes :: Integer
, locStatusItemCount :: Integer
, locStatusKeySchema :: KeySchema
, locStatusProjection :: Projection
}
deriving (Show, Generic)
instance A.FromJSON LocalSecondaryIndexStatus where
parseJSON = A.genericParseJSON $ dropOpt 9
data ProvisionedThroughput
= ProvisionedThroughput {
readCapacityUnits :: Int
, writeCapacityUnits :: Int
}
deriving (Show, Generic)
instance A.ToJSON ProvisionedThroughput where
toJSON = A.genericToJSON capitalizeOpt
instance A.FromJSON ProvisionedThroughput where
parseJSON = A.genericParseJSON capitalizeOpt
data ProvisionedThroughputStatus
= ProvisionedThroughputStatus {
statusLastDecreaseDateTime :: UTCTime
, statusLastIncreaseDateTime :: UTCTime
, statusNumberOfDecreasesToday :: Int
, statusReadCapacityUnits :: Int
, statusWriteCapacityUnits :: Int
}
deriving (Show, Generic)
instance A.FromJSON ProvisionedThroughputStatus where
parseJSON = A.withObject "Throughput status must be an object" $ \o ->
ProvisionedThroughputStatus
<$> (posixSecondsToUTCTime . fromInteger <$> o .:? "LastDecreaseDateTime" .!= 0)
<*> (posixSecondsToUTCTime . fromInteger <$> o .:? "LastIncreaseDateTime" .!= 0)
<*> o .:? "NumberOfDecreasesToday" .!= 0
<*> o .: "ReadCapacityUnits"
<*> o .: "WriteCapacityUnits"
data GlobalSecondaryIndex
= GlobalSecondaryIndex {
globalIndexName :: T.Text
, globalKeySchema :: KeySchema
, globalProjection :: Projection
, globalProvisionedThroughput :: ProvisionedThroughput
}
deriving (Show, Generic)
instance A.ToJSON GlobalSecondaryIndex where
toJSON = A.genericToJSON $ dropOpt 6
instance A.FromJSON GlobalSecondaryIndex where
parseJSON = A.genericParseJSON $ dropOpt 6
data GlobalSecondaryIndexStatus
= GlobalSecondaryIndexStatus {
gStatusIndexName :: T.Text
, gStatusIndexSizeBytes :: Integer
, gStatusIndexStatus :: T.Text
, gStatusItemCount :: Integer
, gStatusKeySchema :: KeySchema
, gStatusProjection :: Projection
, gStatusProvisionedThroughput :: ProvisionedThroughputStatus
}
deriving (Show, Generic)
instance A.FromJSON GlobalSecondaryIndexStatus where
parseJSON = A.genericParseJSON $ dropOpt 7
data GlobalSecondaryIndexUpdate
= GlobalSecondaryIndexUpdate {
gUpdateIndexName :: T.Text
, gUpdateProvisionedThroughput :: ProvisionedThroughput
}
deriving (Show, Generic)
instance A.ToJSON GlobalSecondaryIndexUpdate where
toJSON gi = A.object ["Update" .= A.genericToJSON (dropOpt 7) gi]
data TableDescription
= TableDescription {
rTableName :: T.Text
, rTableSizeBytes :: Integer
, rTableStatus :: T.Text
, rCreationDateTime :: UTCTime
, rItemCount :: Integer
, rAttributeDefinitions :: [KeyAttributeDefinition]
, rKeySchema :: KeySchema
, rProvisionedThroughput :: ProvisionedThroughputStatus
, rLocalSecondaryIndexes :: [LocalSecondaryIndexStatus]
, rGlobalSecondaryIndexes :: [GlobalSecondaryIndexStatus]
}
deriving (Show, Generic)
instance A.FromJSON TableDescription where
parseJSON = A.withObject "Table must be an object" $ \o -> do
t <- case (M.lookup "Table" o, M.lookup "TableDescription" o) of
(Just (A.Object t), _) -> return t
(_, Just (A.Object t)) -> return t
_ -> fail "Table description must have key 'Table' or 'TableDescription'"
TableDescription <$> t .: "TableName"
<*> t .: "TableSizeBytes"
<*> t .: "TableStatus"
<*> (posixSecondsToUTCTime . fromInteger <$> t .: "CreationDateTime")
<*> t .: "ItemCount"
<*> t .: "AttributeDefinitions"
<*> t .: "KeySchema"
<*> t .: "ProvisionedThroughput"
<*> t .:? "LocalSecondaryIndexes" .!= []
<*> t .:? "GlobalSecondaryIndexes" .!= []
data CreateTable
= CreateTable {
createTableName :: T.Text
, createAttributeDefinitions :: [KeyAttributeDefinition]
, createKeySchema :: KeySchema
, createProvisionedThroughput :: ProvisionedThroughput
, createLocalSecondaryIndexes :: [LocalSecondaryIndex]
, createGlobalSecondaryIndexes :: [GlobalSecondaryIndex]
}
deriving (Show, Generic)
instance A.ToJSON CreateTable where
toJSON ct = A.object $ m ++ lindex ++ gindex
where
m = [ "TableName" .= createTableName ct
, "AttributeDefinitions" .= createAttributeDefinitions ct
, "KeySchema" .= createKeySchema ct
, "ProvisionedThroughput" .= createProvisionedThroughput ct
]
lindex = if null (createLocalSecondaryIndexes ct)
then []
else [ "LocalSecondaryIndexes" .= createLocalSecondaryIndexes ct ]
gindex = if null (createGlobalSecondaryIndexes ct)
then []
else [ "GlobalSecondaryIndexes" .= createGlobalSecondaryIndexes ct ]
instance SignQuery CreateTable where
type ServiceConfiguration CreateTable = DyConfiguration
signQuery = dySignQuery "CreateTable"
newtype CreateTableResult = CreateTableResult { ctStatus :: TableDescription }
deriving (Show, A.FromJSON)
instance ResponseConsumer r CreateTableResult where
type ResponseMetadata CreateTableResult = DyMetadata
responseConsumer _ _ = dyResponseConsumer
instance AsMemoryResponse CreateTableResult where
type MemoryResponse CreateTableResult = TableDescription
loadToMemory = return . ctStatus
instance Transaction CreateTable CreateTableResult
data DescribeTable
= DescribeTable {
dTableName :: T.Text
}
deriving (Show, Generic)
instance A.ToJSON DescribeTable where
toJSON = A.genericToJSON $ dropOpt 1
instance SignQuery DescribeTable where
type ServiceConfiguration DescribeTable = DyConfiguration
signQuery = dySignQuery "DescribeTable"
newtype DescribeTableResult = DescribeTableResult { dtStatus :: TableDescription }
deriving (Show, A.FromJSON)
instance ResponseConsumer r DescribeTableResult where
type ResponseMetadata DescribeTableResult = DyMetadata
responseConsumer _ _ = dyResponseConsumer
instance AsMemoryResponse DescribeTableResult where
type MemoryResponse DescribeTableResult = TableDescription
loadToMemory = return . dtStatus
instance Transaction DescribeTable DescribeTableResult
data UpdateTable
= UpdateTable {
updateTableName :: T.Text
, updateProvisionedThroughput :: ProvisionedThroughput
, updateGlobalSecondaryIndexUpdates :: [GlobalSecondaryIndexUpdate]
}
deriving (Show, Generic)
instance A.ToJSON UpdateTable where
toJSON = A.genericToJSON $ dropOpt 6
instance SignQuery UpdateTable where
type ServiceConfiguration UpdateTable = DyConfiguration
signQuery = dySignQuery "UpdateTable"
newtype UpdateTableResult = UpdateTableResult { uStatus :: TableDescription }
deriving (Show, A.FromJSON)
instance ResponseConsumer r UpdateTableResult where
type ResponseMetadata UpdateTableResult = DyMetadata
responseConsumer _ _ = dyResponseConsumer
instance AsMemoryResponse UpdateTableResult where
type MemoryResponse UpdateTableResult = TableDescription
loadToMemory = return . uStatus
instance Transaction UpdateTable UpdateTableResult
data DeleteTable
= DeleteTable {
deleteTableName :: T.Text
}
deriving (Show, Generic)
instance A.ToJSON DeleteTable where
toJSON = A.genericToJSON $ dropOpt 6
instance SignQuery DeleteTable where
type ServiceConfiguration DeleteTable = DyConfiguration
signQuery = dySignQuery "DeleteTable"
newtype DeleteTableResult = DeleteTableResult { dStatus :: TableDescription }
deriving (Show, A.FromJSON)
instance ResponseConsumer r DeleteTableResult where
type ResponseMetadata DeleteTableResult = DyMetadata
responseConsumer _ _ = dyResponseConsumer
instance AsMemoryResponse DeleteTableResult where
type MemoryResponse DeleteTableResult = TableDescription
loadToMemory = return . dStatus
instance Transaction DeleteTable DeleteTableResult
data ListTables = ListTables
deriving (Show)
instance A.ToJSON ListTables where
toJSON _ = A.object []
instance SignQuery ListTables where
type ServiceConfiguration ListTables = DyConfiguration
signQuery = dySignQuery "ListTables"
newtype ListTablesResult
= ListTablesResult {
tableNames :: [T.Text]
}
deriving (Show, Generic)
instance A.FromJSON ListTablesResult where
parseJSON = A.genericParseJSON capitalizeOpt
instance ResponseConsumer r ListTablesResult where
type ResponseMetadata ListTablesResult = DyMetadata
responseConsumer _ _ = dyResponseConsumer
instance AsMemoryResponse ListTablesResult where
type MemoryResponse ListTablesResult = [T.Text]
loadToMemory = return . tableNames
instance Transaction ListTables ListTablesResult