hS3 0.5.2 → 0.5.3

raw patch · 6 files changed

+234/−21 lines, 6 filesdep +MissingHPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: MissingH

API changes (from Hackage documentation)

Files

• FEATURES +35/−0
• Network/AWS/S3Bucket.hs +19/−7
• Network/AWS/S3Object.hs +78/−6
• Tests.hs +94/−4
• hS3.cabal +5/−3
• hS3.hs +3/−1

@@ -0,0 +1,35 @@+The Amazon S3 service has a large number of features.  Those which are+supported by hS3 are listed below.++ * Creating buckets+ * Creating bucket in a specified region (US/EU)+ * Creating buckets with prefix and random suffix+ * Deleting buckets+ * Retrieving physical location of bucket+ * Empty a bucket of all objects+ * List buckets for an account+ * List objects using prefix/marker/delimiter/maxkeys API+ * List all objects, using multiple queries+ * Sending objects+ * Copying objects (preserving metadata)+ * Deleting objects+ * Retrieving object metadata+ * Assigning custom 'amz-meta' headers to objects+ * Forming pre-signed/expiring URLs for objects+  * Expiring either on a given date, or number of seconds from current time+ * Setting the storage class (Reduced Redundancy or Standard) for new objects+ * Rewrite storage class of existing objects+++Missing feature list (incomplete).  We know the following features are not+yet supported.  Some features may be available without changing the+hS3 library, if you understand the S3 API in sufficient detail.  Patches to+add this functionality would be greatly appreciated!++ * ACLs (Access Control Lists)+ * Object versioning+ * Any bittorrent functionality+ * Delete markers+ * Enabling/disabling bucket logging+ * Distributions+ * Payment configurations

@@ -14,7 +14,7 @@                createBucketIn, createBucket, createBucketWithPrefixIn,                createBucketWithPrefix, deleteBucket, getBucketLocation,                emptyBucket, listBuckets, listObjects, listAllObjects,-               isBucketNameValid,+               isBucketNameValid, getObjectStorageClass,                -- * Data Types                S3Bucket(S3Bucket, bucket_name, bucket_creation_date),                ListRequest(..),@@ -55,7 +55,7 @@ --   without of naming conflicts. createBucketWithPrefixIn :: AWSConnection -- ^ AWS connection information                        -> String -- ^ Bucket name prefix-                       -> String -- ^ "US" or "EU"+                       -> String -- ^ Location ("US", "EU", "us-west-1", "ap-southeast-1")                        -> IO (AWSResult String) -- ^ Server response, if                                                 --   successful, the bucket                                                 --   name is returned.@@ -84,7 +84,7 @@ -- | Create a new bucket on S3 with the given name. createBucketIn :: AWSConnection -- ^ AWS connection information              -> String -- ^ Proposed bucket name-             -> String -- ^ "US" or "EU"+             -> String -- ^ Location ("US", "EU", "us-west-1", "ap-southeast-1")              -> IO (AWSResult ()) -- ^ Server response createBucketIn aws bucket location =     let constraint = if location == "US"@@ -105,7 +105,7 @@ -- | Physical location of the bucket. "US" or "EU" getBucketLocation :: AWSConnection  -- ^ AWS connection information                   -> String  -- ^ Bucket name-                  -> IO (AWSResult String) -- ^ Server response ("US" or "EU")+                  -> IO (AWSResult String) -- ^ Server response ("US", "EU", "us-west-1", "ap-southeast-1", etc.) getBucketLocation aws bucket =     do res <- Auth.runAction (S3Action aws bucket "?location" "" [] L.empty GET)        case res of@@ -199,7 +199,8 @@       key :: String, -- ^ Name of object       last_modified :: String, -- ^ Last modification date       etag :: String, -- ^ MD5-      size :: Integer -- ^ Bytes of object data+      size :: Integer, -- ^ Bytes of object data+      storageClass :: StorageClass -- ^ Storage class of the object     } deriving (Show)  -- | Is a result set response truncated?@@ -241,6 +242,16 @@                                              (\x -> return (Right (lr ++ x))) next_set                       (False,lr) -> return (Right lr) +-- | Retrieve the storage class of an object from S3.+--   For checking more than one object's storage class efficiently,+--   use listObjects.+getObjectStorageClass :: AWSConnection+                      -> S3Object+                      -> IO (AWSResult StorageClass)+getObjectStorageClass c obj =+    do res <- listObjects c (obj_bucket obj) (ListRequest (obj_name obj) "" "" 1)+       return (either Left (\(t,xs) -> Right (head (map storageClass xs))) res)+ -- | Determine if ListBucketResult is truncated.  It would make sense --   to combine this with the query for list results, so we didn't --   have to parse the XML twice.@@ -267,8 +278,9 @@                      ((text <<< atTag "Key") &&&                       (text <<< atTag "LastModified") &&&                       (text <<< atTag "ETag") &&&-                      (text <<< atTag "Size")) >>>-                     arr (\(a,(b,(c,d))) -> ListResult a b ((unquote . HTTP.urlDecode) c) (read d))+                      (text <<< atTag "Size") &&&+                      (text <<< atTag "StorageClass")) >>>+                     arr (\(a,(b,(c,(d,e)))) -> ListResult a b ((unquote . HTTP.urlDecode) c) (read d) (read e))  -- | Check Amazon guidelines on bucket naming.  (missing test for IP-like names) isBucketNameValid :: String -> Bool

@@ -11,10 +11,12 @@  module Network.AWS.S3Object (   -- * Function Types-  sendObject, copyObject, getObject, getObjectInfo, deleteObject,-  publicUriForSeconds, publicUriUntilTime,+  sendObject, copyObject, copyObjectWithReplace, getObject,+  getObjectInfo, deleteObject, publicUriForSeconds,+  publicUriUntilTime, setStorageClass, getStorageClass,+  rewriteStorageClass,   -- * Data Types-  S3Object(..)+  S3Object(..), StorageClass(..)   ) where  import Network.AWS.Authentication as Auth@@ -23,6 +25,7 @@ import Network.HTTP import Network.URI import System.Time+import Data.List.Utils  import qualified Data.ByteString.Lazy.Char8 as L @@ -46,6 +49,51 @@                obj_data :: L.ByteString     } deriving (Read, Show) +data StorageClass = STANDARD | REDUCED_REDUNDANCY+  deriving (Read, Show, Eq)++-- Amazon header key for storage class+storageHeader = "x-amz-storage-class"++-- | Add required headers for the storage class.+--   Use this in combination with 'sendObject' for new objects.  To+--   modify the storage class of existing objects, use+--   'rewriteStorageClass'.  Using reduced redundancy for object storage+--   trades off redundancy for storage costs.+setStorageClass :: StorageClass -- ^ Storage class to request+                -> S3Object -- ^ Object to modify+                -> S3Object -- ^ Object with storage class headers set, ready to be sent+setStorageClass sc obj = obj {obj_headers = addToAL+                                            (obj_headers obj)+                                            storageHeader (show sc)}++-- | Retrieve the storage class of a local S3Object.+--   Does not work for objects retrieved with 'getObject', since the+--   required header values are not returned.  Use+--   'getObjectStorageClass' or 'listObjects' from S3Bucket module to+--   determine storage class of existing objects.+getStorageClass :: S3Object -- ^ Object to inspect+                -> Maybe StorageClass -- ^ Requested storage class, Nothing if unspecified+getStorageClass obj = case stg_values of+                        [] -> Nothing+                        x -> Just (read (head x))+    where+      hdrs = obj_headers obj+      stg_hdrs = filter (\x -> fst x == storageHeader) hdrs+      stg_values = map fst stg_hdrs++-- | Change the storage class (and only the storage class) of an existing object.+--   This actually performs a copy to the same location, preserving metadata.+--   It is not clear to me whether ACLs are preserved when copying to the same location.+--   For best performance, we must not change other headers during storage class+--   changes.+rewriteStorageClass :: AWSConnection -- ^ AWS connection information+                    -> StorageClass -- ^ New storage class for object+                    -> S3Object -- ^ Object to modify+                    -> IO (AWSResult S3Object) -- ^ Server response+rewriteStorageClass aws sc obj =+    copyObject aws obj (setStorageClass sc (obj {obj_headers = []}))+ -- | Send data for an object. sendObject :: AWSConnection      -- ^ AWS connection information            -> S3Object           -- ^ Object to add to a bucket@@ -130,11 +178,21 @@                                                               L.empty DELETE)                           return (either Left (\_ -> Right ()) res) --- | Copy object from one bucket to another (or the same bucket).+-- | Copy object from one bucket to another (or the same bucket), preserving the original headers.+--   Headers from @destobj@ are sent, while only the+--   bucket and name of @srcobj@ are used.  For the best+--   performance, when changing headers during a copy, use the+--   'copyObjectWithReplace' function.  For conditional copying, the+--   following headers set on the destination object may be used:+--   @x-amz-copy-source-if-match@, @x-amz-copy-source-if-none-match@,+--   @x-amz-copy-source-if-unmodified-since@, or+--   @x-amz-copy-source-if-modified-since@.  See+--   <http://docs.amazonwebservices.com/AmazonS3/2006-03-01/API/index.html?RESTObjectCOPY.html>+--   for more details. copyObject :: AWSConnection            -- ^ AWS connection information-              -> S3Object                 -- ^ Source object+              -> S3Object                 -- ^ Source object (bucket+name only)               -> S3Object                 -- ^ Destination object-              -> IO (AWSResult S3Object)  -- ^ Server response+              -> IO (AWSResult S3Object)  -- ^ Server response, headers include version information copyObject aws srcobj destobj =     do res <- Auth.runAction (S3Action aws (urlEncode (obj_bucket destobj))                                            (urlEncode (obj_name destobj))@@ -149,4 +207,18 @@              copy_headers = [("x-amz-copy-source",                               ("/"++ (urlEncode (obj_bucket srcobj))                                ++ "/" ++ (urlEncode (obj_name srcobj))))]+                            ++ (obj_headers destobj) +-- | Copy object from one bucket to another (or the same bucket), replacing headers.+--   Any headers from @srcobj@ are ignored, and only those+--   set in @destobj@ are used.+copyObjectWithReplace :: AWSConnection            -- ^ AWS connection information+                      -> S3Object                 -- ^ Source object (bucket+name only)+                      -> S3Object                 -- ^ Destination object+                      -> IO (AWSResult S3Object)  -- ^ Server response, headers include version information+copyObjectWithReplace aws srcobj destobj =+    copyObject aws srcobj (destobj {obj_headers =+                                    (addToAL (obj_headers destobj)+                                     "x-amz-metadata-directive"+                                     "REPLACE")+                                   })

@@ -20,7 +20,8 @@ import qualified Data.ByteString.Lazy.Char8 as L import Control.Exception(finally) import IO(bracket)-+import Control.Concurrent(threadDelay)+import Data.List.Utils(hasKeyAL) import Test.HUnit  -- | Run the tests@@ -31,8 +32,11 @@     [      TestLabel "S3 Operations Test" s3OperationsTest,      TestLabel "S3 Copy Test" s3CopyTest,+     TestLabel "S3 Copy/Replace Test" s3CopyReplaceTest,      TestLabel "S3 Location Test" s3LocationTest,-     TestLabel "Bucket Naming Test" bucketNamingTest+     TestLabel "Bucket Naming Test" bucketNamingTest,+     TestLabel "Reduced Redundancy Creation Test" reducedRedundancyCreateTest,+     TestLabel "Reduced Redundancy Existing Test" reducedRedundancyExistingTest     ]  testBucket = "hs3-test"@@ -73,6 +77,7 @@                  -- Delete bucket                  testDeleteBucket c bucket                  -- Bucket should be gone+                 threadDelay 3000000 -- sleep 3 sec, since bucket isn't always unavailable immediately                  testBucketGone c bucket              ) @@ -123,15 +128,60 @@                  -- Bucket Creation                  b <- testCreateBucket c                  d <- testCreateBucket c+                 let srcHeader = "x-amz-meta-src"+                 let srcValue = "foo"                  finally (-                       do let srcObj = testSourceTemplate {obj_bucket = d}+                       do let srcObj = testSourceTemplate {obj_bucket = d, obj_headers = [(srcHeader,srcValue)]}                           let destObj = testDestinationTemplate {obj_bucket = b}                           -- Object send                           testSendObject c srcObj+                          -- Verify headers were set on original object+                          sr <- getObject c srcObj+                          failOnError sr ()+                                          (\x -> assertBool "Original sent object has custom headers"+                                                (hasKeyAL srcHeader (obj_headers x))+                                          )                           -- Object copy                           testCopyObject c srcObj destObj+                          -- Verify destination object contains same added header as source object+                          testGetObjectInfo c (destObj {obj_headers = [(srcHeader,srcValue)]})+                         ) (+                          -- Empty buckets+                       do testEmptyBucket c b+                          testEmptyBucket c d+                          -- Destroy buckets+                          testDeleteBucket c b+                          testDeleteBucket c d+                         )+             )++s3CopyReplaceTest =+    TestCase (+              do c <- getConn+                 -- Bucket Creation+                 b <- testCreateBucket c+                 d <- testCreateBucket c+                 let srcHeader = "x-amz-meta-src"+                 let srcValue = "foo"+                 finally (+                       do let srcObj = testSourceTemplate {obj_bucket = d, obj_headers = [(srcHeader,srcValue)]}+                          let destObj = testDestinationTemplate {obj_bucket = b}+                          -- Object send+                          testSendObject c srcObj+                          sr <- getObject c srcObj+                          failOnError sr ()+                                          (\x -> assertBool "Original sent object has custom headers"+                                                (hasKeyAL srcHeader (obj_headers x))+                                          )+                          -- Object copy+                          testCopyObjectWithReplace c srcObj destObj                           -- Object get info from copied object                           testGetObjectInfo c destObj+                          dr <- getObject c destObj+                          failOnError dr ()+                                          (\x -> assertBool "Copied object w/ replace does not have source headers"+                                                (not (hasKeyAL srcHeader (obj_headers x)))+                                          )                          ) (                           -- Empty buckets                        do testEmptyBucket c b@@ -192,6 +242,12 @@        failOnError r ()                (const $ assertBool "object copied" True) +testCopyObjectWithReplace :: AWSConnection -> S3Object -> S3Object -> IO ()+testCopyObjectWithReplace c srco desto =+    do r <- copyObjectWithReplace c srco desto+       failOnError r ()+               (const $ assertBool "object copied" True)+ testGetObject :: AWSConnection -> S3Object -> IO () testGetObject c o =     do r <- getObject c o@@ -203,6 +259,7 @@                                         (realMetadata (obj_headers x))               ) +-- Test to ensure an object on S3 matches the headers passed to this function. testGetObjectInfo :: AWSConnection -> S3Object -> IO () testGetObjectInfo c o =     do r <- getObject c o@@ -246,6 +303,40 @@               (\x -> do assertFailure "Bucket still there, should be gone (sometimes slow, not fatal)"                         return ()) +reducedRedundancyCreateTest =+    TestCase (+              do c <- getConn+                 b <- testCreateBucket c+                 let rr = "reduced-redundancy"+                 let testObj = testObjectTemplate {obj_bucket = b, obj_name = rr}+                 let rrTestObj = setStorageClass REDUCED_REDUNDANCY testObj+                 testSendObject c rrTestObj+                 r <- getObjectStorageClass c testObj+                 failOnError r ()+                        (\sc -> assertEqual "storage class is reduced-redundancy"+                               REDUCED_REDUNDANCY sc)+             )++reducedRedundancyExistingTest =+    TestCase (+              do c <- getConn+                 b <- testCreateBucket c+                 let rr = "reduced-redundancy"+                 let testObj = testObjectTemplate {obj_bucket = b, obj_name = rr}+                 testSendObject c testObj+                 rewriteStorageClass c REDUCED_REDUNDANCY testObj+                 r <- getObjectStorageClass c testObj+                 failOnError r ()+                        (\sc -> assertEqual "storage class is reduced-redundancy"+                               REDUCED_REDUNDANCY sc)+                 -- Set storage class back to STANDARD+                 rewriteStorageClass c STANDARD testObj+                 s <- getObjectStorageClass c testObj+                 failOnError s ()+                        (\sc -> assertEqual "storage class switched back to standard"+                               STANDARD sc)+             )+ getConn = do mConn <- amazonS3ConnectionFromEnv              return (fromJust mConn) @@ -255,4 +346,3 @@  realMetadata :: [(String, b)] -> [(String, b)] realMetadata = filter (\x -> fst x `notElem` headersToIgnore)-

@@ -1,5 +1,5 @@ Name:           hS3-Version:        0.5.2+Version:        0.5.3 License:        BSD3 License-file:   LICENSE Cabal-Version: >= 1.6@@ -16,7 +16,8 @@                 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, CONTRIBUTORS, Tests.hs,+extra-source-files: README, CONTRIBUTORS, FEATURES,+                    Tests.hs,                     examples/createBucket.hs                     examples/deleteObject.hs                     examples/listBuckets.hs@@ -33,7 +34,8 @@ Library    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+                regex-compat, old-time, random, old-locale, dataenc, utf8-string, bytestring,+                MissingH >= 0.18.6    Exposed-modules:         Network.AWS.S3Object,

@@ -29,9 +29,10 @@ main = do   args <- getArgs   case args of-    -- create / delete bucket+    -- create / empty / delete bucket     ["cb", name, location] -> withConn $ \g -> createBucketIn g name location     ["db", name ] ->  withConn $ \g -> deleteBucket g name+    ["eb", name ] ->  withConn $ \g -> emptyBucket g name     -- objects     ["go", bucket, gkey ] ->         do c <- withConn $ \g -> getObject g $ S3Object bucket gkey "" [] L.empty@@ -53,6 +54,7 @@         , ""         , "cb <name> [EU, US] : create bucket"         , "db <name> : delete bucket"+        , "eb <name> : empty bucket"         , "do <bucket> <key> : delete object"         , ""         , "lbs : list buckets"