wai-logger-2.3.5/0000755000000000000000000000000013500373437011751 5ustar0000000000000000wai-logger-2.3.5/Setup.hs0000644000000000000000000000150113500373437013402 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.3.5/LICENSE0000644000000000000000000000276513500373437012770 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.3.5/wai-logger.cabal0000644000000000000000000000321413500373437014772 0ustar0000000000000000Name: wai-logger Version: 2.3.5 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 >= 2.4.13 , 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 wai-logger-2.3.5/test/0000755000000000000000000000000013500373437012730 5ustar0000000000000000wai-logger-2.3.5/test/doctests.hs0000644000000000000000000000037713500373437015123 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.3.5/Network/0000755000000000000000000000000013500373437013402 5ustar0000000000000000wai-logger-2.3.5/Network/Wai/0000755000000000000000000000000013500373437014122 5ustar0000000000000000wai-logger-2.3.5/Network/Wai/Logger.hs0000644000000000000000000001247013500373437015701 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | 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 , initLogger -- * Types , IPAddrSource(..) , 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'. initLogger :: IPAddrSource -> LogType -> IO FormattedTime -> IO ApacheLoggerActions initLogger ipsrc typ tgetter = do (fl, cleanUp) <- newFastLogger typ return $ ApacheLoggerActions { apacheLogger = apache fl ipsrc tgetter , serverpushLogger = serverpush fl ipsrc tgetter , logRotator = return () , logRemover = cleanUp } --- | 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 -> IO FormattedTime -> ApacheLogger apache cb ipsrc dateget req st mlen = do zdata <- dateget cb (apacheLogStr ipsrc zdata req st mlen) serverpush :: (LogStr -> IO ()) -> IPAddrSource -> IO FormattedTime -> ServerPushLogger serverpush cb ipsrc dateget req path size = do zdata <- dateget cb (serverpushLogStr ipsrc 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 ()) wai-logger-2.3.5/Network/Wai/Logger/0000755000000000000000000000000013500373437015341 5ustar0000000000000000wai-logger-2.3.5/Network/Wai/Logger/IP.hs0000644000000000000000000000332713500373437016212 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 _ = "unknownSocket" wai-logger-2.3.5/Network/Wai/Logger/IORef.hs0000644000000000000000000000065413500373437016646 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.3.5/Network/Wai/Logger/Apache.hs0000644000000000000000000001100013500373437017046 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 :: IPAddrSource -> FormattedTime -> Request -> Status -> Maybe Integer -> LogStr apacheLogStr ipsrc tmstr req status msize = toLogStr (getSourceIP ipsrc 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 :: IPAddrSource -> FormattedTime -> Request -> ByteString -> Integer -> LogStr serverpushLogStr ipsrc tmstr req path size = toLogStr (getSourceIP ipsrc 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