hS3 0.5.1 → 0.5.2

raw patch · 6 files changed

+149/−26 lines, 6 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CONTRIBUTORS +3/−0
• Network/AWS/Authentication.hs +8/−2
• Network/AWS/S3Bucket.hs +14/−1
• Network/AWS/S3Object.hs +27/−8
• Tests.hs +94/−12
• hS3.cabal +3/−3

@@ -0,0 +1,3 @@+- <harmen@millionmonkeys.nl>+- Marc Weber <marco-oweber@gmx.de>+- Anton van Straaten <anton@appsolutions.com>

@@ -54,9 +54,9 @@     S3Action {       -- | Connection and authentication information       s3conn :: AWSConnection,-      -- | Name of bucket to act on+      -- | Name of bucket to act on (URL encoded)       s3bucket :: String,-      -- | Name of object to act on+      -- | Name of object to act on (URL encoded)       s3object :: String,       -- | Query parameters (requires a prefix of @?@)       s3query :: String,@@ -267,7 +267,13 @@         let aReq = addAuthenticationHeader a $                    addContentLengthHeader $                    addDateToReq (requestFromAction a) cd+        --print aReq -- Show request header         result <- simpleHTTP_ c aReq+        -- Show result header and body+        -- print result+        --case result of+        --  Left a -> print ""+        --  Right a -> print (rspBody a)         close c         createAWSResult a result 

@@ -14,6 +14,7 @@                createBucketIn, createBucket, createBucketWithPrefixIn,                createBucketWithPrefix, deleteBucket, getBucketLocation,                emptyBucket, listBuckets, listObjects, listAllObjects,+               isBucketNameValid,                -- * Data Types                S3Bucket(S3Bucket, bucket_name, bucket_creation_date),                ListRequest(..),@@ -32,7 +33,8 @@  import qualified Data.ByteString.Lazy.Char8 as L -import Data.Char (toLower)+import Data.Char (toLower, isAlphaNum)+import Data.List (isInfixOf)  import Text.XML.HXT.Arrow import qualified Data.Tree.NTree.TypeDefs@@ -267,6 +269,17 @@                       (text <<< atTag "ETag") &&&                       (text <<< atTag "Size")) >>>                      arr (\(a,(b,(c,d))) -> ListResult a b ((unquote . HTTP.urlDecode) c) (read d))++-- | Check Amazon guidelines on bucket naming.  (missing test for IP-like names)+isBucketNameValid :: String -> Bool+isBucketNameValid n = and checks where+    checks = [(length n >= 3),+              (length n <= 63),+              (isAlphaNum $ head n),+              (not (elem '_' n)),+              (not (isInfixOf ".-" n)),+              (not (isInfixOf "-." n)),+              ((last n) /= '-')]  -- | Remove quote characters from a 'String'. unquote :: String -> String

@@ -11,7 +11,7 @@  module Network.AWS.S3Object (   -- * Function Types-  sendObject, getObject, getObjectInfo, deleteObject,+  sendObject, copyObject, getObject, getObjectInfo, deleteObject,   publicUriForSeconds, publicUriUntilTime,   -- * Data Types   S3Object(..)@@ -51,8 +51,8 @@            -> S3Object           -- ^ Object to add to a bucket            -> IO (AWSResult ())  -- ^ Server response sendObject aws obj =-    do res <- Auth.runAction (S3Action aws (obj_bucket obj)-                              (obj_name obj)+    do res <- Auth.runAction (S3Action aws (urlEncode (obj_bucket obj))+                              (urlEncode (obj_name obj))                               ""                               (("Content-Type", (content_type obj)) :                                obj_headers obj)@@ -67,7 +67,7 @@                              --   00:00:00 UTC on January 1, 1970                   -> URI -- ^ URI for the object publicUriUntilTime c obj time =-    let act = S3Action c (obj_bucket obj) (obj_name obj) "" [] L.empty GET+    let act = S3Action c (urlEncode (obj_bucket obj)) (urlEncode (obj_name obj)) "" [] L.empty GET     in preSignedURI act time  -- | Create a pre-signed request URI.  Anyone can use this to request@@ -99,8 +99,8 @@                     -> S3Object      -- ^ Object to request                     -> IO (AWSResult S3Object) getObjectWithMethod m aws obj =-    do res <- Auth.runAction (S3Action aws (obj_bucket obj)-                                           (obj_name obj)+    do res <- Auth.runAction (S3Action aws (urlEncode (obj_bucket obj))+                                           (urlEncode (obj_name obj))                                            ""                                            (obj_headers obj)                                            L.empty m)@@ -123,11 +123,30 @@ deleteObject :: AWSConnection      -- ^ AWS connection information              -> S3Object           -- ^ Object to delete              -> IO (AWSResult ())  -- ^ Server response-deleteObject aws obj = do res <- Auth.runAction (S3Action aws (obj_bucket obj)-                                                              (obj_name obj)+deleteObject aws obj = do res <- Auth.runAction (S3Action aws (urlEncode (obj_bucket obj))+                                                              (urlEncode (obj_name obj))                                                               ""                                                               (obj_headers obj)                                                               L.empty DELETE)                           return (either Left (\_ -> Right ()) res) +-- | Copy object from one bucket to another (or the same bucket).+copyObject :: AWSConnection            -- ^ AWS connection information+              -> S3Object                 -- ^ Source object+              -> S3Object                 -- ^ Destination object+              -> IO (AWSResult S3Object)  -- ^ Server response+copyObject aws srcobj destobj =+    do res <- Auth.runAction (S3Action aws (urlEncode (obj_bucket destobj))+                                           (urlEncode (obj_name destobj))+                                           ""+                                           (copy_headers)+                                           L.empty PUT)+       return (either Left (\x -> Right (populate_obj_from x)) res)+           where+             populate_obj_from x =+                 destobj { obj_data = (rspBody x),+                           obj_headers = (headersFromResponse x) }+             copy_headers = [("x-amz-copy-source",+                              ("/"++ (urlEncode (obj_bucket srcobj))+                               ++ "/" ++ (urlEncode (obj_name srcobj))))] 

@@ -18,6 +18,8 @@ import Network.AWS.S3Bucket import Data.Maybe (fromJust) import qualified Data.ByteString.Lazy.Char8 as L+import Control.Exception(finally)+import IO(bracket)  import Test.HUnit @@ -25,9 +27,15 @@ main = runTestTT tests  tests =-   TestList [s3operationsTest]+    TestList+    [+     TestLabel "S3 Operations Test" s3OperationsTest,+     TestLabel "S3 Copy Test" s3CopyTest,+     TestLabel "S3 Location Test" s3LocationTest,+     TestLabel "Bucket Naming Test" bucketNamingTest+    ] -testBucket = "hS3-test"+testBucket = "hs3-test"  testObjectTemplate = S3Object testBucket "hS3-object-test" "text/plain"                      [("x-amz-meta-foo", "bar"),@@ -35,9 +43,12 @@                       ("x-amz-meta-smiley", "☺")                       ] (L.pack "Hello S3!") +testSourceTemplate = S3Object testBucket "hS3-object-source" "text/plain"+                         [] (L.pack "testing")+testDestinationTemplate = testSourceTemplate {obj_name = "hS3-object-destination"}  -- | A sequence of several operations.-s3operationsTest =+s3OperationsTest =     TestCase (               do c <- getConn                  -- Bucket Creation@@ -63,17 +74,74 @@                  testDeleteBucket c bucket                  -- Bucket should be gone                  testBucketGone c bucket+             ) -                 -- Bucket in europe-                 euBucket <- testCreateBucketIn c "EU"-                 testGetBucketLocation c euBucket "EU"-                 let euTestObj = testObjectTemplate {obj_bucket = euBucket}-                 testSendObject c euTestObj-                 testGetObject c euTestObj-                 testDeleteObject c euTestObj-                 testDeleteBucket c euBucket+s3LocationTest =+    TestCase (+              do c <- getConn+                 -- European buckets+                 bracket (testCreateBucketIn c "EU")+                             (\b ->+                                  do testEmptyBucket c b+                                     testDeleteBucket c b+                             )+                             (\b ->+                                  do testGetBucketLocation c b "EU"+                                     let euTestObj = testObjectTemplate {obj_bucket = b}+                                     testSendObject c euTestObj+                                     testGetObject c euTestObj+                                     testDeleteObject c euTestObj+                             )+                 -- US buckets+                 bracket (testCreateBucketIn c "US")+                             (\b -> testDeleteBucket c b)+                             (\b -> testGetBucketLocation c b "US")              ) +bucketNamingTest =+    TestList+    [+     (nameNotValidTC "At least 3 chars" "ab"),+     (nameValidTC "At least 3 chars" "abc"),+     (nameNotValidTC "63 chars or fewer" (replicate 64 'a')),+     (nameNotValidTC "Starts with alphanum char" "."),+     (nameNotValidTC "Starts with alphanum char" "_"),+     (nameNotValidTC "Starts with alphanum char" "-"),+     (nameNotValidTC "No underscores" "ab_cd"),+     (nameNotValidTC "Do not end with a dash" "foo-"),+     (nameNotValidTC "Dashes should not be next to periods" "ab.-cd")+    ]++nameValidTC :: String -> String -> Test+nameValidTC msg name = TestCase (assertBool msg (isBucketNameValid name))+nameNotValidTC :: String -> String -> Test+nameNotValidTC msg name = TestCase (assertBool msg (not (isBucketNameValid name)))++s3CopyTest =+    TestCase (+              do c <- getConn+                 -- Bucket Creation+                 b <- testCreateBucket c+                 d <- testCreateBucket c+                 finally (+                       do let srcObj = testSourceTemplate {obj_bucket = d}+                          let destObj = testDestinationTemplate {obj_bucket = b}+                          -- Object send+                          testSendObject c srcObj+                          -- Object copy+                          testCopyObject c srcObj destObj+                          -- Object get info from copied object+                          testGetObjectInfo c destObj+                         ) (+                          -- Empty buckets+                       do testEmptyBucket c b+                          testEmptyBucket c d+                          -- Destroy buckets+                          testDeleteBucket c b+                          testDeleteBucket c d+                         )+             )+ failOnError :: (Show a) =>                Either a b  -- ^ AWS Result to inspect             -> t           -- ^ Value to return on failure@@ -85,6 +153,12 @@                             return f)                     (\x -> d x) r +testCreateNamedBucket :: AWSConnection -> String -> IO ()+testCreateNamedBucket c bucket =+    do r <- createBucket c bucket+       failOnError r ()+              (const $ assertBool "bucket creation" True)+ testCreateBucket :: AWSConnection -> IO String testCreateBucket c =     do r <- createBucketWithPrefix c testBucket@@ -112,6 +186,12 @@        failOnError r ()               (const $ assertBool "object send" True) +testCopyObject :: AWSConnection -> S3Object -> S3Object -> IO ()+testCopyObject c srco desto =+    do r <- copyObject c srco desto+       failOnError r ()+               (const $ assertBool "object copied" True)+ testGetObject :: AWSConnection -> S3Object -> IO () testGetObject c o =     do r <- getObject c o@@ -157,11 +237,13 @@               (const $ assertBool "bucket deletion" True)  -- test if a bucket is not present+-- It sometimes takes a second or two for a bucket to disappear after a delete,+-- so failing this is not fatal. testBucketGone :: AWSConnection -> String -> IO () testBucketGone c bucket =     getBucketLocation c bucket >>=        either (\(AWSError code msg) -> assertEqual "Bucket is gone" "NotFound" code)-              (\x -> do assertFailure "Bucket still there, should be gone"+              (\x -> do assertFailure "Bucket still there, should be gone (sometimes slow, not fatal)"                         return ())  getConn = do mConn <- amazonS3ConnectionFromEnv

@@ -1,5 +1,5 @@ Name:           hS3-Version:        0.5.1+Version:        0.5.2 License:        BSD3 License-file:   LICENSE Cabal-Version: >= 1.6@@ -16,7 +16,7 @@                 interface to Amazon's Simple Storage Service (S3), allowing Haskell                 developers to reliably store and retrieve arbitrary amounts of                 data from anywhere on the Internet.-extra-source-files: README, Tests.hs,+extra-source-files: README, CONTRIBUTORS, Tests.hs,                     examples/createBucket.hs                     examples/deleteObject.hs                     examples/listBuckets.hs@@ -32,7 +32,7 @@  Library -  Build-depends:  base >= 3 && < 4, HTTP >= 4000.0.0, Crypto >= 4.1.0, hxt, network,+  Build-depends:  base >= 3 && < 5, HTTP >= 4000.0.0, Crypto >= 4.1.0, hxt, network,                 regex-compat, old-time, random, old-locale, dataenc, utf8-string, bytestring    Exposed-modules: