module Network.Wai.Middleware.ForceSSL
( forceSSL
) where
import Network.Wai
import Network.Wai.Request
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
import Data.Monoid (mempty)
#endif
import Data.Monoid ((<>))
import Network.HTTP.Types (hLocation, methodGet, status301, status307)
import qualified Data.ByteString as S
import Data.Word8 (_colon)
forceSSL :: Middleware
forceSSL app req sendResponse =
case (appearsSecure req, redirectResponse req) of
(False, Just resp) -> sendResponse resp
_ -> app req sendResponse
redirectResponse :: Request -> Maybe Response
redirectResponse req = do
(host, _) <- S.break (== _colon) <$> requestHeaderHost req
return $ responseBuilder status [(hLocation, location host)] mempty
where
location h = "https://" <> h <> rawPathInfo req <> rawQueryString req
status
| requestMethod req == methodGet = status301
| otherwise = status307