module Instana.SDK.Internal.Logging
( initLogger
, instanaLogger
, parseLogLevel
, minimumLogLevel
)
where
import Control.Monad (when)
import Data.Maybe (catMaybes, isJust)
import qualified Data.Text as T
import System.Directory (getTemporaryDirectory)
import System.Environment (lookupEnv)
import System.IO (Handle, stdout)
import System.Log.Formatter
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple (GenericHandler, fileHandler,
streamHandler)
import System.Log.Logger (Priority (..), rootLoggerName,
setHandlers, setLevel,
updateGlobalLogger)
logLevelKey :: String
logLevelKey :: String
logLevelKey = "INSTANA_LOG_LEVEL"
logLevelStdOutKey :: String
logLevelStdOutKey :: String
logLevelStdOutKey = "INSTANA_LOG_LEVEL_STDOUT"
overrideHsloggerRootHandlerKey :: String
overrideHsloggerRootHandlerKey :: String
overrideHsloggerRootHandlerKey = "INSTANA_OVERRIDE_HSLOGGER_ROOT_HANDLER"
instanaLogger :: String
instanaLogger :: String
instanaLogger = "Instana"
initLogger :: String -> IO ()
initLogger :: String -> IO ()
initLogger pid :: String
pid = do
Maybe String
logLevelFileStr <- String -> IO (Maybe String)
lookupEnv String
logLevelKey
Maybe String
logLevelStdOutStr <- String -> IO (Maybe String)
lookupEnv String
logLevelStdOutKey
let
logLevelFile :: Maybe Priority
logLevelFile = Maybe String
logLevelFileStr Maybe String -> (String -> Maybe Priority) -> Maybe Priority
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Priority
parseLogLevel
logLevelStdOut :: Maybe Priority
logLevelStdOut = Maybe String
logLevelStdOutStr Maybe String -> (String -> Maybe Priority) -> Maybe Priority
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Priority
parseLogLevel
let
minLogLevel :: Maybe Priority
minLogLevel = Maybe Priority -> Maybe Priority -> Maybe Priority
minimumLogLevel Maybe Priority
logLevelFile Maybe Priority
logLevelStdOut
case Maybe Priority
minLogLevel of
Just minLevel :: Priority
minLevel ->
String -> Priority -> Maybe Priority -> Maybe Priority -> IO ()
actuallyInitLogger String
pid Priority
minLevel Maybe Priority
logLevelFile Maybe Priority
logLevelStdOut
Nothing -> do
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
actuallyInitLogger ::
String ->
Priority ->
Maybe Priority ->
Maybe Priority ->
IO ()
actuallyInitLogger :: String -> Priority -> Maybe Priority -> Maybe Priority -> IO ()
actuallyInitLogger pid :: String
pid minLogLevel :: Priority
minLogLevel logLevelFile :: Maybe Priority
logLevelFile logLevelStdOut :: Maybe Priority
logLevelStdOut = do
String -> (Logger -> Logger) -> IO ()
updateGlobalLogger String
instanaLogger ((Logger -> Logger) -> IO ()) -> (Logger -> Logger) -> IO ()
forall a b. (a -> b) -> a -> b
$ Priority -> Logger -> Logger
setLevel Priority
minLogLevel
Maybe (GenericHandler Handle)
logFileHandler <-
Maybe (IO (GenericHandler Handle))
-> IO (Maybe (GenericHandler Handle))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Maybe (IO (GenericHandler Handle))
-> IO (Maybe (GenericHandler Handle)))
-> Maybe (IO (GenericHandler Handle))
-> IO (Maybe (GenericHandler Handle))
forall a b. (a -> b) -> a -> b
$
(\logLevel :: Priority
logLevel -> String -> Priority -> IO (GenericHandler Handle)
createFileHandler String
pid Priority
logLevel) (Priority -> IO (GenericHandler Handle))
-> Maybe Priority -> Maybe (IO (GenericHandler Handle))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Priority
logLevelFile
Maybe (GenericHandler Handle)
stdOutHandler <-
Maybe (IO (GenericHandler Handle))
-> IO (Maybe (GenericHandler Handle))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Maybe (IO (GenericHandler Handle))
-> IO (Maybe (GenericHandler Handle)))
-> Maybe (IO (GenericHandler Handle))
-> IO (Maybe (GenericHandler Handle))
forall a b. (a -> b) -> a -> b
$
(\logLevel :: Priority
logLevel -> Priority -> IO (GenericHandler Handle)
createStdOutHandler Priority
logLevel) (Priority -> IO (GenericHandler Handle))
-> Maybe Priority -> Maybe (IO (GenericHandler Handle))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Priority
logLevelStdOut
Maybe (GenericHandler Handle)
-> Maybe (GenericHandler Handle) -> IO ()
setLogHandlers Maybe (GenericHandler Handle)
logFileHandler Maybe (GenericHandler Handle)
stdOutHandler
createFileHandler :: String -> Priority -> IO (GenericHandler Handle)
createFileHandler :: String -> Priority -> IO (GenericHandler Handle)
createFileHandler pid :: String
pid logLevel :: Priority
logLevel = do
String
systemTempDir <- IO String
getTemporaryDirectory
let
systemTempDir' :: String
systemTempDir' =
case String -> Char
forall a. [a] -> a
last String
systemTempDir of
'/' -> String
systemTempDir
'\\' -> String
systemTempDir
_ -> String
systemTempDir String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/"
logPath :: String
logPath = String
systemTempDir' String -> String -> String
forall a. [a] -> [a] -> [a]
++ "instana-haskell-sdk." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pid String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".log"
GenericHandler Handle
instanaFileHandler <- String -> Priority -> IO (GenericHandler Handle)
fileHandler String
logPath Priority
logLevel
let
formattedInstanaFileHandler :: GenericHandler Handle
formattedInstanaFileHandler = GenericHandler Handle -> GenericHandler Handle
withFormatter GenericHandler Handle
instanaFileHandler
GenericHandler Handle -> IO (GenericHandler Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericHandler Handle
formattedInstanaFileHandler
createStdOutHandler :: Priority -> IO (GenericHandler Handle)
createStdOutHandler :: Priority -> IO (GenericHandler Handle)
createStdOutHandler logLevel :: Priority
logLevel = do
GenericHandler Handle
instanaStreamHandler <- Handle -> Priority -> IO (GenericHandler Handle)
streamHandler Handle
stdout Priority
logLevel
let
formattedInstanaStreamHandler :: GenericHandler Handle
formattedInstanaStreamHandler = GenericHandler Handle -> GenericHandler Handle
withFormatter GenericHandler Handle
instanaStreamHandler
GenericHandler Handle -> IO (GenericHandler Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericHandler Handle
formattedInstanaStreamHandler
setLogHandlers ::
Maybe (GenericHandler Handle)
-> Maybe (GenericHandler Handle)
-> IO ()
setLogHandlers :: Maybe (GenericHandler Handle)
-> Maybe (GenericHandler Handle) -> IO ()
setLogHandlers logFileHandler :: Maybe (GenericHandler Handle)
logFileHandler stdOutHandler :: Maybe (GenericHandler Handle)
stdOutHandler = do
Maybe String
overrideHsloggerRootHandlerVal <-
String -> IO (Maybe String)
lookupEnv String
overrideHsloggerRootHandlerKey
let
overrideHsloggerRootHandler :: Bool
overrideHsloggerRootHandler =
Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
overrideHsloggerRootHandlerVal
handlers :: [GenericHandler Handle]
handlers =
[Maybe (GenericHandler Handle)] -> [GenericHandler Handle]
forall a. [Maybe a] -> [a]
catMaybes
[ Maybe (GenericHandler Handle)
logFileHandler
, if Bool
overrideHsloggerRootHandler
then Maybe (GenericHandler Handle)
forall a. Maybe a
Nothing
else Maybe (GenericHandler Handle)
stdOutHandler
]
String -> (Logger -> Logger) -> IO ()
updateGlobalLogger String
instanaLogger ((Logger -> Logger) -> IO ()) -> (Logger -> Logger) -> IO ()
forall a b. (a -> b) -> a -> b
$ [GenericHandler Handle] -> Logger -> Logger
forall a. LogHandler a => [a] -> Logger -> Logger
setHandlers [GenericHandler Handle]
handlers
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
overrideHsloggerRootHandler
(do
GenericHandler Handle
actualStdOutHandler <-
case Maybe (GenericHandler Handle)
stdOutHandler of
Just handler :: GenericHandler Handle
handler ->
GenericHandler Handle -> IO (GenericHandler Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericHandler Handle
handler
Nothing ->
Priority -> IO (GenericHandler Handle)
createStdOutHandler Priority
EMERGENCY
let
overrideRootHhandlers :: [GenericHandler Handle]
overrideRootHhandlers = [ GenericHandler Handle
actualStdOutHandler ]
String -> (Logger -> Logger) -> IO ()
updateGlobalLogger String
rootLoggerName ((Logger -> Logger) -> IO ()) -> (Logger -> Logger) -> IO ()
forall a b. (a -> b) -> a -> b
$ [GenericHandler Handle] -> Logger -> Logger
forall a. LogHandler a => [a] -> Logger -> Logger
setHandlers [GenericHandler Handle]
overrideRootHhandlers
)
withFormatter :: GenericHandler Handle -> GenericHandler Handle
withFormatter :: GenericHandler Handle -> GenericHandler Handle
withFormatter handler :: GenericHandler Handle
handler = GenericHandler Handle
-> LogFormatter (GenericHandler Handle) -> GenericHandler Handle
forall a. LogHandler a => a -> LogFormatter a -> a
setFormatter GenericHandler Handle
handler LogFormatter (GenericHandler Handle)
forall a. LogFormatter a
formatter
where
timeFormat :: String
timeFormat = "%F %H:%M:%S.%4q %z"
formatter :: LogFormatter a
formatter = String -> String -> LogFormatter a
forall a. String -> String -> LogFormatter a
tfLogFormatter String
timeFormat "[$time $loggername $pid $prio] $msg"
parseLogLevel :: String -> Maybe Priority
parseLogLevel :: String -> Maybe Priority
parseLogLevel logLevelStr :: String
logLevelStr =
case (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
logLevelStr) of
"DEBUG" -> Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
DEBUG
"INFO" -> Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
INFO
"NOTICE" -> Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
NOTICE
"WARNING" -> Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
WARNING
"ERROR" -> Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
ERROR
"CRITICAL" -> Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
CRITICAL
"ALERT" -> Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
ALERT
"EMERGENCY" -> Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
EMERGENCY
_ -> Maybe Priority
forall a. Maybe a
Nothing
minimumLogLevel :: Maybe Priority -> Maybe Priority -> Maybe Priority
minimumLogLevel :: Maybe Priority -> Maybe Priority -> Maybe Priority
minimumLogLevel (Just l1 :: Priority
l1) (Just l2 :: Priority
l2) = Priority -> Maybe Priority
forall a. a -> Maybe a
Just (Priority -> Maybe Priority) -> Priority -> Maybe Priority
forall a b. (a -> b) -> a -> b
$ Priority -> Priority -> Priority
forall a. Ord a => a -> a -> a
min Priority
l1 Priority
l2
minimumLogLevel (Just l :: Priority
l) Nothing = Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
l
minimumLogLevel Nothing (Just l :: Priority
l) = Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
l
minimumLogLevel _ _ = Maybe Priority
forall a. Maybe a
Nothing