wai-extra-3.1.9: test/Network/Wai/Middleware/ApprootSpec.hs

{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Middleware.ApprootSpec
    ( main
    , spec
    ) where

import Data.ByteString (ByteString)
import Network.HTTP.Types (RequestHeaders, status200)
import Network.Wai
import Test.Hspec

import Network.Wai.Middleware.Approot (fromRequest, getApproot)
import Network.Wai.Test (SResponse (simpleHeaders), request, runSession)

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
    let test name host secure headers expected = it name $ do
            resp <- runApp host secure headers
            simpleHeaders resp `shouldBe` [("Approot", expected)]
    test "respects host header" "foobar" False [] "http://foobar"
    test "respects isSecure" "foobar" True [] "https://foobar"
    test "respects SSL headers" "foobar" False
        [("HTTP_X_FORWARDED_SSL", "on")] "https://foobar"

runApp :: ByteString -> Bool -> RequestHeaders -> IO SResponse
runApp host secure headers = runSession
    (request defaultRequest
        { requestHeaderHost = Just host
        , isSecure = secure
        , requestHeaders = headers
        }) $ fromRequest app

  where
    app req respond = respond $ responseLBS status200 [("Approot", getApproot req)] ""