Blammo 1.2.1.0 → 2.0.0.0

raw patch · 7 files changed

+30/−320 lines, 7 filesdep −case-insensitivedep −clockdep −http-typesdep ~basedep ~bytestringdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies removed: case-insensitive, clock, http-types, wai

Dependency ranges changed: base, bytestring, containers, dlist, envparse, hspec, lens, markdown-unlit, text, time, unliftio

API changes (from Hackage documentation)

Files

• Blammo.cabal +22/−27
• CHANGELOG.md +5/−0
• LICENSE +1/−1
• README.lhs +0/−46
• README.md +0/−46
• src/Blammo/Logging/Test.hs +2/−1
• src/Network/Wai/Middleware/Logging.hs +0/−199

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            Blammo-version:         1.2.1.0+version:         2.0.0.0 license:         MIT license-file:    LICENSE maintainer:      Freckle Education@@ -8,7 +8,7 @@ bug-reports:     https://github.com/freckle/blammo/issues synopsis:        Batteries-included Structured Logging library description:     Please see README.md-category:        Utils+category:        Logging build-type:      Simple extra-doc-files:     README.md@@ -33,7 +33,6 @@         Blammo.Logging.Test         Blammo.Logging.WithLogger         Data.Aeson.Compat-        Network.Wai.Middleware.Logging         System.Log.FastLogger.Compat      hs-source-dirs:     src@@ -52,26 +51,22 @@      build-depends:         aeson >=1.5.2.0,-        base >=4.12.0.0 && <5,-        bytestring >=0.10.8.2,-        case-insensitive >=1.2.0.11,-        clock >=0.8,-        containers >=0.6.0.1,-        dlist >=0.8.0.7,-        envparse >=0.5.0,+        base >=4.13.0.0 && <5,+        bytestring >=0.10.10.1,+        containers >=0.6.2.1,+        dlist >=0.8.0.8,+        envparse >=0.4.1,         exceptions >=0.10.4,         fast-logger >=3.2.3,-        http-types >=0.12.3,-        lens >=4.17.1,+        lens >=4.18.1,         monad-logger-aeson >=0.4.0.3,         mtl >=2.2.2,-        text >=1.2.3.1,-        time >=1.8.0.2,-        unliftio >=0.2.12,+        text >=1.2.4.0,+        time >=1.9.3,+        unliftio >=0.2.13.1,         unliftio-core >=0.1.2.0,         unordered-containers >=0.2.10.0,-        vector >=0.12.1.2,-        wai >=3.2.2.1+        vector >=0.12.1.2      if impl(ghc >=9.8)         ghc-options: -Wno-missing-role-annotations@@ -102,11 +97,11 @@     build-depends:         Blammo,         aeson >=1.5.2.0,-        base >=4.12.0.0 && <5,-        lens >=4.17.1,-        markdown-unlit >=0.5.0,+        base >=4.13.0.0 && <5,+        lens >=4.18.1,+        markdown-unlit >=0.5.1,         mtl >=2.2.2,-        text >=1.2.3.1+        text >=1.2.4.0      if impl(ghc >=9.8)         ghc-options: -Wno-missing-role-annotations@@ -144,13 +139,13 @@     build-depends:         Blammo,         aeson >=1.5.2.0,-        base >=4.12.0.0 && <5,-        bytestring >=0.10.8.2,-        envparse >=0.5.0,-        hspec >=2.7.9,+        base >=4.13.0.0 && <5,+        bytestring >=0.10.10.1,+        envparse >=0.4.1,+        hspec >=2.7.6,         mtl >=2.2.2,-        text >=1.2.3.1,-        time >=1.8.0.2+        text >=1.2.4.0,+        time >=1.9.3      if impl(ghc >=9.8)         ghc-options: -Wno-missing-role-annotations

@@ -1,5 +1,10 @@ ## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.2.1.0...main) +## [v2.0.0.0](https://github.com/freckle/blammo/compare/v1.2.1.0...v2.0.0.0)++- Remove module `Network.Wai.Middleware.Logging`. It is moved to a new+  package, `Blammo-wai`.+ ## [v1.2.1.0](https://github.com/freckle/blammo/compare/1.2.0.0...v1.2.1.0)  - Add `Blammo.Logging.Simple.withLoggerEnv`

@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2022 Renaissance Learning Inc+Copyright (c) 2022-2024 Renaissance Learning Inc  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -321,52 +321,6 @@     } ``` -## Integration with WAI--```hs-import Network.Wai.Middleware.Logging--instance HasLogger App where-  -- ...--waiMiddleware :: App -> Middleware-waiMiddleware app =-  addThreadContext ["app" .= ("my-app" :: Text)]-    $ requestLogger app-    $ defaultMiddlewaresNoLogging-```--## Integration with Warp--```hs-import qualified Network.Wai.Handler.Warp as Warp--instance HasLogger App where-  -- ...--warpSettings :: App -> Settings-warpSettings app = setOnException onEx $ defaultSettings- where-  onEx _req ex =-    when (Warp.defaultShouldDisplayException ex)-      $ runWithLogger app-      $ logError-      $ "Warp exception" :# ["exception" .= displayException ex]-```--## Integration with Yesod--```hs-instance HasLogger App where-  -- ...--instance Yesod App where-  -- ...--  messageLoggerSource app _logger loc source level msg =-    runWithLogger app $ monadLoggerLog loc source level msg-```- ---  [LICENSE](./LICENSE) | [CHANGELOG](./CHANGELOG.md)

@@ -321,52 +321,6 @@     } ``` -## Integration with WAI--```hs-import Network.Wai.Middleware.Logging--instance HasLogger App where-  -- ...--waiMiddleware :: App -> Middleware-waiMiddleware app =-  addThreadContext ["app" .= ("my-app" :: Text)]-    $ requestLogger app-    $ defaultMiddlewaresNoLogging-```--## Integration with Warp--```hs-import qualified Network.Wai.Handler.Warp as Warp--instance HasLogger App where-  -- ...--warpSettings :: App -> Settings-warpSettings app = setOnException onEx $ defaultSettings- where-  onEx _req ex =-    when (Warp.defaultShouldDisplayException ex)-      $ runWithLogger app-      $ logError-      $ "Warp exception" :# ["exception" .= displayException ex]-```--## Integration with Yesod--```hs-instance HasLogger App where-  -- ...--instance Yesod App where-  -- ...--  messageLoggerSource app _logger loc source level msg =-    runWithLogger app $ monadLoggerLog loc source level msg-```- ---  [LICENSE](./LICENSE) | [CHANGELOG](./CHANGELOG.md)

@@ -33,6 +33,7 @@ appendLogStrLn :: MonadIO m => LoggedMessages -> LogStr -> m () appendLogStrLn lm = appendLogStr lm . (<> "\n") -getLoggedMessages :: MonadIO m => LoggedMessages -> m [Either String LoggedMessage]+getLoggedMessages+  :: MonadIO m => LoggedMessages -> m [Either String LoggedMessage] getLoggedMessages (LoggedMessages ref) =   map (eitherDecodeStrict . fromLogStr) . DList.toList <$> readIORef ref

@@ -1,199 +0,0 @@-module Network.Wai.Middleware.Logging-  ( addThreadContext-  , addThreadContextFromRequest-  , requestLogger-  , requestLoggerWith--    -- * Configuration-  , Config-  , defaultConfig-  , setConfigLogSource-  , setConfigGetClientIp-  , setConfigGetDestinationIp-  ) where--import Prelude--import Blammo.Logging-import Control.Applicative ((<|>))-import Control.Arrow ((***))-import Control.Monad.IO.Unlift (withRunInIO)-import Data.Aeson-import qualified Data.Aeson.Compat as Key-import qualified Data.Aeson.Compat as KeyMap-import Data.ByteString (ByteString)-import qualified Data.CaseInsensitive as CI-import Data.List (find)-import Data.Maybe (fromMaybe)-import Data.Text (Text, pack)-import qualified Data.Text as T-import Data.Text.Encoding (decodeUtf8With)-import Data.Text.Encoding.Error (lenientDecode)-import Network.HTTP.Types.Header (Header, HeaderName)-import Network.HTTP.Types.Status (Status (..))-import Network.Wai-  ( Middleware-  , Request-  , Response-  , rawPathInfo-  , rawQueryString-  , remoteHost-  , requestHeaders-  , requestMethod-  , responseHeaders-  , responseStatus-  )-import qualified System.Clock as Clock---- | Add context to any logging done from the request-handling thread-addThreadContext :: [Pair] -> Middleware-addThreadContext = addThreadContextFromRequest . const---- | 'addThreadContext', but have the 'Request' available-addThreadContextFromRequest :: (Request -> [Pair]) -> Middleware-addThreadContextFromRequest toContext app request respond = do-  withThreadContext (toContext request) $ do-    app request respond---- | Log requests (more accurately, responses) as they happen------ In JSON format, logged messages look like:------ @--- {---   ...---   message: {---     text: "GET /foo/bar => 200 OK",---     meta: {---       method: "GET",---       path: "/foo/bar",---       query: "?baz=bat&quix=quo",---       status: {---         code: 200,---         message: "OK"---       },---       durationMs: 1322.2,---       requestHeaders: {---         Authorization: "***",---         Accept: "text/html",---         Cookie: "***"---       },---       responseHeaders: {---         Set-Cookie: "***",---         Expires: "never"---       }---     }---   }--- }--- @-requestLogger :: HasLogger env => env -> Middleware-requestLogger = requestLoggerWith defaultConfig--data Config = Config-  { cLogSource :: LogSource-  , cGetClientIp :: Request -> Text-  , cGetDestinationIp :: Request -> Maybe Text-  }--defaultConfig :: Config-defaultConfig =-  Config-    { cLogSource = "requestLogger"-    , cGetClientIp = \req ->-        fromMaybe (pack $ show $ remoteHost req) $-          (firstValue =<< lookupRequestHeader "x-forwarded-for" req)-            <|> lookupRequestHeader "x-real-ip" req-    , cGetDestinationIp = lookupRequestHeader "x-real-ip"-    }- where-  firstValue = find (not . T.null) . map T.strip . T.splitOn ","--lookupRequestHeader :: HeaderName -> Request -> Maybe Text-lookupRequestHeader h = fmap decodeUtf8 . lookup h . requestHeaders---- | Change the source used for log messages------ Default is @requestLogger@.-setConfigLogSource :: LogSource -> Config -> Config-setConfigLogSource x c = c {cLogSource = x}---- | Change how the @clientIp@ field is determined------ Default is looking up the first value in @x-forwarded-for@, then the--- @x-real-ip@ header, then finally falling back to 'Network.Wai.remoteHost'.-setConfigGetClientIp :: (Request -> Text) -> Config -> Config-setConfigGetClientIp x c = c {cGetClientIp = x}---- | Change how the @destinationIp@ field is determined------ Default is looking up the @x-real-ip@ header.------ __NOTE__: Our default uses a somewhat loose definition of /destination/. It--- would be more accurate to report the resolved IP address of the @Host@--- header, but we don't have that available. Our default of @x-real-ip@ favors--- containerized Warp on AWS/ECS, where this value holds the ECS target--- container's IP address. This is valuable debugging information and could, if--- you squint, be considered a /destination/.-setConfigGetDestinationIp :: (Request -> Maybe Text) -> Config -> Config-setConfigGetDestinationIp x c = c {cGetDestinationIp = x}--requestLoggerWith :: HasLogger env => Config -> env -> Middleware-requestLoggerWith config env app req respond =-  withRunInIO $ \runInIO -> do-    begin <- getTime-    app req $ \resp -> do-      recvd <- respond resp-      duration <- toMillis . subtract begin <$> getTime-      recvd <$ runInIO (runWithLogger env $ logResponse config duration req resp)- where-  getTime = Clock.getTime Clock.Monotonic-  toMillis x = fromIntegral (Clock.toNanoSecs x) / nsPerMs--logResponse :: MonadLogger m => Config -> Double -> Request -> Response -> m ()-logResponse Config {..} duration req resp-  | statusCode status >= 500 = logErrorNS cLogSource $ message :# details-  | statusCode status == 404 = logDebugNS cLogSource $ message :# details-  | statusCode status >= 400 = logWarnNS cLogSource $ message :# details-  | otherwise = logDebugNS cLogSource $ message :# details- where-  message =-    decodeUtf8 (requestMethod req)-      <> " "-      <> decodeUtf8 (rawPathInfo req)-      <> " => "-      <> pack (show $ statusCode status)-      <> " "-      <> decodeUtf8 (statusMessage status)--  details =-    [ "method" .= decodeUtf8 (requestMethod req)-    , "path" .= decodeUtf8 (rawPathInfo req)-    , "query" .= decodeUtf8 (rawQueryString req)-    , "status"-        .= object-          [ "code" .= statusCode status-          , "message" .= decodeUtf8 (statusMessage status)-          ]-    , "clientIp" .= cGetClientIp req-    , "destinationIp" .= cGetDestinationIp req-    , "durationMs" .= duration-    , "requestHeaders"-        .= headerObject ["authorization", "cookie"] (requestHeaders req)-    , "responseHeaders" .= headerObject ["set-cookie"] (responseHeaders resp)-    ]--  status = responseStatus resp--headerObject :: [HeaderName] -> [Header] -> Value-headerObject redact = Object . KeyMap.fromList . map (mung . hide)- where-  mung = Key.fromText . decodeUtf8 . CI.foldedCase *** String . decodeUtf8-  hide (k, v)-    | k `elem` redact = (k, "***")-    | otherwise = (k, v)--nsPerMs :: Double-nsPerMs = 1000000--decodeUtf8 :: ByteString -> Text-decodeUtf8 = decodeUtf8With lenientDecode