From ad555986d46fc85411a607672d5ad25533fb576a Mon Sep 17 00:00:00 2001 From: calebmer Date: Mon, 16 Nov 2015 17:07:52 -0500 Subject: [PATCH] Error refactors --- src/PostgREST/App.hs | 19 +++++++++++-------- src/PostgREST/Error.hs | 10 +++++++--- src/PostgREST/Main.hs | 4 ++-- src/PostgREST/Middleware.hs | 7 ++++--- test/SpecHelper.hs | 4 ++-- 5 files changed, 26 insertions(+), 18 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index c4714a218..91bd41266 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -46,6 +46,11 @@ import qualified Hasql.Postgres as P import PostgREST.Config (AppConfig (..)) import PostgREST.Parsers import PostgREST.DbStructure +import PostgREST.RangeQuery +import PostgREST.Types +import PostgREST.Auth (tokenJWT) +import PostgREST.Error (errResponse) + import PostgREST.QueryBuilder ( asJson , callProc , asCsvF @@ -62,9 +67,6 @@ import PostgREST.QueryBuilder ( asJson , countNoneF , addRelations ) -import PostgREST.RangeQuery -import PostgREST.Types -import PostgREST.Auth (tokenJWT) import Prelude @@ -86,7 +88,7 @@ app dbStructure conf reqBody req = Left e -> return $ responseLBS status400 [jsonH] $ cs e Right (selectQuery, Nothing) -> -- should we do sanity check to make sure its a GET request? if range == Just emptyRange - then return $ responseLBS status416 [] "HTTP Range error" + then return $ errResponse status416 "HTTP Range error" else do let q = createReadStatement selectQuery range (not $ hasPrefer "count=none") isCsv row <- H.maybeEx q @@ -135,9 +137,9 @@ app dbStructure conf reqBody req = row <- H.maybeEx q let (_, queryTotal, _, _) = extractQueryResult row return $ if queryTotal == 0 - then responseLBS status404 [] "" + then notFound else responseLBS status204 [("Content-Range", "*/"<> cs (show queryTotal))] "" - _ -> return $ responseLBS status404 [] "" + _ -> return notFound (["rpc", proc], "POST") -> do let qi = QualifiedIdentifier schema (cs proc) @@ -153,7 +155,7 @@ app dbStructure conf reqBody req = if returnJWT then "{\"token\":\"" <> cs (tokenJWT jwtSecret body) <> "\"}" else cs $ encode body) - else return $ responseLBS status404 [] "" + else return notFound -- check that proc exists -- check that arg names are all specified @@ -164,9 +166,10 @@ app dbStructure conf reqBody req = return $ responseLBS status200 [jsonH] $ cs body (_, _) -> - return $ responseLBS status404 [] "" + return notFound where + notFound = responseLBS status404 [] "" allPrKeys = dbPrimaryKeys dbStructure filterPk sc table pk = sc == (tableSchema . pkTable) pk && table == (tableName . pkTable) pk path = pathInfo req diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index 9b162c53a..94a8f0554 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -2,13 +2,14 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} -module PostgREST.Error (PgError, errResponse) where +module PostgREST.Error (PgError, pgErrResponse, errResponse) where import Data.Aeson ((.=)) import qualified Data.Aeson as JSON import Data.String.Conversions (cs) import Data.String.Utils (replace) +import Data.Text (Text) import qualified Data.Text as T import qualified Hasql as H import qualified Hasql.Postgres as P @@ -18,8 +19,11 @@ import Network.Wai (Response, responseLBS) type PgError = H.SessionError P.Postgres -errResponse :: PgError -> Response -errResponse e = responseLBS (httpStatus e) +errResponse :: HT.Status -> Text -> Response +errResponse status message = responseLBS status [(hContentType, "application/json")] (cs $ T.concat ["{\"message\":\"",message,"\"}"]) + +pgErrResponse :: PgError -> Response +pgErrResponse e = responseLBS (httpStatus e) [(hContentType, "application/json")] (JSON.encode e) instance JSON.ToJSON PgError where diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs index 4b12d07b8..02640cdd5 100644 --- a/src/PostgREST/Main.hs +++ b/src/PostgREST/Main.hs @@ -6,7 +6,7 @@ import PostgREST.Config (AppConfig (..), minimumPgVersion, prettyVersion, readOptions) -import PostgREST.Error (errResponse, PgError) +import PostgREST.Error (pgErrResponse, PgError) import PostgREST.Middleware import PostgREST.DbStructure @@ -75,4 +75,4 @@ main = do body <- strictRequestBody req resOrError <- liftIO $ H.session pool $ H.tx txSettings $ runWithClaims conf (app dbStructure conf body) req - either (respond . errResponse) respond resOrError + either (respond . pgErrResponse) respond resOrError diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs index 3144bc84f..6a60f20d0 100644 --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -13,7 +13,7 @@ import qualified Hasql.Postgres as P import Network.HTTP.Types.Header (hAccept, hAuthorization) import Network.HTTP.Types.Status (status415, status400) import Network.Wai (Application, Request (..), Response, - requestHeaders, responseLBS) + requestHeaders) import Network.Wai.Middleware.Cors (cors) import Network.Wai.Middleware.Gzip (def, gzip) import Network.Wai.Middleware.Static (only, staticPolicy) @@ -21,6 +21,7 @@ import Network.Wai.Middleware.Static (only, staticPolicy) import PostgREST.App (contentTypeForAccept) import PostgREST.Auth (setRole, jwtClaims, claimsToSQL) import PostgREST.Config (AppConfig (..), corsPolicy) +import PostgREST.Error (errResponse) import System.IO.Unsafe (unsafePerformIO) @@ -54,14 +55,14 @@ runWithClaims conf app req = do auth = fromMaybe "" $ lookup hAuthorization hdrs anon = cs $ configAnonRole conf setAnon = setRole anon - invalidJWT = return $ responseLBS status400 [("Content-Type","application/json")] "{\"message\":\"Invalid JWT\"}" + invalidJWT = return $ errResponse status400 "Invalid JWT" unsupportedAccept :: Application -> Application unsupportedAccept app req respond = do let accept = lookup hAccept $ requestHeaders req if isNothing $ contentTypeForAccept accept - then respond $ responseLBS status415 [] "Unsupported Accept header, try: application/json" + then respond $ errResponse status415 "Unsupported Accept header, try: application/json" else app req respond defaultMiddle :: Application -> Application diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 691ec0696..2a7cb123a 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -29,7 +29,7 @@ import qualified Data.Aeson.Types as J import PostgREST.App (app) import PostgREST.Config (AppConfig(..)) import PostgREST.Middleware -import PostgREST.Error(errResponse) +import PostgREST.Error(pgErrResponse) import PostgREST.DbStructure dbString :: String @@ -61,7 +61,7 @@ withApp perform = do body <- strictRequestBody req result <- liftIO $ H.session pool $ H.tx txSettings $ runWithClaims cfg (app db cfg body) req - either (resp . errResponse) resp result + either (resp . pgErrResponse) resp result where middle = defaultMiddle