wai-logger 0.3.2 → 2.0.0
raw patch · 8 files changed
+482/−254 lines, 8 filesdep +unixdep +unix-timedep −date-cachedep ~fast-loggerdep ~wai
Dependencies added: unix, unix-time
Dependencies removed: date-cache
Dependency ranges changed: fast-logger, wai
Files
- Network/Wai/Logger.hs +199/−49
- Network/Wai/Logger/Apache.hs +121/−0
- Network/Wai/Logger/Date.hs +98/−0
- Network/Wai/Logger/Format.hs +0/−145
- Network/Wai/Logger/IP.hs +49/−0
- Network/Wai/Logger/Utils.hs +0/−53
- test/doctests.hs +4/−1
- wai-logger.cabal +11/−6
Network/Wai/Logger.hs view
@@ -1,73 +1,223 @@-{-# LANGUAGE OverloadedStrings #-}---- | Logging system for WAI applications.+-- | Apache style logger for WAI applications. ----- Sample code:+-- An example: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > module Main where -- > -- > import Blaze.ByteString.Builder (fromByteString) -- > import Control.Monad.IO.Class (liftIO)--- > import Data.ByteString.Char8+-- > import qualified Data.ByteString.Char8 as BS -- > import Network.HTTP.Types (status200)--- > import Network.Wai--- > import Network.Wai.Handler.Warp--- > import Network.Wai.Logger+-- > import Network.Wai (Application, responseBuilder)+-- > import Network.Wai.Handler.Warp (run)+-- > import Network.Wai.Logger (withStdoutLogger, ApacheLogger) -- > -- > main :: IO ()--- > main = do--- > aplogger <- stdoutApacheLoggerInit FromSocket True--- > run 3000 $ logapp aplogger+-- > main = withStdoutLogger $ \aplogger ->+-- > run 3000 $ logApp aplogger -- >--- > logapp :: ApacheLogger -> Application--- > logapp aplogger req = do--- > let status = status200--- > len = 4+-- > logApp :: ApacheLogger -> Application+-- > logApp aplogger req = do -- > liftIO $ aplogger req status (Just len)--- > return $ ResponseBuilder status--- > [("Content-Type", "text/plain")--- > ,("Content-Length", pack (show len))]--- > $ fromByteString "PONG"+-- > return $ responseBuilder status hdr msg+-- > where+-- > status = status200+-- > hdr = [("Content-Type", "text/plain")+-- > ,("Content-Length", BS.pack (show len))]+-- > pong = "PONG"+-- > len = fromIntegral $ BS.length pong+-- > msg = toLogStr pong module Network.Wai.Logger (+ -- * High level functions ApacheLogger- , stdoutApacheLoggerInit- , stdoutApacheLoggerInit2- , module Network.Wai.Logger.Format- , module Network.Wai.Logger.Utils+ , withStdoutLogger+ -- * Creating a logger+ , ApacheLoggerActions(..)+ , initLogger+ -- * Types+ , IPAddrSource(..)+ , LogType(..)+ , FileLogSpec(..)+ -- * Date cacher+ , clockDateCacher+ , ZonedDate+ , DateCacheGetter+ , DateCacheUpdater+ -- * Utilities+ , logCheck+ , showSockAddr ) where -import Control.Applicative-import Network.HTTP.Types-import Network.Wai-import Network.Wai.Logger.Format-import Network.Wai.Logger.Utils-import System.Date.Cache-import System.IO+import Control.Concurrent (forkIO, threadDelay, killThread)+import Control.Exception (handle, SomeException(..), bracket)+import Control.Monad (when, void)+import GHC.IO.FD (stdout)+import Network.HTTP.Types (Status)+import Network.Wai (Request)+import System.IO (withFile, hFileSize, IOMode(..)) import System.Log.FastLogger --- | Apache style logger for WAI+import Network.Wai.Logger.Apache+import Network.Wai.Logger.Date+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+ (getter, updater) <- clockDateCacher+ apf <- initLogger FromFallback (LogStdout 4096) getter+ let aplogger = apacheLogger apf+ flusher = logFlusher apf+ remover = logRemover apf+ loop = do+ threadDelay 1000000+ updater+ flusher+ loop+ t <- forkIO loop+ return (aplogger, remover, t)+ teardown (_, remover, t) = do+ void remover+ killThread t++----------------------------------------------------------------++-- | Apache style logger. type ApacheLogger = Request -> Status -> Maybe Integer -> IO () --- | Obtaining Apache style logger to stdout-stdoutApacheLoggerInit :: IPAddrSource- -> Bool -- ^ Automatically flush on each logging?- -> IO ApacheLogger-stdoutApacheLoggerInit ipsrc autoFlash =- stdoutLogger ipsrc <$> mkLogger autoFlash stdout+data ApacheLoggerActions = ApacheLoggerActions {+ apacheLogger :: ApacheLogger+ -- | Flushing log messages in the buffers.+ -- This is explicitly called from your program.+ -- Probably, one second and 10 seconds is proper to stdout and+ -- log files, respectively.+ -- See the source code of 'withStdoutLogger'.+ , logFlusher :: IO ()+ -- | Rotating log files.+ -- This is explicitly called from your program.+ -- Probably, 10 seconds is proper.+ , logRotator :: IO ()+ -- | Removing resources relating Apache logger.+ , logRemover :: IO ()+ } --- | Obtaining Apache style logger to stdout-stdoutApacheLoggerInit2 :: IPAddrSource- -> Bool -- ^ Automatically flush on each logging?- -> (DateCacheGetter, DateCacheCloser)- -> IO ApacheLogger-stdoutApacheLoggerInit2 ipsrc autoFlash dc =- stdoutLogger ipsrc <$> mkLogger2 autoFlash stdout dc+-- | 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 ()) -stdoutLogger :: IPAddrSource -> Logger -> ApacheLogger-stdoutLogger ipsrc logger req status msiz = do- date <- loggerDate logger- loggerPutStr logger $ logmsg date+----------------------------------------------------------------++-- |+-- 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+ , logFlusher = noFlusher+ , logRotator = noRotator+ , logRemover = noRemover+ } where- logmsg date = apacheFormat ipsrc date req status msiz+ noLogger _ _ _ = return ()+ noFlusher = return ()+ noRotator = return ()+ noRemover = return ()++stdoutLoggerInit :: IPAddrSource -> BufSize -> DateCacheGetter+ -> IO ApacheLoggerActions+stdoutLoggerInit ipsrc size dateget = do+ lgrset <- newLoggerSet size stdout+ let logger = apache (pushLogStr lgrset) ipsrc dateget+ flusher = flushLogStr lgrset+ noRotator = return ()+ remover = rmLoggerSet lgrset+ return ApacheLoggerActions {+ apacheLogger = logger+ , logFlusher = flusher+ , logRotator = noRotator+ , logRemover = remover+ }++fileLoggerInit :: IPAddrSource -> FileLogSpec -> BufSize -> DateCacheGetter+ -> IO ApacheLoggerActions+fileLoggerInit ipsrc spec size dateget = do+ fd <- logOpen (log_file spec)+ lgrset <- newLoggerSet size fd+ let logger = apache (pushLogStr lgrset) ipsrc dateget+ flusher = flushLogStr lgrset+ rotator = logRotater lgrset spec+ remover = rmLoggerSet lgrset+ return ApacheLoggerActions {+ apacheLogger = logger+ , logFlusher = flusher+ , logRotator = rotator+ , logRemover = remover+ }++callbackLoggerInit :: IPAddrSource -> (LogStr -> IO ()) -> IO () -> DateCacheGetter+ -> IO ApacheLoggerActions+callbackLoggerInit ipsrc cb flush dateget = do+ let logger = apache cb ipsrc dateget+ flusher = flush+ noRotator = return ()+ remover = return ()+ return ApacheLoggerActions {+ apacheLogger = logger+ , logFlusher = flusher+ , logRotator = noRotator+ , logRemover = remover+ }++----------------------------------------------------------------++apache :: (LogStr -> IO ()) -> IPAddrSource -> DateCacheGetter -> ApacheLogger+apache cb ipsrc dateget req st mlen = do+ zdata <- dateget+ cb (apacheLogStr ipsrc zdata req st mlen)++----------------------------------------------------------------++logRotater :: LoggerSet -> FileLogSpec -> IO ()+logRotater lgrset spec = do+ over <- isOver+ when over $ do+ rotate spec+ logOpen (log_file 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)++----------------------------------------------------------------++-- |+-- 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 ()
+ Network/Wai/Logger/Apache.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE OverloadedStrings, CPP #-}++module Network.Wai.Logger.Apache (+ IPAddrSource(..)+ , apacheLogStr+ ) where++#ifndef MIN_VERSION_base+#define MIN_VERSION_base(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 ((<>))+#else+import Data.Monoid (mappend)+#endif+import Network.HTTP.Types (Status, statusCode)+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++-- | 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 -> ZonedDate -> Request -> Status -> Maybe Integer -> LogStr+apacheLogStr ipsrc tmstr req status msize =+ toLogStr (getSourceIP ipsrc req)+ <> " - - ["+ <> toLogStr tmstr+ <> "] \""+ <> toLogStr (requestMethod req)+ <> " "+ <> toLogStr (rawPathInfo req)+ <> " "+ <> toLogStr (show (httpVersion req))+ <> "\" "+ <> toLogStr (show (statusCode status))+ <> " "+ <> toLogStr (maybe "-" show msize)+ <> " \""+ <> toLogStr (lookupRequestField' "referer" req)+ <> "\" \""+ <> toLogStr (lookupRequestField' "user-agent" req)+ <> "\"\n"+ where+#if !MIN_VERSION_base(4,5,0)+ (<>) = mappend+#endif++lookupRequestField' :: CI ByteString -> Request -> ByteString+lookupRequestField' k req = fromMaybe "" . lookup k $ requestHeaders req++-- 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
+ Network/Wai/Logger/Date.hs view
@@ -0,0 +1,98 @@+{-# 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.Applicative ((<$>))+import Data.ByteString (ByteString)+import Data.IORef (newIORef, readIORef, writeIORef)+#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++----------------------------------------------------------------++data DateCache t = DateCache {+ timeKey :: !t+ , formattedDate :: !ByteString+ } deriving (Eq, Show)++----------------------------------------------------------------++newDate :: DateCacheConf t -> t -> IO (DateCache t)+newDate setting tm = DateCache tm <$> formatDate setting tm++-- |+-- Returning 'DateCacheGetter' and 'DateCacheUpdater'.++clockDateCacher :: IO (DateCacheGetter, DateCacheUpdater)+clockDateCacher = do+ ref <- getTime zonedDateCacheConf >>= newDate zonedDateCacheConf >>= newIORef+ return (getter ref, clock ref)+ where+ getter ref = formattedDate <$> readIORef ref+ clock ref = do+ tm <- getTime zonedDateCacheConf+ date <- formatDate zonedDateCacheConf tm+ let new = DateCache {+ timeKey = tm+ , formattedDate = date+ }+ writeIORef ref new
− Network/Wai/Logger/Format.hs
@@ -1,145 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.Wai.Logger.Format (- IPAddrSource(..)- , apacheFormat- -- * Builder- , apacheFormatBuilder- ) where--import Blaze.ByteString.Builder-import Blaze.ByteString.Builder.Char8-import Data.ByteString.Char8 (ByteString)-import Data.CaseInsensitive-import Data.List-import Data.Maybe-import Data.Monoid-import Network.HTTP.Types-import Network.Wai-import Network.Wai.Logger.Utils-import System.Log.FastLogger---- $setup--- >>> :set -XOverloadedStrings--- >>> import Network.Wai.Test--{-| 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.-apacheFormat :: IPAddrSource -> ZonedDate -> Request -> Status -> Maybe Integer -> [LogStr]-apacheFormat ipsrc tmstr req st msize = [- getSourceIPLogStr ipsrc req- , LB " - - ["- , LB tmstr- , LB "] \""- , LB $ requestMethod req- , LB " "- , LB $ rawPathInfo req- , LB " "- , LS $ show . httpVersion $ req- , LB "\" "- , LS . show . statusCode $ st- , LB " "- , LS $ maybe "-" show msize- , LB " \""- , LB $ lookupRequestField' "referer" req- , LB "\" \""- , LB $ lookupRequestField' "user-agent" req- , LB "\"\n"- ]--{-| Apache style log format with 'Builder'. This is experimental.- This would replace 'apacheFormat' someday.--}-apacheFormatBuilder :: IPAddrSource -> ZonedDate -> Request -> Status -> Maybe Integer -> Builder-apacheFormatBuilder ipsrc tmstr req status msize =- getSourceIPBuilder ipsrc req- +++ bs " - - ["- +++ bs tmstr- +++ bs "] \""- +++ bs (requestMethod req)- +++ bs " "- +++ bs (rawPathInfo req)- +++ bs " "- +++ st (show (httpVersion req))- +++ bs "\" "- +++ st (show (statusCode status))- +++ bs " "- +++ st (maybe "-" show msize)- +++ bs " \""- +++ bs (lookupRequestField' "referer" req)- +++ bs "\" \""- +++ bs (lookupRequestField' "user-agent" req)- +++ bs "\"\n"- where- st = fromString- bs = fromByteString- (+++) = mappend--lookupRequestField' :: CI ByteString -> Request -> ByteString-lookupRequestField' k req = fromMaybe "" . lookup k $ requestHeaders req--getSourceIPLogStr :: IPAddrSource -> Request -> LogStr-getSourceIPLogStr = getSourceIP LS LB--getSourceIPBuilder :: IPAddrSource -> Request -> Builder-getSourceIPBuilder = getSourceIP fromString fromByteString--getSourceIP :: (String -> a) -> (ByteString -> a) -> IPAddrSource -> Request -> a-getSourceIP f _ FromSocket = f . getSourceFromSocket-getSourceIP _ g FromHeader = g . getSourceFromHeader-getSourceIP f g FromFallback = either f g . getSourceFromFallback---- |--- >>> getSourceFromSocket defaultRequest--- "0.0.0.0"-getSourceFromSocket :: Request -> String-getSourceFromSocket = 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") ] }--- Right "127.0.0.1"--- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Forwarded-For", "127.0.0.1") ] }--- Right "127.0.0.1"--- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("Something", "127.0.0.1") ] }--- Left "0.0.0.0"--- >>> getSourceFromFallback defaultRequest { requestHeaders = [] }--- Left "0.0.0.0"-getSourceFromFallback :: Request -> Either String ByteString-getSourceFromFallback req = maybe (Left $ getSourceFromSocket req) Right $ 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
+ Network/Wai/Logger/IP.hs view
@@ -0,0 +1,49 @@+module 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"
− Network/Wai/Logger/Utils.hs
@@ -1,53 +0,0 @@-module Network.Wai.Logger.Utils (- NumericAddress, showSockAddr- ) where--import Data.Bits-import Data.Word-import Network.Socket (SockAddr(..))-import System.ByteOrder-import Text.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- an IPv4-embedded IPv6 address, the IPv4 is extracted.--}--- HostAddr is network byte order.--- HostAddr6 is host byte order.-showSockAddr :: SockAddr -> NumericAddress-showSockAddr (SockAddrInet _ addr4) = showIPv4 addr4 (byteOrder == LittleEndian)-showSockAddr (SockAddrInet6 _ _ (0,0,0x0000ffff,addr4) _) = showIPv4 addr4 False-showSockAddr (SockAddrInet6 _ _ (0,0,0,1) _) = "::1"-showSockAddr (SockAddrInet6 _ _ addr6 _) = showIPv6 addr6-showSockAddr _ = "unknownSocket"
test/doctests.hs view
@@ -4,5 +4,8 @@ main :: IO () main = doctest [- "Network/Wai/Logger.hs"+ "-idist/build/autogen/"+ , "-optP-include"+ , "-optPdist/build/autogen/cabal_macros.h"+ , "Network/Wai/Logger.hs" ]
wai-logger.cabal view
@@ -1,5 +1,5 @@ Name: wai-logger-Version: 0.3.2+Version: 2.0.0 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -14,18 +14,23 @@ Default-Language: Haskell2010 GHC-Options: -Wall Exposed-Modules: Network.Wai.Logger- Network.Wai.Logger.Format- Network.Wai.Logger.Utils+ Other-Modules: Network.Wai.Logger.Apache+ Network.Wai.Logger.Date+ Network.Wai.Logger.IP Build-Depends: base >= 4 && < 5 , blaze-builder , byteorder , bytestring , case-insensitive- , date-cache >= 0.3- , fast-logger >= 0.3+ , fast-logger >= 2.0.0 , http-types , network- , wai+ , wai >= 2.0.0+ if os(windows)+ Cpp-Options: -DWINDOWS+ else+ Build-Depends: unix+ , unix-time Test-Suite doctest Type: exitcode-stdio-1.0