Fix #746 (#769)

also fix broken text env After the last couple of commits the tests ran correctly only on a fresh db, in addition, the roles within the db were not created/dropped on each request and we need that since their privileges differ and we need to to have an absolute clean db on each execution
2016-12-18 15:46:53 -08:00
parent e364cbc3ff
commit 16fd3a57ff
12 changed files with 106 additions and 84 deletions
@@ -62,6 +62,7 @@ import           PostgREST.QueryBuilder ( callProc
                                        , createReadStatement
                                        , createWriteStatement
                                        , ResultsWithCount
+                                        , returningF
                                        )
 import           PostgREST.Types
 import           PostgREST.OpenAPI
@@ -262,8 +263,9 @@ app dbStructure conf apiRequest =
      mapSnd f (a, b) = (a, f b)
      readDbRequest = DbRead <$> readRequest (configMaxRows conf) (dbRelations dbStructure) (map (mapSnd pdReturnType) $ dbProcs dbStructure) apiRequest
      mutateDbRequest = DbMutate <$> mutateRequest apiRequest
-      selectQuery = requestToQuery schema False <$> readDbRequest
-      mutateQuery = requestToQuery schema False <$> mutateDbRequest
+      returningSql = returningF (iTarget apiRequest) (iPreferRepresentation apiRequest) <$> readDbRequest
+      selectQuery = requestToQuery schema False "" <$> readDbRequest
+      mutateQuery = requestToQuery schema False <$> returningSql <*> mutateDbRequest
      countQuery = requestToCountQuery schema <$> readDbRequest
      readSqlParts = (,) <$> selectQuery <*> countQuery
      mutateSqlParts = (,) <$> selectQuery <*> mutateQuery
@@ -288,6 +290,7 @@ responseContentTypeOrError accepts action = serves contentTypesForRequest accept
            "None of these Content-Types are available: " <> failed
        Just ct -> Right ct

+
 splitKeyValue :: BS.ByteString -> (BS.ByteString, BS.ByteString)
 splitKeyValue kv = (k, BS.tail v)
  where (k, v) = BS.break (== '=') kv
@@ -23,6 +23,7 @@ module PostgREST.QueryBuilder (
  , pgFmtLit
  , requestToQuery
  , requestToCountQuery
+  , returningF
  , sourceCTEName
  , unquoted
  , ResultsWithCount
@@ -52,8 +53,8 @@ import           Data.Scientific         ( FPFormat (..)
                                         , isInteger
                                         )
 import           Protolude hiding        (from, intercalate, ord, cast)
+import           PostgREST.ApiRequest    (PreferRepresentation (..), Target (..))
 import           Unsafe                  (unsafeHead)
-import           PostgREST.ApiRequest    (PreferRepresentation (..))

 {-| The generic query result format used by API responses. The location header
    is represented as a list of strings containing variable bindings like
@@ -121,12 +122,12 @@ createWriteStatement _ _ mutateQuery _ None
      WITH {sourceCTEName} AS ({mutateQuery})
      SELECT '', 0, {noLocationF}, '' |]

-createWriteStatement qi _ mutateQuery isSingle HeadersOnly
+createWriteStatement _ _ mutateQuery isSingle HeadersOnly
                     pKeys _ (PayloadJSON _) =
  unicodeStatement sql encodeUniformObjs decodeStandardMay True
 where
  sql = [qc|
-      WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
+      WITH {sourceCTEName} AS ({mutateQuery})
      SELECT {cols}
      FROM (SELECT 1 FROM {sourceCTEName}) _postgrest_t |]
  cols = intercalate ", " [
@@ -136,12 +137,12 @@ createWriteStatement qi _ mutateQuery isSingle HeadersOnly
      "''"
    ]

-createWriteStatement qi selectQuery mutateQuery isSingle Full
+createWriteStatement _ selectQuery mutateQuery isSingle Full
                     pKeys asCsv (PayloadJSON _) =
  unicodeStatement sql encodeUniformObjs decodeStandardMay True
 where
  sql = [qc|
-      WITH {sourceCTEName} AS ({mutateQuery} RETURNING {fromQi qi}.*)
+      WITH {sourceCTEName} AS ({mutateQuery})
      SELECT {cols}
      FROM ({selectQuery}) _postgrest_t |]
  cols = intercalate ", " [
@@ -320,8 +321,8 @@ requestToCountQuery schema (DbRead (Node (Select _ _ conditions _ _, (mainTbl, _
   fn Filter{value=VForeignKey _ _} = False
   localConditions = filter fn conditions

-requestToQuery :: Schema -> Bool -> DbRequest -> SqlQuery
-requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) =
+requestToQuery :: Schema -> Bool -> SqlFragment -> DbRequest -> SqlQuery
+requestToQuery schema isParent _ (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) =
  query
  where
    -- TODO! the following helper functions are just to remove the "schema" part when the table is "source" which is the name
@@ -358,8 +359,7 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions
           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
           <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
-           where subquery = requestToQuery schema False (DbRead (Node n forst))
-
+           where subquery = requestToQuery schema False "" (DbRead (Node n forst))
    getQueryParts (Node n@(_, (name, Just r@Relation{relType=Parent,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (joi:j,sel:s)
      where
        node_name = fromMaybe name alias
@@ -369,31 +369,30 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions
        sel = "row_to_json(" <> pgFmtIdent local_table_name <> ".*) AS " <> pgFmtIdent node_name
        joi = " LEFT OUTER JOIN ( " <> subquery <> " ) AS " <> pgFmtIdent local_table_name  <>
              " ON " <> intercalate " AND " ( map (pgFmtCondition qi . replaceTableName local_table_name) (getJoinConditions r) )
-          where subquery = requestToQuery schema True (DbRead (Node n forst))
+          where subquery = requestToQuery schema True "" (DbRead (Node n forst))
    getQueryParts (Node n@(_, (name, Just Relation{relType=Many,relTable=Table{tableName=table}}, alias)) forst) (j,s) = (j,sel:s)
      where
        sel = "COALESCE (("
           <> "SELECT array_to_json(array_agg(row_to_json("<>pgFmtIdent table<>"))) "
           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
           <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
-           where subquery = requestToQuery schema False (DbRead (Node n forst))
+           where subquery = requestToQuery schema False "" (DbRead (Node n forst))
    --the following is just to remove the warning
    --getQueryParts is not total but requestToQuery is called only after addJoinConditions which ensures the only
    --posible relations are Child Parent Many
-    getQueryParts _ _ = undefined --error "undefined getQueryParts"
-requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON rows))) =
-  let qi = QualifiedIdentifier schema mainTbl
-      cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
-      colsString = intercalate ", " cols
-      insInto = unwords [ "INSERT INTO" , fromQi qi,
-          if T.null colsString then "" else "(" <> colsString <> ")"
-        ]
-      vals = unwords $ if T.null colsString
-                then ["DEFAULT VALUES"]
-                else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"] in
-  insInto <> vals
-
-requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions)) =
+    getQueryParts _ _ = undefined
+requestToQuery schema _ returningSql (DbMutate (Insert mainTbl (PayloadJSON rows))) =
+  insInto <> vals <> returningSql
+  where qi = QualifiedIdentifier schema mainTbl
+        cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
+        colsString = intercalate ", " cols
+        insInto = unwords [ "INSERT INTO" , fromQi qi,
+            if T.null colsString then "" else "(" <> colsString <> ")"
+          ]
+        vals = unwords $ if T.null colsString
+                  then ["DEFAULT VALUES"]
+                  else ["SELECT", colsString, "FROM json_populate_recordset(null::" , fromQi qi, ", $1)"]
+requestToQuery schema _ returningSql (DbMutate (Update mainTbl (PayloadJSON rows) conditions)) =
  case rows V.!? 0 of
    Just obj ->
      let assignments = map
@@ -401,20 +400,33 @@ requestToQuery schema _ (DbMutate (Update mainTbl (PayloadJSON rows) conditions)
      unwords [
        "UPDATE ", fromQi qi,
        " SET " <> intercalate "," assignments <> " ",
-        ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions
+        ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+        returningSql
        ]
    Nothing -> undefined
  where
    qi = QualifiedIdentifier schema mainTbl
-requestToQuery schema _ (DbMutate (Delete mainTbl conditions)) =
+requestToQuery schema _ returningSql (DbMutate (Delete mainTbl conditions)) =
  query
  where
    qi = QualifiedIdentifier schema mainTbl
    query = unwords [
      "DELETE FROM ", fromQi qi,
-      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions
+      ("WHERE " <> intercalate " AND " ( map (pgFmtCondition qi ) conditions )) `emptyOnNull` conditions,
+      returningSql
      ]

+returningF :: Target -> PreferRepresentation -> DbRequest -> SqlFragment
+returningF _ None _ = ""
+returningF (TargetIdent qi) _ (DbRead (Node (Select colSelects _ _ _ _, (_, _, _)) forest)) =
+  " RETURNING " <>
+  intercalate ", " ( map (pgFmtSelectItem qi) colSelects ++ map (pgFmtColumn qi . colName) fks)
+  where
+    fks = concatMap (fromMaybe [] . f) forest
+    f (Node (_, (_, Just Relation{relFColumns=cols, relType=Parent}, _)) _) = Just cols
+    f _ = Nothing
+returningF _ _ _ = ""
+
 sourceCTEName :: SqlFragment
 sourceCTEName = "pg_source"