module Freckle.App.Bugsnag.HttpException
( httpExceptionBeforeNotify
, HttpException
) where
import Freckle.App.Prelude
import Data.Bugsnag (Exception (..))
import Data.ByteString.Char8 qualified as BS8
import Freckle.App.Exception.Types (AnnotatedException)
import Freckle.App.Exception.Types qualified as Annotated
import Network.Bugsnag
( BeforeNotify
, setGroupingHash
, updateEventFromOriginalException
, updateExceptions
)
import Network.HTTP.Client (HttpException (..), host, method)
httpExceptionBeforeNotify :: BeforeNotify
httpExceptionBeforeNotify :: BeforeNotify
httpExceptionBeforeNotify =
forall e. Exception e => (e -> BeforeNotify) -> BeforeNotify
updateEventFromOriginalException @(AnnotatedException HttpException)
(HttpException -> BeforeNotify
asHttpException (HttpException -> BeforeNotify)
-> (AnnotatedException HttpException -> HttpException)
-> AnnotatedException HttpException
-> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedException HttpException -> HttpException
forall exception. AnnotatedException exception -> exception
Annotated.exception)
asHttpException :: HttpException -> BeforeNotify
asHttpException :: HttpException -> BeforeNotify
asHttpException (HttpExceptionRequest Request
req HttpExceptionContent
content) =
Text -> BeforeNotify
setGroupingHash (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
host Request
req) BeforeNotify -> BeforeNotify -> BeforeNotify
forall a. Semigroup a => a -> a -> a
<> BeforeNotify
update
where
update :: BeforeNotify
update = (Exception -> Exception) -> BeforeNotify
updateExceptions ((Exception -> Exception) -> BeforeNotify)
-> (Exception -> Exception) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Exception
ex ->
Exception
ex
{ exception_errorClass = "HttpExceptionRequest"
, exception_message =
Just
. decodeUtf8
$ method req
<> " request to "
<> host req
<> " failed: "
<> BS8.pack (show content)
}
asHttpException (InvalidUrlException String
url String
msg) = (Exception -> Exception) -> BeforeNotify
updateExceptions ((Exception -> Exception) -> BeforeNotify)
-> (Exception -> Exception) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Exception
ex ->
Exception
ex
{ exception_errorClass = "InvalidUrlException"
, exception_message = Just $ pack $ url <> " is invalid: " <> msg
}