git.iko.soy/typeable/wai
on master help sign in
Added autohead middleware
commit91f36cfa129511ed2a41e835247e63a350b91db9 authorMichael Snoyman <michael@snoyman.com> dateMon 27 Dec 2010, 16:55 (16 years ago) parentc532e80
3 files changed+42
compare with master
unifiedsplit
Network/Wai/Middleware/Autohead.hs+22 runtests.hs+18 wai-extra.cabal+2
Network/Wai/Middleware/Autohead.hsnew file+22
@@ -0,0 +1,22 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+-- | Automatically produce responses to HEAD requests based on the underlying
3+-- applications GET response.
4+module Network.Wai.Middleware.Autohead (autohead) where
5+
6+import Network.Wai
7+import Data.Monoid (mempty)
8+import Data.Enumerator (enumEOF, ($$))
9+
10+autohead :: Middleware
11+autohead app req
12+ | requestMethod req == "HEAD" = do
13+ res <- app req { requestMethod = "GET" }
14+ case res of
15+ ResponseFile s hs _ -> return $ responseBuilder s hs mempty
16+ ResponseEnumerator e -> do
17+ let helper f =
18+ let helper' s hs = enumEOF $$ f s hs
19+ in e helper'
20+ return $ ResponseEnumerator helper
21+ | otherwise = app req
22+
runtests.hs+18
@@ -14,6 +14,7 @@ import Control.Arrow
1414import Network.Wai.Middleware.Jsonp
1515import Network.Wai.Middleware.Gzip
1616import Network.Wai.Middleware.Vhost
17+import Network.Wai.Middleware.Autohead
1718import Codec.Compression.GZip (decompress)
1819
1920import Data.Enumerator (run_, enumList, ($$))
@@ -36,6 +37,7 @@ testSuite = testGroup "Network.Wai.Parse"
3637 , testCase "jsonp" caseJsonp
3738 , testCase "gzip" caseGzip
3839 , testCase "vhost" caseVhost
40+ , testCase "autohead" caseAutohead
3941 ]
4042
4143caseParseQueryString :: Assertion
@@ -262,3 +264,19 @@ caseVhost = flip runSession vhostApp $ do
262264 { serverName = "bar.com"
263265 }
264266 assertBody "app2" sres2
267+
268+autoheadApp = autohead $ const $ return $ responseLBS status200
269+ [("Foo", "Bar")] "body"
270+
271+caseAutohead = flip runSession autoheadApp $ do
272+ sres1 <- request Request
273+ { requestMethod = "GET"
274+ }
275+ assertHeader "Foo" "Bar" sres1
276+ assertBody "body" sres1
277+
278+ sres1 <- request Request
279+ { requestMethod = "HEAD"
280+ }
281+ assertHeader "Foo" "Bar" sres1
282+ assertBody "" sres1
wai-extra.cabal+2
@@ -26,9 +26,11 @@ Library
2626 enumerator >= 0.4 && < 0.5,
2727 blaze-builder >= 0.2.1.3 && < 0.3
2828 Exposed-modules: Network.Wai.Handler.CGI
29+ Network.Wai.Middleware.Autohead
2930 Network.Wai.Middleware.CleanPath
3031 Network.Wai.Middleware.Gzip
3132 Network.Wai.Middleware.Jsonp
33+ Network.Wai.Middleware.Vhost
3234 Network.Wai.Zlib
3335 Network.Wai.Parse
3436 ghc-options: -Wall