module Network.Wai.Logger (
ApacheLogger
, withStdoutLogger
, ApacheLoggerActions(..)
, initLogger
, IPAddrSource(..)
, LogType(..)
, FileLogSpec(..)
, clockDateCacher
, ZonedDate
, DateCacheGetter
, DateCacheUpdater
, logCheck
, showSockAddr
) where
import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction)
import Control.Exception (handle, SomeException(..), bracket)
import Control.Monad (when, void)
import Network.HTTP.Types (Status)
import Network.Wai (Request)
import System.IO (withFile, hFileSize, IOMode(..))
import System.Log.FastLogger
import Network.Wai.Logger.Apache
import Network.Wai.Logger.Date
import Network.Wai.Logger.IP (showSockAddr)
withStdoutLogger :: (ApacheLogger -> IO a) -> IO a
withStdoutLogger app = bracket setup teardown $ \(aplogger, _) ->
app aplogger
where
setup = do
(getter, _updater) <- clockDateCacher
apf <- initLogger FromFallback (LogStdout 4096) getter
let aplogger = apacheLogger apf
remover = logRemover apf
return (aplogger, remover)
teardown (_, remover) = void remover
type ApacheLogger = Request -> Status -> Maybe Integer -> IO ()
data ApacheLoggerActions = ApacheLoggerActions {
apacheLogger :: ApacheLogger
, logRotator :: IO ()
, logRemover :: IO ()
}
data LogType = LogNone
| LogStdout BufSize
| LogFile FileLogSpec BufSize
| LogCallback (LogStr -> IO ()) (IO ())
initLogger :: IPAddrSource -> LogType -> DateCacheGetter
-> IO ApacheLoggerActions
initLogger _ LogNone _ = noLoggerInit
initLogger ipsrc (LogStdout size) dateget = stdoutLoggerInit ipsrc size dateget
initLogger ipsrc (LogFile spec size) dateget = fileLoggerInit ipsrc spec size dateget
initLogger ipsrc (LogCallback cb flush) dateget = callbackLoggerInit ipsrc cb flush dateget
noLoggerInit :: IO ApacheLoggerActions
noLoggerInit = return ApacheLoggerActions {
apacheLogger = noLogger
, logRotator = noRotator
, logRemover = noRemover
}
where
noLogger _ _ _ = return ()
noRotator = return ()
noRemover = return ()
stdoutLoggerInit :: IPAddrSource -> BufSize -> DateCacheGetter
-> IO ApacheLoggerActions
stdoutLoggerInit ipsrc size dateget = do
lgrset <- newStdoutLoggerSet size
let logger = apache (pushLogStr lgrset) ipsrc dateget
noRotator = return ()
remover = rmLoggerSet lgrset
return ApacheLoggerActions {
apacheLogger = logger
, logRotator = noRotator
, logRemover = remover
}
fileLoggerInit :: IPAddrSource -> FileLogSpec -> BufSize -> DateCacheGetter
-> IO ApacheLoggerActions
fileLoggerInit ipsrc spec size dateget = do
lgrset <- newFileLoggerSet size $ log_file spec
let logger = apache (pushLogStr lgrset) ipsrc dateget
rotator = logFileRotator lgrset spec
remover = rmLoggerSet lgrset
return ApacheLoggerActions {
apacheLogger = logger
, logRotator = rotator
, logRemover = remover
}
callbackLoggerInit :: IPAddrSource -> (LogStr -> IO ()) -> IO () -> DateCacheGetter
-> IO ApacheLoggerActions
callbackLoggerInit ipsrc cb flush dateget = do
flush' <- mkAutoUpdate defaultUpdateSettings
{ updateAction = flush
}
let logger a b c = apache cb ipsrc dateget a b c >> flush'
noRotator = return ()
remover = return ()
return ApacheLoggerActions {
apacheLogger = logger
, logRotator = noRotator
, logRemover = remover
}
apache :: (LogStr -> IO ()) -> IPAddrSource -> DateCacheGetter -> ApacheLogger
apache cb ipsrc dateget req st mlen = do
zdata <- dateget
cb (apacheLogStr ipsrc zdata req st mlen)
logFileRotator :: LoggerSet -> FileLogSpec -> IO ()
logFileRotator lgrset spec = do
over <- isOver
when over $ do
rotate spec
renewLoggerSet lgrset
where
file = log_file spec
isOver = handle (\(SomeException _) -> return False) $ do
siz <- withFile file ReadMode hFileSize
return (siz > log_file_size spec)
logCheck :: LogType -> IO ()
logCheck LogNone = return ()
logCheck (LogStdout _) = return ()
logCheck (LogFile spec _) = check spec
logCheck (LogCallback _ _) = return ()