-- | Module for logging (crash) reports to Sentry
module SentryLogging(
  getCrashLogger, logCrashMessage
) where

import qualified System.Log.Raven as Sentry
import qualified System.Log.Raven.Transport.HttpConduit as Sentry
import qualified System.Log.Raven.Types as Sentry

-- | Returns a Maybe SentryService which can be used to send error information
-- to Sentry. Return value is Nothing is the environment variable SENTRY_DSN is
-- not set.
getCrashLogger :: String -> IO Sentry.SentryService
getCrashLogger :: String -> IO SentryService
getCrashLogger String
dsn = String
-> (SentryRecord -> SentryRecord)
-> (SentrySettings -> SentryRecord -> IO ())
-> (SentryRecord -> IO ())
-> IO SentryService
Sentry.initRaven String
dsn SentryRecord -> SentryRecord
forall a. a -> a
id SentrySettings -> SentryRecord -> IO ()
Sentry.sendRecord SentryRecord -> IO ()
Sentry.stderrFallback

-- | Send a crash message to Sentry, used in cases when no exception is available,
-- Which is the case for Scotty errors. Function does nothing when Sentry service
-- is Nothing.
logCrashMessage :: String -> Sentry.SentryService -> String -> IO ()
logCrashMessage :: String -> SentryService -> String -> IO ()
logCrashMessage String
name SentryService
service String
message = SentryService
-> String
-> SentryLevel
-> String
-> (SentryRecord -> SentryRecord)
-> IO ()
Sentry.register SentryService
service String
name SentryLevel
Sentry.Fatal String
message SentryRecord -> SentryRecord
forall a. a -> a
id