bugsnag-haskell 0.0.3.0 → 0.0.3.1
raw patch · 4 files changed
+73/−86 lines, 4 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- bugsnag-haskell.cabal +47/−47
- src/Network/Bugsnag/Exception.hs +6/−21
- src/Network/Bugsnag/Request.hs +18/−16
- test/Network/BugsnagSpec.hs +2/−2
bugsnag-haskell.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.31.0.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: 5358213d15bc36742a81c0406bbf708c01be7b9579ab67a42049f7e25cd4a77f+-- hash: a71bc66ddcfe6442810073ecaf19f31bea964f76eced2a28882753d54c829618 name: bugsnag-haskell-version: 0.0.3.0+version: 0.0.3.1 synopsis: Bugsnag error reporter for Haskell description: Please see README.md category: Web@@ -29,29 +29,6 @@ default: False library- hs-source-dirs:- src- ghc-options: -Wall- build-depends:- Glob >=0.9.0- , aeson >=1.3.0.0- , base >=4.8.0 && <5- , bytestring- , case-insensitive- , containers- , http-client- , http-client-tls- , http-conduit- , http-types- , iproute- , network- , parsec- , template-haskell- , text- , th-lift-instances- , time- , ua-parser- , wai exposed-modules: Data.Aeson.Ext Network.Bugsnag@@ -77,59 +54,84 @@ Network.Bugsnag.User other-modules: Paths_bugsnag_haskell+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ Glob >=0.9.0+ , aeson >=1.3.0.0+ , base >=4.11.0 && <5+ , bytestring+ , case-insensitive+ , containers+ , http-client+ , http-client-tls+ , http-conduit+ , http-types+ , iproute+ , network+ , parsec+ , template-haskell+ , text+ , th-lift-instances+ , time+ , ua-parser+ , wai default-language: Haskell2010 executable example-cli main-is: Main.hs+ other-modules:+ Paths_bugsnag_haskell hs-source-dirs: examples/cli ghc-options: -Wall build-depends:- base >=4.8.0 && <5+ base >=4.11.0 && <5 , bugsnag-haskell if !(flag(examples)) buildable: False- other-modules:- Paths_bugsnag_haskell default-language: Haskell2010 executable example-simple main-is: Main.hs+ other-modules:+ Paths_bugsnag_haskell hs-source-dirs: examples/simple ghc-options: -Wall build-depends:- base >=4.8.0 && <5+ base >=4.11.0 && <5 , bugsnag-haskell if !(flag(examples)) buildable: False- other-modules:- Paths_bugsnag_haskell default-language: Haskell2010 executable example-warp main-is: Main.hs+ other-modules:+ Paths_bugsnag_haskell hs-source-dirs: examples/warp ghc-options: -Wall build-depends:- base >=4.8.0 && <5+ base >=4.11.0 && <5 , bugsnag-haskell , wai , warp if !(flag(examples)) buildable: False- other-modules:- Paths_bugsnag_haskell default-language: Haskell2010 executable example-yesod main-is: Main.hs+ other-modules:+ Paths_bugsnag_haskell hs-source-dirs: examples/yesod ghc-options: -Wall build-depends:- base >=4.8.0 && <5+ base >=4.11.0 && <5 , bugsnag-haskell , exceptions , unliftio@@ -138,41 +140,39 @@ , yesod-core if !(flag(examples)) buildable: False- other-modules:- Paths_bugsnag_haskell default-language: Haskell2010 test-suite doctest type: exitcode-stdio-1.0 main-is: DocTest.hs+ other-modules:+ Paths_bugsnag_haskell hs-source-dirs: ./. ghc-options: -Wall -Wall build-depends:- base >=4.8.0 && <5+ base >=4.11.0 && <5 , doctest- other-modules:- Paths_bugsnag_haskell default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs+ other-modules:+ Network.Bugsnag.CodeIndexSpec+ Network.Bugsnag.ReportSpec+ Network.BugsnagSpec+ Paths_bugsnag_haskell hs-source-dirs: test ghc-options: -Wall build-depends: aeson , aeson-qq- , base >=4.8.0 && <5+ , base >=4.11.0 && <5 , bugsnag-haskell , hspec , text , time , unliftio- other-modules:- Network.Bugsnag.CodeIndexSpec- Network.Bugsnag.ReportSpec- Network.BugsnagSpec- Paths_bugsnag_haskell default-language: Haskell2010
src/Network/Bugsnag/Exception.hs view
@@ -73,34 +73,19 @@ -- ("IOException",Just "user error (Oops)") -- bugsnagExceptionFromSomeException :: SomeException -> BugsnagException-bugsnagExceptionFromSomeException ex =- foldr go (bugsnagExceptionWithParser parseStringException ex) exCasters- where+bugsnagExceptionFromSomeException ex = foldr go seed exCasters+ where go :: Caster -> BugsnagException -> BugsnagException go (Caster caster) res = maybe res caster $ fromException ex + seed = (bugsnagExceptionWithParser parseStringException ex)+ { beErrorClass = (\(SomeException e) -> exErrorClass e) ex+ }+ exCasters :: [Caster] exCasters = [ Caster id , Caster $ bugsnagExceptionWithParser parseErrorCall- , Caster $ bugsnagExceptionFromException @IOException- , Caster $ bugsnagExceptionFromException @ArithException- , Caster $ bugsnagExceptionFromException @ArrayException- , Caster $ bugsnagExceptionFromException @AssertionFailed- , Caster $ bugsnagExceptionFromException @SomeAsyncException- , Caster $ bugsnagExceptionFromException @AsyncException- , Caster $ bugsnagExceptionFromException @NonTermination- , Caster $ bugsnagExceptionFromException @NestedAtomically- , Caster $ bugsnagExceptionFromException @BlockedIndefinitelyOnMVar- , Caster $ bugsnagExceptionFromException @BlockedIndefinitelyOnSTM- , Caster $ bugsnagExceptionFromException @AllocationLimitExceeded- , Caster $ bugsnagExceptionFromException @Deadlock- , Caster $ bugsnagExceptionFromException @NoMethodError- , Caster $ bugsnagExceptionFromException @PatternMatchFail- , Caster $ bugsnagExceptionFromException @RecConError- , Caster $ bugsnagExceptionFromException @RecSelError- , Caster $ bugsnagExceptionFromException @RecUpdError- , Caster $ bugsnagExceptionFromException @TypeError ] bugsnagExceptionWithParser
src/Network/Bugsnag/Request.hs view
@@ -1,10 +1,12 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} module Network.Bugsnag.Request ( BugsnagRequest(..) , bugsnagRequest , bugsnagRequestFromWaiRequest- ) where+ )+where import Control.Applicative ((<|>)) import Data.Aeson@@ -13,7 +15,6 @@ import qualified Data.ByteString.Char8 as C8 import Data.IP import Data.Maybe (fromMaybe)-import Data.Monoid ((<>)) import GHC.Generics import Network.HTTP.Types import Network.Socket@@ -55,12 +56,12 @@ } requestRealIp :: Request -> Maybe ByteString-requestRealIp request = requestForwardedFor request- <|> lookup "X-Real-IP" (requestHeaders request)+requestRealIp request =+ requestForwardedFor request <|> lookup "X-Real-IP" (requestHeaders request) requestForwardedFor :: Request -> Maybe ByteString-requestForwardedFor request = readForwardedFor- =<< lookup "X-Forwarded-For" (requestHeaders request)+requestForwardedFor request =+ readForwardedFor =<< lookup "X-Forwarded-For" (requestHeaders request) -- | --@@ -79,23 +80,24 @@ | otherwise = Just $ fst $ C8.break (== ',') bs requestUrl :: Request -> ByteString-requestUrl request = requestProtocol- <> "://"- <> requestHost request- <> rawPathInfo request- <> rawQueryString request+requestUrl request =+ requestProtocol+ <> "://"+ <> requestHost request+ <> rawPathInfo request+ <> rawQueryString request where clientProtocol = if isSecure request then "https" else "http" requestHost = fromMaybe "<unknown>" . requestHeaderHost- requestProtocol = fromMaybe clientProtocol- $ lookup "X-Forwarded-Proto"- $ requestHeaders request+ requestProtocol =+ fromMaybe clientProtocol $ lookup "X-Forwarded-Proto" $ requestHeaders+ request sockAddrToIp :: SockAddr -> ByteString sockAddrToIp (SockAddrInet _ h) = C8.pack $ show $ fromHostAddress h sockAddrToIp (SockAddrInet6 _ _ h _) = C8.pack $ show $ fromHostAddress6 h sockAddrToIp (SockAddrUnix _) = "<socket>" --- N.B. Can't match deprecated SockAddrCan without warning. TODO: make patterns--- exhaustive without a wildcard once it's actually removed.+-- Matches deprecated and eventually removed SockAddrCan on older GHCs.+-- overlapping-patterns warning is disabled for this. sockAddrToIp _ = "<invalid>"
test/Network/BugsnagSpec.hs view
@@ -78,7 +78,7 @@ e <- brokenFunction' `catch` pure let ex = bugsnagExceptionFromSomeException e- beErrorClass ex `shouldBe` "SomeException"+ beErrorClass ex `shouldBe` "StringException" beMessage ex `shouldBe` Just "empty list" beStacktrace ex `shouldSatisfy` ((== 3) . length) @@ -95,7 +95,7 @@ e <- brokenFunction'' `catch` pure let ex = bugsnagExceptionFromSomeException e- beErrorClass ex `shouldBe` "SomeException"+ beErrorClass ex `shouldBe` "StringException" beMessage ex `shouldBe` Just "empty list\n and message with newlines\n\n" beStacktrace ex `shouldSatisfy` ((== 3) . length)