@@ -0,0 +1,53 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Network.Wai.Middleware.RoutedSpec
3+ ( main
4+ , spec
5+ ) where
6+
7+import Test.Hspec
8+
9+import Network.Wai.Middleware.Routed
10+import Network.Wai.Middleware.ForceSSL (forceSSL)
11+
12+import Network.HTTP.Types (methodPost, status200, status301, status307)
13+import Network.Wai
14+import Network.Wai.Test
15+import Data.ByteString (ByteString)
16+import Data.String (IsString)
17+
18+main :: IO ()
19+main = hspec spec
20+
21+spec :: Spec
22+spec = describe "forceSSL" $ do
23+ it "routed middleware" $ do
24+ let destination = "https://example.com/d/"
25+ let routedSslJsonApp prefix = routedMiddleware (checkPrefix prefix) forceSSL jsonApp
26+ checkPrefix p (p1:_) = p == p1
27+ checkPrefix _ _ = False
28+
29+ flip runSession (routedSslJsonApp "r") $ do
30+ res <- testDPath "http"
31+ assertNoHeader location res
32+ assertStatus 200 res
33+ assertBody "{\"foo\":\"bar\"}" res
34+
35+ flip runSession (routedSslJsonApp "d") $ do
36+ res2 <- testDPath "http"
37+ assertHeader location destination res2
38+ assertStatus 301 res2
39+
40+jsonApp :: Application
41+jsonApp _req cps = cps $ responseLBS status200
42+ [("Content-Type", "application/json")]
43+ "{\"foo\":\"bar\"}"
44+
45+testDPath :: ByteString -> Session SResponse
46+testDPath proto =
47+ request $ flip setRawPathInfo "/d/" defaultRequest
48+ { requestHeaders = [("X-Forwarded-Proto", proto)]
49+ , requestHeaderHost = Just "example.com"
50+ }
51+
52+location :: IsString ci => ci
53+location = "Location"