{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Auth.AppRoot
( smartAppRoot
) where
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI, mk)
import qualified Data.HashMap.Lazy as HM
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Network.HTTP.Types (Header)
import Network.Wai (Request, isSecure, requestHeaderHost,
requestHeaders)
smartAppRoot :: Request -> T.Text
smartAppRoot req =
let secure = isSecure req || any isSecureHeader (requestHeaders req)
host =
maybe "localhost" (decodeUtf8With lenientDecode) (requestHeaderHost req)
in (if secure
then "https://"
else "http://") <>
host
httpsHeaders :: HM.HashMap (CI ByteString) (CI ByteString)
httpsHeaders =
HM.fromList
[ ("X-Forwarded-Protocol", "https")
, ("X-Forwarded-Ssl", "on")
, ("X-Url-Scheme", "https")
, ("X-Forwarded-Proto", "https")
, ("Front-End-Https", "on")
]
isSecureHeader :: Header -> Bool
isSecureHeader (key, value) =
case HM.lookup key httpsHeaders of
Nothing -> False
Just value' -> valueCI == value'
where
valueCI = mk value