ExceptionSpec.hs

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Network.Bugsnag.ExceptionSpec
  ( spec
  ) where

import Prelude

import Control.Exception
import Control.Exception.Annotated (AnnotatedException (..))
import Data.Bugsnag
import Examples
import Network.Bugsnag.Exception
import Test.Hspec

spec :: Spec
spec = do
  describe "AsException" $ do
    it "can throw and catch a Bugsnag.Exception" $ do
      AsException ex <- brokenFunctionIO `catch` pure

      exception_errorClass ex `shouldBe` "IOException"
      exception_message ex `shouldBe` Just "Something exploded"
      exception_stacktrace ex `shouldSatisfy` (not . null)

      let (frame : _) = exception_stacktrace ex
      stackFrame_file frame `shouldBe` "test/Examples.hs"
      stackFrame_lineNumber frame `shouldBe` 33
      -- different versions of GHC disagree on where splices start
      stackFrame_columnNumber frame
        `shouldSatisfy` (`elem` [Just 36, Just 37])
      stackFrame_method frame `shouldBe` "brokenFunctionIO"
      stackFrame_inProject frame `shouldBe` Just True

  describe "bugsnagExceptionFromSomeException" $ do
    it "sets errorClass" $ do
      let ex =
            bugsnagExceptionFromSomeException $
              toException $
                userError "Oops"

      exception_errorClass ex `shouldBe` "IOException"
      exception_message ex `shouldBe` Just "user error (Oops)"

    it "sets errorClass to the name of the exception type" $ do
      let ex = bugsnagExceptionFromSomeException $ toException Whatever

      exception_errorClass ex `shouldBe` "Whatever"

    it "unwraps AnnotatedException, setting errorClass to the wrapped type" $ do
      let ex =
            bugsnagExceptionFromSomeException $
              toException $
                AnnotatedException [] Whatever

      exception_errorClass ex `shouldBe` "Whatever"

    it "can parse errors with callstacks" $ do
      e <- evaluate brokenFunction `catch` pure

      let ex = bugsnagExceptionFromSomeException e
      exception_errorClass ex `shouldBe` "ErrorCall"
      exception_message ex `shouldBe` Just "empty list"
      exception_stacktrace ex `shouldSatisfy` ((== 3) . length)

      let (frame : _) = exception_stacktrace ex
      stackFrame_file frame `shouldBe` "test/Examples.hs"
      stackFrame_lineNumber frame `shouldBe` 41
      stackFrame_columnNumber frame `shouldBe` Just 15
      stackFrame_method frame `shouldBe` "error"

      map stackFrame_method (exception_stacktrace ex)
        `shouldBe` ["error", "sillyHead", "brokenFunction"]

    it "parses StringException" $ do
      e <- brokenFunction' `catch` pure

      let ex = bugsnagExceptionFromSomeException e
      exception_errorClass ex `shouldBe` "StringException"
      exception_message ex `shouldBe` Just "empty list"
      exception_stacktrace ex `shouldSatisfy` ((== 3) . length)

      let (frame : _) = exception_stacktrace ex
      stackFrame_file frame `shouldBe` "test/Examples.hs"
      stackFrame_lineNumber frame `shouldBe` 48
      stackFrame_columnNumber frame `shouldBe` Just 16
      stackFrame_method frame `shouldBe` "throwString"

      map stackFrame_method (exception_stacktrace ex)
        `shouldBe` ["throwString", "sillyHead'", "brokenFunction'"]

    it "parses StringExceptions with newlines" $ do
      e <- brokenFunction'' `catch` pure

      let ex = bugsnagExceptionFromSomeException e
      exception_errorClass ex `shouldBe` "StringException"
      exception_message ex
        `shouldBe` Just "empty list\n and message with newlines"
      exception_stacktrace ex `shouldSatisfy` ((== 3) . length)

      let (frame : _) = exception_stacktrace ex
      stackFrame_file frame `shouldBe` "test/Examples.hs"
      stackFrame_lineNumber frame `shouldBe` 55
      stackFrame_columnNumber frame `shouldBe` Just 17
      stackFrame_method frame `shouldBe` "throwString"

      map stackFrame_method (exception_stacktrace ex)
        `shouldBe` [ "throwString"
                   , "sillyHead''"
                   , "brokenFunction''"
                   ]

    it "parses (AnnotatedException StringException)" $ do
      e <- brokenFunctionAnnotated `catch` pure

      let ex = bugsnagExceptionFromSomeException e
      exception_errorClass ex `shouldBe` "StringException"
      exception_message ex `shouldBe` Just "empty list"
      exception_stacktrace ex `shouldSatisfy` ((== 3) . length)

      let (frame : _) = exception_stacktrace ex
      stackFrame_file frame `shouldBe` "test/Examples.hs"
      stackFrame_lineNumber frame `shouldBe` 48
      stackFrame_columnNumber frame `shouldBe` Just 16
      stackFrame_method frame `shouldBe` "throwString"

      map stackFrame_method (exception_stacktrace ex)
        `shouldBe` [ "throwString"
                   , "sillyHead'"
                   , "brokenFunctionAnnotated"
                   ]

#if MIN_VERSION_base(4,20,0)
    it "extracts a trace from base's native ExceptionContext (a single Backtraces annotation)" $ do
      e <- brokenFunctionBacktrace `catch` pure

      let ex = bugsnagExceptionFromSomeException e
      exception_errorClass ex `shouldBe` "Boom"
      exception_stacktrace ex `shouldSatisfy` ((>= 3) . length)

      -- The leading frames are GHC's own internal backtrace-collection
      -- machinery, which varies across GHC versions; only our own code's
      -- frames (the tail) are asserted on exactly.
      let ourFrames = ourExampleFrames (exception_stacktrace ex)
      map stackFrame_method ourFrames
        `shouldBe` ["throwIO", "sillyHeadBacktrace", "brokenFunctionBacktrace"]

      let (lastFrame : _) = reverse ourFrames
      stackFrame_file lastFrame `shouldBe` "test/Network/Bugsnag/ExceptionSpec.hs"
      stackFrame_lineNumber lastFrame `shouldBe` 136

    it "prefers the earliest attached Backtraces when more than one is present" $ do
      e <- brokenFunctionBacktraceCheckpointed `catch` pure

      let ex = bugsnagExceptionFromSomeException e
      exception_errorClass ex `shouldBe` "Boom"

      let ourFrames = ourExampleFrames (exception_stacktrace ex)
      map stackFrame_method ourFrames
        `shouldBe` ["throwIO", "sillyHeadBacktrace", "brokenFunctionBacktrace"]

      -- The last frame is the call to brokenFunctionBacktrace from *inside*
      -- brokenFunctionBacktraceCheckpointed (in Examples.hs) -- i.e. the
      -- original/earliest-attached annotation -- not the checkpoint's own
      -- separate, later-attached one (which would show only its own single
      -- call site instead).
      let (lastFrame : _) = reverse ourFrames
      stackFrame_file lastFrame `shouldBe` "test/Examples.hs"
      stackFrame_lineNumber lastFrame `shouldBe` 86

-- | The last three frames of a stack trace, i.e. our own test code, ignoring
-- any leading frames from GHC's own internal backtrace-collection machinery
ourExampleFrames :: [StackFrame] -> [StackFrame]
ourExampleFrames frames = drop (length frames - 3) frames
#endif