module Freckle.App.Bugsnag.SqlError
  ( sqlErrorBeforeNotify

    -- * Re-exports
  , SqlError

    -- * Exported for testing
  , sqlErrorGroupingHash
  ) where

import Freckle.App.Prelude

import Data.Bugsnag (Exception (..))
import Database.PostgreSQL.Simple (SqlError (..))
import Database.PostgreSQL.Simple.Errors
  ( ConstraintViolation (..)
  , constraintViolation
  )
import Freckle.App.Exception.Types (AnnotatedException)
import Freckle.App.Exception.Types qualified as Annotated
import Network.Bugsnag
  ( BeforeNotify
  , setGroupingHash
  , updateEventFromOriginalException
  , updateExceptions
  )

sqlErrorBeforeNotify :: BeforeNotify
sqlErrorBeforeNotify :: BeforeNotify
sqlErrorBeforeNotify =
  forall e. Exception e => (e -> BeforeNotify) -> BeforeNotify
updateEventFromOriginalException @(AnnotatedException SqlError)
    (SqlError -> BeforeNotify
asSqlError (SqlError -> BeforeNotify)
-> (AnnotatedException SqlError -> SqlError)
-> AnnotatedException SqlError
-> BeforeNotify
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedException SqlError -> SqlError
forall exception. AnnotatedException exception -> exception
Annotated.exception)

asSqlError :: SqlError -> BeforeNotify
asSqlError :: SqlError -> BeforeNotify
asSqlError err :: SqlError
err@SqlError {ByteString
ExecStatus
sqlState :: ByteString
sqlExecStatus :: ExecStatus
sqlErrorMsg :: ByteString
sqlErrorDetail :: ByteString
sqlErrorHint :: ByteString
sqlErrorHint :: SqlError -> ByteString
sqlErrorDetail :: SqlError -> ByteString
sqlErrorMsg :: SqlError -> ByteString
sqlExecStatus :: SqlError -> ExecStatus
sqlState :: SqlError -> ByteString
..} = BeforeNotify
toSqlGrouping BeforeNotify -> BeforeNotify -> BeforeNotify
forall a. Semigroup a => a -> a -> a
<> BeforeNotify
toSqlException
 where
  toSqlGrouping :: BeforeNotify
toSqlGrouping = BeforeNotify
-> (Text -> BeforeNotify) -> Maybe Text -> BeforeNotify
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BeforeNotify
forall a. Monoid a => a
mempty Text -> BeforeNotify
setGroupingHash (SqlError -> Maybe Text
sqlErrorGroupingHash SqlError
err)
  toSqlException :: BeforeNotify
toSqlException = (Exception -> Exception) -> BeforeNotify
updateExceptions ((Exception -> Exception) -> BeforeNotify)
-> (Exception -> Exception) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ \Exception
ex ->
    Exception
ex
      { exception_errorClass = decodeUtf8 $ "SqlError-" <> sqlState
      , exception_message =
          Just $
            decodeUtf8 $
              sqlErrorMsg
                <> ": "
                <> sqlErrorDetail
                <> " ("
                <> sqlErrorHint
                <> ")"
      }

sqlErrorGroupingHash :: SqlError -> Maybe Text
sqlErrorGroupingHash :: SqlError -> Maybe Text
sqlErrorGroupingHash SqlError
err = do
  ConstraintViolation
violation <- SqlError -> Maybe ConstraintViolation
constraintViolation SqlError
err
  ByteString -> Text
decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ConstraintViolation
violation of
    ForeignKeyViolation ByteString
table ByteString
constraint -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
table ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"." ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
constraint
    UniqueViolation ByteString
constraint -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
constraint
    ConstraintViolation
_ -> Maybe ByteString
forall a. Maybe a
Nothing