diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,2 @@ +# wai-log-0.1 (2019-03-07) +* Initial release (split from internal Scrive package). diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Scrive AB + +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 Scrive AB nor the names of other + 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,6 @@ +# wai-log [![Hackage version](https://img.shields.io/hackage/v/wai-log.svg?label=Hackage)](https://hackage.haskell.org/package/wai-log) [![Build Status](https://secure.travis-ci.org/scrive/wai-log.svg?branch=master)](http://travis-ci.org/scrive/wai-log) + +A simple logging middleware for WAI applications that supports the `log-*` +family of packages. + +See [`log-base`](https://hackage.haskell.org/package/log-base). diff --git a/src/Network/Wai/Log.hs b/src/Network/Wai/Log.hs new file mode 100644 --- /dev/null +++ b/src/Network/Wai/Log.hs @@ -0,0 +1,74 @@ +-- | A simple logging middleware for WAI applications that supports the 'log-*' +-- family of packages: +-- +-- Currently there are no logging options but contributions are welcome. +-- When logging to @stdout@, the output looks like this: +-- +-- @ +-- 2019-02-21 19:51:47 INFO my-server: Request received { +-- \"url\": \"\/api\/myapi\", +-- \"body-length\": \"KnownLength 0\", +-- \"method\": \"GET\", +-- \"user-agent\": \"curl\/7.54.0\", +-- \"remote-host\": \"127.0.0.1:61249\" +-- } +-- 2019-02-21 19:51:47 INFO my-server: Sending response +-- 2019-02-21 19:51:47 INFO my-server: Request complete { +-- \"status\": { +-- \"code\": 200, +-- \"message\": \"OK\" +-- }, +-- \"time\": { +-- \"process\": 2.224e-3, +-- \"full\": 2.348e-3 +-- } +-- } +-- @ +module Network.Wai.Log ( + logRequestsWith +) where + +import Data.Aeson () +import Data.String.Conversions (ConvertibleStrings, StrictText, cs) +import Data.Text (Text) +import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime) +import Log +import Network.HTTP.Types.Status +import Network.Wai + +-- | Given a logger, create a 'Middleware' that logs incoming requests, the +-- response code, and how long it took to process and respond to the request. +logRequestsWith :: (LogT IO () -> IO ()) -> Middleware +logRequestsWith runLogger app req respond = do + + runLogger . logInfo "Request received" $ object + [ "method" .= ts (requestMethod req) + , "url" .= ts (rawPathInfo req) + , "remote-host" .= show (remoteHost req) + , "user-agent" .= fmap ts (requestHeaderUserAgent req) + , "body-length" .= show (requestBodyLength req) + ] + tStart <- getCurrentTime + + app req $ \resp -> do + tEnd <- getCurrentTime + runLogger $ logInfo_ "Sending response" + r <- respond resp + tFull <- getCurrentTime + + runLogger . logInfo "Request complete" $ object + [ "status" .= object [ "code" .= statusCode (responseStatus resp) + , "message" .= ts (statusMessage (responseStatus resp)) + ] + , "time" .= object [ "full" .= diffSeconds tFull tStart + , "process" .= diffSeconds tEnd tStart + ] + ] + + return r + +diffSeconds :: UTCTime -> UTCTime -> Double +diffSeconds a b = realToFrac $ diffUTCTime a b + +ts :: ConvertibleStrings a StrictText => a -> Text +ts = cs diff --git a/wai-log.cabal b/wai-log.cabal new file mode 100644 --- /dev/null +++ b/wai-log.cabal @@ -0,0 +1,45 @@ +name: wai-log +version: 0.1.0.0 + +synopsis: A logging middleware for WAI applications + +description: A simple logging middleware for WAI applications that + supports the 'log-*' family of packages: + + +category: Web, Logging + +homepage: https://github.com/scrive/wai-log + +author: Scrive AB +copyright: Scrive AB +maintainer: Andrzej Rybczak , + Jonathan Jouty , + Mikhail Glushenkov + +license: BSD3 +license-file: LICENSE + +build-type: Simple +cabal-version: 2.0 +extra-source-files: CHANGELOG.md, README.md + +Source-repository head + Type: git + Location: https://github.com/scrive/wai-log.git + +library + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: OverloadedStrings + , FlexibleContexts + build-depends: base >=4.8 && <5 + , aeson + , http-types + , log-base + , string-conversions + , text + , time + , wai + exposed-modules: Network.Wai.Log