module System.Log.Raven
(
initRaven, disabledRaven
, register
, stderrFallback, errorFallback, silentFallback
, culprit, tags, extra
, 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
initRaven :: String
-> (SentryRecord -> SentryRecord)
-> (SentrySettings -> SentryRecord -> IO ())
-> (SentryRecord -> IO ())
-> IO SentryService
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
}
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
register :: SentryService
-> String
-> SentryLevel
-> String
-> (SentryRecord -> SentryRecord)
-> 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)
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
]
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
silentFallback :: SentryRecord -> IO ()
silentFallback :: SentryRecord -> IO ()
silentFallback SentryRecord
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
record :: String
-> SentryLevel
-> String
-> (SentryRecord -> SentryRecord)
-> 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)
recordLBS :: SentryRecord -> ByteString
recordLBS :: SentryRecord -> ByteString
recordLBS = SentryRecord -> ByteString
forall a. ToJSON a => a -> ByteString
encode
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 }
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 }
extra :: [(String, Value)] -> SentryRecord -> SentryRecord
[(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 }