hS3 0.2 → 0.3
raw patch · 5 files changed
+60/−42 lines, 5 filesdep +dataencdep +old-localedep +old-timedep ~Crypto
Dependencies added: dataenc, old-locale, old-time, random, utf8-string
Dependency ranges changed: Crypto
Files
- Network/AWS/Authentication.hs +52/−5
- Network/AWS/S3Bucket.hs +1/−1
- Network/AWS/S3Object.hs +2/−2
- examples/preSignedRequest.hs +0/−30
- hS3.cabal +5/−4
Network/AWS/Authentication.hs view
@@ -14,7 +14,9 @@ -- * Function Types runAction, isAmzHeader, preSignedURI, -- * Data Types- S3Action(..)+ S3Action(..),+ -- * Misc functions+ mimeEncodeQP, mimeDecode ) where import Network.AWS.AWSResult@@ -27,7 +29,11 @@ import Codec.Binary.Base64 (encode, decode) import Codec.Utils (Octet) -import Data.Char (ord, toLower)+import Data.Char (isSpace, intToDigit, digitToInt, ord, chr, toLower)+import Data.Bits ((.&.))+import qualified Codec.Binary.UTF8.String as US+import Codec.Utils (Octet)+ import Data.List (sortBy, groupBy, intersperse) import Data.Maybe @@ -81,7 +87,7 @@ -> [Header] headersFromAction a = map (\(k,v) -> case k of "Content-Type" -> Header HdrContentType v- otherwise -> (Header (HdrCustom k)) v)+ otherwise -> (Header (HdrCustom k)) (mimeEncodeQP v)) (s3metadata a) -- | Inspect HTTP body, and add a @Content-Length@ header with the@@ -176,7 +182,7 @@ -- | Make 'Header' easier to work with, and lowercase keys. headerToLCKeyValue :: Header -> (String, String)-headerToLCKeyValue (Header k v) = (map toLower (show k), v)+headerToLCKeyValue (Header k v) = (map toLower (show k), (mimeEncodeQP v)) -- | Determine if a header belongs in the StringToSign isAmzHeader :: Header -> Bool@@ -233,7 +239,7 @@ -- | Convenience for dealing with HMAC-SHA1 string2words :: String -> [Octet]-string2words = map (fromIntegral . ord)+string2words = US.encode -- | Construct the request specified by an S3Action, send to Amazon, -- and return the response. Todo: add MD5 signature.@@ -304,4 +310,45 @@ second (text <<< atTag "Message") >>> unsplit (\x y -> AWSError x y) +--- mime header encoding+mimeEncodeQP, mimeDecode :: String -> String +-- | Decode a mime string, we only know about quoted printable UTF-8+mimeDecode a =+ if isPrefix utf8qp a+ -- =?UTF-8?Q?....?= -> decoded UTF-8 string+ then US.decodeString $ mimeDecode' $ reverse $ drop 2 $ reverse $ drop (length utf8qp) a+ else a+ where+ utf8qp = "=?UTF-8?Q?"++mimeDecode' :: String -> String+mimeDecode' ('=':a:b:rest) =+ chr (16 * digitToInt a + digitToInt b)+ : mimeDecode' rest+mimeDecode' (h:t) = h : mimeDecode' t+mimeDecode' [] = []++ -- Encode a String into quoted printable, if needed.+ -- eq: =?UTF-8?Q?=aa?=+mimeEncodeQP s =+ if (any (\x -> ord x > 128) s )+ then "=?UTF-8?Q?" ++ (mimeEncodeQP' $ US.encodeString s) ++ "?="+ else s++mimeEncodeQP' :: String -> String+mimeEncodeQP' (h:t) =+ let str = if reserved (ord h) then escape h else [h]+ in str ++ mimeEncodeQP' t+ where+ reserved x+ | x >= ord 'a' && x <= ord 'z' = False+ | x >= ord 'A' && x <= ord 'Z' = False+ | x >= ord '0' && x <= ord '9' = False+ | x == ord ' ' = False+ | x <= 0x20 || x >= 0x7F = True+ | otherwise = True+ escape x =+ let y = ord x in+ [ '=', intToDigit ((y `div` 16) .&. 0xf), intToDigit (y .&. 0xf) ]+mimeEncodeQP' [] = []
Network/AWS/S3Bucket.hs view
@@ -65,7 +65,7 @@ randomName :: IO String randomName =- do rdata <- randomIO+ do rdata <- randomIO :: IO Integer return $ take 10 $ show $ hexdumpBy "" 999 (hash (toOctets 10 (abs rdata)))
Network/AWS/S3Object.hs view
@@ -11,7 +11,7 @@ module Network.AWS.S3Object ( -- * Function Types- sendObject, getObject, deleteObject,+ sendObject, getObject, getObjectInfo, deleteObject, publicUriForSeconds, publicUriUntilTime, -- * Data Types S3Object(..)@@ -112,7 +112,7 @@ headersFromResponse r = let respheaders = rspHeaders r in map (\x -> case x of- Header (HdrCustom name) val -> (name, val)+ Header (HdrCustom name) val -> (name, (mimeDecode val)) ) (filter isAmzHeader respheaders) -- | Delete an object. Only bucket and object name need to be
− examples/preSignedRequest.hs
@@ -1,30 +0,0 @@-#!/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)
hS3.cabal view
@@ -1,12 +1,12 @@ Name: hS3-Version: 0.2+Version: 0.3 License: BSD3 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/doc/+Homepage: http://gregheartsfield.com/repos/hS3/doc/ Category: Network, Web Stability: Alpha Synopsis: Interface to Amazon's Simple Storage Service (S3)@@ -23,8 +23,9 @@ 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+Build-depends: base, HTTP >= 3000.0.0, Crypto >= 4.1.0, hxt, network,+ regex-compat, old-time, random, old-locale, dataenc, utf8-string+Build-type: Simple Exposed-modules: Network.AWS.S3Object, Network.AWS.S3Bucket,