From: pho Date: Mon, 19 Apr 2010 16:37:17 +0000 (+0900) Subject: Lucu 0.7 X-Git-Tag: RELEASE-0_7 X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=1c692e4261ccc65d89a0aeaa8c9971d9a91c276f;p=Lucu.git Lucu 0.7 Ignore-this: 79590876fded88d2fe488665cce4c0ce Changes from 0.6 to 0.7 ----------------------- * Network.HTTP.Lucu.Resource: (Suggested by Voker57) - getQueryForm and inputForm now return [(name :: String, FormData)] instead of [FormData] to ease field lookup by name. The reason why it's not 'Map String FormData' is that there is a possibility where multiple fields have the same name. - Removed field fdName from FormData type as it's now redundant. darcs-hash:20100419163717-62b54-747b74a5884a16becba1f9408b954c9b202909d3.gz --- diff --git a/Lucu.cabal b/Lucu.cabal index c0c5660..ddb7e3c 100644 --- a/Lucu.cabal +++ b/Lucu.cabal @@ -2,13 +2,13 @@ Name: Lucu Synopsis: HTTP Daemonic Library Description: Lucu is an HTTP daemonic library. It can be embedded in any - Haskell program and runs in an independent thread. - Lucu is not a replacement for Apache. It is intended to be - used to create an efficient web-based application without - messing around FastCGI. It is also intended to be run behind a - reverse-proxy so it doesn't have some facilities like logging, - client filtering or such like. -Version: 0.6 + Haskell program and runs in an independent thread. Lucu is + not a replacement for Apache or lighttpd. It is intended to be + used to create an efficient web-based RESTful application + without messing around FastCGI. It is also intended to be run + behind a reverse-proxy so it doesn't have some facilities like + logging, client filtering or such like. +Version: 0.7 License: PublicDomain License-File: COPYING Author: PHO diff --git a/NEWS b/NEWS index aa4edb3..6c88db1 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,14 @@ +Changes from 0.6 to 0.7 +----------------------- +* Network.HTTP.Lucu.Resource: (Suggested by Voker57) + + - getQueryForm and inputForm now return [(name :: String, + FormData)] instead of [FormData] to ease field lookup by + name. The reason why it's not 'Map String FormData' is that + there is a possibility where multiple fields have the same name. + + - Removed field fdName from FormData type as it's now redundant. + Changes from 0.5 to 0.6 ----------------------- * New dependency: time-http == 0.1.* diff --git a/Network/HTTP/Lucu.hs b/Network/HTTP/Lucu.hs index e6ae3ee..52315d6 100644 --- a/Network/HTTP/Lucu.hs +++ b/Network/HTTP/Lucu.hs @@ -16,10 +16,11 @@ -- [/SSL connections/] Lucu can handle HTTP connections over SSL -- layer. -- --- Lucu is not a replacement for Apache. It is intended to be used to --- create an efficient web-based application without messing around --- FastCGI. It is also intended to be run behind a reverse-proxy so it --- doesn't have the following (otherwise essential) facilities: +-- Lucu is not a replacement for Apache or lighttpd. It is intended to +-- be used to create an efficient web-based RESTful application +-- without messing around FastCGI. It is also intended to be run +-- behind a reverse-proxy so it doesn't have the following (otherwise +-- essential) facilities: -- -- [/Logging/] Lucu doesn't log any requests from any clients. -- diff --git a/Network/HTTP/Lucu/MultipartForm.hs b/Network/HTTP/Lucu/MultipartForm.hs index c9684b1..a2ee492 100644 --- a/Network/HTTP/Lucu/MultipartForm.hs +++ b/Network/HTTP/Lucu/MultipartForm.hs @@ -18,12 +18,11 @@ import Network.HTTP.Lucu.Utils data Part = Part Headers L8.ByteString --- |This data type represents a form entry name, form value and --- possibly an uploaded file name. +-- |This data type represents a form value and possibly an uploaded +-- file name. data FormData = FormData { - fdName :: String - , fdFileName :: Maybe String + fdFileName :: Maybe String , fdContent :: L8.ByteString } @@ -50,7 +49,7 @@ instance Show ContDispo where value -multipartFormP :: String -> Parser [FormData] +multipartFormP :: String -> Parser [(String, FormData)] multipartFormP boundary = do parts <- many (partP boundary) _ <- string "--" @@ -58,7 +57,7 @@ multipartFormP boundary _ <- string "--" _ <- crlf eof - return $ map partToFormData parts + return $ map partToFormPair parts partP :: String -> Parser Part @@ -82,17 +81,15 @@ bodyP boundary return body -partToFormData :: Part -> FormData -partToFormData part@(Part _ body) +partToFormPair :: Part -> (String, FormData) +partToFormPair part@(Part _ body) = let name = partName part - fName = partFileName part - in - FormData { - fdName = name - , fdFileName = fName - , fdContent = body - } - + fname = partFileName part + fd = FormData { + fdFileName = fname + , fdContent = body + } + in (name, fd) partName :: Part -> String partName = getName' . getContDispoFormData diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index 08fb6f1..34c1a72 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -301,20 +301,26 @@ getPathInfo = do rsrcPath <- getResourcePath -- rsrcPath の長さの分だけ削除すれば良い。 return $! drop (length rsrcPath) reqPath --- | Assume the query part of request URI as --- application\/x-www-form-urlencoded, and parse it. This action --- doesn't parse the request body. See 'inputForm'. -getQueryForm :: Resource [FormData] -getQueryForm = do uri <- getRequestURI - return $! map pairToFormData $ parseWWWFormURLEncoded $ snd $ splitAt 1 $ uriQuery uri - -pairToFormData :: (String, String) -> FormData -pairToFormData (name, value) - = FormData { - fdName = name - , fdFileName = Nothing - , fdContent = L8.pack value - } +-- |Assume the query part of request URI as +-- application\/x-www-form-urlencoded, and parse it to pairs of +-- @(name, formData)@. This action doesn't parse the request body. See +-- 'inputForm'. +getQueryForm :: Resource [(String, FormData)] +getQueryForm = liftM parse' getRequestURI + where + parse' = map toPairWithFormData . + parseWWWFormURLEncoded . + snd . + splitAt 1 . + uriQuery + +toPairWithFormData :: (String, String) -> (String, FormData) +toPairWithFormData (name, value) + = let fd = FormData { + fdFileName = Nothing + , fdContent = L8.pack value + } + in (name, fd) -- |Get a value of given request header. Comparison of header name is -- case-insensitive. Note that this action is not intended to be used @@ -726,7 +732,7 @@ inputChunkLBS limit -- makes 'Resource' abort with status \"415 Unsupported Media -- Type\". If the request has no \"Content-Type\", it aborts with -- \"400 Bad Request\". -inputForm :: Int -> Resource [FormData] +inputForm :: Int -> Resource [(String, FormData)] inputForm limit = limit `seq` do cTypeM <- getContentType @@ -742,8 +748,7 @@ inputForm limit ++ show cType) where readWWWFormURLEncoded - = do src <- input limit - return $ map pairToFormData $ parseWWWFormURLEncoded src + = liftM (map toPairWithFormData . parseWWWFormURLEncoded) (input limit) readMultipartFormData params = do case find ((== "boundary") . map toLower . fst) params of @@ -752,7 +757,8 @@ inputForm limit Just (_, boundary) -> do src <- inputLBS limit case parse (multipartFormP boundary) src of - (# Success fdList, _ #) -> return fdList + (# Success formList, _ #) + -> return formList (# _, _ #) -> abort BadRequest [] (Just "Unparsable multipart/form-data") diff --git a/examples/Multipart.hs b/examples/Multipart.hs index 3897dfb..69c4125 100644 --- a/examples/Multipart.hs +++ b/examples/Multipart.hs @@ -1,5 +1,4 @@ import qualified Data.ByteString.Lazy.Char8 as L8 -import Data.List import Data.Maybe import Network.HTTP.Lucu @@ -28,9 +27,9 @@ resMain , resHead = Nothing , resPost = Just $ do form <- inputForm defaultLimit - let text = fromMaybe L8.empty $ fmap fdContent $ find ((== "text") . fdName) form - file = fromMaybe L8.empty $ fmap fdContent $ find ((== "file") . fdName) form - fileName = fdFileName =<< find ((== "file") . fdName) form + let text = fromMaybe L8.empty $ fmap fdContent $ lookup "text" form + file = fromMaybe L8.empty $ fmap fdContent $ lookup "file" form + fileName = fdFileName =<< lookup "file" form setContentType $ read "text/plain" outputChunk ("You entered \"" ++ L8.unpack text ++ "\".\n") outputChunk ("You uploaded a " ++ show (L8.length file) ++ " bytes long file.\n")