{-# 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 app :: 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
$ \(aplogger :: ApacheLogger
aplogger, _) ->
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 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 (_, remover :: 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 ipsrc :: IPAddrSource
ipsrc typ :: LogType
typ tgetter :: IO FormattedTime
tgetter = do
(fl :: LogStr -> IO ()
fl, cleanUp :: 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
$ $WApacheLoggerActions :: 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 LogNone = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
logCheck (LogStdout _) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
logCheck (LogStderr _) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
logCheck (LogFileNoRotate fp :: FilePath
fp _) = FilePath -> IO ()
check FilePath
fp
logCheck (LogFile spec :: FileLogSpec
spec _) = FilePath -> IO ()
check (FileLogSpec -> FilePath
log_file FileLogSpec
spec)
logCheck (LogFileTimedRotate spec :: TimedFileLogSpec
spec _) = FilePath -> IO ()
check (TimedFileLogSpec -> FilePath
timed_log_file TimedFileLogSpec
spec)
logCheck (LogCallback _ _) = () -> 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 cb :: LogStr -> IO ()
cb ipsrc :: IPAddrSource
ipsrc dateget :: IO FormattedTime
dateget req :: Request
req st :: Status
st mlen :: 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 cb :: LogStr -> IO ()
cb ipsrc :: IPAddrSource
ipsrc dateget :: IO FormattedTime
dateget req :: Request
req path :: FormattedTime
path size :: 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 ())