wai-logger 2.2.0 → 2.5.0
raw patch · 8 files changed
Files
- Network/Wai/Logger.hs +94/−114
- Network/Wai/Logger/Apache.hs +176/−26
- Network/Wai/Logger/Date.hs +0/−84
- Network/Wai/Logger/IORef.hs +20/−0
- Network/Wai/Logger/IP.hs +1/−1
- Setup.hs +5/−0
- test/doctests.hs +0/−11
- wai-logger.cabal +36/−46
Network/Wai/Logger.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+ -- | Apache style logger for WAI applications. -- -- An example:@@ -5,7 +8,7 @@ -- > {-# LANGUAGE OverloadedStrings #-} -- > module Main where -- >--- > import Blaze.ByteString.Builder (fromByteString)+-- > import Data.ByteString.Builder (byteString) -- > import Control.Monad.IO.Class (liftIO) -- > import qualified Data.ByteString.Char8 as BS -- > import Network.HTTP.Types (status200)@@ -18,48 +21,54 @@ -- > run 3000 $ logApp aplogger -- > -- > logApp :: ApacheLogger -> Application--- > logApp aplogger req = do+-- > logApp aplogger req response = do -- > liftIO $ aplogger req status (Just len)--- > return $ responseBuilder status hdr msg+-- > response $ responseBuilder status hdr msg -- > where -- > status = status200--- > hdr = [("Content-Type", "text/plain")--- > ,("Content-Length", BS.pack (show len))]+-- > hdr = [("Content-Type", "text/plain")] -- > pong = "PONG"+-- > msg = byteString pong -- > len = fromIntegral $ BS.length pong--- > msg = toLogStr pong module Network.Wai.Logger ( -- * High level functions ApacheLogger , withStdoutLogger+ , ServerPushLogger -- * Creating a logger- , ApacheLoggerActions(..)+ , ApacheLoggerActions+ , apacheLogger+ , serverpushLogger+ , logRotator+ , logRemover+ , initLoggerUser , initLogger -- * Types , IPAddrSource(..)- , LogType(..)+ , LogType'(..), LogType , FileLogSpec(..)- -- * Date cacher+ -- * Utilities+ , showSockAddr+ , logCheck+ -- * Backward compability , clockDateCacher , ZonedDate , DateCacheGetter , DateCacheUpdater- -- * Utilities- , logCheck- , showSockAddr ) where -import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction)-import Control.Exception (handle, SomeException(..), bracket)-import Control.Monad (when, void)+#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.IO (withFile, hFileSize, IOMode(..)) import System.Log.FastLogger import Network.Wai.Logger.Apache-import Network.Wai.Logger.Date import Network.Wai.Logger.IP (showSockAddr) ----------------------------------------------------------------@@ -72,8 +81,8 @@ app aplogger where setup = do- (getter, _updater) <- clockDateCacher- apf <- initLogger FromFallback (LogStdout 4096) getter+ tgetter <- newTimeCache simpleTimeFormat+ apf <- initLogger FromFallback (LogStdout 4096) tgetter let aplogger = apacheLogger apf remover = logRemover apf return (aplogger, remover)@@ -84,118 +93,89 @@ -- | Apache style logger. type ApacheLogger = Request -> Status -> Maybe Integer -> IO () +-- | HTTP/2 server push logger in Apache style.+type ServerPushLogger = Request -> ByteString -> Integer -> IO ()++-- | Function set of Apache style logger. data ApacheLoggerActions = ApacheLoggerActions {+ -- | The Apache logger. apacheLogger :: ApacheLogger- -- | Rotating log files.- -- This is explicitly called from your program.- -- Probably, 10 seconds is proper.+ -- | The HTTP/2 server push logger.+ , serverpushLogger :: ServerPushLogger+ -- | This is obsoleted. Rotation is done on-demand.+ -- So, this is now an empty action. , logRotator :: IO ()- -- | Removing resources relating Apache logger.+ -- | Removing resources relating to Apache logger.+ -- E.g. flushing and deallocating internal buffers. , logRemover :: IO () } --- | Logger Type.-data LogType = LogNone -- ^ No logging.- | LogStdout BufSize -- ^ Logging to stdout.- -- 'BufSize' is a buffer size- -- for each capability.- | LogFile FileLogSpec BufSize -- ^ Logging to a file.- -- 'BufSize' is a buffer size- -- for each capability.- | LogCallback (LogStr -> IO ()) (IO ())- ---------------------------------------------------------------- --- |--- Creating 'ApacheLogger' according to 'LogType'.-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+-- | Creating 'ApacheLogger' according to 'LogType'.+initLoggerUser :: ToLogStr user => Maybe (Request -> Maybe user) -> IPAddrSource -> LogType -> IO FormattedTime -> 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+initLoggerUser ugetter ipsrc typ tgetter = do+ (fl, cleanUp) <- newFastLogger typ+ return $ ApacheLoggerActions {+ apacheLogger = apache fl ipsrc ugetter tgetter+ , serverpushLogger = serverpush fl ipsrc ugetter tgetter+ , logRotator = return ()+ , logRemover = cleanUp } -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- }+initLogger :: IPAddrSource -> LogType -> IO FormattedTime+ -> IO ApacheLoggerActions+initLogger = initLoggerUser nouser+ where+ nouser :: Maybe (Request -> Maybe ByteString)+ nouser = Nothing +--- | Checking if a log file can be written if 'LogType' is 'LogFileNoRotate' or 'LogFile'.+logCheck :: LogType -> IO ()+logCheck LogNone = return ()+logCheck (LogStdout _) = return ()+logCheck (LogStderr _) = return ()+logCheck (LogFileNoRotate fp _) = check fp+logCheck (LogFile spec _) = check (log_file spec)+logCheck (LogFileTimedRotate spec _) = check (timed_log_file spec)+logCheck (LogCallback _ _) = return ()+ ---------------------------------------------------------------- -apache :: (LogStr -> IO ()) -> IPAddrSource -> DateCacheGetter -> ApacheLogger-apache cb ipsrc dateget req st mlen = do+apache :: ToLogStr user => (LogStr -> IO ()) -> IPAddrSource -> Maybe (Request -> Maybe user) -> IO FormattedTime -> ApacheLogger+apache cb ipsrc userget dateget req st mlen = do zdata <- dateget- cb (apacheLogStr ipsrc zdata req st mlen)+ cb (apacheLogStr ipsrc (justGetUser userget) zdata req st mlen) -----------------------------------------------------------------+serverpush :: ToLogStr user => (LogStr -> IO ()) -> IPAddrSource -> Maybe (Request -> Maybe user) -> IO FormattedTime -> ServerPushLogger+serverpush cb ipsrc userget dateget req path size = do+ zdata <- dateget+ cb (serverpushLogStr ipsrc (justGetUser userget) zdata req path size) -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)+--------------------------------------------------------------- -----------------------------------------------------------------+-- | Getting cached 'ZonedDate'.+type DateCacheGetter = IO ZonedDate +-- | Updateing cached 'ZonedDate'. This should be called every second.+-- See the source code of 'withStdoutLogger'.+type DateCacheUpdater = IO ()++-- | A type for zoned date.+type ZonedDate = FormattedTime+ -- |--- Checking if a log file can be written if 'LogType' is 'LogFile'.-logCheck :: LogType -> IO ()-logCheck LogNone = return ()-logCheck (LogStdout _) = return ()-logCheck (LogFile spec _) = check spec-logCheck (LogCallback _ _) = return ()+-- Returning 'DateCacheGetter' and 'DateCacheUpdater'.+--+-- Note: Since version 2.1.2, this function uses the auto-update package+-- internally, and therefore the @DateCacheUpdater@ value returned need+-- not be called. To wit, the return value is in fact an empty action.+clockDateCacher :: IO (DateCacheGetter, DateCacheUpdater)+clockDateCacher = do+ tgetter <- newTimeCache simpleTimeFormat+ return (tgetter, return ())++justGetUser :: Maybe (Request -> Maybe user) -> (Request -> Maybe user)+justGetUser (Just getter) = getter+justGetUser Nothing = \_ -> Nothing
Network/Wai/Logger/Apache.hs view
@@ -1,53 +1,78 @@-{-# LANGUAGE OverloadedStrings, CPP #-}+{-# LANGUAGE OverloadedStrings, CPP, TupleSections #-} module Network.Wai.Logger.Apache ( IPAddrSource(..) , apacheLogStr+ , serverpushLogStr ) where #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif+#ifndef MIN_VERSION_wai+#define MIN_VERSION_wai(x,y,z) 1+#endif import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS-import Data.CaseInsensitive (CI) import Data.List (find) import Data.Maybe (fromMaybe) #if MIN_VERSION_base(4,5,0)-import Data.Monoid ((<>))+import Data.Monoid ((<>), First (..)) #else import Data.Monoid (mappend) #endif import Network.HTTP.Types (Status, statusCode)+import Network.HTTP.Types.Header (HeaderName) import Network.Wai (Request(..))-import Network.Wai.Logger.Date import Network.Wai.Logger.IP import System.Log.FastLogger -- $setup -- >>> :set -XOverloadedStrings--- >>> import Network.Wai.Test+-- >>> import Network.Wai (defaultRequest) -- | Source from which the IP source address of the client is obtained. data IPAddrSource = -- | From the peer address of the HTTP connection. FromSocket- -- | From X-Real-IP: or X-Forwarded-For: in the HTTP header.+ -- | From @X-Real-IP@ or @X-Forwarded-For@ in the HTTP header.+ --+ -- This picks either @X-Real-IP@ or @X-Forwarded-For@ depending on which of these+ -- headers comes first in the ordered list of request headers.+ --+ -- If the @X-Forwarded-For@ header is picked, the value will be assumed to be a+ -- comma-separated list of IP addresses. The value will be parsed, and the+ -- left-most IP address will be used (which is mostly likely to be the actual+ -- client IP address). | FromHeader- -- | From the peer address if header is not found.+ -- | From a custom HTTP header, useful in proxied environment.+ --+ -- The header value will be assumed to be a comma-separated list of IP+ -- addresses. The value will be parsed, and the left-most IP address will be+ -- used (which is mostly likely to be the actual client IP address).+ --+ -- Note that this still works as expected for a single IP address.+ | FromHeaderCustom [HeaderName]+ -- | Just like 'FromHeader', but falls back on the peer address if header is not found. | FromFallback+ -- | This gives you the most flexibility to figure out the IP source address+ -- from the 'Request'. The returned 'ByteString' is used as the IP source+ -- address.+ | FromRequest (Request -> ByteString) -- | Apache style log format.-apacheLogStr :: IPAddrSource -> ZonedDate -> Request -> Status -> Maybe Integer -> LogStr-apacheLogStr ipsrc tmstr req status msize =+apacheLogStr :: ToLogStr user => IPAddrSource -> (Request -> Maybe user) -> FormattedTime -> Request -> Status -> Maybe Integer -> LogStr+apacheLogStr ipsrc userget tmstr req status msize = toLogStr (getSourceIP ipsrc req)- <> " - - ["+ <> " - "+ <> maybe "-" toLogStr (userget req)+ <> " [" <> toLogStr tmstr <> "] \"" <> toLogStr (requestMethod req) <> " "- <> toLogStr (rawPathInfo req)+ <> toLogStr path <> " " <> toLogStr (show (httpVersion req)) <> "\" "@@ -55,24 +80,57 @@ <> " " <> toLogStr (maybe "-" show msize) <> " \""- <> toLogStr (lookupRequestField' "referer" req)+ <> toLogStr (fromMaybe "" mr) <> "\" \""- <> toLogStr (lookupRequestField' "user-agent" req)+ <> toLogStr (fromMaybe "" mua) <> "\"\n" where+ path = rawPathInfo req <> rawQueryString req #if !MIN_VERSION_base(4,5,0) (<>) = mappend #endif--lookupRequestField' :: CI ByteString -> Request -> ByteString-lookupRequestField' k req = fromMaybe "" . lookup k $ requestHeaders req+#if MIN_VERSION_wai(3,2,0)+ mr = requestHeaderReferer req+ mua = requestHeaderUserAgent req+#else+ mr = lookup "referer" $ requestHeaders req+ mua = lookup "user-agent" $ requestHeaders req+#endif --- getSourceIP = getSourceIP fromString fromByteString+-- | HTTP/2 Push log format in the Apache style.+serverpushLogStr :: ToLogStr user => IPAddrSource -> (Request -> Maybe user) -> FormattedTime -> Request -> ByteString -> Integer -> LogStr+serverpushLogStr ipsrc userget tmstr req path size =+ toLogStr (getSourceIP ipsrc req)+ <> " - "+ <> maybe "-" toLogStr (userget req)+ <> " ["+ <> toLogStr tmstr+ <> "] \"PUSH "+ <> toLogStr path+ <> " HTTP/2\" 200 "+ <> toLogStr (show size)+ <> " \""+ <> toLogStr ref+ <> "\" \""+ <> toLogStr (fromMaybe "" mua)+ <> "\"\n"+ where+ ref = rawPathInfo req+#if !MIN_VERSION_base(4,5,0)+ (<>) = mappend+#endif+#if MIN_VERSION_wai(3,2,0)+ mua = requestHeaderUserAgent req+#else+ mua = lookup "user-agent" $ requestHeaders req+#endif getSourceIP :: IPAddrSource -> Request -> ByteString-getSourceIP FromSocket = getSourceFromSocket-getSourceIP FromHeader = getSourceFromHeader+getSourceIP FromSocket = getSourceFromSocket+getSourceIP FromHeader = getSourceFromHeader getSourceIP FromFallback = getSourceFromFallback+getSourceIP (FromHeaderCustom hs) = fromMaybe "-" . getSourceFromHeaderCustom hs+getSourceIP (FromRequest fromReq) = fromReq -- | -- >>> getSourceFromSocket defaultRequest@@ -86,11 +144,25 @@ -- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Forwarded-For", "127.0.0.1") ] } -- "127.0.0.1" -- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("Something", "127.0.0.1") ] }--- ""+-- "-" -- >>> getSourceFromHeader defaultRequest { requestHeaders = [] }--- ""+-- "-"+--+-- 'getSourceFromHeader' uses the first instance of either @"X-Real-IP"@ or+-- @"X-Forwarded-For"@ that it finds in the ordered header list:+--+-- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Real-IP", "1.2.3.4"), ("X-Forwarded-For", "5.6.7.8") ] }+-- "1.2.3.4"+-- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8"), ("X-Real-IP", "1.2.3.4") ] }+-- "5.6.7.8"+--+-- 'getSourceFromHeader' handles pulling out the first IP in the+-- comma-separated IP list in X-Forwarded-For:+--+-- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8, 10.11.12.13, 1.2.3.4") ] }+-- "5.6.7.8" getSourceFromHeader :: Request -> ByteString-getSourceFromHeader = fromMaybe "" . getSource+getSourceFromHeader = fromMaybe "-" . getSource -- | -- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] }@@ -101,6 +173,20 @@ -- "0.0.0.0" -- >>> getSourceFromFallback defaultRequest { requestHeaders = [] } -- "0.0.0.0"+--+-- 'getSourceFromFallback' uses the first instance of either @"X-Real-IP"@ or+-- @"X-Forwarded-For"@ that it finds in the ordered header list:+--+-- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Real-IP", "1.2.3.4"), ("X-Forwarded-For", "5.6.7.8") ] }+-- "1.2.3.4"+-- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8"), ("X-Real-IP", "1.2.3.4") ] }+-- "5.6.7.8"+--+-- 'getSourceFromFallback' handles pulling out the first IP in the+-- comma-separated IP list in X-Forwarded-For:+--+-- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8, 10.11.12.13, 1.2.3.4") ] }+-- "5.6.7.8" getSourceFromFallback :: Request -> ByteString getSourceFromFallback req = fromMaybe (getSourceFromSocket req) $ getSource req @@ -113,9 +199,73 @@ -- Nothing -- >>> getSource defaultRequest -- Nothing+--+-- 'getSource' uses the first instance of either @"X-Real-IP"@ or+-- @"X-Forwarded-For"@ that it finds in the ordered header list:+--+-- >>> getSource defaultRequest { requestHeaders = [ ("X-Real-IP", "1.2.3.4"), ("X-Forwarded-For", "5.6.7.8") ] }+-- Just "1.2.3.4"+-- >>> getSource defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8"), ("X-Real-IP", "1.2.3.4") ] }+-- Just "5.6.7.8"+--+-- 'getSource' handles pulling out the first IP in the comma-separated IP list+-- in X-Forwarded-For:+--+-- >>> getSource defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8, 10.11.12.13, 1.2.3.4") ] }+-- Just "5.6.7.8" getSource :: Request -> Maybe ByteString-getSource req = addr+getSource = getSourceFromHeaders [("x-real-ip", id), ("x-forwarded-for", firstIpInXFF)]++-- | Pull out the first IP in a comma-separated list of X-Forwarded-For IPs.+--+-- >>> firstIpInXFF "1.2.3.4, 5.6.7.8, 10.11.12.13"+-- "1.2.3.4"+--+-- If there are no commas, just return the whole input ByteString:+--+-- >>> firstIpInXFF "5.6.7.8"+-- "5.6.7.8"+--+-- Note that this function doesn't make sure the input is actually an IP address:+--+-- >>> firstIpInXFF "hello, world"+-- "hello"+firstIpInXFF :: ByteString -> ByteString+firstIpInXFF = BS.takeWhile (/= ',')++getSourceFromHeaders :: [(HeaderName, ByteString -> ByteString)] -> Request -> Maybe ByteString+getSourceFromHeaders headerNamesAndPostProc req = getFirst $ foldMap f $ requestHeaders req where- maddr = find (\x -> fst x `elem` ["x-real-ip", "x-forwarded-for"]) hdrs- addr = fmap snd maddr- hdrs = requestHeaders req+ -- Take a header name and value from the request, and try match it against+ -- the list of headers and post-processing functions. If it matches,+ -- return the ByteString resulting from applying the post-processing function+ -- to the header value.+ f :: (HeaderName, ByteString) -> First ByteString+ f (headerNameFromReq, headerValFromReq) =+ let maybePostProc = find (\(headerNameFromPostProc, _) -> headerNameFromReq == headerNameFromPostProc) headerNamesAndPostProc+ in First $ fmap (\(_, postProc) -> postProc headerValFromReq) maybePostProc++-- |+-- >>> getSourceFromHeaderCustom ["x-foobar"] defaultRequest { requestHeaders = [ ("X-catdog", "1.2.3.4"), ("X-Foobar", "5.6.7.8"), ("Other", "1.1.1.1") ] }+-- Just "5.6.7.8"+--+-- If none of the headers in the passed-in list are in the 'Request', then return 'Nothing':+--+-- >>> getSourceFromHeaderCustom ["x-foobar", "baz"] defaultRequest { requestHeaders = [ ("abb", "1.2.3.4"), ("xyz", "5.6.7.8") ] }+-- Nothing+--+-- 'getSourceFromHeaderCustom' uses the first instance of any header in the+-- passed in list that it finds in the ordered header list from the request:+--+-- >>> getSourceFromHeaderCustom ["x-foobar", "baz"] defaultRequest { requestHeaders = [ ("baz", "1.2.3.4"), ("x-foobar", "5.6.7.8") ] }+-- Just "1.2.3.4"+--+-- 'getSourceFromHeaderCustom' splits the value of the header it finds by @,@+-- and uses the first item. This makes it easy to use with headers like+-- @X-Forwarded-For@, which are expected to have a comma-separated list of IP+-- addresses:+--+-- >>> getSourceFromHeaderCustom ["x-foobar"] defaultRequest { requestHeaders = [ ("X-Foobar", "5.6.7.8, 10.11.12.13, 1.2.3.4") ] }+-- Just "5.6.7.8"+getSourceFromHeaderCustom :: [HeaderName] -> Request -> Maybe ByteString+getSourceFromHeaderCustom hs = getSourceFromHeaders (fmap (,firstIpInXFF) hs)
− Network/Wai/Logger/Date.hs
@@ -1,84 +0,0 @@-{-# LANGUAGE CPP, OverloadedStrings #-}---- |--- Formatting time is slow.--- This package provides mechanisms to cache formatted date.-module Network.Wai.Logger.Date (- -- * Types- DateCacheGetter- , DateCacheUpdater- , ZonedDate- -- * Cache configuration- , DateCacheConf(..)- , zonedDateCacheConf- -- * Date cacher- , clockDateCacher- ) where--import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction)-import Data.ByteString (ByteString)-#if WINDOWS-import qualified Data.ByteString.Char8 as BS-import Data.Time-import System.Locale-#else-import Data.UnixTime (formatUnixTime, fromEpochTime)-import System.Posix (EpochTime, epochTime)-#endif---------------------------------------------------------------------- | Getting cached 'ZonedDate'.-type DateCacheGetter = IO ZonedDate--- | Updateing cached 'ZonedDate'. This should be called every second.--- See the source code of 'withStdoutLogger'.-type DateCacheUpdater = IO ()---------------------------------------------------------------------- | A type for zoned date.-type ZonedDate = ByteString--------------------------------------------------------------------data DateCacheConf t = DateCacheConf {- -- | A function to get a time. E.g 'epochTime' and 'getCurrentTime'.- getTime :: IO t- -- | A function to format a time.- , formatDate :: t -> IO ByteString- }--#if WINDOWS--- | Zoned date cacher using UTC.-zonedDateCacheConf :: DateCacheConf UTCTime-zonedDateCacheConf = DateCacheConf {- getTime = getCurrentTime- , formatDate = \ut -> do- zt <- utcToLocalZonedTime ut- return $ BS.pack $ formatTime defaultTimeLocale "%d/%b/%Y:%T %z" zt- }-#else--- | Zoned date cacher using UnixTime.-zonedDateCacheConf :: DateCacheConf EpochTime-zonedDateCacheConf = DateCacheConf {- getTime = epochTime- , formatDate = formatUnixTime "%d/%b/%Y:%T %z" . fromEpochTime- }-#endif---------------------------------------------------------------------- |--- Returning 'DateCacheGetter' and 'DateCacheUpdater'.------ Note: Since version 2.1.2, this function uses the auto-update package--- internally, and therefore the @DateCacheUpdater@ value returned need--- not be called. To wit, the return value is in fact an empty action.--clockDateCacher :: IO (DateCacheGetter, DateCacheUpdater)-clockDateCacher = do- getter <- mkAutoUpdate defaultUpdateSettings- { updateAction = getTime zonedDateCacheConf- >>= formatDate zonedDateCacheConf- }- return (getter, return ())
+ Network/Wai/Logger/IORef.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE CPP #-}++module Network.Wai.Logger.IORef (+ IORef+ , newIORef+ , readIORef+ , writeIORef+ , atomicModifyIORef'+ ) where++import Data.IORef++#if !MIN_VERSION_base(4, 6, 0)+atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b+atomicModifyIORef' ref f = do+ b <- atomicModifyIORef ref+ (\x -> let (a, b) = f x+ in (a, a `seq` b))+ b `seq` return b+#endif
Network/Wai/Logger/IP.hs view
@@ -46,4 +46,4 @@ showSockAddr (SockAddrInet6 _ _ (0,0,0x0000ffff,addr4) _) = showIPv4 addr4 False showSockAddr (SockAddrInet6 _ _ (0,0,0,1) _) = "::1" showSockAddr (SockAddrInet6 _ _ addr6 _) = showIPv6 addr6-showSockAddr _ = "unknownSocket"+showSockAddr (SockAddrUnix _) = "-"
Setup.hs view
@@ -1,2 +1,7 @@+{-# OPTIONS_GHC -Wall #-}+module Main (main) where+ import Distribution.Simple++main :: IO () main = defaultMain
− test/doctests.hs
@@ -1,11 +0,0 @@-module Main where--import Test.DocTest--main :: IO ()-main = doctest [- "-idist/build/autogen/"- , "-optP-include"- , "-optPdist/build/autogen/cabal_macros.h"- , "Network/Wai/Logger.hs"- ]
wai-logger.cabal view
@@ -1,49 +1,39 @@-Name: wai-logger-Version: 2.2.0-Author: Kazu Yamamoto <kazu@iij.ad.jp>-Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>-License: BSD3-License-File: LICENSE-Synopsis: A logging system for WAI-Description: A logging system for WAI-Category: Web, Yesod-Cabal-Version: >= 1.10-Build-Type: Simple+cabal-version: >=1.10+name: wai-logger+version: 2.5.0+license: BSD3+license-file: LICENSE+maintainer: Kazu Yamamoto <kazu@iij.ad.jp>+author: Kazu Yamamoto <kazu@iij.ad.jp>+tested-with:+ ghc ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.3 -Library- Default-Language: Haskell2010- GHC-Options: -Wall- Exposed-Modules: Network.Wai.Logger- Other-Modules: Network.Wai.Logger.Apache- Network.Wai.Logger.Date- Network.Wai.Logger.IP- Build-Depends: base >= 4 && < 5- , auto-update- , blaze-builder- , byteorder- , bytestring- , case-insensitive- , fast-logger >= 2.2- , http-types- , network- , wai >= 2.0.0- if os(windows)- Cpp-Options: -DWINDOWS- Build-Depends: time- , old-locale- else- Build-Depends: unix- , unix-time >= 0.2.2+synopsis: A logging system for WAI+description: A logging system for WAI(Web Application Interface)+category: Web, Yesod+build-type: Simple -Test-Suite doctest- Type: exitcode-stdio-1.0- Default-Language: Haskell2010- HS-Source-Dirs: test- Ghc-Options: -Wall- Main-Is: doctests.hs- Build-Depends: base- , doctest+source-repository head+ type: git+ location: https://github.com/kazu-yamamoto/logger.git -Source-Repository head- Type: git- Location: git://github.com/kazu-yamamoto/logger.git+library+ exposed-modules: Network.Wai.Logger+ other-modules:+ Network.Wai.Logger.Apache+ Network.Wai.Logger.IP+ Network.Wai.Logger.IORef++ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4 && <5,+ byteorder,+ bytestring,+ fast-logger >=3,+ http-types,+ network,+ wai >=2.0.0++ if impl(ghc >=8)+ default-extensions: Strict StrictData