From fb438ccd751eb740536b151a3916b397fe1274e5 Mon Sep 17 00:00:00 2001 From: Robert Massaioli Date: Wed, 20 May 2015 14:26:30 +1000 Subject: [PATCH 1/6] Issue 62: First attempt at custom access and error log handlers. This is my first attempt at custom access and error log handlers. --- src/Snap/Http/Server.hs | 2 + src/Snap/Http/Server/Config.hs | 4 ++ src/Snap/Internal/Http/Server.hs | 54 +++++++++++++--------- src/Snap/Internal/Http/Server/Config.hs | 59 ++++++++++++++++--------- 4 files changed, 77 insertions(+), 42 deletions(-) diff --git a/src/Snap/Http/Server.hs b/src/Snap/Http/Server.hs index 44f0fc62..87771eca 100644 --- a/src/Snap/Http/Server.hs +++ b/src/Snap/Http/Server.hs @@ -77,7 +77,9 @@ simpleHttpServe config handler = do (listeners conf) (fromJust $ getHostname conf) alog + (getAccessLogHandler conf) elog + (getErrorLogHandler conf) (\sockets -> let dat = mkStartupInfo sockets conf in maybe (return ()) ($ dat) diff --git a/src/Snap/Http/Server/Config.hs b/src/Snap/Http/Server/Config.hs index 71596691..b2a74b2f 100644 --- a/src/Snap/Http/Server/Config.hs +++ b/src/Snap/Http/Server/Config.hs @@ -19,11 +19,13 @@ module Snap.Http.Server.Config , fmapOpt , getAccessLog + , getAccessLogHandler , getBind , getCompression , getDefaultTimeout , getErrorHandler , getErrorLog + , getErrorLogHandler , getHostname , getLocale , getOther @@ -38,11 +40,13 @@ module Snap.Http.Server.Config , getStartupHook , setAccessLog + , setAccessLogHandler , setBind , setCompression , setDefaultTimeout , setErrorHandler , setErrorLog + , setErrorLogHandler , setHostname , setLocale , setOther diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs index d6b3d44d..24df61be 100644 --- a/src/Snap/Internal/Http/Server.hs +++ b/src/Snap/Internal/Http/Server.hs @@ -155,11 +155,13 @@ httpServe :: Int -- ^ default timeout -> [ListenPort] -- ^ ports to listen on -> ByteString -- ^ local hostname (server name) -> Maybe (ByteString -> IO ()) -- ^ access log action + -> Maybe AccessLogHandler -> Maybe (ByteString -> IO ()) -- ^ error log action + -> Maybe ErrorLogHandler -> ([Socket] -> IO ()) -- ^ initialisation -> ServerHandler -- ^ handler procedure -> IO () -httpServe defaultTimeout ports localHostname alog' elog' initial handler = +httpServe defaultTimeout ports localHostname alog' alh elog' elh initial handler = withSocketsDo $ spawnAll alog' elog' `catches` errorHandlers where @@ -204,7 +206,7 @@ httpServe defaultTimeout ports localHostname alog' elog' initial handler = let socks = map (\x -> case x of ListenHttp s -> s; ListenHttps s _ -> s) nports (simpleEventLoop defaultTimeout nports numCapabilities (logE elog) (initial socks) - $ runHTTP defaultTimeout alog elog handler localHostname) + $ runHTTP defaultTimeout alog alh elog elh handler localHostname) `finally` do logE elog "Server.httpServe: SHUTDOWN" @@ -224,6 +226,24 @@ httpServe defaultTimeout ports localHostname alog' elog' initial handler = debugE :: (MonadIO m) => ByteString -> m () debugE s = debug $ "Server: " ++ (map w2c $ S.unpack s) +type ErrorLogHandler = ByteString -> IO ByteString +type AccessLogHandler = Request -> Response -> IO ByteString + +defaultAccessLogHandler :: AccessLogHandler +defaultAccessLogHandler req rsp = do + let hdrs = rqHeaders req + let host = rqRemoteAddr req + let user = Nothing -- TODO we don't do authentication yet + let (v, v') = rqVersion req + let ver = S.concat [ "HTTP/", bshow v, ".", bshow v' ] + let method = toBS $ show (rqMethod req) + let reql = S.intercalate " " [ method, rqURI req, ver ] + let status = rspStatus rsp + let cl = rspContentLength rsp + let referer = maybe Nothing (Just . head) $ H.lookup "referer" hdrs + let userAgent = maybe "-" head $ H.lookup "user-agent" hdrs + + combinedLogEntry host user reql status cl referer userAgent ------------------------------------------------------------------------------ logE :: Maybe (ByteString -> IO ()) -> ByteString -> IO () @@ -241,33 +261,21 @@ bshow = toBS . show ------------------------------------------------------------------------------ -logA :: Maybe (ByteString -> IO ()) -> Request -> Response -> IO () -logA alog = maybe (\_ _ -> return ()) logA' alog +logA :: AccessLogHandler -> Maybe (ByteString -> IO ()) -> Request -> Response -> IO () +logA alh alog = maybe (\_ _ -> return ()) (logA' alh) alog ------------------------------------------------------------------------------ -logA' :: (ByteString -> IO ()) -> Request -> Response -> IO () -logA' logger req rsp = do - let hdrs = rqHeaders req - let host = rqRemoteAddr req - let user = Nothing -- TODO we don't do authentication yet - let (v, v') = rqVersion req - let ver = S.concat [ "HTTP/", bshow v, ".", bshow v' ] - let method = toBS $ show (rqMethod req) - let reql = S.intercalate " " [ method, rqURI req, ver ] - let status = rspStatus rsp - let cl = rspContentLength rsp - let referer = maybe Nothing (Just . head) $ H.lookup "referer" hdrs - let userAgent = maybe "-" head $ H.lookup "user-agent" hdrs - - msg <- combinedLogEntry host user reql status cl referer userAgent - logger msg +logA' :: AccessLogHandler -> (ByteString -> IO ()) -> Request -> Response -> IO () +logA' alh logger req rsp = logger =<< alh req rsp ------------------------------------------------------------------------------ runHTTP :: Int -- ^ default timeout -> Maybe (ByteString -> IO ()) -- ^ access logger + -> Maybe AccessLogHandler -> Maybe (ByteString -> IO ()) -- ^ error logger + -> Maybe ErrorLogHandler -> ServerHandler -- ^ handler procedure -> ByteString -- ^ local host name -> SessionInfo -- ^ session port information @@ -277,7 +285,7 @@ runHTTP :: Int -- ^ default timeout -- ^ sendfile end -> ((Int -> Int) -> IO ()) -- ^ timeout tickler -> IO () -runHTTP defaultTimeout alog elog handler lh sinfo readEnd writeEnd onSendFile +runHTTP defaultTimeout alog alh elog elh handler lh sinfo readEnd writeEnd onSendFile tickle = go `catches` [ Handler $ \(_ :: TerminatedBeforeHandlerException) -> do return () @@ -301,7 +309,7 @@ runHTTP defaultTimeout alog elog handler lh sinfo readEnd writeEnd onSendFile go = do buf <- allocBuffer 16384 - let iter1 = runServerMonad lh sinfo (logA alog) (logE elog) $ + let iter1 = runServerMonad lh sinfo (logA accessHandle alog) (logE elog) $ httpSession defaultTimeout writeEnd buf onSendFile tickle handler let iter = iterateeDebugWrapper "httpSession iteratee" iter1 @@ -314,6 +322,8 @@ runHTTP defaultTimeout alog elog handler lh sinfo readEnd writeEnd onSendFile run_ $ readEnd step debug "runHTTP/go: finished" + accessHandle = fromMaybe defaultAccessLogHandler alh + ------------------------------------------------------------------------------ requestErrorMessage :: Request -> SomeException -> Builder diff --git a/src/Snap/Internal/Http/Server/Config.hs b/src/Snap/Internal/Http/Server/Config.hs index 4b44c8bc..4e650e25 100644 --- a/src/Snap/Internal/Http/Server/Config.hs +++ b/src/Snap/Internal/Http/Server/Config.hs @@ -43,7 +43,7 @@ import System.Posix.Env import System.Exit import System.IO ------------------------------------------------------------------------------ -import Snap.Internal.Http.Server (requestErrorMessage) +import Snap.Internal.Http.Server (requestErrorMessage, ErrorLogHandler, AccessLogHandler) ------------------------------------------------------------------------------ @@ -78,25 +78,27 @@ instance Show ConfigLog where -- Any fields which are unspecified in the 'Config' passed to 'httpServe' (and -- this is the norm) are filled in with default values from 'defaultConfig'. data Config m a = Config - { hostname :: Maybe ByteString - , accessLog :: Maybe ConfigLog - , errorLog :: Maybe ConfigLog - , locale :: Maybe String - , port :: Maybe Int - , bind :: Maybe ByteString - , sslport :: Maybe Int - , sslbind :: Maybe ByteString - , sslcert :: Maybe FilePath - , sslchaincert :: Maybe Bool - , sslkey :: Maybe FilePath - , compression :: Maybe Bool - , verbose :: Maybe Bool - , errorHandler :: Maybe (SomeException -> m ()) - , defaultTimeout :: Maybe Int - , other :: Maybe a - , backend :: Maybe ConfigBackend - , proxyType :: Maybe ProxyType - , startupHook :: Maybe (StartupInfo m a -> IO ()) + { hostname :: Maybe ByteString + , accessLog :: Maybe ConfigLog + , errorLog :: Maybe ConfigLog + , accessLogHandler :: Maybe AccessLogHandler + , errorLogHandler :: Maybe ErrorLogHandler + , locale :: Maybe String + , port :: Maybe Int + , bind :: Maybe ByteString + , sslport :: Maybe Int + , sslbind :: Maybe ByteString + , sslcert :: Maybe FilePath + , sslchaincert :: Maybe Bool + , sslkey :: Maybe FilePath + , compression :: Maybe Bool + , verbose :: Maybe Bool + , errorHandler :: Maybe (SomeException -> m ()) + , defaultTimeout :: Maybe Int + , other :: Maybe a + , backend :: Maybe ConfigBackend + , proxyType :: Maybe ProxyType + , startupHook :: Maybe (StartupInfo m a -> IO ()) } #if MIN_VERSION_base(4,7,0) deriving Typeable @@ -167,6 +169,8 @@ instance Monoid (Config m a) where { hostname = Nothing , accessLog = Nothing , errorLog = Nothing + , accessLogHandler = Nothing + , errorLogHandler = Nothing , locale = Nothing , port = Nothing , bind = Nothing @@ -189,6 +193,8 @@ instance Monoid (Config m a) where { hostname = ov hostname , accessLog = ov accessLog , errorLog = ov errorLog + , accessLogHandler = ov accessLogHandler + , errorLogHandler = ov errorLogHandler , locale = ov locale , port = ov port , bind = ov bind @@ -241,10 +247,17 @@ getHostname = hostname getAccessLog :: Config m a -> Maybe ConfigLog getAccessLog = accessLog +-- | Get the access log handler +getAccessLogHandler :: Config m a -> Maybe AccessLogHandler +getAccessLogHandler = accessLogHandler + -- | Path to the error log getErrorLog :: Config m a -> Maybe ConfigLog getErrorLog = errorLog +getErrorLogHandler :: Config m a -> Maybe ErrorLogHandler +getErrorLogHandler = errorLogHandler + -- | Gets the locale to use. Locales are used on Unix only, to set the -- @LANG@\/@LC_ALL@\/etc. environment variable. For instance if you set the -- locale to \"@en_US@\", we'll set the relevant environment variables to @@ -319,9 +332,15 @@ setHostname x c = c { hostname = Just x } setAccessLog :: ConfigLog -> Config m a -> Config m a setAccessLog x c = c { accessLog = Just x } +setAccessLogHandler :: AccessLogHandler -> Config m a -> Config m a +setAccessLogHandler x c = c { accessLogHandler = Just x } + setErrorLog :: ConfigLog -> Config m a -> Config m a setErrorLog x c = c { errorLog = Just x } +setErrorLogHandler :: ErrorLogHandler -> Config m a -> Config m a +setErrorLogHandler x c = c { errorLogHandler = Just x } + setLocale :: String -> Config m a -> Config m a setLocale x c = c { locale = Just x } From b3be5db2af9c746a2b756fdf28901bd5d2824b98 Mon Sep 17 00:00:00 2001 From: Robert Massaioli Date: Wed, 20 May 2015 17:26:24 +1000 Subject: [PATCH 2/6] Issue 62: Made the error handler work and exported the handler types. --- src/Snap/Http/Server/Config.hs | 4 ++++ src/Snap/Internal/Http/Server.hs | 30 ++++++++++++++++++------------ 2 files changed, 22 insertions(+), 12 deletions(-) diff --git a/src/Snap/Http/Server/Config.hs b/src/Snap/Http/Server/Config.hs index b2a74b2f..76a2c23e 100644 --- a/src/Snap/Http/Server/Config.hs +++ b/src/Snap/Http/Server/Config.hs @@ -9,6 +9,9 @@ module Snap.Http.Server.Config ( Config , ConfigLog(..) + , AccessLogHandler + , ErrorLogHandler + , emptyConfig , defaultConfig , commandLineConfig @@ -65,3 +68,4 @@ module Snap.Http.Server.Config ) where import Snap.Internal.Http.Server.Config +import Snap.Internal.Http.Server diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs index 24df61be..b5cf1621 100644 --- a/src/Snap/Internal/Http/Server.hs +++ b/src/Snap/Internal/Http/Server.hs @@ -172,7 +172,7 @@ httpServe defaultTimeout ports localHostname alog' alh elog' elh initial handler -------------------------------------------------------------------------- sslException (e@(TLS.TLSException msg)) = do - logE elog' msg + logE errorHandle elog' msg SC.hPutStrLn stderr msg throw e @@ -185,14 +185,14 @@ httpServe defaultTimeout ports localHostname alog' alh elog' elh initial handler "Error on startup: \n" , T.encodeUtf8 $ T.pack $ show e ] - logE elog' msg + logE errorHandle elog' msg SC.hPutStrLn stderr msg throw e -------------------------------------------------------------------------- spawnAll alog elog = {-# SCC "httpServe/spawnAll" #-} do - logE elog $ S.concat [ "Server.httpServe: START, binding to " + logE errorHandle elog $ S.concat [ "Server.httpServe: START, binding to " , bshow ports ] let isHttps p = case p of { (HttpsPort _ _ _ _ _) -> True; _ -> False;} @@ -205,22 +205,24 @@ httpServe defaultTimeout ports localHostname alog' alh elog' elh initial handler nports <- mapM bindPort ports let socks = map (\x -> case x of ListenHttp s -> s; ListenHttps s _ -> s) nports - (simpleEventLoop defaultTimeout nports numCapabilities (logE elog) (initial socks) + (simpleEventLoop defaultTimeout nports numCapabilities (logE errorHandle elog) (initial socks) $ runHTTP defaultTimeout alog alh elog elh handler localHostname) `finally` do - logE elog "Server.httpServe: SHUTDOWN" + logE errorHandle elog "Server.httpServe: SHUTDOWN" if initHttps then TLS.stopTLS else return () - logE elog "Server.httpServe: BACKEND STOPPED" + logE errorHandle elog "Server.httpServe: BACKEND STOPPED" -------------------------------------------------------------------------- bindPort (HttpPort baddr port ) = bindHttp baddr port bindPort (HttpsPort baddr port cert chainCert key) = TLS.bindHttps baddr port cert chainCert key + errorHandle = fromMaybe defaultErrorLogHandler elh + ------------------------------------------------------------------------------ debugE :: (MonadIO m) => ByteString -> m () @@ -245,14 +247,17 @@ defaultAccessLogHandler req rsp = do combinedLogEntry host user reql status cl referer userAgent +defaultErrorLogHandler :: ErrorLogHandler +defaultErrorLogHandler = timestampedLogEntry + ------------------------------------------------------------------------------ -logE :: Maybe (ByteString -> IO ()) -> ByteString -> IO () -logE elog = maybe debugE (\l s -> debugE s >> logE' l s) elog +logE :: ErrorLogHandler -> Maybe (ByteString -> IO ()) -> ByteString -> IO () +logE elh elog = maybe debugE (\l s -> debugE s >> logE' elh l s) elog ------------------------------------------------------------------------------ -logE' :: (ByteString -> IO ()) -> ByteString -> IO () -logE' logger s = (timestampedLogEntry s) >>= logger +logE' :: ErrorLogHandler -> (ByteString -> IO ()) -> ByteString -> IO () +logE' elh logger s = logger =<< elh s ------------------------------------------------------------------------------ @@ -296,7 +301,7 @@ runHTTP defaultTimeout alog alh elog elh handler lh sinfo readEnd writeEnd onSen , Handler $ \(e :: AsyncException) -> do throwIO e , Handler $ \(e :: SomeException) -> - logE elog $ toByteString $ lmsg e + logE errorHandle elog $ toByteString $ lmsg e ] where @@ -309,7 +314,7 @@ runHTTP defaultTimeout alog alh elog elh handler lh sinfo readEnd writeEnd onSen go = do buf <- allocBuffer 16384 - let iter1 = runServerMonad lh sinfo (logA accessHandle alog) (logE elog) $ + let iter1 = runServerMonad lh sinfo (logA accessHandle alog) (logE errorHandle elog) $ httpSession defaultTimeout writeEnd buf onSendFile tickle handler let iter = iterateeDebugWrapper "httpSession iteratee" iter1 @@ -323,6 +328,7 @@ runHTTP defaultTimeout alog alh elog elh handler lh sinfo readEnd writeEnd onSen debug "runHTTP/go: finished" accessHandle = fromMaybe defaultAccessLogHandler alh + errorHandle = fromMaybe defaultErrorLogHandler elh ------------------------------------------------------------------------------ From e28ec2984cbeccc49018ddd7a0d499d683a4b720 Mon Sep 17 00:00:00 2001 From: Robert Massaioli Date: Thu, 21 May 2015 08:25:44 +1000 Subject: [PATCH 3/6] Issue 62: Cleaning up the code to get it ready for a pull request. --- src/Snap/Internal/Http/Server.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs index b5cf1621..20dc354f 100644 --- a/src/Snap/Internal/Http/Server.hs +++ b/src/Snap/Internal/Http/Server.hs @@ -93,6 +93,15 @@ type ServerHandler = (ByteString -> IO ()) ------------------------------------------------------------------------------ type ServerMonad = StateT ServerState (Iteratee ByteString IO) +------------------------------------------------------------------------------ +-- | This handler may be used (in conjunction with setErrorLogHandler) to write out error logs in a +-- custom manner. +type ErrorLogHandler = ByteString -> IO ByteString + +------------------------------------------------------------------------------ +-- | This handler may be used (in conjunction with setAccessLogHandler) to write out access logs in a +-- custom manner. +type AccessLogHandler = Request -> Response -> IO ByteString ------------------------------------------------------------------------------ data ListenPort = @@ -228,9 +237,7 @@ httpServe defaultTimeout ports localHostname alog' alh elog' elh initial handler debugE :: (MonadIO m) => ByteString -> m () debugE s = debug $ "Server: " ++ (map w2c $ S.unpack s) -type ErrorLogHandler = ByteString -> IO ByteString -type AccessLogHandler = Request -> Response -> IO ByteString - +------------------------------------------------------------------------------ defaultAccessLogHandler :: AccessLogHandler defaultAccessLogHandler req rsp = do let hdrs = rqHeaders req @@ -247,6 +254,7 @@ defaultAccessLogHandler req rsp = do combinedLogEntry host user reql status cl referer userAgent +------------------------------------------------------------------------------ defaultErrorLogHandler :: ErrorLogHandler defaultErrorLogHandler = timestampedLogEntry From 6b018544b5ff5cedb373eb20ff8ddbc0cb9a8c4e Mon Sep 17 00:00:00 2001 From: Robert Massaioli Date: Thu, 21 May 2015 08:27:13 +1000 Subject: [PATCH 4/6] Issue 62: Forgot to add one message. --- src/Snap/Internal/Http/Server/Config.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Snap/Internal/Http/Server/Config.hs b/src/Snap/Internal/Http/Server/Config.hs index 4e650e25..d0879871 100644 --- a/src/Snap/Internal/Http/Server/Config.hs +++ b/src/Snap/Internal/Http/Server/Config.hs @@ -255,6 +255,7 @@ getAccessLogHandler = accessLogHandler getErrorLog :: Config m a -> Maybe ConfigLog getErrorLog = errorLog +-- | Get the error log handler getErrorLogHandler :: Config m a -> Maybe ErrorLogHandler getErrorLogHandler = errorLogHandler From 8c4515fab532aa8023b2f55104c65c66928deceb Mon Sep 17 00:00:00 2001 From: Robert Massaioli Date: Fri, 22 May 2015 08:31:36 +1000 Subject: [PATCH 5/6] Issue 62: Cleaned up some imports. --- src/Snap/Http/Server/Config.hs | 2 -- src/Snap/Internal/Http/Server/Config.hs | 5 +++-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Snap/Http/Server/Config.hs b/src/Snap/Http/Server/Config.hs index 5cfb09c7..420163f2 100644 --- a/src/Snap/Http/Server/Config.hs +++ b/src/Snap/Http/Server/Config.hs @@ -41,14 +41,12 @@ module Snap.Http.Server.Config , getStartupHook , setAccessLog - , AccessLogHandler , setAccessLogHandler , setBind , setCompression , setDefaultTimeout , setErrorHandler , setErrorLog - , ErrorLogHandler , setErrorLogHandler , setHostname , setLocale diff --git a/src/Snap/Internal/Http/Server/Config.hs b/src/Snap/Internal/Http/Server/Config.hs index e4a1e7b0..1bb87c0e 100644 --- a/src/Snap/Internal/Http/Server/Config.hs +++ b/src/Snap/Internal/Http/Server/Config.hs @@ -23,6 +23,9 @@ module Snap.Internal.Http.Server.Config , optDescrs , fmapOpt + , AccessLogHandler + , ErrorLogHandler + , getAccessLog , getAccessLogHandler , getBind @@ -45,14 +48,12 @@ module Snap.Internal.Http.Server.Config , getStartupHook , setAccessLog - , AccessLogHandler , setAccessLogHandler , setBind , setCompression , setDefaultTimeout , setErrorHandler , setErrorLog - , ErrorLogHandler , setErrorLogHandler , setHostname , setLocale From b5e2305cf48d09741d97919e02097d3b9e2f257c Mon Sep 17 00:00:00 2001 From: Robert Massaioli Date: Thu, 28 May 2015 07:21:26 +1000 Subject: [PATCH 6/6] Issue 62: Running Stylish Haskell on the code. --- src/Snap/Http/Server.hs | 4 ++-- src/Snap/Internal/Http/Server/Config.hs | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Snap/Http/Server.hs b/src/Snap/Http/Server.hs index 75b464f4..bad87566 100644 --- a/src/Snap/Http/Server.hs +++ b/src/Snap/Http/Server.hs @@ -44,10 +44,10 @@ import Data.ByteString.Builder (Builder, toLazyByteString) ------------------------------------------------------------------------------ import qualified Paths_snap_server as V import Snap.Core (MonadSnap (..), Request, Response, Snap, rqClientAddr, rqHeaders, rqMethod, rqURI, rqVersion, rspStatus) -import Snap.Http.Server.Config (Config, ConfigLog (..), commandLineConfig, completeConfig, defaultConfig, getAccessLog, getBind, getCompression, getDefaultTimeout, getErrorHandler, getErrorLog, getHostname, getLocale, getOther, getPort, getProxyType, getSSLBind, getSSLCert, getSSLChainCert, getSSLKey, getSSLPort, getStartupHook, getVerbose, getAccessLogHandler, getErrorLogHandler) +import Snap.Http.Server.Config (Config, ConfigLog (..), commandLineConfig, completeConfig, defaultConfig, getAccessLog, getAccessLogHandler, getBind, getCompression, getDefaultTimeout, getErrorHandler, getErrorLog, getErrorLogHandler, getHostname, getLocale, getOther, getPort, getProxyType, getSSLBind, getSSLCert, getSSLChainCert, getSSLKey, getSSLPort, getStartupHook, getVerbose) import qualified Snap.Http.Server.Types as Ty import Snap.Internal.Debug (debug) -import Snap.Internal.Http.Server.Config (ProxyType (..), emptyStartupInfo, setStartupConfig, setStartupSockets, AccessLogHandler, ErrorLogHandler) +import Snap.Internal.Http.Server.Config (AccessLogHandler, ErrorLogHandler, ProxyType (..), emptyStartupInfo, setStartupConfig, setStartupSockets) import Snap.Internal.Http.Server.Session (httpAcceptLoop, snapToServerHandler) import qualified Snap.Internal.Http.Server.Socket as Sock import qualified Snap.Internal.Http.Server.TLS as TLS diff --git a/src/Snap/Internal/Http/Server/Config.hs b/src/Snap/Internal/Http/Server/Config.hs index 1bb87c0e..a9801143 100644 --- a/src/Snap/Internal/Http/Server/Config.hs +++ b/src/Snap/Internal/Http/Server/Config.hs @@ -48,7 +48,7 @@ module Snap.Internal.Http.Server.Config , getStartupHook , setAccessLog - , setAccessLogHandler + , setAccessLogHandler , setBind , setCompression , setDefaultTimeout @@ -139,7 +139,7 @@ instance Show ConfigLog where show (ConfigIoLog _) = "custom logging handler" ------------------------------------------------------------------------------ --- | This handler may be used (in conjunction with setErrorLogHandler) to write out error logs in a +-- | This handler may be used (in conjunction with setErrorLogHandler) to write out error logs in a -- custom manner. type ErrorLogHandler = ByteString -> IO ByteString @@ -315,7 +315,7 @@ instance Monoid (Config m a) where { hostname = ov hostname , accessLog = ov accessLog , errorLog = ov errorLog - , accessLogHandler = ov accessLogHandler + , accessLogHandler = ov accessLogHandler , errorLogHandler = ov errorLogHandler , locale = ov locale , port = ov port