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 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