refactor: DRY and enforce error format

This commit is contained in:
Laurence Isla
2023-10-10 11:42:36 -05:00
committed by GitHub
parent 818387f24e
commit 056c748c5f
+135 -178
View File
@@ -94,147 +94,122 @@ instance PgrstError ApiRequestError where
headers SingularityError{} = [MediaType.toContentType $ MTSingularJSON False] headers SingularityError{} = [MediaType.toContentType $ MTSingularJSON False]
headers _ = mempty headers _ = mempty
toJsonPgrstError :: ErrorCode -> Text -> Maybe JSON.Value -> Maybe JSON.Value -> JSON.Value
toJsonPgrstError code msg details hint = JSON.object [
"code" .= code
, "message" .= msg
, "details" .= details
, "hint" .= hint
]
instance JSON.ToJSON ApiRequestError where instance JSON.ToJSON ApiRequestError where
toJSON (QueryParamError (QPError message details)) = JSON.object [ toJSON (QueryParamError (QPError message details)) = toJsonPgrstError
"code" .= ApiRequestErrorCode00, ApiRequestErrorCode00 message (Just (JSON.String details)) Nothing
"message" .= message,
"details" .= details, toJSON (InvalidRpcMethod method) = toJsonPgrstError
"hint" .= JSON.Null] ApiRequestErrorCode01 ("Cannot use the " <> T.decodeUtf8 method <> " method on RPC") Nothing Nothing
toJSON (InvalidRpcMethod method) = JSON.object [
"code" .= ApiRequestErrorCode01, toJSON (InvalidBody errorMessage) = toJsonPgrstError
"message" .= ("Cannot use the " <> T.decodeUtf8 method <> " method on RPC"), ApiRequestErrorCode02 (T.decodeUtf8 errorMessage) Nothing Nothing
"details" .= JSON.Null,
"hint" .= JSON.Null] toJSON (InvalidRange rangeError) = toJsonPgrstError
toJSON (InvalidBody errorMessage) = JSON.object [ ApiRequestErrorCode03
"code" .= ApiRequestErrorCode02, "Requested range not satisfiable"
"message" .= T.decodeUtf8 errorMessage, (Just $ case rangeError of
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (InvalidRange rangeError) = JSON.object [
"code" .= ApiRequestErrorCode03,
"message" .= ("Requested range not satisfiable" :: Text),
"details" .= (case rangeError of
NegativeLimit -> "Limit should be greater than or equal to zero." NegativeLimit -> "Limit should be greater than or equal to zero."
LowerGTUpper -> "The lower boundary must be lower than or equal to the upper boundary in the Range header." LowerGTUpper -> "The lower boundary must be lower than or equal to the upper boundary in the Range header."
OutOfBounds lower total -> "An offset of " <> lower <> " was requested, but there are only " <> total <> " rows."), OutOfBounds lower total -> JSON.String $ "An offset of " <> lower <> " was requested, but there are only " <> total <> " rows.")
"hint" .= JSON.Null] Nothing
toJSON InvalidFilters = JSON.object [
"code" .= ApiRequestErrorCode05, toJSON InvalidFilters = toJsonPgrstError
"message" .= ("Filters must include all and only primary key columns with 'eq' operators" :: Text), ApiRequestErrorCode05 "Filters must include all and only primary key columns with 'eq' operators" Nothing Nothing
"details" .= JSON.Null,
"hint" .= JSON.Null] toJSON (UnacceptableSchema schemas) = toJsonPgrstError
toJSON (UnacceptableSchema schemas) = JSON.object [ ApiRequestErrorCode06 ("The schema must be one of the following: " <> T.intercalate ", " schemas) Nothing Nothing
"code" .= ApiRequestErrorCode06,
"message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas), toJSON (MediaTypeError cts) = toJsonPgrstError
"details" .= JSON.Null, ApiRequestErrorCode07 ("None of these media types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts)) Nothing Nothing
"hint" .= JSON.Null]
toJSON (MediaTypeError cts) = JSON.object [
"code" .= ApiRequestErrorCode07,
"message" .= ("None of these media types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts)),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON NotFound = JSON.object [] toJSON NotFound = JSON.object []
toJSON (NotEmbedded resource) = JSON.object [
"code" .= ApiRequestErrorCode08,
"message" .= ("'" <> resource <> "' is not an embedded resource in this request" :: Text),
"details" .= JSON.Null,
"hint" .= ("Verify that '" <> resource <> "' is included in the 'select' query parameter." :: Text)]
toJSON LimitNoOrderError = JSON.object [ toJSON (NotEmbedded resource) = toJsonPgrstError
"code" .= ApiRequestErrorCode09, ApiRequestErrorCode08
"message" .= ("A 'limit' was applied without an explicit 'order'":: Text), ("'" <> resource <> "' is not an embedded resource in this request")
"details" .= JSON.Null, Nothing
"hint" .= ("Apply an 'order' using unique column(s)" :: Text)] (Just $ JSON.String $ "Verify that '" <> resource <> "' is included in the 'select' query parameter.")
toJSON (OffLimitsChangesError n maxs) = JSON.object [ toJSON LimitNoOrderError = toJsonPgrstError
"code" .= ApiRequestErrorCode10, ApiRequestErrorCode09 "A 'limit' was applied without an explicit 'order'" Nothing (Just "Apply an 'order' using unique column(s)")
"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 [ toJSON (OffLimitsChangesError n maxs) = toJsonPgrstError
"code" .= ApiRequestErrorCode11, ApiRequestErrorCode10
"message" .= ("response.headers guc must be a JSON array composed of objects with a single key and a string value" :: Text), "The maximum number of rows allowed to change was surpassed"
"details" .= JSON.Null, (Just $ JSON.String $ T.unwords ["Results contain", show n, "rows changed but the maximum number allowed is", show maxs])
"hint" .= JSON.Null] Nothing
toJSON GucStatusError = JSON.object [ toJSON GucHeadersError = toJsonPgrstError
"code" .= ApiRequestErrorCode12, ApiRequestErrorCode11 "response.headers guc must be a JSON array composed of objects with a single key and a string value" Nothing Nothing
"message" .= ("response.status guc must be a valid status code" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (BinaryFieldError ct) = JSON.object [ toJSON GucStatusError = toJsonPgrstError
"code" .= ApiRequestErrorCode13, ApiRequestErrorCode12 "response.status guc must be a valid status code" Nothing Nothing
"message" .= ((T.decodeUtf8 (MediaType.toMime ct) <> " requested but more than one column was selected") :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON PutLimitNotAllowedError = JSON.object [ toJSON (BinaryFieldError ct) = toJsonPgrstError
"code" .= ApiRequestErrorCode14, ApiRequestErrorCode13 (T.decodeUtf8 (MediaType.toMime ct) <> " requested but more than one column was selected") Nothing Nothing
"message" .= ("limit/offset querystring parameters are not allowed for PUT" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON PutMatchingPkError = JSON.object [ toJSON PutLimitNotAllowedError = toJsonPgrstError
"code" .= ApiRequestErrorCode15, ApiRequestErrorCode14 "limit/offset querystring parameters are not allowed for PUT" Nothing Nothing
"message" .= ("Payload values do not match URL in primary key column(s)" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (SingularityError n) = JSON.object [ toJSON PutMatchingPkError = toJsonPgrstError
"code" .= ApiRequestErrorCode16, ApiRequestErrorCode15 "Payload values do not match URL in primary key column(s)" Nothing Nothing
"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 [ toJSON (SingularityError n) = toJsonPgrstError
"code" .= ApiRequestErrorCode17, ApiRequestErrorCode16
"message" .= ("Unsupported HTTP method: " <> T.decodeUtf8 method), "JSON object requested, multiple (or no) rows returned"
"details" .= JSON.Null, (Just $ JSON.String $ T.unwords ["The result contains", show n, "rows"])
"hint" .= JSON.Null] Nothing
toJSON (RelatedOrderNotToOne origin target) = JSON.object [ toJSON (UnsupportedMethod method) = toJsonPgrstError
"code" .= ApiRequestErrorCode18, ApiRequestErrorCode17 ("Unsupported HTTP method: " <> T.decodeUtf8 method) Nothing Nothing
"message" .= ("A related order on '" <> target <> "' is not possible" :: Text),
"details" .= ("'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship" :: Text),
"hint" .= JSON.Null]
toJSON (SpreadNotToOne origin target) = JSON.object [ toJSON (RelatedOrderNotToOne origin target) = toJsonPgrstError
"code" .= ApiRequestErrorCode19, ApiRequestErrorCode18
"message" .= ("A spread operation on '" <> target <> "' is not possible" :: Text), ("A related order on '" <> target <> "' is not possible")
"details" .= ("'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship" :: Text), (Just $ JSON.String $ "'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship")
"hint" .= JSON.Null] Nothing
toJSON (UnacceptableFilter target) = JSON.object [ toJSON (SpreadNotToOne origin target) = toJsonPgrstError
"code" .= ApiRequestErrorCode20, ApiRequestErrorCode19
"message" .= ("Bad operator on the '" <> target <> "' embedded resource":: Text), ("A spread operation on '" <> target <> "' is not possible")
"details" .= ("Only is null or not is null filters are allowed on embedded resources":: Text), (Just $ JSON.String $ "'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship")
"hint" .= JSON.Null] Nothing
toJSON PGRSTParseError = JSON.object [ toJSON (UnacceptableFilter target) = toJsonPgrstError
"code" .= ApiRequestErrorCode21, ApiRequestErrorCode20
"message" .= ("The message and detail field of RAISE 'PGRST' error expects JSON" :: Text), ("Bad operator on the '" <> target <> "' embedded resource")
"details" .= JSON.Null, (Just "Only is null or not is null filters are allowed on embedded resources")
"hint" .= JSON.Null] Nothing
toJSON (InvalidPreferences prefs) = JSON.object [ toJSON PGRSTParseError = toJsonPgrstError
"code" .= ApiRequestErrorCode22, ApiRequestErrorCode21 "The message and detail field of RAISE 'PGRST' error expects JSON" Nothing Nothing
"message" .= ("Invalid preferences given with handling=strict" :: Text),
"details" .= T.decodeUtf8 ("Invalid preferences: " <> BS.intercalate ", " prefs),
"hint" .= JSON.Null]
toJSON (NoRelBetween parent child embedHint schema allRels) = JSON.object [ toJSON (InvalidPreferences prefs) = toJsonPgrstError
"code" .= SchemaCacheErrorCode00, ApiRequestErrorCode22
"message" .= ("Could not find a relationship between '" <> parent <> "' and '" <> child <> "' in the schema cache" :: Text), "Invalid preferences given with handling=strict"
"details" .= ("Searched for a foreign key relationship between '" <> parent <> "' and '" <> child <> maybe mempty ("' using the hint '" <>) embedHint <> "' in the schema '" <> schema <> "', but no matches were found."), (Just $ JSON.String $ T.decodeUtf8 ("Invalid preferences: " <> BS.intercalate ", " prefs))
"hint" .= noRelBetweenHint parent child schema allRels] Nothing
toJSON (NoRelBetween parent child embedHint schema allRels) = toJsonPgrstError
SchemaCacheErrorCode00
("Could not find a relationship between '" <> parent <> "' and '" <> child <> "' in the schema cache")
(Just $ JSON.String $ "Searched for a foreign key relationship between '" <> parent <> "' and '" <> child <> maybe mempty ("' using the hint '" <>) embedHint <> "' in the schema '" <> schema <> "', but no matches were found.")
(JSON.String <$> noRelBetweenHint parent child schema allRels)
toJSON (AmbiguousRelBetween parent child rels) = toJsonPgrstError
SchemaCacheErrorCode01
("Could not embed because more than one relationship was found for '" <> parent <> "' and '" <> child <> "'")
(Just $ JSON.toJSONList (compressedRel <$> rels))
(Just $ JSON.String $ "Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key.")
toJSON (AmbiguousRelBetween parent child rels) = JSON.object [
"code" .= SchemaCacheErrorCode01,
"message" .= ("Could not embed because more than one relationship was found for '" <> parent <> "' and '" <> child <> "'" :: Text),
"details" .= (compressedRel <$> rels),
"hint" .= ("Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key." :: Text)]
toJSON (NoRpc schema procName argumentKeys hasPreferSingleObject contentType isInvPost allProcs overloadedProcs) = toJSON (NoRpc schema procName argumentKeys hasPreferSingleObject contentType isInvPost allProcs overloadedProcs) =
let func = schema <> "." <> procName let func = schema <> "." <> procName
prms = T.intercalate ", " argumentKeys prms = T.intercalate ", " argumentKeys
@@ -242,10 +217,10 @@ instance JSON.ToJSON ApiRequestError where
prmsDet = " with parameter" <> (if length argumentKeys > 1 then "s " else " ") <> prms prmsDet = " with parameter" <> (if length argumentKeys > 1 then "s " else " ") <> prms
fmtPrms p = if null argumentKeys then " without parameters" else p fmtPrms p = if null argumentKeys then " without parameters" else p
onlySingleParams = hasPreferSingleObject || (isInvPost && contentType `elem` [MTTextPlain, MTTextXML, MTOctetStream]) onlySingleParams = hasPreferSingleObject || (isInvPost && contentType `elem` [MTTextPlain, MTTextXML, MTOctetStream])
in JSON.object [ in toJsonPgrstError
"code" .= SchemaCacheErrorCode02, SchemaCacheErrorCode02
"message" .= ("Could not find the function " <> func <> (if onlySingleParams then "" else fmtPrms prmsMsg) <> " in the schema cache"), ("Could not find the function " <> func <> (if onlySingleParams then "" else fmtPrms prmsMsg) <> " in the schema cache")
"details" .= ("Searched for the function " <> func <> (Just $ JSON.String $ "Searched for the function " <> func <>
(case (hasPreferSingleObject, isInvPost, contentType) of (case (hasPreferSingleObject, isInvPost, contentType) of
(True, _, _) -> " with a single json/jsonb parameter" (True, _, _) -> " with a single json/jsonb parameter"
(_, True, MTTextPlain) -> " with a single unnamed text parameter" (_, True, MTTextPlain) -> " with a single unnamed text parameter"
@@ -253,21 +228,20 @@ instance JSON.ToJSON ApiRequestError where
(_, True, MTOctetStream) -> " with a single unnamed bytea parameter" (_, True, MTOctetStream) -> " with a single unnamed bytea parameter"
(_, True, MTApplicationJSON) -> fmtPrms prmsDet <> " or with a single unnamed json/jsonb parameter" (_, True, MTApplicationJSON) -> fmtPrms prmsDet <> " or with a single unnamed json/jsonb parameter"
_ -> fmtPrms prmsDet) <> _ -> fmtPrms prmsDet) <>
", but no matches were found in the schema cache."), ", but no matches were found in the schema cache.")
-- The hint will be null in the case of single unnamed parameter functions -- The hint will be null in the case of single unnamed parameter functions
"hint" .= if onlySingleParams (if onlySingleParams
then Nothing then Nothing
else noRpcHint schema procName argumentKeys allProcs overloadedProcs ] else JSON.String <$> noRpcHint schema procName argumentKeys allProcs overloadedProcs)
toJSON (AmbiguousRpc procs) = JSON.object [
"code" .= SchemaCacheErrorCode03, toJSON (AmbiguousRpc procs) = toJsonPgrstError
"message" .= ("Could not choose the best candidate function between: " <> T.intercalate ", " [pdSchema p <> "." <> pdName p <> "(" <> T.intercalate ", " [ppName a <> " => " <> ppType a | a <- pdParams p] <> ")" | p <- procs]), SchemaCacheErrorCode03
"details" .= JSON.Null, ("Could not choose the best candidate function between: " <> T.intercalate ", " [pdSchema p <> "." <> pdName p <> "(" <> T.intercalate ", " [ppName a <> " => " <> ppType a | a <- pdParams p] <> ")" | p <- procs])
"hint" .= ("Try renaming the parameters or the function itself in the database so function overloading can be resolved" :: Text)] Nothing
toJSON (ColumnNotFound relName colName) = JSON.object [ (Just "Try renaming the parameters or the function itself in the database so function overloading can be resolved")
"code" .= SchemaCacheErrorCode04,
"message" .= ("Column '" <> colName <> "' of relation '" <> relName <> "' does not exist" :: Text), toJSON (ColumnNotFound relName colName) = toJsonPgrstError
"details" .= JSON.Null, SchemaCacheErrorCode04 ("Column '" <> colName <> "' of relation '" <> relName <> "' does not exist") Nothing Nothing
"hint" .= JSON.Null]
-- | -- |
-- If no relationship is found then: -- If no relationship is found then:
@@ -428,17 +402,16 @@ instance JSON.ToJSON PgError where
toJSON (PgError _ usageError) = JSON.toJSON usageError toJSON (PgError _ usageError) = JSON.toJSON usageError
instance JSON.ToJSON SQL.UsageError where instance JSON.ToJSON SQL.UsageError where
toJSON (SQL.ConnectionUsageError e) = JSON.object [ toJSON (SQL.ConnectionUsageError e) = toJsonPgrstError
"code" .= ConnectionErrorCode00, ConnectionErrorCode00
"message" .= ("Database connection error. Retrying the connection." :: Text), "Database connection error. Retrying the connection."
"details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text), (Just $ JSON.String $ T.decodeUtf8With T.lenientDecode $ fromMaybe "" e)
"hint" .= JSON.Null] Nothing
toJSON (SQL.SessionUsageError e) = JSON.toJSON e -- SQL.Error toJSON (SQL.SessionUsageError e) = JSON.toJSON e -- SQL.Error
toJSON SQL.AcquisitionTimeoutUsageError = JSON.object [
"code" .= ConnectionErrorCode03, toJSON SQL.AcquisitionTimeoutUsageError = toJsonPgrstError
"message" .= ("Timed out acquiring connection from connection pool." :: Text), ConnectionErrorCode03 "Timed out acquiring connection from connection pool." Nothing Nothing
"details" .= JSON.Null,
"hint" .= JSON.Null]
instance JSON.ToJSON SQL.QueryError where instance JSON.ToJSON SQL.QueryError where
toJSON (SQL.QueryError _ _ e) = JSON.toJSON e toJSON (SQL.QueryError _ _ e) = JSON.toJSON e
@@ -462,17 +435,11 @@ instance JSON.ToJSON SQL.CommandError where
"details" .= (fmap T.decodeUtf8 d :: Maybe Text), "details" .= (fmap T.decodeUtf8 d :: Maybe Text),
"hint" .= (fmap T.decodeUtf8 h :: Maybe Text)] "hint" .= (fmap T.decodeUtf8 h :: Maybe Text)]
toJSON (SQL.ResultError resultError) = JSON.object [ toJSON (SQL.ResultError resultError) = toJsonPgrstError
"code" .= InternalErrorCode00, InternalErrorCode00 (show resultError) Nothing Nothing
"message" .= (show resultError :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (SQL.ClientError d) = JSON.object [ toJSON (SQL.ClientError d) = toJsonPgrstError
"code" .= ConnectionErrorCode01, ConnectionErrorCode01 "Database client error. Retrying the connection." (JSON.String <$> fmap T.decodeUtf8 d) Nothing
"message" .= ("Database client error. Retrying the connection." :: Text),
"details" .= (fmap T.decodeUtf8 d :: Maybe Text),
"hint" .= JSON.Null]
pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503 pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503
@@ -545,27 +512,17 @@ instance PgrstError Error where
headers _ = mempty headers _ = mempty
instance JSON.ToJSON Error where instance JSON.ToJSON Error where
toJSON NoSchemaCacheError = JSON.object [ toJSON NoSchemaCacheError = toJsonPgrstError
"code" .= ConnectionErrorCode02, ConnectionErrorCode02 "Could not query the database for the schema cache. Retrying." Nothing Nothing
"message" .= ("Could not query the database for the schema cache. Retrying." :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON JwtTokenMissing = JSON.object [ toJSON JwtTokenMissing = toJsonPgrstError
"code" .= JWTErrorCode00, JWTErrorCode00 "Server lacks JWT secret" Nothing Nothing
"message" .= ("Server lacks JWT secret" :: Text),
"details" .= JSON.Null, toJSON (JwtTokenInvalid message) = toJsonPgrstError
"hint" .= JSON.Null] JWTErrorCode01 message Nothing Nothing
toJSON (JwtTokenInvalid message) = JSON.object [
"code" .= JWTErrorCode01, toJSON JwtTokenRequired = toJsonPgrstError
"message" .= (message :: Text), JWTErrorCode02 "Anonymous access is disabled" Nothing Nothing
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON JwtTokenRequired = JSON.object [
"code" .= JWTErrorCode02,
"message" .= ("Anonymous access is disabled" :: Text),
"details" .= JSON.Null,
"hint" .= JSON.Null]
toJSON (PgErr err) = JSON.toJSON err toJSON (PgErr err) = JSON.toJSON err
toJSON (ApiRequestError err) = JSON.toJSON err toJSON (ApiRequestError err) = JSON.toJSON err