ihp-log (empty) → 1.0.0
raw patch · 4 files changed
+444/−0 lines, 4 filesdep +basedep +bytestringdep +data-default
Dependencies added: base, bytestring, data-default, fast-logger, filepath, text, wai, wai-extra
Files
- IHP/Log.hs +120/−0
- IHP/Log/Types.hs +261/−0
- LICENSE +21/−0
- ihp-log.cabal +42/−0
+ IHP/Log.hs view
@@ -0,0 +1,120 @@+{-|+Module: IHP.Log+Description: Functions to write logs at all log levels.++Import this module qualified! All code examples+assume you have imported the module as follows:++> import qualified IHP.Log as Log++-}+module IHP.Log+( module IHP.Log.Types+, debug+, info+, warn+, error+, fatal+, unknown+, makeRequestLogger+, defaultRequestLogger+) where++import Prelude hiding (error, log)+import Control.Monad (when)+import IHP.Log.Types+import Network.Wai (Middleware)+import Network.Wai.Middleware.RequestLogger (mkRequestLogger, RequestLoggerSettings, destination)+import qualified Network.Wai.Middleware.RequestLogger as RequestLogger+import Data.Default (Default (def))+import qualified System.Log.FastLogger as FastLogger++-- | Format a log and send it to the logger.+-- Internal use only -- application code should call the+-- function corresponding to the desired log level.+log :: (?context :: context, LoggingProvider context, FastLogger.ToLogStr string) => LogLevel -> string -> IO ()+log level text = do+ writeLog level ?context.logger text++-- | Log a debug level message.+--+-- > action CreateUserAction { .. } = do+-- > Log.debug "entered CreateUserAction"+-- > ...+debug :: (?context :: context, LoggingProvider context, FastLogger.ToLogStr string) => string -> IO ()+debug = log Debug++-- | Log an info level message.+--+-- > action UsersAction = do+-- > users <- query @User |> fetch+-- > Log.info $ show (lengh users) <> " users fetched."+-- > ...+info :: (?context :: context, LoggingProvider context, FastLogger.ToLogStr string) => string -> IO ()+info = log Info++-- | Log a warning level message.+--+-- > action UsersAction = do+-- > users <- query @User |> fetch+-- > whenEmpty users $ Log.warn "No users found. Something might be wrong!"+-- > ...+warn :: (?context :: context, LoggingProvider context, FastLogger.ToLogStr string) => string -> IO ()+warn = log Warn++-- |Log a warning level message.+--+-- @+-- action CreatePostAction = do+-- let post = newRecord @Post+-- post+-- |> buildPost+-- |> ifValid \case+-- Left post -> do+-- Log.error "Invalid post."+-- render NewView { .. }+-- Right post -> do+-- post <- post |> createRecord+-- setSuccessMessage "Post created"+-- redirectTo PostsAction+-- @+error :: (?context :: context, LoggingProvider context, FastLogger.ToLogStr string) => string -> IO ()+error = log Error++-- | Log a fatal level message.+-- Note this does not exit the program for you -- it only logs to the "Fatal" log level.+--+-- > Log.fatal "Unrecoverable application error!"+fatal :: (?context :: context, LoggingProvider context, FastLogger.ToLogStr string) => string -> IO ()+fatal = log Fatal++-- | Log an "unknown" level message.+-- This is the highest log level and will always be output by the logger.+--+-- > Log.unknown "This will be sent to the logger no matter what!"+unknown :: (?context :: context, LoggingProvider context, FastLogger.ToLogStr string) => string -> IO ()+unknown = log Unknown++-- | Write a log if the given log level is greater than or equal to the logger's log level.+writeLog :: (FastLogger.ToLogStr string) => LogLevel -> Logger -> string -> IO ()+writeLog level logger text = do+ let write = logger.write+ let formatter = logger.formatter+ when (level >= logger.level) $+ write (\time -> formatter time level (toLogStr text))++-- | Wraps 'RequestLogger' from wai-extra to log to an IHP logger.+-- See 'Network.Wai.Middleware.RequestLogger'.+makeRequestLogger :: RequestLoggerSettings -> Logger -> IO Middleware+makeRequestLogger settings logger =+ mkRequestLogger settings {+ destination = RequestLogger.Callback (\logStr ->+ let ?context = logger in+ info (fromLogStr logStr)+ )+ }++-- | Create a request logger with default settings wrapped in an IHP logger.+-- See 'Network.Wai.Middleware.RequestLogger'.+defaultRequestLogger :: Logger -> IO Middleware+defaultRequestLogger = makeRequestLogger def
+ IHP/Log/Types.hs view
@@ -0,0 +1,261 @@+{-# LANGUAGE ConstraintKinds #-}+{-|+Module: IHP.Log.Types+Description: Types for the IHP logging system+-}++module IHP.Log.Types+( Bytes(..)+, LogStr+, BufSize+, TimeFormat+, RotateSettings(..)+, toLogStr+, fromLogStr+, defaultBufSize+, simpleTimeFormat+, simpleTimeFormat'+, Logger(..)+, LogLevel(..)+, LogDestination(..)+, LoggingProvider(..)+, LoggerSettings(..)+, LogFormatter+, FormattedTime+, newLogger+, defaultLogger+, defaultDestination+, defaultFormatter+, withLevelFormatter+, withTimeFormatter+, withTimeAndLevelFormatter+, OsPath+) where++import Prelude+import Data.ByteString (ByteString)+import Data.Text as Text+import Data.Default (Default (def))+import System.Log.FastLogger (+ LogStr,+ LogType'(..),+ BufSize,+ FileLogSpec(..),+ TimedFileLogSpec(..),+ TimeFormat,+ toLogStr,+ fromLogStr,+ defaultBufSize,+ newTimeCache,+ simpleTimeFormat,+ simpleTimeFormat',+ newTimedFastLogger,+ ToLogStr (..)+ )++import qualified System.Log.FastLogger as FastLogger (FormattedTime)+import GHC.Records+import System.OsPath (OsPath, encodeUtf, decodeUtf)+++-- some functions brought over from IHP.Prelude+-- can't import due to circular dependency with IHP.ModelSupport which relies on this module++tshow :: Show a => a -> Text+tshow value = Text.pack (Prelude.show value)++show :: Show a => a -> Text+show = tshow++-- | Interal logger type that encapsulates information needed to perform+-- logging operations. Users can also access this though the 'LoggingProvider'+-- class in controller and model actions to perform logic based on the set log level.+data Logger = Logger {+ write :: !((FastLogger.FormattedTime -> LogStr) -> IO ()),+ level :: !LogLevel,+ formatter :: !LogFormatter,+ timeCache :: !(IO FastLogger.FormattedTime),+ cleanup :: !(IO ())+}++data LogLevel+ -- | For general messages to help with debugging during development.+ -- Default log level in development.+ -- Also the log level used for SQL queries.+ -- See 'IHP.Log.debug' for example usage.+ = Debug+ -- | For info messages that help montior application usage.+ -- Default log level for production.+ -- See 'IHP.Log.info' for example usage.+ | Info+ -- | For warning messages when something might be wrong.+ -- See 'IHP.Log.warn' for example usage.+ | Warn+ -- | For application errors that can be recovered from.+ -- See 'IHP.Log.error' for example usage.+ | Error+ -- | For application errors that are fatal+ -- See 'IHP.Log.fatal' for example usage.+ | Fatal+ -- | For miscallenaous log messages. Highest log level - will always be logged+ -- See 'IHP.Log.unknown' for example usage.+ | Unknown+ deriving (Enum, Eq, Ord, Show)++instance ToLogStr LogLevel where+ toLogStr Debug = "DEBUG"+ toLogStr Info = "INFO"+ toLogStr Warn = "WARN"+ toLogStr Error = "ERROR"+ toLogStr Fatal = "FATAL"+ toLogStr Unknown = "UNKNOWN"++-- | The timestamp in the formatted defined by the logger's timeFormat string.+type FormattedTime = ByteString++-- | Called every time a message is sent to the logger.+-- Since this is just a function type, it's trivial to define custom formatters:+--+-- @+-- withTimeAndLevelFormatterUpcaseAndHappy :: LogFormatter+-- withTimeAndLevelFormatterUpcaseAndHappy time level msg =+-- "[" <> toUpper (show level) <> "]"+-- <> "[" <> time <> "] "+-- <> toUpper msg <> " :) \n"+-- @+type LogFormatter = FormattedTime -> LogLevel -> LogStr -> LogStr++-- | A number of bytes, used in 'RotateSettings'+newtype Bytes = Bytes Integer++data RotateSettings+ -- | Log messages to a file which is never rotated.+ --+ -- @+ -- newLogger def {+ -- destination = File "Log/production.log" NoRotate defaultBufSize+ -- }+ -- @+ = NoRotate+ -- | Log messages to a file and rotate the file after it reaches the given size in bytes.+ -- Third argument is the max number of rotated log files to keep around before overwriting the oldest one.+ --+ -- Example: log to a file rotated once it is 4MB, and keep 7 files before overwriting the first file.+ --+ -- @+ -- newLogger def {+ -- destination = File "Log/production.log" (SizeRotate (Bytes (4 * 1024 * 1024)) 7) defaultBufSize+ -- }+ -- @+ | SizeRotate !Bytes !Int+ -- | Log messages to a file rotated on a timed basis.+ -- Expects a time format string as well as a function which compares two formatted time strings+ -- which is used to determine if the file should be rotated.+ -- Last argument is a function which is called on a log file once its rotated.+ --+ -- Example: rotate a file daily and compress the log file once rotated.+ --+ -- @+ -- let+ -- filePath = "Log/production.log"+ -- formatString = "%FT%H%M%S"+ -- timeCompare = (==) on C8.takeWhile (/=T))+ -- compressFile fp = void . forkIO $+ -- callProcess "tar" [ "--remove-files", "-caf", fp <> ".gz", fp ]+ -- in+ -- newLogger def {+ -- destination = File+ -- filePath+ -- (TimedRotate formatString timeCompare compressFile)+ -- defaultBufSize+ -- }+ -- @+ | TimedRotate !TimeFormat (FastLogger.FormattedTime -> FastLogger.FormattedTime -> Bool) (OsPath -> IO ())++-- | Where logged messages will be delivered to.+data LogDestination+ = None+ -- | Log messages to standard output.+ | Stdout !BufSize+ -- | Log messages to standard error.+ | Stderr !BufSize+ -- | Log message to a file. Rotate the log file with the behavior given by 'RotateSettings'.+ | File !OsPath !RotateSettings !BufSize+ -- | Send logged messages to a callback. Flush action called after every log.+ | Callback !(LogStr -> IO ()) !(IO ())++data LoggerSettings = LoggerSettings {+ level :: LogLevel,+ formatter :: LogFormatter,+ destination :: LogDestination,+ timeFormat :: TimeFormat+}++instance Default LoggerSettings where+ def = LoggerSettings {+ level = Debug,+ formatter = defaultFormatter,+ destination = defaultDestination,+ timeFormat = simpleTimeFormat'+ }++-- | Logger default destination is to standard out.+defaultDestination :: LogDestination+defaultDestination = Stdout defaultBufSize++-- | Used to get the logger for a given environment.+-- | Call in any instance of 'LoggingProvider' get the the environment's current logger.+-- Useful in controller and model actions, which both have logging contexts.+type LoggingProvider context = HasField "logger" context Logger++instance HasField "logger" Logger Logger where+ getField logger = logger++-- | Create a new 'FastLogger' and wrap it in an IHP 'Logger'.+-- Use with the default logger settings and record update syntax for nice configuration:+--+-- > newLogger def { level = Error }+newLogger :: LoggerSettings -> IO Logger+newLogger LoggerSettings { .. } = do+ timeCache <- newTimeCache timeFormat+ (write, cleanup) <- makeFastLogger timeCache destination+ pure Logger { .. }+ where+ makeFastLogger timeCache = \case+ None -> newTimedFastLogger timeCache LogNone+ Stdout buf -> newTimedFastLogger timeCache (LogStdout buf)+ Stderr buf -> newTimedFastLogger timeCache (LogStderr buf)+ File path settings buf -> do+ logType <- makeFileLogger path settings buf+ newTimedFastLogger timeCache logType+ Callback callback flush -> newTimedFastLogger timeCache (LogCallback callback flush)++ makeFileLogger path NoRotate buf = do+ fp <- decodeUtf path+ pure (LogFileNoRotate fp buf)+ makeFileLogger path (SizeRotate (Bytes size) count) buf = do+ fp <- decodeUtf path+ pure (LogFile (FileLogSpec fp size count) buf)+ makeFileLogger path (TimedRotate fmt cmp post) buf = do+ fp <- decodeUtf path+ pure (LogFileTimedRotate (TimedFileLogSpec fp fmt cmp (\fpStr -> post =<< encodeUtf fpStr)) buf)++-- | Formats logs as-is to stdout.+defaultLogger :: IO Logger+defaultLogger = newLogger def++-- | Formats the log as-is with a newline added.+defaultFormatter :: LogFormatter+defaultFormatter _ _ msg = msg <> "\n"++-- | Prepends the timestamp to the log message and adds a new line.+withTimeFormatter :: LogFormatter+withTimeFormatter time _ msg = "[" <> toLogStr time <> "] " <> msg <> "\n"++-- | Prepends the log level to the log message and adds a new line.+withLevelFormatter :: LogFormatter+withLevelFormatter time level msg = "[" <> (toLogStr level) <> "] " <> msg <> "\n"++-- | Prepends the log level and timestamp to the log message and adds a new line.+withTimeAndLevelFormatter :: LogFormatter+withTimeAndLevelFormatter time level msg = "[" <> (toLogStr level) <> "] [" <> toLogStr time <> "] " <> msg <> "\n"
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2020 digitally induced GmbH++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.
+ ihp-log.cabal view
@@ -0,0 +1,42 @@+cabal-version: 2.2+name: ihp-log+version: 1.0.0+synopsis: Lightweight logging for IHP applications+description: Provides structured logging with configurable levels, formatters, and destinations.+ Can be used standalone or with the full IHP framework.+license: MIT+license-file: LICENSE+author: digitally induced GmbH+maintainer: hello@digitallyinduced.com+homepage: https://ihp.digitallyinduced.com/+bug-reports: https://github.com/digitallyinduced/ihp/issues+copyright: (c) digitally induced GmbH+category: Web, Logging, IHP++common shared-properties+ default-language: GHC2021+ build-depends:+ base >= 4.17.0 && < 4.22+ , filepath >= 1.5+ , text+ , bytestring+ , data-default+ , fast-logger+ , wai+ , wai-extra+ default-extensions:+ OverloadedStrings+ , ImplicitParams+ , DataKinds+ , RecordWildCards+ , OverloadedRecordDot+ , DuplicateRecordFields+ , LambdaCase+ ghc-options: -Werror=incomplete-patterns -Werror=unused-imports -Werror=missing-fields++library+ import: shared-properties+ hs-source-dirs: .+ exposed-modules:+ IHP.Log+ , IHP.Log.Types