aws 0.16 → 0.17

raw patch · 10 files changed

+341/−19 lines, 10 filesdep ~basedep ~http-clientdep ~timePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, http-client, time, xml-conduit

API changes (from Hackage documentation)

Files

• Aws/Aws.hs +5/−1
• Aws/DynamoDb/Commands.hs +5/−1
• Aws/DynamoDb/Commands/BatchGetItem.hs +142/−0
• Aws/DynamoDb/Commands/BatchWriteItem.hs +137/−0
• Aws/DynamoDb/Commands/Table.hs +8/−3
• Aws/DynamoDb/Core.hs +9/−0
• Aws/Sqs/Commands/Message.hs +8/−8
• CHANGELOG.md +8/−0
• aws.cabal +8/−6
• tests/S3/Main.hs +11/−0

@@ -82,6 +82,7 @@       , credentials :: Credentials         -- | The error / message logger.       , logger      :: Logger+      , proxy       :: Maybe HTTP.Proxy       }  -- | The default configuration, with credentials loaded from environment variable or configuration file@@ -95,6 +96,7 @@                       timeInfo = Timestamp                     , credentials = cr'                     , logger = defaultLog Warning+                    , proxy = Nothing                     }  -- | Debug configuration, which logs much more verbosely.@@ -234,7 +236,9 @@   let !q = {-# SCC "unsafeAwsRef:signQuery" #-} signQuery request info sd   let logDebug = liftIO . logger cfg Debug . T.pack   logDebug $ "String to sign: " ++ show (sqStringToSign q)-  !httpRequest <- {-# SCC "unsafeAwsRef:httpRequest" #-} liftIO $ queryToHttpRequest q+  !httpRequest <- {-# SCC "unsafeAwsRef:httpRequest" #-} liftIO $ do+    req <- queryToHttpRequest q+    return $ req { HTTP.proxy = proxy cfg }   logDebug $ "Host: " ++ show (HTTP.host httpRequest)   logDebug $ "Path: " ++ show (HTTP.path httpRequest)   logDebug $ "Query string: " ++ show (HTTP.queryString httpRequest)

@@ -1,5 +1,7 @@ module Aws.DynamoDb.Commands-    ( module Aws.DynamoDb.Commands.DeleteItem+    ( module Aws.DynamoDb.Commands.BatchGetItem+    , module Aws.DynamoDb.Commands.BatchWriteItem+    , module Aws.DynamoDb.Commands.DeleteItem     , module Aws.DynamoDb.Commands.GetItem     , module Aws.DynamoDb.Commands.PutItem     , module Aws.DynamoDb.Commands.Query@@ -9,6 +11,8 @@     ) where  -------------------------------------------------------------------------------+import           Aws.DynamoDb.Commands.BatchGetItem+import           Aws.DynamoDb.Commands.BatchWriteItem import           Aws.DynamoDb.Commands.DeleteItem import           Aws.DynamoDb.Commands.GetItem import           Aws.DynamoDb.Commands.PutItem

@@ -0,0 +1,142 @@+{-# LANGUAGE DeriveDataTypeable        #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE RecordWildCards           #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeFamilies              #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Aws.DynamoDb.Commands.BatchGetItem+-- Copyright   :  Soostone Inc+-- License     :  BSD3+--+-- Maintainer  :  Justin Dawson <jtdawso@gmail.com>+-- Stability   :  experimental+--+-- @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_BatchGetItem.html@+----------------------------------------------------------------------------++module Aws.DynamoDb.Commands.BatchGetItem where++-------------------------------------------------------------------------------+import           Control.Applicative+import           Data.Aeson+import           Data.Default+import qualified Data.HashMap.Strict as HM+import qualified Data.Text           as T+import           Prelude+-------------------------------------------------------------------------------+import           Aws.Core+import           Aws.DynamoDb.Core+import           Aws.DynamoDb.Commands.GetItem+-------------------------------------------------------------------------------+++data GetRequestItem = GetRequestItem{+         griProjExpr :: Maybe T.Text+       , griConsistent ::Bool+       , griKeys :: [PrimaryKey]  +     } deriving (Eq,Show,Read,Ord)++data BatchGetItem = BatchGetItem {+      bgRequests :: [(T.Text,GetRequestItem)]+    -- ^ Get Requests for a specified table+    , bgRetCons :: ReturnConsumption+    } deriving (Eq,Show,Read,Ord)++-------------------------------------------------------------------------------++-- | Construct a RequestItem .+batchGetRequestItem :: Maybe T.Text+               -- ^ Projection Expression+               -> Bool+               -- ^ Consistent Read+               -> [PrimaryKey]+               -- ^ Items to be deleted+               -> GetRequestItem+batchGetRequestItem expr consistent keys = GetRequestItem expr consistent keys++toBatchGet :: [GetItem] -> BatchGetItem+toBatchGet gs = BatchGetItem (convert gs) def++  where+    groupItems :: [GetItem]-> HM.HashMap T.Text [GetItem] -> HM.HashMap T.Text [GetItem]+    groupItems [] hm = hm+    groupItems (x:xs) hm = let key = giTableName x+                             in groupItems xs (HM.insert key (x : (HM.lookupDefault [] key hm)) hm)+    +    convert :: [GetItem] -> [(T.Text,GetRequestItem)] +    convert gs' = let l = HM.toList $ groupItems gs' HM.empty+                    -- Uses one GetItem to specify ProjectionExpression+                    -- and ConsistentRead for the entire batch+                    in map (\(table,items@(i:_)) ->(table,GetRequestItem +                                                    (T.intercalate "," <$> giAttrs i)+                                                    (giConsistent i)+                                                    (map giKey items)) ) l++-- | Construct a BatchGetItem+batchGetItem :: [(T.Text, GetRequestItem)]+               -> BatchGetItem+batchGetItem reqs = BatchGetItem reqs def+++instance ToJSON GetRequestItem where+   toJSON GetRequestItem{..} =+       (object $ maybe [] (return . ("ProjectionExpression" .=)) griProjExpr +++                 ["ConsistentRead" .= griConsistent+                 , "Keys" .= griKeys])+         ++instance ToJSON BatchGetItem where+    toJSON BatchGetItem{..} =+        object $+          [ "RequestItems" .= HM.fromList bgRequests+          , "ReturnConsumedCapacity" .= bgRetCons+          ]++instance FromJSON GetRequestItem where+    parseJSON (Object p) = do+                 GetRequestItem <$> p .:? "ProjectionExpression"+                                <*> p .: "ConsistentRead"+                                <*> p .: "Keys"+    parseJSON _ = fail "unable to parse GetRequestItem"+    +         +data BatchGetItemResponse = BatchGetItemResponse {+      bgResponses :: [(T.Text, [Item])]+    , bgUnprocessed    :: Maybe [(T.Text,GetRequestItem)]+    -- ^ Unprocessed Requests on failure+    , bgConsumed :: Maybe ConsumedCapacity+    -- ^ Amount of capacity consumed+    } deriving (Eq,Show,Read,Ord)++++instance Transaction BatchGetItem BatchGetItemResponse+++instance SignQuery BatchGetItem where+    type ServiceConfiguration BatchGetItem = DdbConfiguration+    signQuery gi = ddbSignQuery "BatchGetItem" gi+++instance FromJSON BatchGetItemResponse where+    parseJSON (Object v) = BatchGetItemResponse+        <$> (HM.toList <$> (v .: "Responses"))+        <*> v .:? "UnprocessedItems"+        <*> v .:? "ConsumedCapacity"++    parseJSON _ = fail "BatchGetItemResponse must be an object."++instance ResponseConsumer r BatchGetItemResponse where+    type ResponseMetadata BatchGetItemResponse = DdbResponse+    responseConsumer _ _ ref resp = ddbResponseConsumer ref resp++instance AsMemoryResponse BatchGetItemResponse where+    type MemoryResponse BatchGetItemResponse = BatchGetItemResponse+    loadToMemory = return++

@@ -0,0 +1,137 @@+{-# LANGUAGE DeriveDataTypeable        #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE RecordWildCards           #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeFamilies              #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Aws.DynamoDb.Commands.BatchWriteItem+-- Copyright   :  Soostone Inc+-- License     :  BSD3+--+-- Maintainer  :  Justin Dawson <jtdawso@gmail.com>+-- Stability   :  experimental+--+-- @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_BatchWriteItem.html@+----------------------------------------------------------------------------++module Aws.DynamoDb.Commands.BatchWriteItem where++-------------------------------------------------------------------------------+import           Control.Applicative+import           Data.Aeson+import           Data.Default+import           Data.Foldable (asum)+import qualified Data.HashMap.Strict as HM+import qualified Data.Text           as T+import           Prelude+-------------------------------------------------------------------------------+import           Aws.Core+import           Aws.DynamoDb.Core+import           Aws.DynamoDb.Commands.PutItem+import           Aws.DynamoDb.Commands.DeleteItem+-------------------------------------------------------------------------------+++data Request = PutRequest { prItem :: Item }+             | DeleteRequest {drKey :: PrimaryKey}+     deriving (Eq,Show,Read,Ord)++data BatchWriteItem = BatchWriteItem {+      bwRequests :: [(T.Text,[Request])]+    -- ^ Put or Delete Requests for a specified table+    , bwRetCons :: ReturnConsumption+    , bwRetMet  :: ReturnItemCollectionMetrics+    } deriving (Eq,Show,Read,Ord)+++-------------------------------------------------------------------------------++toBatchWrite :: [PutItem]+           -> [DeleteItem]+           -> BatchWriteItem+toBatchWrite ps ds =BatchWriteItem maps def def  +      where+        maps :: [(T.Text,[Request])]+        maps = let pMap = foldl (\acc p -> let key = piTable p+                                             in HM.insert key (PutRequest (piItem p) : (HM.lookupDefault [] key acc)) acc) HM.empty ps +                   totalMap = foldl (\acc d -> let key = diTable d+                                                 in  HM.insert key (DeleteRequest (diKey d) : (HM.lookupDefault [] key acc)) acc) pMap ds+                 in  HM.toList totalMap+-- | Construct a BatchWriteItem+batchWriteItem :: [(T.Text,[Request])]+               -> BatchWriteItem+batchWriteItem reqs = BatchWriteItem reqs def def+++instance ToJSON Request where+   toJSON PutRequest{..} =+       object $+         [ "PutRequest" .= (object $ ["Item" .= prItem])+         ]+   toJSON DeleteRequest{..} =+       object $+         [ "DeleteRequest" .=  (object $ ["Key" .= drKey])+         ]++instance ToJSON BatchWriteItem where+    toJSON BatchWriteItem{..} =+        object $+          [ "RequestItems" .= HM.fromList bwRequests+          , "ReturnConsumedCapacity" .= bwRetCons+          , "ReturnItemCollectionMetrics" .= bwRetMet+          ]++instance FromJSON Request where+    parseJSON = withObject "PutRequest or DeleteRequest" $ \o ->+     +     asum [+           do+             pr <- o .: "PutRequest"+             i  <- pr .: "Item"+             return $ PutRequest i ,+           do+             dr <- o .: "DeleteRequest"+             pk <- dr .: "Key"+             return $ DeleteRequest pk+          ]+    +data BatchWriteItemResponse = BatchWriteItemResponse {+      bwUnprocessed    :: [(T.Text,[Request])]+    -- ^ Unprocessed Requests on failure+    , bwConsumed :: Maybe ConsumedCapacity+    -- ^ Amount of capacity consumed+    , bwColMet   :: Maybe ItemCollectionMetrics+    -- ^ Collection metrics for tables affected by BatchWriteItem.+    } deriving (Eq,Show,Read,Ord)++++instance Transaction BatchWriteItem BatchWriteItemResponse+++instance SignQuery BatchWriteItem where+    type ServiceConfiguration BatchWriteItem = DdbConfiguration+    signQuery gi = ddbSignQuery "BatchWriteItem" gi+++instance FromJSON BatchWriteItemResponse where+    parseJSON (Object v) = BatchWriteItemResponse+        <$> HM.toList <$> (v .: "UnprocessedItems")+        <*> v .:? "ConsumedCapacity"+        <*> v .:? "ItemCollectionMetrics"+    parseJSON _ = fail "BatchWriteItemResponse must be an object."+++instance ResponseConsumer r BatchWriteItemResponse where+    type ResponseMetadata BatchWriteItemResponse = DdbResponse+    responseConsumer _ _ ref resp = ddbResponseConsumer ref resp+++instance AsMemoryResponse BatchWriteItemResponse where+    type MemoryResponse BatchWriteItemResponse = BatchWriteItemResponse+    loadToMemory = return

@@ -38,6 +38,7 @@ import qualified Data.Aeson.Types      as A import           Data.Char             (toUpper) import qualified Data.HashMap.Strict   as M+import           Data.Scientific       (Scientific) import qualified Data.Text             as T import           Data.Time import           Data.Time.Clock.POSIX@@ -63,6 +64,10 @@ dropOpt d = A.defaultOptions { A.fieldLabelModifier = drop d }  +convertToUTCTime :: Scientific -> UTCTime+convertToUTCTime = posixSecondsToUTCTime . fromInteger . round++ -- | The type of a key attribute that appears in the table key or as a -- key in one of the indices. data AttributeType = AttrString | AttrNumber | AttrBinary@@ -211,8 +216,8 @@ 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)+            <$> (convertToUTCTime <$> o .:? "LastDecreaseDateTime" .!= 0)+            <*> (convertToUTCTime <$> o .:? "LastIncreaseDateTime" .!= 0)             <*> o .:? "NumberOfDecreasesToday" .!= 0             <*> o .: "ReadCapacityUnits"             <*> o .: "WriteCapacityUnits"@@ -283,7 +288,7 @@         TableDescription <$> t .: "TableName"                          <*> t .: "TableSizeBytes"                          <*> t .: "TableStatus"-                         <*> (fmap (posixSecondsToUTCTime . fromInteger) <$> t .:? "CreationDateTime")+                         <*> (fmap convertToUTCTime <$> t .:? "CreationDateTime")                          <*> t .: "ItemCount"                          <*> t .:? "AttributeDefinitions" .!= []                          <*> t .:? "KeySchema"

@@ -532,6 +532,15 @@           Object p2 = toJSON r       in Object (p1 `HM.union` p2) +instance FromJSON PrimaryKey where+    parseJSON p = do+       l <- listPKey p+       case length l of+          1 -> return $ head l +          _ -> fail "Unable to parse PrimaryKey"     +      where listPKey p'= map (\(txt,dval)-> hk txt dval)+                          . HM.toList <$> parseJSON p'+  -- | A key-value pair data Attribute = Attribute {

@@ -133,9 +133,9 @@ userMessageAttributesQuery = concat . zipWith msgAttrQuery [1 :: Int ..]   where     msgAttrQuery i (name, value) =-        [ ( pre <> ".Name", Just $ TE.encodeUtf8 name )-        , ( pre <> ".Value.DataType", Just typ )-        , ( pre <> ".Value." <> valueKey, Just encodedValue )+        [ ( pre <> "Name", Just $ TE.encodeUtf8 name )+        , ( pre <> "Value.DataType", Just typ )+        , ( pre <> "Value." <> valueKey, Just encodedValue )         ]       where         pre = "MessageAttribute." <> B.pack (show i) <> "."@@ -488,22 +488,22 @@     -> Response SqsMetadata UserMessageAttributeValue readUserMessageAttributeValue cursor = do     typStr <- force "Missing DataType"-        $ cursor $/ Cu.laxElement "DataType" &/ Cu.content+        $ cursor $// Cu.laxElement "DataType" &/ Cu.content     case parseType typStr of         ("String", c) -> do             val <- force "Missing StringValue"-                $ cursor $/ Cu.laxElement "StringValue" &/ Cu.content+                $ cursor $// Cu.laxElement "StringValue" &/ Cu.content             return $ UserMessageAttributeString c val          ("Number", c) -> do             valStr <- force "Missing StringValue"-                $ cursor $/ Cu.laxElement "StringValue" &/ Cu.content+                $ cursor $// Cu.laxElement "StringValue" &/ Cu.content             val <- tryXml . readEither $ T.unpack valStr             return $ UserMessageAttributeNumber c val          ("Binary", c) -> do-            val64 <- force "Missing StringValue"-                $ cursor $/ Cu.laxElement "StringValue" &/ Cu.content+            val64 <- force "Missing BinaryValue"+                $ cursor $// Cu.laxElement "BinaryValue" &/ Cu.content             val <- tryXml . B64.decode $ TE.encodeUtf8 val64             return $ UserMessageAttributeBinary c val 

@@ -1,3 +1,11 @@+0.17 series+-----------++-   0.17+    -   HTTP proxy support+    -   DDB: Support for additional interfaces, bug fixes+    -   Relax version bounds+ 0.16 series ----------- 

@@ -1,5 +1,5 @@ Name:                aws-Version:             0.16+Version:             0.17 Synopsis:            Amazon Web Services (AWS) for Haskell Description:         Bindings for Amazon Web Services (AWS), with the aim of supporting all AWS services. To see a high level overview of the library, see the README at <https://github.com/aristidb/aws/blob/master/README.md>. Homepage:            http://github.com/aristidb/aws@@ -19,7 +19,7 @@ Source-repository this   type: git   location: https://github.com/aristidb/aws.git-  tag: 0.16+  tag: 0.17  Source-repository head   type: git@@ -36,6 +36,8 @@                        Aws.Core                        Aws.DynamoDb                        Aws.DynamoDb.Commands+                       Aws.DynamoDb.Commands.BatchGetItem+                       Aws.DynamoDb.Commands.BatchWriteItem                        Aws.DynamoDb.Commands.DeleteItem                        Aws.DynamoDb.Commands.GetItem                        Aws.DynamoDb.Commands.PutItem@@ -140,12 +142,12 @@                        scientific           >= 0.3,                        tagged               >= 0.7     && < 0.9,                        text                 >= 0.11,-                       time                 >= 1.4.0   && < 1.7,+                       time                 >= 1.4.0   && < 2.0,                        transformers         >= 0.2.2   && < 0.6,                        unordered-containers >= 0.2,                        utf8-string          >= 0.3     && < 1.1,                        vector               >= 0.10,-                       xml-conduit          >= 1.2     && <1.5+                       xml-conduit          >= 1.2     && <2.0     if !impl(ghc >= 7.6)     Build-depends: ghc-prim@@ -345,7 +347,7 @@         base == 4.*,         bytestring >= 0.10,         errors >= 2.0,-        http-client >= 0.3 && < 0.5,+        http-client >= 0.3 && < 0.6,         lifted-base >= 0.2,         monad-control >= 0.3,         mtl >= 2.1,@@ -407,7 +409,7 @@         base == 4.*,         bytestring,         conduit-combinators,-        http-client < 0.5,+        http-client < 0.6,         http-client-tls < 0.5,         http-types,         resourcet,

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                        #-} {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-}@@ -30,6 +31,10 @@ import           Network.HTTP.Client          (HttpException (..),                                                RequestBody (..), newManager,                                                responseBody)+#if MIN_VERSION_http_client(0, 5, 0)+import           Network.HTTP.Client          (HttpExceptionContent (..),+                                               responseStatus)+#endif import           Network.HTTP.Client.TLS      (tlsManagerSettings) import           Network.HTTP.Types.Status import           System.Environment@@ -271,7 +276,13 @@     Right _ -> assertFailure ("Expected error with status " <> show expectedStatus <> ", but got success.")     Left _ -> return ()   where+#if MIN_VERSION_http_client(0, 5, 0)+    selector (HttpExceptionRequest _ (StatusCodeException res _))+      | statusCode (responseStatus res) == expectedStatus = Just ()+    selector _ = Nothing+#else     selector (StatusCodeException s _ _)       | statusCode s == expectedStatus = Just ()       | otherwise = Nothing     selector  _ = Nothing+#endif