{-# LANGUAGE LambdaCase #-}

{- |
Module      :  OpenTelemetry.Internal.Logging
Copyright   :  (c) Ian Duncan, 2021
License     :  BSD-3
Description :  SDK-internal diagnostic logging, per the OTel specification.
Maintainer  :  Ian Duncan
Stability   :  internal
Portability :  non-portable (GHC extensions)

The OpenTelemetry specification mandates that the SDK produces
self-diagnostic output controllable via @OTEL_LOG_LEVEL@
(error, warn, info, debug) and that users can plug a custom error
handler.

Output goes to @stderr@ by default so it never interferes with
application stdout. The log level is read once from the environment
on first use and cached for the process lifetime. Users can override
the output sink via 'setGlobalErrorHandler'.

This module is internal. Library authors should not depend on it.

@since 0.4.0.0
-}
module OpenTelemetry.Internal.Logging (
  OTelLogLevel (..),
  otelLogError,
  otelLogWarning,
  otelLogInfo,
  otelLogDebug,
  getOTelLogLevel,
  setGlobalErrorHandler,
  getGlobalErrorHandler,
) where

import Data.Char (toLower)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import System.Environment (lookupEnv)
import System.IO (hPutStrLn, stderr)
import System.IO.Unsafe (unsafePerformIO)


-- | @since 0.4.0.0
data OTelLogLevel
  = OTelLogNone
  | OTelLogError
  | OTelLogWarning
  | OTelLogInfo
  | OTelLogDebug
  deriving (OTelLogLevel -> OTelLogLevel -> Bool
(OTelLogLevel -> OTelLogLevel -> Bool)
-> (OTelLogLevel -> OTelLogLevel -> Bool) -> Eq OTelLogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OTelLogLevel -> OTelLogLevel -> Bool
== :: OTelLogLevel -> OTelLogLevel -> Bool
$c/= :: OTelLogLevel -> OTelLogLevel -> Bool
/= :: OTelLogLevel -> OTelLogLevel -> Bool
Eq, Eq OTelLogLevel
Eq OTelLogLevel =>
(OTelLogLevel -> OTelLogLevel -> Ordering)
-> (OTelLogLevel -> OTelLogLevel -> Bool)
-> (OTelLogLevel -> OTelLogLevel -> Bool)
-> (OTelLogLevel -> OTelLogLevel -> Bool)
-> (OTelLogLevel -> OTelLogLevel -> Bool)
-> (OTelLogLevel -> OTelLogLevel -> OTelLogLevel)
-> (OTelLogLevel -> OTelLogLevel -> OTelLogLevel)
-> Ord OTelLogLevel
OTelLogLevel -> OTelLogLevel -> Bool
OTelLogLevel -> OTelLogLevel -> Ordering
OTelLogLevel -> OTelLogLevel -> OTelLogLevel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OTelLogLevel -> OTelLogLevel -> Ordering
compare :: OTelLogLevel -> OTelLogLevel -> Ordering
$c< :: OTelLogLevel -> OTelLogLevel -> Bool
< :: OTelLogLevel -> OTelLogLevel -> Bool
$c<= :: OTelLogLevel -> OTelLogLevel -> Bool
<= :: OTelLogLevel -> OTelLogLevel -> Bool
$c> :: OTelLogLevel -> OTelLogLevel -> Bool
> :: OTelLogLevel -> OTelLogLevel -> Bool
$c>= :: OTelLogLevel -> OTelLogLevel -> Bool
>= :: OTelLogLevel -> OTelLogLevel -> Bool
$cmax :: OTelLogLevel -> OTelLogLevel -> OTelLogLevel
max :: OTelLogLevel -> OTelLogLevel -> OTelLogLevel
$cmin :: OTelLogLevel -> OTelLogLevel -> OTelLogLevel
min :: OTelLogLevel -> OTelLogLevel -> OTelLogLevel
Ord, Int -> OTelLogLevel -> ShowS
[OTelLogLevel] -> ShowS
OTelLogLevel -> [Char]
(Int -> OTelLogLevel -> ShowS)
-> (OTelLogLevel -> [Char])
-> ([OTelLogLevel] -> ShowS)
-> Show OTelLogLevel
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OTelLogLevel -> ShowS
showsPrec :: Int -> OTelLogLevel -> ShowS
$cshow :: OTelLogLevel -> [Char]
show :: OTelLogLevel -> [Char]
$cshowList :: [OTelLogLevel] -> ShowS
showList :: [OTelLogLevel] -> ShowS
Show)


parseLogLevel :: String -> OTelLogLevel
parseLogLevel :: [Char] -> OTelLogLevel
parseLogLevel [Char]
s = case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
s of
  [Char]
"none" -> OTelLogLevel
OTelLogNone
  [Char]
"error" -> OTelLogLevel
OTelLogError
  [Char]
"warn" -> OTelLogLevel
OTelLogWarning
  [Char]
"warning" -> OTelLogLevel
OTelLogWarning
  [Char]
"info" -> OTelLogLevel
OTelLogInfo
  [Char]
"debug" -> OTelLogLevel
OTelLogDebug
  [Char]
_ -> OTelLogLevel
OTelLogInfo


cachedLogLevel :: IORef OTelLogLevel
cachedLogLevel :: IORef OTelLogLevel
cachedLogLevel = IO (IORef OTelLogLevel) -> IORef OTelLogLevel
forall a. IO a -> a
unsafePerformIO (IO (IORef OTelLogLevel) -> IORef OTelLogLevel)
-> IO (IORef OTelLogLevel) -> IORef OTelLogLevel
forall a b. (a -> b) -> a -> b
$ do
  mEnv <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"OTEL_LOG_LEVEL"
  newIORef $ case mEnv of
    Maybe [Char]
Nothing -> OTelLogLevel
OTelLogInfo
    Just [Char]
v -> [Char] -> OTelLogLevel
parseLogLevel [Char]
v
{-# NOINLINE cachedLogLevel #-}


globalErrorHandler :: IORef (String -> IO ())
globalErrorHandler :: IORef ([Char] -> IO ())
globalErrorHandler = IO (IORef ([Char] -> IO ())) -> IORef ([Char] -> IO ())
forall a. IO a -> a
unsafePerformIO (IO (IORef ([Char] -> IO ())) -> IORef ([Char] -> IO ()))
-> IO (IORef ([Char] -> IO ())) -> IORef ([Char] -> IO ())
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO ()) -> IO (IORef ([Char] -> IO ()))
forall a. a -> IO (IORef a)
newIORef (Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr)
{-# NOINLINE globalErrorHandler #-}


{- | Replace the global error handler used by all OTel SDK diagnostic
output. The default writes to @stderr@. The OTel spec requires that
the SDK allow users to plug a custom error handler.

The handler receives a pre-formatted message string including the
severity prefix (e.g. @"OpenTelemetry [ERROR] ..."@).

@since 0.4.0.0
-}
setGlobalErrorHandler :: (String -> IO ()) -> IO ()
setGlobalErrorHandler :: ([Char] -> IO ()) -> IO ()
setGlobalErrorHandler = IORef ([Char] -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ([Char] -> IO ())
globalErrorHandler


{- | Retrieve the current global error handler.

@since 0.4.0.0
-}
getGlobalErrorHandler :: IO (String -> IO ())
getGlobalErrorHandler :: IO ([Char] -> IO ())
getGlobalErrorHandler = IORef ([Char] -> IO ()) -> IO ([Char] -> IO ())
forall a. IORef a -> IO a
readIORef IORef ([Char] -> IO ())
globalErrorHandler


{- | Retrieve the currently configured log level.

@since 0.4.0.0
-}
getOTelLogLevel :: IO OTelLogLevel
getOTelLogLevel :: IO OTelLogLevel
getOTelLogLevel = IORef OTelLogLevel -> IO OTelLogLevel
forall a. IORef a -> IO a
readIORef IORef OTelLogLevel
cachedLogLevel
{-# INLINE getOTelLogLevel #-}


otelLog :: OTelLogLevel -> String -> String -> IO ()
otelLog :: OTelLogLevel -> [Char] -> [Char] -> IO ()
otelLog OTelLogLevel
minLevel [Char]
prefix [Char]
msg = do
  level <- IO OTelLogLevel
getOTelLogLevel
  if level >= minLevel
    then do
      handler <- getGlobalErrorHandler
      handler (prefix <> msg)
    else pure ()
{-# INLINE otelLog #-}


{- | Log at ERROR level. Always emitted unless @OTEL_LOG_LEVEL=none@.

@since 0.4.0.0
-}
otelLogError :: String -> IO ()
otelLogError :: [Char] -> IO ()
otelLogError = OTelLogLevel -> [Char] -> [Char] -> IO ()
otelLog OTelLogLevel
OTelLogError [Char]
"OpenTelemetry [ERROR] "
{-# INLINE otelLogError #-}


{- | Log at WARNING level.

@since 0.4.0.0
-}
otelLogWarning :: String -> IO ()
otelLogWarning :: [Char] -> IO ()
otelLogWarning = OTelLogLevel -> [Char] -> [Char] -> IO ()
otelLog OTelLogLevel
OTelLogWarning [Char]
"OpenTelemetry [WARN] "
{-# INLINE otelLogWarning #-}


{- | Log at INFO level.

@since 0.4.0.0
-}
otelLogInfo :: String -> IO ()
otelLogInfo :: [Char] -> IO ()
otelLogInfo = OTelLogLevel -> [Char] -> [Char] -> IO ()
otelLog OTelLogLevel
OTelLogInfo [Char]
"OpenTelemetry [INFO] "
{-# INLINE otelLogInfo #-}


{- | Log at DEBUG level.

@since 0.4.0.0
-}
otelLogDebug :: String -> IO ()
otelLogDebug :: [Char] -> IO ()
otelLogDebug = OTelLogLevel -> [Char] -> [Char] -> IO ()
otelLog OTelLogLevel
OTelLogDebug [Char]
"OpenTelemetry [DEBUG] "
{-# INLINE otelLogDebug #-}