module Network.Wai.Logger.Format (
IPAddrSource(..)
, apacheFormat
, 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
data IPAddrSource =
FromSocket
| FromHeader
| FromFallback
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"
]
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 :: Request -> String
getSourceFromSocket = showSockAddr . remoteHost
getSourceFromHeader :: Request -> ByteString
getSourceFromHeader = fromMaybe "" . getSource
getSourceFromFallback :: Request -> Either String ByteString
getSourceFromFallback req = maybe (Left $ getSourceFromSocket req) Right $ getSource req
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