diff options
| -rw-r--r-- | juandelacosa.cabal | 2 | ||||
| -rw-r--r-- | src/Application.hs | 10 | ||||
| -rw-r--r-- | src/LogFormat.hs | 40 |
3 files changed, 49 insertions, 3 deletions
diff --git a/juandelacosa.cabal b/juandelacosa.cabal index a228f61..ddac3a9 100644 --- a/juandelacosa.cabal +++ b/juandelacosa.cabal @@ -32,6 +32,7 @@ executable juandelacosa main-is: Main.hs other-modules: Application + LogFormat Server build-depends: base >= 4.8 && < 50 @@ -40,6 +41,7 @@ executable juandelacosa , data-default-class , docopt >= 0.7 , entropy >= 0.3 + , fast-logger , http-types >= 0.9 , interpolatedstring-perl6 >= 1.0 , mtl >= 2.2 diff --git a/src/Application.hs b/src/Application.hs index b3d7fb1..616532c 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -12,11 +12,11 @@ import Data.Default.Class (def) import Data.Pool (Pool, withResource) import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8) import Database.MySQL.Simple (Connection, Only(..), query, execute) -import Network.HTTP.Types (notFound404, badRequest400) +import Network.HTTP.Types (notFound404, badRequest400) import Network.Wai (Application, Middleware) import Network.Wai.Middleware.RequestLogger (Destination(Handle), mkRequestLogger, RequestLoggerSettings(destination, outputFormat), - OutputFormat(Apache), IPAddrSource(FromHeader)) + OutputFormat(CustomOutputFormat)) import Network.Wai.Middleware.Static (addBase, hasPrefix, staticPolicy, (>->)) import System.Entropy (getEntropy) import System.IO (stderr) @@ -25,9 +25,13 @@ import Web.Scotty (ScottyM, ActionM, header, middleware, file, get, post, import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS +import LogFormat (logFormat) + + app :: Pool Connection -> FilePath -> IO Application app p f = do - logger <- mkRequestLogger def{ destination = Handle stderr, outputFormat = Apache FromHeader } + logger <- mkRequestLogger def{ destination = Handle stderr + , outputFormat = CustomOutputFormat logFormat } scottyApp (juanDeLaCosa p logger f) juanDeLaCosa :: Pool Connection -> Middleware -> FilePath -> ScottyM () diff --git a/src/LogFormat.hs b/src/LogFormat.hs new file mode 100644 index 0000000..51c36c6 --- /dev/null +++ b/src/LogFormat.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} + +module LogFormat ( + logFormat +) where + +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import Network.HTTP.Types (Status(statusCode)) +import Network.Wai (Request, httpVersion, requestHeaders, requestMethod, + rawPathInfo, requestHeaderReferer, requestHeaderUserAgent) +import System.Log.FastLogger (LogStr, toLogStr) +import qualified Data.ByteString.Char8 as BS + +-- Sligthly modified Common Log Format. +-- User ID extracted from the From header. +logFormat :: BS.ByteString -> Request -> Status -> Maybe Integer -> LogStr +logFormat t req st msize = "" + <> toLogStr (fromMaybe "-" $ lookup "X-Forwarded-For" headers) + <> " - " + <> toLogStr (fromMaybe "-" $ lookup "From" headers) + <> " [" + <> toLogStr t + <> "] \"" + <> toLogStr (requestMethod req) + <> " " + <> toLogStr (rawPathInfo req) + <> " " + <> toLogStr (show $ httpVersion req) + <> "\" " + <> toLogStr (show $ statusCode st) + <> " " + <> toLogStr (maybe "-" show msize) + <> " \"" + <> toLogStr (fromMaybe "" $ requestHeaderReferer req) + <> "\" \"" + <> toLogStr (fromMaybe "" $ requestHeaderUserAgent req) + <> "\"\n" + where headers = requestHeaders req + |