freckle-app 1.10.5.1 → 1.10.6.0

raw patch · 9 files changed

+178/−71 lines, 9 files

Files

• CHANGELOG.md +8/−1
• freckle-app.cabal +4/−1
• library/Freckle/App/Bugsnag.hs +12/−65
• library/Freckle/App/Bugsnag/CallStack.hs +46/−0
• library/Freckle/App/Bugsnag/HttpException.hs +47/−0
• library/Freckle/App/Bugsnag/MetaData.hs +2/−2
• library/Freckle/App/Bugsnag/SqlError.hs +57/−0
• package.yaml +1/−1
• tests/Freckle/App/BugsnagSpec.hs +1/−1

@@ -1,4 +1,11 @@-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.10.5.1...main)+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.10.6.0...main)++## [v1.10.6.0](https://github.com/freckle/freckle-app/compare/v1.10.5.0...v1.10.6.0)++- The Bugsnag settings created by `envParseBugsnagSettings` now has a `BeforeNotify`+  that appropriately handles `AnnotatedException`. Its special handling of `SqlError`+  and `HttpException` now works in the presence of annotations. If a `CallStack`+  annotation is present, that will be used as the stacktrace for reported events.  ## [v1.10.5.1](https://github.com/freckle/freckle-app/compare/v1.10.5.0...v1.10.5.1) 

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               freckle-app-version:            1.10.5.1+version:            1.10.6.0 license:            MIT license-file:       LICENSE maintainer:         Freckle Education@@ -26,7 +26,10 @@         Freckle.App.Aeson         Freckle.App.Async         Freckle.App.Bugsnag+        Freckle.App.Bugsnag.CallStack+        Freckle.App.Bugsnag.HttpException         Freckle.App.Bugsnag.MetaData+        Freckle.App.Bugsnag.SqlError         Freckle.App.Csv         Freckle.App.Database         Freckle.App.Database.XRay

@@ -11,9 +11,6 @@     -- * Loading settings   , envParseBugsnagSettings -    -- * Exported for testing-  , sqlErrorGroupingHash-     -- * Re-exports   , MonadReader   , runReaderT@@ -22,22 +19,21 @@  import Freckle.App.Prelude +import qualified Control.Exception as Base (Exception) import Control.Lens (Lens', view) import Control.Monad.Catch (MonadMask) import Control.Monad.Reader (runReaderT)-import Data.Bugsnag-import Data.Bugsnag.Settings-import qualified Data.ByteString.Char8 as BS8+import Data.Bugsnag (App (..), Event (..), defaultApp)+import Data.Bugsnag.Settings (Settings (..), defaultSettings) import Data.List (isInfixOf)-import Database.PostgreSQL.Simple (SqlError (..))-import Database.PostgreSQL.Simple.Errors import Freckle.App.Async (async)+import Freckle.App.Bugsnag.CallStack (callStackBeforeNotify)+import Freckle.App.Bugsnag.HttpException (httpExceptionBeforeNotify)+import Freckle.App.Bugsnag.SqlError (sqlErrorBeforeNotify) import qualified Freckle.App.Env as Env-import qualified Freckle.App.Exception.MonadUnliftIO as Exception import Network.Bugsnag hiding (notifyBugsnag, notifyBugsnagWith) import qualified Network.Bugsnag as Bugsnag-import Network.HTTP.Client (HttpException (..), host, method)-import Yesod.Core.Lens+import Yesod.Core.Lens (envL, siteL) import Yesod.Core.Types (HandlerData)  class HasAppVersion env where@@ -72,7 +68,7 @@      , MonadUnliftIO m      , MonadReader env m      , HasBugsnagSettings env-     , Exception.Exception e+     , Base.Exception e      )   => e   -> m ()@@ -84,7 +80,7 @@      , MonadUnliftIO m      , MonadReader env m      , HasBugsnagSettings env-     , Exception.Exception e+     , Base.Exception e      )   => BeforeNotify   -> e@@ -93,54 +89,6 @@   settings <- view bugsnagSettingsL   void $ async $ liftIO $ Bugsnag.notifyBugsnagWith f settings ex -asSqlError :: SqlError -> BeforeNotify-asSqlError err@SqlError {..} = toSqlGrouping <> toSqlException- where-  toSqlGrouping = maybe mempty setGroupingHash (sqlErrorGroupingHash err)-  toSqlException = updateExceptions $ \ex ->-    ex-      { exception_errorClass = decodeUtf8 $ "SqlError-" <> sqlState-      , exception_message =-          Just $-            decodeUtf8 $-              sqlErrorMsg-                <> ": "-                <> sqlErrorDetail-                <> " ("-                <> sqlErrorHint-                <> ")"-      }--sqlErrorGroupingHash :: SqlError -> Maybe Text-sqlErrorGroupingHash err = do-  violation <- constraintViolation err-  decodeUtf8 <$> case violation of-    ForeignKeyViolation table constraint -> pure $ table <> "." <> constraint-    UniqueViolation constraint -> pure constraint-    _ -> Nothing--asHttpException :: HttpException -> BeforeNotify-asHttpException (HttpExceptionRequest req content) =-  setGroupingHash (decodeUtf8 $ host req) <> update- where-  update = updateExceptions $ \ex ->-    ex-      { exception_errorClass = "HttpExceptionRequest"-      , exception_message =-          Just-            . decodeUtf8-            $ method req-              <> " request to "-              <> host req-              <> " failed: "-              <> BS8.pack (show content)-      }-asHttpException (InvalidUrlException url msg) = updateExceptions $ \ex ->-  ex-    { exception_errorClass = "InvalidUrlException"-    , exception_message = Just $ pack $ url <> " is invalid: " <> msg-    }- -- | Set StackFrame's InProject to @'False'@ for Error Helper modules -- -- We want exceptions grouped by the the first stack-frame that is /not/ them.@@ -148,8 +96,6 @@ maskErrorHelpers :: BeforeNotify maskErrorHelpers = setStackFramesInProjectByFile (`isInfixOf` "Exceptions") --- brittany-disable-next-binding- envParseBugsnagSettings :: Env.Parser Env.Error Settings envParseBugsnagSettings =   build@@ -164,6 +110,7 @@  globalBeforeNotify :: BeforeNotify globalBeforeNotify =-  updateEventFromOriginalException asSqlError-    <> updateEventFromOriginalException asHttpException+  callStackBeforeNotify+    <> sqlErrorBeforeNotify+    <> httpExceptionBeforeNotify     <> maskErrorHelpers

@@ -0,0 +1,46 @@+module Freckle.App.Bugsnag.CallStack+  ( callStackBeforeNotify+  , attachCallStack+  , callStackToStackFrames+  , callSiteToStackFrame++    -- * Re-exports+  , CallStack+  , SrcLoc+  , StackFrame+  ) where++import Freckle.App.Prelude++import Control.Exception.Annotated (annotatedExceptionCallStack)+import Data.Bugsnag (Exception (..), StackFrame (..), defaultStackFrame)+import qualified Data.Text as T+import Freckle.App.Exception.Types (AnnotatedException)+import GHC.Stack (CallStack, SrcLoc (..), getCallStack)+import Network.Bugsnag (BeforeNotify, updateExceptions)+import Network.Bugsnag.BeforeNotify (updateEventFromOriginalException)++-- | Copy the call stack from an AnnotatedException+callStackBeforeNotify :: BeforeNotify+callStackBeforeNotify =+  updateEventFromOriginalException @(AnnotatedException SomeException) $ \e ->+    foldMap attachCallStack $ annotatedExceptionCallStack e++attachCallStack :: CallStack -> BeforeNotify+attachCallStack cs =+  updateExceptions $ \ex ->+    ex {exception_stacktrace = callStackToStackFrames cs}++-- | Converts a GHC call stack to a list of stack frames suitable+--   for use as the stacktrace in a Bugsnag exception+callStackToStackFrames :: CallStack -> [StackFrame]+callStackToStackFrames = fmap callSiteToStackFrame . getCallStack++callSiteToStackFrame :: (String, SrcLoc) -> StackFrame+callSiteToStackFrame (str, loc) =+  defaultStackFrame+    { stackFrame_method = T.pack str+    , stackFrame_file = T.pack $ srcLocFile loc+    , stackFrame_lineNumber = srcLocStartLine loc+    , stackFrame_columnNumber = Just $ srcLocStartCol loc+    }

@@ -0,0 +1,47 @@+module Freckle.App.Bugsnag.HttpException+  ( httpExceptionBeforeNotify++    -- * Re-exports+  , HttpException+  ) where++import Freckle.App.Prelude++import Data.Bugsnag (Exception (..))+import qualified Data.ByteString.Char8 as BS8+import Freckle.App.Exception.Types (AnnotatedException)+import qualified Freckle.App.Exception.Types as Annotated+import Network.Bugsnag+  ( BeforeNotify+  , setGroupingHash+  , updateEventFromOriginalException+  , updateExceptions+  )+import Network.HTTP.Client (HttpException (..), host, method)++httpExceptionBeforeNotify :: BeforeNotify+httpExceptionBeforeNotify =+  updateEventFromOriginalException @(AnnotatedException HttpException)+    (asHttpException . Annotated.exception)++asHttpException :: HttpException -> BeforeNotify+asHttpException (HttpExceptionRequest req content) =+  setGroupingHash (decodeUtf8 $ host req) <> update+ where+  update = updateExceptions $ \ex ->+    ex+      { exception_errorClass = "HttpExceptionRequest"+      , exception_message =+          Just+            . decodeUtf8+            $ method req+              <> " request to "+              <> host req+              <> " failed: "+              <> BS8.pack (show content)+      }+asHttpException (InvalidUrlException url msg) = updateExceptions $ \ex ->+  ex+    { exception_errorClass = "InvalidUrlException"+    , exception_message = Just $ pack $ url <> " is invalid: " <> msg+    }

@@ -17,11 +17,11 @@  import Blammo.Logging (Pair, myThreadContext) import Control.Lens (Lens', lens, to, view, (<>~))-import Data.Aeson+import Data.Aeson (KeyValue ((.=)), Object, Value (..), object) import Data.Bugsnag (Event (..)) import Data.String (fromString) import qualified Freckle.App.Aeson as Aeson-import Freckle.App.Bugsnag+import Freckle.App.Bugsnag (BeforeNotify, updateEvent) import Freckle.App.Stats (HasStatsClient (..), tagsL)  newtype MetaData = MetaData

@@ -0,0 +1,57 @@+module Freckle.App.Bugsnag.SqlError+  ( sqlErrorBeforeNotify++    -- * Re-exports+  , SqlError++    -- * Exported for testing+  , sqlErrorGroupingHash+  ) where++import Freckle.App.Prelude++import Data.Bugsnag (Exception (..))+import Database.PostgreSQL.Simple (SqlError (..))+import Database.PostgreSQL.Simple.Errors+  ( ConstraintViolation (..)+  , constraintViolation+  )+import Freckle.App.Exception.Types (AnnotatedException)+import qualified Freckle.App.Exception.Types as Annotated+import Network.Bugsnag+  ( BeforeNotify+  , setGroupingHash+  , updateEventFromOriginalException+  , updateExceptions+  )++sqlErrorBeforeNotify :: BeforeNotify+sqlErrorBeforeNotify =+  updateEventFromOriginalException @(AnnotatedException SqlError)+    (asSqlError . Annotated.exception)++asSqlError :: SqlError -> BeforeNotify+asSqlError err@SqlError {..} = toSqlGrouping <> toSqlException+ where+  toSqlGrouping = maybe mempty setGroupingHash (sqlErrorGroupingHash err)+  toSqlException = updateExceptions $ \ex ->+    ex+      { exception_errorClass = decodeUtf8 $ "SqlError-" <> sqlState+      , exception_message =+          Just $+            decodeUtf8 $+              sqlErrorMsg+                <> ": "+                <> sqlErrorDetail+                <> " ("+                <> sqlErrorHint+                <> ")"+      }++sqlErrorGroupingHash :: SqlError -> Maybe Text+sqlErrorGroupingHash err = do+  violation <- constraintViolation err+  decodeUtf8 <$> case violation of+    ForeignKeyViolation table constraint -> pure $ table <> "." <> constraint+    UniqueViolation constraint -> pure constraint+    _ -> Nothing

@@ -1,5 +1,5 @@ name: freckle-app-version: 1.10.5.1+version: 1.10.6.0 maintainer: Freckle Education category: Utils github: freckle/freckle-app

@@ -6,7 +6,7 @@  import Data.ByteString (ByteString) import Database.PostgreSQL.Simple (ExecStatus (..), SqlError (..))-import Freckle.App.Bugsnag+import Freckle.App.Bugsnag.SqlError (sqlErrorGroupingHash) import Test.Hspec  spec :: Spec