Force SSL in production (fixes #150)
This commit is contained in:
parent
0e46ca9964
commit
be25e87b69
3 changed files with 15 additions and 4 deletions
|
@ -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)
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue