module Instana.SDK.Internal.Logging
( initLogger
, instanaLogger
, parseLogLevel
, minimumLogLevel
)
where
import Control.Monad (when)
import Data.Maybe (catMaybes, isJust)
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 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