module Freckle.App.Bugsnag.SqlError
( sqlErrorBeforeNotify
, SqlError
, 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 qualified Freckle.App.Exception.Types 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall exception. AnnotatedException exception -> exception
Annotated.exception)
asSqlError :: SqlError -> BeforeNotify
asSqlError :: SqlError -> BeforeNotify
asSqlError err :: SqlError
err@SqlError {ByteString
ExecStatus
sqlState :: SqlError -> ByteString
sqlExecStatus :: SqlError -> ExecStatus
sqlErrorMsg :: SqlError -> ByteString
sqlErrorDetail :: SqlError -> ByteString
sqlErrorHint :: SqlError -> ByteString
sqlErrorHint :: ByteString
sqlErrorDetail :: ByteString
sqlErrorMsg :: ByteString
sqlExecStatus :: ExecStatus
sqlState :: ByteString
..} = BeforeNotify
toSqlGrouping forall a. Semigroup a => a -> a -> a
<> BeforeNotify
toSqlException
where
toSqlGrouping :: BeforeNotify
toSqlGrouping = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Text -> BeforeNotify
setGroupingHash (SqlError -> Maybe Text
sqlErrorGroupingHash SqlError
err)
toSqlException :: BeforeNotify
toSqlException = (Exception -> Exception) -> BeforeNotify
updateExceptions forall a b. (a -> b) -> a -> b
$ \Exception
ex ->
Exception
ex
{ exception_errorClass :: Text
exception_errorClass = ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString
"SqlError-" forall a. Semigroup a => a -> a -> a
<> ByteString
sqlState
, exception_message :: Maybe Text
exception_message =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$
ByteString
sqlErrorMsg
forall a. Semigroup a => a -> a -> a
<> ByteString
": "
forall a. Semigroup a => a -> a -> a
<> ByteString
sqlErrorDetail
forall a. Semigroup a => a -> a -> a
<> ByteString
" ("
forall a. Semigroup a => a -> a -> a
<> ByteString
sqlErrorHint
forall a. Semigroup a => a -> a -> a
<> ByteString
")"
}
sqlErrorGroupingHash :: SqlError -> Maybe Text
sqlErrorGroupingHash :: SqlError -> Maybe Text
sqlErrorGroupingHash SqlError
err = do
ConstraintViolation
violation <- SqlError -> Maybe ConstraintViolation
constraintViolation SqlError
err
ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ConstraintViolation
violation of
ForeignKeyViolation ByteString
table ByteString
constraint -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString
table forall a. Semigroup a => a -> a -> a
<> ByteString
"." forall a. Semigroup a => a -> a -> a
<> ByteString
constraint
UniqueViolation ByteString
constraint -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
constraint
ConstraintViolation
_ -> forall a. Maybe a
Nothing