copy metadata from annotations into bugsnag events (#135)

freckle · Dec 4, 2023 · a68d3d5 · a68d3d5
1 parent b0c7b6c
commit a68d3d5
Show file tree

Hide file tree

Showing 7 changed files with 36 additions and 5 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,4 +1,13 @@
-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.10.6.0...main)
+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.10.7.0...main)
+
+## [v1.10.7.0](https://github.com/freckle/freckle-app/compare/v1.10.6.0...v1.10.7.0)
+
+- Any Bugsnag `MetaData` in an `AnnotatedException`'s annotations will now be copied
+  into the Bugsnag event. This means you can use the `checkpoint` function to add
+  context to an action, and this information will be visible in the bug report for
+  any unhandled exception thrown from that action.
+
+  e.g. `checkpoint (metaData "tab name" ["key" .= _value]) $ _action`
 
 ## [v1.10.6.0](https://github.com/freckle/freckle-app/compare/v1.10.5.0...v1.10.6.0)
 

diff --git a/freckle-app.cabal b/freckle-app.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.18
 -- see: https://github.com/sol/hpack
 
 name:           freckle-app
-version:        1.10.6.0
+version:        1.10.7.0
 synopsis:       Haskell application toolkit used at Freckle
 description:    Please see README.md
 category:       Utils

diff --git a/library/Freckle/App/Bugsnag.hs b/library/Freckle/App/Bugsnag.hs
@@ -29,6 +29,7 @@ import Data.List (isInfixOf)
 import Freckle.App.Async (async)
 import Freckle.App.Bugsnag.CallStack (callStackBeforeNotify)
 import Freckle.App.Bugsnag.HttpException (httpExceptionBeforeNotify)
+import Freckle.App.Bugsnag.MetaData (metaDataAnnotationsBeforeNotify)
 import Freckle.App.Bugsnag.SqlError (sqlErrorBeforeNotify)
 import qualified Freckle.App.Env as Env
 import Network.Bugsnag hiding (notifyBugsnag, notifyBugsnagWith)
@@ -111,6 +112,7 @@ envParseBugsnagSettings =
 globalBeforeNotify :: BeforeNotify
 globalBeforeNotify =
   callStackBeforeNotify
+    <> metaDataAnnotationsBeforeNotify
     <> sqlErrorBeforeNotify
     <> httpExceptionBeforeNotify
     <> maskErrorHelpers
diff --git a/library/Freckle/App/Bugsnag/MetaData.hs b/library/Freckle/App/Bugsnag/MetaData.hs
@@ -11,18 +11,25 @@ module Freckle.App.Bugsnag.MetaData
 
     -- * 'BeforeNotify'
   , mergeMetaData
+  , metaDataAnnotationsBeforeNotify
   ) where
 
 import Freckle.App.Prelude
 
 import Blammo.Logging (Pair, myThreadContext)
+import Control.Exception.Annotated (AnnotatedException, annotations)
 import Control.Lens (Lens', lens, to, view, (<>~))
 import Data.Aeson (KeyValue ((.=)), Object, Value (..), object)
+import Data.Annotation (tryAnnotations)
 import Data.Bugsnag (Event (..))
 import Data.String (fromString)
 import qualified Freckle.App.Aeson as Aeson
-import Freckle.App.Bugsnag (BeforeNotify, updateEvent)
 import Freckle.App.Stats (HasStatsClient (..), tagsL)
+import Network.Bugsnag
+  ( BeforeNotify
+  , updateEvent
+  , updateEventFromOriginalException
+  )
 
 newtype MetaData = MetaData
   { unMetaData :: Object
@@ -140,3 +147,10 @@ mergeMetaData md = updateEvent $ metaDataL <>~ md
 -- >         ...
 -- >     }
 -- > }
+
+-- | If any 'MetaData' values are present among the original exception's
+--   annotations, merge them into the Bugsnag event's metadata.
+metaDataAnnotationsBeforeNotify :: BeforeNotify
+metaDataAnnotationsBeforeNotify =
+  updateEventFromOriginalException @(AnnotatedException SomeException) $
+    foldMap mergeMetaData . fst . tryAnnotations @MetaData . annotations
diff --git a/library/Freckle/App/Exception/MonadThrow.hs b/library/Freckle/App/Exception/MonadThrow.hs
@@ -8,6 +8,8 @@ module Freckle.App.Exception.MonadThrow
   , catches
   , try
   , tryJust
+  , checkpoint
+  , checkpointMany
   , checkpointCallStack
 
     -- * Miscellany
@@ -20,6 +22,7 @@ module Freckle.App.Exception.MonadThrow
 import Freckle.App.Exception.Types
 
 import Control.Applicative (pure)
+import Control.Exception.Annotated (checkpoint, checkpointMany)
 import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
 import Data.Either (Either (..))
 import Data.Function (($), (.))

diff --git a/library/Freckle/App/Exception/MonadUnliftIO.hs b/library/Freckle/App/Exception/MonadUnliftIO.hs
@@ -8,6 +8,8 @@ module Freckle.App.Exception.MonadUnliftIO
   , catches
   , try
   , tryJust
+  , checkpoint
+  , checkpointMany
   , checkpointCallStack
 
     -- * Miscellany
@@ -20,6 +22,7 @@ module Freckle.App.Exception.MonadUnliftIO
 import Freckle.App.Exception.Types
 
 import Control.Applicative (pure)
+import Control.Exception.Annotated.UnliftIO (checkpoint, checkpointMany)
 import Data.Either (Either (..))
 import Data.Function (($), (.))
 import Data.Functor (fmap, (<$>))
@@ -29,9 +32,9 @@ import GHC.IO.Exception (userError)
 import GHC.Stack (withFrozenCallStack)
 import System.IO (IO)
 import UnliftIO (MonadIO, MonadUnliftIO)
-import qualified UnliftIO.Exception
 
 import qualified Control.Exception.Annotated.UnliftIO as Annotated
+import qualified UnliftIO.Exception
 
 -- Throws an exception, wrapped in 'AnnotatedException' which includes a call stack
 throwM :: forall e m a. (Exception e, MonadIO m, HasCallStack) => e -> m a

diff --git a/package.yaml b/package.yaml
@@ -1,5 +1,5 @@
 name: freckle-app
-version: 1.10.6.0
+version: 1.10.7.0
 maintainer: Freckle Education
 category: Utils
 github: freckle/freckle-app