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 +8/−0
- Aws/S3/Commands.hs +4/−0
- Aws/S3/Commands/DeleteObjectVersion.hs +52/−0
- Aws/S3/Commands/GetBucketObjectVersions.hs +125/−0
- Aws/S3/Commands/Multipart.hs +14/−15
- Aws/S3/Core.hs +62/−0
- CHANGELOG.md +12/−0
- aws.cabal +5/−2
- tests/S3/Main.hs +84/−2
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)))