Logging.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |Logging utility functions
module Chakra.Logging
  ( LogMessage,
    ModLogger,
    Formatter,
    jsonFormatter,
    newLogger,
    buildLogger,
  )
where

import Data.Aeson
  ( ToJSON (toEncoding),
    defaultOptions,
    encode,
    genericToEncoding,
  )
import Data.Has (Has (hasLens))
import qualified Data.Text.Encoding as T
import RIO
import System.Log.FastLogger

type ModLogger = LogFunc

type Formatter = TimedFastLogger -> CallStack -> LogSource -> LogLevel -> Utf8Builder -> IO ()

data LogMessage = LogMessage
  { message :: !Text,
    logSource :: !Text,
    callStack :: !Text,
    timestamp :: !Text,
    level :: !Text,
    appVersion :: !Text,
    appEnvironment :: !Text
  }
  deriving (Eq, Show, Generic)

instance ToJSON LogMessage where
  toEncoding = genericToEncoding defaultOptions

instance ToLogStr LogMessage where
  toLogStr a = (toLogStr . encode $ a) <> "\n"

instance {-# OVERLAPPABLE #-} Has ModLogger a => HasLogFunc a where
  logFuncL = hasLens

-- | Creates a logger module using a given formatting function.
-- | Also returns the underlying TimedFastLogger for use outside of your app (e.g. in some WAI middleware).
newLogger :: LogType -> Formatter -> IO (TimedFastLogger, ModLogger)
newLogger logtype formatter = do
  tc <- newTimeCache simpleTimeFormat'
  (fl, _cleanupAction) <- newTimedFastLogger tc logtype
  -- todo clean up
  return (fl, mkLogFunc $ formatter fl)

-- | Builds LogMessage and json encodes to string
jsonFormatter :: Text -> Text -> Formatter
jsonFormatter envName appVer logger cs src logLvl msg = logger buildJsonLogMsg
  where
    showLevel LevelDebug = "debug"
    showLevel LevelInfo = "info"
    showLevel LevelWarn = "warn"
    showLevel LevelError = "error"
    showLevel (LevelOther t) = "" <> t <> ""
    buildJsonLogMsg t =
      toLogStr $
        LogMessage
          (utf8BuilderToText msg)
          (utf8BuilderToText . displayBytesUtf8 . fromLogStr . toLogStr $ src)
          (utf8BuilderToText $ displayCallStack cs)
          (T.decodeUtf8 t)
          (showLevel logLvl)
          appVer
          envName

-- | Convenient function to create json formatted logger with appName & appVer values
buildLogger :: Text -> Text -> IO ModLogger
buildLogger envName appVer = do
  (_, lf) <- newLogger (LogStderr defaultBufSize) (jsonFormatter envName appVer)
  return lf