Force SSL in production (fixes #150)

This commit is contained in:
Michael Snoyman 2016-02-02 07:56:30 +00:00
parent 0e46ca9964
commit be25e87b69
3 changed files with 15 additions and 4 deletions

View file

@ -12,6 +12,7 @@ import Import hiding (catch)
import Language.Haskell.TH.Syntax (Loc(..))
import Network.Wai (Middleware, responseLBS)
import Network.Wai.Logger (clockDateCacher)
import Network.Wai.Middleware.ForceSSL (forceSSL)
import Network.Wai.Middleware.RequestLogger
( mkRequestLogger, outputFormat, OutputFormat (..), IPAddrSource (..), destination
)
@ -67,7 +68,7 @@ makeApplication echo@True conf = do
{ destination = RequestLogger.Callback (const (return ()))
}
Echo.clear
return (logWare (defaultMiddlewaresNoLogging app),logFunc)
return (forceSSL' conf $ logWare (defaultMiddlewaresNoLogging app),logFunc)
where logFunc (Loc filename' _pkg _mod (line,_) _) source level str =
Echo.write (filename',line) (show source ++ ": " ++ show level ++ ": " ++ toStr str)
toStr = unpack . decodeUtf8 . fromLogStr
@ -84,9 +85,14 @@ makeApplication echo@False conf = do
-- Create the WAI application and apply middlewares
app <- toWaiAppPlain foundation
let logFunc = messageLoggerSource foundation (appLogger foundation)
middleware = nicerExceptions . logWare . defaultMiddlewaresNoLogging
middleware = forceSSL' conf . nicerExceptions . logWare . defaultMiddlewaresNoLogging
return (middleware app, logFunc)
forceSSL' :: AppConfig DefaultEnv Extra -> Middleware
forceSSL' app
| extraForceSsl $ appExtra app = forceSSL
| otherwise = id
nicerExceptions :: Middleware
nicerExceptions app req send = catch (app req send) $ \e -> do
let text = "Exception thrown to Warp: " ++ tshow (e :: SomeException)

View file

@ -61,8 +61,11 @@ widgetFile = (if development then widgetFileReload
data Extra = Extra
{ extraDevDownload :: !Bool
-- ^ Controls how Git and database resources are downloaded (True means less downloading)
, extraForceSsl :: !Bool
}
deriving Show
parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra _ o = Extra <$> o .:? "dev-download" .!= False
parseExtra _ o = Extra
<$> o .:? "dev-download" .!= False
<*> o .: "force-ssl"

View file

@ -2,6 +2,7 @@ Default: &defaults
host: "*4" # any IPv4 host
port: 3000
approot: "http://localhost:3000"
force-ssl: false
Development:
<<: *defaults
@ -14,5 +15,6 @@ Staging:
<<: *defaults
Production:
approot: "http://www.stackage.org"
approot: "https://www.stackage.org"
force-ssl: true
<<: *defaults