diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 Todd Mohney + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,25 @@ +# logentries + +### Example Usage + +The `logEntriesLogger` produces a chainable `Middleware` type +which can be used in conjunction with any other `Middleware` type. + +```Haskell +-- The Middleware is chained to Servant's Application +-- Other Middlewares can be attached, as well. +app :: Application +app = requestLogger $ serve api server + +-- Configures and creates the LogEntries request logger Middleware +requestLogger :: Middleware +requestLogger = + let token = fromJust . fromString $ "00000000-0000-0000-0000-000000000000" + logentriesConfig = Config "data.logentries.com" 80 token + in logEntriesLogger logentriesConfig +``` + +### Example Application + +A [Servant example](https://github.com/toddmohney/master/tree/add-example-app/example) +can be found in the repo. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/circle.yml b/circle.yml new file mode 100644 --- /dev/null +++ b/circle.yml @@ -0,0 +1,19 @@ +machine: + timezone: + America/New_York + +dependencies: + cache_directories: + - "~/.stack" + - ".stack-work" + pre: + - sudo apt-key adv --keyserver keyserver.ubuntu.com --recv-keys 575159689BEFB442 + - echo 'deb http://download.fpcomplete.com/ubuntu trusty main'|sudo tee /etc/apt/sources.list.d/fpco.list + - sudo apt-get update && sudo apt-get install stack -y + override: + - stack setup + - stack test --dependencies-only + +test: + override: + - stack test diff --git a/example/LICENSE b/example/LICENSE new file mode 100644 --- /dev/null +++ b/example/LICENSE @@ -0,0 +1,30 @@ +Copyright Todd Mohney (c) 2016 + +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 Todd Mohney 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/example/README.md b/example/README.md new file mode 100644 --- /dev/null +++ b/example/README.md @@ -0,0 +1,23 @@ + +### Example Usage + +The example is a Servant application, but this package is compatible with any Wai application. + +The `logEntriesLogger` produces a chainable `Middleware` type +which can be used in conjunction with any other `Middleware` type. + +The relevant code in the example is found in `src/Lib.hs`. + +```Haskell +-- The Middleware is chained to Servant's Application +-- Other Middlewares can be attached, as well. +app :: Application +app = requestLogger $ serve api server + +-- Configures and creates the LogEntries request logger Middleware +requestLogger :: Middleware +requestLogger = + let token = fromJust . fromString $ "00000000-0000-0000-0000-000000000000" + logentriesConfig = Config "data.logentries.com" 80 token + in logEntriesLogger logentriesConfig +``` diff --git a/example/Setup.hs b/example/Setup.hs new file mode 100644 --- /dev/null +++ b/example/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/example/example.cabal b/example/example.cabal new file mode 100644 --- /dev/null +++ b/example/example.cabal @@ -0,0 +1,46 @@ +name: example +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/toddmohney/example#readme +license: BSD3 +license-file: LICENSE +author: Todd Mohney +maintainer: toddmohney@gmail.com +copyright: 2016 Todd Mohney +category: Web +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Lib + build-depends: base >= 4.7 && < 5 + , aeson + , logentries + , servant-server + , wai + , warp + default-language: Haskell2010 + +executable example-exe + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , example + default-language: Haskell2010 + +test-suite example-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , example + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/toddmohney/example diff --git a/example/stack.yaml b/example/stack.yaml new file mode 100644 --- /dev/null +++ b/example/stack.yaml @@ -0,0 +1,7 @@ +resolver: lts-6.4 + +packages: + - location: . + + - location: ../ + extra-dep: true diff --git a/logentries.cabal b/logentries.cabal new file mode 100644 --- /dev/null +++ b/logentries.cabal @@ -0,0 +1,93 @@ +name: logentries +version: 0.1.0.1 +homepage: https://github.com/toddmohney/logentries#README.md +license: BSD3 +license-file: LICENSE +author: Todd Mohney +maintainer: toddmohney@gmail.com +copyright: 2016 Todd Mohney +category: Web +build-type: Simple +cabal-version: >=1.10 +stability: experimental +synopsis: Request logger middleware for Logentries +description: Wai Middleware request logger for Logentries + +extra-source-files: + README.md + LICENSE + circle.yml + stack.yaml + example/LICENSE + example/README.md + example/example.cabal + example/*.hs + example/stack.yaml + +source-repository head + type: git + location: https://github.com/toddmohney/logentries.git + +library + hs-source-dirs: src + + exposed-modules: + Network.Wai.Middleware.RequestLogger.LogEntries + + other-modules: + Network.Wai.Middleware.RequestLogger.Internal.Formatting + + build-depends: base >= 4.7 && < 5 + , bytestring >= 0.10.6.0 && < 0.10.7.0 + , data-default >= 0.5.3 && < 0.6.0 + , fast-logger >= 2.4.6 && < 2.5.0 + , network >= 2.6.2.1 && < 2.6.3.0 + , stm >= 2.4.4.1 && < 2.4.5.0 + , uuid-types >= 1.0.3 && < 1.1.0 + , wai >= 3.2.1.1 && < 3.2.2.0 + , wai-extra >= 3.0.15.1 && < 3.0.16.0 + + default-language: Haskell2010 + + default-extensions: + OverloadedStrings + RecordWildCards + +test-suite logentries-test + type: exitcode-stdio-1.0 + + hs-source-dirs: + src + test + + other-modules: + Network.Wai.Middleware.RequestLogger.Internal.Formatting + Network.Wai.Middleware.RequestLogger.Internal.FormattingSpec + + main-is: Spec.hs + + build-depends: base + , bytestring >= 0.10.6.0 && < 0.10.7.0 + , fast-logger >= 2.4.6 && < 2.5.0 + , hspec >= 2.2.3 && < 2.3.0 + , logentries + , uuid-types >= 1.0.3 && < 1.1.0 + + ghc-options: + -Wall + -fwarn-unused-matches + -fwarn-unused-binds + -fwarn-unused-imports + -threaded + -rtsopts + -with-rtsopts=-N + + default-extensions: + OverloadedStrings + RecordWildCards + + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/toddmohney/logentries diff --git a/src/Network/Wai/Middleware/RequestLogger/Internal/Formatting.hs b/src/Network/Wai/Middleware/RequestLogger/Internal/Formatting.hs new file mode 100644 --- /dev/null +++ b/src/Network/Wai/Middleware/RequestLogger/Internal/Formatting.hs @@ -0,0 +1,23 @@ +{- | + Log message formatting functions +-} +module Network.Wai.Middleware.RequestLogger.Internal.Formatting + ( buildLogMessage + ) where + +import qualified Data.ByteString.Char8 as BS8 +import Data.Monoid ((<>)) +import Data.UUID.Types (UUID) +import qualified Data.UUID.Types as UUID +import System.Log.FastLogger (LogStr, fromLogStr, toLogStr) + +{- | + Adds the user's account token to the log message +-} +buildLogMessage :: UUID -> LogStr -> String +buildLogMessage token logStr = + (BS8.unpack . fromLogStr $ addToken token logStr) ++ "\n" + +addToken :: UUID -> LogStr -> LogStr +addToken token logStr = + toLogStr $ (BS8.pack $ UUID.toString token) <> " " <> (fromLogStr logStr) diff --git a/src/Network/Wai/Middleware/RequestLogger/LogEntries.hs b/src/Network/Wai/Middleware/RequestLogger/LogEntries.hs new file mode 100644 --- /dev/null +++ b/src/Network/Wai/Middleware/RequestLogger/LogEntries.hs @@ -0,0 +1,85 @@ +{- | + Entrypoint module for the package +-} +module Network.Wai.Middleware.RequestLogger.LogEntries + ( Config (..) + , logEntriesLogger + + -- UUID export to make configuration a bit easier + , UUID + , UUID.fromString + , UUID.nil + ) where + +import Network.Wai +import Network.Wai.Middleware.RequestLogger + ( RequestLoggerSettings (..) + , OutputFormat (..) + , Destination (..) + , IPAddrSource (..) + , mkRequestLogger) +import Network.Wai.Middleware.RequestLogger.Internal.Formatting (buildLogMessage) +import qualified Data.ByteString.Char8 as BS8 +import Data.Default (def) +import Data.Monoid ((<>)) +import Data.UUID.Types (UUID) +import qualified Data.UUID.Types as UUID +import Network.Socket +import System.IO.Unsafe (unsafePerformIO) +import System.Log.FastLogger (LogStr, fromLogStr, toLogStr) + +import Control.Concurrent (forkIO) +import Control.Exception (bracket) +import qualified Control.Concurrent.STM as STM + +{- | + Account configuration +-} +data Config = Config + { hostname :: String + , port :: Int + , token :: UUID + } deriving (Show) + +{- | + Function to create the LogEntries Middleware +-} +logEntriesLogger :: Config -> Middleware +logEntriesLogger config = unsafePerformIO $ do + logChan <- STM.newTChanIO + forkIO (logRequests config logChan) + >> mkRequestLogger (logEntriesSettings logChan) + +logEntriesSettings :: STM.TChan LogStr -> RequestLoggerSettings +logEntriesSettings logChan = def + { outputFormat = Apache FromSocket + , destination = Callback (addLogMessage logChan) + } + +addLogMessage :: STM.TChan LogStr -> LogStr -> IO () +addLogMessage logChan logStr = do + STM.atomically $ STM.writeTChan logChan logStr + return () + +sendLogMessage :: Config -> STM.TChan LogStr -> Socket -> IO () +sendLogMessage config@Config{..} logChan sock = do + logStr <- STM.atomically $ STM.readTChan logChan + _ <- send sock $ buildLogMessage token logStr + sendLogMessage config logChan sock -- recur forever + +logRequests :: Config -> STM.TChan LogStr -> IO () +logRequests config@Config{..} logChan = do + addrs <- getAddrInfo Nothing (Just hostname) (Just . show $ port) + case addrs of + [] -> return () + (serverAddr:_) -> + bracket + (openSocket serverAddr) + sClose + (sendLogMessage config logChan) + +openSocket :: AddrInfo -> IO Socket +openSocket AddrInfo{..} = do + sock <- socket addrFamily Stream defaultProtocol + connect sock addrAddress + return sock diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,35 @@ +# This file was automatically generated by stack init +# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) +resolver: lts-6.4 + +# Local packages, usually specified by relative directory name +packages: + - '.' +# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) +extra-deps: [] + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true + +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: >= 1.0.0 + +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 + +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] + +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/test/Network/Wai/Middleware/RequestLogger/Internal/FormattingSpec.hs b/test/Network/Wai/Middleware/RequestLogger/Internal/FormattingSpec.hs new file mode 100644 --- /dev/null +++ b/test/Network/Wai/Middleware/RequestLogger/Internal/FormattingSpec.hs @@ -0,0 +1,19 @@ +module Network.Wai.Middleware.RequestLogger.Internal.FormattingSpec where + +import qualified Data.UUID.Types as UUID +import Network.Wai.Middleware.RequestLogger.Internal.Formatting +import System.Log.FastLogger (toLogStr) +import Test.Hspec + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "buildLogMessage" $ do + it "prepends the UUID to the log message and appends a newline char" $ + let uuid = UUID.nil + logMsg = toLogStr ("This is my log message"::String) + expectedLogMsg = "00000000-0000-0000-0000-000000000000 This is my log message\n" + in buildLogMessage uuid logMsg `shouldBe` expectedLogMsg + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}