git.iko.soy/typeable/wai
on master help sign in
Merge pull request #64 from sordina/master

Adding ability to override POST request method from the first field of url-encoded post-data

commit0eb6c8a121d3f5cc35a882640372aca007699a51 authorMichael Snoyman <michael@snoyman.com> dateSat 28 Apr 2012, 23:52 (14 years ago) parente6d9281c64992c
3 files changed+69−1
compare with master
unifiedsplit
wai-extra/Network/Wai/Middleware/MethodOverridePost.hs+39 wai-extra/test/WaiExtraTest.hs+28−1 wai-extra/wai-extra.cabal+2
wai-extra/Network/Wai/Middleware/MethodOverridePost.hsnew file+39
@@ -0,0 +1,39 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+-----------------------------------------------------------------
3+-- | Module : Network.Wai.Middleware.MethodOverridePost
4+--
5+-- Changes the request-method via first post-parameter _method.
6+-----------------------------------------------------------------
7+module Network.Wai.Middleware.MethodOverridePost
8+ ( methodOverridePost
9+ ) where
10+
11+import Network.Wai
12+import Network.HTTP.Types (parseQuery)
13+import Data.Monoid (mconcat)
14+import Data.Conduit.Lazy (lazyConsume)
15+import Control.Monad.Trans.Resource (ResourceT)
16+import Data.Conduit.List (sourceList)
17+
18+-- | Allows overriding of the HTTP request method via the _method post string parameter.
19+--
20+-- * Looks for the Content-Type requestHeader.
21+--
22+-- * If the header is set to application/x-www-form-urlencoded
23+-- and the first POST parameter is _method
24+-- then it changes the request-method to the value of that
25+-- parameter.
26+--
27+-- * This middlware only applies when the initial request method is POST.
28+--
29+methodOverridePost :: Middleware
30+methodOverridePost app req = case (requestMethod req, lookup "Content-Type" (requestHeaders req)) of
31+ ("POST", Just "application/x-www-form-urlencoded") -> setPost req >>= app
32+ _ -> app req
33+
34+setPost :: Request -> ResourceT IO Request
35+setPost req = do
36+ body <- lazyConsume (requestBody req)
37+ case parseQuery (mconcat body) of
38+ (("_method", Just newmethod):_) -> return $ req {requestBody = sourceList body, requestMethod = newmethod}
39+ _ -> return $ req {requestBody = sourceList body}
wai-extra/test/WaiExtraTest.hs+28−1
@@ -21,6 +21,7 @@ import Network.Wai.Middleware.Gzip
2121import Network.Wai.Middleware.Vhost
2222import Network.Wai.Middleware.Autohead
2323import Network.Wai.Middleware.MethodOverride
24+import Network.Wai.Middleware.MethodOverridePost
2425import Network.Wai.Middleware.AcceptOverride
2526import Network.Wai.Middleware.RequestLogger (logCallback)
2627import Codec.Compression.GZip (decompress)
@@ -31,7 +32,6 @@ import Data.Conduit.Binary (sourceFile)
3132import Control.Monad.IO.Class (liftIO)
3233import Data.Maybe (fromMaybe)
3334import Network.HTTP.Types (parseSimpleQuery, status200)
34−import Data.Monoid (mappend)
3535
3636specs :: Specs
3737specs = do
@@ -53,6 +53,7 @@ specs = do
5353 it "vhost" caseVhost
5454 it "autohead" caseAutohead
5555 it "method override" caseMethodOverride
56+ it "method override post" caseMethodOverridePost
5657 it "accept override" caseAcceptOverride
5758 it "dalvik multipart" caseDalvikMultipart
5859 it "debug request body" caseDebugRequestBody
@@ -354,6 +355,32 @@ caseMethodOverride = flip runSession moApp $ do
354355 }
355356 assertHeader "Method" "PUT" sres3
356357
358+mopApp :: Application
359+mopApp = methodOverridePost $ \req -> return $ responseLBS status200 [("Method", requestMethod req)] ""
360+
361+caseMethodOverridePost :: Assertion
362+caseMethodOverridePost = flip runSession mopApp $ do
363+
364+ -- Get Request are unmodified
365+ sres1 <- let r = toRequest "application/x-www-form-urlencoded" "_method=PUT&foo=bar&baz=bin"
366+ s = simpleRequest r
367+ m = s { requestMethod = "GET" }
368+ b = r { simpleRequest = m }
369+ in srequest b
370+ assertHeader "Method" "GET" sres1
371+
372+ -- Post requests are modified if _method comes first
373+ sres2 <- srequest $ toRequest "application/x-www-form-urlencoded" "_method=PUT&foo=bar&baz=bin"
374+ assertHeader "Method" "PUT" sres2
375+
376+ -- Post requests are unmodified if _method doesn't come first
377+ sres3 <- srequest $ toRequest "application/x-www-form-urlencoded" "foo=bar&_method=PUT&baz=bin"
378+ assertHeader "Method" "POST" sres3
379+
380+ -- Post requests are unmodified if Content-Type header isn't set to "application/x-www-form-urlencoded"
381+ sres4 <- srequest $ toRequest "text/html; charset=utf-8" "foo=bar&_method=PUT&baz=bin"
382+ assertHeader "Method" "POST" sres4
383+
357384aoApp :: Application
358385aoApp = acceptOverride $ \req -> return $ responseLBS status200
359386 [("Accept", fromMaybe "" $ lookup "Accept" $ requestHeaders req)] ""
wai-extra/wai-extra.cabal+2
@@ -38,6 +38,7 @@ Library
3838 , zlib-conduit >= 0.4 && < 0.5
3939 , blaze-builder-conduit >= 0.4 && < 0.5
4040 , ansi-terminal
41+ , resourcet >= 0.3 && < 0.4
4142
4243 Exposed-modules: Network.Wai.Handler.CGI
4344 Network.Wai.Middleware.AcceptOverride
@@ -47,6 +48,7 @@ Library
4748 Network.Wai.Middleware.Gzip
4849 Network.Wai.Middleware.Jsonp
4950 Network.Wai.Middleware.MethodOverride
51+ Network.Wai.Middleware.MethodOverridePost
5052 Network.Wai.Middleware.Rewrite
5153 Network.Wai.Middleware.Vhost
5254 Network.Wai.Parse