@@ -0,0 +1,20 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Network.Wai.Middleware.MethodOverridePost ( methodOverridePost) where
4+
5+import Network.Wai
6+import Data.Monoid (mconcat)
7+import Data.Conduit.Lazy (lazyConsume)
8+import Network.HTTP.Types (parseQuery)
9+import Control.Monad.Trans.Resource (ResourceT)
10+
11+methodOverridePost :: Middleware
12+methodOverridePost app req = do
13+ case lookup "Content-Type" (requestHeaders req) of Just "application/x-www-form-urlencoded" -> setPost req >>= app
14+ _ -> app req
15+
16+setPost :: Request -> ResourceT IO Request
17+setPost req = do
18+ body <- lazyConsume (requestBody req)
19+ case parseQuery $ mconcat body of (("method_", Just newmethod):_) -> return $ req {requestMethod = newmethod}
20+ _ -> return req