diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index c1a247bc0..7509cf790 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -24,7 +24,7 @@ import qualified Data.Csv as CSV import Data.Functor.Identity import qualified Data.HashMap.Strict as M import Data.List (find, sortBy, delete, transpose) -import Data.Maybe (fromMaybe, fromJust, isJust, isNothing) +import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, mapMaybe) import Data.Ord (comparing) import Data.Ranged.Ranges (emptyRange) import qualified Data.Set as S @@ -61,6 +61,7 @@ import PostgREST.Types import PostgREST.Auth (tokenJWT) import Prelude +import Debug.Trace app :: DbStructure -> AppConfig -> BL.ByteString -> Request -> H.Tx P.Postgres s Response app dbstructure conf reqBody req = @@ -76,12 +77,12 @@ app dbstructure conf reqBody req = let q = B.Stmt ( wrapQuery qs [ - (if hasPrefer "count=none" then countNoneF else countAllF), + if hasPrefer "count=none" then countNoneF else countAllF, countF, case contentType of "text/csv" -> asCsvF -- TODO check when in csv mode if the header is correct when requesting nested data _ -> asJsonF - ] range + ] selectStarF range ) V.empty True row <- H.maybeEx q @@ -104,32 +105,32 @@ app dbstructure conf reqBody req = where frm = fromMaybe 0 $ rangeOffset <$> range - apiRequest = parseGetRequest table req - >>= first formatRelationError . addRelations schema allRels Nothing - >>= addJoinConditions schema allCols + -- apiRequest = parseGetRequest table req + -- >>= first formatRelationError . addRelations schema allRels Nothing + -- >>= addJoinConditions schema allCols + apiRequest = parseGetRequest table req >>= augumentRequestWithJoin schema allRels query = requestToQuery schema <$> apiRequest ([table], "POST") -> do let echoRequested = hasPrefer "return=representation" - case insertQuery of + case queries of Left e -> return $ responseLBS status400 [("Content-Type", "application/json")] $ cs e - Right qs -> do + Right (qi, qs) -> do let isSingle = either (const False) id returnSingle pKeys = map pkName $ filter (filterPk schema table) allPrKeys q = B.Stmt ( - wrapQuery qs [ + wrapQuery qi [ if isSingle then locationF pKeys else "null", "null", -- countF, - ( - if echoRequested - then - case contentType of - "text/csv" -> asCsvF - _ -> if isSingle then asJsonSingleF else asJsonF - else "null" - ) - ] Nothing + if echoRequested + then + case contentType of + "text/csv" -> asCsvF + _ -> if isSingle then asJsonSingleF else asJsonF + else "null" + + ] qs Nothing ) V.empty True @@ -145,9 +146,18 @@ app dbstructure conf reqBody req = $ if echoRequested then body else "" where res = parsePostRequest table req reqBody - apiRequest = snd <$> res - returnSingle = fst <$> res - insertQuery = requestToQuery schema <$> apiRequest + ins = fst <$> res + insertApiRequest = snd <$> ins + returnSingle = fst <$> ins + insertQuery = requestToQuery schema <$> insertApiRequest + selectApiRequest = (snd <$> res) >>= augumentRequestWithJoin schema (fakeSourceRelations ++ allRels) + selectQuery = requestToQuery schema <$> selectApiRequest + queries = (,) <$> insertQuery <*> selectQuery + fakeSourceRelations = mapMaybe (toSourceRelation table) allRels + --changeRootNodeToSource :: Text -> ApiRequest -> ApiRequest + --changeRootNodeToSource rootTableName (q, (rootTableName, r)) = + + --returnSelect = selectStarF ([table], "PUT") -> handleJsonObj reqBody $ \obj -> do @@ -350,11 +360,12 @@ formatParserError e = cs $ encode $ object [ details = strip $ replace "\n" " " $ cs $ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e) -parsePostRequest :: NodeName -> Request -> BL.ByteString -> Either Text (Bool, ApiRequest) +-- quite ugly return type +parsePostRequest :: NodeName -> Request -> BL.ByteString -> Either Text ((Bool, ApiRequest), ApiRequest) parsePostRequest rootTableName httpRequest reqBody = - (,) <$> returnSingle <*> node + (,) <$> ((,) <$> returnSingle <*> insertApiRequest) <*> returnApiRequest where - node = Node <$> apiNode <*> pure [] + insertApiRequest = Node <$> apiNode <*> pure [] apiNode = (,) <$> (Insert rootTableName <$> flds <*> vals) <*> pure (rootTableName, Nothing) flds = join $ first formatParserError . mapM (parseField . cs) <$> (fst <$> parsed) vals = snd <$> parsed @@ -366,6 +377,8 @@ parsePostRequest rootTableName httpRequest reqBody = lookupHeader = flip lookup hdrs --rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head isCsv = lookupHeader "Content-Type" == Just csvMT + qParams = queryParams httpRequest + returnApiRequest = buildSelectApiRequest sourceSubqueryName (selectStr qParams) (whereFilters qParams) (orderStr qParams) parseRequestBody :: Bool -> BL.ByteString -> Either Text ([Text],[[Value]]) @@ -426,17 +439,36 @@ convertJson v = (,) <$> (header <$> normalized) <*> (vals <$> normalized) parseGetRequest :: NodeName -> Request -> Either Text ApiRequest parseGetRequest rootTableName httpRequest = + buildSelectApiRequest rootTableName (selectStr qParams) (whereFilters qParams) (orderStr qParams) + where + qParams = queryParams httpRequest + +augumentRequestWithJoin :: Text -> [Relation] -> ApiRequest -> Either Text ApiRequest +augumentRequestWithJoin schema allRels request = return request + >>= first formatRelationError . addRelations schema allRels Nothing + >>= addJoinConditions schema + +-- we use strings here because most of this data will be sent to parsers (which need strings for now) +queryParams :: Request -> [(String, Maybe String)] +queryParams httpRequest = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest] + +selectStr :: [(String, Maybe String)] -> String +selectStr qParams = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams + +whereFilters :: [(String, Maybe String)] -> [(String, String)] +whereFilters qParams = [ (k, fromJust v) | (k,v) <- qParams, k `notElem` ["select", "order"], isJust v ] + +orderStr :: [(String, Maybe String)] -> Maybe String +orderStr qParams = join $ lookup "order" qParams + +buildSelectApiRequest :: Text -> String -> [(String, String)] -> Maybe String -> Either Text ApiRequest +buildSelectApiRequest rootTableName sel wher orderS = first formatParserError $ foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts where - apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++selectStr++">>") $ cs selectStr + apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select parameter <<"++sel++">>") $ sel addOrder (Node (q,i) f) o = Node (q{order=o}, i) 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 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 ] + flts = mapM pRequestFilter wher + ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderS++">>")) orderS addFilter :: (Path, Filter) -> ApiRequest -> ApiRequest addFilter ([], flt) (Node (q@(Select {where_=flts}), i) forest) = Node (q {where_=flt:flts}, i) forest @@ -453,6 +485,12 @@ addFilter (path, flt) (Node rn forest) = Just node -> (Just node, delete node forest) where maybeNode = find ((name==).fst.snd.rootLabel) forst +toSourceRelation :: Text -> Relation -> Maybe Relation +toSourceRelation mt r@(Relation _ t _ ft _ _ rt _ _) + | mt == t = Just $ r {relTable=sourceSubqueryName} + | mt == ft = Just $ r {relFTable=sourceSubqueryName} + | Just mt == rt = Just $ r {relLTable=Just sourceSubqueryName} + | otherwise = Nothing data TableOptions = TableOptions { tblOptcolumns :: [Column] diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs index c83d304d6..af6f395fb 100644 --- a/src/PostgREST/Main.hs +++ b/src/PostgREST/Main.hs @@ -2,6 +2,7 @@ module Main where import PostgREST.App +-- import PostgREST.QueryBuilder import PostgREST.Config (AppConfig (..), minimumPgVersion, prettyVersion, @@ -26,7 +27,7 @@ import Network.Wai.Middleware.RequestLogger (logStdout) import System.IO (BufferMode (..), hSetBuffering, stderr, stdin, stdout) - +-- import Data.Maybe (mapMaybe) isServerVersionSupported :: H.Session P.Postgres IO Bool isServerVersionSupported = do @@ -86,8 +87,10 @@ main = do keys <- allPrimaryKeys return (tabs, rels, cols, keys) + dbstructure <- either hasqlError (\(tabs, rels, cols, keys) -> + return DbStructure { tables=tabs , columns=cols @@ -96,6 +99,11 @@ main = do } ) metadata + -- let allRels = relations dbstructure + -- fakeRels = mapMaybe (toSourceRelation "projects") allRels + -- + -- print $ findRelation (fakeRels ++ allRels) "test" "pg_source" "clients" + runSettings appSettings $ middle $ \ req respond -> do body <- strictRequestBody req resOrError <- liftIO $ H.session pool $ H.tx txSettings $ diff --git a/src/PostgREST/PgQuery.hs b/src/PostgREST/PgQuery.hs index 2b9cb71ca..3d25b2cd2 100644 --- a/src/PostgREST/PgQuery.hs +++ b/src/PostgREST/PgQuery.hs @@ -36,6 +36,7 @@ module PostgREST.PgQuery ( , whereT -- query fragments +, sourceSubqueryName , orderF , countNoneF , countAllF @@ -44,6 +45,7 @@ module PostgREST.PgQuery ( , asCsvF , asJsonSingleF , asJsonF +, selectStarF , StatementT ) where @@ -246,24 +248,27 @@ insertableValue :: JSON.Value -> T.Text insertableValue JSON.Null = "null" insertableValue v = insertableText $ unquoted v -wrapQuery :: T.Text -> [T.Text] -> Maybe NonnegRange -> T.Text -wrapQuery source selectColumns range = +wrapQuery :: T.Text -> [T.Text] -> T.Text -> Maybe NonnegRange -> T.Text +wrapQuery source selectColumns returnSelect range = withSourceF source <> " SELECT " <> T.intercalate ", " selectColumns <> " " <> - fromF ( limitF range ) + fromF returnSelect ( limitF range ) -- query fragments +sourceSubqueryName :: T.Text +sourceSubqueryName = "pg_source" + withSourceF :: T.Text -> T.Text -withSourceF s = "WITH source AS (" <> s <>")" +withSourceF s = "WITH " <> sourceSubqueryName <> " AS (" <> s <>")" countF :: T.Text countF = "pg_catalog.count(t)" countAllF :: T.Text -countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM source) a )" +countAllF = "(SELECT pg_catalog.count(1) FROM (SELECT * FROM " <> sourceSubqueryName <> ") a )" countNoneF :: T.Text countNoneF = "null" @@ -283,7 +288,7 @@ asCsvHeaderF = " FROM (" <> " SELECT json_object_keys(r)::TEXT as k" <> " FROM ( " <> - " SELECT row_to_json(source) as r from source limit 1" <> + " SELECT row_to_json(hh) as r from " <> sourceSubqueryName <> " as hh limit 1" <> " ) s" <> " ) a" <> ")" @@ -291,8 +296,11 @@ asCsvHeaderF = asCsvBodyF :: T.Text asCsvBodyF = "coalesce(string_agg(substring(t::text, 2, length(t::text) - 2), '\n'), '')" -fromF :: T.Text -> T.Text -fromF limit = "FROM (SELECT * FROM source " <> limit <> ") t" +selectStarF :: T.Text +selectStarF = "SELECT * FROM " <> sourceSubqueryName + +fromF :: T.Text -> T.Text -> T.Text +fromF sel limit = "FROM (" <> sel <> " " <> limit <> ") t" limitF :: Maybe NonnegRange -> T.Text limitF r = "LIMIT " <> limit <> " OFFSET " <> offset @@ -303,7 +311,7 @@ limitF r = "LIMIT " <> limit <> " OFFSET " <> offset locationF :: [T.Text] -> T.Text locationF pKeys = "(" <> - " WITH s AS (SELECT row_to_json(source) as r from source limit 1)" <> + " WITH s AS (SELECT row_to_json(ss) as r from " <> sourceSubqueryName <> " as ss limit 1)" <> " SELECT string_agg(json_data.key || '=' || coalesce( 'eq.' || json_data.value, 'is.null'), '&')" <> " FROM s, json_each_text(s.r) AS json_data" <> ( @@ -375,23 +383,24 @@ pgFmtLit x = pgFmtCondition :: QualifiedIdentifier -> Filter -> T.Text pgFmtCondition table (Filter (col,jp) ops val) = - notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <> - if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue - where - headPredicate:rest = T.split (=='.') ops - hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse - opCode = hasNot (head rest) headPredicate - notOp = hasNot headPredicate "" - sqlCol = case val of - VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp - VForeignKey qi _ -> pgFmtColumn qi col - sqlValue = valToStr val - getInner v = case v of - VText s -> s - _ -> "" - valToStr v = case v of - VText s -> pgFmtValue opCode s - VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn (QualifiedIdentifier s ft) fc + notOp <> " " <> sqlCol <> " " <> pgFmtOperator opCode <> " " <> + if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue + where + headPredicate:rest = T.split (=='.') ops + hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse + opCode = hasNot (head rest) headPredicate + notOp = hasNot headPredicate "" + sqlCol = case val of + VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp + VForeignKey qi _ -> pgFmtColumn qi col + sqlValue = valToStr val + getInner v = case v of + VText s -> s + _ -> "" + valToStr v = case v of + VText s -> pgFmtValue opCode s + VForeignKey (QualifiedIdentifier s _) (ForeignKey ft fc) -> pgFmtColumn qi fc + where qi = QualifiedIdentifier (if ft == sourceSubqueryName then "" else s) ft pgFmtColumn :: QualifiedIdentifier -> T.Text -> T.Text pgFmtColumn table "*" = fromQi table <> ".*" diff --git a/src/PostgREST/QueryBuilder.hs b/src/PostgREST/QueryBuilder.hs index 60521839b..ed8093769 100644 --- a/src/PostgREST/QueryBuilder.hs +++ b/src/PostgREST/QueryBuilder.hs @@ -12,7 +12,7 @@ import Control.Applicative import Data.Tree import PostgREST.PgQuery (fromQi, pgFmtCondition, pgFmtSelectItem, pgFmtIdent, pgFmtCondition, - insertableValue, orderF) + insertableValue, orderF, sourceSubqueryName) import PostgREST.Types --import qualified Data.Vector as V (empty) --import qualified Hasql.Backend as B @@ -47,8 +47,8 @@ getJoinConditions (Relation s t cs ft fcs typ lt lc1 lc2) = toFilter :: Text -> Text -> FieldName -> FieldName -> Filter toFilter tb ftb c fc = Filter (c, Nothing) "=" (VForeignKey (QualifiedIdentifier s tb) (ForeignKey ftb fc)) -addJoinConditions :: Text -> [Column] -> ApiRequest -> Either Text ApiRequest -addJoinConditions schema allColumns (Node (query, (t, r)) forest) = +addJoinConditions :: Text -> ApiRequest -> Either Text ApiRequest +addJoinConditions schema (Node (query, (t, r)) forest) = case r of Nothing -> Node (updatedQuery, (t, r)) <$> updatedForest -- this is the root node Just rel@(Relation{relType=Child}) -> Node (addCond updatedQuery (getJoinConditions rel),(t,r)) <$> updatedForest @@ -68,7 +68,7 @@ addJoinConditions schema allColumns (Node (query, (t, r)) forest) = parents = mapMaybe (getParents.rootLabel) forest getParents (_, (tbl, Just rel@(Relation{relType=Parent}))) = Just (tbl, rel) getParents _ = Nothing - updatedForest = mapM (addJoinConditions schema allColumns) forest + updatedForest = mapM (addJoinConditions schema) forest addCond q con = q{where_=con ++ where_ q} -- requestToCountQuery :: Text -> ApiRequest -> PStmt @@ -94,11 +94,24 @@ requestToQuery schema (Node (Select colSelects tbls conditions ord, (mainTbl, _) where --query = B.Stmt qStr V.empty True --qStr = Data.Text.unwords [ + -- query = Data.Text.unwords [ + -- ("WITH " <> intercalate ", " withs) `emptyOnNull` withs, + -- "SELECT ", intercalate ", " (map (pgFmtSelectItem (QualifiedIdentifier schema mainTbl)) colSelects ++ selects), + -- "FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) tbls), + -- ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions, + -- orderF (fromMaybe [] ord) + -- ] + -- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name + -- of our WITH query part + tblSchema tbl = if tbl == sourceSubqueryName then "" else schema + qi = QualifiedIdentifier (tblSchema mainTbl) mainTbl + toQi t = QualifiedIdentifier (tblSchema t) t + query = Data.Text.unwords [ ("WITH " <> intercalate ", " withs) `emptyOnNull` withs, - "SELECT ", intercalate ", " (map (pgFmtSelectItem (QualifiedIdentifier schema mainTbl)) colSelects ++ selects), - "FROM ", intercalate ", " (map (fromQi . QualifiedIdentifier schema) tbls), - ("WHERE " <> intercalate " AND " ( map (pgFmtCondition (QualifiedIdentifier schema mainTbl) ) conditions )) `emptyOnNull` conditions, + "SELECT ", intercalate ", " (map (pgFmtSelectItem qi) colSelects ++ selects), + "FROM ", intercalate ", " (map (fromQi . toQi) tbls), + ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions, orderF (fromMaybe [] ord) ] emptyOnNull val x = if null x then "" else val diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index c0775150b..40a665651 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -19,16 +19,38 @@ import TestTypes(IncPK(..), CompoundPK(..)) spec :: Spec spec = afterAll_ resetDb $ around withApp $ do describe "Posting new record" $ do - after_ (clearTable "menagerie") . it "accepts disparate json types" $ do - p <- post "/menagerie" - [json| { - "integer": 13, "double": 3.14159, "varchar": "testing!" - , "boolean": false, "date": "1900-01-01", "money": "$3.99" - , "enum": "foo" - } |] - liftIO $ do - simpleBody p `shouldBe` "" - simpleStatus p `shouldBe` created201 + after_ (clearTable "menagerie") . context "disparate csv types" $ do + it "accepts disparate json types" $ do + p <- post "/menagerie" + [json| { + "integer": 13, "double": 3.14159, "varchar": "testing!" + , "boolean": false, "date": "1900-01-01", "money": "$3.99" + , "enum": "foo" + } |] + liftIO $ do + simpleBody p `shouldBe` "" + simpleStatus p `shouldBe` created201 + + it "filters columns in result using &select" $ do + request methodPost "/menagerie?select=integer,varchar" [("Prefer", "return=representation")] + [json| { + "integer": 14, "double": 3.14159, "varchar": "testing!" + , "boolean": false, "date": "1900-01-01", "money": "$3.99" + , "enum": "foo" + } |] `shouldRespondWith` ResponseMatcher { + matchBody = Just [str|{"integer":14,"varchar":"testing!"}|] + , matchStatus = 201 + , matchHeaders = ["Content-Type" <:> "application/json"] + } + + it "includes related data after insert" $ do + request methodPost "/projects?select=id,name,clients(id,name)" [("Prefer", "return=representation")] + [str|{"id":5,"name":"New Project","client_id":2}|] `shouldRespondWith` ResponseMatcher { + matchBody = Just [str|{"id":5,"name":"New Project","clients":{"id":2,"name":"Apple"}}|] + , matchStatus = 201 + , matchHeaders = ["Content-Type" <:> "application/json", "Location" <:> "/projects?id=eq.5"] + } + context "with no pk supplied" $ do context "into a table with auto-incrementing pk" . after_ (clearTable "auto_incrementing_pk") $ diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index c094934cc..1ff4c899a 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -11,6 +11,7 @@ import SpecHelper spec :: Spec spec = beforeAll (clearTable "items" >> createItems 15) + . beforeAll (clearProjectsTable) . beforeAll (clearTable "complex_items" >> createComplexItems) . beforeAll (clearTable "nullable_integer" >> createNullInteger) . beforeAll ( diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index bf7042c11..30af213d0 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -130,6 +130,13 @@ clearTable table = do void . liftIO $ H.session pool $ H.tx Nothing $ H.unitEx $ B.Stmt ("delete from test."<>table) V.empty True +clearProjectsTable :: IO () +clearProjectsTable = do + pool <- testPool + void . liftIO $ H.session pool $ H.tx Nothing $ + H.unitEx $ B.Stmt ("delete from test.projects where id > 4") V.empty True + + createItems :: Int -> IO () createItems n = do pool <- testPool