{-
   Ory Hydra API

   Documentation for all of Ory Hydra's APIs. 

   OpenAPI Version: 3.0.3
   Ory Hydra API API version: 
   Contact: hi@ory.sh
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : OryHydra.LoggingKatip
Katip Logging functions
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module OryHydra.LoggingKatip where

import qualified Control.Exception.Safe as E
import qualified Control.Monad.IO.Class as P
import qualified Control.Monad.Trans.Reader as P
import qualified Data.Text as T
import qualified Lens.Micro as L
import qualified System.IO as IO

import Data.Text (Text)
import GHC.Exts (IsString(..))

import qualified Katip as LG

-- * Type Aliases (for compatibility)

-- | Runs a Katip logging block with the Log environment
type LogExecWithContext = forall m a. P.MonadIO m =>
                                      LogContext -> LogExec m a

-- | A Katip logging block
type LogExec m a = LG.KatipT m a -> m a

-- | A Katip Log environment
type LogContext = LG.LogEnv

-- | A Katip Log severity
type LogLevel = LG.Severity

-- * default logger

-- | the default log environment
initLogContext :: IO LogContext
initLogContext :: IO LogContext
initLogContext = Namespace -> Environment -> IO LogContext
LG.initLogEnv Namespace
"OryHydra" Environment
"dev"

-- | Runs a Katip logging block with the Log environment
runDefaultLogExecWithContext :: LogExecWithContext
runDefaultLogExecWithContext :: LogExecWithContext
runDefaultLogExecWithContext = forall (m :: * -> *) a. LogContext -> KatipT m a -> m a
LG.runKatipT

-- * stdout logger

-- | Runs a Katip logging block with the Log environment
stdoutLoggingExec :: LogExecWithContext
stdoutLoggingExec :: LogExecWithContext
stdoutLoggingExec = LogExecWithContext
runDefaultLogExecWithContext

-- | A Katip Log environment which targets stdout
stdoutLoggingContext :: LogContext -> IO LogContext
stdoutLoggingContext :: LogContext -> IO LogContext
stdoutLoggingContext LogContext
cxt = do
    Scribe
handleScribe <- ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
LG.mkHandleScribe ColorStrategy
LG.ColorIfTerminal Handle
IO.stdout (forall (m :: * -> *) a. Monad m => Severity -> Item a -> m Bool
LG.permitItem Severity
LG.InfoS) Verbosity
LG.V2
    Text -> Scribe -> ScribeSettings -> LogContext -> IO LogContext
LG.registerScribe Text
"stdout" Scribe
handleScribe ScribeSettings
LG.defaultScribeSettings LogContext
cxt

-- * stderr logger

-- | Runs a Katip logging block with the Log environment
stderrLoggingExec :: LogExecWithContext
stderrLoggingExec :: LogExecWithContext
stderrLoggingExec = LogExecWithContext
runDefaultLogExecWithContext

-- | A Katip Log environment which targets stderr
stderrLoggingContext :: LogContext -> IO LogContext
stderrLoggingContext :: LogContext -> IO LogContext
stderrLoggingContext LogContext
cxt = do
    Scribe
handleScribe <- ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
LG.mkHandleScribe ColorStrategy
LG.ColorIfTerminal Handle
IO.stderr (forall (m :: * -> *) a. Monad m => Severity -> Item a -> m Bool
LG.permitItem Severity
LG.InfoS) Verbosity
LG.V2
    Text -> Scribe -> ScribeSettings -> LogContext -> IO LogContext
LG.registerScribe Text
"stderr" Scribe
handleScribe ScribeSettings
LG.defaultScribeSettings LogContext
cxt

-- * Null logger

-- | Disables Katip logging
runNullLogExec :: LogExecWithContext
runNullLogExec :: LogExecWithContext
runNullLogExec LogContext
le (LG.KatipT ReaderT LogContext m a
f) = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
P.runReaderT ReaderT LogContext m a
f (forall s t a b. ASetter s t a b -> b -> s -> t
L.set Lens' LogContext (Map Text ScribeHandle)
LG.logEnvScribes forall a. Monoid a => a
mempty LogContext
le)

-- * Log Msg

-- | Log a katip message
_log :: (Applicative m, LG.Katip m) => Text -> LogLevel -> Text -> m ()
_log :: forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> Severity -> Text -> m ()
_log Text
src Severity
level Text
msg = do
  forall (m :: * -> *).
(Applicative m, Katip m) =>
Namespace -> Severity -> LogStr -> m ()
LG.logMsg (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src) Severity
level (forall a. StringConv a Text => a -> LogStr
LG.logStr Text
msg)

-- * Log Exceptions

-- | re-throws exceptions after logging them
logExceptions
  :: (LG.Katip m, E.MonadCatch m, Applicative m)
  => Text -> m a -> m a
logExceptions :: forall (m :: * -> *) a.
(Katip m, MonadCatch m, Applicative m) =>
Text -> m a -> m a
logExceptions Text
src =
  forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle
    (\(SomeException
e :: E.SomeException) -> do
       forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> Severity -> Text -> m ()
_log Text
src Severity
LG.ErrorS ((String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) SomeException
e)
       forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
E.throw SomeException
e)

-- * Log Level

levelInfo :: LogLevel
levelInfo :: Severity
levelInfo = Severity
LG.InfoS

levelError :: LogLevel
levelError :: Severity
levelError = Severity
LG.ErrorS

levelDebug :: LogLevel
levelDebug :: Severity
levelDebug = Severity
LG.DebugS