git.iko.soy/typeable/wai
on master help sign in
Added vhost middleware
c532e80Michael Snoyman
Network/Wai/Middleware/Vhost.hsnew file+9
compare with master
unifiedsplit
@@ -0,0 +1,9 @@
1+module Network.Wai.Middleware.Vhost (vhost) where
2+
3+import Network.Wai
4+
5+vhost :: [(Request -> Bool, Application)] -> Application -> Application
6+vhost vhosts def req =
7+ case filter (\(b, _) -> b req) vhosts of
8+ [] -> def req
9+ (_, app):_ -> app req
runtests.hs+20
@@ -13,6 +13,7 @@ import Control.Arrow
13
13
14import Network.Wai.Middleware.Jsonp
14import Network.Wai.Middleware.Jsonp
15import Network.Wai.Middleware.Gzip
15import Network.Wai.Middleware.Gzip
16+import Network.Wai.Middleware.Vhost
16import Codec.Compression.GZip (decompress)
17import Codec.Compression.GZip (decompress)
17
18
18import Data.Enumerator (run_, enumList, ($$))
19import Data.Enumerator (run_, enumList, ($$))
@@ -34,6 +35,7 @@ testSuite = testGroup "Network.Wai.Parse"
34 , testCase "takeLine" caseTakeLine
35 , testCase "takeLine" caseTakeLine
35 , testCase "jsonp" caseJsonp
36 , testCase "jsonp" caseJsonp
36 , testCase "gzip" caseGzip
37 , testCase "gzip" caseGzip
38+ , testCase "vhost" caseVhost
37 ]
39 ]
38
40
39caseParseQueryString :: Assertion
41caseParseQueryString :: Assertion
@@ -242,3 +244,21 @@ caseGzip = flip runSession gzipApp $ do
242 }
244 }
243 assertNoHeader "Content-Encoding" sres2
245 assertNoHeader "Content-Encoding" sres2
244 assertBody "test" sres2
246 assertBody "test" sres2
247+
248+vhostApp1 = const $ return $ responseLBS status200 [] "app1"
249+vhostApp2 = const $ return $ responseLBS status200 [] "app2"
250+vhostApp = vhost
251+ [ ((== "foo.com") . serverName, vhostApp1)
252+ ]
253+ vhostApp2
254+
255+caseVhost = flip runSession vhostApp $ do
256+ sres1 <- request Request
257+ { serverName = "foo.com"
258+ }
259+ assertBody "app1" sres1
260+
261+ sres2 <- request Request
262+ { serverName = "bar.com"
263+ }
264+ assertBody "app2" sres2