{-# LANGUAGE TemplateHaskell #-}

-- | Postgres SQL Error
--
-- Functions and datatypes for interpreting Postgres errors.
module Hasura.Backends.Postgres.SQL.Error
  ( PGErrorType (..),
    _PGDataException,
    _PGIntegrityConstraintViolation,
    _PGSyntaxErrorOrAccessRuleViolation,
    _PGTransactionRollback,
    pgErrorType,
    PGErrorCode (..),
    _PGErrorGeneric,
    _PGErrorSpecific,
    PGDataException (..),
    PGIntegrityConstraintViolation (..),
    PGSyntaxErrorOrAccessRuleViolation (..),
    PGTransactionRollback (..),
  )
where

import Control.Lens.TH (makePrisms)
import Data.Text qualified as T
import Database.PG.Query.Connection qualified as PG
import Hasura.Prelude

-- | The top-level error code type. Errors in Postgres are divided into different /classes/, which
-- are further subdivided into individual error codes. Even if a particular status code is not known
-- to the application, it’s possible to determine its class and handle it appropriately.
data PGErrorType
  = PGDataException (Maybe (PGErrorCode PGDataException))
  | PGIntegrityConstraintViolation (Maybe (PGErrorCode PGIntegrityConstraintViolation))
  | PGSyntaxErrorOrAccessRuleViolation (Maybe (PGErrorCode PGSyntaxErrorOrAccessRuleViolation))
  | PGTransactionRollback (Maybe (PGErrorCode PGTransactionRollback))
  deriving (Int -> PGErrorType -> ShowS
[PGErrorType] -> ShowS
PGErrorType -> String
(Int -> PGErrorType -> ShowS)
-> (PGErrorType -> String)
-> ([PGErrorType] -> ShowS)
-> Show PGErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGErrorType -> ShowS
showsPrec :: Int -> PGErrorType -> ShowS
$cshow :: PGErrorType -> String
show :: PGErrorType -> String
$cshowList :: [PGErrorType] -> ShowS
showList :: [PGErrorType] -> ShowS
Show, PGErrorType -> PGErrorType -> Bool
(PGErrorType -> PGErrorType -> Bool)
-> (PGErrorType -> PGErrorType -> Bool) -> Eq PGErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGErrorType -> PGErrorType -> Bool
== :: PGErrorType -> PGErrorType -> Bool
$c/= :: PGErrorType -> PGErrorType -> Bool
/= :: PGErrorType -> PGErrorType -> Bool
Eq)

data PGErrorCode a
  = -- | represents errors that have the non-specific @000@ status code
    PGErrorGeneric
  | -- | represents errors with a known, more specific status code
    PGErrorSpecific a
  deriving (Int -> PGErrorCode a -> ShowS
[PGErrorCode a] -> ShowS
PGErrorCode a -> String
(Int -> PGErrorCode a -> ShowS)
-> (PGErrorCode a -> String)
-> ([PGErrorCode a] -> ShowS)
-> Show (PGErrorCode a)
forall a. Show a => Int -> PGErrorCode a -> ShowS
forall a. Show a => [PGErrorCode a] -> ShowS
forall a. Show a => PGErrorCode a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PGErrorCode a -> ShowS
showsPrec :: Int -> PGErrorCode a -> ShowS
$cshow :: forall a. Show a => PGErrorCode a -> String
show :: PGErrorCode a -> String
$cshowList :: forall a. Show a => [PGErrorCode a] -> ShowS
showList :: [PGErrorCode a] -> ShowS
Show, PGErrorCode a -> PGErrorCode a -> Bool
(PGErrorCode a -> PGErrorCode a -> Bool)
-> (PGErrorCode a -> PGErrorCode a -> Bool) -> Eq (PGErrorCode a)
forall a. Eq a => PGErrorCode a -> PGErrorCode a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PGErrorCode a -> PGErrorCode a -> Bool
== :: PGErrorCode a -> PGErrorCode a -> Bool
$c/= :: forall a. Eq a => PGErrorCode a -> PGErrorCode a -> Bool
/= :: PGErrorCode a -> PGErrorCode a -> Bool
Eq, (forall a b. (a -> b) -> PGErrorCode a -> PGErrorCode b)
-> (forall a b. a -> PGErrorCode b -> PGErrorCode a)
-> Functor PGErrorCode
forall a b. a -> PGErrorCode b -> PGErrorCode a
forall a b. (a -> b) -> PGErrorCode a -> PGErrorCode b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PGErrorCode a -> PGErrorCode b
fmap :: forall a b. (a -> b) -> PGErrorCode a -> PGErrorCode b
$c<$ :: forall a b. a -> PGErrorCode b -> PGErrorCode a
<$ :: forall a b. a -> PGErrorCode b -> PGErrorCode a
Functor)

data PGDataException
  = PGInvalidDatetimeFormat
  | PGInvalidParameterValue
  | PGInvalidEscapeSequence
  | PGInvalidTextRepresentation
  deriving (Int -> PGDataException -> ShowS
[PGDataException] -> ShowS
PGDataException -> String
(Int -> PGDataException -> ShowS)
-> (PGDataException -> String)
-> ([PGDataException] -> ShowS)
-> Show PGDataException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGDataException -> ShowS
showsPrec :: Int -> PGDataException -> ShowS
$cshow :: PGDataException -> String
show :: PGDataException -> String
$cshowList :: [PGDataException] -> ShowS
showList :: [PGDataException] -> ShowS
Show, PGDataException -> PGDataException -> Bool
(PGDataException -> PGDataException -> Bool)
-> (PGDataException -> PGDataException -> Bool)
-> Eq PGDataException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGDataException -> PGDataException -> Bool
== :: PGDataException -> PGDataException -> Bool
$c/= :: PGDataException -> PGDataException -> Bool
/= :: PGDataException -> PGDataException -> Bool
Eq)

data PGIntegrityConstraintViolation
  = PGRestrictViolation
  | PGNotNullViolation
  | PGForeignKeyViolation
  | PGUniqueViolation
  | PGCheckViolation
  | PGExclusionViolation
  deriving (Int -> PGIntegrityConstraintViolation -> ShowS
[PGIntegrityConstraintViolation] -> ShowS
PGIntegrityConstraintViolation -> String
(Int -> PGIntegrityConstraintViolation -> ShowS)
-> (PGIntegrityConstraintViolation -> String)
-> ([PGIntegrityConstraintViolation] -> ShowS)
-> Show PGIntegrityConstraintViolation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGIntegrityConstraintViolation -> ShowS
showsPrec :: Int -> PGIntegrityConstraintViolation -> ShowS
$cshow :: PGIntegrityConstraintViolation -> String
show :: PGIntegrityConstraintViolation -> String
$cshowList :: [PGIntegrityConstraintViolation] -> ShowS
showList :: [PGIntegrityConstraintViolation] -> ShowS
Show, PGIntegrityConstraintViolation
-> PGIntegrityConstraintViolation -> Bool
(PGIntegrityConstraintViolation
 -> PGIntegrityConstraintViolation -> Bool)
-> (PGIntegrityConstraintViolation
    -> PGIntegrityConstraintViolation -> Bool)
-> Eq PGIntegrityConstraintViolation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGIntegrityConstraintViolation
-> PGIntegrityConstraintViolation -> Bool
== :: PGIntegrityConstraintViolation
-> PGIntegrityConstraintViolation -> Bool
$c/= :: PGIntegrityConstraintViolation
-> PGIntegrityConstraintViolation -> Bool
/= :: PGIntegrityConstraintViolation
-> PGIntegrityConstraintViolation -> Bool
Eq)

data PGSyntaxErrorOrAccessRuleViolation
  = PGUndefinedObject
  | PGInvalidColumnReference
  deriving (Int -> PGSyntaxErrorOrAccessRuleViolation -> ShowS
[PGSyntaxErrorOrAccessRuleViolation] -> ShowS
PGSyntaxErrorOrAccessRuleViolation -> String
(Int -> PGSyntaxErrorOrAccessRuleViolation -> ShowS)
-> (PGSyntaxErrorOrAccessRuleViolation -> String)
-> ([PGSyntaxErrorOrAccessRuleViolation] -> ShowS)
-> Show PGSyntaxErrorOrAccessRuleViolation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGSyntaxErrorOrAccessRuleViolation -> ShowS
showsPrec :: Int -> PGSyntaxErrorOrAccessRuleViolation -> ShowS
$cshow :: PGSyntaxErrorOrAccessRuleViolation -> String
show :: PGSyntaxErrorOrAccessRuleViolation -> String
$cshowList :: [PGSyntaxErrorOrAccessRuleViolation] -> ShowS
showList :: [PGSyntaxErrorOrAccessRuleViolation] -> ShowS
Show, PGSyntaxErrorOrAccessRuleViolation
-> PGSyntaxErrorOrAccessRuleViolation -> Bool
(PGSyntaxErrorOrAccessRuleViolation
 -> PGSyntaxErrorOrAccessRuleViolation -> Bool)
-> (PGSyntaxErrorOrAccessRuleViolation
    -> PGSyntaxErrorOrAccessRuleViolation -> Bool)
-> Eq PGSyntaxErrorOrAccessRuleViolation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGSyntaxErrorOrAccessRuleViolation
-> PGSyntaxErrorOrAccessRuleViolation -> Bool
== :: PGSyntaxErrorOrAccessRuleViolation
-> PGSyntaxErrorOrAccessRuleViolation -> Bool
$c/= :: PGSyntaxErrorOrAccessRuleViolation
-> PGSyntaxErrorOrAccessRuleViolation -> Bool
/= :: PGSyntaxErrorOrAccessRuleViolation
-> PGSyntaxErrorOrAccessRuleViolation -> Bool
Eq)

data PGTransactionRollback
  = PGSerializationFailure
  deriving (Int -> PGTransactionRollback -> ShowS
[PGTransactionRollback] -> ShowS
PGTransactionRollback -> String
(Int -> PGTransactionRollback -> ShowS)
-> (PGTransactionRollback -> String)
-> ([PGTransactionRollback] -> ShowS)
-> Show PGTransactionRollback
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGTransactionRollback -> ShowS
showsPrec :: Int -> PGTransactionRollback -> ShowS
$cshow :: PGTransactionRollback -> String
show :: PGTransactionRollback -> String
$cshowList :: [PGTransactionRollback] -> ShowS
showList :: [PGTransactionRollback] -> ShowS
Show, PGTransactionRollback -> PGTransactionRollback -> Bool
(PGTransactionRollback -> PGTransactionRollback -> Bool)
-> (PGTransactionRollback -> PGTransactionRollback -> Bool)
-> Eq PGTransactionRollback
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PGTransactionRollback -> PGTransactionRollback -> Bool
== :: PGTransactionRollback -> PGTransactionRollback -> Bool
$c/= :: PGTransactionRollback -> PGTransactionRollback -> Bool
/= :: PGTransactionRollback -> PGTransactionRollback -> Bool
Eq)

$(makePrisms ''PGErrorType)
$(makePrisms ''PGErrorCode)

pgErrorType :: PG.PGStmtErrDetail -> Maybe PGErrorType
pgErrorType :: PGStmtErrDetail -> Maybe PGErrorType
pgErrorType PGStmtErrDetail
errorDetails = do
  Text -> Maybe PGErrorType
parseTypes (Text -> Maybe PGErrorType) -> Maybe Text -> Maybe PGErrorType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PGStmtErrDetail -> Maybe Text
PG.edStatusCode PGStmtErrDetail
errorDetails
  where
    parseTypes :: Text -> Maybe PGErrorType
parseTypes Text
fullCodeText =
      [Maybe PGErrorType] -> Maybe PGErrorType
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
        [ Text
-> (Maybe (PGErrorCode PGDataException) -> PGErrorType)
-> [Maybe (PGErrorCode PGDataException)]
-> Maybe PGErrorType
forall a b. Text -> (Maybe a -> b) -> [Maybe a] -> Maybe b
withClass
            Text
"22"
            Maybe (PGErrorCode PGDataException) -> PGErrorType
PGDataException
            [ Text -> PGDataException -> Maybe (PGErrorCode PGDataException)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"007" PGDataException
PGInvalidDatetimeFormat,
              Text -> PGDataException -> Maybe (PGErrorCode PGDataException)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"023" PGDataException
PGInvalidParameterValue,
              Text -> PGDataException -> Maybe (PGErrorCode PGDataException)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"025" PGDataException
PGInvalidEscapeSequence,
              Text -> PGDataException -> Maybe (PGErrorCode PGDataException)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"P02" PGDataException
PGInvalidTextRepresentation
            ],
          Text
-> (Maybe (PGErrorCode PGIntegrityConstraintViolation)
    -> PGErrorType)
-> [Maybe (PGErrorCode PGIntegrityConstraintViolation)]
-> Maybe PGErrorType
forall a b. Text -> (Maybe a -> b) -> [Maybe a] -> Maybe b
withClass
            Text
"23"
            Maybe (PGErrorCode PGIntegrityConstraintViolation) -> PGErrorType
PGIntegrityConstraintViolation
            [ Text
-> PGIntegrityConstraintViolation
-> Maybe (PGErrorCode PGIntegrityConstraintViolation)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"001" PGIntegrityConstraintViolation
PGRestrictViolation,
              Text
-> PGIntegrityConstraintViolation
-> Maybe (PGErrorCode PGIntegrityConstraintViolation)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"502" PGIntegrityConstraintViolation
PGNotNullViolation,
              Text
-> PGIntegrityConstraintViolation
-> Maybe (PGErrorCode PGIntegrityConstraintViolation)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"503" PGIntegrityConstraintViolation
PGForeignKeyViolation,
              Text
-> PGIntegrityConstraintViolation
-> Maybe (PGErrorCode PGIntegrityConstraintViolation)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"505" PGIntegrityConstraintViolation
PGUniqueViolation,
              Text
-> PGIntegrityConstraintViolation
-> Maybe (PGErrorCode PGIntegrityConstraintViolation)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"514" PGIntegrityConstraintViolation
PGCheckViolation,
              Text
-> PGIntegrityConstraintViolation
-> Maybe (PGErrorCode PGIntegrityConstraintViolation)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"P01" PGIntegrityConstraintViolation
PGExclusionViolation
            ],
          Text
-> (Maybe (PGErrorCode PGTransactionRollback) -> PGErrorType)
-> [Maybe (PGErrorCode PGTransactionRollback)]
-> Maybe PGErrorType
forall a b. Text -> (Maybe a -> b) -> [Maybe a] -> Maybe b
withClass
            Text
"40"
            Maybe (PGErrorCode PGTransactionRollback) -> PGErrorType
PGTransactionRollback
            [ Text
-> PGTransactionRollback
-> Maybe (PGErrorCode PGTransactionRollback)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"001" PGTransactionRollback
PGSerializationFailure
            ],
          Text
-> (Maybe (PGErrorCode PGSyntaxErrorOrAccessRuleViolation)
    -> PGErrorType)
-> [Maybe (PGErrorCode PGSyntaxErrorOrAccessRuleViolation)]
-> Maybe PGErrorType
forall a b. Text -> (Maybe a -> b) -> [Maybe a] -> Maybe b
withClass
            Text
"42"
            Maybe (PGErrorCode PGSyntaxErrorOrAccessRuleViolation)
-> PGErrorType
PGSyntaxErrorOrAccessRuleViolation
            [ Text
-> PGSyntaxErrorOrAccessRuleViolation
-> Maybe (PGErrorCode PGSyntaxErrorOrAccessRuleViolation)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"704" PGSyntaxErrorOrAccessRuleViolation
PGUndefinedObject,
              Text
-> PGSyntaxErrorOrAccessRuleViolation
-> Maybe (PGErrorCode PGSyntaxErrorOrAccessRuleViolation)
forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
"P10" PGSyntaxErrorOrAccessRuleViolation
PGInvalidColumnReference
            ]
        ]
      where
        (Text
classText, Text
codeText) = Int -> Text -> (Text, Text)
T.splitAt Int
2 Text
fullCodeText

        withClass :: Text -> (Maybe a -> b) -> [Maybe a] -> Maybe b
        withClass :: forall a b. Text -> (Maybe a -> b) -> [Maybe a] -> Maybe b
withClass Text
expectedClassText Maybe a -> b
mkClass [Maybe a]
codes =
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
classText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expectedClassText) Maybe () -> b -> Maybe b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe a -> b
mkClass ([Maybe a] -> Maybe a
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Maybe a]
codes)

        code :: Text -> a -> Maybe (PGErrorCode a)
        code :: forall a. Text -> a -> Maybe (PGErrorCode a)
code Text
expectedCodeText a
codeValue =
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
codeText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expectedCodeText) Maybe () -> PGErrorCode a -> Maybe (PGErrorCode a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a -> PGErrorCode a
forall a. a -> PGErrorCode a
PGErrorSpecific a
codeValue