git.iko.soy/typeable/wai
on master help sign in
Added vhost middleware
commitc532e809684462aa35c92c396fbd27232f71c1cb authorMichael Snoyman <michael@snoyman.com> dateMon 27 Dec 2010, 16:34 (16 years ago) parentf910ffd
2 files changed+29
compare with master
unifiedsplit
Network/Wai/Middleware/Vhost.hs+9 runtests.hs+20
Network/Wai/Middleware/Vhost.hsnew file+9
@@ -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
1313
1414import Network.Wai.Middleware.Jsonp
1515import Network.Wai.Middleware.Gzip
16+import Network.Wai.Middleware.Vhost
1617import Codec.Compression.GZip (decompress)
1718
1819import Data.Enumerator (run_, enumList, ($$))
@@ -34,6 +35,7 @@ testSuite = testGroup "Network.Wai.Parse"
3435 , testCase "takeLine" caseTakeLine
3536 , testCase "jsonp" caseJsonp
3637 , testCase "gzip" caseGzip
38+ , testCase "vhost" caseVhost
3739 ]
3840
3941caseParseQueryString :: Assertion
@@ -242,3 +244,21 @@ caseGzip = flip runSession gzipApp $ do
242244 }
243245 assertNoHeader "Content-Encoding" sres2
244246 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