refactor: move errors to ApiRequestError

src/PostgREST/ApiRequest/Types.hs

@@ -87,6 +87,12 @@ data ApiRequestError
   | UnacceptableSchema [Text]
   | UnsupportedMethod ByteString
   | ColumnNotFound Text Text
+  | GucHeadersError
+  | GucStatusError
+  | OffLimitsChangesError Int64 Integer
+  | PutMatchingPkError
+  | SingularityError Integer
+  | PGRSTParseError
   deriving Show
 
 data QPError = QPError Text Text

src/PostgREST/Error.hs

@@ -11,7 +11,6 @@ module PostgREST.Error
   , PgError(..)
   , Error(..)
   , errorPayload
-  , singularityError
   ) where
 
 import qualified Data.Aeson                as JSON
@@ -85,7 +84,14 @@ instance PgrstError ApiRequestError where
   status UnsupportedMethod{}     = HTTP.status405
   status LimitNoOrderError       = HTTP.status400
   status ColumnNotFound{}        = HTTP.status400
+  status GucHeadersError         = HTTP.status500
+  status GucStatusError          = HTTP.status500
+  status OffLimitsChangesError{} = HTTP.status400
+  status PutMatchingPkError      = HTTP.status400
+  status SingularityError{}      = HTTP.status406
+  status PGRSTParseError         = HTTP.status500
 
+  headers SingularityError{}     = [MediaType.toContentType $ MTSingularJSON False]
   headers _ = mempty
 
 instance JSON.ToJSON ApiRequestError where
@@ -140,6 +146,24 @@ instance JSON.ToJSON ApiRequestError where
     "details" .= JSON.Null,
     "hint"    .= ("Apply an 'order' using unique column(s)" :: Text)]
 
+  toJSON (OffLimitsChangesError n maxs) = JSON.object [
+      "code"    .= ApiRequestErrorCode10,
+      "message" .= ("The maximum number of rows allowed to change was surpassed" :: Text),
+      "details" .= T.unwords ["Results contain", show n, "rows changed but the maximum number allowed is", show maxs],
+      "hint"    .= JSON.Null]
+
+  toJSON GucHeadersError = JSON.object [
+    "code"    .= ApiRequestErrorCode11,
+    "message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text),
+    "details" .= JSON.Null,
+    "hint"    .= JSON.Null]
+
+  toJSON GucStatusError = JSON.object [
+    "code"    .= ApiRequestErrorCode12,
+    "message" .= ("response.status guc must be a valid status code" :: Text),
+    "details" .= JSON.Null,
+    "hint"    .= JSON.Null]
+
   toJSON (BinaryFieldError ct) = JSON.object [
     "code"    .= ApiRequestErrorCode13,
     "message" .= ((T.decodeUtf8 (MediaType.toMime ct) <> " requested but more than one column was selected") :: Text),
@@ -152,6 +176,18 @@ instance JSON.ToJSON ApiRequestError where
     "details" .= JSON.Null,
     "hint"    .= JSON.Null]
 
+  toJSON PutMatchingPkError = JSON.object [
+    "code"    .= ApiRequestErrorCode15,
+    "message" .= ("Payload values do not match URL in primary key column(s)" :: Text),
+    "details" .= JSON.Null,
+    "hint"    .= JSON.Null]
+
+  toJSON (SingularityError n) = JSON.object [
+    "code"    .= ApiRequestErrorCode16,
+    "message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
+    "details" .= T.unwords ["The result contains", show n, "rows"],
+    "hint"    .= JSON.Null]
+
   toJSON (UnsupportedMethod method) = JSON.object [
     "code"    .= ApiRequestErrorCode17,
     "message" .= ("Unsupported HTTP method: " <> T.decodeUtf8 method),
@@ -175,6 +211,13 @@ instance JSON.ToJSON ApiRequestError where
     "message" .= ("Bad operator on the '" <> target <> "' embedded resource":: Text),
     "details" .= ("Only is null or not is null filters are allowed on embedded resources":: Text),
     "hint"    .= JSON.Null]
+
+  toJSON PGRSTParseError = JSON.object [
+    "code"    .= ApiRequestErrorCode21,
+    "message" .= ("The message and detail field of RAISE 'PGRST' error expects JSON" :: Text),
+    "details" .= JSON.Null,
+    "hint"    .= JSON.Null]
+
   toJSON (InvalidPreferences prefs) = JSON.object [
     "code"    .= ApiRequestErrorCode22,
     "message" .= ("Invalid preferences given with handling=strict" :: Text),
@@ -481,38 +524,25 @@ pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError
 
 data Error
   = ApiRequestError ApiRequestError
-  | GucHeadersError
-  | GucStatusError
   | JwtTokenInvalid Text
   | JwtTokenMissing
   | JwtTokenRequired
   | NoSchemaCacheError
-  | OffLimitsChangesError Int64 Integer
   | PgErr PgError
-  | PutMatchingPkError
-  | SingularityError Integer
-  | PGRSTParseError
 
 instance PgrstError Error where
-  status (ApiRequestError err)   = status err
+  status (ApiRequestError err) = status err
-  status GucHeadersError         = HTTP.status500
+  status JwtTokenInvalid{}     = HTTP.unauthorized401
-  status GucStatusError          = HTTP.status500
+  status JwtTokenMissing       = HTTP.status500
-  status JwtTokenInvalid{}       = HTTP.unauthorized401
+  status JwtTokenRequired      = HTTP.unauthorized401
-  status JwtTokenMissing         = HTTP.status500
+  status NoSchemaCacheError    = HTTP.status503
-  status JwtTokenRequired        = HTTP.unauthorized401
+  status (PgErr err)           = status err
-  status NoSchemaCacheError      = HTTP.status503
-  status OffLimitsChangesError{} = HTTP.status400
-  status (PgErr err)             = status err
-  status PutMatchingPkError      = HTTP.status400
-  status SingularityError{}      = HTTP.status406
-  status PGRSTParseError         = HTTP.status500
 
-  headers (ApiRequestError err)  = headers err
+  headers (ApiRequestError err) = headers err
-  headers (JwtTokenInvalid m)    = [invalidTokenHeader m]
+  headers (JwtTokenInvalid m)   = [invalidTokenHeader m]
-  headers JwtTokenRequired       = [requiredTokenHeader]
+  headers JwtTokenRequired      = [requiredTokenHeader]
-  headers (PgErr err)            = headers err
+  headers (PgErr err)           = headers err
-  headers SingularityError{}     = [MediaType.toContentType $ MTSingularJSON False]
+  headers _                     = mempty
-  headers _                      = mempty
 
 instance JSON.ToJSON Error where
   toJSON NoSchemaCacheError = JSON.object [
@@ -537,41 +567,6 @@ instance JSON.ToJSON Error where
       "details" .= JSON.Null,
       "hint"    .= JSON.Null]
 
-  toJSON (OffLimitsChangesError n maxs) = JSON.object [
-      "code"    .= ApiRequestErrorCode10,
-      "message" .= ("The maximum number of rows allowed to change was surpassed" :: Text),
-      "details" .= T.unwords ["Results contain", show n, "rows changed but the maximum number allowed is", show maxs],
-      "hint"    .= JSON.Null]
-
-  toJSON GucHeadersError = JSON.object [
-    "code"    .= ApiRequestErrorCode11,
-    "message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-  toJSON GucStatusError = JSON.object [
-    "code"    .= ApiRequestErrorCode12,
-    "message" .= ("response.status guc must be a valid status code" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-
-  toJSON PutMatchingPkError = JSON.object [
-    "code"    .= ApiRequestErrorCode15,
-    "message" .= ("Payload values do not match URL in primary key column(s)" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-
-  toJSON (SingularityError n) = JSON.object [
-    "code"    .= ApiRequestErrorCode16,
-    "message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
-    "details" .= T.unwords ["The result contains", show n, "rows"],
-    "hint"    .= JSON.Null]
-
-  toJSON PGRSTParseError = JSON.object [
-    "code"    .= ApiRequestErrorCode21,
-    "message" .= ("The message and detail field of RAISE 'PGRST' error expects JSON" :: Text),
-    "details" .= JSON.Null,
-    "hint"    .= JSON.Null]
-
   toJSON (PgErr err) = JSON.toJSON err
   toJSON (ApiRequestError err) = JSON.toJSON err
 
@@ -582,9 +577,6 @@ invalidTokenHeader m =
 requiredTokenHeader :: Header
 requiredTokenHeader = ("WWW-Authenticate", "Bearer")
 
-singularityError :: (Integral a) => a -> Error
-singularityError = SingularityError . toInteger
-
 -- For parsing byteString to JSON Object, used for allowing full response control
 data PgRaiseErrMessage = PgRaiseErrMessage {
   getCode    :: Text,

src/PostgREST/Query.hs

@@ -26,6 +26,7 @@ import qualified Hasql.DynamicStatements.Snippet   as SQL (Snippet)
 import qualified Hasql.DynamicStatements.Statement as SQL
 import qualified Hasql.Transaction                 as SQL
 
+import qualified PostgREST.ApiRequest.Types   as ApiRequestTypes
 import qualified PostgREST.Error              as Error
 import qualified PostgREST.Query.QueryBuilder as QueryBuilder
 import qualified PostgREST.Query.Statements   as Statements
@@ -139,7 +140,7 @@ failPut RSPlan{} = pure ()
 failPut RSStandard{rsQueryTotal=queryTotal} =
   when (queryTotal /= 1) $ do
     lift SQL.condemn
-    throwError Error.PutMatchingPkError
+    throwError $ Error.ApiRequestError ApiRequestTypes.PutMatchingPkError
 
 deleteQuery :: MutateReadPlan -> ApiRequest -> AppConfig -> DbHandler ResultSet
 deleteQuery mrPlan@MutateReadPlan{mrMedia} apiReq@ApiRequest{..} conf = do
@@ -208,7 +209,7 @@ failNotSingular _ RSPlan{} = pure ()
 failNotSingular mediaType RSStandard{rsQueryTotal=queryTotal} =
   when (elem mediaType [MTSingularJSON True,MTSingularJSON False] && queryTotal /= 1) $ do
     lift SQL.condemn
-    throwError $ Error.singularityError queryTotal
+    throwError $ Error.ApiRequestError . ApiRequestTypes.SingularityError $ toInteger queryTotal
 
 failsChangesOffLimits :: Maybe Integer -> ResultSet -> DbHandler ()
 failsChangesOffLimits _ RSPlan{} = pure ()
@@ -216,7 +217,7 @@ failsChangesOffLimits Nothing _  = pure ()
 failsChangesOffLimits (Just maxChanges) RSStandard{rsQueryTotal=queryTotal} =
   when (queryTotal > fromIntegral maxChanges) $ do
     lift SQL.condemn
-    throwError $ Error.OffLimitsChangesError queryTotal maxChanges
+    throwError $ Error.ApiRequestError $ ApiRequestTypes.OffLimitsChangesError queryTotal maxChanges
 
 -- | Set a transaction to roll back if requested
 optionalRollback :: AppConfig -> ApiRequest -> DbHandler ()

src/PostgREST/Response.hs

@@ -279,11 +279,11 @@ overrideStatusHeaders rsGucStatus rsGucHeaders pgrstStatus pgrstHeaders = do
 
 decodeGucHeaders :: Maybe BS.ByteString -> Either Error.Error [GucHeader]
 decodeGucHeaders =
-  maybe (Right []) $ first (const Error.GucHeadersError) . JSON.eitherDecode . LBS.fromStrict
+  maybe (Right []) $ first (const . Error.ApiRequestError $ ApiRequestTypes.GucHeadersError) . JSON.eitherDecode . LBS.fromStrict
 
 decodeGucStatus :: Maybe Text -> Either Error.Error (Maybe HTTP.Status)
 decodeGucStatus =
-  maybe (Right Nothing) $ first (const Error.GucStatusError) . fmap (Just . toEnum . fst) . decimal
+  maybe (Right Nothing) $ first (const . Error.ApiRequestError $ ApiRequestTypes.GucStatusError) . fmap (Just . toEnum . fst) . decimal
 
 contentTypeHeaders :: MediaType -> ApiRequest -> [HTTP.Header]
 contentTypeHeaders mediaType ApiRequest{..} =