wai-logger 0.0.0 → 0.0.1
raw patch · 4 files changed
+84/−34 lines, 4 filesdep +blaze-builder
Dependencies added: blaze-builder
Files
- Network/Wai/Logger/Date.hs +32/−30
- Network/Wai/Logger/Format.hs +34/−1
- Network/Wai/Logger/IO.hs +15/−1
- wai-logger.cabal +3/−2
Network/Wai/Logger/Date.hs view
@@ -1,50 +1,52 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DoAndIfThenElse, BangPatterns #-} module Network.Wai.Logger.Date ( ZonedDate+ , DateRef , dateInit , getDate- , DateRef ) where -import Control.Concurrent-import Control.DeepSeq+import Control.Applicative import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import Data.IORef import Data.Time import System.Locale+import System.Posix (EpochTime, epochTime)+import Data.Time.Clock.POSIX -- | A type for zoned date. type ZonedDate = ByteString --- | Reference to the cache of 'ZoneDate'.-newtype DateRef = DateRef (IORef ByteString)+data DateCache = DateCache {+ unixTime :: !EpochTime+ , zonedDate :: !ZonedDate+ } --- | Getting 'ZonedDate' from the cache.-getDate :: DateRef -> IO ZonedDate-getDate (DateRef ref) = readIORef ref+-- | Reference to the 'ZonedDate' cache.+newtype DateRef = DateRef (IORef DateCache) --- | Start caching 'ZonedDate' every second.-dateInit :: IO DateRef-dateInit = do- ref <- formatDate >>= newIORef- let dateref = DateRef ref- forkIO $ date dateref- return dateref+-- | Getting 'ZonedDate' from the 'ZonedDate' cache.+getDate :: DateRef -> IO ZonedDate+getDate (DateRef ref) = do+ newEt <- epochTime+ cache <- readIORef ref+ let oldEt = unixTime cache+ if oldEt == newEt then+ return $ zonedDate cache+ else do+ newCache <- newDate newEt+ !_ <- atomicModifyIORef ref (\_ -> (newCache, ()))+ return $ zonedDate newCache -date :: DateRef -> IO ()-date dateref@(DateRef !ref) = do- !tmstr <- formatDate- x <- atomicModifyIORef ref (\_ -> (tmstr, ()))- -- atomicModifyIORef is prone to leak spaces.- x `seq` return ()- threadDelay 1000000- date dateref+newDate :: EpochTime -> IO DateCache+newDate et = DateCache et . format <$> toZonedTime et+ where+ toZonedTime = utcToLocalZonedTime . toUTC+ toUTC = posixSecondsToUTCTime . realToFrac+ format = BS.pack . formatTime defaultTimeLocale "%d/%b/%Y:%T %z" -formatDate :: IO ByteString-formatDate = do- tm <- getZonedTime- let !str = formatTime defaultTimeLocale "%d/%b/%Y:%T %z" tm- !tmstr = str `deepseq` BS.pack str- return tmstr+-- | Initializing the 'ZonedDate' cache.+dateInit :: IO DateRef+dateInit = DateRef <$> (epochTime >>= newDate >>= newIORef)
Network/Wai/Logger/Format.hs view
@@ -1,10 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} -module Network.Wai.Logger.Format (apacheFormat) where+module Network.Wai.Logger.Format (+ apacheFormat+ , apacheFormatBuilder+ ) where +import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8 import Data.ByteString.Char8 () import Data.CaseInsensitive import Data.Maybe+import Data.Monoid import Network.HTTP.Types import Network.Wai import Network.Wai.Logger.Date@@ -38,3 +44,30 @@ lookupRequestField' :: CI Ascii -> Request -> Ascii lookupRequestField' k req = fromMaybe "" . lookup k $ requestHeaders req++-- | Apache style log format with 'Builder'. This is experimental.+apacheFormatBuilder :: ZonedDate -> Request -> Status -> Maybe Integer -> Builder+apacheFormatBuilder tmstr req status msize =+ st addr+ +++ 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+ addr = showSockAddr (remoteHost req)+ st = fromString+ bs = fromByteString+ (+++) = mappend
Network/Wai/Logger/IO.hs view
@@ -3,12 +3,14 @@ module Network.Wai.Logger.IO ( LogStr(..)- , hPutLogStr+ , hPutLogStr, hPutBuilder, initHandle ) where +import Blaze.ByteString.Builder import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString(..), c2w) import Data.List+import Data.Maybe import Foreign import GHC.Base import GHC.IO.Buffer@@ -19,6 +21,7 @@ import GHC.IORef import GHC.Num import GHC.Real+import System.IO -- | A date type to contain 'String' and 'ByteString'. data LogStr = LS !String | LB !ByteString@@ -67,3 +70,14 @@ copy' dst (x:xs) = do poke dst (c2w x) copy' (dst `plusPtr` 1) xs++-- | Setting a proper buffering to 'Handle'.+initHandle :: Handle -> IO ()+initHandle hdl = hSetBuffering hdl (BlockBuffering (Just 4096))++{-| The 'hPut' function directory to copy 'Builder' to the buffer.+ The current implementation is inefficient at this moment.+ 'initHandle' must be called once beforehand if this function is used.+-}+hPutBuilder :: Handle -> Builder -> IO ()+hPutBuilder hdl = BS.hPut hdl . toByteString
wai-logger.cabal view
@@ -1,5 +1,5 @@ Name: wai-logger-Version: 0.0.0+Version: 0.0.1 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -24,7 +24,8 @@ Build-Depends: base >= 4 && < 5, wai, http-types, bytestring, filepath, directory, old-locale, case-insensitive,- time, deepseq, unix, byteorder, network+ time, deepseq, unix, byteorder, network,+ blaze-builder Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/wai-logger.git