filter-logger (empty) → 0.1.0.0
raw patch · 9 files changed
+493/−0 lines, 9 filesdep +HUnitdep +aesondep +aeson-prettysetup-changed
Dependencies added: HUnit, aeson, aeson-pretty, base, bytestring, data-default, fast-logger, filter-logger, http-types, scotty, wai, wai-extra
Files
- LICENSE +21/−0
- README.md +125/−0
- Setup.hs +2/−0
- examples/basic/Main.hs +46/−0
- examples/password/Main.hs +54/−0
- filter-logger.cabal +65/−0
- src/Network/Wai/Middleware/FilterLogger.hs +11/−0
- src/Network/Wai/Middleware/FilterLogger/Internal.hs +106/−0
- test/Spec.hs +63/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017 Joe Canero++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,125 @@+# filter-logger++Filterable request logging as a wai middleware. Change what data is logged and when.++## Usage++Here is one example from the **examples/password** directory where we use the filter logger to implement password filtering. The example uses `scotty` for our web server, and we use the `logShowJSON` and `logFilterJSON` helper functions to help us create our instances.++### Password Filtering++```haskell++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Main where++import Data.Aeson+import GHC.Generics+import Network.Wai.Middleware.FilterLogger+import Web.Scotty++data LoginRequest = LoginRequest {+ username :: String+ , password :: String+ } deriving (Generic)++instance FromJSON LoginRequest where+instance ToJSON LoginRequest where++instance LogShowable LoginRequest where+ logShow = logShowJSON++instance LogFilterable LoginRequest where+ prep = logFilterJSON++instance Loggable LoginRequest where++main :: IO ()+main = scotty 3000 $ do+ middleware filterPasswords+ post "/" $ text "SUCCESS"++filterPasswords =+ mkFilterLogger True hidePasswords+ where hidePasswords r@LoginRequest{..} = Just r {password = "*****"}++```++Sending a POST request to localhost:3000 with a body like+```+{+ "username": "test-username",+ "password": "myPassw0rd123"+}+```++ will result in a log message like+```+11/Jul/2017:21:48:20 -0400+200 - OK+0.03ms+{+ "username": "test-username",+ "password": "*****"+}+```++### Chaining Filters++Here is a rather contrived example showing that you can chain these filters together easily and do all sorts of filtering.++```haskell++{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad+import qualified Data.ByteString as BS (elem, length)+import Data.Char+import Data.Word+import Network.Wai.Middleware.FilterLogger+import Web.Scotty++main :: IO ()+main = scotty 3000 $ do+ middleware filteringMiddleware+ post "/" $ text "SUCCESS"++filteringMiddleware =+ mkFilterLogger True (keepShortBodies >=> containing 'c')+ where keepShortBodies bs+ | BS.length bs < 10 = Just bs+ | otherwise = Nothing+ containing c bs+ | BS.elem (fromIntegral $ ord c) bs = Just bs+ | otherwise = Nothing++```++Sending a POST request to localhost:3000 with a body like+```+abcdefghi+```++will result in a log message like+```+11/Jul/2017:22:00:59 -0400+200 - OK+0.03ms+abcdefghi+```++If you send a POST request with a body like+```+abcdefghij+```+or+```+abdefghij+```++you won't see anything in the server logs.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/basic/Main.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad+import qualified Data.ByteString as BS (elem, length)+import Data.Char+import Data.Word+import Network.Wai.Middleware.FilterLogger+import Web.Scotty++{-++ Sending a POST request to localhost:3000 with a body like:+ abcdefghi++ will result in a log message like:+ 11/Jul/2017:22:00:59 -0400+ 200 - OK+ 0.03ms+ abcdefghi++ If you send a POST request with a body like:+ abcdefghij++ or with a body like:++ abdefghij++ you won't see anything in the server logs.++-}++main :: IO ()+main = scotty 3000 $ do+ middleware filteringMiddleware+ post "/" $ text "SUCCESS"++filteringMiddleware =+ mkFilterLogger True (keepShortBodies >=> containing 'c')+ where keepShortBodies bs+ | BS.length bs < 10 = Just bs+ | otherwise = Nothing+ containing c bs+ | BS.elem (fromIntegral $ ord c) bs = Just bs+ | otherwise = Nothing
+ examples/password/Main.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Main where++import Data.Aeson+import GHC.Generics+import Network.Wai.Middleware.FilterLogger+import Web.Scotty++data LoginRequest = LoginRequest {+ username :: String+ , password :: String+ } deriving (Generic)++instance FromJSON LoginRequest where+instance ToJSON LoginRequest where++instance LogShowable LoginRequest where+ logShow = logShowJSON++instance LogFilterable LoginRequest where+ prep = logFilterJSON++instance Loggable LoginRequest where++{-++ Sending a POST request to localhost:3000+ with a body like:+ {+ "username": "test-username",+ "password": "myPassw0rd123"+ }+ will result in a log message like:+ 11/Jul/2017:21:48:20 -0400+ 200 - OK+ 0.03ms+ {+ "username": "test-username",+ "password": "*****"+ }++-}++main :: IO ()+main = scotty 3000 $ do+ middleware filterPasswords+ post "/" $ text "SUCCESS"++filterPasswords =+ mkFilterLogger True hidePasswords+ where hidePasswords r@LoginRequest{..} = Just r {password = "*****"}
+ filter-logger.cabal view
@@ -0,0 +1,65 @@+name: filter-logger+version: 0.1.0.0+synopsis: Filterable request logging as a wai middleware. Change what data is logged and when.+description: Composable filters to transform objects and control when they are written to server logs.+homepage: https://github.com/caneroj1/filter-logger#readme+license: MIT+license-file: LICENSE+author: Joe Canero+maintainer: jmc41493@gmail.com+copyright: Copyright: (c) 2016 Joe Canero+category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Network.Wai.Middleware.FilterLogger+ , Network.Wai.Middleware.FilterLogger.Internal+ build-depends: base >= 4.7 && < 5+ , aeson+ , aeson-pretty+ , bytestring+ , data-default+ , fast-logger+ , http-types+ , wai+ , wai-extra+ default-language: Haskell2010++executable filter-logger-basic-exe+ hs-source-dirs: examples/basic+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , filter-logger+ , bytestring+ , scotty+ default-language: Haskell2010++executable filter-logger-password-exe+ hs-source-dirs: examples/password+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , filter-logger+ , aeson+ , bytestring+ , scotty+ default-language: Haskell2010++test-suite filter-logger-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , filter-logger+ , bytestring+ , HUnit+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/caneroj1/filter-logger
+ src/Network/Wai/Middleware/FilterLogger.hs view
@@ -0,0 +1,11 @@+module Network.Wai.Middleware.FilterLogger+(+ module X+) where++import Network.Wai.Middleware.FilterLogger.Internal as X (LogFilter, LogFilterable (..),+ LogShowable (..),+ Loggable,+ logFilterJSON,+ logShowJSON,+ mkFilterLogger)
+ src/Network/Wai/Middleware/FilterLogger/Internal.hs view
@@ -0,0 +1,106 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module Network.Wai.Middleware.FilterLogger.Internal where++import Control.Monad+import Data.Aeson+import Data.Aeson.Encode.Pretty+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS hiding (ByteString)+import qualified Data.ByteString.Lazy as BL (ByteString,+ fromStrict,+ toStrict)+import Data.Char+import Data.Default+import Data.Semigroup+import Data.Word+import Network.HTTP.Types.Status+import Network.Wai+import Network.Wai.Middleware.RequestLogger+import System.IO.Unsafe+import System.Log.FastLogger+import Text.Printf (printf)++-- | Typeclass for types that can be converted into a strict 'ByteString'+-- and be shown in a log.+class LogShowable a where+ logShow :: a -> ByteString -- | Convert the type into a strict 'ByteString' to be displayed in the logs.++instance LogShowable ByteString where+ logShow = id++instance LogShowable BL.ByteString where+ logShow = BL.toStrict++-- | Helper function that can be used when you want to make an instance of 'ToJSON' an instance of+-- 'LogShowable'. This helps avoid having to use UndecidableInstances.+logShowJSON :: (ToJSON a) => a -> ByteString+logShowJSON = BL.toStrict . encodePretty++-- | Helper function that can be used when you want to make an instance of 'FromJSON' an instance of+-- 'LogFilterable'. This helps avoid having to use UndecidableInstances.+logFilterJSON :: (FromJSON a) => ByteString -> Maybe a+logFilterJSON = decodeStrict'++-- | Typeclass for types that can be converted into from a strict 'ByteString' and will be used as+-- arguments to 'LogFilter'+class LogFilterable a where+ prep :: ByteString -> Maybe a -- | Try to convert the type from a strict 'ByteString'.++instance LogFilterable ByteString where+ prep = return++instance LogFilterable BL.ByteString where+ prep = return . BL.fromStrict++-- | Helper Typeclass for types that implement both 'LogFilterable' and 'LogShowable'+class (LogFilterable a, LogShowable a) => Loggable a where++instance Loggable ByteString where+instance Loggable BL.ByteString where++-- | Type that represents a log filtering function. If the return type+-- is Nothing, then no log message will be created. Otherwise, a log message+-- will be created using the (potentially different) returned value.+type LogFilter a = a -> Maybe a++logFilter :: (Loggable a) => ByteString -> LogFilter a -> Maybe a+logFilter bs lf = prep bs >>= lf++-- | Given a valid 'LogFilter', construct a 'Middleware' value that+-- will log messages where the request body of the incoming request passes+-- the filter. Accepts an optional 'Bool' parameter for detailed logging or not.+mkFilterLogger :: (Loggable a) => Bool -> LogFilter a -> Middleware+mkFilterLogger detailed lf = unsafePerformIO $+ mkRequestLogger def { outputFormat = CustomOutputFormatWithDetails $ customOutputFormatter detailed lf }+{-# NOINLINE mkFilterLogger #-}++customOutputFormatter :: (Loggable a) => Bool -> LogFilter a -> OutputFormatterWithDetails+customOutputFormatter detail lf date req status responseSize time reqBody builder =+ maybe mempty (logString detail) $ logFilter (BS.concat reqBody) lf+ where+ toBS = BS.pack . map (fromIntegral . ord)++ dfromRational :: Rational -> Double+ dfromRational = fromRational++ inMS = printf "%.2f" . dfromRational $ toRational time * 1000++ header = date <> "\n" <>+ toBS (show . fromIntegral $ statusCode status) <> " - " <> statusMessage status <> "\n"++ buildRespSize (Just s) = "Response Size: " <> toBS (show s) <> "\n"+ buildRespSize Nothing = ""++ buildDuration = toBS inMS <> "ms" <> "\n"++ buildDetails True = buildRespSize responseSize <> buildDuration+ buildDetails False = ""++ logString detailed msg = toLogStr (+ header <>+ buildDetails detail <>+ logShow msg <>+ "\n")
+ test/Spec.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad+import qualified Data.ByteString as BS+import Data.Monoid+import Network.Wai.Middleware.FilterLogger.Internal+import Test.HUnit.Base+import Test.HUnit.Text++main :: IO ()+main = void . runTestTT . TestList $ basicTests ++ advancedTests++-- basic tests for log filtering functionality+basicTests :: [Test]+basicTests = map TestCase [+ noFilter+ , simpleFilterKeep+ , simpleFilterDiscard+ ]++-- slightly more complicated filters+advancedTests :: [Test]+advancedTests = map TestCase [+ doubleFilterKeep+ , doubleFilterDiscard+ ]++runFilterUnitTest :: Maybe BS.ByteString -> BS.ByteString -> LogFilter BS.ByteString -> Assertion+runFilterUnitTest expectation input lf = expectation @=? lf input++invert :: LogFilter a -> LogFilter a+invert lf a = maybe (Just a) (const Nothing) $ lf a++contains :: BS.ByteString -> BS.ByteString -> Bool+contains t = not . BS.null . snd . BS.breakSubstring t++simpleFilter :: BS.ByteString -> BS.ByteString -> Maybe BS.ByteString+simpleFilter t bs+ | contains t bs = Just bs+ | otherwise = Nothing++noFilter :: Assertion+noFilter = runFilterUnitTest (Just "MyByteString") "MyByteString" return++simpleFilterKeep :: Assertion+simpleFilterKeep = runFilterUnitTest (Just "MyByteString") "MyByteString" testFilter+ where testFilter = simpleFilter "Str"++simpleFilterDiscard :: Assertion+simpleFilterDiscard = runFilterUnitTest Nothing "MyByteString" testFilter+ where testFilter = invert (simpleFilter "Str")++doubleFilter :: LogFilter BS.ByteString+doubleFilter = simpleFilter "Test" >=> lenCheck+ where lenCheck s+ | BS.length s > 4 = Just s+ | otherwise = Nothing++doubleFilterKeep :: Assertion+doubleFilterKeep = runFilterUnitTest (Just "UnitTest") "UnitTest" doubleFilter++doubleFilterDiscard :: Assertion+doubleFilterDiscard = runFilterUnitTest Nothing "UnitTest" (invert doubleFilter)