packages feed

aws 0.15.1 → 0.16

raw patch · 9 files changed

+366/−19 lines, 9 filesdep +conduit-combinatorsdep ~xml-conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: conduit-combinators

Dependency ranges changed: xml-conduit

API changes (from Hackage documentation)

- Aws.S3.Commands.Multipart: [cmuVersionId] :: CompleteMultipartUpload -> Maybe Text
- Aws.S3.Commands.Multipart: [uprVersionId] :: UploadPartResponse -> !(Maybe Text)
+ Aws.Core: textReadBool :: MonadThrow m => Text -> m Bool
+ Aws.S3.Commands.DeleteObjectVersion: DeleteObjectVersion :: Text -> Bucket -> Text -> DeleteObjectVersion
+ Aws.S3.Commands.DeleteObjectVersion: DeleteObjectVersionResponse :: DeleteObjectVersionResponse
+ Aws.S3.Commands.DeleteObjectVersion: [dovBucket] :: DeleteObjectVersion -> Bucket
+ Aws.S3.Commands.DeleteObjectVersion: [dovObjectName] :: DeleteObjectVersion -> Text
+ Aws.S3.Commands.DeleteObjectVersion: [dovVersionId] :: DeleteObjectVersion -> Text
+ Aws.S3.Commands.DeleteObjectVersion: data DeleteObjectVersion
+ Aws.S3.Commands.DeleteObjectVersion: data DeleteObjectVersionResponse
+ Aws.S3.Commands.DeleteObjectVersion: deleteObjectVersion :: Bucket -> Text -> Text -> DeleteObjectVersion
+ Aws.S3.Commands.DeleteObjectVersion: instance Aws.Core.AsMemoryResponse Aws.S3.Commands.DeleteObjectVersion.DeleteObjectVersionResponse
+ Aws.S3.Commands.DeleteObjectVersion: instance Aws.Core.ResponseConsumer Aws.S3.Commands.DeleteObjectVersion.DeleteObjectVersion Aws.S3.Commands.DeleteObjectVersion.DeleteObjectVersionResponse
+ Aws.S3.Commands.DeleteObjectVersion: instance Aws.Core.SignQuery Aws.S3.Commands.DeleteObjectVersion.DeleteObjectVersion
+ Aws.S3.Commands.DeleteObjectVersion: instance Aws.Core.Transaction Aws.S3.Commands.DeleteObjectVersion.DeleteObjectVersion Aws.S3.Commands.DeleteObjectVersion.DeleteObjectVersionResponse
+ Aws.S3.Commands.GetBucketObjectVersions: GetBucketObjectVersions :: Bucket -> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Text -> Maybe Text -> GetBucketObjectVersions
+ Aws.S3.Commands.GetBucketObjectVersions: GetBucketObjectVersionsResponse :: Bucket -> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Text -> Maybe Text -> [ObjectVersionInfo] -> [Text] -> Bool -> Maybe Text -> Maybe Text -> GetBucketObjectVersionsResponse
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovBucket] :: GetBucketObjectVersions -> Bucket
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovDelimiter] :: GetBucketObjectVersions -> Maybe Text
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovKeyMarker] :: GetBucketObjectVersions -> Maybe Text
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovMaxKeys] :: GetBucketObjectVersions -> Maybe Int
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovPrefix] :: GetBucketObjectVersions -> Maybe Text
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovVersionIdMarker] :: GetBucketObjectVersions -> Maybe Text
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrCommonPrefixes] :: GetBucketObjectVersionsResponse -> [Text]
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrContents] :: GetBucketObjectVersionsResponse -> [ObjectVersionInfo]
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrDelimiter] :: GetBucketObjectVersionsResponse -> Maybe Text
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrIsTruncated] :: GetBucketObjectVersionsResponse -> Bool
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrKeyMarker] :: GetBucketObjectVersionsResponse -> Maybe Text
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrMaxKeys] :: GetBucketObjectVersionsResponse -> Maybe Int
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrName] :: GetBucketObjectVersionsResponse -> Bucket
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrNextKeyMarker] :: GetBucketObjectVersionsResponse -> Maybe Text
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrNextVersionIdMarker] :: GetBucketObjectVersionsResponse -> Maybe Text
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrPrefix] :: GetBucketObjectVersionsResponse -> Maybe Text
+ Aws.S3.Commands.GetBucketObjectVersions: [gbovrVersionIdMarker] :: GetBucketObjectVersionsResponse -> Maybe Text
+ Aws.S3.Commands.GetBucketObjectVersions: data GetBucketObjectVersions
+ Aws.S3.Commands.GetBucketObjectVersions: data GetBucketObjectVersionsResponse
+ Aws.S3.Commands.GetBucketObjectVersions: getBucketObjectVersions :: Bucket -> GetBucketObjectVersions
+ Aws.S3.Commands.GetBucketObjectVersions: instance Aws.Core.AsMemoryResponse Aws.S3.Commands.GetBucketObjectVersions.GetBucketObjectVersionsResponse
+ Aws.S3.Commands.GetBucketObjectVersions: instance Aws.Core.IteratedTransaction Aws.S3.Commands.GetBucketObjectVersions.GetBucketObjectVersions Aws.S3.Commands.GetBucketObjectVersions.GetBucketObjectVersionsResponse
+ Aws.S3.Commands.GetBucketObjectVersions: instance Aws.Core.ListResponse Aws.S3.Commands.GetBucketObjectVersions.GetBucketObjectVersionsResponse Aws.S3.Core.ObjectVersionInfo
+ Aws.S3.Commands.GetBucketObjectVersions: instance Aws.Core.ResponseConsumer r Aws.S3.Commands.GetBucketObjectVersions.GetBucketObjectVersionsResponse
+ Aws.S3.Commands.GetBucketObjectVersions: instance Aws.Core.SignQuery Aws.S3.Commands.GetBucketObjectVersions.GetBucketObjectVersions
+ Aws.S3.Commands.GetBucketObjectVersions: instance Aws.Core.Transaction Aws.S3.Commands.GetBucketObjectVersions.GetBucketObjectVersions Aws.S3.Commands.GetBucketObjectVersions.GetBucketObjectVersionsResponse
+ Aws.S3.Commands.GetBucketObjectVersions: instance GHC.Show.Show Aws.S3.Commands.GetBucketObjectVersions.GetBucketObjectVersions
+ Aws.S3.Commands.GetBucketObjectVersions: instance GHC.Show.Show Aws.S3.Commands.GetBucketObjectVersions.GetBucketObjectVersionsResponse
+ Aws.S3.Commands.Multipart: [cmurVersionId] :: CompleteMultipartUploadResponse -> !(Maybe Text)
+ Aws.S3.Core: DeleteMarker :: Text -> Text -> Bool -> UTCTime -> Maybe UserInfo -> ObjectVersionInfo
+ Aws.S3.Core: ObjectVersion :: Text -> Text -> Bool -> UTCTime -> Text -> Integer -> StorageClass -> Maybe UserInfo -> ObjectVersionInfo
+ Aws.S3.Core: [oviETag] :: ObjectVersionInfo -> Text
+ Aws.S3.Core: [oviIsLatest] :: ObjectVersionInfo -> Bool
+ Aws.S3.Core: [oviKey] :: ObjectVersionInfo -> Text
+ Aws.S3.Core: [oviLastModified] :: ObjectVersionInfo -> UTCTime
+ Aws.S3.Core: [oviOwner] :: ObjectVersionInfo -> Maybe UserInfo
+ Aws.S3.Core: [oviSize] :: ObjectVersionInfo -> Integer
+ Aws.S3.Core: [oviStorageClass] :: ObjectVersionInfo -> StorageClass
+ Aws.S3.Core: [oviVersionId] :: ObjectVersionInfo -> Text
+ Aws.S3.Core: data ObjectVersionInfo
+ Aws.S3.Core: instance GHC.Show.Show Aws.S3.Core.ObjectVersionInfo
+ Aws.S3.Core: parseObjectVersionInfo :: MonadThrow m => Cursor -> m ObjectVersionInfo
- Aws.S3.Commands.Multipart: CompleteMultipartUpload :: Bucket -> Object -> Text -> [(Integer, Text)] -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> CompleteMultipartUpload
+ Aws.S3.Commands.Multipart: CompleteMultipartUpload :: Bucket -> Object -> Text -> [(Integer, Text)] -> Maybe Text -> Maybe Text -> Maybe Text -> CompleteMultipartUpload
- Aws.S3.Commands.Multipart: CompleteMultipartUploadResponse :: !Text -> !Bucket -> !Text -> !Text -> CompleteMultipartUploadResponse
+ Aws.S3.Commands.Multipart: CompleteMultipartUploadResponse :: !Text -> !Bucket -> !Text -> !Text -> !(Maybe Text) -> CompleteMultipartUploadResponse
- Aws.S3.Commands.Multipart: UploadPartResponse :: !(Maybe Text) -> !Text -> UploadPartResponse
+ Aws.S3.Commands.Multipart: UploadPartResponse :: !Text -> UploadPartResponse
- Aws.S3.Commands.Multipart: sendEtag :: Configuration -> S3Configuration NormalQuery -> Manager -> Text -> Text -> Text -> [Text] -> IO ()
+ Aws.S3.Commands.Multipart: sendEtag :: Configuration -> S3Configuration NormalQuery -> Manager -> Text -> Text -> Text -> [Text] -> IO CompleteMultipartUploadResponse

Files

Aws/Core.hs view
@@ -30,6 +30,7 @@ , elCont , force , forceM+, textReadBool , textReadInt , readInt , xmlCursorConsumer@@ -833,6 +834,13 @@ -- | Extract the first element from a monadic parser result list, and throw an 'XmlException' if the list is empty. forceM :: MonadThrow m => String -> [m a] -> m a forceM = Cu.forceM . XmlException++-- | Read a boolean from a 'T.Text', throwing an 'XmlException' on failure.+textReadBool :: MonadThrow m => T.Text -> m Bool+textReadBool s = case T.unpack s of+                  "true"  -> return True+                  "false" -> return False+                  _        -> throwM $ XmlException "Invalid Bool"  -- | Read an integer from a 'T.Text', throwing an 'XmlException' on failure. textReadInt :: (MonadThrow m, Num a) => T.Text -> m a
Aws/S3/Commands.hs view
@@ -3,9 +3,11 @@   module Aws.S3.Commands.CopyObject , module Aws.S3.Commands.DeleteBucket , module Aws.S3.Commands.DeleteObject+, module Aws.S3.Commands.DeleteObjectVersion , module Aws.S3.Commands.DeleteObjects , module Aws.S3.Commands.GetBucket , module Aws.S3.Commands.GetBucketLocation+, module Aws.S3.Commands.GetBucketObjectVersions , module Aws.S3.Commands.GetObject , module Aws.S3.Commands.GetService , module Aws.S3.Commands.HeadObject@@ -18,9 +20,11 @@ import Aws.S3.Commands.CopyObject import Aws.S3.Commands.DeleteBucket import Aws.S3.Commands.DeleteObject+import Aws.S3.Commands.DeleteObjectVersion import Aws.S3.Commands.DeleteObjects import Aws.S3.Commands.GetBucket import Aws.S3.Commands.GetBucketLocation+import Aws.S3.Commands.GetBucketObjectVersions import Aws.S3.Commands.GetObject import Aws.S3.Commands.GetService import Aws.S3.Commands.HeadObject
+ Aws/S3/Commands/DeleteObjectVersion.hs view
@@ -0,0 +1,52 @@+module Aws.S3.Commands.DeleteObjectVersion+where++import           Aws.Core+import           Aws.S3.Core+import           Data.ByteString.Char8      ({- IsString -})+import qualified Data.Text                  as T+import qualified Data.Text.Encoding         as T++data DeleteObjectVersion = DeleteObjectVersion {+  dovObjectName :: T.Text,+  dovBucket :: Bucket,+  dovVersionId :: T.Text+}++deleteObjectVersion :: Bucket -> T.Text -> T.Text -> DeleteObjectVersion+deleteObjectVersion bucket object version+    = DeleteObjectVersion {+          dovObjectName = object+        , dovBucket = bucket+        , dovVersionId = version+        }++data DeleteObjectVersionResponse = DeleteObjectVersionResponse {+}++-- | ServiceConfiguration: 'S3Configuration'+instance SignQuery DeleteObjectVersion where+    type ServiceConfiguration DeleteObjectVersion = S3Configuration+    signQuery DeleteObjectVersion {..} = s3SignQuery S3Query {+                                 s3QMethod = Delete+                               , s3QBucket = Just $ T.encodeUtf8 dovBucket+                               , s3QSubresources = [ ("versionId", Just $ T.encodeUtf8 dovVersionId) ]+                               , s3QQuery = []+                               , s3QContentType = Nothing+                               , s3QContentMd5 = Nothing+                               , s3QAmzHeaders = []+                               , s3QOtherHeaders = []+                               , s3QRequestBody = Nothing+                               , s3QObject = Just $ T.encodeUtf8 dovObjectName+                               }++instance ResponseConsumer DeleteObjectVersion DeleteObjectVersionResponse where+    type ResponseMetadata DeleteObjectVersionResponse = S3Metadata+    responseConsumer _ _+        = s3ResponseConsumer $ \_ -> return DeleteObjectVersionResponse++instance Transaction DeleteObjectVersion DeleteObjectVersionResponse++instance AsMemoryResponse DeleteObjectVersionResponse where+    type MemoryResponse DeleteObjectVersionResponse = DeleteObjectVersionResponse+    loadToMemory = return
+ Aws/S3/Commands/GetBucketObjectVersions.hs view
@@ -0,0 +1,125 @@+module Aws.S3.Commands.GetBucketObjectVersions+where++import           Aws.Core+import           Aws.S3.Core+import           Control.Applicative+import           Data.ByteString.Char8 ({- IsString -})+import           Data.Maybe+import           Text.XML.Cursor       (($/), (&|), (&//))+import qualified Data.ByteString.Char8 as B8+import qualified Data.Text             as T+import qualified Data.Text.Encoding    as T+import qualified Data.Traversable+import           Prelude+import qualified Network.HTTP.Types    as HTTP+import qualified Text.XML.Cursor       as Cu+import qualified Text.XML              as XML++data GetBucketObjectVersions+    = GetBucketObjectVersions {+        gbovBucket          :: Bucket+      , gbovDelimiter       :: Maybe T.Text+      , gbovKeyMarker       :: Maybe T.Text+      , gbovMaxKeys         :: Maybe Int+      , gbovPrefix          :: Maybe T.Text+      , gbovVersionIdMarker :: Maybe T.Text+      }+    deriving (Show)++getBucketObjectVersions :: Bucket -> GetBucketObjectVersions+getBucketObjectVersions bucket+    = GetBucketObjectVersions {+        gbovBucket          = bucket+      , gbovDelimiter       = Nothing+      , gbovKeyMarker       = Nothing+      , gbovMaxKeys         = Nothing+      , gbovPrefix          = Nothing+      , gbovVersionIdMarker = Nothing+      }++data GetBucketObjectVersionsResponse+    = GetBucketObjectVersionsResponse {+        gbovrName                :: Bucket+      , gbovrDelimiter           :: Maybe T.Text+      , gbovrKeyMarker           :: Maybe T.Text+      , gbovrMaxKeys             :: Maybe Int+      , gbovrPrefix              :: Maybe T.Text+      , gbovrVersionIdMarker     :: Maybe T.Text+      , gbovrContents            :: [ObjectVersionInfo]+      , gbovrCommonPrefixes      :: [T.Text]+      , gbovrIsTruncated         :: Bool+      , gbovrNextKeyMarker       :: Maybe T.Text+      , gbovrNextVersionIdMarker :: Maybe T.Text+      }+    deriving (Show)++-- | ServiceConfiguration: 'S3Configuration'+instance SignQuery GetBucketObjectVersions where+    type ServiceConfiguration GetBucketObjectVersions = S3Configuration+    signQuery GetBucketObjectVersions {..} = s3SignQuery S3Query {+                                 s3QMethod = Get+                               , s3QBucket = Just $ T.encodeUtf8 gbovBucket+                               , s3QObject = Nothing+                               , s3QSubresources = [ ("versions", Nothing) ]+                               , s3QQuery = HTTP.toQuery [+                                              ("delimiter" :: B8.ByteString ,) <$> gbovDelimiter+                                            , ("key-marker",) <$> gbovKeyMarker+                                            , ("max-keys",) . T.pack . show <$> gbovMaxKeys+                                            , ("prefix",) <$> gbovPrefix+                                            , ("version-id-marker",) <$> gbovVersionIdMarker+                                            ]+                               , s3QContentType = Nothing+                               , s3QContentMd5 = Nothing+                               , s3QAmzHeaders = []+                               , s3QOtherHeaders = []+                               , s3QRequestBody = Nothing+                               }++instance ResponseConsumer r GetBucketObjectVersionsResponse where+    type ResponseMetadata GetBucketObjectVersionsResponse = S3Metadata++    responseConsumer _ _ = s3XmlResponseConsumer parse+        where parse cursor+                  = do name <- force "Missing Name" $ cursor $/ elContent "Name"+                       let delimiter = listToMaybe $ cursor $/ elContent "Delimiter"+                       let keyMarker = listToMaybe $ cursor $/ elContent "KeyMarker"+                       let versionMarker = listToMaybe $ cursor $/ elContent "VersionIdMarker"+                       maxKeys <- Data.Traversable.sequence . listToMaybe $ cursor $/ elContent "MaxKeys" &| textReadInt+                       let truncated = maybe True (/= "false") $ listToMaybe $ cursor $/ elContent "IsTruncated"+                       let nextKeyMarker = listToMaybe $ cursor $/ elContent "NextKeyMarker"+                       let nextVersionMarker = listToMaybe $ cursor $/ elContent "NextVersionIdMarker"+                       let prefix = listToMaybe $ cursor $/ elContent "Prefix"+                       contents <- sequence $ cursor $/ Cu.checkName objectNodeName &| parseObjectVersionInfo+                       let commonPrefixes = cursor $/ Cu.laxElement "CommonPrefixes" &// Cu.content+                       return GetBucketObjectVersionsResponse{+                                                gbovrName                = name+                                              , gbovrDelimiter           = delimiter+                                              , gbovrKeyMarker           = keyMarker+                                              , gbovrMaxKeys             = maxKeys+                                              , gbovrPrefix              = prefix+                                              , gbovrVersionIdMarker     = versionMarker+                                              , gbovrContents            = contents+                                              , gbovrCommonPrefixes      = commonPrefixes+                                              , gbovrIsTruncated         = truncated+                                              , gbovrNextKeyMarker       = nextKeyMarker+                                              , gbovrNextVersionIdMarker = nextVersionMarker+                                              }+              objectNodeName n = let fn = T.toCaseFold $ XML.nameLocalName n+                                  in fn == T.toCaseFold "Version" || fn == T.toCaseFold "DeleteMarker"++instance Transaction GetBucketObjectVersions GetBucketObjectVersionsResponse++instance IteratedTransaction GetBucketObjectVersions GetBucketObjectVersionsResponse where+    nextIteratedRequest request response+        = case (gbovrIsTruncated response, gbovrNextKeyMarker response, gbovrNextVersionIdMarker response, gbovrContents response) of+            (True, Just keyMarker, Just versionMarker, _             ) -> Just $ request { gbovKeyMarker = Just keyMarker, gbovVersionIdMarker = Just versionMarker }+            (True, Nothing,        Nothing,            contents@(_:_)) -> Just $ request { gbovKeyMarker = Just $ oviKey $ last contents, gbovVersionIdMarker = Just $ oviVersionId $ last contents }+            (_,    _,              _,                  _             ) -> Nothing++instance ListResponse GetBucketObjectVersionsResponse ObjectVersionInfo where+    listResponse = gbovrContents++instance AsMemoryResponse GetBucketObjectVersionsResponse where+    type MemoryResponse GetBucketObjectVersionsResponse = GetBucketObjectVersionsResponse+    loadToMemory = return
Aws/S3/Commands/Multipart.hs view
@@ -5,6 +5,7 @@ import           Aws.S3.Core import           Control.Applicative import           Control.Arrow         (second)+import           Control.Monad import           Control.Monad.IO.Class import           Control.Monad.Trans.Resource import           Crypto.Hash@@ -141,7 +142,6 @@  data UploadPartResponse   = UploadPartResponse {-      uprVersionId :: !(Maybe T.Text),       uprETag :: !T.Text     }   deriving (Show)@@ -174,9 +174,8 @@ instance ResponseConsumer UploadPart UploadPartResponse where     type ResponseMetadata UploadPartResponse = S3Metadata     responseConsumer _ _ = s3ResponseConsumer $ \resp -> do-      let vid = T.decodeUtf8 `fmap` lookup "x-amz-version-id" (HTTP.responseHeaders resp)       let etag = fromMaybe "" $ T.decodeUtf8 `fmap` lookup "ETag" (HTTP.responseHeaders resp)-      return $ UploadPartResponse vid etag+      return $ UploadPartResponse etag  instance Transaction UploadPart UploadPartResponse @@ -197,12 +196,11 @@     , cmuExpiration :: Maybe T.Text     , cmuServerSideEncryption :: Maybe T.Text     , cmuServerSideEncryptionCustomerAlgorithm :: Maybe T.Text-    , cmuVersionId :: Maybe T.Text     }   deriving (Show)  postCompleteMultipartUpload :: Bucket -> T.Text -> T.Text -> [(Integer,T.Text)]-> CompleteMultipartUpload-postCompleteMultipartUpload b o i p = CompleteMultipartUpload b o i p Nothing  Nothing  Nothing  Nothing+postCompleteMultipartUpload b o i p = CompleteMultipartUpload b o i p Nothing  Nothing  Nothing  data CompleteMultipartUploadResponse   = CompleteMultipartUploadResponse {@@ -210,6 +208,7 @@     , cmurBucket   :: !Bucket     , cmurKey      :: !T.Text     , cmurETag     :: !T.Text+    , cmurVersionId :: !(Maybe T.Text)     }  -- | ServiceConfiguration: 'S3Configuration'@@ -229,7 +228,6 @@                                   , ("x-amz-server-side-encryption",) <$> (T.encodeUtf8 <$> cmuServerSideEncryption)                                   , ("x-amz-server-side-encryption-customer-algorithm",)                                     <$> (T.encodeUtf8 <$> cmuServerSideEncryptionCustomerAlgorithm)-                                  , ("x-amz-version-id",) <$> (T.encodeUtf8 <$> cmuVersionId)                                   ]       , s3QOtherHeaders = []       , s3QRequestBody  = Just $ HTTP.RequestBodyLBS reqBody@@ -260,8 +258,9 @@ instance ResponseConsumer r CompleteMultipartUploadResponse where     type ResponseMetadata CompleteMultipartUploadResponse = S3Metadata -    responseConsumer _ _ = s3XmlResponseConsumer parse-        where parse cursor+    responseConsumer _ _ metadata resp = s3XmlResponseConsumer parse metadata resp+        where vid = T.decodeUtf8 `fmap` lookup "x-amz-version-id" (HTTP.responseHeaders resp)+              parse cursor                   = do location <- force "Missing Location" $ cursor $/ elContent "Location"                        bucket <- force "Missing Bucket Name" $ cursor $/ elContent "Bucket"                        key <- force "Missing Key" $ cursor $/ elContent "Key"@@ -271,6 +270,7 @@                                               , cmurBucket         = bucket                                               , cmurKey            = key                                               , cmurETag           = etag+                                              , cmurVersionId      = vid                                               }  instance Transaction CompleteMultipartUpload CompleteMultipartUploadResponse@@ -357,11 +357,10 @@   -> T.Text   -> T.Text   -> [T.Text]-  -> IO ()+  -> IO CompleteMultipartUploadResponse sendEtag cfg s3cfg mgr bucket object uploadId etags = do-  _ <- memoryAws cfg s3cfg mgr $+  memoryAws cfg s3cfg mgr $        postCompleteMultipartUpload bucket object uploadId (zip [1..] etags)-  return ()  putConduit ::   MonadResource m =>@@ -378,7 +377,7 @@       v' <- await       case v' of         Just v -> do-          UploadPartResponse _ etag <- memoryAws cfg s3cfg mgr $+          UploadPartResponse etag <- memoryAws cfg s3cfg mgr $             uploadPart bucket object n uploadId (HTTP.RequestBodyLBS v)           yield etag           loop (n+1)@@ -416,7 +415,7 @@            $= chunkedConduit chunkSize            $= putConduit cfg s3cfg mgr bucket object uploadId            $$ CL.consume-  liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags+  void $ liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags  multipartUploadSink :: MonadResource m   => Configuration@@ -444,7 +443,7 @@            $= chunkedConduit chunkSize            $= putConduit cfg s3cfg mgr bucket object uploadId            $$ CL.consume-  liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags+  void $ liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags  multipartUploadSinkWithInitiator :: MonadResource m   => Configuration@@ -460,4 +459,4 @@   etags <- chunkedConduit chunkSize            $= putConduit cfg s3cfg mgr bucket object uploadId            $= CL.consume-  liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags+  void $ liftIO $ sendEtag cfg s3cfg mgr bucket object uploadId etags
Aws/S3/Core.hs view
@@ -390,6 +390,68 @@       }     deriving (Show) +data ObjectVersionInfo+    = ObjectVersion {+        oviKey          :: T.Text+      , oviVersionId    :: T.Text+      , oviIsLatest     :: Bool+      , oviLastModified :: UTCTime+      , oviETag         :: T.Text+      , oviSize         :: Integer+      , oviStorageClass :: StorageClass+      , oviOwner        :: Maybe UserInfo+      }+    | DeleteMarker {+        oviKey          :: T.Text+      , oviVersionId    :: T.Text+      , oviIsLatest     :: Bool+      , oviLastModified :: UTCTime+      , oviOwner        :: Maybe UserInfo+      }+    deriving (Show)++parseObjectVersionInfo :: MonadThrow m => Cu.Cursor -> m ObjectVersionInfo+parseObjectVersionInfo el+    = do key <- force "Missing object Key" $ el $/ elContent "Key"+         versionId <- force "Missing object VersionId" $ el $/ elContent "VersionId"+         isLatest <- forceM "Missing object IsLatest" $ el $/ elContent "IsLatest" &| textReadBool+         let time s = case (parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" $ T.unpack s) <|>+                           (parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Q%Z" $ T.unpack s) of+                        Nothing -> throwM $ XmlException "Invalid time"+                        Just v -> return v+         lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time+         owner <- case el $/ Cu.laxElement "Owner" &| parseUserInfo of+                    (x:_) -> fmap' Just x+                    [] -> return Nothing+         case Cu.node el of+           XML.NodeElement e | elName e == "Version" ->+             do eTag <- force "Missing object ETag" $ el $/ elContent "ETag"+                size <- forceM "Missing object Size" $ el $/ elContent "Size" &| textReadInt+                storageClass <- forceM "Missing object StorageClass" $ el $/ elContent "StorageClass" &| return . parseStorageClass+                return ObjectVersion{+                             oviKey          = key+                           , oviVersionId    = versionId+                           , oviIsLatest     = isLatest+                           , oviLastModified = lastModified+                           , oviETag         = eTag+                           , oviSize         = size+                           , oviStorageClass = storageClass+                           , oviOwner        = owner+                           }+           XML.NodeElement e | elName e == "DeleteMarker" ->+             return DeleteMarker{+                             oviKey          = key+                           , oviVersionId    = versionId+                           , oviIsLatest     = isLatest+                           , oviLastModified = lastModified+                           , oviOwner        = owner+                           }+           _ -> throwM $ XmlException "Invalid object version tag"+    where+      elName = XML.nameLocalName . XML.elementName+      fmap' :: Monad m => (a -> b) -> m a -> m b+      fmap' f ma = ma >>= return . f+ data ObjectInfo     = ObjectInfo {         objectKey          :: T.Text
CHANGELOG.md view
@@ -1,3 +1,15 @@+0.16 series+-----------++NOTES: 0.16 brings technically breaking changes, which should not affect+most users. I recommend using smart constructors and {} matching syntax+whenever possible when interacting with aws types.++-   0.16+    -   S3: Add support for versioning+    -   S3: [breaking change] Move version ID from UploadPartResponse to+        CompleteMultipartUpload.+ 0.15 series ----------- 
aws.cabal view
@@ -1,5 +1,5 @@ Name:                aws-Version:             0.15.1+Version:             0.16 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.15.1+  tag: 0.16  Source-repository head   type: git@@ -69,9 +69,11 @@                        Aws.S3.Commands.CopyObject                        Aws.S3.Commands.DeleteBucket                        Aws.S3.Commands.DeleteObject+                       Aws.S3.Commands.DeleteObjectVersion                        Aws.S3.Commands.DeleteObjects                        Aws.S3.Commands.GetBucket                        Aws.S3.Commands.GetBucketLocation+                       Aws.S3.Commands.GetBucketObjectVersions                        Aws.S3.Commands.GetObject                        Aws.S3.Commands.GetService                        Aws.S3.Commands.HeadObject@@ -404,6 +406,7 @@         aws,         base == 4.*,         bytestring,+        conduit-combinators,         http-client < 0.5,         http-client-tls < 0.5,         http-types,
tests/S3/Main.hs view
@@ -15,7 +15,9 @@     ) where  import           Control.Applicative-import Data.ByteString (ByteString)+import qualified Data.ByteString              as BS+import qualified Data.ByteString.Lazy         as BL+import           Conduit import           Control.Arrow                (second) import           Control.Exception import           Control.Monad@@ -26,7 +28,8 @@ import           Data.Typeable import           Data.Proxy import           Network.HTTP.Client          (HttpException (..),-                                               RequestBody (..), newManager)+                                               RequestBody (..), newManager,+                                               responseBody) import           Network.HTTP.Client.TLS      (tlsManagerSettings) import           Network.HTTP.Types.Status import           System.Environment@@ -97,6 +100,7 @@ tests = testGroup "S3 Tests"     [ test_head     , test_get+    , test_versioning     ]  @@ -177,6 +181,84 @@       void (runResourceT (pureAws cfg s3cfg mgr (putObject bucket k (RequestBodyBS content))))       return (cfg, s3cfg, mgr)     teardown (cfg, s3cfg, mgr) =+      void (runResourceT (pureAws cfg s3cfg mgr (DeleteObject k bucket)))+++-------------------------------------------------------------------------------+-- GetBucketObjectVersions Tests+-------------------------------------------------------------------------------+++test_versioning :: TestTree+test_versioning = askOption $ \(BucketOption bucket) ->+  withResource (mkSetup bucket) (teardown bucket) $ \setup -> testGroup "Versioning"+    [ testCase "GetBucketObjectVersions succeeds" $ do+        (cfg, s3cfg, mgr) <- setup+        resp <- runResourceT $ pureAws cfg s3cfg mgr $ (getBucketObjectVersions bucket)+          { gbovPrefix = Just k+          }+        let [o1, o2, o3, o4] = take 4 $ gbovrContents resp+        checkObject True o1+        checkDeleteMarker False o2+        checkObject False o3+        checkObject False o4+    , testCase "DeleteObjectVersion succeeds" $ do+        -- Note: this test requires bucket with versioning enabled+        (cfg, s3cfg, mgr) <- setup+        resp <- runResourceT $ pureAws cfg s3cfg mgr $ (getBucketObjectVersions bucket)+          { gbovPrefix = Just k+          }+        let [v1, v2, v3, v4] = map oviVersionId $ take 4 $ gbovrContents resp+        void (runResourceT (pureAws cfg s3cfg mgr (deleteObjectVersion bucket k v2)))+        void (runResourceT (pureAws cfg s3cfg mgr (deleteObjectVersion bucket k v3)))++        resp' <- runResourceT $ pureAws cfg s3cfg mgr $ (getBucketObjectVersions bucket)+          { gbovPrefix = Just k+          }+        let [v1', v4'] = map oviVersionId $ take 2 $ gbovrContents resp'+        assertEqual "invalid v1 version" v1 v1'+        assertEqual "invalid v4 version" v4 v4'+    , testCase "Multipart upload succeeds" $ do+        -- Note: this test requires bucket with versioning enabled+        (cfg, s3cfg, mgr) <- setup+        resp <- runResourceT $ do+            uploadId <- liftIO $ getUploadId cfg s3cfg mgr bucket k+            etags <- sourceLazy testStr+                $= chunkedConduit 65536+                $= putConduit cfg s3cfg mgr bucket k uploadId+                $$ sinkList+            liftIO $ sendEtag cfg s3cfg mgr bucket k uploadId etags+        let Just vid = cmurVersionId resp+        bs <- runResourceT $ do+            gor <- pureAws cfg s3cfg mgr (getObject bucket k) { goVersionId = Just vid }+            responseBody (gorResponse gor) $$+- sinkLazy++        assertEqual "data do not match" testStr bs+    ]+  where+    testStr = "foobar" :: BL.ByteString+    k = "s3-test-object"+    content = "example"+    payloadMD5 = "1a79a4d60de6718e8e5b326e338ae533"+    checkObject marker obj@ObjectVersion{} = do+        assertEqual "invalid object key" k (oviKey obj)+        assertEqual "invalid isLatest flag" marker (oviIsLatest obj)+        assertEqual "invalid object size" (fromIntegral $ BS.length content) (oviSize obj)+    checkObject _ obj = assertFailure $ "Invalid object type " <> show obj+    checkDeleteMarker marker obj@DeleteMarker{} = do+        assertEqual "invalid object key" k (oviKey obj)+        assertEqual "invalid isLatest flag" marker (oviIsLatest obj)+    checkDeleteMarker _ obj = assertFailure $ "Invalid object type " <> show obj+    mkSetup bucket = do+      cfg <- baseConfiguration+      let s3cfg = defServiceConfig+      mgr <- newManager tlsManagerSettings+      void (runResourceT (pureAws cfg s3cfg mgr (putObject bucket k (RequestBodyBS content))))+      void (runResourceT (pureAws cfg s3cfg mgr (putObject bucket k (RequestBodyBS content))))+      void (runResourceT (pureAws cfg s3cfg mgr (DeleteObject k bucket)))+      void (runResourceT (pureAws cfg s3cfg mgr (putObject bucket k (RequestBodyBS content))))+      return (cfg, s3cfg, mgr)+    teardown bucket (cfg, s3cfg, mgr) =       void (runResourceT (pureAws cfg s3cfg mgr (DeleteObject k bucket)))