From 9c324528e5eabbd15b3c3db225bdc6cda3230919 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 18:03:00 +0300 Subject: [PATCH 01/19] Work around postgresql-libpq compilation issues --- cabal.project | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cabal.project b/cabal.project index 313d3fc1f4..4aa4c1988f 100644 --- a/cabal.project +++ b/cabal.project @@ -1,2 +1,4 @@ packages: postgrest.cabal tests: true +allow-newer: + *:postgresql-libpq, From 13af502ea7dcdad54b3ac00dd793ebd957fa1b16 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 17:42:04 +0300 Subject: [PATCH 02/19] Isolate Algebra --- postgrest.cabal | 1 + src/PostgREST/Error.hs | 26 +------------------------- src/PostgREST/Error/Algebra.hs | 30 ++++++++++++++++++++++++++++++ 3 files changed, 32 insertions(+), 25 deletions(-) create mode 100644 src/PostgREST/Error/Algebra.hs diff --git a/postgrest.cabal b/postgrest.cabal index 1524f5397b..440098f0f9 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -66,6 +66,7 @@ library PostgREST.SchemaCache.Representations PostgREST.SchemaCache.Table PostgREST.Error + PostgREST.Error.Algebra PostgREST.Listener PostgREST.Logger PostgREST.MainTx diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 39217610cf..d3dcf73cbb 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -22,7 +22,6 @@ module PostgREST.Error import qualified Data.Aeson as JSON import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy as LBS import qualified Data.CaseInsensitive as CI import qualified Data.FuzzySet as Fuzzy import qualified Data.HashMap.Strict as HM @@ -34,12 +33,10 @@ import qualified Hasql.Session as SQL import qualified Network.HTTP.Types.Status as HTTP import Data.Aeson ((.:), (.:?), (.=)) -import Network.Wai (Response, responseLBS) import Network.HTTP.Types.Header (Header) import PostgREST.MediaType (MediaType (..)) -import qualified PostgREST.MediaType as MediaType import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), Schema) @@ -50,30 +47,9 @@ import PostgREST.SchemaCache.Relationship (Cardinality (..), import PostgREST.SchemaCache.Routine (Routine (..), RoutineParam (..)) import PostgREST.SchemaCache.Table (Table (..)) +import PostgREST.Error.Algebra import Protolude - -class (ErrorBody a, JSON.ToJSON a) => PgrstError a where - status :: a -> HTTP.Status - headers :: a -> [Header] - - errorPayload :: a -> LByteString - errorPayload = JSON.encode - - errorResponseFor :: a -> Response - errorResponseFor err = - let - baseHeader = MediaType.toContentType MTApplicationJSON - cLHeader body = (,) "Content-Length" (show $ LBS.length body) :: Header - in - responseLBS (status err) (baseHeader : cLHeader (errorPayload err) : headers err) $ errorPayload err - -class ErrorBody a where - code :: a -> Text - message :: a -> Text - details :: a -> Maybe JSON.Value - hint :: a -> Maybe JSON.Value - data ApiRequestError = AggregatesNotAllowed | MediaTypeError [ByteString] diff --git a/src/PostgREST/Error/Algebra.hs b/src/PostgREST/Error/Algebra.hs new file mode 100644 index 0000000000..1817ae6ed7 --- /dev/null +++ b/src/PostgREST/Error/Algebra.hs @@ -0,0 +1,30 @@ +module PostgREST.Error.Algebra where + +import qualified Data.Aeson as JSON +import qualified Data.ByteString.Lazy as LBS +import qualified Network.HTTP.Types as HTTP +import qualified PostgREST.MediaType as MediaType + +import Network.Wai (Response, responseLBS) +import Protolude + +class (ErrorBody a, JSON.ToJSON a) => PgrstError a where + status :: a -> HTTP.Status + headers :: a -> [HTTP.Header] + + errorPayload :: a -> LByteString + errorPayload = JSON.encode + + errorResponseFor :: a -> Response + errorResponseFor err = + let + baseHeader = MediaType.toContentType MediaType.MTApplicationJSON + cLHeader body = (,) "Content-Length" (show $ LBS.length body) :: HTTP.Header + in + responseLBS (status err) (baseHeader : cLHeader (errorPayload err) : headers err) $ errorPayload err + +class ErrorBody a where + code :: a -> Text + message :: a -> Text + details :: a -> Maybe JSON.Value + hint :: a -> Maybe JSON.Value From 540bb3adc66a29c2ee9942d443bb81fba13e5ffb Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 18:19:43 +0300 Subject: [PATCH 03/19] Factor ApiRequestError out of Error --- postgrest.cabal | 1 + src/PostgREST/Error.hs | 190 +----------------------- src/PostgREST/Error/Algebra.hs | 8 + src/PostgREST/Error/ApiRequestError.hs | 196 +++++++++++++++++++++++++ 4 files changed, 206 insertions(+), 189 deletions(-) create mode 100644 src/PostgREST/Error/ApiRequestError.hs diff --git a/postgrest.cabal b/postgrest.cabal index 440098f0f9..62a743c04c 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -67,6 +67,7 @@ library PostgREST.SchemaCache.Table PostgREST.Error PostgREST.Error.Algebra + PostgREST.Error.ApiRequestError PostgREST.Listener PostgREST.Logger PostgREST.MainTx diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index d3dcf73cbb..f74f113d07 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -48,178 +48,9 @@ import PostgREST.SchemaCache.Routine (Routine (..), RoutineParam (..)) import PostgREST.SchemaCache.Table (Table (..)) import PostgREST.Error.Algebra +import PostgREST.Error.ApiRequestError import Protolude -data ApiRequestError - = AggregatesNotAllowed - | MediaTypeError [ByteString] - | InvalidBody ByteString - | InvalidFilters - | InvalidPreferences [ByteString] - | InvalidRange RangeError - | InvalidRpcMethod ByteString - | NotEmbedded Text - | NotImplemented Text - | PutLimitNotAllowedError - | QueryParamError QPError - | RelatedOrderNotToOne Text Text - | UnacceptableFilter Text - | UnacceptableSchema Text [Text] - | UnsupportedMethod ByteString - | GucHeadersError - | GucStatusError - | PutMatchingPkError - | SingularityError Integer - | PGRSTParseError RaiseError - | MaxAffectedViolationError Integer - | InvalidResourcePath - | OpenAPIDisabled - | MaxAffectedRpcViolation - deriving Show - -data QPError = QPError Text Text - deriving Show - -data RaiseError - = MsgParseError ByteString - | DetParseError ByteString - | NoDetail - deriving Show - -data RangeError - = NegativeLimit - | LowerGTUpper - | OutOfBounds Text Text - deriving Show - -instance PgrstError ApiRequestError where - status AggregatesNotAllowed{} = HTTP.status400 - status MediaTypeError{} = HTTP.status406 - status InvalidBody{} = HTTP.status400 - status InvalidFilters = HTTP.status405 - status InvalidPreferences{} = HTTP.status400 - status InvalidRpcMethod{} = HTTP.status405 - status InvalidRange{} = HTTP.status416 - - status NotEmbedded{} = HTTP.status400 - status NotImplemented{} = HTTP.status400 - status PutLimitNotAllowedError = HTTP.status400 - status QueryParamError{} = HTTP.status400 - status RelatedOrderNotToOne{} = HTTP.status400 - status UnacceptableFilter{} = HTTP.status400 - status UnacceptableSchema{} = HTTP.status406 - status UnsupportedMethod{} = HTTP.status405 - status GucHeadersError = HTTP.status500 - status GucStatusError = HTTP.status500 - status PutMatchingPkError = HTTP.status400 - status SingularityError{} = HTTP.status406 - status PGRSTParseError{} = HTTP.status500 - status MaxAffectedViolationError{} = HTTP.status400 - status InvalidResourcePath = HTTP.status404 - status OpenAPIDisabled = HTTP.status404 - status MaxAffectedRpcViolation = HTTP.status400 - - headers _ = mempty - --- Error codes: --- --- Error codes are grouped by common modules or characteristics --- New group of errors will be added at the end of all the groups and will have the next prefix in the sequence --- Keep the "PGRST" prefix in every code for an easier search/grep --- They are grouped as following: --- --- PGRST0xx -> Connection Error --- PGRST1xx -> ApiRequest Error --- PGRST2xx -> SchemaCache Error --- PGRST3xx -> JWT authentication Error --- PGRSTXxx -> Internal Hasql Error - -instance ErrorBody ApiRequestError where - -- CODE: Text - code QueryParamError{} = "PGRST100" - code InvalidRpcMethod{} = "PGRST101" - code InvalidBody{} = "PGRST102" - code InvalidRange{} = "PGRST103" - -- code ParseRequestError = "PGRST104" -- no longer used - code InvalidFilters = "PGRST105" - code UnacceptableSchema{} = "PGRST106" - code MediaTypeError{} = "PGRST107" - code NotEmbedded{} = "PGRST108" - -- code LimitNoOrderError = "PGRST109" -- no longer used - -- code OffLimitsChangesError = "PGRST110" -- no longer used - code GucHeadersError = "PGRST111" - code GucStatusError = "PGRST112" - -- code BinaryFieldError = "PGRST113" -- no longer used - code PutLimitNotAllowedError = "PGRST114" - code PutMatchingPkError = "PGRST115" - code SingularityError{} = "PGRST116" - code UnsupportedMethod{} = "PGRST117" - code RelatedOrderNotToOne{} = "PGRST118" - -- code SpreadNotToOne = "PGRST109" -- no longer used - code UnacceptableFilter{} = "PGRST120" - code PGRSTParseError{} = "PGRST121" - code InvalidPreferences{} = "PGRST122" - code AggregatesNotAllowed = "PGRST123" - code MaxAffectedViolationError{} = "PGRST124" - code InvalidResourcePath = "PGRST125" - code OpenAPIDisabled = "PGRST126" - code NotImplemented{} = "PGRST127" - code MaxAffectedRpcViolation = "PGRST128" - - -- MESSAGE: Text - message (QueryParamError (QPError msg _)) = msg - message (InvalidRpcMethod method) = "Cannot use the " <> T.decodeUtf8 method <> " method on RPC" - message (InvalidBody errorMessage) = T.decodeUtf8 errorMessage - message (InvalidRange _) = "Requested range not satisfiable" - message InvalidFilters = "Filters must include all and only primary key columns with 'eq' operators" - message (UnacceptableSchema sch _) = "Invalid schema: " <> sch - message (MediaTypeError cts) = "None of these media types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts) - message (NotEmbedded resource) = "'" <> resource <> "' is not an embedded resource in this request" - message GucHeadersError = "response.headers guc must be a JSON array composed of objects with a single key and a string value" - message GucStatusError = "response.status guc must be a valid status code" - message PutLimitNotAllowedError = "limit/offset querystring parameters are not allowed for PUT" - message PutMatchingPkError = "Payload values do not match URL in primary key column(s)" - message (SingularityError _) = "Cannot coerce the result to a single JSON object" - message (UnsupportedMethod method) = "Unsupported HTTP method: " <> T.decodeUtf8 method - message (RelatedOrderNotToOne _ target) = "A related order on '" <> target <> "' is not possible" - message (UnacceptableFilter target) = "Bad operator on the '" <> target <> "' embedded resource" - message (PGRSTParseError _) = "Could not parse JSON in the \"RAISE SQLSTATE 'PGRST'\" error" - message (InvalidPreferences _) = "Invalid preferences given with handling=strict" - message AggregatesNotAllowed = "Use of aggregate functions is not allowed" - message (MaxAffectedViolationError _) = "Query result exceeds max-affected preference constraint" - message InvalidResourcePath = "Invalid path specified in request URL" - message OpenAPIDisabled = "Root endpoint metadata is disabled" - message (NotImplemented _) = "Feature not implemented" - message MaxAffectedRpcViolation = "Function must return SETOF or TABLE when max-affected preference is used with handling=strict" - - -- DETAILS: Maybe JSON.Value - details (QueryParamError (QPError _ dets)) = Just $ JSON.String dets - details (InvalidRange rangeError) = 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 -> JSON.String $ "An offset of " <> lower <> " was requested, but there are only " <> total <> " rows." - details (SingularityError n) = Just $ JSON.String $ T.unwords ["The result contains", show n, "rows"] - details (RelatedOrderNotToOne origin target) = Just $ JSON.String $ "'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship" - details (UnacceptableFilter _) = Just "Only is null or not is null filters are allowed on embedded resources" - details (PGRSTParseError raiseErr) = Just $ JSON.String $ pgrstParseErrorDetails raiseErr - details (InvalidPreferences prefs) = Just $ JSON.String $ T.decodeUtf8 ("Invalid preferences: " <> BS.intercalate ", " prefs) - details (MaxAffectedViolationError n) = Just $ JSON.String $ T.unwords ["The query affects", show n, "rows"] - details (NotImplemented details') = Just $ JSON.String details' - - details _ = Nothing - - -- HINT: Maybe JSON.Value - hint (NotEmbedded resource) = Just $ JSON.String $ "Verify that '" <> resource <> "' is included in the 'select' query parameter." - hint (PGRSTParseError raiseErr) = Just $ JSON.String $ pgrstParseErrorHint raiseErr - hint (UnacceptableSchema _ schemas) = Just $ JSON.String $ "Only the following schemas are exposed: " <> T.intercalate ", " schemas - - hint _ = Nothing - -instance JSON.ToJSON ApiRequestError where - toJSON err = toJsonPgrstError - (code err) (message err) (details err) (hint err) - data SchemaCacheError = AmbiguousRelBetween Text Text [Relationship] | AmbiguousRpc [Routine] @@ -297,14 +128,6 @@ instance JSON.ToJSON SchemaCacheError where toJSON err = toJsonPgrstError (code err) (message err) (details err) (hint err) -toJsonPgrstError :: Text -> Text -> Maybe JSON.Value -> Maybe JSON.Value -> JSON.Value -toJsonPgrstError code' message' details' hint' = JSON.object [ - "code" .= code' - , "message" .= message' - , "details" .= details' - , "hint" .= hint' - ] - -- | -- If no relationship is found then: -- @@ -452,17 +275,6 @@ relHint rels = T.intercalate ", " (hintList <$> rels) -- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed hintList ComputedRelationship{} = mempty -pgrstParseErrorDetails :: RaiseError -> Text -pgrstParseErrorDetails err = case err of - MsgParseError m -> "Invalid JSON value for MESSAGE: '" <> T.decodeUtf8 m <> "'" - DetParseError d -> "Invalid JSON value for DETAIL: '" <> T.decodeUtf8 d <> "'" - NoDetail -> "DETAIL is missing in the RAISE statement" - -pgrstParseErrorHint :: RaiseError -> Text -pgrstParseErrorHint err = case err of - MsgParseError _ -> "MESSAGE must be a JSON object with obligatory keys: 'code', 'message' and optional keys: 'details', 'hint'." - _ -> "DETAIL must be a JSON object with obligatory keys: 'status', 'headers' and optional key: 'status_text'." - data PgError = PgError Authenticated SQL.UsageError deriving Show diff --git a/src/PostgREST/Error/Algebra.hs b/src/PostgREST/Error/Algebra.hs index 1817ae6ed7..c116bb59d2 100644 --- a/src/PostgREST/Error/Algebra.hs +++ b/src/PostgREST/Error/Algebra.hs @@ -28,3 +28,11 @@ class ErrorBody a where message :: a -> Text details :: a -> Maybe JSON.Value hint :: a -> Maybe JSON.Value + +toJsonPgrstError :: Text -> Text -> Maybe JSON.Value -> Maybe JSON.Value -> JSON.Value +toJsonPgrstError code' message' details' hint' = JSON.object [ + "code" JSON..= code' + , "message" JSON..= message' + , "details" JSON..= details' + , "hint" JSON..= hint' + ] diff --git a/src/PostgREST/Error/ApiRequestError.hs b/src/PostgREST/Error/ApiRequestError.hs new file mode 100644 index 0000000000..3469f3bac1 --- /dev/null +++ b/src/PostgREST/Error/ApiRequestError.hs @@ -0,0 +1,196 @@ +module PostgREST.Error.ApiRequestError + ( ApiRequestError(..), + QPError(..), + RaiseError(..), + RangeError(..), + ) where + +import qualified Data.Aeson as JSON +import qualified Data.ByteString.Char8 as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Network.HTTP.Types.Status as HTTP + +import PostgREST.Error.Algebra +import Protolude + +data ApiRequestError + = AggregatesNotAllowed + | MediaTypeError [ByteString] + | InvalidBody ByteString + | InvalidFilters + | InvalidPreferences [ByteString] + | InvalidRange RangeError + | InvalidRpcMethod ByteString + | NotEmbedded Text + | NotImplemented Text + | PutLimitNotAllowedError + | QueryParamError QPError + | RelatedOrderNotToOne Text Text + | UnacceptableFilter Text + | UnacceptableSchema Text [Text] + | UnsupportedMethod ByteString + | GucHeadersError + | GucStatusError + | PutMatchingPkError + | SingularityError Integer + | PGRSTParseError RaiseError + | MaxAffectedViolationError Integer + | InvalidResourcePath + | OpenAPIDisabled + | MaxAffectedRpcViolation + deriving Show + +data QPError = QPError Text Text + deriving Show + +data RaiseError + = MsgParseError ByteString + | DetParseError ByteString + | NoDetail + deriving Show + +data RangeError + = NegativeLimit + | LowerGTUpper + | OutOfBounds Text Text + deriving Show + +instance PgrstError ApiRequestError where + status AggregatesNotAllowed{} = HTTP.status400 + status MediaTypeError{} = HTTP.status406 + status InvalidBody{} = HTTP.status400 + status InvalidFilters = HTTP.status405 + status InvalidPreferences{} = HTTP.status400 + status InvalidRpcMethod{} = HTTP.status405 + status InvalidRange{} = HTTP.status416 + + status NotEmbedded{} = HTTP.status400 + status NotImplemented{} = HTTP.status400 + status PutLimitNotAllowedError = HTTP.status400 + status QueryParamError{} = HTTP.status400 + status RelatedOrderNotToOne{} = HTTP.status400 + status UnacceptableFilter{} = HTTP.status400 + status UnacceptableSchema{} = HTTP.status406 + status UnsupportedMethod{} = HTTP.status405 + status GucHeadersError = HTTP.status500 + status GucStatusError = HTTP.status500 + status PutMatchingPkError = HTTP.status400 + status SingularityError{} = HTTP.status406 + status PGRSTParseError{} = HTTP.status500 + status MaxAffectedViolationError{} = HTTP.status400 + status InvalidResourcePath = HTTP.status404 + status OpenAPIDisabled = HTTP.status404 + status MaxAffectedRpcViolation = HTTP.status400 + + headers _ = mempty + +-- Error codes: +-- +-- Error codes are grouped by common modules or characteristics +-- New group of errors will be added at the end of all the groups and will have the next prefix in the sequence +-- Keep the "PGRST" prefix in every code for an easier search/grep +-- They are grouped as following: +-- +-- PGRST0xx -> Connection Error +-- PGRST1xx -> ApiRequest Error +-- PGRST2xx -> SchemaCache Error +-- PGRST3xx -> JWT authentication Error +-- PGRSTXxx -> Internal Hasql Error + +instance ErrorBody ApiRequestError where + -- CODE: Text + code QueryParamError{} = "PGRST100" + code InvalidRpcMethod{} = "PGRST101" + code InvalidBody{} = "PGRST102" + code InvalidRange{} = "PGRST103" + -- code ParseRequestError = "PGRST104" -- no longer used + code InvalidFilters = "PGRST105" + code UnacceptableSchema{} = "PGRST106" + code MediaTypeError{} = "PGRST107" + code NotEmbedded{} = "PGRST108" + -- code LimitNoOrderError = "PGRST109" -- no longer used + -- code OffLimitsChangesError = "PGRST110" -- no longer used + code GucHeadersError = "PGRST111" + code GucStatusError = "PGRST112" + -- code BinaryFieldError = "PGRST113" -- no longer used + code PutLimitNotAllowedError = "PGRST114" + code PutMatchingPkError = "PGRST115" + code SingularityError{} = "PGRST116" + code UnsupportedMethod{} = "PGRST117" + code RelatedOrderNotToOne{} = "PGRST118" + -- code SpreadNotToOne = "PGRST109" -- no longer used + code UnacceptableFilter{} = "PGRST120" + code PGRSTParseError{} = "PGRST121" + code InvalidPreferences{} = "PGRST122" + code AggregatesNotAllowed = "PGRST123" + code MaxAffectedViolationError{} = "PGRST124" + code InvalidResourcePath = "PGRST125" + code OpenAPIDisabled = "PGRST126" + code NotImplemented{} = "PGRST127" + code MaxAffectedRpcViolation = "PGRST128" + + -- MESSAGE: Text + message (QueryParamError (QPError msg _)) = msg + message (InvalidRpcMethod method) = "Cannot use the " <> T.decodeUtf8 method <> " method on RPC" + message (InvalidBody errorMessage) = T.decodeUtf8 errorMessage + message (InvalidRange _) = "Requested range not satisfiable" + message InvalidFilters = "Filters must include all and only primary key columns with 'eq' operators" + message (UnacceptableSchema sch _) = "Invalid schema: " <> sch + message (MediaTypeError cts) = "None of these media types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts) + message (NotEmbedded resource) = "'" <> resource <> "' is not an embedded resource in this request" + message GucHeadersError = "response.headers guc must be a JSON array composed of objects with a single key and a string value" + message GucStatusError = "response.status guc must be a valid status code" + message PutLimitNotAllowedError = "limit/offset querystring parameters are not allowed for PUT" + message PutMatchingPkError = "Payload values do not match URL in primary key column(s)" + message (SingularityError _) = "Cannot coerce the result to a single JSON object" + message (UnsupportedMethod method) = "Unsupported HTTP method: " <> T.decodeUtf8 method + message (RelatedOrderNotToOne _ target) = "A related order on '" <> target <> "' is not possible" + message (UnacceptableFilter target) = "Bad operator on the '" <> target <> "' embedded resource" + message (PGRSTParseError _) = "Could not parse JSON in the \"RAISE SQLSTATE 'PGRST'\" error" + message (InvalidPreferences _) = "Invalid preferences given with handling=strict" + message AggregatesNotAllowed = "Use of aggregate functions is not allowed" + message (MaxAffectedViolationError _) = "Query result exceeds max-affected preference constraint" + message InvalidResourcePath = "Invalid path specified in request URL" + message OpenAPIDisabled = "Root endpoint metadata is disabled" + message (NotImplemented _) = "Feature not implemented" + message MaxAffectedRpcViolation = "Function must return SETOF or TABLE when max-affected preference is used with handling=strict" + + -- DETAILS: Maybe JSON.Value + details (QueryParamError (QPError _ dets)) = Just $ JSON.String dets + details (InvalidRange rangeError) = 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 -> JSON.String $ "An offset of " <> lower <> " was requested, but there are only " <> total <> " rows." + details (SingularityError n) = Just $ JSON.String $ T.unwords ["The result contains", show n, "rows"] + details (RelatedOrderNotToOne origin target) = Just $ JSON.String $ "'" <> origin <> "' and '" <> target <> "' do not form a many-to-one or one-to-one relationship" + details (UnacceptableFilter _) = Just "Only is null or not is null filters are allowed on embedded resources" + details (PGRSTParseError raiseErr) = Just $ JSON.String $ pgrstParseErrorDetails raiseErr + details (InvalidPreferences prefs) = Just $ JSON.String $ T.decodeUtf8 ("Invalid preferences: " <> BS.intercalate ", " prefs) + details (MaxAffectedViolationError n) = Just $ JSON.String $ T.unwords ["The query affects", show n, "rows"] + details (NotImplemented details') = Just $ JSON.String details' + + details _ = Nothing + + -- HINT: Maybe JSON.Value + hint (NotEmbedded resource) = Just $ JSON.String $ "Verify that '" <> resource <> "' is included in the 'select' query parameter." + hint (PGRSTParseError raiseErr) = Just $ JSON.String $ pgrstParseErrorHint raiseErr + hint (UnacceptableSchema _ schemas) = Just $ JSON.String $ "Only the following schemas are exposed: " <> T.intercalate ", " schemas + + hint _ = Nothing + +instance JSON.ToJSON ApiRequestError where + toJSON err = toJsonPgrstError + (code err) (message err) (details err) (hint err) + +pgrstParseErrorHint :: RaiseError -> Text +pgrstParseErrorHint err = case err of + MsgParseError _ -> "MESSAGE must be a JSON object with obligatory keys: 'code', 'message' and optional keys: 'details', 'hint'." + _ -> "DETAIL must be a JSON object with obligatory keys: 'status', 'headers' and optional key: 'status_text'." + +pgrstParseErrorDetails :: RaiseError -> Text +pgrstParseErrorDetails err = case err of + MsgParseError m -> "Invalid JSON value for MESSAGE: '" <> T.decodeUtf8 m <> "'" + DetParseError d -> "Invalid JSON value for DETAIL: '" <> T.decodeUtf8 d <> "'" + NoDetail -> "DETAIL is missing in the RAISE statement" From bd429cef5dece33874e061a547fd012890e38752 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 18:28:08 +0300 Subject: [PATCH 04/19] Isolate SchemaCacheError --- postgrest.cabal | 1 + src/PostgREST/Error.hs | 242 +---------------------- src/PostgREST/Error/SchemaCacheError.hs | 246 ++++++++++++++++++++++++ 3 files changed, 249 insertions(+), 240 deletions(-) create mode 100644 src/PostgREST/Error/SchemaCacheError.hs diff --git a/postgrest.cabal b/postgrest.cabal index 62a743c04c..6ff72ec81e 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -68,6 +68,7 @@ library PostgREST.Error PostgREST.Error.Algebra PostgREST.Error.ApiRequestError + PostgREST.Error.SchemaCacheError PostgREST.Listener PostgREST.Logger PostgREST.MainTx diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index f74f113d07..95b9880b14 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -23,257 +23,19 @@ module PostgREST.Error import qualified Data.Aeson as JSON import qualified Data.ByteString.Char8 as BS import qualified Data.CaseInsensitive as CI -import qualified Data.FuzzySet as Fuzzy -import qualified Data.HashMap.Strict as HM import qualified Data.Map.Internal as M -import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Hasql.Pool as SQL import qualified Hasql.Session as SQL import qualified Network.HTTP.Types.Status as HTTP -import Data.Aeson ((.:), (.:?), (.=)) - +import Data.Aeson ((.:), (.:?)) import Network.HTTP.Types.Header (Header) - -import PostgREST.MediaType (MediaType (..)) - -import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), - Schema) -import PostgREST.SchemaCache.Relationship (Cardinality (..), - Junction (..), - Relationship (..), - RelationshipsMap) -import PostgREST.SchemaCache.Routine (Routine (..), - RoutineParam (..)) -import PostgREST.SchemaCache.Table (Table (..)) import PostgREST.Error.Algebra import PostgREST.Error.ApiRequestError +import PostgREST.Error.SchemaCacheError import Protolude -data SchemaCacheError - = AmbiguousRelBetween Text Text [Relationship] - | AmbiguousRpc [Routine] - | NoRelBetween Text Text (Maybe Text) Text RelationshipsMap - | NoRpc Text Text [Text] MediaType Bool [QualifiedIdentifier] [Routine] - | ColumnNotFound Text Text - | TableNotFound Text Text [Table] - deriving Show - -instance PgrstError SchemaCacheError where - status AmbiguousRelBetween{} = HTTP.status300 - status AmbiguousRpc{} = HTTP.status300 - status NoRelBetween{} = HTTP.status400 - status NoRpc{} = HTTP.status404 - status ColumnNotFound{} = HTTP.status400 - status TableNotFound{} = HTTP.status404 - - headers _ = mempty - -instance ErrorBody SchemaCacheError where - code NoRelBetween{} = "PGRST200" - code AmbiguousRelBetween{} = "PGRST201" - code NoRpc{} = "PGRST202" - code AmbiguousRpc{} = "PGRST203" - code ColumnNotFound{} = "PGRST204" - code TableNotFound{} = "PGRST205" - - message (NoRelBetween parent child _ _ _) = "Could not find a relationship between '" <> parent <> "' and '" <> child <> "' in the schema cache" - message (AmbiguousRelBetween parent child _) = "Could not embed because more than one relationship was found for '" <> parent <> "' and '" <> child <> "'" - message (NoRpc schema procName argumentKeys contentType isInvPost _ _) = "Could not find the function " <> func <> (if onlySingleParams then "" else fmtPrms prmsMsg) <> " in the schema cache" - where - onlySingleParams = isInvPost && contentType `elem` [MTTextPlain, MTTextXML, MTOctetStream] - func = schema <> "." <> procName - prms = T.intercalate ", " argumentKeys - prmsMsg = "(" <> prms <> ")" - fmtPrms p = if null argumentKeys then " without parameters" else p - message (AmbiguousRpc procs) = "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] - message (ColumnNotFound rel col) = "Could not find the '" <> col <> "' column of '" <> rel <> "' in the schema cache" - message (TableNotFound schemaName relName _) = "Could not find the table '" <> schemaName <> "." <> relName <> "' in the schema cache" - - details (NoRelBetween parent child embedHint schema _) = 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." - details (AmbiguousRelBetween _ _ rels) = Just $ JSON.toJSONList (compressedRel <$> rels) - details (NoRpc schema procName argumentKeys contentType isInvPost _ _) = - Just $ JSON.String $ "Searched for the function " <> func <> - (case (isInvPost, contentType) of - (True, MTTextPlain) -> " with a single unnamed text parameter" - (True, MTTextXML) -> " with a single unnamed xml parameter" - (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." - where - func = schema <> "." <> procName - prms = T.intercalate ", " argumentKeys - prmsDet = " with parameter" <> (if length argumentKeys > 1 then "s " else " ") <> prms - fmtPrms p = if null argumentKeys then " without parameters" else p - - details _ = Nothing - - hint (NoRelBetween parent child _ schema allRels) = JSON.String <$> noRelBetweenHint parent child schema allRels - hint (AmbiguousRelBetween _ child rels) = Just $ JSON.String $ "Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key." - -- The hint will be null in the case of single unnamed parameter functions - hint (NoRpc schema procName argumentKeys contentType isInvPost allProcs overloadedProcs) = - if onlySingleParams - then Nothing - else JSON.String <$> noRpcHint schema procName argumentKeys allProcs overloadedProcs - where - onlySingleParams = isInvPost && contentType `elem` [MTTextPlain, MTTextXML, MTOctetStream] - hint (AmbiguousRpc _) = Just "Try renaming the parameters or the function itself in the database so function overloading can be resolved" - hint (TableNotFound schemaName relName tbls) = JSON.String <$> tableNotFoundHint schemaName relName tbls - - hint _ = Nothing - -instance JSON.ToJSON SchemaCacheError where - toJSON err = toJsonPgrstError - (code err) (message err) (details err) (hint err) - --- | --- If no relationship is found then: --- --- Looks for parent suggestions if parent not found --- Looks for child suggestions if parent is found but child is not --- Gives no suggestions if both are found (it means that there is a problem with the embed hint) --- --- >>> :set -Wno-missing-fields --- >>> let qi t = QualifiedIdentifier "api" t --- >>> let rel ft = Relationship{relForeignTable = qi ft} --- >>> let rels = HM.fromList [((qi "films", "api"), [rel "directors", rel "roles", rel "actors"])] --- --- >>> noRelBetweenHint "film" "directors" "api" rels --- Just "Perhaps you meant 'films' instead of 'film'." --- --- >>> noRelBetweenHint "films" "role" "api" rels --- Just "Perhaps you meant 'roles' instead of 'role'." --- --- >>> noRelBetweenHint "films" "role" "api" rels --- Just "Perhaps you meant 'roles' instead of 'role'." --- --- >>> noRelBetweenHint "films" "actors" "api" rels --- Nothing --- --- >>> noRelBetweenHint "noclosealternative" "roles" "api" rels --- Nothing --- --- >>> noRelBetweenHint "films" "noclosealternative" "api" rels --- Nothing --- --- >>> noRelBetweenHint "films" "noclosealternative" "noclosealternative" rels --- Nothing --- -noRelBetweenHint :: Text -> Text -> Schema -> RelationshipsMap -> Maybe Text -noRelBetweenHint parent child schema allRels = ("Perhaps you meant '" <>) <$> - if isJust findParent - then (<> "' instead of '" <> child <> "'.") <$> suggestChild - else (<> "' instead of '" <> parent <> "'.") <$> suggestParent - where - findParent = HM.lookup (QualifiedIdentifier schema parent, schema) allRels - fuzzySetOfParents = Fuzzy.fromList [qiName (fst p) | p <- HM.keys allRels, snd p == schema] - fuzzySetOfChildren = Fuzzy.fromList [qiName (relForeignTable c) | c <- fromMaybe [] findParent] - suggestParent = Fuzzy.getOne fuzzySetOfParents parent - -- Do not give suggestion if the child is found in the relations (weight = 1.0) - suggestChild = headMay [snd k | k <- Fuzzy.get fuzzySetOfChildren child, fst k < 1.0] - --- | --- If no function is found with the given name, it does a fuzzy search to all the functions --- in the same schema and shows the best match as hint. --- --- >>> :set -Wno-missing-fields --- >>> let procs = [(QualifiedIdentifier "api" "test"), (QualifiedIdentifier "api" "another"), (QualifiedIdentifier "private" "other")] --- --- >>> noRpcHint "api" "testt" ["val", "param", "name"] procs [] --- Just "Perhaps you meant to call the function api.test" --- --- >>> noRpcHint "api" "other" [] procs [] --- Just "Perhaps you meant to call the function api.another" --- --- >>> noRpcHint "api" "noclosealternative" [] procs [] --- Nothing --- --- If a function is found with the given name, but no params match, then it does a fuzzy search --- to all the overloaded functions' params using the form "param1, param2, param3, ..." --- and shows the best match as hint. --- --- >>> let procsDesc = [Function {pdParams = [RoutineParam {ppName="val"}, RoutineParam {ppName="param"}, RoutineParam {ppName="name"}]}, Function {pdParams = [RoutineParam {ppName="id"}, RoutineParam {ppName="attr"}]}] --- --- >>> noRpcHint "api" "test" ["vall", "pqaram", "nam"] procs procsDesc --- Just "Perhaps you meant to call the function api.test(name, param, val)" --- --- >>> noRpcHint "api" "test" ["val", "param"] procs procsDesc --- Just "Perhaps you meant to call the function api.test(name, param, val)" --- --- >>> noRpcHint "api" "test" ["id", "attrs"] procs procsDesc --- Just "Perhaps you meant to call the function api.test(attr, id)" --- --- >>> noRpcHint "api" "test" ["id"] procs procsDesc --- Just "Perhaps you meant to call the function api.test(attr, id)" --- --- >>> noRpcHint "api" "test" ["noclosealternative"] procs procsDesc --- Nothing --- -noRpcHint :: Text -> Text -> [Text] -> [QualifiedIdentifier] -> [Routine] -> Maybe Text -noRpcHint schema procName params allProcs overloadedProcs = - fmap (("Perhaps you meant to call the function " <> schema <> ".") <>) possibleProcs - where - fuzzySetOfProcs = Fuzzy.fromList [qiName k | k <- allProcs, qiSchema k == schema] - fuzzySetOfParams = Fuzzy.fromList $ listToText <$> [[ppName prm | prm <- pdParams ov] | ov <- overloadedProcs] - -- Cannot do a fuzzy search like: Fuzzy.getOne [[Text]] [Text], where [[Text]] is the list of params for each - -- overloaded function and [Text] the given params. This converts those lists to text to make fuzzy search possible. - -- E.g. ["val", "param", "name"] into "(name, param, val)" - listToText = ("(" <>) . (<> ")") . T.intercalate ", " . sort - possibleProcs - | null overloadedProcs = Fuzzy.getOne fuzzySetOfProcs procName - | otherwise = (procName <>) <$> Fuzzy.getOne fuzzySetOfParams (listToText params) - --- | --- Do a fuzzy search in all tables in the same schema and return closest result -tableNotFoundHint :: Text -> Text -> [Table] -> Maybe Text -tableNotFoundHint schema tblName tblList - = fmap (\tbl -> "Perhaps you meant the table '" <> schema <> "." <> tbl <> "'") perhapsTable - where - perhapsTable = Fuzzy.getOne fuzzyTableSet tblName - fuzzyTableSet = Fuzzy.fromList [ tableName tbl | tbl <- tblList, tableSchema tbl == schema] - - -compressedRel :: Relationship -> JSON.Value --- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed -compressedRel ComputedRelationship{} = JSON.object mempty -compressedRel Relationship{..} = - let - fmtEls els = "(" <> T.intercalate ", " els <> ")" - in - JSON.object $ - ("embedding" .= (qiName relTable <> " with " <> qiName relForeignTable :: Text)) - : case relCardinality of - M2M Junction{..} -> [ - "cardinality" .= ("many-to-many" :: Text) - , "relationship" .= (qiName junTable <> " using " <> junConstraint1 <> fmtEls (snd <$> junColsSource) <> " and " <> junConstraint2 <> fmtEls (snd <$> junColsTarget)) - ] - M2O cons relColumns -> [ - "cardinality" .= ("many-to-one" :: Text) - , "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns)) - ] - O2O cons relColumns _ -> [ - "cardinality" .= ("one-to-one" :: Text) - , "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns)) - ] - O2M cons relColumns -> [ - "cardinality" .= ("one-to-many" :: Text) - , "relationship" .= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns)) - ] - -relHint :: [Relationship] -> Text -relHint rels = T.intercalate ", " (hintList <$> rels) - where - hintList Relationship{..} = - let buildHint rel = "'" <> qiName relForeignTable <> "!" <> rel <> "'" in - case relCardinality of - M2M Junction{..} -> buildHint (qiName junTable) - M2O cons _ -> buildHint cons - O2O cons _ _ -> buildHint cons - O2M cons _ -> buildHint cons - -- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed - hintList ComputedRelationship{} = mempty data PgError = PgError Authenticated SQL.UsageError deriving Show diff --git a/src/PostgREST/Error/SchemaCacheError.hs b/src/PostgREST/Error/SchemaCacheError.hs new file mode 100644 index 0000000000..f5b9489191 --- /dev/null +++ b/src/PostgREST/Error/SchemaCacheError.hs @@ -0,0 +1,246 @@ +{-# LANGUAGE RecordWildCards #-} +module PostgREST.Error.SchemaCacheError + ( SchemaCacheError (..), + ) where + +import qualified Data.Aeson as JSON +import qualified Data.FuzzySet as Fuzzy +import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T +import qualified Network.HTTP.Types.Status as HTTP + +import PostgREST.MediaType (MediaType (..)) +import PostgREST.SchemaCache.Identifiers (QualifiedIdentifier (..), + Schema) +import PostgREST.SchemaCache.Relationship (Cardinality (..), + Junction (..), + Relationship (..), + RelationshipsMap) +import PostgREST.SchemaCache.Routine (Routine (..), + RoutineParam (..)) +import PostgREST.SchemaCache.Table (Table (..)) +import PostgREST.Error.Algebra +import Protolude + +data SchemaCacheError + = AmbiguousRelBetween Text Text [Relationship] + | AmbiguousRpc [Routine] + | NoRelBetween Text Text (Maybe Text) Text RelationshipsMap + | NoRpc Text Text [Text] MediaType Bool [QualifiedIdentifier] [Routine] + | ColumnNotFound Text Text + | TableNotFound Text Text [Table] + deriving Show + +instance PgrstError SchemaCacheError where + status AmbiguousRelBetween{} = HTTP.status300 + status AmbiguousRpc{} = HTTP.status300 + status NoRelBetween{} = HTTP.status400 + status NoRpc{} = HTTP.status404 + status ColumnNotFound{} = HTTP.status400 + status TableNotFound{} = HTTP.status404 + + headers _ = mempty + +instance ErrorBody SchemaCacheError where + code NoRelBetween{} = "PGRST200" + code AmbiguousRelBetween{} = "PGRST201" + code NoRpc{} = "PGRST202" + code AmbiguousRpc{} = "PGRST203" + code ColumnNotFound{} = "PGRST204" + code TableNotFound{} = "PGRST205" + + message (NoRelBetween parent child _ _ _) = "Could not find a relationship between '" <> parent <> "' and '" <> child <> "' in the schema cache" + message (AmbiguousRelBetween parent child _) = "Could not embed because more than one relationship was found for '" <> parent <> "' and '" <> child <> "'" + message (NoRpc schema procName argumentKeys contentType isInvPost _ _) = "Could not find the function " <> func <> (if onlySingleParams then "" else fmtPrms prmsMsg) <> " in the schema cache" + where + onlySingleParams = isInvPost && contentType `elem` [MTTextPlain, MTTextXML, MTOctetStream] + func = schema <> "." <> procName + prms = T.intercalate ", " argumentKeys + prmsMsg = "(" <> prms <> ")" + fmtPrms p = if null argumentKeys then " without parameters" else p + message (AmbiguousRpc procs) = "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] + message (ColumnNotFound rel col) = "Could not find the '" <> col <> "' column of '" <> rel <> "' in the schema cache" + message (TableNotFound schemaName relName _) = "Could not find the table '" <> schemaName <> "." <> relName <> "' in the schema cache" + + details (NoRelBetween parent child embedHint schema _) = 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." + details (AmbiguousRelBetween _ _ rels) = Just $ JSON.toJSONList (compressedRel <$> rels) + details (NoRpc schema procName argumentKeys contentType isInvPost _ _) = + Just $ JSON.String $ "Searched for the function " <> func <> + (case (isInvPost, contentType) of + (True, MTTextPlain) -> " with a single unnamed text parameter" + (True, MTTextXML) -> " with a single unnamed xml parameter" + (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." + where + func = schema <> "." <> procName + prms = T.intercalate ", " argumentKeys + prmsDet = " with parameter" <> (if length argumentKeys > 1 then "s " else " ") <> prms + fmtPrms p = if null argumentKeys then " without parameters" else p + + details _ = Nothing + + hint (NoRelBetween parent child _ schema allRels) = JSON.String <$> noRelBetweenHint parent child schema allRels + hint (AmbiguousRelBetween _ child rels) = Just $ JSON.String $ "Try changing '" <> child <> "' to one of the following: " <> relHint rels <> ". Find the desired relationship in the 'details' key." + -- The hint will be null in the case of single unnamed parameter functions + hint (NoRpc schema procName argumentKeys contentType isInvPost allProcs overloadedProcs) = + if onlySingleParams + then Nothing + else JSON.String <$> noRpcHint schema procName argumentKeys allProcs overloadedProcs + where + onlySingleParams = isInvPost && contentType `elem` [MTTextPlain, MTTextXML, MTOctetStream] + hint (AmbiguousRpc _) = Just "Try renaming the parameters or the function itself in the database so function overloading can be resolved" + hint (TableNotFound schemaName relName tbls) = JSON.String <$> tableNotFoundHint schemaName relName tbls + + hint _ = Nothing + +instance JSON.ToJSON SchemaCacheError where + toJSON err = toJsonPgrstError + (code err) (message err) (details err) (hint err) + +-- | +-- Do a fuzzy search in all tables in the same schema and return closest result +tableNotFoundHint :: Text -> Text -> [Table] -> Maybe Text +tableNotFoundHint schema tblName tblList + = fmap (\tbl -> "Perhaps you meant the table '" <> schema <> "." <> tbl <> "'") perhapsTable + where + perhapsTable = Fuzzy.getOne fuzzyTableSet tblName + fuzzyTableSet = Fuzzy.fromList [ tableName tbl | tbl <- tblList, tableSchema tbl == schema] + +-- | +-- If no function is found with the given name, it does a fuzzy search to all the functions +-- in the same schema and shows the best match as hint. +-- +-- >>> :set -Wno-missing-fields +-- >>> let procs = [(QualifiedIdentifier "api" "test"), (QualifiedIdentifier "api" "another"), (QualifiedIdentifier "private" "other")] +-- +-- >>> noRpcHint "api" "testt" ["val", "param", "name"] procs [] +-- Just "Perhaps you meant to call the function api.test" +-- +-- >>> noRpcHint "api" "other" [] procs [] +-- Just "Perhaps you meant to call the function api.another" +-- +-- >>> noRpcHint "api" "noclosealternative" [] procs [] +-- Nothing +-- +-- If a function is found with the given name, but no params match, then it does a fuzzy search +-- to all the overloaded functions' params using the form "param1, param2, param3, ..." +-- and shows the best match as hint. +-- +-- >>> let procsDesc = [Function {pdParams = [RoutineParam {ppName="val"}, RoutineParam {ppName="param"}, RoutineParam {ppName="name"}]}, Function {pdParams = [RoutineParam {ppName="id"}, RoutineParam {ppName="attr"}]}] +-- +-- >>> noRpcHint "api" "test" ["vall", "pqaram", "nam"] procs procsDesc +-- Just "Perhaps you meant to call the function api.test(name, param, val)" +-- +-- >>> noRpcHint "api" "test" ["val", "param"] procs procsDesc +-- Just "Perhaps you meant to call the function api.test(name, param, val)" +-- +-- >>> noRpcHint "api" "test" ["id", "attrs"] procs procsDesc +-- Just "Perhaps you meant to call the function api.test(attr, id)" +-- +-- >>> noRpcHint "api" "test" ["id"] procs procsDesc +-- Just "Perhaps you meant to call the function api.test(attr, id)" +-- +-- >>> noRpcHint "api" "test" ["noclosealternative"] procs procsDesc +-- Nothing +-- +noRpcHint :: Text -> Text -> [Text] -> [QualifiedIdentifier] -> [Routine] -> Maybe Text +noRpcHint schema procName params allProcs overloadedProcs = + fmap (("Perhaps you meant to call the function " <> schema <> ".") <>) possibleProcs + where + fuzzySetOfProcs = Fuzzy.fromList [qiName k | k <- allProcs, qiSchema k == schema] + fuzzySetOfParams = Fuzzy.fromList $ listToText <$> [[ppName prm | prm <- pdParams ov] | ov <- overloadedProcs] + -- Cannot do a fuzzy search like: Fuzzy.getOne [[Text]] [Text], where [[Text]] is the list of params for each + -- overloaded function and [Text] the given params. This converts those lists to text to make fuzzy search possible. + -- E.g. ["val", "param", "name"] into "(name, param, val)" + listToText = ("(" <>) . (<> ")") . T.intercalate ", " . sort + possibleProcs + | null overloadedProcs = Fuzzy.getOne fuzzySetOfProcs procName + | otherwise = (procName <>) <$> Fuzzy.getOne fuzzySetOfParams (listToText params) + +relHint :: [Relationship] -> Text +relHint rels = T.intercalate ", " (hintList <$> rels) + where + hintList Relationship{..} = + let buildHint rel = "'" <> qiName relForeignTable <> "!" <> rel <> "'" in + case relCardinality of + M2M Junction{..} -> buildHint (qiName junTable) + M2O cons _ -> buildHint cons + O2O cons _ _ -> buildHint cons + O2M cons _ -> buildHint cons + -- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed + hintList ComputedRelationship{} = mempty + +-- | +-- If no relationship is found then: +-- +-- Looks for parent suggestions if parent not found +-- Looks for child suggestions if parent is found but child is not +-- Gives no suggestions if both are found (it means that there is a problem with the embed hint) +-- +-- >>> :set -Wno-missing-fields +-- >>> let qi t = QualifiedIdentifier "api" t +-- >>> let rel ft = Relationship{relForeignTable = qi ft} +-- >>> let rels = HM.fromList [((qi "films", "api"), [rel "directors", rel "roles", rel "actors"])] +-- +-- >>> noRelBetweenHint "film" "directors" "api" rels +-- Just "Perhaps you meant 'films' instead of 'film'." +-- +-- >>> noRelBetweenHint "films" "role" "api" rels +-- Just "Perhaps you meant 'roles' instead of 'role'." +-- +-- >>> noRelBetweenHint "films" "role" "api" rels +-- Just "Perhaps you meant 'roles' instead of 'role'." +-- +-- >>> noRelBetweenHint "films" "actors" "api" rels +-- Nothing +-- +-- >>> noRelBetweenHint "noclosealternative" "roles" "api" rels +-- Nothing +-- +-- >>> noRelBetweenHint "films" "noclosealternative" "api" rels +-- Nothing +-- +-- >>> noRelBetweenHint "films" "noclosealternative" "noclosealternative" rels +-- Nothing +-- +noRelBetweenHint :: Text -> Text -> Schema -> RelationshipsMap -> Maybe Text +noRelBetweenHint parent child schema allRels = ("Perhaps you meant '" <>) <$> + if isJust findParent + then (<> "' instead of '" <> child <> "'.") <$> suggestChild + else (<> "' instead of '" <> parent <> "'.") <$> suggestParent + where + findParent = HM.lookup (QualifiedIdentifier schema parent, schema) allRels + fuzzySetOfParents = Fuzzy.fromList [qiName (fst p) | p <- HM.keys allRels, snd p == schema] + fuzzySetOfChildren = Fuzzy.fromList [qiName (relForeignTable c) | c <- fromMaybe [] findParent] + suggestParent = Fuzzy.getOne fuzzySetOfParents parent + -- Do not give suggestion if the child is found in the relations (weight = 1.0) + suggestChild = headMay [snd k | k <- Fuzzy.get fuzzySetOfChildren child, fst k < 1.0] + +compressedRel :: Relationship -> JSON.Value +-- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed +compressedRel ComputedRelationship{} = JSON.object mempty +compressedRel Relationship{..} = + let + fmtEls els = "(" <> T.intercalate ", " els <> ")" + in + JSON.object $ + ("embedding" JSON..= (qiName relTable <> " with " <> qiName relForeignTable :: Text)) + : case relCardinality of + M2M Junction{..} -> [ + "cardinality" JSON..= ("many-to-many" :: Text) + , "relationship" JSON..= (qiName junTable <> " using " <> junConstraint1 <> fmtEls (snd <$> junColsSource) <> " and " <> junConstraint2 <> fmtEls (snd <$> junColsTarget)) + ] + M2O cons relColumns -> [ + "cardinality" JSON..= ("many-to-one" :: Text) + , "relationship" JSON..= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns)) + ] + O2O cons relColumns _ -> [ + "cardinality" JSON..= ("one-to-one" :: Text) + , "relationship" JSON..= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns)) + ] + O2M cons relColumns -> [ + "cardinality" JSON..= ("one-to-many" :: Text) + , "relationship" JSON..= (cons <> " using " <> qiName relTable <> fmtEls (fst <$> relColumns) <> " and " <> qiName relForeignTable <> fmtEls (snd <$> relColumns)) + ] From 03d5398418f4c5fe49b59deed1547b8f63cede5c Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 18:34:21 +0300 Subject: [PATCH 05/19] Isolate parseRaisePGRST, PgRaiseErrMessage and PgRaiseErrDetails --- src/PostgREST/Error.hs | 41 ----------------------- src/PostgREST/Error/ApiRequestError.hs | 45 ++++++++++++++++++++++++++ 2 files changed, 45 insertions(+), 41 deletions(-) diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 95b9880b14..02cf72c674 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -29,7 +29,6 @@ import qualified Hasql.Pool as SQL import qualified Hasql.Session as SQL import qualified Network.HTTP.Types.Status as HTTP -import Data.Aeson ((.:), (.:?)) import Network.HTTP.Types.Header (Header) import PostgREST.Error.Algebra import PostgREST.Error.ApiRequestError @@ -326,43 +325,3 @@ invalidTokenHeader m = requiredTokenHeader :: Header requiredTokenHeader = ("WWW-Authenticate", "Bearer") - --- For parsing byteString to JSON Object, used for allowing full response control -data PgRaiseErrMessage = PgRaiseErrMessage { - getCode :: Text, - getMessage :: Text, - getDetails :: Maybe Text, - getHint :: Maybe Text -} - -data PgRaiseErrDetails = PgRaiseErrDetails { - getStatus :: Int, - getStatusText :: Maybe Text, - getHeaders :: Map Text Text -} - -instance JSON.FromJSON PgRaiseErrMessage where - parseJSON (JSON.Object m) = - PgRaiseErrMessage - <$> m .: "code" - <*> m .: "message" - <*> m .:? "details" - <*> m .:? "hint" - - parseJSON _ = mzero - -instance JSON.FromJSON PgRaiseErrDetails where - parseJSON (JSON.Object d) = - PgRaiseErrDetails - <$> d .: "status" - <*> d .:? "status_text" - <*> d .: "headers" - - parseJSON _ = mzero - -parseRaisePGRST :: ByteString -> Maybe ByteString -> Either ApiRequestError (PgRaiseErrMessage, PgRaiseErrDetails) -parseRaisePGRST m d = do - msgJson <- maybeToRight (PGRSTParseError $ MsgParseError m) (JSON.decodeStrict m) - det <- maybeToRight (PGRSTParseError NoDetail) d - detJson <- maybeToRight (PGRSTParseError $ DetParseError det) (JSON.decodeStrict det) - return (msgJson, detJson) diff --git a/src/PostgREST/Error/ApiRequestError.hs b/src/PostgREST/Error/ApiRequestError.hs index 3469f3bac1..8cdb70801e 100644 --- a/src/PostgREST/Error/ApiRequestError.hs +++ b/src/PostgREST/Error/ApiRequestError.hs @@ -3,6 +3,9 @@ module PostgREST.Error.ApiRequestError QPError(..), RaiseError(..), RangeError(..), + PgRaiseErrMessage(..), + PgRaiseErrDetails(..), + parseRaisePGRST, ) where import qualified Data.Aeson as JSON @@ -194,3 +197,45 @@ pgrstParseErrorDetails err = case err of MsgParseError m -> "Invalid JSON value for MESSAGE: '" <> T.decodeUtf8 m <> "'" DetParseError d -> "Invalid JSON value for DETAIL: '" <> T.decodeUtf8 d <> "'" NoDetail -> "DETAIL is missing in the RAISE statement" + + + +-- For parsing byteString to JSON Object, used for allowing full response control +data PgRaiseErrMessage = PgRaiseErrMessage { + getCode :: Text, + getMessage :: Text, + getDetails :: Maybe Text, + getHint :: Maybe Text +} + +instance JSON.FromJSON PgRaiseErrMessage where + parseJSON (JSON.Object m) = + PgRaiseErrMessage + <$> m JSON..: "code" + <*> m JSON..: "message" + <*> m JSON..:? "details" + <*> m JSON..:? "hint" + + parseJSON _ = mzero + +data PgRaiseErrDetails = PgRaiseErrDetails { + getStatus :: Int, + getStatusText :: Maybe Text, + getHeaders :: Map Text Text +} + +instance JSON.FromJSON PgRaiseErrDetails where + parseJSON (JSON.Object d) = + PgRaiseErrDetails + <$> d JSON..: "status" + <*> d JSON..:? "status_text" + <*> d JSON..: "headers" + + parseJSON _ = mzero + +parseRaisePGRST :: ByteString -> Maybe ByteString -> Either ApiRequestError (PgRaiseErrMessage, PgRaiseErrDetails) +parseRaisePGRST m d = do + msgJson <- maybeToRight (PGRSTParseError $ MsgParseError m) (JSON.decodeStrict m) + det <- maybeToRight (PGRSTParseError NoDetail) d + detJson <- maybeToRight (PGRSTParseError $ DetParseError det) (JSON.decodeStrict det) + return (msgJson, detJson) From 48fec7ea6ad764fb2ad7656cce492d91958864b4 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 18:54:08 +0300 Subject: [PATCH 06/19] Clean up imports --- src/PostgREST/Error.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 02cf72c674..87cfc2e985 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -27,9 +27,8 @@ import qualified Data.Map.Internal as M import qualified Data.Text.Encoding as T import qualified Hasql.Pool as SQL import qualified Hasql.Session as SQL -import qualified Network.HTTP.Types.Status as HTTP +import qualified Network.HTTP.Types as HTTP -import Network.HTTP.Types.Header (Header) import PostgREST.Error.Algebra import PostgREST.Error.ApiRequestError import PostgREST.Error.SchemaCacheError @@ -53,10 +52,10 @@ instance PgrstError PgError where headers err = if status err == HTTP.status401 - then [("WWW-Authenticate", "Bearer") :: Header] + then [("WWW-Authenticate", "Bearer") :: HTTP.Header] else mempty -proxyStatusHeader :: Text -> Header +proxyStatusHeader :: Text -> HTTP.Header proxyStatusHeader code' = ("Proxy-Status", "PostgREST; error=" <> T.encodeUtf8 code') instance JSON.ToJSON PgError where @@ -319,9 +318,9 @@ instance ErrorBody JwtError where hint _ = Nothing -invalidTokenHeader :: Text -> Header +invalidTokenHeader :: Text -> HTTP.Header invalidTokenHeader m = ("WWW-Authenticate", "Bearer error=\"invalid_token\", " <> "error_description=" <> encodeUtf8 (show m)) -requiredTokenHeader :: Header +requiredTokenHeader :: HTTP.Header requiredTokenHeader = ("WWW-Authenticate", "Bearer") From f2f5330f7b3d497dd772edb2a72bb7e0f183bce8 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 19:11:37 +0300 Subject: [PATCH 07/19] Integrate ResultError --- .gitignore | 1 - postgrest.cabal | 1 + src/PostgREST/Error.hs | 108 ++++------------------------- src/PostgREST/Error/ResultError.hs | 106 ++++++++++++++++++++++++++++ 4 files changed, 122 insertions(+), 94 deletions(-) create mode 100644 src/PostgREST/Error/ResultError.hs diff --git a/.gitignore b/.gitignore index af81dde65d..9a34545196 100644 --- a/.gitignore +++ b/.gitignore @@ -13,7 +13,6 @@ site *#* .#* *.swp -result* dist-* postgrest.hp postgrest.prof diff --git a/postgrest.cabal b/postgrest.cabal index 6ff72ec81e..0510313b54 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -69,6 +69,7 @@ library PostgREST.Error.Algebra PostgREST.Error.ApiRequestError PostgREST.Error.SchemaCacheError + PostgREST.Error.ResultError PostgREST.Listener PostgREST.Logger PostgREST.MainTx diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 87cfc2e985..847d053d90 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -4,6 +4,7 @@ Description : PostgREST error HTTP responses -} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} module PostgREST.Error ( errorResponseFor @@ -20,14 +21,12 @@ module PostgREST.Error , status ) where -import qualified Data.Aeson as JSON -import qualified Data.ByteString.Char8 as BS -import qualified Data.CaseInsensitive as CI -import qualified Data.Map.Internal as M -import qualified Data.Text.Encoding as T -import qualified Hasql.Pool as SQL -import qualified Hasql.Session as SQL -import qualified Network.HTTP.Types as HTTP +import qualified Data.Aeson as JSON +import qualified Data.Text.Encoding as T +import qualified Hasql.Pool as SQL +import qualified Hasql.Session as SQL +import qualified Network.HTTP.Types as HTTP +import qualified PostgREST.Error.ResultError as ResultError import PostgREST.Error.Algebra import PostgREST.Error.ApiRequestError @@ -43,12 +42,8 @@ type Authenticated = Bool instance PgrstError PgError where status (PgError authed usageError) = pgErrorStatus authed usageError - headers (PgError _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError (SQL.ServerError "PGRST" m d _ _p))))) = - case parseRaisePGRST m d of - Right (_, r) -> map intoHeader (M.toList $ getHeaders r) - Left e -> headers e - where - intoHeader (k,v) = (CI.mk $ T.encodeUtf8 k, T.encodeUtf8 v) + headers (PgError _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError (ResultError.toHeaders -> Just matchingHeaders))))) = + matchingHeaders headers err = if status err == HTTP.status401 @@ -95,40 +90,17 @@ instance JSON.ToJSON SQL.CommandError where instance ErrorBody SQL.CommandError where -- Special error raised with code PGRST, to allow full response control - code (SQL.ResultError (SQL.ServerError "PGRST" m d _ _)) = - case parseRaisePGRST m d of - Right (r, _) -> getCode r - Left e -> code e - code (SQL.ResultError (SQL.ServerError c _ _ _ _)) = T.decodeUtf8 c - - code (SQL.ResultError _) = "PGRSTX00" -- Internal Error - + code (SQL.ResultError resultError) = code resultError code (SQL.ClientError _) = "PGRST001" - message (SQL.ResultError (SQL.ServerError "PGRST" m d _ _)) = - case parseRaisePGRST m d of - Right (r, _) -> getMessage r - Left e -> message e - message (SQL.ResultError (SQL.ServerError _ m _ _ _)) = T.decodeUtf8 m - message (SQL.ResultError resultError) = show resultError -- We never really return this error, because we kill pgrst thread early in App.hs + message (SQL.ResultError resultError) = message resultError message (SQL.ClientError _) = "Database client error. Retrying the connection." - details (SQL.ResultError (SQL.ServerError "PGRST" m d _ _)) = - case parseRaisePGRST m d of - Right (r, _) -> JSON.String <$> getDetails r - Left e -> details e - details (SQL.ResultError (SQL.ServerError _ _ d _ _)) = JSON.String . T.decodeUtf8 <$> d + details (SQL.ResultError resultError) = details resultError details (SQL.ClientError d) = JSON.String . T.decodeUtf8 <$> d - details _ = Nothing - - hint (SQL.ResultError (SQL.ServerError "PGRST" m d _ _p)) = - case parseRaisePGRST m d of - Right (r, _) -> JSON.String <$> getHint r - Left e -> hint e - hint (SQL.ResultError (SQL.ServerError _ _ _ h _)) = JSON.String . T.decodeUtf8 <$> h - - hint _ = Nothing + hint (SQL.ResultError resultError) = hint resultError + hint _ = Nothing pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status @@ -136,57 +108,7 @@ pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503 pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504 pgErrorStatus _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503 pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) = - case rError of - (SQL.ServerError c m d _ _) -> - case BS.unpack c of - '0':'8':_ -> HTTP.status503 -- pg connection err - '0':'9':_ -> HTTP.status500 -- triggered action exception - '0':'L':_ -> HTTP.status403 -- invalid grantor - '0':'P':_ -> HTTP.status403 -- invalid role specification - "23503" -> HTTP.status409 -- foreign_key_violation - "23505" -> HTTP.status409 -- unique_violation - "25006" -> HTTP.status405 -- read_only_sql_transaction - "21000" -> -- cardinality_violation - if BS.isSuffixOf "requires a WHERE clause" m - then HTTP.status400 -- special case for pg-safeupdate, which we consider as client error - else HTTP.status500 -- generic function or view server error, e.g. "more than one row returned by a subquery used as an expression" - "22023" -> -- invalid_parameter_value. Catch nonexistent role error, see https://github.com/PostgREST/postgrest/issues/3601 - if BS.isPrefixOf "role" m && BS.isSuffixOf "does not exist" m - then HTTP.status401 -- role in jwt does not exist - else HTTP.status400 - '2':'5':_ -> HTTP.status500 -- invalid tx state - '2':'8':_ -> HTTP.status403 -- invalid auth specification - '2':'D':_ -> HTTP.status500 -- invalid tx termination - '3':'8':_ -> HTTP.status500 -- external routine exception - '3':'9':_ -> HTTP.status500 -- external routine invocation - '3':'B':_ -> HTTP.status500 -- savepoint exception - '4':'0':_ -> HTTP.status500 -- tx rollback - "53400" -> HTTP.status500 -- config limit exceeded - '5':'3':_ -> HTTP.status503 -- insufficient resources - '5':'4':_ -> HTTP.status500 -- too complex - '5':'5':_ -> HTTP.status500 -- obj not on prereq state - "57P01" -> HTTP.status503 -- terminating connection due to administrator command - '5':'7':_ -> HTTP.status500 -- operator intervention - '5':'8':_ -> HTTP.status500 -- system error - 'F':'0':_ -> HTTP.status500 -- conf file error - 'H':'V':_ -> HTTP.status500 -- foreign data wrapper error - "P0001" -> HTTP.status400 -- default code for "raise" - 'P':'0':_ -> HTTP.status500 -- PL/pgSQL Error - 'X':'X':_ -> HTTP.status500 -- internal Error - "42883"-> if BS.isPrefixOf "function xmlagg(" m - then HTTP.status406 - else HTTP.status404 -- undefined function - "42P01" -> HTTP.status404 -- undefined table - "42P17" -> HTTP.status500 -- infinite recursion - "42501" -> if authed then HTTP.status403 else HTTP.status401 -- insufficient privilege - 'P':'T':n -> fromMaybe HTTP.status500 (HTTP.mkStatus <$> readMaybe n <*> pure m) - "PGRST" -> - case parseRaisePGRST m d of - Right (_, r) -> maybe (toEnum $ getStatus r) (HTTP.mkStatus (getStatus r) . T.encodeUtf8) (getStatusText r) - Left e -> status e - _ -> HTTP.status400 - - _ -> HTTP.status500 + ResultError.toHttpStatusByAuthed rError authed data Error diff --git a/src/PostgREST/Error/ResultError.hs b/src/PostgREST/Error/ResultError.hs new file mode 100644 index 0000000000..e9ada1f7ed --- /dev/null +++ b/src/PostgREST/Error/ResultError.hs @@ -0,0 +1,106 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module PostgREST.Error.ResultError where + +import qualified Data.Aeson as JSON +import qualified Data.ByteString.Char8 as BS +import qualified Data.CaseInsensitive as CI +import qualified Data.Map.Internal as M +import qualified Data.Text.Encoding as T +import qualified Hasql.Session as SQL +import qualified Network.HTTP.Types as HTTP + +import PostgREST.Error.Algebra +import PostgREST.Error.ApiRequestError +import Protolude + +instance ErrorBody SQL.ResultError where + -- Special error raised with code PGRST, to allow full response control + code (SQL.ServerError "PGRST" m d _ _) = + case parseRaisePGRST m d of + Right (r, _) -> getCode r + Left e -> code e + code (SQL.ServerError c _ _ _ _) = T.decodeUtf8 c + code _ = "PGRSTX00" -- Internal Error + + message (SQL.ServerError "PGRST" m d _ _) = + case parseRaisePGRST m d of + Right (r, _) -> getMessage r + Left e -> message e + message (SQL.ServerError _ m _ _ _) = T.decodeUtf8 m + message resultError = show resultError -- We never really return this error, because we kill pgrst thread early in App.hs + + details (SQL.ServerError "PGRST" m d _ _) = + case parseRaisePGRST m d of + Right (r, _) -> JSON.String <$> getDetails r + Left e -> details e + details (SQL.ServerError _ _ d _ _) = JSON.String . T.decodeUtf8 <$> d + details _ = Nothing + + hint (SQL.ServerError "PGRST" m d _ _p) = + case parseRaisePGRST m d of + Right (r, _) -> JSON.String <$> getHint r + Left e -> hint e + hint (SQL.ServerError _ _ _ h _) = JSON.String . T.decodeUtf8 <$> h + hint _ = Nothing + +toHttpStatusByAuthed :: SQL.ResultError -> Bool -> HTTP.Status +toHttpStatusByAuthed rError authed = case rError of + SQL.ServerError c m d _ _ -> + case BS.unpack c of + '0':'8':_ -> HTTP.status503 -- pg connection err + '0':'9':_ -> HTTP.status500 -- triggered action exception + '0':'L':_ -> HTTP.status403 -- invalid grantor + '0':'P':_ -> HTTP.status403 -- invalid role specification + "23503" -> HTTP.status409 -- foreign_key_violation + "23505" -> HTTP.status409 -- unique_violation + "25006" -> HTTP.status405 -- read_only_sql_transaction + "21000" -> -- cardinality_violation + if BS.isSuffixOf "requires a WHERE clause" m + then HTTP.status400 -- special case for pg-safeupdate, which we consider as client error + else HTTP.status500 -- generic function or view server error, e.g. "more than one row returned by a subquery used as an expression" + "22023" -> -- invalid_parameter_value. Catch nonexistent role error, see https://github.com/PostgREST/postgrest/issues/3601 + if BS.isPrefixOf "role" m && BS.isSuffixOf "does not exist" m + then HTTP.status401 -- role in jwt does not exist + else HTTP.status400 + '2':'5':_ -> HTTP.status500 -- invalid tx state + '2':'8':_ -> HTTP.status403 -- invalid auth specification + '2':'D':_ -> HTTP.status500 -- invalid tx termination + '3':'8':_ -> HTTP.status500 -- external routine exception + '3':'9':_ -> HTTP.status500 -- external routine invocation + '3':'B':_ -> HTTP.status500 -- savepoint exception + '4':'0':_ -> HTTP.status500 -- tx rollback + "53400" -> HTTP.status500 -- config limit exceeded + '5':'3':_ -> HTTP.status503 -- insufficient resources + '5':'4':_ -> HTTP.status500 -- too complex + '5':'5':_ -> HTTP.status500 -- obj not on prereq state + "57P01" -> HTTP.status503 -- terminating connection due to administrator command + '5':'7':_ -> HTTP.status500 -- operator intervention + '5':'8':_ -> HTTP.status500 -- system error + 'F':'0':_ -> HTTP.status500 -- conf file error + 'H':'V':_ -> HTTP.status500 -- foreign data wrapper error + "P0001" -> HTTP.status400 -- default code for "raise" + 'P':'0':_ -> HTTP.status500 -- PL/pgSQL Error + 'X':'X':_ -> HTTP.status500 -- internal Error + "42883"-> if BS.isPrefixOf "function xmlagg(" m + then HTTP.status406 + else HTTP.status404 -- undefined function + "42P01" -> HTTP.status404 -- undefined table + "42P17" -> HTTP.status500 -- infinite recursion + "42501" -> if authed then HTTP.status403 else HTTP.status401 -- insufficient privilege + 'P':'T':n -> fromMaybe HTTP.status500 (HTTP.mkStatus <$> readMaybe n <*> pure m) + "PGRST" -> + case parseRaisePGRST m d of + Right (_, r) -> maybe (toEnum $ getStatus r) (HTTP.mkStatus (getStatus r) . T.encodeUtf8) (getStatusText r) + Left e -> status e + _ -> HTTP.status400 + _ -> HTTP.status500 + +toHeaders :: SQL.ResultError -> Maybe [HTTP.Header] +toHeaders (SQL.ServerError "PGRST" m d _ _p) = + Just $ case parseRaisePGRST m d of + Right (_, r) -> map intoHeader (M.toList $ getHeaders r) + Left e -> headers e + where + intoHeader (k,v) = (CI.mk $ T.encodeUtf8 k, T.encodeUtf8 v) +toHeaders _ = Nothing From a64f307bef28dc87f87838bd93657c7b5f0f6822 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 20:53:49 +0300 Subject: [PATCH 08/19] Reorganize for better encapsulation --- src/PostgREST/Error/ApiRequestError.hs | 45 ------------------ src/PostgREST/Error/ResultError.hs | 63 ++++++++++++++++++++++---- 2 files changed, 54 insertions(+), 54 deletions(-) diff --git a/src/PostgREST/Error/ApiRequestError.hs b/src/PostgREST/Error/ApiRequestError.hs index 8cdb70801e..3469f3bac1 100644 --- a/src/PostgREST/Error/ApiRequestError.hs +++ b/src/PostgREST/Error/ApiRequestError.hs @@ -3,9 +3,6 @@ module PostgREST.Error.ApiRequestError QPError(..), RaiseError(..), RangeError(..), - PgRaiseErrMessage(..), - PgRaiseErrDetails(..), - parseRaisePGRST, ) where import qualified Data.Aeson as JSON @@ -197,45 +194,3 @@ pgrstParseErrorDetails err = case err of MsgParseError m -> "Invalid JSON value for MESSAGE: '" <> T.decodeUtf8 m <> "'" DetParseError d -> "Invalid JSON value for DETAIL: '" <> T.decodeUtf8 d <> "'" NoDetail -> "DETAIL is missing in the RAISE statement" - - - --- For parsing byteString to JSON Object, used for allowing full response control -data PgRaiseErrMessage = PgRaiseErrMessage { - getCode :: Text, - getMessage :: Text, - getDetails :: Maybe Text, - getHint :: Maybe Text -} - -instance JSON.FromJSON PgRaiseErrMessage where - parseJSON (JSON.Object m) = - PgRaiseErrMessage - <$> m JSON..: "code" - <*> m JSON..: "message" - <*> m JSON..:? "details" - <*> m JSON..:? "hint" - - parseJSON _ = mzero - -data PgRaiseErrDetails = PgRaiseErrDetails { - getStatus :: Int, - getStatusText :: Maybe Text, - getHeaders :: Map Text Text -} - -instance JSON.FromJSON PgRaiseErrDetails where - parseJSON (JSON.Object d) = - PgRaiseErrDetails - <$> d JSON..: "status" - <*> d JSON..:? "status_text" - <*> d JSON..: "headers" - - parseJSON _ = mzero - -parseRaisePGRST :: ByteString -> Maybe ByteString -> Either ApiRequestError (PgRaiseErrMessage, PgRaiseErrDetails) -parseRaisePGRST m d = do - msgJson <- maybeToRight (PGRSTParseError $ MsgParseError m) (JSON.decodeStrict m) - det <- maybeToRight (PGRSTParseError NoDetail) d - detJson <- maybeToRight (PGRSTParseError $ DetParseError det) (JSON.decodeStrict det) - return (msgJson, detJson) diff --git a/src/PostgREST/Error/ResultError.hs b/src/PostgREST/Error/ResultError.hs index e9ada1f7ed..7558d94d95 100644 --- a/src/PostgREST/Error/ResultError.hs +++ b/src/PostgREST/Error/ResultError.hs @@ -1,17 +1,20 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module PostgREST.Error.ResultError where +module PostgREST.Error.ResultError + ( toHttpStatusByAuthed, + toHeaders, + ) where -import qualified Data.Aeson as JSON -import qualified Data.ByteString.Char8 as BS -import qualified Data.CaseInsensitive as CI -import qualified Data.Map.Internal as M -import qualified Data.Text.Encoding as T -import qualified Hasql.Session as SQL -import qualified Network.HTTP.Types as HTTP +import qualified Data.Aeson as JSON +import qualified Data.ByteString.Char8 as BS +import qualified Data.CaseInsensitive as CI +import qualified Data.Map.Internal as M +import qualified Data.Text.Encoding as T +import qualified Hasql.Session as SQL +import qualified Network.HTTP.Types as HTTP +import qualified PostgREST.Error.ApiRequestError as ApiRequestError import PostgREST.Error.Algebra -import PostgREST.Error.ApiRequestError import Protolude instance ErrorBody SQL.ResultError where @@ -104,3 +107,45 @@ toHeaders (SQL.ServerError "PGRST" m d _ _p) = where intoHeader (k,v) = (CI.mk $ T.encodeUtf8 k, T.encodeUtf8 v) toHeaders _ = Nothing + +-- ** Helpers for parsing RAISE PGRST errors + +-- For parsing byteString to JSON Object, used for allowing full response control +data PgRaiseErrMessage = PgRaiseErrMessage { + getCode :: Text, + getMessage :: Text, + getDetails :: Maybe Text, + getHint :: Maybe Text +} + +instance JSON.FromJSON PgRaiseErrMessage where + parseJSON (JSON.Object m) = + PgRaiseErrMessage + <$> m JSON..: "code" + <*> m JSON..: "message" + <*> m JSON..:? "details" + <*> m JSON..:? "hint" + + parseJSON _ = mzero + +data PgRaiseErrDetails = PgRaiseErrDetails { + getStatus :: Int, + getStatusText :: Maybe Text, + getHeaders :: Map Text Text +} + +instance JSON.FromJSON PgRaiseErrDetails where + parseJSON (JSON.Object d) = + PgRaiseErrDetails + <$> d JSON..: "status" + <*> d JSON..:? "status_text" + <*> d JSON..: "headers" + + parseJSON _ = mzero + +parseRaisePGRST :: ByteString -> Maybe ByteString -> Either ApiRequestError.ApiRequestError (PgRaiseErrMessage, PgRaiseErrDetails) +parseRaisePGRST m d = do + msgJson <- maybeToRight (ApiRequestError.PGRSTParseError $ ApiRequestError.MsgParseError m) (JSON.decodeStrict m) + det <- maybeToRight (ApiRequestError.PGRSTParseError ApiRequestError.NoDetail) d + detJson <- maybeToRight (ApiRequestError.PGRSTParseError $ ApiRequestError.DetParseError det) (JSON.decodeStrict det) + return (msgJson, detJson) From 188c7662a7b865f065431c5e3f83c5b1616a11d8 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 21:07:46 +0300 Subject: [PATCH 09/19] Isolate RaisePgrst --- postgrest.cabal | 1 + src/PostgREST/Error/ResultError.hs | 68 ++++--------------- src/PostgREST/Error/ResultError/RaisePgrst.hs | 46 +++++++++++++ 3 files changed, 60 insertions(+), 55 deletions(-) create mode 100644 src/PostgREST/Error/ResultError/RaisePgrst.hs diff --git a/postgrest.cabal b/postgrest.cabal index 0510313b54..78cd34d0a2 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -70,6 +70,7 @@ library PostgREST.Error.ApiRequestError PostgREST.Error.SchemaCacheError PostgREST.Error.ResultError + PostgREST.Error.ResultError.RaisePgrst PostgREST.Listener PostgREST.Logger PostgREST.MainTx diff --git a/src/PostgREST/Error/ResultError.hs b/src/PostgREST/Error/ResultError.hs index 7558d94d95..0d630c4259 100644 --- a/src/PostgREST/Error/ResultError.hs +++ b/src/PostgREST/Error/ResultError.hs @@ -12,7 +12,7 @@ import qualified Data.Map.Internal as M import qualified Data.Text.Encoding as T import qualified Hasql.Session as SQL import qualified Network.HTTP.Types as HTTP -import qualified PostgREST.Error.ApiRequestError as ApiRequestError +import qualified PostgREST.Error.ResultError.RaisePgrst as RaisePgrst import PostgREST.Error.Algebra import Protolude @@ -20,29 +20,29 @@ import Protolude instance ErrorBody SQL.ResultError where -- Special error raised with code PGRST, to allow full response control code (SQL.ServerError "PGRST" m d _ _) = - case parseRaisePGRST m d of - Right (r, _) -> getCode r + case RaisePgrst.parseRaisePGRST m d of + Right (r, _) -> RaisePgrst.getCode r Left e -> code e code (SQL.ServerError c _ _ _ _) = T.decodeUtf8 c code _ = "PGRSTX00" -- Internal Error message (SQL.ServerError "PGRST" m d _ _) = - case parseRaisePGRST m d of - Right (r, _) -> getMessage r + case RaisePgrst.parseRaisePGRST m d of + Right (r, _) -> RaisePgrst.getMessage r Left e -> message e message (SQL.ServerError _ m _ _ _) = T.decodeUtf8 m message resultError = show resultError -- We never really return this error, because we kill pgrst thread early in App.hs details (SQL.ServerError "PGRST" m d _ _) = - case parseRaisePGRST m d of - Right (r, _) -> JSON.String <$> getDetails r + case RaisePgrst.parseRaisePGRST m d of + Right (r, _) -> JSON.String <$> RaisePgrst.getDetails r Left e -> details e details (SQL.ServerError _ _ d _ _) = JSON.String . T.decodeUtf8 <$> d details _ = Nothing hint (SQL.ServerError "PGRST" m d _ _p) = - case parseRaisePGRST m d of - Right (r, _) -> JSON.String <$> getHint r + case RaisePgrst.parseRaisePGRST m d of + Right (r, _) -> JSON.String <$> RaisePgrst.getHint r Left e -> hint e hint (SQL.ServerError _ _ _ h _) = JSON.String . T.decodeUtf8 <$> h hint _ = Nothing @@ -93,59 +93,17 @@ toHttpStatusByAuthed rError authed = case rError of "42501" -> if authed then HTTP.status403 else HTTP.status401 -- insufficient privilege 'P':'T':n -> fromMaybe HTTP.status500 (HTTP.mkStatus <$> readMaybe n <*> pure m) "PGRST" -> - case parseRaisePGRST m d of - Right (_, r) -> maybe (toEnum $ getStatus r) (HTTP.mkStatus (getStatus r) . T.encodeUtf8) (getStatusText r) + case RaisePgrst.parseRaisePGRST m d of + Right (_, r) -> maybe (toEnum $ RaisePgrst.getStatus r) (HTTP.mkStatus (RaisePgrst.getStatus r) . T.encodeUtf8) (RaisePgrst.getStatusText r) Left e -> status e _ -> HTTP.status400 _ -> HTTP.status500 toHeaders :: SQL.ResultError -> Maybe [HTTP.Header] toHeaders (SQL.ServerError "PGRST" m d _ _p) = - Just $ case parseRaisePGRST m d of - Right (_, r) -> map intoHeader (M.toList $ getHeaders r) + Just $ case RaisePgrst.parseRaisePGRST m d of + Right (_, r) -> map intoHeader (M.toList $ RaisePgrst.getHeaders r) Left e -> headers e where intoHeader (k,v) = (CI.mk $ T.encodeUtf8 k, T.encodeUtf8 v) toHeaders _ = Nothing - --- ** Helpers for parsing RAISE PGRST errors - --- For parsing byteString to JSON Object, used for allowing full response control -data PgRaiseErrMessage = PgRaiseErrMessage { - getCode :: Text, - getMessage :: Text, - getDetails :: Maybe Text, - getHint :: Maybe Text -} - -instance JSON.FromJSON PgRaiseErrMessage where - parseJSON (JSON.Object m) = - PgRaiseErrMessage - <$> m JSON..: "code" - <*> m JSON..: "message" - <*> m JSON..:? "details" - <*> m JSON..:? "hint" - - parseJSON _ = mzero - -data PgRaiseErrDetails = PgRaiseErrDetails { - getStatus :: Int, - getStatusText :: Maybe Text, - getHeaders :: Map Text Text -} - -instance JSON.FromJSON PgRaiseErrDetails where - parseJSON (JSON.Object d) = - PgRaiseErrDetails - <$> d JSON..: "status" - <*> d JSON..:? "status_text" - <*> d JSON..: "headers" - - parseJSON _ = mzero - -parseRaisePGRST :: ByteString -> Maybe ByteString -> Either ApiRequestError.ApiRequestError (PgRaiseErrMessage, PgRaiseErrDetails) -parseRaisePGRST m d = do - msgJson <- maybeToRight (ApiRequestError.PGRSTParseError $ ApiRequestError.MsgParseError m) (JSON.decodeStrict m) - det <- maybeToRight (ApiRequestError.PGRSTParseError ApiRequestError.NoDetail) d - detJson <- maybeToRight (ApiRequestError.PGRSTParseError $ ApiRequestError.DetParseError det) (JSON.decodeStrict det) - return (msgJson, detJson) diff --git a/src/PostgREST/Error/ResultError/RaisePgrst.hs b/src/PostgREST/Error/ResultError/RaisePgrst.hs new file mode 100644 index 0000000000..0e975d1856 --- /dev/null +++ b/src/PostgREST/Error/ResultError/RaisePgrst.hs @@ -0,0 +1,46 @@ +module PostgREST.Error.ResultError.RaisePgrst where + +import qualified Data.Aeson as JSON +import qualified PostgREST.Error.ApiRequestError as ApiRequestError +import Protolude + +-- For parsing byteString to JSON Object, used for allowing full response control +data PgRaiseErrMessage = PgRaiseErrMessage + { getCode :: Text, + getMessage :: Text, + getDetails :: Maybe Text, + getHint :: Maybe Text + } + +instance JSON.FromJSON PgRaiseErrMessage where + parseJSON (JSON.Object m) = + PgRaiseErrMessage + <$> m JSON..: "code" + <*> m JSON..: "message" + <*> m JSON..:? "details" + <*> m JSON..:? "hint" + parseJSON _ = mzero + +data PgRaiseErrDetails = PgRaiseErrDetails + { getStatus :: Int, + getStatusText :: Maybe Text, + getHeaders :: Map Text Text + } + +instance JSON.FromJSON PgRaiseErrDetails where + parseJSON (JSON.Object d) = + PgRaiseErrDetails + <$> d JSON..: "status" + <*> d JSON..:? "status_text" + <*> d JSON..: "headers" + parseJSON _ = mzero + +parseRaisePGRST :: + ByteString -> + Maybe ByteString -> + Either ApiRequestError.ApiRequestError (PgRaiseErrMessage, PgRaiseErrDetails) +parseRaisePGRST m d = do + msgJson <- maybeToRight (ApiRequestError.PGRSTParseError $ ApiRequestError.MsgParseError m) (JSON.decodeStrict m) + det <- maybeToRight (ApiRequestError.PGRSTParseError ApiRequestError.NoDetail) d + detJson <- maybeToRight (ApiRequestError.PGRSTParseError $ ApiRequestError.DetParseError det) (JSON.decodeStrict det) + return (msgJson, detJson) From 449aaf942881a09731b1d14a998cc2b6e80eb38a Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 21:18:10 +0300 Subject: [PATCH 10/19] Isolate CommandError --- postgrest.cabal | 1 + src/PostgREST/Error.hs | 19 +---------------- src/PostgREST/Error/CommandError.hs | 32 +++++++++++++++++++++++++++++ 3 files changed, 34 insertions(+), 18 deletions(-) create mode 100644 src/PostgREST/Error/CommandError.hs diff --git a/postgrest.cabal b/postgrest.cabal index 78cd34d0a2..72d929baf7 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -68,6 +68,7 @@ library PostgREST.Error PostgREST.Error.Algebra PostgREST.Error.ApiRequestError + PostgREST.Error.CommandError PostgREST.Error.SchemaCacheError PostgREST.Error.ResultError PostgREST.Error.ResultError.RaisePgrst diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 847d053d90..6ec1bbd87a 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -30,6 +30,7 @@ import qualified PostgREST.Error.ResultError as ResultError import PostgREST.Error.Algebra import PostgREST.Error.ApiRequestError +import PostgREST.Error.CommandError () import PostgREST.Error.SchemaCacheError import Protolude @@ -84,24 +85,6 @@ instance ErrorBody SQL.UsageError where hint (SQL.SessionUsageError (SQL.QueryError _ _ e)) = hint e hint SQL.AcquisitionTimeoutUsageError = Nothing -instance JSON.ToJSON SQL.CommandError where - toJSON err = toJsonPgrstError - (code err) (message err) (details err) (hint err) - -instance ErrorBody SQL.CommandError where - -- Special error raised with code PGRST, to allow full response control - code (SQL.ResultError resultError) = code resultError - code (SQL.ClientError _) = "PGRST001" - - message (SQL.ResultError resultError) = message resultError - message (SQL.ClientError _) = "Database client error. Retrying the connection." - - details (SQL.ResultError resultError) = details resultError - details (SQL.ClientError d) = JSON.String . T.decodeUtf8 <$> d - - hint (SQL.ResultError resultError) = hint resultError - hint _ = Nothing - pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503 diff --git a/src/PostgREST/Error/CommandError.hs b/src/PostgREST/Error/CommandError.hs new file mode 100644 index 0000000000..68dda6ae36 --- /dev/null +++ b/src/PostgREST/Error/CommandError.hs @@ -0,0 +1,32 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module PostgREST.Error.CommandError where + +import qualified Data.Aeson as JSON +import qualified Data.Text.Encoding as T +import qualified Hasql.Session as SQL +import PostgREST.Error.Algebra +import PostgREST.Error.ResultError () +import Protolude + +instance JSON.ToJSON SQL.CommandError where + toJSON err = + toJsonPgrstError + (code err) + (message err) + (details err) + (hint err) + +instance ErrorBody SQL.CommandError where + -- Special error raised with code PGRST, to allow full response control + code (SQL.ResultError resultError) = code resultError + code (SQL.ClientError _) = "PGRST001" + + message (SQL.ResultError resultError) = message resultError + message (SQL.ClientError _) = "Database client error. Retrying the connection." + + details (SQL.ResultError resultError) = details resultError + details (SQL.ClientError d) = JSON.String . T.decodeUtf8 <$> d + + hint (SQL.ResultError resultError) = hint resultError + hint _ = Nothing From 90ae82204d233346cf74ad881ce6d884d21c4e5a Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 21:21:28 +0300 Subject: [PATCH 11/19] Isolate UsageError --- postgrest.cabal | 1 + src/PostgREST/Error.hs | 24 ++-------------------- src/PostgREST/Error/UsageError.hs | 34 +++++++++++++++++++++++++++++++ 3 files changed, 37 insertions(+), 22 deletions(-) create mode 100644 src/PostgREST/Error/UsageError.hs diff --git a/postgrest.cabal b/postgrest.cabal index 72d929baf7..bd52d6ae0c 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -72,6 +72,7 @@ library PostgREST.Error.SchemaCacheError PostgREST.Error.ResultError PostgREST.Error.ResultError.RaisePgrst + PostgREST.Error.UsageError PostgREST.Listener PostgREST.Logger PostgREST.MainTx diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 6ec1bbd87a..6d44eed2f3 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -31,7 +31,9 @@ import qualified PostgREST.Error.ResultError as ResultError import PostgREST.Error.Algebra import PostgREST.Error.ApiRequestError import PostgREST.Error.CommandError () +import PostgREST.Error.ResultError () import PostgREST.Error.SchemaCacheError +import PostgREST.Error.UsageError () import Protolude @@ -64,28 +66,6 @@ instance ErrorBody PgError where details (PgError _ usageError) = details usageError hint (PgError _ usageError) = hint usageError -instance JSON.ToJSON SQL.UsageError where - toJSON err = toJsonPgrstError - (code err) (message err) (details err) (hint err) - -instance ErrorBody SQL.UsageError where - code (SQL.ConnectionUsageError _) = "PGRST000" - code (SQL.SessionUsageError (SQL.QueryError _ _ e)) = code e - code SQL.AcquisitionTimeoutUsageError = "PGRST003" - - message (SQL.ConnectionUsageError _) = "Database connection error. Retrying the connection." - message (SQL.SessionUsageError (SQL.QueryError _ _ e)) = message e - message SQL.AcquisitionTimeoutUsageError = "Timed out acquiring connection from connection pool." - - details (SQL.ConnectionUsageError e) = JSON.String . T.decodeUtf8 <$> e - details (SQL.SessionUsageError (SQL.QueryError _ _ e)) = details e - details SQL.AcquisitionTimeoutUsageError = Nothing - - hint (SQL.ConnectionUsageError _) = Nothing - hint (SQL.SessionUsageError (SQL.QueryError _ _ e)) = hint e - hint SQL.AcquisitionTimeoutUsageError = Nothing - - pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503 pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504 diff --git a/src/PostgREST/Error/UsageError.hs b/src/PostgREST/Error/UsageError.hs new file mode 100644 index 0000000000..f8f9439e7a --- /dev/null +++ b/src/PostgREST/Error/UsageError.hs @@ -0,0 +1,34 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module PostgREST.Error.UsageError where + +import qualified Data.Aeson as JSON +import qualified Data.Text.Encoding as T +import qualified Hasql.Pool as SQL +import qualified Hasql.Session as SQL + +import PostgREST.Error.Algebra +import PostgREST.Error.CommandError () +import Protolude + + +instance JSON.ToJSON SQL.UsageError where + toJSON err = toJsonPgrstError + (code err) (message err) (details err) (hint err) + +instance ErrorBody SQL.UsageError where + code (SQL.ConnectionUsageError _) = "PGRST000" + code (SQL.SessionUsageError (SQL.QueryError _ _ e)) = code e + code SQL.AcquisitionTimeoutUsageError = "PGRST003" + + message (SQL.ConnectionUsageError _) = "Database connection error. Retrying the connection." + message (SQL.SessionUsageError (SQL.QueryError _ _ e)) = message e + message SQL.AcquisitionTimeoutUsageError = "Timed out acquiring connection from connection pool." + + details (SQL.ConnectionUsageError e) = JSON.String . T.decodeUtf8 <$> e + details (SQL.SessionUsageError (SQL.QueryError _ _ e)) = details e + details SQL.AcquisitionTimeoutUsageError = Nothing + + hint (SQL.ConnectionUsageError _) = Nothing + hint (SQL.SessionUsageError (SQL.QueryError _ _ e)) = hint e + hint SQL.AcquisitionTimeoutUsageError = Nothing From fecd0690ab2101a828c1316b04d83941b4d6526c Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 21:28:38 +0300 Subject: [PATCH 12/19] Extract PgError --- postgrest.cabal | 1 + src/PostgREST/Error.hs | 37 +----------------------- src/PostgREST/Error/PgError.hs | 53 ++++++++++++++++++++++++++++++++++ 3 files changed, 55 insertions(+), 36 deletions(-) create mode 100644 src/PostgREST/Error/PgError.hs diff --git a/postgrest.cabal b/postgrest.cabal index bd52d6ae0c..90bd049c3d 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -69,6 +69,7 @@ library PostgREST.Error.Algebra PostgREST.Error.ApiRequestError PostgREST.Error.CommandError + PostgREST.Error.PgError PostgREST.Error.SchemaCacheError PostgREST.Error.ResultError PostgREST.Error.ResultError.RaisePgrst diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 6d44eed2f3..2b5a9f6a0f 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -23,56 +23,21 @@ module PostgREST.Error import qualified Data.Aeson as JSON import qualified Data.Text.Encoding as T -import qualified Hasql.Pool as SQL -import qualified Hasql.Session as SQL import qualified Network.HTTP.Types as HTTP -import qualified PostgREST.Error.ResultError as ResultError import PostgREST.Error.Algebra import PostgREST.Error.ApiRequestError import PostgREST.Error.CommandError () +import PostgREST.Error.PgError import PostgREST.Error.ResultError () import PostgREST.Error.SchemaCacheError import PostgREST.Error.UsageError () import Protolude -data PgError = PgError Authenticated SQL.UsageError - deriving Show - -type Authenticated = Bool - -instance PgrstError PgError where - status (PgError authed usageError) = pgErrorStatus authed usageError - - headers (PgError _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError (ResultError.toHeaders -> Just matchingHeaders))))) = - matchingHeaders - - headers err = - if status err == HTTP.status401 - then [("WWW-Authenticate", "Bearer") :: HTTP.Header] - else mempty - proxyStatusHeader :: Text -> HTTP.Header proxyStatusHeader code' = ("Proxy-Status", "PostgREST; error=" <> T.encodeUtf8 code') -instance JSON.ToJSON PgError where - toJSON (PgError _ usageError) = toJsonPgrstError - (code usageError) (message usageError) (details usageError) (hint usageError) - -instance ErrorBody PgError where - code (PgError _ usageError) = code usageError - message (PgError _ usageError) = message usageError - details (PgError _ usageError) = details usageError - hint (PgError _ usageError) = hint usageError - -pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status -pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503 -pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504 -pgErrorStatus _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503 -pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) = - ResultError.toHttpStatusByAuthed rError authed - data Error = ApiRequestError ApiRequestError diff --git a/src/PostgREST/Error/PgError.hs b/src/PostgREST/Error/PgError.hs new file mode 100644 index 0000000000..e0b1a6c3e1 --- /dev/null +++ b/src/PostgREST/Error/PgError.hs @@ -0,0 +1,53 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +module PostgREST.Error.PgError + ( PgError(..), + Authenticated, + ) where + +import qualified Data.Aeson as JSON +import qualified Hasql.Pool as SQL +import qualified Hasql.Session as SQL +import qualified Network.HTTP.Types as HTTP +import qualified PostgREST.Error.ResultError as ResultError + +import PostgREST.Error.Algebra +import PostgREST.Error.CommandError () +import PostgREST.Error.ResultError () +import PostgREST.Error.UsageError () +import Protolude + +data PgError = PgError Authenticated SQL.UsageError + deriving Show + +type Authenticated = Bool + +instance PgrstError PgError where + status (PgError authed usageError) = pgErrorStatus authed usageError + + headers (PgError _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError (ResultError.toHeaders -> Just matchingHeaders))))) = + matchingHeaders + + headers err = + if status err == HTTP.status401 + then [("WWW-Authenticate", "Bearer") :: HTTP.Header] + else mempty + +instance JSON.ToJSON PgError where + toJSON (PgError _ usageError) = toJsonPgrstError + (code usageError) (message usageError) (details usageError) (hint usageError) + +instance ErrorBody PgError where + code (PgError _ usageError) = code usageError + message (PgError _ usageError) = message usageError + details (PgError _ usageError) = details usageError + hint (PgError _ usageError) = hint usageError + +pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status +pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503 +pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504 +pgErrorStatus _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503 +pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) = + ResultError.toHttpStatusByAuthed rError authed From bb1c9a62f1a3562d14e86d9a44206292bcc7d323 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 21:45:31 +0300 Subject: [PATCH 13/19] Isolate Error --- postgrest.cabal | 1 + src/PostgREST/Error.hs | 150 +-------------------------------- src/PostgREST/Error/Error.hs | 158 +++++++++++++++++++++++++++++++++++ 3 files changed, 160 insertions(+), 149 deletions(-) create mode 100644 src/PostgREST/Error/Error.hs diff --git a/postgrest.cabal b/postgrest.cabal index 90bd049c3d..33e29df812 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -69,6 +69,7 @@ library PostgREST.Error.Algebra PostgREST.Error.ApiRequestError PostgREST.Error.CommandError + PostgREST.Error.Error PostgREST.Error.PgError PostgREST.Error.SchemaCacheError PostgREST.Error.ResultError diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 2b5a9f6a0f..a52c581c3c 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -2,9 +2,6 @@ Module : PostgREST.Error Description : PostgREST error HTTP responses -} -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ViewPatterns #-} module PostgREST.Error ( errorResponseFor @@ -21,156 +18,11 @@ module PostgREST.Error , status ) where -import qualified Data.Aeson as JSON -import qualified Data.Text.Encoding as T -import qualified Network.HTTP.Types as HTTP - import PostgREST.Error.Algebra import PostgREST.Error.ApiRequestError import PostgREST.Error.CommandError () import PostgREST.Error.PgError +import PostgREST.Error.Error import PostgREST.Error.ResultError () import PostgREST.Error.SchemaCacheError import PostgREST.Error.UsageError () -import Protolude - - -proxyStatusHeader :: Text -> HTTP.Header -proxyStatusHeader code' = ("Proxy-Status", "PostgREST; error=" <> T.encodeUtf8 code') - - -data Error - = ApiRequestError ApiRequestError - | SchemaCacheErr SchemaCacheError - | JwtErr JwtError - | NoSchemaCacheError - | PgErr PgError - deriving Show - -data JwtError - = JwtDecodeErr JwtDecodeError - | JwtSecretMissing - | JwtTokenRequired - | JwtClaimsErr JwtClaimsError - deriving Show - -data JwtDecodeError - = EmptyAuthHeader - | UnexpectedParts Int - | KeyError Text - | BadAlgorithm Text - | BadCrypto - | UnsupportedTokenType - | UnreachableDecodeError - deriving Show - -data JwtClaimsError - = JWTExpired - | JWTNotYetValid - | JWTIssuedAtFuture - | JWTNotInAudience - | ParsingClaimsFailed - | ExpClaimNotNumber - | NbfClaimNotNumber - | IatClaimNotNumber - | AudClaimNotStringOrArray - deriving Show - -instance PgrstError Error where - status (ApiRequestError err) = status err - status (SchemaCacheErr err) = status err - status (JwtErr err) = status err - status NoSchemaCacheError = HTTP.status503 - status (PgErr err) = status err - - headers (ApiRequestError err) = proxyStatusHeader (code err) : headers err - headers (SchemaCacheErr err) = proxyStatusHeader (code err) : headers err - headers (JwtErr err) = proxyStatusHeader (code err) : headers err - headers (PgErr err) = proxyStatusHeader (code err) : headers err - headers err@NoSchemaCacheError = proxyStatusHeader (code err) : mempty - -instance JSON.ToJSON Error where - toJSON err = toJsonPgrstError - (code err) (message err) (details err) (hint err) - -instance ErrorBody Error where - code (ApiRequestError err) = code err - code (SchemaCacheErr err) = code err - code (JwtErr err) = code err - code NoSchemaCacheError = "PGRST002" - code (PgErr err) = code err - - message (ApiRequestError err) = message err - message (SchemaCacheErr err) = message err - message (JwtErr err) = message err - message NoSchemaCacheError = "Could not query the database for the schema cache. Retrying." - message (PgErr err) = message err - - details (ApiRequestError err) = details err - details (SchemaCacheErr err) = details err - details (JwtErr err) = details err - details NoSchemaCacheError = Nothing - details (PgErr err) = details err - - hint (ApiRequestError err) = hint err - hint (SchemaCacheErr err) = hint err - hint (JwtErr err) = hint err - hint NoSchemaCacheError = Nothing - hint (PgErr err) = hint err - -instance PgrstError JwtError where - status JwtDecodeErr{} = HTTP.unauthorized401 - status JwtSecretMissing = HTTP.status500 - status JwtTokenRequired = HTTP.unauthorized401 - status JwtClaimsErr{} = HTTP.unauthorized401 - - headers e@(JwtDecodeErr _) = [invalidTokenHeader $ message e] - headers JwtTokenRequired = [requiredTokenHeader] - headers e@(JwtClaimsErr _) = [invalidTokenHeader $ message e] - headers _ = mempty - -instance JSON.ToJSON JwtError where - toJSON err = toJsonPgrstError - (code err) (message err) (details err) (hint err) - -instance ErrorBody JwtError where - code JwtSecretMissing = "PGRST300" - code (JwtDecodeErr _) = "PGRST301" - code JwtTokenRequired = "PGRST302" - code (JwtClaimsErr _) = "PGRST303" - - message JwtSecretMissing = "Server lacks JWT secret" - message (JwtDecodeErr e) = case e of - EmptyAuthHeader -> "Empty JWT is sent in Authorization header" - UnexpectedParts n -> "Expected 3 parts in JWT; got " <> show n - KeyError _ -> "No suitable key or wrong key type" - BadAlgorithm _ -> "Wrong or unsupported encoding algorithm" - BadCrypto -> "JWT cryptographic operation failed" - UnsupportedTokenType -> "Unsupported token type" - UnreachableDecodeError -> "JWT couldn't be decoded" - message JwtTokenRequired = "Anonymous access is disabled" - message (JwtClaimsErr e) = case e of - JWTExpired -> "JWT expired" - JWTNotYetValid -> "JWT not yet valid" - JWTIssuedAtFuture -> "JWT issued at future" - JWTNotInAudience -> "JWT not in audience" - ParsingClaimsFailed -> "Parsing claims failed" - ExpClaimNotNumber -> "The JWT 'exp' claim must be a number" - NbfClaimNotNumber -> "The JWT 'nbf' claim must be a number" - IatClaimNotNumber -> "The JWT 'iat' claim must be a number" - AudClaimNotStringOrArray -> "The JWT 'aud' claim must be a string or an array of strings" - - details (JwtDecodeErr jde) = case jde of - KeyError dets -> Just $ JSON.String dets - BadAlgorithm dets -> Just $ JSON.String dets - _ -> Nothing - details _ = Nothing - - hint _ = Nothing - -invalidTokenHeader :: Text -> HTTP.Header -invalidTokenHeader m = - ("WWW-Authenticate", "Bearer error=\"invalid_token\", " <> "error_description=" <> encodeUtf8 (show m)) - -requiredTokenHeader :: HTTP.Header -requiredTokenHeader = ("WWW-Authenticate", "Bearer") diff --git a/src/PostgREST/Error/Error.hs b/src/PostgREST/Error/Error.hs new file mode 100644 index 0000000000..5185658ac2 --- /dev/null +++ b/src/PostgREST/Error/Error.hs @@ -0,0 +1,158 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE RecordWildCards #-} + +module PostgREST.Error.Error + ( Error (..) + , JwtError (..) + , JwtDecodeError (..) + , JwtClaimsError (..) + ) where + +import qualified Data.Aeson as JSON +import qualified Data.Text.Encoding as T +import qualified Network.HTTP.Types as HTTP + +import PostgREST.Error.Algebra +import PostgREST.Error.ApiRequestError +import PostgREST.Error.PgError +import PostgREST.Error.SchemaCacheError +import Protolude + +data Error + = ApiRequestError ApiRequestError + | SchemaCacheErr SchemaCacheError + | JwtErr JwtError + | NoSchemaCacheError + | PgErr PgError + deriving Show + +data JwtError + = JwtDecodeErr JwtDecodeError + | JwtSecretMissing + | JwtTokenRequired + | JwtClaimsErr JwtClaimsError + deriving Show + +data JwtDecodeError + = EmptyAuthHeader + | UnexpectedParts Int + | KeyError Text + | BadAlgorithm Text + | BadCrypto + | UnsupportedTokenType + | UnreachableDecodeError + deriving Show + +data JwtClaimsError + = JWTExpired + | JWTNotYetValid + | JWTIssuedAtFuture + | JWTNotInAudience + | ParsingClaimsFailed + | ExpClaimNotNumber + | NbfClaimNotNumber + | IatClaimNotNumber + | AudClaimNotStringOrArray + deriving Show + +instance PgrstError Error where + status (ApiRequestError err) = status err + status (SchemaCacheErr err) = status err + status (JwtErr err) = status err + status NoSchemaCacheError = HTTP.status503 + status (PgErr err) = status err + + headers (ApiRequestError err) = proxyStatusHeader (code err) : headers err + headers (SchemaCacheErr err) = proxyStatusHeader (code err) : headers err + headers (JwtErr err) = proxyStatusHeader (code err) : headers err + headers (PgErr err) = proxyStatusHeader (code err) : headers err + headers err@NoSchemaCacheError = proxyStatusHeader (code err) : mempty + +instance JSON.ToJSON Error where + toJSON err = toJsonPgrstError + (code err) (message err) (details err) (hint err) + +instance ErrorBody Error where + code (ApiRequestError err) = code err + code (SchemaCacheErr err) = code err + code (JwtErr err) = code err + code NoSchemaCacheError = "PGRST002" + code (PgErr err) = code err + + message (ApiRequestError err) = message err + message (SchemaCacheErr err) = message err + message (JwtErr err) = message err + message NoSchemaCacheError = "Could not query the database for the schema cache. Retrying." + message (PgErr err) = message err + + details (ApiRequestError err) = details err + details (SchemaCacheErr err) = details err + details (JwtErr err) = details err + details NoSchemaCacheError = Nothing + details (PgErr err) = details err + + hint (ApiRequestError err) = hint err + hint (SchemaCacheErr err) = hint err + hint (JwtErr err) = hint err + hint NoSchemaCacheError = Nothing + hint (PgErr err) = hint err + +instance PgrstError JwtError where + status JwtDecodeErr{} = HTTP.unauthorized401 + status JwtSecretMissing = HTTP.status500 + status JwtTokenRequired = HTTP.unauthorized401 + status JwtClaimsErr{} = HTTP.unauthorized401 + + headers e@(JwtDecodeErr _) = [invalidTokenHeader $ message e] + headers JwtTokenRequired = [requiredTokenHeader] + headers e@(JwtClaimsErr _) = [invalidTokenHeader $ message e] + headers _ = mempty + +instance JSON.ToJSON JwtError where + toJSON err = toJsonPgrstError + (code err) (message err) (details err) (hint err) + +instance ErrorBody JwtError where + code JwtSecretMissing = "PGRST300" + code (JwtDecodeErr _) = "PGRST301" + code JwtTokenRequired = "PGRST302" + code (JwtClaimsErr _) = "PGRST303" + + message JwtSecretMissing = "Server lacks JWT secret" + message (JwtDecodeErr e) = case e of + EmptyAuthHeader -> "Empty JWT is sent in Authorization header" + UnexpectedParts n -> "Expected 3 parts in JWT; got " <> show n + KeyError _ -> "No suitable key or wrong key type" + BadAlgorithm _ -> "Wrong or unsupported encoding algorithm" + BadCrypto -> "JWT cryptographic operation failed" + UnsupportedTokenType -> "Unsupported token type" + UnreachableDecodeError -> "JWT couldn't be decoded" + message JwtTokenRequired = "Anonymous access is disabled" + message (JwtClaimsErr e) = case e of + JWTExpired -> "JWT expired" + JWTNotYetValid -> "JWT not yet valid" + JWTIssuedAtFuture -> "JWT issued at future" + JWTNotInAudience -> "JWT not in audience" + ParsingClaimsFailed -> "Parsing claims failed" + ExpClaimNotNumber -> "The JWT 'exp' claim must be a number" + NbfClaimNotNumber -> "The JWT 'nbf' claim must be a number" + IatClaimNotNumber -> "The JWT 'iat' claim must be a number" + AudClaimNotStringOrArray -> "The JWT 'aud' claim must be a string or an array of strings" + + details (JwtDecodeErr jde) = case jde of + KeyError dets -> Just $ JSON.String dets + BadAlgorithm dets -> Just $ JSON.String dets + _ -> Nothing + details _ = Nothing + + hint _ = Nothing + +invalidTokenHeader :: Text -> HTTP.Header +invalidTokenHeader m = + ("WWW-Authenticate", "Bearer error=\"invalid_token\", " <> "error_description=" <> encodeUtf8 (show m)) + +requiredTokenHeader :: HTTP.Header +requiredTokenHeader = ("WWW-Authenticate", "Bearer") + +proxyStatusHeader :: Text -> HTTP.Header +proxyStatusHeader code' = ("Proxy-Status", "PostgREST; error=" <> T.encodeUtf8 code') From 3743342d2410febb9c9fc11f9468646ce70a557c Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 21:51:52 +0300 Subject: [PATCH 14/19] Encapsulate deeper --- postgrest.cabal | 8 ++++---- src/PostgREST/Error.hs | 5 +---- src/PostgREST/Error/PgError.hs | 16 ++++++++-------- .../Error/{ => PgError}/CommandError.hs | 4 ++-- src/PostgREST/Error/{ => PgError}/ResultError.hs | 4 ++-- .../{ => PgError}/ResultError/RaisePgrst.hs | 2 +- src/PostgREST/Error/{ => PgError}/UsageError.hs | 4 ++-- 7 files changed, 20 insertions(+), 23 deletions(-) rename src/PostgREST/Error/{ => PgError}/CommandError.hs (90%) rename src/PostgREST/Error/{ => PgError}/ResultError.hs (97%) rename src/PostgREST/Error/{ => PgError}/ResultError/RaisePgrst.hs (96%) rename src/PostgREST/Error/{ => PgError}/UsageError.hs (93%) diff --git a/postgrest.cabal b/postgrest.cabal index 33e29df812..ed7ca1bbef 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -68,13 +68,13 @@ library PostgREST.Error PostgREST.Error.Algebra PostgREST.Error.ApiRequestError - PostgREST.Error.CommandError + PostgREST.Error.PgError.CommandError PostgREST.Error.Error PostgREST.Error.PgError PostgREST.Error.SchemaCacheError - PostgREST.Error.ResultError - PostgREST.Error.ResultError.RaisePgrst - PostgREST.Error.UsageError + PostgREST.Error.PgError.ResultError + PostgREST.Error.PgError.ResultError.RaisePgrst + PostgREST.Error.PgError.UsageError PostgREST.Listener PostgREST.Logger PostgREST.MainTx diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index a52c581c3c..9e16404d0a 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -20,9 +20,6 @@ module PostgREST.Error import PostgREST.Error.Algebra import PostgREST.Error.ApiRequestError -import PostgREST.Error.CommandError () -import PostgREST.Error.PgError import PostgREST.Error.Error -import PostgREST.Error.ResultError () +import PostgREST.Error.PgError import PostgREST.Error.SchemaCacheError -import PostgREST.Error.UsageError () diff --git a/src/PostgREST/Error/PgError.hs b/src/PostgREST/Error/PgError.hs index e0b1a6c3e1..b1aa270d1c 100644 --- a/src/PostgREST/Error/PgError.hs +++ b/src/PostgREST/Error/PgError.hs @@ -7,16 +7,16 @@ module PostgREST.Error.PgError Authenticated, ) where -import qualified Data.Aeson as JSON -import qualified Hasql.Pool as SQL -import qualified Hasql.Session as SQL -import qualified Network.HTTP.Types as HTTP -import qualified PostgREST.Error.ResultError as ResultError +import qualified Data.Aeson as JSON +import qualified Hasql.Pool as SQL +import qualified Hasql.Session as SQL +import qualified Network.HTTP.Types as HTTP +import qualified PostgREST.Error.PgError.ResultError as ResultError import PostgREST.Error.Algebra -import PostgREST.Error.CommandError () -import PostgREST.Error.ResultError () -import PostgREST.Error.UsageError () +import PostgREST.Error.PgError.CommandError () +import PostgREST.Error.PgError.ResultError () +import PostgREST.Error.PgError.UsageError () import Protolude data PgError = PgError Authenticated SQL.UsageError diff --git a/src/PostgREST/Error/CommandError.hs b/src/PostgREST/Error/PgError/CommandError.hs similarity index 90% rename from src/PostgREST/Error/CommandError.hs rename to src/PostgREST/Error/PgError/CommandError.hs index 68dda6ae36..7874c59608 100644 --- a/src/PostgREST/Error/CommandError.hs +++ b/src/PostgREST/Error/PgError/CommandError.hs @@ -1,12 +1,12 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module PostgREST.Error.CommandError where +module PostgREST.Error.PgError.CommandError where import qualified Data.Aeson as JSON import qualified Data.Text.Encoding as T import qualified Hasql.Session as SQL import PostgREST.Error.Algebra -import PostgREST.Error.ResultError () +import PostgREST.Error.PgError.ResultError () import Protolude instance JSON.ToJSON SQL.CommandError where diff --git a/src/PostgREST/Error/ResultError.hs b/src/PostgREST/Error/PgError/ResultError.hs similarity index 97% rename from src/PostgREST/Error/ResultError.hs rename to src/PostgREST/Error/PgError/ResultError.hs index 0d630c4259..ca0a6e6b5e 100644 --- a/src/PostgREST/Error/ResultError.hs +++ b/src/PostgREST/Error/PgError/ResultError.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module PostgREST.Error.ResultError +module PostgREST.Error.PgError.ResultError ( toHttpStatusByAuthed, toHeaders, ) where @@ -12,7 +12,7 @@ import qualified Data.Map.Internal as M import qualified Data.Text.Encoding as T import qualified Hasql.Session as SQL import qualified Network.HTTP.Types as HTTP -import qualified PostgREST.Error.ResultError.RaisePgrst as RaisePgrst +import qualified PostgREST.Error.PgError.ResultError.RaisePgrst as RaisePgrst import PostgREST.Error.Algebra import Protolude diff --git a/src/PostgREST/Error/ResultError/RaisePgrst.hs b/src/PostgREST/Error/PgError/ResultError/RaisePgrst.hs similarity index 96% rename from src/PostgREST/Error/ResultError/RaisePgrst.hs rename to src/PostgREST/Error/PgError/ResultError/RaisePgrst.hs index 0e975d1856..c732be0c09 100644 --- a/src/PostgREST/Error/ResultError/RaisePgrst.hs +++ b/src/PostgREST/Error/PgError/ResultError/RaisePgrst.hs @@ -1,4 +1,4 @@ -module PostgREST.Error.ResultError.RaisePgrst where +module PostgREST.Error.PgError.ResultError.RaisePgrst where import qualified Data.Aeson as JSON import qualified PostgREST.Error.ApiRequestError as ApiRequestError diff --git a/src/PostgREST/Error/UsageError.hs b/src/PostgREST/Error/PgError/UsageError.hs similarity index 93% rename from src/PostgREST/Error/UsageError.hs rename to src/PostgREST/Error/PgError/UsageError.hs index f8f9439e7a..61f170ed53 100644 --- a/src/PostgREST/Error/UsageError.hs +++ b/src/PostgREST/Error/PgError/UsageError.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module PostgREST.Error.UsageError where +module PostgREST.Error.PgError.UsageError where import qualified Data.Aeson as JSON import qualified Data.Text.Encoding as T @@ -8,7 +8,7 @@ import qualified Hasql.Pool as SQL import qualified Hasql.Session as SQL import PostgREST.Error.Algebra -import PostgREST.Error.CommandError () +import PostgREST.Error.PgError.CommandError () import Protolude From fe9b1766fb517231a3f48340f524649aeb4eab77 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 21:54:29 +0300 Subject: [PATCH 15/19] Adapt to the preexisting naming conventions --- src/PostgREST/Error/PgError.hs | 4 ++-- src/PostgREST/Error/PgError/ResultError.hs | 14 +++++++------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/PostgREST/Error/PgError.hs b/src/PostgREST/Error/PgError.hs index b1aa270d1c..245b0ea02f 100644 --- a/src/PostgREST/Error/PgError.hs +++ b/src/PostgREST/Error/PgError.hs @@ -27,7 +27,7 @@ type Authenticated = Bool instance PgrstError PgError where status (PgError authed usageError) = pgErrorStatus authed usageError - headers (PgError _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError (ResultError.toHeaders -> Just matchingHeaders))))) = + headers (PgError _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError (ResultError.maybeHeaders -> Just matchingHeaders))))) = matchingHeaders headers err = @@ -50,4 +50,4 @@ pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503 pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504 pgErrorStatus _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503 pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) = - ResultError.toHttpStatusByAuthed rError authed + ResultError.pgErrorStatus authed rError diff --git a/src/PostgREST/Error/PgError/ResultError.hs b/src/PostgREST/Error/PgError/ResultError.hs index ca0a6e6b5e..cca480dfad 100644 --- a/src/PostgREST/Error/PgError/ResultError.hs +++ b/src/PostgREST/Error/PgError/ResultError.hs @@ -1,8 +1,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module PostgREST.Error.PgError.ResultError - ( toHttpStatusByAuthed, - toHeaders, + ( pgErrorStatus, + maybeHeaders, ) where import qualified Data.Aeson as JSON @@ -47,8 +47,8 @@ instance ErrorBody SQL.ResultError where hint (SQL.ServerError _ _ _ h _) = JSON.String . T.decodeUtf8 <$> h hint _ = Nothing -toHttpStatusByAuthed :: SQL.ResultError -> Bool -> HTTP.Status -toHttpStatusByAuthed rError authed = case rError of +pgErrorStatus :: Bool -> SQL.ResultError -> HTTP.Status +pgErrorStatus authed rError = case rError of SQL.ServerError c m d _ _ -> case BS.unpack c of '0':'8':_ -> HTTP.status503 -- pg connection err @@ -99,11 +99,11 @@ toHttpStatusByAuthed rError authed = case rError of _ -> HTTP.status400 _ -> HTTP.status500 -toHeaders :: SQL.ResultError -> Maybe [HTTP.Header] -toHeaders (SQL.ServerError "PGRST" m d _ _p) = +maybeHeaders :: SQL.ResultError -> Maybe [HTTP.Header] +maybeHeaders (SQL.ServerError "PGRST" m d _ _p) = Just $ case RaisePgrst.parseRaisePGRST m d of Right (_, r) -> map intoHeader (M.toList $ RaisePgrst.getHeaders r) Left e -> headers e where intoHeader (k,v) = (CI.mk $ T.encodeUtf8 k, T.encodeUtf8 v) -toHeaders _ = Nothing +maybeHeaders _ = Nothing From f4bd83d7ee9058662aabad50357da3ab9717a513 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 22:10:07 +0300 Subject: [PATCH 16/19] Refine the deps --- src/PostgREST/Error/PgError.hs | 23 ++++++--------------- src/PostgREST/Error/PgError/CommandError.hs | 12 ++++++++++- src/PostgREST/Error/PgError/UsageError.hs | 22 +++++++++++++++----- 3 files changed, 34 insertions(+), 23 deletions(-) diff --git a/src/PostgREST/Error/PgError.hs b/src/PostgREST/Error/PgError.hs index 245b0ea02f..e6c9a1e9a5 100644 --- a/src/PostgREST/Error/PgError.hs +++ b/src/PostgREST/Error/PgError.hs @@ -7,16 +7,12 @@ module PostgREST.Error.PgError Authenticated, ) where -import qualified Data.Aeson as JSON -import qualified Hasql.Pool as SQL -import qualified Hasql.Session as SQL -import qualified Network.HTTP.Types as HTTP -import qualified PostgREST.Error.PgError.ResultError as ResultError +import qualified Data.Aeson as JSON +import qualified Hasql.Pool as SQL +import qualified Network.HTTP.Types as HTTP +import qualified PostgREST.Error.PgError.UsageError as UsageError import PostgREST.Error.Algebra -import PostgREST.Error.PgError.CommandError () -import PostgREST.Error.PgError.ResultError () -import PostgREST.Error.PgError.UsageError () import Protolude data PgError = PgError Authenticated SQL.UsageError @@ -25,9 +21,9 @@ data PgError = PgError Authenticated SQL.UsageError type Authenticated = Bool instance PgrstError PgError where - status (PgError authed usageError) = pgErrorStatus authed usageError + status (PgError authed usageError) = UsageError.pgErrorStatus authed usageError - headers (PgError _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError (ResultError.maybeHeaders -> Just matchingHeaders))))) = + headers (PgError _ (UsageError.maybeHeaders -> Just matchingHeaders)) = matchingHeaders headers err = @@ -44,10 +40,3 @@ instance ErrorBody PgError where message (PgError _ usageError) = message usageError details (PgError _ usageError) = details usageError hint (PgError _ usageError) = hint usageError - -pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status -pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503 -pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504 -pgErrorStatus _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503 -pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) = - ResultError.pgErrorStatus authed rError diff --git a/src/PostgREST/Error/PgError/CommandError.hs b/src/PostgREST/Error/PgError/CommandError.hs index 7874c59608..17477f8e7c 100644 --- a/src/PostgREST/Error/PgError/CommandError.hs +++ b/src/PostgREST/Error/PgError/CommandError.hs @@ -5,8 +5,9 @@ module PostgREST.Error.PgError.CommandError where import qualified Data.Aeson as JSON import qualified Data.Text.Encoding as T import qualified Hasql.Session as SQL +import qualified Network.HTTP.Types as HTTP import PostgREST.Error.Algebra -import PostgREST.Error.PgError.ResultError () +import qualified PostgREST.Error.PgError.ResultError as ResultError import Protolude instance JSON.ToJSON SQL.CommandError where @@ -30,3 +31,12 @@ instance ErrorBody SQL.CommandError where hint (SQL.ResultError resultError) = hint resultError hint _ = Nothing + +pgErrorStatus :: Bool -> SQL.CommandError -> HTTP.Status +pgErrorStatus _ (SQL.ClientError _) = HTTP.status503 +pgErrorStatus authed (SQL.ResultError rError) = + ResultError.pgErrorStatus authed rError + +maybeHeaders :: SQL.CommandError -> Maybe [HTTP.Header] +maybeHeaders (SQL.ResultError rError) = ResultError.maybeHeaders rError +maybeHeaders _ = Nothing diff --git a/src/PostgREST/Error/PgError/UsageError.hs b/src/PostgREST/Error/PgError/UsageError.hs index 61f170ed53..71c364a163 100644 --- a/src/PostgREST/Error/PgError/UsageError.hs +++ b/src/PostgREST/Error/PgError/UsageError.hs @@ -2,13 +2,14 @@ module PostgREST.Error.PgError.UsageError where -import qualified Data.Aeson as JSON -import qualified Data.Text.Encoding as T -import qualified Hasql.Pool as SQL -import qualified Hasql.Session as SQL +import qualified Data.Aeson as JSON +import qualified Data.Text.Encoding as T +import qualified Hasql.Pool as SQL +import qualified Hasql.Session as SQL +import qualified Network.HTTP.Types as HTTP +import qualified PostgREST.Error.PgError.CommandError as CommandError import PostgREST.Error.Algebra -import PostgREST.Error.PgError.CommandError () import Protolude @@ -32,3 +33,14 @@ instance ErrorBody SQL.UsageError where hint (SQL.ConnectionUsageError _) = Nothing hint (SQL.SessionUsageError (SQL.QueryError _ _ e)) = hint e hint SQL.AcquisitionTimeoutUsageError = Nothing + +pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status +pgErrorStatus _ (SQL.ConnectionUsageError _) = HTTP.status503 +pgErrorStatus _ SQL.AcquisitionTimeoutUsageError = HTTP.status504 +pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ commandError)) = + CommandError.pgErrorStatus authed commandError + +maybeHeaders :: SQL.UsageError -> Maybe [HTTP.Header] +maybeHeaders (SQL.SessionUsageError (SQL.QueryError _ _ commandError)) = + CommandError.maybeHeaders commandError +maybeHeaders _ = Nothing From 1ffa84a21a44f4a32dc4435ba8c3c26dfb103a21 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 22:23:19 +0300 Subject: [PATCH 17/19] Clean up --- cabal.project | 2 -- 1 file changed, 2 deletions(-) diff --git a/cabal.project b/cabal.project index 4aa4c1988f..313d3fc1f4 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,2 @@ packages: postgrest.cabal tests: true -allow-newer: - *:postgresql-libpq, From 859c2c543133277b81837e8ff338eb3aaa478f35 Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Tue, 28 Oct 2025 22:47:06 +0300 Subject: [PATCH 18/19] Sort --- postgrest.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/postgrest.cabal b/postgrest.cabal index ed7ca1bbef..4a8f6b8f48 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -68,13 +68,13 @@ library PostgREST.Error PostgREST.Error.Algebra PostgREST.Error.ApiRequestError - PostgREST.Error.PgError.CommandError PostgREST.Error.Error PostgREST.Error.PgError - PostgREST.Error.SchemaCacheError + PostgREST.Error.PgError.CommandError PostgREST.Error.PgError.ResultError PostgREST.Error.PgError.ResultError.RaisePgrst PostgREST.Error.PgError.UsageError + PostgREST.Error.SchemaCacheError PostgREST.Listener PostgREST.Logger PostgREST.MainTx From 08b3686639df297ca0ea60c0dceefc3af5fbe38d Mon Sep 17 00:00:00 2001 From: Nikita Volkov Date: Wed, 29 Oct 2025 01:18:38 +0300 Subject: [PATCH 19/19] Lint --- src/PostgREST/Error/Error.hs | 1 - src/PostgREST/Error/PgError.hs | 1 - 2 files changed, 2 deletions(-) diff --git a/src/PostgREST/Error/Error.hs b/src/PostgREST/Error/Error.hs index 5185658ac2..0151000374 100644 --- a/src/PostgREST/Error/Error.hs +++ b/src/PostgREST/Error/Error.hs @@ -1,5 +1,4 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE RecordWildCards #-} module PostgREST.Error.Error ( Error (..) diff --git a/src/PostgREST/Error/PgError.hs b/src/PostgREST/Error/PgError.hs index e6c9a1e9a5..063c8d9686 100644 --- a/src/PostgREST/Error/PgError.hs +++ b/src/PostgREST/Error/PgError.hs @@ -1,5 +1,4 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module PostgREST.Error.PgError