git.iko.soy/typeable/wai
on master help sign in
ForceSSL: preserve port number when redirecting to https://.
bf6fedbDominik Bollmann
wai-extra/Network/Wai/Middleware/ForceSSL.hs+2−6
compare with master
unifiedsplit
@@ -17,7 +17,6 @@ import Data.Monoid (mempty)
17import Data.Monoid ((<>))
17import Data.Monoid ((<>))
18import Network.HTTP.Types (hLocation, methodGet, status301, status307)
18import Network.HTTP.Types (hLocation, methodGet, status301, status307)
19
19
20−import qualified Data.ByteString as S
21import Data.Word8 (_colon)
20import Data.Word8 (_colon)
22
21
23-- | For requests that don't appear secure, redirect to https
22-- | For requests that don't appear secure, redirect to https
@@ -31,13 +30,10 @@ forceSSL app req sendResponse =
31
30
32redirectResponse :: Request -> Maybe Response
31redirectResponse :: Request -> Maybe Response
33redirectResponse req = do
32redirectResponse req = do
34− (host, _) <- S.break (== _colon) <$> requestHeaderHost req
33+ host <- requestHeaderHost req
35−
36− return $ responseBuilder status [(hLocation, location host)] mempty
34+ return $ responseBuilder status [(hLocation, location host)] mempty
37−
38 where
35 where
39 location h = "https://" <> h <> rawPathInfo req <> rawQueryString req
36 location h = "https://" <> h <> rawPathInfo req <> rawQueryString req
40−
41 status
37 status
42 | requestMethod req == methodGet = status301
38 | requestMethod req == methodGet = status301
43 | otherwise = status307
39 | otherwise = status307
wai-extra/test/Network/Wai/Middleware/ForceSSLSpec.hs+9−5
@@ -8,6 +8,7 @@ import Test.Hspec
8
8
9import Network.Wai.Middleware.ForceSSL
9import Network.Wai.Middleware.ForceSSL
10
10
11+import Control.Monad
11import Data.ByteString (ByteString)
12import Data.ByteString (ByteString)
12import Data.Monoid ((<>))
13import Data.Monoid ((<>))
13import Network.HTTP.Types (methodPost, status200, status301, status307)
14import Network.HTTP.Types (methodPost, status200, status301, status307)
@@ -18,8 +19,12 @@ main :: IO ()
18main = hspec spec
19main = hspec spec
19
20
20spec :: Spec
21spec :: Spec
21−spec = describe "forceSSL" $ do
22+spec = describe "forceSSL" (forM_ hosts $ \host -> hostSpec host)
22− let host = "example.com"
23+ where
24+ hosts = ["example.com", "example.com:80", "example.com:8080"]
25+
26+hostSpec :: ByteString -> Spec
27+hostSpec host = describe ("forceSSL on host " <> show host <> "") $ do
23
28
24 it "redirects non-https requests to https" $ do
29 it "redirects non-https requests to https" $ do
25 resp <- runApp host forceSSL defaultRequest
30 resp <- runApp host forceSSL defaultRequest
@@ -39,7 +44,7 @@ spec = describe "forceSSL" $ do
39
44
40 simpleStatus resp `shouldBe` status200
45 simpleStatus resp `shouldBe` status200
41
46
42− it "preserves the original path and query string" $ do
47+ it "preserves the original host, path, and query string" $ do
43 resp <- runApp host forceSSL defaultRequest
48 resp <- runApp host forceSSL defaultRequest
44 { rawPathInfo = "/foo/bar"
49 { rawPathInfo = "/foo/bar"
45 , rawQueryString = "?baz=bat"
50 , rawQueryString = "?baz=bat"
@@ -50,7 +55,6 @@ spec = describe "forceSSL" $ do
50
55
51runApp :: ByteString -> Middleware -> Request -> IO SResponse
56runApp :: ByteString -> Middleware -> Request -> IO SResponse
52runApp host mw req = runSession
57runApp host mw req = runSession
53− (request req { requestHeaderHost = Just $ host <> ":80" }) $ mw app
58+ (request req { requestHeaderHost = Just host }) $ mw app
54−
55 where
59 where
56 app _ respond = respond $ responseLBS status200 [] ""
60 app _ respond = respond $ responseLBS status200 [] ""