{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
module Network.Wai.Logger (
ApacheLogger
, withStdoutLogger
, ServerPushLogger
, ApacheLoggerActions
, apacheLogger
, serverpushLogger
, logRotator
, logRemover
, initLogger
, IPAddrSource(..)
, LogType'(..), LogType
, FileLogSpec(..)
, showSockAddr
, logCheck
, clockDateCacher
, ZonedDate
, DateCacheGetter
, DateCacheUpdater
) where
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative ((<$>))
#endif
import Control.Exception (bracket)
import Control.Monad (void)
import Data.ByteString (ByteString)
import Network.HTTP.Types (Status)
import Network.Wai (Request)
import System.Log.FastLogger
import Network.Wai.Logger.Apache
import Network.Wai.Logger.IP (showSockAddr)
withStdoutLogger :: (ApacheLogger -> IO a) -> IO a
withStdoutLogger :: (ApacheLogger -> IO a) -> IO a
withStdoutLogger ApacheLogger -> IO a
app = IO (ApacheLogger, IO ())
-> ((ApacheLogger, IO ()) -> IO ())
-> ((ApacheLogger, IO ()) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (ApacheLogger, IO ())
setup (ApacheLogger, IO ()) -> IO ()
forall (f :: * -> *) a a. Functor f => (a, f a) -> f ()
teardown (((ApacheLogger, IO ()) -> IO a) -> IO a)
-> ((ApacheLogger, IO ()) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(ApacheLogger
aplogger, IO ()
_) ->
ApacheLogger -> IO a
app ApacheLogger
aplogger
where
setup :: IO (ApacheLogger, IO ())
setup = do
IO FormattedTime
tgetter <- FormattedTime -> IO (IO FormattedTime)
newTimeCache FormattedTime
simpleTimeFormat
ApacheLoggerActions
apf <- IPAddrSource
-> LogType -> IO FormattedTime -> IO ApacheLoggerActions
initLogger IPAddrSource
FromFallback (BufSize -> LogType
LogStdout BufSize
4096) IO FormattedTime
tgetter
let aplogger :: ApacheLogger
aplogger = ApacheLoggerActions -> ApacheLogger
apacheLogger ApacheLoggerActions
apf
remover :: IO ()
remover = ApacheLoggerActions -> IO ()
logRemover ApacheLoggerActions
apf
(ApacheLogger, IO ()) -> IO (ApacheLogger, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ApacheLogger
aplogger, IO ()
remover)
teardown :: (a, f a) -> f ()
teardown (a
_, f a
remover) = f a -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f a
remover
type ApacheLogger = Request -> Status -> Maybe Integer -> IO ()
type ServerPushLogger = Request -> ByteString -> Integer -> IO ()
data ApacheLoggerActions = ApacheLoggerActions {
ApacheLoggerActions -> ApacheLogger
apacheLogger :: ApacheLogger
, ApacheLoggerActions -> ServerPushLogger
serverpushLogger :: ServerPushLogger
, ApacheLoggerActions -> IO ()
logRotator :: IO ()
, ApacheLoggerActions -> IO ()
logRemover :: IO ()
}
initLogger :: IPAddrSource -> LogType -> IO FormattedTime
-> IO ApacheLoggerActions
initLogger :: IPAddrSource
-> LogType -> IO FormattedTime -> IO ApacheLoggerActions
initLogger IPAddrSource
ipsrc LogType
typ IO FormattedTime
tgetter = do
(LogStr -> IO ()
fl, IO ()
cleanUp) <- LogType -> IO (LogStr -> IO (), IO ())
forall v. LogType' v -> IO (v -> IO (), IO ())
newFastLogger LogType
typ
ApacheLoggerActions -> IO ApacheLoggerActions
forall (m :: * -> *) a. Monad m => a -> m a
return (ApacheLoggerActions -> IO ApacheLoggerActions)
-> ApacheLoggerActions -> IO ApacheLoggerActions
forall a b. (a -> b) -> a -> b
$ ApacheLoggerActions :: ApacheLogger
-> ServerPushLogger -> IO () -> IO () -> ApacheLoggerActions
ApacheLoggerActions {
apacheLogger :: ApacheLogger
apacheLogger = (LogStr -> IO ())
-> IPAddrSource -> IO FormattedTime -> ApacheLogger
apache LogStr -> IO ()
fl IPAddrSource
ipsrc IO FormattedTime
tgetter
, serverpushLogger :: ServerPushLogger
serverpushLogger = (LogStr -> IO ())
-> IPAddrSource -> IO FormattedTime -> ServerPushLogger
serverpush LogStr -> IO ()
fl IPAddrSource
ipsrc IO FormattedTime
tgetter
, logRotator :: IO ()
logRotator = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, logRemover :: IO ()
logRemover = IO ()
cleanUp
}
logCheck :: LogType -> IO ()
logCheck :: LogType -> IO ()
logCheck LogType
LogNone = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
logCheck (LogStdout BufSize
_) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
logCheck (LogStderr BufSize
_) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
logCheck (LogFileNoRotate FilePath
fp BufSize
_) = FilePath -> IO ()
check FilePath
fp
logCheck (LogFile FileLogSpec
spec BufSize
_) = FilePath -> IO ()
check (FileLogSpec -> FilePath
log_file FileLogSpec
spec)
logCheck (LogFileTimedRotate TimedFileLogSpec
spec BufSize
_) = FilePath -> IO ()
check (TimedFileLogSpec -> FilePath
timed_log_file TimedFileLogSpec
spec)
logCheck (LogCallback LogStr -> IO ()
_ IO ()
_) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
apache :: (LogStr -> IO ()) -> IPAddrSource -> IO FormattedTime -> ApacheLogger
apache :: (LogStr -> IO ())
-> IPAddrSource -> IO FormattedTime -> ApacheLogger
apache LogStr -> IO ()
cb IPAddrSource
ipsrc IO FormattedTime
dateget Request
req Status
st Maybe Integer
mlen = do
FormattedTime
zdata <- IO FormattedTime
dateget
LogStr -> IO ()
cb (IPAddrSource
-> FormattedTime -> Request -> Status -> Maybe Integer -> LogStr
apacheLogStr IPAddrSource
ipsrc FormattedTime
zdata Request
req Status
st Maybe Integer
mlen)
serverpush :: (LogStr -> IO ()) -> IPAddrSource -> IO FormattedTime -> ServerPushLogger
serverpush :: (LogStr -> IO ())
-> IPAddrSource -> IO FormattedTime -> ServerPushLogger
serverpush LogStr -> IO ()
cb IPAddrSource
ipsrc IO FormattedTime
dateget Request
req FormattedTime
path Integer
size = do
FormattedTime
zdata <- IO FormattedTime
dateget
LogStr -> IO ()
cb (IPAddrSource
-> FormattedTime -> Request -> FormattedTime -> Integer -> LogStr
serverpushLogStr IPAddrSource
ipsrc FormattedTime
zdata Request
req FormattedTime
path Integer
size)
type DateCacheGetter = IO ZonedDate
type DateCacheUpdater = IO ()
type ZonedDate = FormattedTime
clockDateCacher :: IO (DateCacheGetter, DateCacheUpdater)
clockDateCacher :: IO (IO FormattedTime, IO ())
clockDateCacher = do
IO FormattedTime
tgetter <- FormattedTime -> IO (IO FormattedTime)
newTimeCache FormattedTime
simpleTimeFormat
(IO FormattedTime, IO ()) -> IO (IO FormattedTime, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO FormattedTime
tgetter, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())