git.iko.soy/typeable/wai
on master help sign in
ForceSSL: preserve port number when redirecting to https://.
commitbf6fedbad787fb4f3666427076c666e0d804ab63 authorDominik Bollmann <bollmann@seas.upenn.edu> dateSat 24 Sep 2016, 17:20 (10 years ago) parent9e3e1be
2 files changed+11−11
compare with master
unifiedsplit
wai-extra/Network/Wai/Middleware/ForceSSL.hs+2−6 wai-extra/test/Network/Wai/Middleware/ForceSSLSpec.hs+9−5
wai-extra/Network/Wai/Middleware/ForceSSL.hs+2−6
@@ -17,7 +17,6 @@ import Data.Monoid (mempty)
1717import Data.Monoid ((<>))
1818import Network.HTTP.Types (hLocation, methodGet, status301, status307)
1919
20−import qualified Data.ByteString as S
2120import Data.Word8 (_colon)
2221
2322-- | For requests that don't appear secure, redirect to https
@@ -31,13 +30,10 @@ forceSSL app req sendResponse =
3130
3231redirectResponse :: Request -> Maybe Response
3332redirectResponse req = do
34− (host, _) <- S.break (== _colon) <$> requestHeaderHost req
35−
36− return $ responseBuilder status [(hLocation, location host)] mempty
37−
33+ host <- requestHeaderHost req
34+ return $ responseBuilder status [(hLocation, location host)] mempty
3835 where
3936 location h = "https://" <> h <> rawPathInfo req <> rawQueryString req
40−
4137 status
4238 | requestMethod req == methodGet = status301
4339 | otherwise = status307
wai-extra/test/Network/Wai/Middleware/ForceSSLSpec.hs+9−5
@@ -8,6 +8,7 @@ import Test.Hspec
88
99import Network.Wai.Middleware.ForceSSL
1010
11+import Control.Monad
1112import Data.ByteString (ByteString)
1213import Data.Monoid ((<>))
1314import Network.HTTP.Types (methodPost, status200, status301, status307)
@@ -18,8 +19,12 @@ main :: IO ()
1819main = hspec spec
1920
2021spec :: Spec
21−spec = describe "forceSSL" $ do
22− let host = "example.com"
22+spec = describe "forceSSL" (forM_ hosts $ \host -> hostSpec host)
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
2328
2429 it "redirects non-https requests to https" $ do
2530 resp <- runApp host forceSSL defaultRequest
@@ -39,7 +44,7 @@ spec = describe "forceSSL" $ do
3944
4045 simpleStatus resp `shouldBe` status200
4146
42− it "preserves the original path and query string" $ do
47+ it "preserves the original host, path, and query string" $ do
4348 resp <- runApp host forceSSL defaultRequest
4449 { rawPathInfo = "/foo/bar"
4550 , rawQueryString = "?baz=bat"
@@ -50,7 +55,6 @@ spec = describe "forceSSL" $ do
5055
5156runApp :: ByteString -> Middleware -> Request -> IO SResponse
5257runApp host mw req = runSession
53− (request req { requestHeaderHost = Just $ host <> ":80" }) $ mw app
54−
58+ (request req { requestHeaderHost = Just host }) $ mw app
5559 where
5660 app _ respond = respond $ responseLBS status200 [] ""