9a69864 · typeable/wai

git.iko.soy/typeable/wai

ForceSSL cleanups

* Use Data.Word8 (more efficient than Data.ByteString.Char8) * Use mempty (older blaze-builder does not have an IsString instance) * Update ChangeLog Pinging @pbrisbin

commit9a69864daf59eabda1d02a97e8d2cde57334f6f9 authorMichael Snoyman <michael@snoyman.com> dateThu 9 Apr 2015, 09:23 (12 years ago) parent4d46f08

2 files changed+10−3

compare with master

unifiedsplit

wai-extra/ChangeLog.md+1 wai-extra/Network/Wai/Middleware/ForceSSL.hs+9−3

wai-extra/ChangeLog.md+1

@@ -2,6 +2,7 @@

33* Add appearsSecure: check if a request appears to be using SSL even in the

44 presence of reverse proxies [#362](https://github.com/yesodweb/wai/pull/362)

5+* Add ForceSSL middleware [#363](https://github.com/yesodweb/wai/pull/363)

67## 3.0.6.1

wai-extra/Network/Wai/Middleware/ForceSSL.hs+9−3

@@ -1,6 +1,8 @@

11{-# LANGUAGE CPP #-}

22{-# LANGUAGE OverloadedStrings #-}

33-- | Redirect non-SSL requests to https

4+--

5+-- Since 3.0.7

46module Network.Wai.Middleware.ForceSSL

57 ( forceSSL

68 ) where

@@ -10,14 +12,18 @@ import Network.Wai.Request

1012

1113#if __GLASGOW_HASKELL__ < 710

1214import Control.Applicative ((<$>))

15+import Data.Monoid (mempty)

1316#endif

1417

1518import Data.Monoid ((<>))

1619import Network.HTTP.Types (hLocation, methodGet, status301, status307)

1720

18−import qualified Data.ByteString.Char8 as C

21+import qualified Data.ByteString as S

22+import Data.Word8 (_colon)

1923

2024-- | For requests that don't appear secure, redirect to https

25+--

26+-- Since 3.0.7

2127forceSSL :: Middleware

2228forceSSL app req sendResponse =

2329 case (appearsSecure req, redirectResponse req) of

@@ -26,9 +32,9 @@ forceSSL app req sendResponse =

2632

2733redirectResponse :: Request -> Maybe Response

2834redirectResponse req = do

29− (host:_) <- C.split ':' <$> requestHeaderHost req

35+ (host, _) <- S.break (== _colon) <$> requestHeaderHost req

3036

31− return $ responseBuilder status [(hLocation, location host)] ""

37+ return $ responseBuilder status [(hLocation, location host)] mempty

3238

3339 where

3440 location h = "https://" <> h <> rawPathInfo req <> rawQueryString req