hS3 0.1 → 0.2
raw patch · 15 files changed
+581/−82 lines, 15 files
Files
- Network/AWS/AWSResult.hs +13/−3
- Network/AWS/Authentication.hs +69/−18
- Network/AWS/S3Bucket.hs +64/−21
- Network/AWS/S3Object.hs +59/−10
- Tests.hs +60/−24
- examples/createBucket.hs +33/−0
- examples/deleteBucket.hs +33/−0
- examples/deleteObject.hs +34/−0
- examples/getObject.hs +35/−0
- examples/listBuckets.hs +29/−0
- examples/listObjects.hs +38/−0
- examples/preSignedRequest.hs +30/−0
- examples/sendObject.hs +35/−0
- examples/uploadFile.hs +36/−0
- hS3.cabal +13/−6
Network/AWS/AWSResult.hs view
@@ -18,13 +18,23 @@ import Network.Stream as Stream -type AWSResult a = Either ReqError {- some kind of failure to process the request -}- a {- result -}+-- | A result from processing a request to S3. Either some success+-- value, or a 'ReqError'.+type AWSResult a = Either ReqError a++-- | An error from an S3 request, either at the network layer, or from+-- S3 itself. data ReqError =+ -- | Connection error at the network layer. NetworkError Stream.ConnError |- AWSError String String -- AWS error code and message+ -- | @AWSError code message@ constructs an error message from S3+ -- itself. See+ -- <http://docs.amazonwebservices.com/AmazonS3/2006-03-01/ErrorCodeList.html>+ -- for a detailed list of possible codes.+ AWSError String String deriving (Show, Eq) +-- | Pretty print an error message. prettyReqError :: ReqError -> String prettyReqError r = case r of AWSError a b -> b
Network/AWS/Authentication.hs view
@@ -12,7 +12,7 @@ module Network.AWS.Authentication ( -- * Function Types- runAction,+ runAction, isAmzHeader, preSignedURI, -- * Data Types S3Action(..) ) where@@ -41,15 +41,22 @@ -- | An action to be performed using S3. data S3Action =- S3Action { s3conn :: AWSConnection, -- ^ Connection and authentication- -- information- s3bucket :: String, -- ^ Name of bucket to act on- s3object :: String, -- ^ Name of object to act on- s3query :: String, -- ^ Query parameters, requires a prefix of @?@- s3metadata :: [(String, String)], -- ^ Additional header fields to send- s3body :: String, -- ^ Body of action, if sending data- s3operation :: RequestMethod -- ^ Type of action, 'PUT', 'GET', etc.- } deriving (Show)+ S3Action {+ -- | Connection and authentication information+ s3conn :: AWSConnection,+ -- | Name of bucket to act on+ s3bucket :: String,+ -- | Name of object to act on+ s3object :: String,+ -- | Query parameters (requires a prefix of @?@)+ s3query :: String,+ -- | Additional header fields to send+ s3metadata :: [(String, String)],+ -- | Body of action, if sending data+ s3body :: String,+ -- | Type of action, 'PUT', 'GET', etc.+ s3operation :: RequestMethod+ } deriving (Show) -- | Transform an 'S3Action' into an HTTP request. Does not add -- authentication or date information, so it is not suitable for@@ -72,8 +79,10 @@ -- | Create 'Header' objects from an action. headersFromAction :: S3Action -> [Header]-headersFromAction a = map (\(k,v) -> (Header (HdrCustom k)) v)- (s3metadata a)+headersFromAction a = map (\(k,v) -> case k of+ "Content-Type" -> Header HdrContentType v+ otherwise -> (Header (HdrCustom k)) v)+ (s3metadata a) -- | Inspect HTTP body, and add a @Content-Length@ header with the -- correct length.@@ -86,11 +95,18 @@ -> HTTP.Request -- ^ Authenticated request addAuthenticationHeader act req = insertHeader HdrAuthorization auth_string req where auth_string = "AWS " ++ (awsAccessKey conn) ++ ":" ++ signature- signature = encode (hmac_sha1 keyOctets msgOctets)- keyOctets = string2words (awsSecretKey conn)- msgOctets = string2words (stringToSign act req)+ signature = makeSignature conn (stringToSign act req) conn = s3conn act +-- | Sign a string using the given authentication data+makeSignature :: AWSConnection -- ^ Action with authentication data+ -> String -- ^ String to sign+ -> String -- ^ Base-64 encoded signature+makeSignature c s =+ encode (hmac_sha1 keyOctets msgOctets)+ where keyOctets = string2words (awsSecretKey c)+ msgOctets = string2words s+ -- | Generate text that will be signed and subsequently added to the -- request. stringToSign :: S3Action -> HTTP.Request -> String@@ -105,12 +121,13 @@ http_verb ++ "\n" ++ hdr_content_md5 ++ "\n" ++ hdr_content_type ++ "\n" ++- hdr_date ++ "\n"+ dateOrExpiration ++ "\n" where http_verb = show (rqMethod r) hdr_content_md5 = get_header HdrContentMD5 hdr_date = get_header HdrDate hdr_content_type = get_header HdrContentType get_header h = maybe "" id (findHeader h r)+ dateOrExpiration = maybe hdr_date id (findHeader HdrExpires r) -- | Extract @x-amz-*@ headers needed for signing. -- find all headers with type HdrCustom that begin with amzHeader@@ -186,7 +203,6 @@ otherwise -> case uri of [] -> "/" -- at the least we have a "/" otherwise -> ""- -- | Add a date string to a request. addDateToReq :: HTTP.Request -- ^ Request to modify -> String -- ^ Date string, in RFC 2616 format@@ -194,6 +210,13 @@ addDateToReq r d = r {HTTP.rqHeaders = (HTTP.Header HTTP.HdrDate d) : (HTTP.rqHeaders r)} +-- | Add an expiration date to a request+addExpirationToReq :: HTTP.Request -> String -> HTTP.Request+addExpirationToReq r e = addHeaderToReq r (HTTP.Header HTTP.HdrExpires e)++addHeaderToReq :: HTTP.Request -> Header -> HTTP.Request+addHeaderToReq r h = r {HTTP.rqHeaders = h : (HTTP.rqHeaders r)}+ -- | Get current time in HTTP 1.1 format (RFC 2616) -- Numeric time zones should be used, but I'd rather not subvert the -- intent of ctTZName, so we stick with the name format. Otherwise,@@ -212,7 +235,6 @@ string2words :: String -> [Octet] string2words = map (fromIntegral . ord) - -- | Construct the request specified by an S3Action, send to Amazon, -- and return the response. Todo: add MD5 signature. runAction :: S3Action -> IO (AWSResult Response)@@ -223,6 +245,35 @@ addDateToReq (requestFromAction a) cd result <- (simpleHTTP_ c aReq) createAWSResult result++-- | Construct a pre-signed URI, but don't act on it. This is useful+-- for when an expiration date has been set, and the URI needs to be+-- passed on to a client.+preSignedURI :: S3Action -- ^ Action with resource+ -> Integer -- ^ Expiration time, in seconds since+ -- 00:00:00 UTC on January 1, 1970+ -> URI -- ^ URI of resource+preSignedURI a e =+ let c = (s3conn a)+ server = (awsHost c)+ port = (show (awsPort c))+ accessKeyQuery = "AWSAccessKeyId=" ++ (awsAccessKey c)+ secretKey = (awsSecretKey c)+ beginQuery = case (s3query a) of+ "" -> "?"+ x -> x ++ "&"+ expireQuery = "Expires=" ++ (show e)+ toSign = "GET\n\n\n" ++ (show e) ++ "\n/" ++ (s3bucket a) ++ "/" ++ (s3object a)+ sigQuery = "Signature=" ++ (urlEncode (makeSignature c toSign))+ query = beginQuery ++ accessKeyQuery ++ "&" +++ expireQuery ++ "&" ++ sigQuery+ in URI { uriScheme = "http:",+ uriAuthority = Just (URIAuth "" server (":" ++ port)),+ uriPath = "/" ++ (s3bucket a) ++ "/" ++ (s3object a),+ uriQuery = query,+ uriFragment = ""+ }+ -- | Inspect a response for network errors, HTTP error codes, and -- Amazon error messages.
Network/AWS/S3Bucket.hs view
@@ -11,15 +11,18 @@ module Network.AWS.S3Bucket ( -- * Function Types- createBucket, createBucketWithPrefix, deleteBucket, listBuckets, listObjects,+ createBucket, createBucketWithPrefix, deleteBucket,+ emptyBucket, listBuckets, listObjects, listAllObjects, -- * Data Types- Bucket(Bucket, bucket_name, bucket_creation_date),+ S3Bucket(S3Bucket, bucket_name, bucket_creation_date), ListRequest(..),- ListResult(..)+ ListResult(..),+ IsTruncated ) where import Network.AWS.Authentication as Auth import Network.AWS.AWSResult+import Network.AWS.S3Object import Network.AWS.AWSConnection import Network.AWS.ArrowUtils @@ -38,9 +41,9 @@ import Data.Digest.MD5 import Codec.Text.Raw -data Bucket = Bucket { bucket_name :: String,- bucket_creation_date :: String- } deriving (Show, Eq)+data S3Bucket = S3Bucket { bucket_name :: String,+ bucket_creation_date :: String+ } deriving (Show, Eq) -- | Create a new bucket on S3 with the given prefix, and a random -- suffix. This can be used to programatically create buckets@@ -63,7 +66,8 @@ randomName :: IO String randomName = do rdata <- randomIO- return $ take 10 $ show $ hexdumpBy "" 999 (hash (toOctets 10 (abs rdata)))+ return $ take 10 $ show $ hexdumpBy "" 999+ (hash (toOctets 10 (abs rdata))) -- | Create a new bucket on S3 with the given name. createBucket :: AWSConnection -- ^ AWS connection information@@ -83,10 +87,35 @@ do res <- Auth.runAction (S3Action aws bucket "" "" [] "" DELETE) return (either (Left) (\x -> Right ()) res) +-- | Empty a bucket of all objects. Iterates through all objects+-- issuing delete commands, so time is proportional to number of+-- objects in the bucket. At this time, delete requests are free+-- from Amazon.+emptyBucket :: AWSConnection -- ^ AWS connection information+ -> String -- ^ Bucket name to empty+ -> IO (AWSResult ()) -- ^ Server response+emptyBucket aws bucket =+ do res <- listAllObjects aws bucket (ListRequest "" "" "" 0)+ let objFromRes x = S3Object bucket (key x) "" [] ""+ case res of+ Left x -> return (Left x)+ Right y -> deleteObjects aws (map objFromRes y)++-- | Delete a list of objects, stop as soon as an error is encountered.+deleteObjects :: AWSConnection+ -> [S3Object]+ -> IO (AWSResult ())+deleteObjects _ [] = return (Right ())+deleteObjects aws (x:xs) =+ do dr <- deleteObject aws x+ case dr of+ Left x -> return (Left x)+ Right x -> deleteObjects aws xs+ -- | Return a list of all bucket names and creation dates. S3 -- allows a maximum of 100 buckets per user. listBuckets :: AWSConnection -- ^ AWS connection information- -> IO (AWSResult [Bucket]) -- ^ Server response+ -> IO (AWSResult [S3Bucket]) -- ^ Server response listBuckets aws = do res <- Auth.runAction (S3Action aws "" "" "" [] "" GET) case res of@@ -94,13 +123,13 @@ Right y -> do bs <- parseBucketListXML (rspBody y) return (Right bs) -parseBucketListXML :: String -> IO [Bucket]+parseBucketListXML :: String -> IO [S3Bucket] parseBucketListXML x = runX (readString [(a_validate,v_0)] x >>> processBuckets) processBuckets = deep (isElem >>> hasName "Bucket") >>> split >>> first (text <<< atTag "Name") >>> second (text <<< atTag "CreationDate") >>>- unsplit (\x y -> Bucket x y)+ unsplit (\x y -> S3Bucket x y) -- | List request parameters data ListRequest =@@ -125,6 +154,9 @@ size :: Integer -- ^ Bytes of object data } deriving (Show) +-- | Is a result set response truncated?+type IsTruncated = Bool+ -- | List objects in a bucket, based on parameters from 'ListRequest'. See -- the Amazon S3 developer resources for in depth explanation of how -- the fields in 'ListRequest' can be used to query for objects.@@ -132,23 +164,34 @@ listObjects :: AWSConnection -- ^ AWS connection information -> String -- ^ Bucket name to search -> ListRequest -- ^ List parameters- -> IO (AWSResult [ListResult]) -- ^ Server response-listObjects aws bucket lp =+ -> IO (AWSResult (IsTruncated, [ListResult])) -- ^ Server response+listObjects aws bucket lreq = do res <- Auth.runAction (S3Action aws bucket ""- ("?" ++ (show lp)) [] "" GET)+ ("?" ++ (show lreq)) [] "" GET) case res of Left x -> do return (Left x) Right y -> do let objs = rspBody y tr <- isListTruncated objs lr <- getListResults objs- case tr of- True -> do let last_result = (key . head . reverse) lr- next_set <- listObjects aws bucket- (lp {marker = last_result,- max_keys = (max_keys lp) - (length lr)})- either (\x -> return (Left x))- (\x -> return (Right (lr ++ x))) next_set- False -> do return (Right lr)+ return (Right (tr, lr))++-- | Repeatedly query the server for all objects in a bucket, ignoring the @max_keys@ field.+listAllObjects :: AWSConnection -- ^ AWS connection information+ -> String -- ^ Bucket name to search+ -> ListRequest -- ^ List parameters+ -> IO (AWSResult [ListResult]) -- ^ Server response+listAllObjects aws bucket lp =+ do let lp_max = lp {max_keys = 1000}+ res <- listObjects aws bucket lp_max+ case res of+ Left x -> do return (Left x)+ Right y -> case y of+ (True,lr) -> do let last_result = (key . head . reverse) lr+ next_set <- listAllObjects aws bucket+ (lp_max {marker = last_result})+ either (\x -> return (Left x))+ (\x -> return (Right (lr ++ x))) next_set+ (False,lr) -> return (Right lr) -- | Determine if ListBucketResult is truncated. It would make sense -- to combine this with the query for list results, so we didn't
Network/AWS/S3Object.hs view
@@ -12,6 +12,7 @@ module Network.AWS.S3Object ( -- * Function Types sendObject, getObject, deleteObject,+ publicUriForSeconds, publicUriUntilTime, -- * Data Types S3Object(..) ) where@@ -20,6 +21,8 @@ import Network.AWS.AWSResult import Network.AWS.AWSConnection import Network.HTTP+import Network.URI+import System.Time -- | An object that can be stored and retrieved from S3. data S3Object =@@ -39,32 +42,78 @@ obj_headers :: [(String, String)], -- | Object data. obj_data :: String- } deriving (Show)+ } deriving (Read, Show) -- | Send data for an object. sendObject :: AWSConnection -- ^ AWS connection information -> 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)- ""- (obj_headers obj)- (obj_data obj) PUT)- return (either (Left) (\x -> Right ()) res)+sendObject aws obj =+ do res <- Auth.runAction (S3Action aws (obj_bucket obj)+ (obj_name obj)+ ""+ (("Content-Type", (content_type obj)) :+ (obj_headers obj))+ (obj_data obj) PUT)+ return (either (Left) (\x -> Right ()) res) +-- | Create a pre-signed request URI. Anyone can use this to request+-- an object until the specified date.+publicUriUntilTime :: AWSConnection -- ^ AWS connection information+ -> S3Object -- ^ Object to be made available+ -> Integer -- ^ Expiration time, in seconds since+ -- 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) "" [] "" GET+ in preSignedURI act time++-- | Create a pre-signed request URI. Anyone can use this to request+-- an object for the number of seconds specified.+publicUriForSeconds :: AWSConnection -- ^ AWS connection information+ -> S3Object -- ^ Object to be made available+ -> Integer -- ^ How many seconds until this+ -- request expires+ -> IO URI -- ^ URI for the object+publicUriForSeconds c obj time =+ do TOD ctS _ <- getClockTime -- GHC specific, todo: get epoch within h98.+ return (publicUriUntilTime c obj (ctS + time))+ -- | Retrieve an object. getObject :: AWSConnection -- ^ AWS connection information -> S3Object -- ^ Object to retrieve -> IO (AWSResult S3Object) -- ^ Server response-getObject aws obj =+getObject = getObjectWithMethod GET++-- | Get object info without retrieving content body from server.+getObjectInfo :: AWSConnection -- ^ AWS connection information+ -> S3Object -- ^ Object to retrieve information on+ -> IO (AWSResult S3Object) -- ^ Server response+getObjectInfo = getObjectWithMethod HEAD++-- | Get an object with specified method.+getObjectWithMethod :: RequestMethod -- ^ Method to use for retrieval (GET/HEAD)+ -> AWSConnection -- ^ AWS connection+ -> S3Object -- ^ Object to request+ -> IO (AWSResult S3Object)+getObjectWithMethod m aws obj = do res <- Auth.runAction (S3Action aws (obj_bucket obj) (obj_name obj) "" (obj_headers obj)- "" GET)+ "" m) return (either (Left) (\x -> Right (populate_obj_from x)) res) where- populate_obj_from x = obj {obj_data = (rspBody x)}+ populate_obj_from x =+ obj { obj_data = (rspBody x),+ obj_headers = (headersFromResponse x) }++headersFromResponse :: Response -> [(String,String)]+headersFromResponse r =+ let respheaders = rspHeaders r+ in map (\x -> case x of+ Header (HdrCustom name) val -> (name, val)+ ) (filter isAmzHeader respheaders) -- | Delete an object. Only bucket and object name need to be -- specified in the S3Object. Deletion of a non-existent object
Tests.hs view
@@ -29,7 +29,7 @@ testBucket = "hS3-test" testObjectTemplate = S3Object testBucket "hS3-object-test" "text/plain"- [("x-amz-foo", "bar")] "Hello S3!"+ [("x-amz-meta-foo", "bar")] "Hello S3!" -- | A sequence of several operations. s3operationsTest =@@ -42,58 +42,94 @@ testSendObject c testObj -- Object get testGetObject c testObj- -- Object list- testListObject c bucket 1+ -- Object get info+ testGetObjectInfo c testObj+ -- Object list (should have 1 object in bucket)+ testListAllObjects c bucket 1 -- Object delete testDeleteObject c testObj+ -- Object send, and then bucket empty+ testSendObject c testObj+ testEmptyBucket c bucket+ -- Bucket should now be empty+ testListAllObjects c bucket 0 -- Delete bucket testDeleteBucket c bucket ) +failOnError :: (Show a) =>+ Either a b -- ^ AWS Result to inspect+ -> t -- ^ Value to return on failure+ -> (b -> IO t) -- ^ Assertions to run on success+ -> IO t+failOnError r f d = do either (\x -> do assertFailure (show x)+ return f)+ (\x -> do d x) r+ testCreateBucket :: AWSConnection -> IO String testCreateBucket c = do r <- createBucketWithPrefix c testBucket- either (\x -> do assertFailure (show x)- return ""- )- (\x -> do assertBool "bucket creation" True- return x- ) r+ failOnError r "" (\x -> do assertBool "bucket creation" True+ return x+ ) testSendObject :: AWSConnection -> S3Object -> IO () testSendObject c o = do r <- sendObject c o- either (\x -> assertFailure (show x))- (const $ assertBool "object send" True) r+ failOnError r ()+ (const $ assertBool "object send" True) testGetObject :: AWSConnection -> S3Object -> IO () testGetObject c o = do r <- getObject c o- either (\x -> assertFailure (show x))+ failOnError r () (\x -> do assertEqual "object get body"- (obj_data x) (obj_data o)+ (obj_data o) (obj_data x) assertEqual "object get metadata"- (obj_headers x) (obj_headers o)- ) r+ (obj_headers o)+ (realMetadata (obj_headers x))+ ) +testGetObjectInfo :: AWSConnection -> S3Object -> IO ()+testGetObjectInfo c o =+ do r <- getObject c o+ failOnError r ()+ (\x -> assertEqual "object info get metadata"+ (obj_headers o) (realMetadata (obj_headers x))+ )+ -- test that a bucket has a given number of objects-testListObject :: AWSConnection -> String -> Int -> IO ()-testListObject c bucket count =- do r <- listObjects c bucket (ListRequest "" "" "" 100)- either (\x -> assertFailure (show x))- (\x -> assertEqual "object list" count (length x)) r+testListAllObjects :: AWSConnection -> String -> Int -> IO ()+testListAllObjects c bucket count =+ do r <- listAllObjects c bucket (ListRequest "" "" "" 100)+ failOnError r ()+ (\x -> assertEqual "object list" count (length x)) +testEmptyBucket :: AWSConnection -> String -> IO ()+testEmptyBucket c b =+ do r <- emptyBucket c b+ failOnError r ()+ (const $ assertBool "bucket empty" True)+ testDeleteObject :: AWSConnection -> S3Object -> IO () testDeleteObject c o = do r <- deleteObject c o- either (\x -> assertFailure (show x))- (const $ assertBool "object delete" True) r+ failOnError r ()+ (const $ assertBool "object delete" True) testDeleteBucket :: AWSConnection -> String -> IO () testDeleteBucket c bucket = do r <- deleteBucket c bucket- either (\x -> assertFailure (show x))- (const $ assertBool "bucket deletion" True) r+ failOnError r ()+ (const $ assertBool "bucket deletion" True) getConn = do mConn <- amazonS3ConnectionFromEnv return (fromJust mConn)++-- These headers get added by amazon, but ignore them for+-- testing metadata storage.+headersToIgnore = ["x-amz-id-2", "x-amz-request-id"]++realMetadata :: [(String, b)] -> [(String, b)]+realMetadata = filter (\x -> (fst x) `notElem` headersToIgnore)+
+ examples/createBucket.hs view
@@ -0,0 +1,33 @@+#!/usr/local/bin/runhaskell++-----------------------------------------------------------------------------+-- |+-- Program : Create Bucket+-- Copyright : (c) Greg Heartsfield 2007+-- License : BSD3+--+-- Create a new bucket, with a unique suffix.+-- Usage:+-- createBucket.hs bucket-name+--+-- This requires the following environment variables to be set with+-- your Amazon keys:+-- AWS_ACCESS_KEY_ID+-- AWS_ACCESS_KEY_SECRET+-----------------------------------------------------------------------------++import Network.AWS.S3Bucket+import Network.AWS.AWSConnection+import Network.AWS.AWSResult+import System.Environment+import Data.Maybe++main = do argv <- getArgs+ let bucket = head argv+ mConn <- amazonS3ConnectionFromEnv+ let conn = fromJust mConn+ putStrLn ("Creating bucket with name: " ++ bucket)+ res <- createBucketWithPrefix conn bucket+ either (putStrLn . prettyReqError)+ (\x -> putStrLn ("Creation of " ++ x ++ " successful."))+ res
+ examples/deleteBucket.hs view
@@ -0,0 +1,33 @@+#!/usr/local/bin/runhaskell++-----------------------------------------------------------------------------+-- |+-- Program : Delete Bucket+-- Copyright : (c) Greg Heartsfield 2007+-- License : BSD3+--+-- Delete a bucket with a given name.+-- Usage:+-- deleteBucket.hs bucket-name+--+-- This requires the following environment variables to be set with+-- your Amazon keys:+-- AWS_ACCESS_KEY_ID+-- AWS_ACCESS_KEY_SECRET+-----------------------------------------------------------------------------++import Network.AWS.S3Bucket+import Network.AWS.AWSConnection+import Network.AWS.AWSResult+import System.Environment+import Data.Maybe++main = do argv <- getArgs+ let bucket = head argv+ mConn <- amazonS3ConnectionFromEnv+ let conn = fromJust mConn+ putStrLn ("Deleting bucket with name: " ++ bucket)+ res <- deleteBucket conn bucket+ either (putStrLn . prettyReqError)+ (const $ putStrLn ("Deletion of " ++ bucket ++ " successful."))+ res
+ examples/deleteObject.hs view
@@ -0,0 +1,34 @@+#!/usr/local/bin/runhaskell++-----------------------------------------------------------------------------+-- |+-- Program : Delete Object+-- Copyright : (c) Greg Heartsfield 2007+-- License : BSD3+--+-- Delete an object in a bucket with a given name.+-- Usage:+-- deleteObject.hs bucket-name object-name+--+-- This requires the following environment variables to be set with+-- your Amazon keys:+-- AWS_ACCESS_KEY_ID+-- AWS_ACCESS_KEY_SECRET+-----------------------------------------------------------------------------++import Network.AWS.S3Bucket+import Network.AWS.S3Object+import Network.AWS.AWSConnection+import Network.AWS.AWSResult+import System.Environment+import Data.Maybe++main = do argv <- getArgs+ mConn <- amazonS3ConnectionFromEnv+ let conn = fromJust mConn+ let bucket : key : xs = argv+ let obj = S3Object bucket key "" [] ""+ res <- deleteObject conn obj+ either (putStrLn . prettyReqError)+ (const $ putStrLn ("Key " ++ key ++ " has been removed, if it existed before."))+ res
+ examples/getObject.hs view
@@ -0,0 +1,35 @@+#!/usr/local/bin/runhaskell++-----------------------------------------------------------------------------+-- |+-- Program : Get Object+-- Copyright : (c) Greg Heartsfield 2007+-- License : BSD3+--+-- Retrieve the contents of an object in a bucket.+-- Usage:+-- getObject.hs bucket-name object-name+--+-- This requires the following environment variables to be set with+-- your Amazon keys:+-- AWS_ACCESS_KEY_ID+-- AWS_ACCESS_KEY_SECRET+-----------------------------------------------------------------------------++import Network.AWS.S3Bucket+import Network.AWS.S3Object+import Network.AWS.AWSConnection+import Network.AWS.AWSResult+import System.Environment+import Data.Maybe++main = do argv <- getArgs+ let bucket : key : xs = argv+ let obj = S3Object bucket key "" [] ""+ mConn <- amazonS3ConnectionFromEnv+ let conn = fromJust mConn+ res <- getObject conn obj+ either (putStrLn . prettyReqError)+ (\x -> do putStrLn ("Key " ++ key ++ " has been retrieved. Content follows:")+ putStrLn (obj_data x))+ res
+ examples/listBuckets.hs view
@@ -0,0 +1,29 @@+#!/usr/local/bin/runhaskell++-----------------------------------------------------------------------------+-- |+-- Program : List Buckets+-- Copyright : (c) Greg Heartsfield 2007+-- License : BSD3+--+-- List all buckets for an S3 account+-- Usage:+-- listBuckets.hs+--+-- This requires the following environment variables to be set with+-- your Amazon keys:+-- AWS_ACCESS_KEY_ID+-- AWS_ACCESS_KEY_SECRET+-----------------------------------------------------------------------------++import Network.AWS.S3Bucket+import Network.AWS.S3Object+import Network.AWS.AWSConnection+import Network.AWS.AWSResult+import System.Environment+import Data.Maybe++main = do mConn <- amazonS3ConnectionFromEnv+ let conn = fromJust mConn+ res <- listBuckets conn+ either (putStrLn . show) (mapM_ (putStrLn . bucket_name)) res
+ examples/listObjects.hs view
@@ -0,0 +1,38 @@+#!/usr/local/bin/runhaskell++-----------------------------------------------------------------------------+-- |+-- Program : List Objects+-- Copyright : (c) Greg Heartsfield 2007+-- License : BSD3+--+-- List all objects in a bucket+-- Usage:+-- listObjects.hs bucket-name+--+-- This requires the following environment variables to be set with+-- your Amazon keys:+-- AWS_ACCESS_KEY_ID+-- AWS_ACCESS_KEY_SECRET+-----------------------------------------------------------------------------++import Network.AWS.S3Bucket+import Network.AWS.S3Object+import Network.AWS.AWSConnection+import Network.AWS.AWSResult+import System.Environment+import Data.Maybe++main = do argv <- getArgs+ let bucket : xs = argv+ mConn <- amazonS3ConnectionFromEnv+ let conn = fromJust mConn+ res <- listAllObjects conn bucket (ListRequest "" "" "" 1000)+ either (putStrLn . prettyReqError)+ (\x -> do putStrLn ("Key list from bucket " +++ bucket +++ " has been retrieved. Key/Etag follows:")+ mapM_ (\x -> putStrLn ((key x) +++ " " +++ (etag x))) x+ ) res
+ examples/preSignedRequest.hs view
@@ -0,0 +1,30 @@+#!/usr/local/bin/runhaskell++-----------------------------------------------------------------------------+-- |+-- Program : Get Object+-- Copyright : (c) Greg Heartsfield 2007+-- License : BSD3+--+-- Generate a pre-signed object request, suitable for sending to a 3rd party.+-- Usage:+-- preSignedRequest.hs bucket-name object-name seconds-request-valid+--+-- This requires the following environment variables to be set with+-- your Amazon keys:+-- AWS_ACCESS_KEY_ID+-- AWS_ACCESS_KEY_SECRET+-----------------------------------------------------------------------------++import Network.AWS.S3Object+import Network.AWS.AWSConnection+import System.Environment+import Data.Maybe++main = do argv <- getArgs+ let bucket : key : seconds : xs = argv+ mConn <- amazonS3ConnectionFromEnv+ let conn = fromJust mConn+ let obj = S3Object bucket key "" [] ""+ uri <- (publicUriForSeconds conn obj (read seconds))+ putStrLn (show uri)
+ examples/sendObject.hs view
@@ -0,0 +1,35 @@+#!/usr/local/bin/runhaskell++-----------------------------------------------------------------------------+-- |+-- Program : Send Object+-- Copyright : (c) Greg Heartsfield 2007+-- License : BSD3+--+-- Create a new public object with some content. This can be viewed through+-- a web browser afterwards by visiting http://bucket.s3.amazonaws.com/object+-- Usage:+-- listObjects.hs bucket-name object-name "Some Object Content."+--+-- This requires the following environment variables to be set with+-- your Amazon keys:+-- AWS_ACCESS_KEY_ID+-- AWS_ACCESS_KEY_SECRET+-----------------------------------------------------------------------------++import Network.AWS.S3Bucket+import Network.AWS.S3Object+import Network.AWS.AWSConnection+import Network.AWS.AWSResult+import System.Environment+import Data.Maybe++main = do argv <- getArgs+ let bucket : key : content : xs = argv+ mConn <- amazonS3ConnectionFromEnv+ let conn = fromJust mConn+ let obj = S3Object bucket key "text/html" [("x-amz-acl", "public-read")] content+ res <- sendObject conn obj+ either (putStrLn . prettyReqError)+ (const $ putStrLn ("Creation of " ++ key ++ " successful."))+ res
+ examples/uploadFile.hs view
@@ -0,0 +1,36 @@+#!/usr/local/bin/runhaskell++-----------------------------------------------------------------------------+-- |+-- Program : Upload File+-- Copyright : (c) Greg Heartsfield 2007+-- License : BSD3+--+-- Upload a file to S3 with a given bucket and object name.+-- Usage:+-- uploadFile.hs bucket-name object-name filename+--+-- This requires the following environment variables to be set with+-- your Amazon keys:+-- AWS_ACCESS_KEY_ID+-- AWS_ACCESS_KEY_SECRET+-----------------------------------------------------------------------------++import Network.AWS.S3Bucket+import Network.AWS.S3Object+import Network.AWS.AWSConnection+import Network.AWS.AWSResult+import System.Environment+import Data.Maybe+import System.IO++main = do argv <- getArgs+ let bucket : key : filename : xs = argv+ f <- readFile filename+ mConn <- amazonS3ConnectionFromEnv+ let conn = fromJust mConn+ let obj = S3Object bucket key "text/plain" [] f+ res <- sendObject conn obj+ either (putStrLn . prettyReqError)+ (const $ putStrLn ("Creation of " ++ key ++ " successful."))+ res
hS3.cabal view
@@ -1,20 +1,28 @@ Name: hS3-Version: 0.1+Version: 0.2 License: BSD3-License-file: LICENSE+License-file: LICENSE Copyright: Copyright (c) 2007, Greg Heartsfield Author: Greg Heartsfield <scsibug@imap.cc> Maintainer: Greg Heartsfield <scsibug@imap.cc>-Homepage: http://scsibug.com/hS3+Homepage: http://scsibug.com/hS3/doc/ Category: Network, Web Stability: Alpha-Synopsis: Interface to Amazon's Simple Storage Service (S3).+Synopsis: Interface to Amazon's Simple Storage Service (S3) Description: This is the Haskell S3 library. It provides an 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, Tests.hs,+ examples/createBucket.hs+ examples/deleteObject.hs+ examples/listBuckets.hs+ examples/sendObject.hs+ examples/deleteBucket.hs+ examples/getObject.hs+ examples/listObjects.hs+ examples/uploadFile.hs Build-depends: base, HTTP >= 3000.0.0, Crypto >= 4.0.3, hxt, network, regex-compat GHC-options: -O Exposed-modules:@@ -24,4 +32,3 @@ Network.AWS.AWSConnection, Network.AWS.Authentication, Network.AWS.ArrowUtils-