{-
   Vikunja API

   # Pagination Every endpoint capable of pagination will return two headers: * `x-pagination-total-pages`: The total number of available pages for this request * `x-pagination-result-count`: The number of items returned for this request. # Rights All endpoints which return a single item (project, task, etc.) - no array - will also return a `x-max-right` header with the max right the user has on this item as an int where `0` is `Read Only`, `1` is `Read & Write` and `2` is `Admin`. This can be used to show or hide ui elements based on the rights the user has. # Errors All errors have an error code and a human-readable error message in addition to the http status code. You should always check for the status code in the response, not only the http status code. Due to limitations in the swagger library we're using for this document, only one error per http status code is documented here. Make sure to check the [error docs](https://vikunja.io/docs/errors/) in Vikunja's documentation for a full list of available error codes. # Authorization **JWT-Auth:** Main authorization method, used for most of the requests. Needs `Authorization: Bearer <jwt-token>`-header to authenticate successfully.  **API Token:** You can create scoped API tokens for your user and use the token to make authenticated requests in the context of that user. The token must be provided via an `Authorization: Bearer <token>` header, similar to jwt auth. See the documentation for the `api` group to manage token creation and revocation.  **BasicAuth:** Only used when requesting tasks via CalDAV. <!-- ReDoc-Inject: <security-definitions> -->

   OpenAPI Version: 3.0.1
   Vikunja API API version: 0.24.6
   Contact: hello@vikunja.io
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

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

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

module Vikunja.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
"Vikunja" Environment
"dev"

-- | Runs a Katip logging block with the Log environment
runDefaultLogExecWithContext :: LogExecWithContext
runDefaultLogExecWithContext :: LogContext -> LogExec m a
runDefaultLogExecWithContext = LogContext -> LogExec m a
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 :: LogContext -> LogExec m a
stdoutLoggingExec = LogContext -> LogExec m a
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 (Severity -> Item a -> IO Bool
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 :: LogContext -> LogExec m a
stderrLoggingExec = LogContext -> LogExec m a
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 (Severity -> Item a -> IO Bool
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 :: LogContext -> LogExec m a
runNullLogExec LogContext
le (LG.KatipT ReaderT LogContext m a
f) = ReaderT LogContext m a -> LogContext -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
P.runReaderT ReaderT LogContext m a
f (ASetter
  LogContext
  LogContext
  (Map Text ScribeHandle)
  (Map Text ScribeHandle)
-> Map Text ScribeHandle -> LogContext -> LogContext
forall s t a b. ASetter s t a b -> b -> s -> t
L.set ASetter
  LogContext
  LogContext
  (Map Text ScribeHandle)
  (Map Text ScribeHandle)
Lens' LogContext (Map Text ScribeHandle)
LG.logEnvScribes Map Text ScribeHandle
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 :: Text -> Severity -> Text -> m ()
_log Text
src Severity
level Text
msg = do
  Namespace -> Severity -> LogStr -> m ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Namespace -> Severity -> LogStr -> m ()
LG.logMsg (String -> Namespace
forall a. IsString a => String -> a
fromString (String -> Namespace) -> String -> Namespace
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src) Severity
level (Text -> LogStr
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 :: Text -> m a -> m a
logExceptions Text
src =
  (SomeException -> m a) -> m a -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle
    (\(SomeException
e :: E.SomeException) -> do
       Text -> Severity -> Text -> m ()
forall (m :: * -> *).
(Applicative m, Katip m) =>
Text -> Severity -> Text -> m ()
_log Text
src Severity
LG.ErrorS ((String -> Text
T.pack (String -> Text)
-> (SomeException -> String) -> SomeException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) SomeException
e)
       SomeException -> m a
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