module Yesod.Default.MainTLS
( defaultMainTLS
, defaultMainLogTLS
, LogFunc
) where
import Yesod.Default.Config
import Yesod.Default.Main (LogFunc)
import Network.Wai (Application)
import Network.Wai.Handler.Warp
(defaultSettings, settingsPort, settingsHost, settingsOnException)
import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
import qualified Network.Wai.Handler.Warp as Warp
import Control.Monad (when)
import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc)
import System.Log.FastLogger (LogStr, toLogStr)
import Language.Haskell.TH.Syntax (qLocation)
defaultMainTLS :: (Show env, Read env)
=> FilePath
-> FilePath
-> IO (AppConfig env extra)
-> (AppConfig env extra -> IO Application)
-> IO ()
defaultMainTLS cert key load getApp = do
config <- load
app <- getApp config
runTLS (tlsSettings cert key) defaultSettings
{ settingsPort = appPort config
, settingsHost = appHost config
} app
defaultMainLogTLS :: (Show env, Read env)
=> FilePath
-> FilePath
-> IO (AppConfig env extra)
-> (AppConfig env extra -> IO (Application, LogFunc))
-> IO ()
defaultMainLogTLS cert key load getApp = do
config <- load
(app, logFunc) <- getApp config
runTLS (tlsSettings cert key) defaultSettings
{ settingsPort = appPort config
, settingsHost = appHost config
, settingsOnException = const $ \e -> when (shouldLog' e) $ logFunc
$(qLocation >>= liftLoc)
"yesod"
LevelError
(toLogStr $ "Exception from Warp: " ++ show e)
} app
where
shouldLog' = Warp.defaultShouldDisplayException