diff --git a/Hack/Middleware/MethodOverride.hs b/Hack/Middleware/MethodOverride.hs new file mode 100644 index 00000000..940c168d --- /dev/null +++ b/Hack/Middleware/MethodOverride.hs @@ -0,0 +1,37 @@ +--------------------------------------------------------- +-- | +-- Module : Hack.Middleware.MethodOverride +-- Copyright : Michael Snoyman +-- License : BSD3 +-- +-- Maintainer : Michael Snoyman +-- Stability : Unstable +-- Portability : portable +-- +-- Override the HTTP method based on either: +-- The X-HTTP-Method-Override header. +-- The _method_override GET parameter. +-- +--------------------------------------------------------- +module Hack.Middleware.MethodOverride (methodOverride) where + +import Hack +import Web.Encodings (decodeUrlPairs) +import Data.Monoid (mappend) + +methodOverride :: Middleware +methodOverride app env = do + let mo1 = lookup "X-HTTP-Method-Override" $ http env + gets = decodeUrlPairs $ queryString env + mo2 = lookup "_method_override" gets + cm = requestMethod env + app $ + case mo1 `mappend` mo2 of + Nothing -> env + Just nm -> env { requestMethod = safeRead cm nm } + +safeRead :: Read a => a -> String -> a +safeRead d s = + case reads s of + ((x, _):_) -> x + [] -> d diff --git a/README.md b/README.md index e84ad30e..21c4cc8d 100644 --- a/README.md +++ b/README.md @@ -14,11 +14,14 @@ PUT: Replace data on server. DELETE: Remove data from server. POST: Some form of update. -FIXME Note: not all clients support PUT and DELETE. Therefore, we need a -workaround. I will implement two fixes: +Note: not all clients support PUT and DELETE. Therefore, we need a +workaround. There are two fixes: 1. X-HTTP-Method-Override header. -2. Get parameter (ie, in the query string). This will be more useful for web forms. +2. Get parameter _method_override (ie, in the query string). This will be more +useful for web forms. + +See MethodOverride middleware. ## Resource diff --git a/Web/Restful/Application.hs b/Web/Restful/Application.hs index 84c30672..dc9679fa 100644 --- a/Web/Restful/Application.hs +++ b/Web/Restful/Application.hs @@ -47,6 +47,7 @@ import Hack.Middleware.Gzip import Hack.Middleware.CleanPath import Hack.Middleware.Jsonp import Hack.Middleware.ClientSession +import Hack.Middleware.MethodOverride import Control.Applicative ((<$>), Applicative (..)) import Control.Arrow (second) @@ -80,7 +81,12 @@ instance Default ApplicationSettings where , rpxnowApiKey = Nothing , encryptKey = Left defaultKeyFile , urlRewriter = \s -> (s, []) - , hackMiddleware = [gzip, cleanPath, jsonp] + , hackMiddleware = + [ gzip + , cleanPath + , jsonp + , methodOverride + ] , response404 = default404 , htmlWrapper = id }