----------------------------------------------------------------------------- -- | -- Module : Network.AWS.S3Object -- Copyright : (c) Greg Heartsfield 2007 -- License : BSD3 -- -- Object interface for Amazon S3 -- API Version 2006-03-01 -- <http://docs.amazonwebservices.com/AmazonS3/2006-03-01/> ----------------------------------------------------------------------------- module Network.AWS.S3Object ( -- * Function Types sendObject, sendObjectMIC, copyObject, copyObjectWithReplace, getObject, getObjectInfo, deleteObject, publicUriForSeconds, publicUriUntilTime, setStorageClass, getStorageClass, rewriteStorageClass, -- * Data Types S3Object(..), StorageClass(..) ) where import Network.AWS.Authentication as Auth import Network.AWS.AWSResult import Network.AWS.AWSConnection import Network.HTTP import Network.URI import System.Time import Data.List.Utils import Data.List(lookup) import Data.Digest.MD5(hash) import Codec.Binary.Base64 (encode) import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy as LO -- | An object that can be stored and retrieved from S3. data S3Object = S3Object { -- | Name of the bucket containing this object obj_bucket :: String, -- | URI of the object. Subresources ("?acl" or -- | "?torrent") should be suffixed onto this name. obj_name :: String, -- | A standard MIME type describing the format of the -- contents. If not specified, @binary/octet-stream@ is -- used. content_type :: String, -- | Object metadata in (key,value) pairs. Key names -- should use the prefix @x-amz-meta-@ to be stored with -- the object. The total HTTP request must be under 4KB, -- including these headers. obj_headers :: [(String, String)], -- | Object data. 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. -- If the header "Content-Length" is not set, all content must be read into -- memory prior to sending. 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 (urlEncode (obj_bucket obj)) (urlEncode (obj_name obj)) "" (("Content-Type", (content_type obj)) : obj_headers obj) (obj_data obj) PUT) return (either Left (\_ -> Right ()) res) -- | Send data for an object, with message integrity check. This -- version of sendObject will add an MD5 message integrity check so -- that transmission errors will be detected, but requires the message -- be read into memory before being sent. sendObjectMIC :: AWSConnection -- ^ AWS connection information -> S3Object -- ^ Object to add to a bucket -> IO (AWSResult ()) -- ^ Server response sendObjectMIC aws obj = sendObject aws obj_w_header where obj_w_header = obj { obj_headers = (obj_headers obj) ++ md5_header } md5_header = [("Content-MD5", (mkMD5 (obj_data obj)))] mkMD5 = encode . hash . LO.unpack -- | 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 (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 -- 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 = 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 (urlEncode (obj_bucket obj)) (urlEncode (obj_name obj)) "" (obj_headers obj) L.empty m) return (either Left (\x -> Right (populate_obj_from x)) res) where populate_obj_from x = obj { obj_data = (rspBody x), obj_headers = (headersFromResponse x) } headersFromResponse :: HTTPResponse L.ByteString -> [(String,String)] headersFromResponse r = let respheaders = rspHeaders r in map (\x -> case x of Header (HdrCustom name) val -> (name, (mimeDecode 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 -- does not return an error. deleteObject :: AWSConnection -- ^ AWS connection information -> S3Object -- ^ Object to delete -> IO (AWSResult ()) -- ^ Server response 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), 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 (bucket+name only) -> S3Object -- ^ Destination object -> 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)) "" (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))))] ++ (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") })