module Freckle.App.Bugsnag.HttpException
  ( httpExceptionBeforeNotify

    -- * Re-exports
  , HttpException
  ) where

import Freckle.App.Prelude

import Data.Bugsnag (Exception (..))
import qualified Data.ByteString.Char8 as BS8
import Freckle.App.Exception.Types (AnnotatedException)
import qualified Freckle.App.Exception.Types 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
    }