on master help sign in
MethodOverride
commitabf9643e1470bc643fe8102c6fd8a59a20528f54 authorMichael Snoyman <michael@snoyman.com> dateWed 2 Feb 2011, 12:15 (16 years ago) parentc6fbbbb
3 files changed+42−1
Network/Wai/Middleware/MethodOverride.hs+16 runtests.hs+24 wai-extra.cabal+2−1
Network/Wai/Middleware/MethodOverride.hsnew file+16
@@ -0,0 +1,16 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Network.Wai.Middleware.MethodOverride
3+ ( methodOverride
4+ ) where
5+
6+import Network.Wai
7+import Network.Wai.Parse (parseQueryString)
8+
9+methodOverride :: Middleware
10+methodOverride app req =
11+ app req'
12+ where
13+ req' =
14+ case lookup "_method" $ parseQueryString $ queryString req of
15+ Nothing -> req
16+ Just m -> req { requestMethod = m }
runtests.hs+24
@@ -16,6 +16,7 @@ import Network.Wai.Middleware.Jsonp
1616import Network.Wai.Middleware.Gzip
1717import Network.Wai.Middleware.Vhost
1818import Network.Wai.Middleware.Autohead
19+import Network.Wai.Middleware.MethodOverride
1920import Codec.Compression.GZip (decompress)
2021
2122import Data.Enumerator (run_, enumList, ($$), Iteratee)
@@ -39,6 +40,7 @@ testSuite = testGroup "Network.Wai.Parse"
3940 , testCase "gzip" caseGzip
4041 , testCase "vhost" caseVhost
4142 , testCase "autohead" caseAutohead
43+ , testCase "method override" caseMethodOverride
4244 ]
4345
4446caseParseQueryString :: Assertion
@@ -285,3 +287,25 @@ caseAutohead = flip runSession autoheadApp $ do
285287 }
286288 assertHeader "Foo" "Bar" sres1
287289 assertBody "" sres1
290+
291+moApp = methodOverride $ \req -> return $ responseLBS status200
292+ [("Method", requestMethod req)] ""
293+
294+caseMethodOverride = flip runSession moApp $ do
295+ sres1 <- request Request
296+ { requestMethod = "GET"
297+ , queryString = ""
298+ }
299+ assertHeader "Method" "GET" sres1
300+
301+ sres2 <- request Request
302+ { requestMethod = "POST"
303+ , queryString = ""
304+ }
305+ assertHeader "Method" "POST" sres2
306+
307+ sres3 <- request Request
308+ { requestMethod = "POST"
309+ , queryString = "_method=PUT"
310+ }
311+ assertHeader "Method" "PUT" sres3
wai-extra.cabal+2−1
@@ -1,5 +1,5 @@
11Name: wai-extra
2−Version: 0.3.0
2+Version: 0.3.1
33Synopsis: Provides some basic WAI handlers and middleware.
44Description: The goal here is to provide common features without many dependencies.
55License: BSD3
@@ -31,6 +31,7 @@ Library
3131 Network.Wai.Middleware.Debug
3232 Network.Wai.Middleware.Gzip
3333 Network.Wai.Middleware.Jsonp
34+ Network.Wai.Middleware.MethodOverride
3435 Network.Wai.Middleware.Vhost
3536 Network.Wai.Zlib
3637 Network.Wai.Parse