jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: Remove Protolude.Conv from Error

Browse Source
This commit is contained in:
monacoremo
2021-11-12 20:25:22 +01:00
committed by Remo
parent ebe66cb985
commit 65062364c4
1 changed files with 20 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/Error.hs
+20 -18
View File
@@ -16,7 +16,10 @@ module PostgREST.Error
) where ) where
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import qualified Hasql.Pool as SQL import qualified Hasql.Pool as SQL
import qualified Hasql.Session as SQL import qualified Hasql.Session as SQL
import qualified Network.HTTP.Types.Status as HTTP import qualified Network.HTTP.Types.Status as HTTP
@@ -36,8 +39,7 @@ import PostgREST.DbStructure.Relationship (Cardinality (..),
Relationship (..)) Relationship (..))
import PostgREST.DbStructure.Table (Column (..), Table (..)) import PostgREST.DbStructure.Table (Column (..), Table (..))
import Protolude hiding (toS) import Protolude
import Protolude.Conv (toS, toSL)
class (JSON.ToJSON a) => PgrstError a where class (JSON.ToJSON a) => PgrstError a where
@@ -88,7 +90,7 @@ instance JSON.ToJSON ApiRequestError where
toJSON ActionInappropriate = JSON.object [ toJSON ActionInappropriate = JSON.object [
"message" .= ("Bad Request" :: Text)] "message" .= ("Bad Request" :: Text)]
toJSON (InvalidBody errorMessage) = JSON.object [ toJSON (InvalidBody errorMessage) = JSON.object [
"message" .= (toS errorMessage :: Text)] "message" .= T.decodeUtf8 errorMessage]
toJSON InvalidRange = JSON.object [ toJSON InvalidRange = JSON.object [
"message" .= ("HTTP Range error" :: Text)] "message" .= ("HTTP Range error" :: Text)]
toJSON (NoRelBetween parent child) = JSON.object [ toJSON (NoRelBetween parent child) = JSON.object [
@@ -119,7 +121,7 @@ instance JSON.ToJSON ApiRequestError where
toJSON (UnacceptableSchema schemas) = JSON.object [ toJSON (UnacceptableSchema schemas) = JSON.object [
"message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas)] "message" .= ("The schema must be one of the following: " <> T.intercalate ", " schemas)]
toJSON (ContentTypeError cts) = JSON.object [ toJSON (ContentTypeError cts) = JSON.object [
"message" .= ("None of these Content-Types are available: " <> (toS . intercalate ", " . map toS) cts :: Text)] "message" .= ("None of these Content-Types are available: " <> T.intercalate ", " (map T.decodeUtf8 cts))]
compressedRel :: Relationship -> JSON.Value compressedRel :: Relationship -> JSON.Value
compressedRel Relationship{..} = compressedRel Relationship{..} =
@@ -163,23 +165,23 @@ instance JSON.ToJSON SQL.UsageError where
toJSON (SQL.ConnectionError e) = JSON.object [ toJSON (SQL.ConnectionError e) = JSON.object [
"code" .= ("" :: Text), "code" .= ("" :: Text),
"message" .= ("Database connection error. Retrying the connection." :: Text), "message" .= ("Database connection error. Retrying the connection." :: Text),
"details" .= (toSL $ fromMaybe "" e :: Text)] "details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text)]
toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error
instance JSON.ToJSON SQL.QueryError where instance JSON.ToJSON SQL.QueryError where
toJSON (SQL.QueryError _ _ e) = JSON.toJSON e toJSON (SQL.QueryError _ _ e) = JSON.toJSON e
instance JSON.ToJSON SQL.CommandError where instance JSON.ToJSON SQL.CommandError where
toJSON (SQL.ResultError (SQL.ServerError c m d h)) = case toS c of toJSON (SQL.ResultError (SQL.ServerError c m d h)) = case BS.unpack c of
'P':'T':_ -> JSON.object [ 'P':'T':_ -> JSON.object [
"details" .= (fmap toS d :: Maybe Text), "details" .= fmap T.decodeUtf8 d,
"hint" .= (fmap toS h :: Maybe Text)] "hint" .= fmap T.decodeUtf8 h]
_ -> JSON.object [ _ -> JSON.object [
"code" .= (toS c :: Text), "code" .= (T.decodeUtf8 c :: Text),
"message" .= (toS m :: Text), "message" .= (T.decodeUtf8 m :: Text),
"details" .= (fmap toS d :: Maybe Text), "details" .= (fmap T.decodeUtf8 d :: Maybe Text),
"hint" .= (fmap toS h :: Maybe Text)] "hint" .= (fmap T.decodeUtf8 h :: Maybe Text)]
toJSON (SQL.ResultError (SQL.UnexpectedResult m)) = JSON.object [ toJSON (SQL.ResultError (SQL.UnexpectedResult m)) = JSON.object [
"message" .= (m :: Text)] "message" .= (m :: Text)]
@@ -200,7 +202,7 @@ instance JSON.ToJSON SQL.CommandError where
"details" .= i] "details" .= i]
toJSON (SQL.ClientError d) = JSON.object [ toJSON (SQL.ClientError d) = JSON.object [
"message" .= ("Database client error. Retrying the connection." :: Text), "message" .= ("Database client error. Retrying the connection." :: Text),
"details" .= (fmap toS d :: Maybe Text)] "details" .= (fmap T.decodeUtf8 d :: Maybe Text)]
pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
pgErrorStatus _ (SQL.ConnectionError _) = HTTP.status503 pgErrorStatus _ (SQL.ConnectionError _) = HTTP.status503
@@ -208,7 +210,7 @@ pgErrorStatus _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ClientError _)))
pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) = pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) =
case rError of case rError of
(SQL.ServerError c m _ _) -> (SQL.ServerError c m _ _) ->
case toS c of case BS.unpack c of
'0':'8':_ -> HTTP.status503 -- pg connection err '0':'8':_ -> HTTP.status503 -- pg connection err
'0':'9':_ -> HTTP.status500 -- triggered action exception '0':'9':_ -> HTTP.status500 -- triggered action exception
'0':'L':_ -> HTTP.status403 -- invalid grantor '0':'L':_ -> HTTP.status403 -- invalid grantor
@@ -245,8 +247,8 @@ checkIsFatal :: PgError -> Maybe Text
checkIsFatal (PgError _ (SQL.ConnectionError e)) checkIsFatal (PgError _ (SQL.ConnectionError e))
| isAuthFailureMessage = Just $ toS failureMessage | isAuthFailureMessage = Just $ toS failureMessage
| otherwise = Nothing | otherwise = Nothing
where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` toS failureMessage where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` failureMessage
failureMessage = fromMaybe mempty e failureMessage = BS.unpack $ fromMaybe mempty e
checkIsFatal (PgError _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError serverError)))) checkIsFatal (PgError _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError serverError))))
= case serverError of = case serverError of
-- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal. -- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal.
@@ -306,7 +308,7 @@ instance JSON.ToJSON Error where
toJSON GucStatusError = JSON.object [ toJSON GucStatusError = JSON.object [
"message" .= ("response.status guc must be a valid status code" :: Text)] "message" .= ("response.status guc must be a valid status code" :: Text)]
toJSON (BinaryFieldError ct) = JSON.object [ toJSON (BinaryFieldError ct) = JSON.object [
"message" .= ((toS (ContentType.toMime ct) <> " requested but more than one column was selected") :: Text)] "message" .= ((T.decodeUtf8 (ContentType.toMime ct) <> " requested but more than one column was selected") :: Text)]
toJSON ConnectionLostError = JSON.object [ toJSON ConnectionLostError = JSON.object [
"message" .= ("Database connection lost. Retrying the connection." :: Text)] "message" .= ("Database connection lost. Retrying the connection." :: Text)]
@@ -317,7 +319,7 @@ instance JSON.ToJSON Error where
toJSON (SingularityError n) = JSON.object [ toJSON (SingularityError n) = JSON.object [
"message" .= ("JSON object requested, multiple (or no) rows returned" :: Text), "message" .= ("JSON object requested, multiple (or no) rows returned" :: Text),
"details" .= T.unwords ["Results contain", show n, "rows,", toS (ContentType.toMime CTSingularJSON), "requires 1 row"]] "details" .= T.unwords ["Results contain", show n, "rows,", T.decodeUtf8 (ContentType.toMime CTSingularJSON), "requires 1 row"]]
toJSON JwtTokenMissing = JSON.object [ toJSON JwtTokenMissing = JSON.object [
"message" .= ("Server lacks JWT secret" :: Text)] "message" .= ("Server lacks JWT secret" :: Text)]