diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 03845a92b..8dc758f48 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -10,7 +10,6 @@ module PostgREST.App ( , TableOptions(..) ) where - import qualified Blaze.ByteString.Builder as BB import Control.Applicative import Control.Arrow (second, (***)) @@ -29,9 +28,11 @@ import Data.Ord (comparing) import Data.Ranged.Ranges (emptyRange) import qualified Data.Set as S import Data.String.Conversions (cs) -import Data.Text (Text) +import Data.Text (Text, replace, strip) import Text.Regex.TDFA ((=~)) +import Text.Parsec.Error + import Network.HTTP.Base (urlEncodeVars) import Network.HTTP.Types.Header import Network.HTTP.Types.Status @@ -77,7 +78,7 @@ app dbstructure conf reqBody dbrole req = then return $ responseLBS status416 [] "HTTP Range error" else case queries of - Left e -> return $ responseLBS status400 [("Content-Type", "text/plain")] $ cs e + Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e Right (qs, cqs) -> do let qt = qualify table count = if hasPrefer "count=none" @@ -111,9 +112,22 @@ app dbstructure conf reqBody dbrole req = where from = fromMaybe 0 $ rangeOffset <$> range apiRequest = first formatParserError (parseGetRequest req) - >>= addRelations schema allRels Nothing + >>= first formatRelationError . addRelations schema allRels Nothing >>= addJoinConditions schema allCols - where formatParserError = cs.show + where + formatRelationError :: Text -> Text + formatRelationError e = cs $ encode $ object [ + "mesage" .= ("could not find foreign keys between these entities"::String), + "details" .= e] + formatParserError :: ParseError -> Text + formatParserError e = cs $ encode $ object [ + "message" .= message, + "details" .= details] + where + message = show (errorPos e) + details = strip $ replace "\n" " " $ cs + $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e) + query = requestToQuery schema <$> apiRequest countQuery = requestToCountQuery schema <$> apiRequest queries = (,) <$> query <*> countQuery diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs index 4cebf0d8f..235962811 100644 --- a/src/PostgREST/Parsers.hs +++ b/src/PostgREST/Parsers.hs @@ -22,13 +22,13 @@ parseGetRequest :: Request -> Either ParseError ApiRequest parseGetRequest httpRequest = foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts where - apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select ("++selectStr++")") $ cs selectStr + apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr addOrder (Node r f) o = Node r{order=o} f flts = mapM pRequestFilter whereFilters rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest] orderStr = join $ lookup "order" qString - ord = traverse (parse pOrder ("failed to parse order ("++fromMaybe "" orderStr++")")) orderStr + ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderStr++">>")) orderStr selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to * whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ]