bugsnag-haskell 0.0.3.1 → 0.0.4.0

raw patch · 34 files changed

+416/−253 lines, 34 filesdep +yamldep −exceptionsdep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: yaml

Dependencies removed: exceptions

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• CHANGELOG.md +27/−5
• DocTest.hs +17/−2
• bugsnag-haskell.cabal +21/−12
• examples/cli/Main.hs +6/−2
• examples/simple/Main.hs +11/−6
• examples/warp/Main.hs +9/−5
• examples/yesod/Main.hs +8/−4
• src/Data/Aeson/Ext.hs +6/−7
• src/Network/Bugsnag.hs +3/−1
• src/Network/Bugsnag/App.hs +5/−3
• src/Network/Bugsnag/BeforeNotify.hs +9/−11
• src/Network/Bugsnag/Breadcrumb.hs +7/−9
• src/Network/Bugsnag/BugsnagRequestHeaders.hs +49/−0
• src/Network/Bugsnag/CodeIndex.hs +21/−5
• src/Network/Bugsnag/Device.hs +7/−6
• src/Network/Bugsnag/Event.hs +18/−19
• src/Network/Bugsnag/Exception.hs +16/−21
• src/Network/Bugsnag/Exception/Parse.hs +4/−2
• src/Network/Bugsnag/Notifier.hs +5/−4
• src/Network/Bugsnag/Notify.hs +4/−2
• src/Network/Bugsnag/ReleaseStage.hs +5/−4
• src/Network/Bugsnag/Report.hs +7/−7
• src/Network/Bugsnag/Reporter.hs +8/−6
• src/Network/Bugsnag/Request.hs +12/−5
• src/Network/Bugsnag/Session.hs +7/−2
• src/Network/Bugsnag/Settings.hs +5/−3
• src/Network/Bugsnag/Severity.hs +8/−7
• src/Network/Bugsnag/StackFrame.hs +7/−5
• src/Network/Bugsnag/Thread.hs +7/−8
• src/Network/Bugsnag/User.hs +5/−3
• test/Network/Bugsnag/CodeIndexSpec.hs +6/−3
• test/Network/Bugsnag/ReportSpec.hs +80/−69
• test/Network/BugsnagSpec.hs +5/−5
• test/Spec.hs +1/−0

@@ -1,7 +1,26 @@-## [*Unreleased*](https://github.com/pbrisbin/bugsnag-haskell/compare/v0.0.3.0...master)+## [_Unreleased_](https://github.com/pbrisbin/bugsnag-haskell/compare/v0.0.4.0...master) -None+None. +## [v0.0.4.0](https://github.com/pbrisbin/bugsnag-haskell/compare/v0.0.3.1...v0.0.4.0)++- Fixed serialization of headers in BugsnagRequest++  Previously, headers were a list of:++  ```+  [(CI ByteString, ByteString)]+  ```++  So they serialized as an array, but Bugsnag only accepts objects for headers.++  To solve this, the `newtype BugsnagRequestHeaders` wraps the headers and has a+  correct `ToJSON` instance.++## [v0.0.3.1](https://github.com/pbrisbin/bugsnag-haskell/compare/v0.0.3.0...v0.0.3.1)++- Tag SomeException with the underlying exception class+ ## [v0.0.3.0](https://github.com/pbrisbin/bugsnag-haskell/compare/v0.0.2.2...v0.0.3.0)  - Fix sensitive request header redacting@@ -29,17 +48,20 @@  ## [v0.0.1.3](https://github.com/pbrisbin/bugsnag-haskell/compare/v0.0.1.2...v0.0.1.3) -- Redact sensitive request headers by default [#31](https://github.com/pbrisbin/bugsnag-haskell/issues/31)+- Redact sensitive request headers by default+  [#31](https://github.com/pbrisbin/bugsnag-haskell/issues/31)    **NOTE**: this wasn't actually working at this point. It is actually fixed in   v0.0.3.0. -- Deprecate Settings that should be `BeforeNotify` values [#32](https://github.com/pbrisbin/bugsnag-haskell/issues/32)+- Deprecate Settings that should be `BeforeNotify` values+  [#32](https://github.com/pbrisbin/bugsnag-haskell/issues/32) - `bugsnagShouldNotify` operates after any `BeforeNotify` changes  ## [v0.0.1.2](https://github.com/pbrisbin/bugsnag-haskell/tree/v0.0.1.2) -- Make App Version an opaque `Text`, not a structured `Version` ([@MaxGabriel](https://github.com/pbrisbin/bugsnag-haskell/pull/29))+- Make App Version an opaque `Text`, not a structured `Version`+  ([@MaxGabriel](https://github.com/pbrisbin/bugsnag-haskell/pull/29))  ## [v0.0.1.1](https://github.com/pbrisbin/bugsnag-haskell/tree/v0.0.1.1) 

@@ -1,6 +1,21 @@-module Main (main) where+module Main+    ( main+    )+where +import Prelude++import Data.Aeson+import qualified Data.Yaml as Yaml import Test.DocTest +newtype Package = Package [String]++instance FromJSON Package where+    parseJSON =+        withObject "Package" $ \o -> Package <$> o .: "default-extensions"+ main :: IO ()-main = doctest ["-isrc", "src/"]+main = do+    Package extensions <- Yaml.decodeFileThrow "package.yaml"+    doctest $ ["-isrc", "src/"] <> map ("-X" <>) extensions

@@ -1,13 +1,13 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: a71bc66ddcfe6442810073ecaf19f31bea964f76eced2a28882753d54c829618+-- hash: 29c38ed61343fc8899e7a70afac5583415798394fe6c7c1a6fbbf30575f59cd9  name:           bugsnag-haskell-version:        0.0.3.1+version:        0.0.4.0 synopsis:       Bugsnag error reporter for Haskell description:    Please see README.md category:       Web@@ -35,6 +35,7 @@       Network.Bugsnag.App       Network.Bugsnag.BeforeNotify       Network.Bugsnag.Breadcrumb+      Network.Bugsnag.BugsnagRequestHeaders       Network.Bugsnag.CodeIndex       Network.Bugsnag.Device       Network.Bugsnag.Event@@ -56,7 +57,8 @@       Paths_bugsnag_haskell   hs-source-dirs:       src-  ghc-options: -Wall+  default-extensions: BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TypeApplications TypeFamilies+  ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-all-missed-specialisations   build-depends:       Glob >=0.9.0     , aeson >=1.3.0.0@@ -85,7 +87,8 @@       Paths_bugsnag_haskell   hs-source-dirs:       examples/cli-  ghc-options: -Wall+  default-extensions: BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TypeApplications TypeFamilies+  ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-all-missed-specialisations   build-depends:       base >=4.11.0 && <5     , bugsnag-haskell@@ -99,7 +102,8 @@       Paths_bugsnag_haskell   hs-source-dirs:       examples/simple-  ghc-options: -Wall+  default-extensions: BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TypeApplications TypeFamilies+  ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-all-missed-specialisations   build-depends:       base >=4.11.0 && <5     , bugsnag-haskell@@ -113,7 +117,8 @@       Paths_bugsnag_haskell   hs-source-dirs:       examples/warp-  ghc-options: -Wall+  default-extensions: BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TypeApplications TypeFamilies+  ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-all-missed-specialisations   build-depends:       base >=4.11.0 && <5     , bugsnag-haskell@@ -129,11 +134,11 @@       Paths_bugsnag_haskell   hs-source-dirs:       examples/yesod-  ghc-options: -Wall+  default-extensions: BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TypeApplications TypeFamilies+  ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-all-missed-specialisations   build-depends:       base >=4.11.0 && <5     , bugsnag-haskell-    , exceptions     , unliftio     , wai     , warp@@ -149,10 +154,13 @@       Paths_bugsnag_haskell   hs-source-dirs:       ./.-  ghc-options: -Wall -Wall+  default-extensions: BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TypeApplications TypeFamilies+  ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-all-missed-specialisations   build-depends:-      base >=4.11.0 && <5+      aeson+    , base >=4.11.0 && <5     , doctest+    , yaml   default-language: Haskell2010  test-suite spec@@ -165,7 +173,8 @@       Paths_bugsnag_haskell   hs-source-dirs:       test-  ghc-options: -Wall+  default-extensions: BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TypeApplications TypeFamilies+  ghc-options: -Weverything -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-all-missed-specialisations   build-depends:       aeson     , aeson-qq

@@ -1,5 +1,9 @@-{-# LANGUAGE OverloadedStrings #-}-module Main (main) where+module Main+    ( main+    )+where++import Prelude  import Control.Exception (catch) import Network.Bugsnag

@@ -1,7 +1,12 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}-module Main (main) where +module Main+    ( main+    )+where++import Prelude+ import Control.Exception (toException) import Network.Bugsnag @@ -9,7 +14,7 @@ main = do     settings <- newBugsnagSettings "BUGSNAG_API_KEY" -    notifyBugsnag settings $ toException-        $ bugsnagException "Error" "message"-            [ $(currentStackFrame) "myFunction"-            ]+    notifyBugsnag settings $ toException $ bugsnagException+        "Error"+        "message"+        [$(currentStackFrame) "myFunction"]

@@ -1,6 +1,10 @@-{-# LANGUAGE OverloadedStrings #-}-module Main (main) where+module Main+    ( main+    )+where +import Prelude+ import Control.Concurrent (forkIO) import Control.Exception (SomeException) import Control.Monad (void, when)@@ -15,9 +19,9 @@ warpSettings = do     settings <- newBugsnagSettings "BUGSNAG_API_KEY" -    pure-        $ setPort 3000-        $ setOnException (bugsnagOnException settings) defaultSettings+    pure $ setPort 3000 $ setOnException+        (bugsnagOnException settings)+        defaultSettings  -- N.B. This may some day be provided by a bugsnag-warp package bugsnagOnException :: BugsnagSettings -> Maybe Request -> SomeException -> IO ()

@@ -1,12 +1,16 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-missing-local-signatures #-} {-# OPTIONS_GHC -fno-warn-unused-top-binds #-}++#if __GLASGOW_HASKELL__ >= 808+{-# OPTIONS_GHC -fno-warn-missing-deriving-strategies #-}+#endif+ module Main (main) where++import Prelude  import Control.Exception (SomeException, fromException, toException) import Control.Monad (unless)

@@ -1,16 +1,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+ -- | -- -- Orphan instances and shared @'Generic'@ JSON options. -- module Data.Aeson.Ext     ( bsAesonOptions-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.ByteString (ByteString)-import Data.CaseInsensitive (CI)-import qualified Data.CaseInsensitive as CI import Data.Char (toLower) import Data.List (stripPrefix) import Data.Maybe (fromMaybe)@@ -19,9 +21,6 @@ instance ToJSON ByteString where     toJSON = String . decodeUtf8 -instance ToJSON a => ToJSON (CI a) where-    toJSON = toJSON . CI.original- -- | Our custom Aeson @'Options'@ -- -- Omits @'Nothing'@ fields, and drops/lowers accordingly:@@ -49,4 +48,4 @@  lowerFirst :: String -> String lowerFirst [] = []-lowerFirst (x:rest) = toLower x : rest+lowerFirst (x : rest) = toLower x : rest

@@ -12,11 +12,13 @@ -- module Network.Bugsnag     ( module X-    ) where+    )+where  import Network.Bugsnag.App as X import Network.Bugsnag.BeforeNotify as X import Network.Bugsnag.Breadcrumb as X+import Network.Bugsnag.BugsnagRequestHeaders as X import Network.Bugsnag.Device as X import Network.Bugsnag.Event as X import Network.Bugsnag.Exception as X

@@ -1,9 +1,11 @@-{-# LANGUAGE DeriveGeneric #-} module Network.Bugsnag.App     ( BugsnagApp(..)     , bugsnagApp-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Ext import Data.Text (Text)@@ -22,7 +24,7 @@     , baDurationInForeground :: Maybe Natural     , baInForeground :: Maybe Bool     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagApp where     toJSON = genericToJSON $ bsAesonOptions "ba"

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- module Network.Bugsnag.BeforeNotify     ( BeforeNotify @@ -32,11 +30,15 @@     , setWarningSeverity     , setErrorSeverity     , setInfoSeverity-    ) where+    )+where +import Prelude+ import Control.Exception (Exception, fromException) import Data.Maybe (fromMaybe) import Data.Text (Text)+import Network.Bugsnag.BugsnagRequestHeaders import Network.Bugsnag.CodeIndex import Network.Bugsnag.Device import Network.Bugsnag.Event@@ -45,7 +47,7 @@ import Network.Bugsnag.Session import Network.Bugsnag.Severity import Network.Bugsnag.StackFrame-import Network.HTTP.Types.Header (Header, HeaderName)+import Network.HTTP.Types.Header (HeaderName) import Network.Wai (Request)  type BeforeNotify = BugsnagEvent -> BugsnagEvent@@ -180,18 +182,14 @@ -- | -- -- >>> let headers = [("Authorization", "secret"), ("X-Foo", "Bar")]--- >>> let req = bugsnagRequest { brHeaders = Just headers }+-- >>> let req = bugsnagRequest { brHeaders = Just $ bugsnagRequestHeaders headers } -- >>> brHeaders $ redactHeaders ["Authorization"] req--- Just [("Authorization","<redacted>"),("X-Foo","Bar")]+-- Just (BugsnagRequestHeaders {unBugsnagRequestHeaders = [("Authorization","<redacted>"),("X-Foo","Bar")]}) -- redactHeaders :: [HeaderName] -> BugsnagRequest -> BugsnagRequest redactHeaders headers request = request-    { brHeaders = map redactHeader <$> brHeaders request+    { brHeaders = redactBugsnagRequestHeaders headers <$> brHeaders request     }-  where-    redactHeader :: Header -> Header-    redactHeader (k, _) | k `elem` headers = (k, "<redacted>")-    redactHeader h = h  -- | Set the Event's Request --

@@ -1,11 +1,12 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-} module Network.Bugsnag.Breadcrumb     ( BugsnagBreadcrumbType(..)     , BugsnagBreadcrumb(..)     , bugsnagBreadcrumb-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Ext import Data.Text (Text)@@ -21,7 +22,7 @@     | StateBreadcrumb     | ErrorBreadcrumb     | ManualBreadcrumb-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagBreadcrumbType where     toJSON = genericToJSON $ bsAesonOptions "Breadcrumb"@@ -33,17 +34,14 @@     , bbType :: BugsnagBreadcrumbType     , bbMetaData :: Maybe Value     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagBreadcrumb where     toJSON = genericToJSON $ bsAesonOptions "bb"     toEncoding = genericToEncoding $ bsAesonOptions "bb"  bugsnagBreadcrumb-    :: UTCTime-    -> Text-    -> BugsnagBreadcrumbType-    -> BugsnagBreadcrumb+    :: UTCTime -> Text -> BugsnagBreadcrumbType -> BugsnagBreadcrumb bugsnagBreadcrumb timestamp name typ = BugsnagBreadcrumb     { bbTimestamp = timestamp     , bbName = name

@@ -0,0 +1,49 @@+module Network.Bugsnag.BugsnagRequestHeaders+    ( BugsnagRequestHeaders+    , bugsnagRequestHeaders+    , redactBugsnagRequestHeaders+    )+where++import Prelude++import Data.Aeson+import Data.ByteString (ByteString)+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI+import qualified Data.Text.Encoding as TE+import Network.HTTP.Types++-- | Wrapper around Wai's 'RequestHeaders', for custom 'ToJSON' instance+newtype BugsnagRequestHeaders = BugsnagRequestHeaders+    { unBugsnagRequestHeaders :: RequestHeaders+    }+    deriving stock (Show, Eq, Ord)++instance ToJSON BugsnagRequestHeaders where+    toJSON = object . map headerToKeyValue . unBugsnagRequestHeaders+    toEncoding = pairs . foldMap headerToKeyValue . unBugsnagRequestHeaders++headerToKeyValue :: KeyValue kv => (CI ByteString, ByteString) -> kv+headerToKeyValue (name, value) =+    TE.decodeUtf8 (CI.original name) .= String (TE.decodeUtf8 value)++-- | Create 'BugsnagRequestHeaders'+bugsnagRequestHeaders :: RequestHeaders -> BugsnagRequestHeaders+bugsnagRequestHeaders = BugsnagRequestHeaders++-- | For headers with the given names, replace their value with "<redacted>".+--+-- This is intended to remove sensitive data from headers.+redactBugsnagRequestHeaders+    :: [HeaderName] -> BugsnagRequestHeaders -> BugsnagRequestHeaders+redactBugsnagRequestHeaders redactList = mapBugsnagRequestHeaders redactHeader+  where+    redactHeader :: Header -> Header+    redactHeader (k, _) | k `elem` redactList = (k, "<redacted>")+    redactHeader h = h++mapBugsnagRequestHeaders+    :: (Header -> Header) -> BugsnagRequestHeaders -> BugsnagRequestHeaders+mapBugsnagRequestHeaders fn (BugsnagRequestHeaders headers) =+    BugsnagRequestHeaders $ map fn headers

@@ -1,14 +1,17 @@ {-# LANGUAGE DeriveLift #-} {-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-}+ module Network.Bugsnag.CodeIndex     ( CodeIndex     , buildCodeIndex     , findSourceRange-    ) where+    )+where +import Prelude+ import Data.List (genericLength) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map@@ -22,9 +25,22 @@ import System.FilePath.Glob (glob)  newtype CodeIndex = CodeIndex-    { unCodeIndex :: Map FilePath FileIndex }-    deriving (Lift, Show)+    { unCodeIndex :: Map FilePath FileIndex+    }+    deriving stock (Lift, Show) +-- | Index code for attaching lines of source to 'StackFrame's+--+-- See the 'bsCodeIndex' field of 'BugsnagSettings' for details.+--+-- **WARNING**: This feature comes with a number of caveats.+--+-- 1. It's not frequently used and may not work.+-- 2. It (probably) means you will be holding all indexed source code in memory+--    during the life of your process.+-- 3. In larger projects, it will embed substantial amounts of source code in a+--    single file, which can significantly degrade compilation time.+-- buildCodeIndex :: String -> Q Exp buildCodeIndex p = do     index <- qRunIO $ buildCodeIndex' p@@ -42,7 +58,7 @@     { fiSourceLines :: Map Natural Text     , fiLastLine :: Natural     }-    deriving (Lift, Show)+    deriving stock (Lift, Show)  buildFileIndex :: FilePath -> IO FileIndex buildFileIndex path = do

@@ -1,13 +1,13 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} module Network.Bugsnag.Device     ( Bytes(..)     , BugsnagDevice(..)     , bugsnagDevice     , bugsnagDeviceFromWaiRequest-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Ext import Data.ByteString (ByteString)@@ -20,7 +20,8 @@ import Text.Read (readMaybe) import Web.UAParser -newtype Bytes = Bytes Natural deriving ToJSON+newtype Bytes = Bytes Natural+    deriving newtype ToJSON  data BugsnagDevice = BugsnagDevice     { bdHostname :: Maybe Text@@ -38,7 +39,7 @@     , bdJailBroken :: Maybe Bool     , bdOrientation :: Maybe Text     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagDevice where     toJSON = genericToJSON $ bsAesonOptions "bd"

@@ -1,10 +1,11 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} module Network.Bugsnag.Event     ( BugsnagEvent(..)     , bugsnagEvent-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Types import Data.Text (Text)@@ -38,22 +39,20 @@  instance ToJSON BugsnagEvent where     -- | Explicit instance needed to send @'beException'@ as @exceptions@-    toJSON BugsnagEvent {..} = object-        $ "exceptions" .= [beException]-        : concat-            [ "breadcrumbs" .=? beBreadcrumbs-            , "request" .=? beRequest-            , "threads" .=? beThreads-            , "context" .=? beContext-            , "groupingHash" .=? beGroupingHash-            , "unhandled" .=? beUnhandled-            , "severity" .=? beSeverity-            , "severityReason" .=? beSeverityReason-            , "user" .=? beUser-            , "app" .=? beApp-            , "device" .=? beDevice-            , "metaData" .=? beMetaData-            ]+    toJSON BugsnagEvent {..} = object $ "exceptions" .= [beException] : concat+        [ "breadcrumbs" .=? beBreadcrumbs+        , "request" .=? beRequest+        , "threads" .=? beThreads+        , "context" .=? beContext+        , "groupingHash" .=? beGroupingHash+        , "unhandled" .=? beUnhandled+        , "severity" .=? beSeverity+        , "severityReason" .=? beSeverityReason+        , "user" .=? beUser+        , "app" .=? beApp+        , "device" .=? beDevice+        , "metaData" .=? beMetaData+        ]       where         -- For implementing "omit Nothing fields"         (.=?) :: ToJSON v => Text -> Maybe v -> [Pair]

@@ -1,15 +1,14 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}+ module Network.Bugsnag.Exception     ( BugsnagException(..)     , bugsnagException     , bugsnagExceptionFromSomeException-    ) where+    )+where +import Prelude+ import Control.Exception import Data.Aeson import Data.Proxy (Proxy(..))@@ -35,10 +34,10 @@     , beStacktrace :: [BugsnagStackFrame]     , beOriginalException :: Maybe SomeException     }-    deriving (Generic, Show)+    deriving stock (Generic, Show)  instance ToJSON BugsnagException where-    toJSON BugsnagException{..} = object+    toJSON BugsnagException {..} = object         [ "errorClass" .= beErrorClass         , "message" .= beMessage         , "stacktrace" .= beStacktrace@@ -64,7 +63,7 @@ -- -- @'BugsnagException'@s are left as-is, and @'ErrorCall'@ exceptions are parsed -- for @'HasCallStack'@ information to use as @stacktrace@. Otherwise, we--- attempt to determine @errorClass@ and we use the @'show'@n exception as+-- attempt to determine @errorClass@ and we use @'displayException'@ as -- @message@. -- -- >>> import Control.Arrow@@ -74,7 +73,7 @@ -- bugsnagExceptionFromSomeException :: SomeException -> BugsnagException bugsnagExceptionFromSomeException ex = foldr go seed exCasters- where+  where     go :: Caster -> BugsnagException -> BugsnagException     go (Caster caster) res = maybe res caster $ fromException ex @@ -83,21 +82,17 @@         }  exCasters :: [Caster]-exCasters =-    [ Caster id-    , Caster $ bugsnagExceptionWithParser parseErrorCall-    ]+exCasters = [Caster id, Caster $ bugsnagExceptionWithParser parseErrorCall]  bugsnagExceptionWithParser     :: Exception e     => (e -> Either String MessageWithStackFrames)     -> e     -> BugsnagException-bugsnagExceptionWithParser p ex =-    case p ex of-        Left _ -> bugsnagExceptionFromException ex-        Right (MessageWithStackFrames message stacktrace) ->-            bugsnagException (exErrorClass ex) message stacktrace+bugsnagExceptionWithParser p ex = case p ex of+    Left _ -> bugsnagExceptionFromException ex+    Right (MessageWithStackFrames message stacktrace) ->+        bugsnagException (exErrorClass ex) message stacktrace  -- | Construct a @'BugsnagException'@ from an @'Exception'@ --@@ -107,7 +102,7 @@ -- bugsnagExceptionFromException :: Exception e => e -> BugsnagException bugsnagExceptionFromException ex =-    (bugsnagException (exErrorClass ex) (T.pack $ show ex) [])+    (bugsnagException (exErrorClass ex) (T.pack $ displayException ex) [])         { beOriginalException = Just $ toException ex         } @@ -119,5 +114,5 @@ -- >>> exErrorClass (undefined :: SomeException) -- "SomeException" ---exErrorClass :: forall e. Exception e => e -> Text+exErrorClass :: forall e . Exception e => e -> Text exErrorClass _ = T.pack $ show $ typeRep $ Proxy @e

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} -- | -- -- Parse error messages for @'HasCallStack'@ information.@@ -7,7 +6,10 @@     ( MessageWithStackFrames(..)     , parseErrorCall     , parseStringException-    ) where+    )+where++import Prelude  import Control.Exception (ErrorCall, Exception, SomeException) import Control.Monad (void)

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-} -- | -- -- Static values about this notifier itself.@@ -7,8 +5,11 @@ module Network.Bugsnag.Notifier     ( BugsnagNotifier     , bugsnagNotifier-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Ext import Data.Text (Text)@@ -22,7 +23,7 @@     , bnVersion :: Version     , bnUrl :: Text     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagNotifier where     toJSON = genericToJSON $ bsAesonOptions "bn"

@@ -1,8 +1,11 @@ module Network.Bugsnag.Notify     ( notifyBugsnag     , notifyBugsnagWith-    ) where+    )+where +import Prelude+ import Control.Exception (SomeException) import Control.Monad (when) import Data.Maybe (isJust)@@ -67,4 +70,3 @@         , baReleaseStage = Just $ bsReleaseStage settings         }     }-

@@ -1,9 +1,10 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-} module Network.Bugsnag.ReleaseStage     ( BugsnagReleaseStage(..)-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Text (Text) @@ -12,7 +13,7 @@     | StagingReleaseStage     | ProductionReleaseStage     | CustomReleaseStage Text-    deriving (Eq, Show)+    deriving stock (Eq, Show)  instance FromJSON BugsnagReleaseStage where     parseJSON = withText "ReleaseStage" $ \case

@@ -1,9 +1,11 @@-{-# LANGUAGE DeriveGeneric #-} module Network.Bugsnag.Report     ( BugsnagReport(..)     , bugsnagReport-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Ext import GHC.Generics@@ -14,14 +16,12 @@     { brNotifier :: BugsnagNotifier     , brEvents :: [BugsnagEvent]     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagReport where     toJSON = genericToJSON $ bsAesonOptions "br"     toEncoding = genericToEncoding $ bsAesonOptions "br"  bugsnagReport :: [BugsnagEvent] -> BugsnagReport-bugsnagReport events = BugsnagReport-    { brNotifier = bugsnagNotifier-    , brEvents = events-    }+bugsnagReport events =+    BugsnagReport { brNotifier = bugsnagNotifier, brEvents = events }

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} -- | -- -- Report an error to Bugsnag@@ -10,8 +9,11 @@ -- module Network.Bugsnag.Reporter     ( reportError-    ) where+    )+where +import Prelude+ import Control.Monad (void) import Data.Text.Encoding (encodeUtf8) import Network.Bugsnag.Report@@ -25,7 +27,7 @@     void $ httpNoBody request manager   where     key = encodeUtf8 $ unBugsnagApiKey apiKey-    setupRequest-        = setRequestBodyJSON report-        . setRequestHeader "Bugsnag-Api-Key" [key]-        . setRequestHeader "Bugsnag-Payload-Version" ["4"]+    setupRequest =+        setRequestBodyJSON report+            . setRequestHeader "Bugsnag-Api-Key" [key]+            . setRequestHeader "Bugsnag-Payload-Version" ["4"]

@@ -1,6 +1,5 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}+ module Network.Bugsnag.Request     ( BugsnagRequest(..)     , bugsnagRequest@@ -8,6 +7,8 @@     ) where +import Prelude+ import Control.Applicative ((<|>)) import Data.Aeson import Data.Aeson.Ext@@ -16,6 +17,7 @@ import Data.IP import Data.Maybe (fromMaybe) import GHC.Generics+import Network.Bugsnag.BugsnagRequestHeaders import Network.HTTP.Types import Network.Socket import Network.Wai@@ -23,12 +25,12 @@ -- | The web request being handled when the error was encountered data BugsnagRequest = BugsnagRequest     { brClientIp :: Maybe ByteString-    , brHeaders :: Maybe RequestHeaders+    , brHeaders :: Maybe BugsnagRequestHeaders     , brHttpMethod :: Maybe Method     , brUrl :: Maybe ByteString     , brReferer :: Maybe ByteString     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagRequest where     toJSON = genericToJSON $ bsAesonOptions "br"@@ -49,7 +51,7 @@ bugsnagRequestFromWaiRequest request = bugsnagRequest     { brClientIp = requestRealIp request         <|> Just (sockAddrToIp $ remoteHost request)-    , brHeaders = Just $ requestHeaders request+    , brHeaders = Just $ bugsnagRequestHeaders $ requestHeaders request     , brHttpMethod = Just $ requestMethod request     , brUrl = Just $ requestUrl request     , brReferer = requestHeaderReferer request@@ -87,8 +89,13 @@         <> rawPathInfo request         <> rawQueryString request   where+    clientProtocol :: ByteString     clientProtocol = if isSecure request then "https" else "http"++    requestHost :: Request -> ByteString     requestHost = fromMaybe "<unknown>" . requestHeaderHost++    requestProtocol :: ByteString     requestProtocol =         fromMaybe clientProtocol $ lookup "X-Forwarded-Proto" $ requestHeaders             request

@@ -1,4 +1,6 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+ -- | -- -- <https://docs.bugsnag.com/api/error-reporting/#per-session-settings>@@ -6,8 +8,11 @@ module Network.Bugsnag.Session     ( BugsnagSession(..)     , bugsnagSession-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Ext import Data.Text (Text)@@ -19,7 +24,7 @@     , bsContext :: Maybe Text     , bsMetaData :: Maybe Value     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagSession where     toJSON = genericToJSON $ bsAesonOptions "bs"

@@ -1,4 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | -- -- <https://docs.bugsnag.com/api/error-reporting/#application-settings>@@ -9,8 +8,11 @@     , newBugsnagSettings     , bugsnagSettings     , bugsnagShouldNotify-    ) where+    )+where +import Prelude+ import Data.Aeson (FromJSON) import Data.String import Data.Text (Text)@@ -26,7 +28,7 @@ newtype BugsnagApiKey = BugsnagApiKey     { unBugsnagApiKey :: Text     }-    deriving (FromJSON, IsString)+    deriving newtype (FromJSON, IsString)  instance Show BugsnagApiKey where     show = T.unpack . unBugsnagApiKey

@@ -1,13 +1,14 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-} module Network.Bugsnag.Severity     ( BugsnagSeverity(..)     , BugsnagSeverityReason(..)     , BugsnagSeverityReasonAttributes(..)     , bugsnagSeverityReasonAttributes     , BugsnagSeverityReasonType(..)-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Ext import Data.Text (Text)@@ -17,7 +18,7 @@     = ErrorSeverity     | WarningSeverity     | InfoSeverity-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagSeverity where     toJSON = genericToJSON $ bsAesonOptions "Severity"@@ -39,7 +40,7 @@     | HandledErrorReasonType     | HandledPanicReasonType     | UserContextSetSeverityReasonType-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagSeverityReasonType where     toJSON = genericToJSON $ bsAesonOptions "ReasonType"@@ -52,7 +53,7 @@     , bsraViolationType :: Maybe Text     , bsraErrorClass :: Maybe Text     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagSeverityReasonAttributes where     toJSON = genericToJSON $ bsAesonOptions "bsra"@@ -62,7 +63,7 @@     { bsrType :: BugsnagSeverityReasonType     , bsrAttributes :: BugsnagSeverityReasonAttributes     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagSeverityReason where     toJSON = genericToJSON $ bsAesonOptions "bsr"

@@ -1,15 +1,17 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-}+ module Network.Bugsnag.StackFrame     ( BugsnagCode(..)     , attachBugsnagCode     , BugsnagStackFrame(..)     , bugsnagStackFrame     , currentStackFrame-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Ext import Data.Text (Text)@@ -24,7 +26,7 @@ -- Pairs of @(line-number, line-of-code)@, up to 3 on either side. -- newtype BugsnagCode = BugsnagCode [(Natural, Text)]-    deriving (Show, ToJSON)+    deriving newtype (Show, ToJSON)  -- | Attempt to attach a @'BugsnagCode'@ to a @'BugsnagStackFrame'@ --@@ -50,7 +52,7 @@     , bsfInProject :: Maybe Bool     , bsfCode :: Maybe BugsnagCode     }-    deriving (Generic, Show)+    deriving stock (Generic, Show)  instance ToJSON BugsnagStackFrame where     toJSON = genericToJSON $ bsAesonOptions "bsf"

@@ -1,9 +1,11 @@-{-# LANGUAGE DeriveGeneric #-} module Network.Bugsnag.Thread     ( BugsnagThread(..)     , bugsnagThread-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Ext import Data.Text (Text)@@ -15,15 +17,12 @@     , btName :: Maybe Text     , btStacktrace :: Maybe [BugsnagStackFrame]     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagThread where     toJSON = genericToJSON $ bsAesonOptions "bt"     toEncoding = genericToEncoding $ bsAesonOptions "bt"  bugsnagThread :: BugsnagThread-bugsnagThread = BugsnagThread-    { btId = Nothing-    , btName = Nothing-    , btStacktrace = Nothing-    }+bugsnagThread =+    BugsnagThread { btId = Nothing, btName = Nothing, btStacktrace = Nothing }

@@ -1,9 +1,11 @@-{-# LANGUAGE DeriveGeneric #-} module Network.Bugsnag.User     ( BugsnagUser(..)     , bugsnagUser-    ) where+    )+where +import Prelude+ import Data.Aeson import Data.Aeson.Ext import Data.Text (Text)@@ -14,7 +16,7 @@     , buEmailAddress :: Maybe Text     , buUsername :: Maybe Text     }-    deriving Generic+    deriving stock Generic  instance ToJSON BugsnagUser where     toJSON = genericToJSON $ bsAesonOptions "bu"

@@ -1,12 +1,15 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-missing-local-signatures #-}+ module Network.Bugsnag.CodeIndexSpec     ( spec-    ) where+    )+where -import Test.Hspec+import Prelude  import Network.Bugsnag.CodeIndex+import Test.Hspec  spec :: Spec spec = do

@@ -1,29 +1,30 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+ module Network.Bugsnag.ReportSpec     ( spec-    ) where+    )+where -import Test.Hspec+import Prelude  import Data.Aeson import Data.Aeson.QQ (aesonQQ) import Data.Text (Text) import Data.Time (getCurrentTime) import Network.Bugsnag+import Test.Hspec  spec :: Spec spec = do     describe "JSON payload" $ do         it "is right for a minimally-specified report" $ do-            let report =-                    bugsnagReport-                        [ bugsnagEvent $ bugsnagException-                            "errorClass"-                            "message"-                            [ bugsnagStackFrame "src/Foo/Bar.hs" 10 "myFunction"-                            ]-                        ]+            let+                report = bugsnagReport+                    [ bugsnagEvent $ bugsnagException+                          "errorClass"+                          "message"+                          [bugsnagStackFrame "src/Foo/Bar.hs" 10 "myFunction"]+                    ]              -- N.B. we don't worry about the notifier object since it would need             -- updating on version bumps and is a simple, static value.@@ -46,16 +47,16 @@          it "is right for a mostly-specified report" $ do             now <- getCurrentTime-            let report =-                    BugsnagReport-                        { brNotifier = bugsnagNotifier-                        , brEvents =-                            [ BugsnagEvent-                                { beException = BugsnagException-                                    { beErrorClass = "errorClass"-                                    , beMessage = Just "message"-                                    , beStacktrace =-                                        [ BugsnagStackFrame+            let+                report = BugsnagReport+                    { brNotifier = bugsnagNotifier+                    , brEvents =+                        [ BugsnagEvent+                              { beException = BugsnagException+                                  { beErrorClass = "errorClass"+                                  , beMessage = Just "message"+                                  , beStacktrace =+                                      [ BugsnagStackFrame                                             { bsfFile = "src/Foo/Bar.hs"                                             , bsfLineNumber = 10                                             , bsfColumnNumber = Just 12@@ -63,53 +64,63 @@                                             , bsfInProject = Just True                                             , bsfCode = Nothing                                             }-                                        ]-                                    , beOriginalException = Nothing-                                    }-                                , beBreadcrumbs = Just-                                    [ bugsnagBreadcrumb now "here" NavigationBreadcrumb-                                    , bugsnagBreadcrumb now "there" NavigationBreadcrumb-                                    ]-                                , beRequest = Just bugsnagRequest-                                    { brClientIp = Just "127.0.0.1"-                                    , brHeaders = Just []-                                    , brHttpMethod = Just "POST"-                                    , brUrl = Just "https://example.com"-                                    }-                                , beThreads = Just-                                    [ bugsnagThread-                                        { btId = Just "1"-                                        , btName = Just "thread-1"-                                        }-                                    ]-                                , beContext = Just "app"-                                , beGroupingHash = Nothing-                                , beUnhandled = Just False-                                , beSeverity = Just WarningSeverity-                                , beSeverityReason = Just BugsnagSeverityReason-                                    { bsrType = UnhandledExceptionReasonType-                                    , bsrAttributes = bugsnagSeverityReasonAttributes-                                        { bsraErrorType = Just "reason"-                                        , bsraLevel = Just "1"-                                        , bsraSignalType = Just "SIGKILL"-                                        }-                                    }-                                , beUser = Just bugsnagUser-                                    { buId = Just "1"-                                    , buUsername = Just "pbrisbin"-                                    }-                                , beApp = Just bugsnagApp-                                    { baId = Just "1"-                                    , baVersion = Just "1.0.0"-                                    }-                                , beDevice = Nothing-                                , beMetaData = Just $ object-                                    [ "foo" .= ("bar" :: Text)-                                    , "baz" .= ("bat" :: Text)-                                    ]-                                }-                            ]-                        }+                                      ]+                                  , beOriginalException = Nothing+                                  }+                              , beBreadcrumbs = Just+                                  [ bugsnagBreadcrumb+                                      now+                                      "here"+                                      NavigationBreadcrumb+                                  , bugsnagBreadcrumb+                                      now+                                      "there"+                                      NavigationBreadcrumb+                                  ]+                              , beRequest = Just bugsnagRequest+                                  { brClientIp = Just "127.0.0.1"+                                  , brHeaders = Just (bugsnagRequestHeaders [])+                                  , brHttpMethod = Just "POST"+                                  , brUrl = Just "https://example.com"+                                  }+                              , beThreads =+                                  Just+                                      [ bugsnagThread+                                            { btId = Just "1"+                                            , btName = Just "thread-1"+                                            }+                                      ]+                              , beContext = Just "app"+                              , beGroupingHash = Nothing+                              , beUnhandled = Just False+                              , beSeverity = Just WarningSeverity+                              , beSeverityReason = Just BugsnagSeverityReason+                                  { bsrType = UnhandledExceptionReasonType+                                  , bsrAttributes =+                                      bugsnagSeverityReasonAttributes+                                          { bsraErrorType = Just "reason"+                                          , bsraLevel = Just "1"+                                          , bsraSignalType = Just "SIGKILL"+                                          }+                                  }+                              , beUser = Just bugsnagUser+                                  { buId = Just "1"+                                  , buUsername = Just "pbrisbin"+                                  }+                              , beApp = Just bugsnagApp+                                  { baId = Just "1"+                                  , baVersion = Just "1.0.0"+                                  }+                              , beDevice = Nothing+                              , beMetaData =+                                  Just+                                      $ object+                                            [ "foo" .= ("bar" :: Text)+                                            , "baz" .= ("bat" :: Text)+                                            ]+                              }+                        ]+                    }              toJSON report `shouldBe` [aesonQQ|                 {@@ -152,7 +163,7 @@                             "clientIp": "127.0.0.1",                             "httpMethod": "POST",                             "url": "https://example.com",-                            "headers": []+                            "headers": {}                         },                         "unhandled": false,                         "metaData": {

@@ -1,15 +1,15 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}+ module Network.BugsnagSpec     ( spec-    ) where+    )+where -import Test.Hspec+import Prelude  import Control.Exception import Network.Bugsnag+import Test.Hspec import UnliftIO.Exception (throwString)  brokenFunctionIO :: IO a

@@ -1,1 +1,2 @@+{-# OPTIONS_GHC -Wno-missing-export-lists #-} {-# OPTIONS_GHC -F -pgmF hspec-discover #-}