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 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 (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
sqlState :: SqlError -> ByteString
sqlExecStatus :: SqlError -> ExecStatus
sqlErrorMsg :: SqlError -> ByteString
sqlErrorDetail :: SqlError -> ByteString
sqlErrorHint :: 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 :: Text
exception_errorClass = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
"SqlError-" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sqlState
      , exception_message :: Maybe Text
exception_message =
          Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
            ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$
              ByteString
sqlErrorMsg
                ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
": "
                ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sqlErrorDetail
                ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" ("
                ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sqlErrorHint
                ByteString -> ByteString -> ByteString
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 (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