X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource.hs;h=a9d487c0908188dbe1c5ad4294a5b224778e7ec2;hp=3a27e9ca5e1acbe786d83a949e7711c6d0657ffb;hb=a2a726f3581933cea2d805b76aca0e93da778994;hpb=e2a6ee839c0ca27b25b32656a5c080e4b464e7c9 diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs index 3a27e9c..a9d487c 100644 --- a/Network/HTTP/Lucu/Resource.hs +++ b/Network/HTTP/Lucu/Resource.hs @@ -61,7 +61,8 @@ module Network.HTTP.Lucu.Resource ( -- * Monad - Resource + Resource + , FormData(..) , runRes -- private -- * Actions @@ -302,9 +303,17 @@ getPathInfo = do rsrcPath <- getResourcePath -- | 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 [(String, String)] +getQueryForm :: Resource [FormData] getQueryForm = do uri <- getRequestURI - return $! parseWWWFormURLEncoded $ snd $ splitAt 1 $ uriQuery uri + return $! map pairToFormData $ parseWWWFormURLEncoded $ snd $ splitAt 1 $ uriQuery uri + +pairToFormData :: (String, String) -> FormData +pairToFormData (name, value) + = FormData { + fdName = name + , fdFileName = Nothing + , fdContent = value + } -- |Get a value of given request header. Comparison of header name is -- case-insensitive. Note that this action is not intended to be used @@ -716,7 +725,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 [(String, String)] +inputForm :: Int -> Resource [FormData] inputForm limit = limit `seq` do cTypeM <- getContentType @@ -733,7 +742,7 @@ inputForm limit where readWWWFormURLEncoded = do src <- input limit - return $ parseWWWFormURLEncoded src + return $ map pairToFormData $ parseWWWFormURLEncoded src readMultipartFormData params = do case find ((== "boundary") . map toLower . fst) params of @@ -742,7 +751,7 @@ inputForm limit Just (_, boundary) -> do src <- inputLBS limit case parse (multipartFormP boundary) src of - (# Success pairs, _ #) -> return pairs + (# Success fdList, _ #) -> return fdList (# _, _ #) -> abort BadRequest [] (Just "Unparsable multipart/form-data")