-- | Raven is a client for Sentry event server (<https://www.getsentry.com/>).
--
--   Start by initializing the raven 'Service':
--
-- > l <- initRaven
-- >          "https://pub:priv@sentry.hostname.tld:8443/sentry/example_project"
-- >          id
-- >          sendRecord
-- >          stderrFallback
--
--   Send events using 'register' function:
--
-- > register l "my.logger.name" Debug "Hi there!" id
--
--   Tags and stuff can be added using register update functions.
--
-- > import Data.HashMap.Strict as HM
-- > let tags r = r { srTags = HM.insert "spam" "sausage"
-- >                         . HM.insert "eggs" "bacon"
-- >                         . srTags r }
-- > lt <- initRaven dsn tags sendRecord stderrFallback
-- >
-- > let culprit r = r { srCulprit = "my.module.function.name" }
-- > register lt "test.culprit" Error "It's a trap!" culprit
-- > let extra r = r { srExtra = HM.insert "fnord" "42" $ srExtra r }
-- > register lt "test.extra" Info "Test with tags and extra, please ignore."
--
--   The core package provides only general interface for sending events which
--   could be wrapped to adapt it to your needs.
--
-- > let debug msg = forkIO $ register l "my.logger.name" Debug msg (culprit . extra)
-- > debug "Async stuff too."
--
--   There are some little helpers to compose your own updaters.
--   You can use them both in 'initRaven' and 'register'.
--
-- > l <- initRaven dsn ( tags [ ("spam", "sausage"
-- >                           , ("eggs", "bacon") ]
-- >                    . extra [ ("more", "stuff") ]
-- >                    )
-- >                    sendRecord stderrFallback
-- >
-- > register l "test.helpers" Info "yup, i'm here." $ culprit "java.lang.NotReally"

module System.Log.Raven
    ( -- * Event service
      initRaven, disabledRaven
    , register
      -- * Fallback handlers
    , stderrFallback, errorFallback, silentFallback
      -- * Record updaters
    , culprit, tags, extra
      -- * Lower level helpers
    , record, recordLBS
    ) where

import Data.Aeson (Value, encode)
import Data.ByteString.Lazy (ByteString)

import Data.UUID.Types (UUID)
import System.Random (randomIO)
import Data.Time.Clock (getCurrentTime)
import System.IO (stderr, hPutStrLn)
import qualified Control.Exception as E
import qualified Data.HashMap.Strict as HM

import System.Log.Raven.Types

-- | Initialize event service.
initRaven :: String                                    -- ^ Sentry DSN
          -> (SentryRecord -> SentryRecord)            -- ^ Default fields updater. Use 'id' if not needed.
          -> (SentrySettings -> SentryRecord -> IO ()) -- ^ Event transport from Raven.Transport.*
          -> (SentryRecord -> IO ())                   -- ^ Fallback handler.
          -> IO SentryService                          -- ^ Event service to use in 'register'.
initRaven :: String
-> (SentryRecord -> SentryRecord)
-> (SentrySettings -> SentryRecord -> IO ())
-> (SentryRecord -> IO ())
-> IO SentryService
initRaven String
dsn SentryRecord -> SentryRecord
d SentrySettings -> SentryRecord -> IO ()
t SentryRecord -> IO ()
fb = SentryService -> IO SentryService
forall (m :: * -> *) a. Monad m => a -> m a
return
    SentryService :: SentrySettings
-> (SentryRecord -> SentryRecord)
-> (SentrySettings -> SentryRecord -> IO ())
-> (SentryRecord -> IO ())
-> SentryService
SentryService { serviceSettings :: SentrySettings
serviceSettings = String -> SentrySettings
fromDSN String
dsn
                  , serviceDefaults :: SentryRecord -> SentryRecord
serviceDefaults = SentryRecord -> SentryRecord
d
                  , serviceTransport :: SentrySettings -> SentryRecord -> IO ()
serviceTransport = SentrySettings -> SentryRecord -> IO ()
t
                  , serviceFallback :: SentryRecord -> IO ()
serviceFallback = SentryRecord -> IO ()
fb
                  }

-- | Disabled service that ignores incoming events.
disabledRaven :: IO SentryService
disabledRaven :: IO SentryService
disabledRaven = String
-> (SentryRecord -> SentryRecord)
-> (SentrySettings -> SentryRecord -> IO ())
-> (SentryRecord -> IO ())
-> IO SentryService
initRaven String
"" SentryRecord -> SentryRecord
forall a. a -> a
id SentrySettings -> SentryRecord -> IO ()
forall a. HasCallStack => a
undefined SentryRecord -> IO ()
forall a. HasCallStack => a
undefined

-- | Ask service to store an event.
register :: SentryService                  -- ^ Configured raven service.
         -> String                         -- ^ Logger name.
         -> SentryLevel                    -- ^ Sentry event level.
         -> String                         -- ^ Message.
         -> (SentryRecord -> SentryRecord) -- ^ Record updates.
         -> IO ()
register :: SentryService
-> String
-> SentryLevel
-> String
-> (SentryRecord -> SentryRecord)
-> IO ()
register SentryService
s String
loggerName SentryLevel
level String
message SentryRecord -> SentryRecord
upd = do
    SentryRecord
rec <- String
-> SentryLevel
-> String
-> (SentryRecord -> SentryRecord)
-> IO SentryRecord
record String
loggerName SentryLevel
level String
message (SentryRecord -> SentryRecord
upd (SentryRecord -> SentryRecord)
-> (SentryRecord -> SentryRecord) -> SentryRecord -> SentryRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SentryService -> SentryRecord -> SentryRecord
serviceDefaults SentryService
s)

    let transport :: SentrySettings -> SentryRecord -> IO ()
transport = SentryService -> SentrySettings -> SentryRecord -> IO ()
serviceTransport SentryService
s

    case SentryService -> SentrySettings
serviceSettings SentryService
s of
        SentrySettings
SentryDisabled -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        SentrySettings
settings -> IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (SentrySettings -> SentryRecord -> IO ()
transport SentrySettings
settings SentryRecord
rec)
                            (\(E.SomeException e
_) -> SentryService -> SentryRecord -> IO ()
serviceFallback SentryService
s (SentryRecord -> IO ()) -> SentryRecord -> IO ()
forall a b. (a -> b) -> a -> b
$ SentryRecord
rec)

-- | Show basic message on stderr.
stderrFallback :: SentryRecord -> IO ()
stderrFallback :: SentryRecord -> IO ()
stderrFallback SentryRecord
rec =
    Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ UTCTime -> String
forall a. Show a => a -> String
show (UTCTime -> String) -> UTCTime -> String
forall a b. (a -> b) -> a -> b
$ SentryRecord -> UTCTime
srTimestamp SentryRecord
rec, String
" "
        , SentryLevel -> String
forall a. Show a => a -> String
show (SentryLevel -> String) -> SentryLevel -> String
forall a b. (a -> b) -> a -> b
$ SentryRecord -> SentryLevel
srLevel SentryRecord
rec, String
" "
        , SentryRecord -> String
srLogger SentryRecord
rec, String
": "
        , SentryRecord -> String
srMessage SentryRecord
rec
        ]

-- | Crash and burn with record data.
errorFallback :: SentryRecord -> IO ()
errorFallback :: SentryRecord -> IO ()
errorFallback SentryRecord
rec = String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error sending record: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SentryRecord -> String
forall a. Show a => a -> String
show SentryRecord
rec

-- | Ignore recording errors.
silentFallback :: SentryRecord -> IO ()
silentFallback :: SentryRecord -> IO ()
silentFallback SentryRecord
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Record an event using logging service.
record :: String                         -- ^ Logger name.
       -> SentryLevel                    -- ^ Level
       -> String                         -- ^ Message
       -> (SentryRecord -> SentryRecord) -- ^ Additional options
       -> IO SentryRecord
record :: String
-> SentryLevel
-> String
-> (SentryRecord -> SentryRecord)
-> IO SentryRecord
record String
logger SentryLevel
lvl String
msg SentryRecord -> SentryRecord
upd = do
    String
eid <- ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') (String -> String) -> (UUID -> String) -> UUID -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall a. Show a => a -> String
show) (UUID -> String) -> IO UUID -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (IO UUID
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO :: IO UUID)
    UTCTime
ts <- IO UTCTime
getCurrentTime
    SentryRecord -> IO SentryRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (SentryRecord -> IO SentryRecord)
-> SentryRecord -> IO SentryRecord
forall a b. (a -> b) -> a -> b
$! SentryRecord -> SentryRecord
upd (String
-> String -> UTCTime -> SentryLevel -> String -> SentryRecord
newRecord String
eid String
msg UTCTime
ts SentryLevel
lvl String
logger)

-- | JSON-encode record data.
recordLBS :: SentryRecord -> ByteString
recordLBS :: SentryRecord -> ByteString
recordLBS = SentryRecord -> ByteString
forall a. ToJSON a => a -> ByteString
encode

-- | Set culprit field.
culprit :: String -> SentryRecord -> SentryRecord
culprit :: String -> SentryRecord -> SentryRecord
culprit String
c SentryRecord
r = SentryRecord
r { srCulprit :: Maybe String
srCulprit = String -> Maybe String
forall a. a -> Maybe a
Just String
c }

-- | Add record tags.
tags :: [(String, String)] -> SentryRecord -> SentryRecord
tags :: [(String, String)] -> SentryRecord -> SentryRecord
tags [(String, String)]
ts SentryRecord
r = SentryRecord
r { srTags :: Assoc
srTags = [(String, String)] -> Assoc
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(String, String)]
ts Assoc -> Assoc -> Assoc
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union` SentryRecord -> Assoc
srTags SentryRecord
r }

-- | Add record extra information.
extra :: [(String, Value)] -> SentryRecord -> SentryRecord
extra :: [(String, Value)] -> SentryRecord -> SentryRecord
extra [(String, Value)]
ts SentryRecord
r =  SentryRecord
r { srExtra :: HashMap String Value
srExtra = [(String, Value)] -> HashMap String Value
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(String, Value)]
ts HashMap String Value
-> HashMap String Value -> HashMap String Value
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union` SentryRecord -> HashMap String Value
srExtra SentryRecord
r }