git.iko.soy/typeable/wai
on master help sign in
Add Network.Wai.Request.appearsSecure to wai-extra

First checks isSecure, then checks various Headers that can indicate a secure request even in the presence of a reverse proxy.

commiteabe0fdedd081f59e3853e2716c7d4627f4f914c authorpatrick brisbin <pbrisbin@gmail.com> dateTue 7 Apr 2015, 15:05 (12 years ago) parent9d56717
3 files changed+98
compare with master
unifiedsplit
wai-extra/Network/Wai/Request.hs+34 wai-extra/test/Network/Wai/RequestSpec.hs+63 wai-extra/wai-extra.cabal+1
wai-extra/Network/Wai/Request.hsnew file+34
@@ -0,0 +1,34 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+-- | Some helpers for interrogating a WAI 'Request'.
3+
4+module Network.Wai.Request
5+ ( appearsSecure
6+ ) where
7+
8+import Data.ByteString (ByteString)
9+import Network.HTTP.Types (HeaderName)
10+import Network.Wai (Request, isSecure, requestHeaders)
11+
12+import qualified Data.ByteString.Char8 as C
13+
14+-- | Does this request appear to have been made over an SSL connection?
15+--
16+-- This function first checks @'isSecure'@, but also checks for headers that may
17+-- indicate a secure connection even in the presence of reverse proxies.
18+--
19+-- Note: these headers can be easily spoofed, so decisions which require a true
20+-- SSL connection (i.e. sending sensitive information) should only use
21+-- @'isSecure'@. This is not always the case though: for example, deciding to
22+-- force a non-SSL request to SSL by redirect. One can safely choose not to
23+-- redirect when the request /appears/ secure, even if it's actually not.
24+appearsSecure :: Request -> Bool
25+appearsSecure request = isSecure request || any (uncurry matchHeader)
26+ [ ("HTTPS" , (== "on"))
27+ , ("HTTP_X_FORWARDED_SSL" , (== "on"))
28+ , ("HTTP_X_FORWARDED_SCHEME", (== "https"))
29+ , ("HTTP_X_FORWARDED_PROTO" , ((== ["https"]) . take 1 . C.split ','))
30+ ]
31+
32+ where
33+ matchHeader :: HeaderName -> (ByteString -> Bool) -> Bool
34+ matchHeader h f = maybe False f $ lookup h $ requestHeaders request
wai-extra/test/Network/Wai/RequestSpec.hsnew file+63
@@ -0,0 +1,63 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Network.Wai.RequestSpec
3+ ( main
4+ , spec
5+ ) where
6+
7+import Test.Hspec
8+
9+import Data.ByteString (ByteString)
10+import Network.HTTP.Types (HeaderName)
11+import Network.Wai (Request(..), defaultRequest)
12+
13+import Network.Wai.Request
14+
15+main :: IO ()
16+main = hspec spec
17+
18+spec :: Spec
19+spec = describe "appearsSecure" $ do
20+ let insecureRequest = defaultRequest
21+ { isSecure = False
22+ , requestHeaders =
23+ [ ("HTTPS", "off")
24+ , ("HTTP_X_FORWARDED_SSL", "off")
25+ , ("HTTP_X_FORWARDED_SCHEME", "http")
26+ , ("HTTP_X_FORWARDED_PROTO", "http,xyz")
27+ ]
28+ }
29+
30+ it "returns False for an insecure request" $
31+ insecureRequest `shouldSatisfy` not . appearsSecure
32+
33+ it "checks if the Request is actually secure" $ do
34+ let req = insecureRequest { isSecure = True }
35+
36+ req `shouldSatisfy` appearsSecure
37+
38+ it "checks for HTTP: on" $ do
39+ let req = addHeader "HTTPS" "on" insecureRequest
40+
41+ req `shouldSatisfy` appearsSecure
42+
43+ it "checks for HTTP_X_FORWARDED_SSL: on" $ do
44+ let req = addHeader "HTTP_X_FORWARDED_SSL" "on" insecureRequest
45+
46+ req `shouldSatisfy` appearsSecure
47+
48+ it "checks for HTTP_X_FORWARDED_SCHEME: https" $ do
49+ let req = addHeader "HTTP_X_FORWARDED_SCHEME" "https" insecureRequest
50+
51+ req `shouldSatisfy` appearsSecure
52+
53+ it "checks for HTTP_X_FORWARDED_PROTO: https,..." $ do
54+ let req = addHeader "HTTP_X_FORWARDED_PROTO" "https,xyz" insecureRequest
55+
56+ req `shouldSatisfy` appearsSecure
57+
58+addHeader :: HeaderName -> ByteString -> Request -> Request
59+addHeader name value req = req
60+ { requestHeaders = (name, value) : otherHeaders }
61+
62+ where
63+ otherHeaders = filter ((/= name) . fst) $ requestHeaders req
wai-extra/wai-extra.cabal+1
@@ -132,6 +132,7 @@ Library
132132 Network.Wai.Middleware.HttpAuth
133133 Network.Wai.Middleware.StreamFile
134134 Network.Wai.Parse
135+ Network.Wai.Request
135136 Network.Wai.UrlMap
136137 Network.Wai.Test
137138 Network.Wai.EventSource