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 <pho at cielonegro dot org>
+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.*
-- [/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.
--
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
}
value
-multipartFormP :: String -> Parser [FormData]
+multipartFormP :: String -> Parser [(String, FormData)]
multipartFormP boundary
= do parts <- many (partP boundary)
_ <- string "--"
_ <- string "--"
_ <- crlf
eof
- return $ map partToFormData parts
+ return $ map partToFormPair parts
partP :: String -> Parser Part
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
-- 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
-- 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
++ 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
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")
import qualified Data.ByteString.Lazy.Char8 as L8
-import Data.List
import Data.Maybe
import Network.HTTP.Lucu
, 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")