{-# LANGUAGE OverloadedStrings #-}
module EnforceHTTPSSpec where
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Middleware.EnforceHTTPS
import Network.Wai.Test
import Test.Hspec
app :: EnforceHTTPSConfig -> Application
app conf = withConfig conf $
-- reference to: https://en.wikipedia.org/wiki/Zork
\_ respond -> respond $ responseLBS status200 [] "Hello, sailor"
run :: EnforceHTTPSConfig -> Session a -> IO a
run = flip runSession . app
baseReq :: Request
baseReq =
defaultRequest { requestHeaderHost = Just "haskell.org" }
spec :: Spec
spec = do
describe "Default settings" defaultSettingsSpec
describe "`httpsHostname` setting" hostnameSpec
describe "`httpsPort` setting" portSpec
describe "`httpsIgnoreURL` setting" ignoreURLSpec
describe "`httpsTemporary` setting" temporarySpec
describe "`skipDefaultPort` setting" skipDefaultPortSpec
describe "`httsRedirectMethods` setting" redirectMethodsSpec
describe "`httpsDisallowStatus` settings" disallowStatusSpec
describe "resolvers" resolversSpec
defaultSettingsSpec :: Spec
defaultSettingsSpec = do
let withApp = run defaultConfig
it "retuns 301 redirect on GET" $ withApp $ do
res <- request $ baseReq
assertStatus 301 res
assertHeader "Location" "https://haskell.org" res
it "retuns 301 redirect on HEAD" $ withApp $ do
res <- request $ baseReq { requestMethod = "HEAD" }
assertStatus 301 res
assertHeader "Location" "https://haskell.org" res
it "retuns 405 disallow on POST" $ withApp $ do
res <- request $ baseReq { requestMethod = "POST" }
assertStatus 405 res
assertNoHeader "Location" res
assertHeader "Allow" "GET, HEAD" res
it "should not redirect secure request" $ withApp $ do
res <- request $ baseReq { isSecure = True }
assertStatus 200 res
assertNoHeader "Location" res
assertBody "Hello, sailor" res
it "includes url path and params to redirect" $ withApp $ do
res <- request $ baseReq { rawPathInfo = "/foo", rawQueryString = "?bar=baz" }
assertStatus 301 res
assertHeader "Location" "https://haskell.org/foo?bar=baz" res
it "request without `Host` header fails with 400 (Bad Request)" $ withApp $ do
res <- request defaultRequest
assertStatus 400 res
hostnameSpec :: Spec
hostnameSpec = do
let withApp = run $ defaultConfig { httpsHostname = Just "foo.com" }
it "redirects to specified hostname" $ withApp $ do
res <- request baseReq
assertStatus 301 res
assertHeader "Location" "https://foo.com" res
it "redirects with path and params" $ withApp $ do
res <- request $ baseReq { rawPathInfo = "/foo", rawQueryString = "?bar=baz" }
assertStatus 301 res
assertHeader "Location" "https://foo.com/foo?bar=baz" res
portSpec :: Spec
portSpec = do
let withApp = run $ defaultConfig { httpsPort = 8443 }
it "redirects to specified port" $ withApp $ do
res <- request baseReq
assertStatus 301 res
assertHeader "Location" "https://haskell.org:8443" res
it "redirects with path and params" $ withApp $ do
res <- request $ baseReq { rawPathInfo = "/foo", rawQueryString = "?bar=baz" }
assertStatus 301 res
assertHeader "Location" "https://haskell.org:8443/foo?bar=baz" res
it "removes doesn't stack ports" $ withApp $ do
res <- request $ baseReq { requestHeaderHost = Just "localhost:8080" }
assertStatus 301 res
assertHeader "Location" "https://localhost:8443" res
ignoreURLSpec :: Spec
ignoreURLSpec =
let withApp = run $ defaultConfig { httpsIgnoreURL = True }
in
it "redirect without path" $ withApp $ do
res <- request $ baseReq { rawPathInfo = "/foo", rawQueryString = "?bar=baz" }
assertStatus 301 res
assertHeader "Location" "https://haskell.org" res
temporarySpec :: Spec
temporarySpec =
let withApp = run $ defaultConfig { httpsTemporary = True }
in
it "redirect without path" $ withApp $ do
res <- request baseReq
assertStatus 307 res
skipDefaultPortSpec :: Spec
skipDefaultPortSpec =
let withApp = run $ defaultConfig { httpsSkipDefaultPort = False }
in
it "redirect without path" $ withApp $ do
res <- request baseReq
assertStatus 301 res
assertHeader "Location" "https://haskell.org:443" res
redirectMethodsSpec :: Spec
redirectMethodsSpec = do
let withApp = run $ defaultConfig { httpsRedirectMethods = [ "TRACE" ] }
it "default settings for GET is overwritten" $ withApp $ do
res <- request baseReq
assertStatus 405 res
it "specified methods is redirected" $ withApp $ do
res <- request $ baseReq { requestMethod = "TRACE" }
assertStatus 301 res
disallowStatusSpec :: Spec
disallowStatusSpec =
let withApp = run $ defaultConfig { httpsDisallowStatus = status403 }
in
it "returns specified status for disallowed method" $ withApp $ do
res <- request $ baseReq { requestMethod = "POST" }
assertStatus 403 res
assertNoHeader "Allow" res
resolversSpec :: Spec
resolversSpec = do
describe "x-forwarded-proto resolver" $ do
let withApp = run $ defaultConfig { httpsIsSecure = xForwardedProto }
it "retuns 301 redirect on GET without header" $ withApp $ do
res <- request $ baseReq
assertStatus 301 res
assertHeader "Location" "https://haskell.org" res
it "retuns 301 redirect on GET if header value is http" $ withApp $ do
res <- request $ baseReq { requestHeaders = [("x-forwarded-proto", "http")]}
assertStatus 301 res
assertHeader "Location" "https://haskell.org" res
it "returns 200 if header value is https" $ withApp $ do
res <- request $ baseReq { requestHeaders = [("x-forwarded-proto", "https")]}
assertStatus 200 res
assertNoHeader "Location" res
assertBody "Hello, sailor" res
describe "azure's x-arr-ssl header" $ do
let withApp = run $ defaultConfig { httpsIsSecure = azure }
it "retuns 301 redirect on GET without header" $ withApp $ do
res <- request $ baseReq
assertStatus 301 res
assertHeader "Location" "https://haskell.org" res
it "returns 200 if header is present" $ withApp $ do
res <- request $ baseReq { requestHeaders = [("x-arr-ssl", "")]}
assertStatus 200 res
assertNoHeader "Location" res
assertBody "Hello, sailor" res
describe "custom proto header resolver" $ do
let withApp = run $ defaultConfig { httpsIsSecure = customProtoHeader("x-proto") }
it "retuns 301 redirect on GET without header" $ withApp $ do
res <- request $ baseReq
assertStatus 301 res
assertHeader "Location" "https://haskell.org" res
it "retuns 301 redirect on GET if header value is http" $ withApp $ do
res <- request $ baseReq { requestHeaders = [("x-proto", "http")]}
assertStatus 301 res
assertHeader "Location" "https://haskell.org" res
it "returns 200 if header value is https" $ withApp $ do
res <- request $ baseReq { requestHeaders = [("x-proto", "https")]}
assertStatus 200 res
assertNoHeader "Location" res
assertBody "Hello, sailor" res
describe "forwarded header" $ do
let withApp = run $ defaultConfig { httpsIsSecure = forwarded }
it "retuns 301 redirect on GET without header" $ withApp $ do
res <- request $ baseReq
assertStatus 301 res
assertHeader "Location" "https://haskell.org" res
it "retuns 301 redirect on GET if header value is http" $ withApp $ do
res <- request $ baseReq { requestHeaders = [("forwarded", "proto=http")]}
assertStatus 301 res
assertHeader "Location" "https://haskell.org" res
it "returns 200 if header value is https" $ withApp $ do
res <- request $ baseReq { requestHeaders = [("forwarded", "proto=https")]}
assertStatus 200 res
assertNoHeader "Location" res
assertBody "Hello, sailor" res