wai-logger-2.4.0/0000755000000000000000000000000007346545000011743 5ustar0000000000000000wai-logger-2.4.0/LICENSE0000644000000000000000000000276507346545000012762 0ustar0000000000000000Copyright (c) 2009, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. wai-logger-2.4.0/Network/Wai/0000755000000000000000000000000007346545000014114 5ustar0000000000000000wai-logger-2.4.0/Network/Wai/Logger.hs0000644000000000000000000001371407346545000015675 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} -- | Apache style logger for WAI applications. -- -- An example: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > module Main where -- > -- > import Data.ByteString.Builder (byteString) -- > import Control.Monad.IO.Class (liftIO) -- > import qualified Data.ByteString.Char8 as BS -- > import Network.HTTP.Types (status200) -- > import Network.Wai (Application, responseBuilder) -- > import Network.Wai.Handler.Warp (run) -- > import Network.Wai.Logger (withStdoutLogger, ApacheLogger) -- > -- > main :: IO () -- > main = withStdoutLogger $ \aplogger -> -- > run 3000 $ logApp aplogger -- > -- > logApp :: ApacheLogger -> Application -- > logApp aplogger req response = do -- > liftIO $ aplogger req status (Just len) -- > response $ responseBuilder status hdr msg -- > where -- > status = status200 -- > hdr = [("Content-Type", "text/plain")] -- > pong = "PONG" -- > msg = byteString pong -- > len = fromIntegral $ BS.length pong module Network.Wai.Logger ( -- * High level functions ApacheLogger , withStdoutLogger , ServerPushLogger -- * Creating a logger , ApacheLoggerActions , apacheLogger , serverpushLogger , logRotator , logRemover , initLoggerUser , initLogger -- * Types , IPAddrSource(..) , LogType'(..), LogType , FileLogSpec(..) -- * Utilities , showSockAddr , logCheck -- * Backward compability , 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) ---------------------------------------------------------------- -- | Executing a function which takes 'ApacheLogger'. -- This 'ApacheLogger' writes log message to stdout. -- Each buffer (4K bytes) is flushed every second. withStdoutLogger :: (ApacheLogger -> IO a) -> IO a withStdoutLogger app = bracket setup teardown $ \(aplogger, _) -> app aplogger where setup = do tgetter <- newTimeCache simpleTimeFormat apf <- initLogger FromFallback (LogStdout 4096) tgetter let aplogger = apacheLogger apf remover = logRemover apf return (aplogger, remover) teardown (_, remover) = void remover ---------------------------------------------------------------- -- | 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 -- | 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 to Apache logger. -- E.g. flushing and deallocating internal buffers. , logRemover :: IO () } ---------------------------------------------------------------- -- | Creating 'ApacheLogger' according to 'LogType'. initLoggerUser :: ToLogStr user => Maybe (Request -> Maybe user) -> IPAddrSource -> LogType -> IO FormattedTime -> IO ApacheLoggerActions 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 } 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 :: 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 (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) --------------------------------------------------------------- -- | 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 -- | -- 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 wai-logger-2.4.0/Network/Wai/Logger/0000755000000000000000000000000007346545000015333 5ustar0000000000000000wai-logger-2.4.0/Network/Wai/Logger/Apache.hs0000644000000000000000000001130507346545000017050 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, CPP #-} 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.List (find) import Data.Maybe (fromMaybe) #if MIN_VERSION_base(4,5,0) import Data.Monoid ((<>)) #else import Data.Monoid (mappend) #endif import Network.HTTP.Types (Status, statusCode) import Network.Wai (Request(..)) import Network.Wai.Logger.IP import System.Log.FastLogger -- $setup -- >>> :set -XOverloadedStrings -- >>> 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. | FromHeader -- | From the peer address if header is not found. | FromFallback -- | Apache style log format. 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 path <> " " <> toLogStr (show (httpVersion req)) <> "\" " <> toLogStr (show (statusCode status)) <> " " <> toLogStr (maybe "-" show msize) <> " \"" <> toLogStr (fromMaybe "" mr) <> "\" \"" <> toLogStr (fromMaybe "" mua) <> "\"\n" where path = rawPathInfo req <> rawQueryString req #if !MIN_VERSION_base(4,5,0) (<>) = mappend #endif #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 -- | 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 = getSourceIP fromString fromByteString getSourceIP :: IPAddrSource -> Request -> ByteString getSourceIP FromSocket = getSourceFromSocket getSourceIP FromHeader = getSourceFromHeader getSourceIP FromFallback = getSourceFromFallback -- | -- >>> getSourceFromSocket defaultRequest -- "0.0.0.0" getSourceFromSocket :: Request -> ByteString getSourceFromSocket = BS.pack . showSockAddr . remoteHost -- | -- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] } -- "127.0.0.1" -- >>> 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 :: Request -> ByteString getSourceFromHeader = fromMaybe "-" . getSource -- | -- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] } -- "127.0.0.1" -- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Forwarded-For", "127.0.0.1") ] } -- "127.0.0.1" -- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("Something", "127.0.0.1") ] } -- "0.0.0.0" -- >>> getSourceFromFallback defaultRequest { requestHeaders = [] } -- "0.0.0.0" getSourceFromFallback :: Request -> ByteString getSourceFromFallback req = fromMaybe (getSourceFromSocket req) $ getSource req -- | -- >>> getSource defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] } -- Just "127.0.0.1" -- >>> getSource defaultRequest { requestHeaders = [ ("X-Forwarded-For", "127.0.0.1") ] } -- Just "127.0.0.1" -- >>> getSource defaultRequest { requestHeaders = [ ("Something", "127.0.0.1") ] } -- Nothing -- >>> getSource defaultRequest -- Nothing getSource :: Request -> Maybe ByteString getSource req = addr where maddr = find (\x -> fst x `elem` ["x-real-ip", "x-forwarded-for"]) hdrs addr = fmap snd maddr hdrs = requestHeaders req wai-logger-2.4.0/Network/Wai/Logger/IORef.hs0000644000000000000000000000065407346545000016640 0ustar0000000000000000{-# 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 wai-logger-2.4.0/Network/Wai/Logger/IP.hs0000644000000000000000000000331307346545000016177 0ustar0000000000000000module Network.Wai.Logger.IP ( NumericAddress, showSockAddr ) where import Data.Bits (shift, (.&.)) import Data.Word (Word32) import Network.Socket (SockAddr(..)) import System.ByteOrder (ByteOrder(..), byteOrder) import Text.Printf (printf) -- | A type for IP address in numeric string representation. type NumericAddress = String showIPv4 :: Word32 -> Bool -> NumericAddress showIPv4 w32 little | little = show b1 ++ "." ++ show b2 ++ "." ++ show b3 ++ "." ++ show b4 | otherwise = show b4 ++ "." ++ show b3 ++ "." ++ show b2 ++ "." ++ show b1 where t1 = w32 t2 = shift t1 (-8) t3 = shift t2 (-8) t4 = shift t3 (-8) b1 = t1 .&. 0x000000ff b2 = t2 .&. 0x000000ff b3 = t3 .&. 0x000000ff b4 = t4 .&. 0x000000ff showIPv6 :: (Word32,Word32,Word32,Word32) -> String showIPv6 (w1,w2,w3,w4) = printf "%x:%x:%x:%x:%x:%x:%x:%x" s1 s2 s3 s4 s5 s6 s7 s8 where (s1,s2) = split16 w1 (s3,s4) = split16 w2 (s5,s6) = split16 w3 (s7,s8) = split16 w4 split16 w = (h1,h2) where h1 = shift w (-16) .&. 0x0000ffff h2 = w .&. 0x0000ffff -- | Convert 'SockAddr' to 'NumericAddress'. If the address is -- IPv4-embedded IPv6 address, the IPv4 is extracted. showSockAddr :: SockAddr -> NumericAddress -- HostAddr is network byte order. showSockAddr (SockAddrInet _ addr4) = showIPv4 addr4 (byteOrder == LittleEndian) -- HostAddr6 is host byte order. showSockAddr (SockAddrInet6 _ _ (0,0,0x0000ffff,addr4) _) = showIPv4 addr4 False showSockAddr (SockAddrInet6 _ _ (0,0,0,1) _) = "::1" showSockAddr (SockAddrInet6 _ _ addr6 _) = showIPv6 addr6 showSockAddr (SockAddrUnix _) = "-" wai-logger-2.4.0/Setup.hs0000644000000000000000000000150107346545000013374 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module Main (main) where #ifndef MIN_VERSION_cabal_doctest #define MIN_VERSION_cabal_doctest(x,y,z) 0 #endif #if MIN_VERSION_cabal_doctest(1,0,0) import Distribution.Extra.Doctest ( defaultMainWithDoctests ) main :: IO () main = defaultMainWithDoctests "doctests" #else #ifdef MIN_VERSION_Cabal -- If the macro is defined, we have new cabal-install, -- but for some reason we don't have cabal-doctest in package-db -- -- Probably we are running cabal sdist, when otherwise using new-build -- workflow #warning You are configuring this package without cabal-doctest installed. \ The doctests test-suite will not work as a result. \ To fix this, install cabal-doctest before configuring. #endif import Distribution.Simple main :: IO () main = defaultMain #endif wai-logger-2.4.0/test/0000755000000000000000000000000007346545000012722 5ustar0000000000000000wai-logger-2.4.0/test/doctests.hs0000644000000000000000000000037707346545000015115 0ustar0000000000000000module Main where import Build_doctests (flags, pkgs, module_sources) import Data.Foldable (traverse_) import Test.DocTest (doctest) main :: IO () main = do traverse_ putStrLn args doctest args where args = flags ++ pkgs ++ module_sources wai-logger-2.4.0/wai-logger.cabal0000644000000000000000000000320707346545000014766 0ustar0000000000000000Name: wai-logger Version: 2.4.0 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto 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: Custom Tested-With: GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.3 Custom-Setup Setup-Depends: base, Cabal, cabal-doctest >=1.0.6 && <1.1 Library Default-Language: Haskell2010 GHC-Options: -Wall Exposed-Modules: Network.Wai.Logger Other-Modules: Network.Wai.Logger.Apache Network.Wai.Logger.IP Network.Wai.Logger.IORef 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 Test-Suite doctests Type: exitcode-stdio-1.0 Default-Language: Haskell2010 HS-Source-Dirs: test Ghc-Options: -Wall Main-Is: doctests.hs Build-Depends: base , wai-logger , doctest >= 0.10.1 if impl(ghc >= 8) Default-Extensions: Strict StrictData Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/logger.git