1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169
|
{-# LANGUAGE OverloadedLists, OverloadedStrings #-}
module AWS.DynamoDB (tests) where
import AWS.Aeson
import Control.Concurrent (threadDelay)
import Control.Lens hiding ((.=))
import Data.Aeson.Lens (key, _String, values, _Double)
import Data.Text as T (pack)
import Network.Wreq
import System.Timeout (timeout)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (assertBool, assertFailure)
-- FIXME: retry create call in case the table is in DELETING state
-- from a previous test run (error 'Table already exists: ...'). For
-- now 'create' testcase and all others will fails. Rerun when ongoing
-- delete operation is complete.
tests :: String -> String -> Options -> Test
tests prefix region baseopts = testGroup "dynamodb" [
testCase "createTable" $ createTable prefix region baseopts
, testCase "listTables" $ listTables prefix region baseopts
, testCase "awaitTableActive" $ awaitTableActive prefix region baseopts
, testCase "putItem" $ putItem prefix region baseopts
, testCase "getItem" $ getItem prefix region baseopts
, testCase "deleteItem" $ deleteItem prefix region baseopts
, testCase "deleteTable" $ deleteTable prefix region baseopts -- call last
]
createTable :: String -> String -> Options -> IO ()
createTable prefix region baseopts = do
let opts = baseopts
& header "X-Amz-Target" .~ ["DynamoDB_20120810.CreateTable"]
& header "Content-Type" .~ ["application/x-amz-json-1.0"]
r <- postWith opts (url region) $
object [
"TableName" .= string (prefix ++ tablename),
"KeySchema" .= [
object ["AttributeName" .= "name", "KeyType" .= "HASH"],
object ["AttributeName" .= "age", "KeyType" .= "RANGE"]
],
"AttributeDefinitions" .= [
object ["AttributeName" .= "name", "AttributeType" .= "S"],
object ["AttributeName" .= "age", "AttributeType" .= "S"]
],
"ProvisionedThroughput" .= object [
"ReadCapacityUnits" .= 1,
"WriteCapacityUnits" .= 1
]
]
assertBool "createTables 200" $ r ^. responseStatus . statusCode == 200
assertBool "createTables OK" $ r ^. responseStatus . statusMessage == "OK"
assertBool "createTables status CREATING" $
r ^. responseBody . key "TableDescription" . key "TableStatus" . _String == "CREATING"
assertBool "createTables no items in new table" $
r ^? responseBody . key "TableDescription" . key "ItemCount" . _Double == Just 0
listTables :: String -> String -> Options -> IO ()
listTables prefix region baseopts = do
let opts = baseopts
& header "X-Amz-Target" .~ ["DynamoDB_20120810.ListTables"]
& header "Content-Type" .~ ["application/x-amz-json-1.0"]
-- FIXME avoid limit to keep tests from failing if there are > tables?
r <- postWith opts (url region) $ object ["Limit" .= 100]
assertBool "listTables 200" $ r ^. responseStatus . statusCode == 200
assertBool "listTables OK" $ r ^. responseStatus . statusMessage == "OK"
assertBool "listTables contains test table" $
elem (T.pack $ prefix ++ tablename)
(r ^.. responseBody . key "TableNames" . values . _String)
awaitTableActive :: String -> String -> Options -> IO ()
awaitTableActive prefix region baseopts = do
let dur = 45 -- typically ACTIVE in 20s or less (us-west-2, Sept 2014)
res <- timeout (dur*1000*1000) check
case res of
Nothing ->
assertFailure $ "timeout: table not ACTIVE after " ++ show dur ++ "s"
Just () ->
return () -- PASS
where
check = do
let opts = baseopts
& header "X-Amz-Target" .~ ["DynamoDB_20120810.DescribeTable"]
& header "Content-Type" .~ ["application/x-amz-json-1.0"]
r <- postWith opts (url region) $
object ["TableName" .= string (prefix ++ tablename)]
assertBool "awaitTableActive 200" $ r ^. responseStatus . statusCode == 200
assertBool "awaitTableActive OK" $ r ^. responseStatus . statusMessage == "OK"
-- Prelude.putStr "."
case r ^. responseBody . key "Table" . key "TableStatus" . _String of
"ACTIVE" ->
return ()
_ -> do
threadDelay $ 5*1000*1000 -- 5 sleep
check
deleteTable :: String -> String -> Options -> IO ()
deleteTable prefix region baseopts = do
let opts = baseopts
& header "X-Amz-Target" .~ ["DynamoDB_20120810.DeleteTable"]
& header "Content-Type" .~ ["application/x-amz-json-1.0"]
r <- postWith opts (url region) $
object ["TableName" .= string (prefix ++ tablename)]
assertBool "deleteTable 200" $ r ^. responseStatus . statusCode == 200
assertBool "deleteTable OK" $ r ^. responseStatus . statusMessage == "OK"
putItem :: String -> String -> Options -> IO ()
putItem prefix region baseopts = do
let opts = baseopts
& header "X-Amz-Target" .~ ["DynamoDB_20120810.PutItem"]
& header "Content-Type" .~ ["application/x-amz-json-1.0"]
r <- postWith opts (url region) $
object [
"TableName" .= string (prefix ++ tablename),
"Item" .= object [
"name" .= object ["S" .= "someone"],
"age" .= object ["S" .= "whatever"],
"bar" .= object ["S" .= "baz"]
]
]
assertBool "putItem 200" $ r ^. responseStatus . statusCode == 200
assertBool "putItem OK" $ r ^. responseStatus . statusMessage == "OK"
getItem :: String -> String -> Options -> IO ()
getItem prefix region baseopts = do
let opts = baseopts
& header "X-Amz-Target" .~ ["DynamoDB_20120810.GetItem"]
& header "Content-Type" .~ ["application/x-amz-json-1.0"]
r <- postWith opts (url region) $
object [
"TableName" .= string (prefix ++ tablename),
"Key" .= object [
"name" .= object ["S" .= "someone"],
"age" .= object ["S" .= "whatever"]
],
"AttributesToGet" .= ["bar"],
"ConsistentRead" .= true,
"ReturnConsumedCapacity" .= "TOTAL"
]
assertBool "getItem 200" $ r ^. responseStatus . statusCode == 200
assertBool "getItem OK" $ r ^. responseStatus . statusMessage == "OK"
assertBool "getItem baz value is bar" $
r ^. responseBody . key "Item" . key "bar" . key "S" . _String == "baz"
deleteItem :: String -> String -> Options -> IO ()
deleteItem prefix region baseopts = do
let opts = baseopts
& header "X-Amz-Target" .~ ["DynamoDB_20120810.DeleteItem"]
& header "Content-Type" .~ ["application/x-amz-json-1.0"]
r <- postWith opts (url region) $
object [
"TableName" .= string (prefix ++ tablename),
"Key" .= object [
"name" .= object ["S" .= "someone"],
"age" .= object ["S" .= "whatever"]
],
"ReturnValues" .= "ALL_OLD"
]
assertBool "getItem 200" $ r ^. responseStatus . statusCode == 200
assertBool "getItem OK" $ r ^. responseStatus . statusMessage == "OK"
url :: String -> String
url region =
"https://dynamodb." ++ region ++ ".amazonaws.com/"
tablename :: String
tablename =
"test"
|