yesod-tls 1.4.0 → 1.4.1
raw patch · 2 files changed
+19/−81 lines, 2 filesdep −directorydep −safe
Dependencies removed: directory, safe
Files
- Yesod/Default/MainTLS.hs +18/−78
- yesod-tls.cabal +1/−3
Yesod/Default/MainTLS.hs view
@@ -3,71 +3,58 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Yesod.Default.MainTLS- ( defaultMain- , defaultMainLog- , defaultRunner- , defaultDevelApp+ ( 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, defaultTlsSettings)+import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings) import qualified Network.Wai.Handler.Warp as Warp-import System.Directory (doesDirectoryExist, removeDirectoryRecursive)-import Network.Wai.Middleware.Gzip (gzip, GzipFiles (GzipCacheFolder), gzipFiles, def)-import Network.Wai.Middleware.Autohead (autohead)-import Network.Wai.Middleware.Jsonp (jsonp) import Control.Monad (when)-import System.Environment (getEnvironment)-import Data.Maybe (fromMaybe)-import Safe (readMay) import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc) import System.Log.FastLogger (LogStr, toLogStr) import Language.Haskell.TH.Syntax (qLocation) -#ifndef WINDOWS-import qualified System.Posix.Signals as Signal-import Control.Concurrent (forkIO, killThread)-import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)-#endif---- | Run your app, taking environment and port settings from the+-- | Run your app, taking environment, port, and TLS settings from the -- commandline. -- -- @'fromArgs'@ helps parse a custom configuration -- -- > main :: IO ()--- > main = defaultMain (fromArgs parseExtra) makeApplication+-- > main = cert key defaultMain (fromArgs parseExtra) makeApplication ---defaultMain :: (Show env, Read env)- => IO (AppConfig env extra)+defaultMainTLS :: (Show env, Read env)+ => FilePath+ -> FilePath+ -> IO (AppConfig env extra) -> (AppConfig env extra -> IO Application) -> IO ()-defaultMain load getApp = do+defaultMainTLS cert key load getApp = do config <- load app <- getApp config- runTLS defaultTlsSettings defaultSettings+ runTLS (tlsSettings cert key) defaultSettings { settingsPort = appPort config , settingsHost = appHost config } app -type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()- -- | Same as @defaultMain@, but gets a logging function back as well as an -- @Application@ to install Warp exception handlers. ----- Since 1.2.5-defaultMainLog :: (Show env, Read env)- => IO (AppConfig env extra)+defaultMainLogTLS :: (Show env, Read env)+ => FilePath+ -> FilePath+ -> IO (AppConfig env extra) -> (AppConfig env extra -> IO (Application, LogFunc)) -> IO ()-defaultMainLog load getApp = do+defaultMainLogTLS cert key load getApp = do config <- load (app, logFunc) <- getApp config- runTLS defaultTlsSettings defaultSettings+ runTLS (tlsSettings cert key) defaultSettings { settingsPort = appPort config , settingsHost = appHost config , settingsOnException = const $ \e -> when (shouldLog' e) $ logFunc@@ -78,50 +65,3 @@ } app where shouldLog' = Warp.defaultShouldDisplayException---- | Run your application continously, listening for SIGINT and exiting--- when received------ > withYourSite :: AppConfig DefaultEnv -> Logger -> (Application -> IO a) -> IO ()--- > withYourSite conf logger f = do--- > Settings.withConnectionPool conf $ \p -> do--- > runConnectionPool (runMigration yourMigration) p--- > defaultRunner f $ YourSite conf logger p-defaultRunner :: (Application -> IO ()) -> Application -> IO ()-defaultRunner f app = do- -- clear the .static-cache so we don't have stale content- exists <- doesDirectoryExist staticCache- when exists $ removeDirectoryRecursive staticCache-#ifdef WINDOWS- f (middlewares app)-#else- tid <- forkIO $ f (middlewares app) >> return ()- flag <- newEmptyMVar- _ <- Signal.installHandler Signal.sigINT (Signal.CatchOnce $ do- putStrLn "Caught an interrupt"- killThread tid- putMVar flag ()) Nothing- takeMVar flag-#endif- where- middlewares = gzip gset . jsonp . autohead-- gset = def { gzipFiles = GzipCacheFolder staticCache }- staticCache = ".static-cache"---- | Run your development app using a custom environment type and loader--- function-defaultDevelApp- :: (Show env, Read env)- => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@- -> (AppConfig env extra -> IO Application) -- ^ Get your @Application@- -> IO (Int, Application)-defaultDevelApp load getApp = do- conf <- load- env <- getEnvironment- let p = fromMaybe (appPort conf) $ lookup "PORT" env >>= readMay- pdisplay = fromMaybe p $ lookup "DISPLAY_PORT" env >>= readMay- putStrLn $ "Devel application launched: http://localhost:" ++ show pdisplay- app <- getApp conf- return (p, app)-
yesod-tls.cabal view
@@ -1,5 +1,5 @@ name: yesod-tls-version: 1.4.0+version: 1.4.1 synopsis: Provides main functions using warp-tls for yesod projects description: This package makes possible to build Yesod web applications that provide SSL support. homepage: http://github.com/netom/yesod-tls@@ -21,8 +21,6 @@ , template-haskell , monad-logger , fast-logger- , safe- , directory if !os(windows) build-depends: unix