diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,25 +1,20 @@ -The following license covers this documentation, and the source code, except -where otherwise indicated. - -Copyright 2010, Michael Snoyman. All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ -* Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: -* Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO -EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, -OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Network/Wai/Middleware/MethodOverridePost.hs b/Network/Wai/Middleware/MethodOverridePost.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Middleware/MethodOverridePost.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} +----------------------------------------------------------------- +-- | Module : Network.Wai.Middleware.MethodOverridePost +-- +-- Changes the request-method via first post-parameter _method. +----------------------------------------------------------------- +module Network.Wai.Middleware.MethodOverridePost + ( methodOverridePost + ) where + +import Network.Wai +import Network.HTTP.Types (parseQuery) +import Data.Monoid (mconcat) +import Data.Conduit.Lazy (lazyConsume) +import Control.Monad.Trans.Resource (ResourceT) +import Data.Conduit.List (sourceList) + +-- | Allows overriding of the HTTP request method via the _method post string parameter. +-- +-- * Looks for the Content-Type requestHeader. +-- +-- * If the header is set to application/x-www-form-urlencoded +-- and the first POST parameter is _method +-- then it changes the request-method to the value of that +-- parameter. +-- +-- * This middlware only applies when the initial request method is POST. +-- +methodOverridePost :: Middleware +methodOverridePost app req = case (requestMethod req, lookup "Content-Type" (requestHeaders req)) of + ("POST", Just "application/x-www-form-urlencoded") -> setPost req >>= app + _ -> app req + +setPost :: Request -> ResourceT IO Request +setPost req = do + body <- lazyConsume (requestBody req) + case parseQuery (mconcat body) of + (("_method", Just newmethod):_) -> return $ req {requestBody = sourceList body, requestMethod = newmethod} + _ -> return $ req {requestBody = sourceList body} diff --git a/test/WaiExtraTest.hs b/test/WaiExtraTest.hs --- a/test/WaiExtraTest.hs +++ b/test/WaiExtraTest.hs @@ -21,6 +21,7 @@ import Network.Wai.Middleware.Vhost import Network.Wai.Middleware.Autohead import Network.Wai.Middleware.MethodOverride +import Network.Wai.Middleware.MethodOverridePost import Network.Wai.Middleware.AcceptOverride import Network.Wai.Middleware.RequestLogger (logCallback) import Codec.Compression.GZip (decompress) @@ -31,7 +32,6 @@ import Control.Monad.IO.Class (liftIO) import Data.Maybe (fromMaybe) import Network.HTTP.Types (parseSimpleQuery, status200) -import Data.Monoid (mappend) specs :: Specs specs = do @@ -53,6 +53,7 @@ it "vhost" caseVhost it "autohead" caseAutohead it "method override" caseMethodOverride + it "method override post" caseMethodOverridePost it "accept override" caseAcceptOverride it "dalvik multipart" caseDalvikMultipart it "debug request body" caseDebugRequestBody @@ -353,6 +354,32 @@ , queryString = [("_method", Just "PUT")] } assertHeader "Method" "PUT" sres3 + +mopApp :: Application +mopApp = methodOverridePost $ \req -> return $ responseLBS status200 [("Method", requestMethod req)] "" + +caseMethodOverridePost :: Assertion +caseMethodOverridePost = flip runSession mopApp $ do + + -- Get Request are unmodified + sres1 <- let r = toRequest "application/x-www-form-urlencoded" "_method=PUT&foo=bar&baz=bin" + s = simpleRequest r + m = s { requestMethod = "GET" } + b = r { simpleRequest = m } + in srequest b + assertHeader "Method" "GET" sres1 + + -- Post requests are modified if _method comes first + sres2 <- srequest $ toRequest "application/x-www-form-urlencoded" "_method=PUT&foo=bar&baz=bin" + assertHeader "Method" "PUT" sres2 + + -- Post requests are unmodified if _method doesn't come first + sres3 <- srequest $ toRequest "application/x-www-form-urlencoded" "foo=bar&_method=PUT&baz=bin" + assertHeader "Method" "POST" sres3 + + -- Post requests are unmodified if Content-Type header isn't set to "application/x-www-form-urlencoded" + sres4 <- srequest $ toRequest "text/html; charset=utf-8" "foo=bar&_method=PUT&baz=bin" + assertHeader "Method" "POST" sres4 aoApp :: Application aoApp = acceptOverride $ \req -> return $ responseLBS status200 diff --git a/wai-extra.cabal b/wai-extra.cabal --- a/wai-extra.cabal +++ b/wai-extra.cabal @@ -1,5 +1,5 @@ Name: wai-extra -Version: 1.2.0.3 +Version: 1.2.0.4 Synopsis: Provides some basic WAI handlers and middleware. Description: The goal here is to provide common features without many dependencies. License: MIT @@ -21,7 +21,7 @@ Library Build-Depends: base >= 4 && < 5 - , bytestring >= 0.9.1.4 && < 0.10 + , bytestring >= 0.9.1.4 , wai >= 1.2 && < 1.3 , old-locale >= 1.0.0.2 && < 1.1 , time >= 1.1.4 @@ -38,6 +38,7 @@ , zlib-conduit >= 0.4 && < 0.5 , blaze-builder-conduit >= 0.4 && < 0.5 , ansi-terminal + , resourcet >= 0.3 && < 0.4 Exposed-modules: Network.Wai.Handler.CGI Network.Wai.Middleware.AcceptOverride @@ -47,6 +48,7 @@ Network.Wai.Middleware.Gzip Network.Wai.Middleware.Jsonp Network.Wai.Middleware.MethodOverride + Network.Wai.Middleware.MethodOverridePost Network.Wai.Middleware.Rewrite Network.Wai.Middleware.Vhost Network.Wai.Parse @@ -61,7 +63,7 @@ build-depends: base >= 4 && < 5 , wai-extra , wai-test - , hspec >= 0.8 && < 0.10 + , hspec >= 0.8 && < 1.2 , HUnit , wai