module Aws.Test.DynamoDb.Utils
(
testProtocol
, testRegion
, defaultTableName
, dyConfiguration
, simpleDy
, simpleDyT
, withTable
, withTable_
, createTestTable
, readRegion
) where
import Aws
import Aws.Core
import qualified Aws.DynamoDb as DY
import Aws.Test.Utils
import Control.Error
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import qualified Data.List as L
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import System.IO
testProtocol :: Protocol
testProtocol = HTTP
testRegion :: DY.Region
testRegion = DY.ddbUsWest2
defaultTableName :: T.Text
defaultTableName = "test-table"
dyConfiguration :: DY.DdbConfiguration qt
dyConfiguration = DY.DdbConfiguration
{ DY.ddbcRegion = testRegion
, DY.ddbcProtocol = testProtocol
, DY.ddbcPort = Nothing
}
simpleDy
:: (AsMemoryResponse a, Transaction r a, ServiceConfiguration r ~ DY.DdbConfiguration, MonadIO m)
=> r
-> m (MemoryResponse a)
simpleDy command = do
c <- baseConfiguration
simpleAws c dyConfiguration command
simpleDyT
:: (AsMemoryResponse a, Transaction r a, ServiceConfiguration r ~ DY.DdbConfiguration, MonadBaseControl IO m, MonadIO m)
=> r
-> EitherT T.Text m (MemoryResponse a)
simpleDyT = tryT . simpleDy
withTable
:: T.Text
-> Int
-> Int
-> (T.Text -> IO a)
-> IO a
withTable = withTable_ True
withTable_
:: Bool
-> T.Text
-> Int
-> Int
-> (T.Text -> IO a)
-> IO a
withTable_ prefix tableName readCapacity writeCapacity f =
bracket_ createTable deleteTable $ f tTableName
where
tTableName = if prefix then testData tableName else tableName
deleteTable = do
r <- runEitherT . retryT 6 $
void (simpleDyT $ DY.DeleteTable tTableName) `catchT` \e ->
liftIO . T.hPutStrLn stderr $ "attempt to delete table failed: " <> e
either (error . T.unpack) (const $ return ()) r
createTable = do
r <- runEitherT $ do
retryT 3 $ tryT $ createTestTable tTableName readCapacity writeCapacity
retryT 6 $ do
tableDesc <- simpleDyT $ DY.DescribeTable tTableName
when (DY.rTableStatus tableDesc == "CREATING") $ left "Table not ready: status CREATING"
either (error . T.unpack) return r
createTestTable
:: T.Text
-> Int
-> Int
-> IO ()
createTestTable tableName readCapacity writeCapacity = void . simpleDy $
DY.createTable
tableName
attrs
(DY.HashOnly keyName)
throughPut
where
keyName = "Id"
keyType = DY.AttrString
attrs = [DY.AttributeDefinition keyName keyType]
throughPut = DY.ProvisionedThroughput
{ DY.readCapacityUnits = readCapacity
, DY.writeCapacityUnits = writeCapacity
}
readRegion
:: T.Text
-> Either String DY.Region
readRegion t =
maybe (Left $ "unknown region: " <> T.unpack t) Right $
L.find (\(DY.Region _ n) -> T.decodeUtf8 n == t)
[ DY.ddbLocal
, DY.ddbUsEast1
, DY.ddbUsWest1
, DY.ddbUsWest2
, DY.ddbEuWest1
, DY.ddbApNe1
, DY.ddbApSe1
, DY.ddbApSe2
, DY.ddbSaEast1
]