bugsnag-haskell 0.0.1.2 → 0.0.1.3

raw patch · 5 files changed

+146/−70 lines, 5 filesdep +unliftiodep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unliftio

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• bugsnag-haskell.cabal +4/−3
• examples/yesod/Main.hs +8/−2
• src/Network/Bugsnag/BeforeNotify.hs +87/−16
• src/Network/Bugsnag/Notify.hs +17/−37
• src/Network/Bugsnag/Settings.hs +30/−12

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 7bf291abde6fe3bc6aa43132c387532dae5ab319f44295932acaefa836a13869+-- hash: 36962ecc46dfa7d5ab30da6797310d06145ecdd5d2d487ab6f1ec237b259e721  name:           bugsnag-haskell-version:        0.0.1.2+version:        0.0.1.3 synopsis:       Bugsnag error reporter for Haskell description:    Please see README.md category:       Web@@ -27,7 +27,7 @@       src   ghc-options: -Wall   build-depends:-      aeson+      aeson >=1.3.0.0     , base >=4.8.0 && <5     , bytestring     , case-insensitive@@ -123,6 +123,7 @@       base >=4.8.0 && <5     , bugsnag-haskell     , exceptions+    , unliftio     , wai     , warp     , yesod-core

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}@@ -9,9 +10,14 @@  import Control.Exception (SomeException, fromException, toException) import Control.Monad (unless)-import Control.Monad.Catch (catch, throwM) import Network.Bugsnag import Network.Wai.Handler.Warp (run)+#if MIN_VERSION_yesod_core(1,6,0)+import UnliftIO.Exception (catch, throwIO)+#else+import Control.Monad.Catch (catch)+import UnliftIO.Exception (throwIO)+#endif import Yesod.Core import Yesod.Core.Types (HandlerContents) @@ -43,7 +49,7 @@         unless (isHandlerContents ex)             $ forkHandler (const $ pure ()) $ liftIO             $ notifyBugsnagWith (updateEventFromWaiRequest request) settings ex-        throwM $ toException ex+        throwIO $ toException ex   where     isHandlerContents :: SomeException -> Bool     isHandlerContents ex =

@@ -1,13 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+ module Network.Bugsnag.BeforeNotify     ( BeforeNotify+    , defaultBeforeNotify      -- * Modifying the Exception     , updateException+    , filterStackFrames+    , setStackFramesInProject+    , setGroupingHash+    , setGroupingHashBy      -- * Modifying the Event     , updateEventFromSession     , updateEventFromWaiRequest +    -- * Modifying the Request+    , redactRequestHeaders+     -- * Simple setters     , setDevice     , setRequest@@ -19,6 +29,7 @@     , setInfoSeverity     ) where +import Data.Text (Text) import Network.Bugsnag.Device import Network.Bugsnag.Event import Network.Bugsnag.Exception@@ -26,10 +37,30 @@ import Network.Bugsnag.Session import Network.Bugsnag.Severity import Network.Bugsnag.StackFrame+import Network.HTTP.Types.Header (Header, HeaderName) import Network.Wai (Request)  type BeforeNotify = BugsnagEvent -> BugsnagEvent +-- | Used as @'bsBeforeNotify'@ the default Settings value+--+-- Redacts the following Request headers:+--+-- - Authorization+-- - Cookie+-- - X-XSRF-TOKEN (CSRF token header used by Yesod)+--+-- N.B. If you override the value on @'BugsnagSettings'@, you probably want to+-- maintain this as well:+--+-- @+-- settings { 'bsBeforeNotify' = 'defaultBeforeNotify' . myBeforeNotify }+-- @+--+defaultBeforeNotify :: BeforeNotify+defaultBeforeNotify =+    redactRequestHeaders ["Authorization", "Cookie", "X-XSRF-TOKEN"]+ -- | Modify just the Exception part of an Event -- -- Technically this will modify all exceptions in the Event, but if you're using@@ -50,50 +81,90 @@ -- >         _ -> ex -- updateException :: (BugsnagException -> BugsnagException) -> BeforeNotify-updateException f event = event-    { beExceptions = f <$> beExceptions event-    }+updateException f event = event { beExceptions = f <$> beExceptions event } +-- | Filter out StackFrames matching a predicate+filterStackFrames :: (BugsnagStackFrame -> Bool) -> BeforeNotify+filterStackFrames p =+    updateException $ \ex -> ex { beStacktrace = filter p $ beStacktrace ex }++-- | Set @'bsIsInProject'@ using the given predicate, applied to the Filename+setStackFramesInProject :: (FilePath -> Bool) -> BeforeNotify+setStackFramesInProject p = updateException+    $ \ex -> ex { beStacktrace = map updateStackFrames $ beStacktrace ex }+  where+    updateStackFrames :: BugsnagStackFrame -> BugsnagStackFrame+    updateStackFrames sf = sf { bsfInProject = Just $ p $ bsfFile sf }++-- | Set @'beGroupingHash'@+setGroupingHash :: Text -> BeforeNotify+setGroupingHash hash = setGroupingHashBy $ const $ Just hash++-- | Set @'beGroupingHash'@ based on the Event+setGroupingHashBy :: (BugsnagEvent -> Maybe Text) -> BeforeNotify+setGroupingHashBy f event = event { beGroupingHash = f event }+ -- | Set the events @'BugsnagEvent'@ and @'BugsnagDevice'@ updateEventFromWaiRequest :: Request -> BeforeNotify updateEventFromWaiRequest wrequest =-    let mdevice = bugsnagDeviceFromWaiRequest wrequest+    let+        mdevice = bugsnagDeviceFromWaiRequest wrequest         request = bugsnagRequestFromWaiRequest wrequest     in maybe id setDevice mdevice . setRequest request  -- | Update the Event's Context and User from the Session updateEventFromSession :: BugsnagSession -> BeforeNotify-updateEventFromSession session event = event-    { beContext = bsContext session-    , beUser = bsUser session+updateEventFromSession session event =+    event { beContext = bsContext session, beUser = bsUser session }++-- | Redact the given request headers+--+-- Headers like @Authorization@ may contain information you don't want to report+-- to Bugsnag.+--+-- > redactRequestHeaders ["Authorization", "Cookie"]+--+redactRequestHeaders :: [HeaderName] -> BeforeNotify+redactRequestHeaders headers event =+    event { beRequest = redactHeaders headers <$> beRequest event }++-- |+--+-- >>> let headers = [("Authorization", "secret"), ("X-Foo", "Bar")]+-- >>> let req = bugsnagRequest { brHeaders = Just headers }+-- >>> brHeaders $ redactHeaders ["Authorization"] req+-- Just [("Authorization","<redacted>"),("X-Foo","Bar")]+--+redactHeaders :: [HeaderName] -> BugsnagRequest -> BugsnagRequest+redactHeaders headers request = request+    { brHeaders = map redactHeader <$> brHeaders request     }+  where+    redactHeader :: Header -> Header+    redactHeader (k, _) | k `elem` headers = (k, "<redacted>")+    redactHeader h = h  -- | Set the Event's Request -- -- See @'bugsnagRequestFromWaiRequest'@ -- setRequest :: BugsnagRequest -> BeforeNotify-setRequest request event = event-    { beRequest = Just request-    }+setRequest request event = event { beRequest = Just request }  -- | Set the Event's Device -- -- See @'bugsnagDeviceFromWaiRequest'@ -- setDevice :: BugsnagDevice -> BeforeNotify-setDevice device event = event-    { beDevice = Just device-    }+setDevice device event = event { beDevice = Just device }  -- | Set the stacktrace on the reported exception -- -- > notifyBugsnagWith (setStacktrace [$(currentStackFrame) "myFunc"]) ... -- setStacktrace :: [BugsnagStackFrame] -> BeforeNotify-setStacktrace stacktrace = updateException $ \ex -> ex-    { beStacktrace = stacktrace-    }+setStacktrace stacktrace =+    updateException $ \ex -> ex { beStacktrace = stacktrace }  -- | Set to @'ErrorSeverity'@ setErrorSeverity :: BeforeNotify

@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-}+ module Network.Bugsnag.Notify     ( notifyBugsnag     , notifyBugsnagWith@@ -12,7 +14,6 @@ import Network.Bugsnag.Report import Network.Bugsnag.Reporter import Network.Bugsnag.Settings-import Network.Bugsnag.StackFrame  -- | Notify Bugsnag of a single exception notifyBugsnag :: BugsnagSettings -> SomeException -> IO ()@@ -26,47 +27,26 @@ -- notifyBugsnagWith :: BeforeNotify -> BugsnagSettings -> SomeException -> IO () notifyBugsnagWith f settings ex = do-    let exception = bugsnagExceptionFromSomeException ex--    -- N.B. all notify functions should go through here. We need to maintain-    -- this as the single point where (e.g.) should-notify is checked,-    -- before-notify is applied, stack-frame filtering, etc.-    when (bugsnagShouldNotify settings exception) $ do-        let event-                = f+    let event =+            f                 . bsBeforeNotify settings-                . updateGroupingHash settings-                . updateStackFramesInProject settings-                . filterStackFrames settings+                . setGroupingHashBy (bsGroupingHash settings)+                . setStackFramesInProject (bsIsInProject settings)+                . filterStackFrames (bsFilterStackFrames settings)                 . createApp settings                 . bugsnagEvent-                $ pure exception--            manager = bsHttpManager settings-            apiKey = bsApiKey settings-            report = bugsnagReport [event]--        reportError manager apiKey report--updateGroupingHash :: BugsnagSettings -> BeforeNotify-updateGroupingHash settings event = event-    { beGroupingHash = bsGroupingHash settings event-    }+                . pure+                $ bugsnagExceptionFromSomeException ex -updateStackFramesInProject :: BugsnagSettings -> BeforeNotify-updateStackFramesInProject settings = updateException $ \ex -> ex-    { beStacktrace = map updateStackFrames $ beStacktrace ex-    }-  where-    updateStackFrames :: BugsnagStackFrame -> BugsnagStackFrame-    updateStackFrames sf = sf-        { bsfInProject = Just $ bsIsInProject settings $ bsfFile sf-        }+        manager = bsHttpManager settings+        apiKey = bsApiKey settings+        report = bugsnagReport [event] -filterStackFrames :: BugsnagSettings -> BeforeNotify-filterStackFrames settings = updateException $ \ex -> ex-    { beStacktrace = filter (bsFilterStackFrames settings) $ beStacktrace ex-    }+    -- N.B. all notify functions should go through here. We need to maintain+    -- this as the single point where (e.g.) should-notify is checked,+    -- before-notify is applied, stack-frame filtering, etc.+    when (bugsnagShouldNotify settings event)+        $ reportError manager apiKey report  -- | --

@@ -12,6 +12,7 @@     ) where  import Data.Aeson (FromJSON)+import qualified Data.List.NonEmpty as NE import Data.String import Data.Text (Text) import qualified Data.Text as T@@ -51,7 +52,9 @@     , bsBeforeNotify :: BeforeNotify     -- ^ Modify any events before they are sent     ---    -- For example to attach a user, or set the context.+    -- For example to attach a user, or set the context. By default, we use+    -- @'redactRequestHeaders'@ to strip some sensitive Headers from the+    -- Request.     --     , bsIgnoreException :: BugsnagException -> Bool     -- ^ Exception filtering@@ -86,6 +89,10 @@     --     } +{-# DEPRECATED bsGroupingHash "use setGroupingHashBy with bsBeforeNotify" #-}+{-# DEPRECATED bsIsInProject "use setStackFramesInProject with bsBeforeNotify" #-}+{-# DEPRECATED bsFilterStackFrames "use filterStackFrames with bsBeforeNotify" #-}+ -- | Construct settings purely, given an existing @'Manager'@ bugsnagSettings :: BugsnagApiKey -> Manager -> BugsnagSettings bugsnagSettings apiKey manager = BugsnagSettings@@ -93,7 +100,7 @@     , bsAppVersion = Nothing     , bsReleaseStage = ProductionReleaseStage     , bsNotifyReleaseStages = [ProductionReleaseStage]-    , bsBeforeNotify = id+    , bsBeforeNotify = defaultBeforeNotify     , bsIgnoreException = const False     , bsGroupingHash = const Nothing     , bsIsInProject = const True@@ -101,37 +108,48 @@     , bsHttpManager = manager     } --- | Should this @'BugsnagException'@ trigger notification?+-- | Should this @'BugsnagEvent'@ trigger notification? -- -- >>> :set -XOverloadedStrings -- >>> settings <- newBugsnagSettings ""--- >>> let exception = bugsnagException "" "" []--- >>> bugsnagShouldNotify settings exception+-- >>> let event = bugsnagEvent $ pure $ bugsnagException "" "" []+-- >>> bugsnagShouldNotify settings event -- True -- -- >>> let devSettings = settings { bsReleaseStage = DevelopmentReleaseStage }--- >>> bugsnagShouldNotify devSettings exception+-- >>> bugsnagShouldNotify devSettings event -- False ----- >>> bugsnagShouldNotify devSettings { bsNotifyReleaseStages = [DevelopmentReleaseStage] } exception+-- >>> bugsnagShouldNotify devSettings { bsNotifyReleaseStages = [DevelopmentReleaseStage] } event -- True -- -- >>> let ignore = (== "IgnoreMe") . beErrorClass -- >>> let ignoreSettings = settings { bsIgnoreException = ignore }--- >>> bugsnagShouldNotify ignoreSettings exception+-- >>> let ignoreEvent = bugsnagEvent $ pure $ bugsnagException "IgnoreMe" "" []+-- >>> bugsnagShouldNotify ignoreSettings event -- True ----- >>> bugsnagShouldNotify ignoreSettings exception { beErrorClass = "IgnoreMe" }+-- >>> bugsnagShouldNotify ignoreSettings ignoreEvent -- False ---bugsnagShouldNotify :: BugsnagSettings -> BugsnagException -> Bool-bugsnagShouldNotify settings exception+bugsnagShouldNotify :: BugsnagSettings -> BugsnagEvent -> Bool+bugsnagShouldNotify settings event     | bsReleaseStage settings `notElem` bsNotifyReleaseStages settings = False     | bsIgnoreException settings exception = False     | otherwise = True+  where+    exception+        | NE.length (beExceptions event) == 1 = NE.head $ beExceptions event+        | otherwise = error $ unlines+            [ "Library misused. Event must have exactly one Exception when"+            , " going through our notifyBugsnag functions. To send more than"+            , " one Exception, drop down to reportError."+            ]  -- | Construct settings with a new, TLS-enabled @'Manager'@ --+-- Uses @'getGlobalManager'@.+-- -- >>> :set -XOverloadedStrings -- >>> settings <- newBugsnagSettings "API_KEY" -- >>> bsApiKey settings@@ -144,4 +162,4 @@ -- [ProductionReleaseStage] -- newBugsnagSettings :: BugsnagApiKey -> IO BugsnagSettings-newBugsnagSettings apiKey = bugsnagSettings apiKey <$> newTlsManager+newBugsnagSettings apiKey = bugsnagSettings apiKey <$> getGlobalManager