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