fix relation detection bug and allow offset on lower levels

2016-10-05 11:34:07 +03:00
parent 980680f3d6
commit 211e3d4141
9 changed files with 169 additions and 98 deletions
@@ -20,11 +20,12 @@ import           Network.HTTP.Types.Header (hAuthorization, hContentType, Header
 import           Network.HTTP.Types.URI    (parseSimpleQuery)
 import           Network.Wai               (Request (..))
 import           Network.Wai.Parse         (parseHttpAccept)
-import           PostgREST.RangeQuery      (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange)
+import           PostgREST.RangeQuery      (NonnegRange, rangeRequested, restrictRange, rangeGeq, allRange, rangeLimit, rangeOffset)
+import           Data.Ranged.Boundaries
 import           PostgREST.Types           (QualifiedIdentifier (..),
                                            Schema, Payload(..),
                                            UniformObjects(..))
-import           Data.Ranged.Ranges        (singletonRange, rangeIntersection)
+import           Data.Ranged.Ranges        (Range(..), singletonRange, rangeIntersection)

 type RequestBody = BL.ByteString

@@ -146,15 +147,14 @@ userApiRequest schema req reqBody =
  ApiRequest {
    iAction = action
  , iTarget = target
-  , iRange = M.insert "limit" (rangeIntersection headerRange urlRange) $
-      M.fromList [ (toS k, restrictRange (readBSMaybe =<< v) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k ]
+  , iRange = ranges
  , iAccepts = fromMaybe [CTAny] $
      map decodeContentType . parseHttpAccept <$> lookupHeader "accept"
  , iPayload = relevantPayload
  , iPreferRepresentation = representation
  , iPreferSingular = singular
  , iPreferCount = not singular && hasPrefer "count=exact"
-  , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", k /= "offset", not (endingIn ["order", "limit"] k) ]
+  , iFilters = [ (toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, k /= "select", not (endingIn ["order", "limit", "offset"] k) ]
  , iSelect = toS $ fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qParams
  , iOrder = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["order"] k ]
  , iCanonicalQS = toS $ urlEncodeVars
@@ -191,11 +191,19 @@ userApiRequest schema req reqBody =
    where lastWord = last $ T.split (=='.') key

  headerRange = if singular && method == "GET" then singletonRange 0 else rangeRequested hdrs
-  urlOffsetRange = rangeGeq . fromMaybe (0::Integer) $
-    readBSMaybe =<< join (lookup "offset" qParams)
-  urlRange = restrictRange
-    (readBSMaybe =<< join (lookup "limit" qParams))
-    urlOffsetRange
+  replaceLast x s = T.intercalate "." $ L.init (T.split (=='.') s) ++ [x]
+  limitParams :: M.HashMap ByteString NonnegRange
+  limitParams  = M.fromList [(toS (replaceLast "limit" k), restrictRange (readMaybe =<< (toS <$> v)) allRange) | (k,v) <- qParams, isJust v, endingIn ["limit"] k]
+  offsetParams :: M.HashMap ByteString NonnegRange
+  offsetParams = M.fromList [(toS (replaceLast "limit" k), fromMaybe allRange (rangeGeq <$> (readMaybe =<< (toS <$> v)))) | (k,v) <- qParams, isJust v, endingIn ["offset"] k]
+
+  urlRange = M.unionWith f limitParams offsetParams
+    where
+      f rl ro = Range (BoundaryBelow o) (BoundaryAbove $ o + l - 1)
+        where
+          l = fromMaybe 0 $ rangeLimit rl
+          o = rangeOffset ro
+  ranges = M.insert "limit" (rangeIntersection headerRange (fromMaybe allRange (M.lookup "limit" urlRange))) urlRange

 {-|
  Find the best match from a list of content types accepted by the
@@ -558,73 +558,73 @@ allSynonyms cols =
 where
  -- query explanation at https://gist.github.com/ruslantalpa/2eab8c930a65e8043d8f
  sql = [q|
-    WITH view_columns AS (
-    	SELECT
-    		c.oid AS view_oid,
-    		a.attname::information_schema.sql_identifier AS column_name
-    	FROM pg_attribute a
-    	JOIN pg_class c ON a.attrelid = c.oid
-    	JOIN pg_namespace nc ON c.relnamespace = nc.oid
-    	WHERE
-    		NOT pg_is_other_temp_schema(nc.oid)
-    		AND a.attnum > 0
-    		AND NOT a.attisdropped
-    		AND (c.relkind = 'v'::"char")
-    		AND nc.nspname NOT IN ('information_schema', 'pg_catalog')
+    with view_columns as (
+        select
+            c.oid as view_oid,
+            a.attname::information_schema.sql_identifier as column_name
+        from pg_attribute a
+        join pg_class c on a.attrelid = c.oid
+        join pg_namespace nc on c.relnamespace = nc.oid
+        where
+            not pg_is_other_temp_schema(nc.oid)
+            and a.attnum > 0
+            and not a.attisdropped
+            and (c.relkind = 'v'::"char")
+            and nc.nspname not in ('information_schema', 'pg_catalog')
    ),
-    view_column_usage AS (
-    	SELECT DISTINCT
-    		v.oid as view_oid,
-    		nv.nspname::information_schema.sql_identifier AS view_schema,
-    		v.relname::information_schema.sql_identifier AS view_name,
-    		nt.nspname::information_schema.sql_identifier AS table_schema,
-    		t.relname::information_schema.sql_identifier AS table_name,
-    		a.attname::information_schema.sql_identifier AS column_name,
-    		pg_get_viewdef(v.oid)::information_schema.character_data AS view_definition
-    	FROM pg_namespace nv
-    	JOIN pg_class v ON nv.oid = v.relnamespace
-    	JOIN pg_depend dv ON v.oid = dv.refobjid
-    	JOIN pg_depend dt ON dv.objid = dt.objid
-    	JOIN pg_class t ON dt.refobjid = t.oid
-    	JOIN pg_namespace nt ON t.relnamespace = nt.oid
-    	JOIN pg_attribute a ON t.oid = a.attrelid AND dt.refobjsubid = a.attnum
+    view_column_usage as (
+        select distinct
+            v.oid as view_oid,
+            nv.nspname::information_schema.sql_identifier as view_schema,
+            v.relname::information_schema.sql_identifier as view_name,
+            nt.nspname::information_schema.sql_identifier as table_schema,
+            t.relname::information_schema.sql_identifier as table_name,
+            a.attname::information_schema.sql_identifier as column_name,
+            pg_get_viewdef(v.oid)::information_schema.character_data as view_definition
+        from pg_namespace nv
+        join pg_class v on nv.oid = v.relnamespace
+        join pg_depend dv on v.oid = dv.refobjid
+        join pg_depend dt on dv.objid = dt.objid
+        join pg_class t on dt.refobjid = t.oid
+        join pg_namespace nt on t.relnamespace = nt.oid
+        join pg_attribute a on t.oid = a.attrelid and dt.refobjsubid = a.attnum

-    	WHERE
-    		nv.nspname not in ('information_schema', 'pg_catalog')
-    		AND v.relkind = 'v'::"char"
-    		AND dv.refclassid = 'pg_class'::regclass::oid
-    		AND dv.classid = 'pg_rewrite'::regclass::oid
-    		AND dv.deptype = 'i'::"char"
-    		AND dv.refobjid <> dt.refobjid
-    		AND dt.classid = 'pg_rewrite'::regclass::oid
-    		AND dt.refclassid = 'pg_class'::regclass::oid
-    		AND (t.relkind = ANY (ARRAY['r'::"char", 'v'::"char", 'f'::"char"]))
+        where
+            nv.nspname not in ('information_schema', 'pg_catalog')
+            and v.relkind = 'v'::"char"
+            and dv.refclassid = 'pg_class'::regclass::oid
+            and dv.classid = 'pg_rewrite'::regclass::oid
+            and dv.deptype = 'i'::"char"
+            and dv.refobjid <> dt.refobjid
+            and dt.classid = 'pg_rewrite'::regclass::oid
+            and dt.refclassid = 'pg_class'::regclass::oid
+            and (t.relkind = any (array['r'::"char", 'v'::"char", 'f'::"char"]))
    ),
-    candidates AS (
-    	SELECT
-    		vcu.*,
-    		(
-    			SELECT CASE WHEN match IS NOT NULL THEN coalesce(match[7], match[4]) END
-    			FROM REGEXP_MATCHES(
-    				CONCAT('SELECT ', SPLIT_PART(vcu.view_definition, 'SELECT', 2)),
-    				CONCAT('SELECT.*?((',vcu.table_name,')|(\w+))\.(', vcu.column_name, ')(\sAS\s(")?([^"]+)\6)?.*?FROM.*?',vcu.table_schema,'\.(\2|',vcu.table_name,'\s+(AS\s)?\3)'),
-    				'ns'
-    			) match
-    		) AS view_column_name
-    	FROM view_column_usage AS vcu
+    candidates as (
+        select
+            vcu.*,
+            (
+                select case when match is not null then coalesce(match[8], match[7], match[4]) end
+                from regexp_matches(
+                    CONCAT('SELECT ', SPLIT_PART(vcu.view_definition, 'SELECT', 2)),
+                    CONCAT('SELECT.*?((',vcu.table_name,')|(\w+))\.(', vcu.column_name, ')(\s+AS\s+("([^"]+)"|([^, \n\t]+)))?.*?FROM.*?',vcu.table_schema,'\.(\2|',vcu.table_name,'\s+(as\s)?\3)'),
+                    'nsi'
+                ) match
+            ) as view_column_name
+        from view_column_usage as vcu
    )
-    SELECT
-    	c.table_schema,
-    	c.table_name,
-    	c.column_name AS table_column_name,
-    	c.view_schema,
-    	c.view_name,
-    	c.view_column_name
-    FROM view_columns AS vc, candidates AS c
-    WHERE
-    	vc.view_oid = c.view_oid AND
-    	vc.column_name = c.view_column_name
-    ORDER BY c.view_schema, c.view_name, c.table_name, c.view_column_name
+    select
+        c.table_schema,
+        c.table_name,
+        c.column_name as table_column_name,
+        c.view_schema,
+        c.view_name,
+        c.view_column_name
+    from view_columns as vc, candidates as c
+    where
+        vc.view_oid = c.view_oid
+        and vc.column_name = c.view_column_name
+    order by c.view_schema, c.view_name, c.table_name, c.view_column_name
    |]

 synonymFromRow :: [Column] -> (Text,Text,Text,Text,Text,Text) -> Maybe (Column,Column)
@@ -35,7 +35,7 @@ import qualified Hasql.Decoders          as HD
 import qualified Data.Aeson              as JSON

 import           PostgREST.RangeQuery    (NonnegRange, rangeLimit, rangeOffset, allRange)
-import           Control.Error           (note)
+import           Control.Error           (note, hush)
 import           Data.Functor.Contravariant (contramap)
 import qualified Data.HashMap.Strict     as HM
 import           Data.Text               (intercalate, unwords, replace, isInfixOf, toLower, split)
@@ -53,6 +53,7 @@ import           Data.Scientific         ( FPFormat (..)
                                         , isInteger
                                         )
 import           Protolude hiding        (from, intercalate, ord, cast)
+import           Unsafe                  (unsafeHead)
 import           PostgREST.ApiRequest    (PreferRepresentation (..))

 {-| The generic query result format used by API responses. The location header
@@ -157,33 +158,74 @@ createWriteStatement qi selectQuery mutateQuery isSingle Full
    | otherwise = asJsonF

 addRelations :: Schema -> [Relation] -> Maybe ReadRequest -> ReadRequest -> Either Text ReadRequest
-addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _, alias)) forest) =
+addRelations schema allRelations parentNode (Node readNode@(query, (name, _, alias)) forest) =
  case parentNode of
-    (Just (Node (Select{from=[parentTable]}, (_, _, _)) _)) -> Node <$> (addRel readNode <$> rel) <*> updatedForest
+    (Just (Node (Select{from=[parentNodeTable]}, (_, _, _)) _)) ->
+      Node <$> readNode' <*> forest'
      where
-        rel = note ("no relation between " <> parentTable <> " and " <> name)
-            $  findRelationByTable schema name parentTable
-           <|> findRelationByColumn schema parentTable name
+        forest' = updateForest $ hush node'
+        node' = Node <$> readNode' <*> pure forest
+        readNode' = addRel readNode <$> rel
+        rel :: Either Text Relation
+        rel = note ("no relation between " <> parentNodeTable <> " and " <> name)
+            $ findRelation schema name parentNodeTable
+
+            where
+              findRelation s nodeTableName parentNodeTableName =
+                find (\r ->
+                  s == tableSchema (relTable r) && -- match schema for relation table
+                  s == tableSchema (relFTable r) && -- match schema for relation foriegn table
+                  (
+
+                    -- (request)        => projects { ..., clients{...} }
+                    -- will match
+                    -- (relation type)  => parent
+                    -- (entity)         => clients  {id}
+                    -- (foriegn entity) => projects {client_id}
+                    (
+                      nodeTableName == tableName (relTable r) && -- match relation table name
+                      parentNodeTableName == tableName (relFTable r) -- match relation foreign table name
+                    ) ||
+
+
+                    -- (request)        => projects { ..., client_id{...} }
+                    -- will match
+                    -- (relation type)  => parent
+                    -- (entity)         => clients  {id}
+                    -- (foriegn entity) => projects {client_id}
+                    (
+                      parentNodeTableName == tableName (relFTable r) &&
+                      length (relFColumns r) == 1 &&
+                      nodeTableName `colMatches` (colName . unsafeHead . relFColumns) r
+                    )
+
+                    -- (request)        => project_id { ..., client_id{...} }
+                    -- will match
+                    -- (relation type)  => parent
+                    -- (entity)         => clients  {id}
+                    -- (foriegn entity) => projects {client_id}
+                    -- this case works becasue before reaching this place
+                    -- addRelation will turn project_id to project so the above condition will match
+                  )
+                ) allRelations
+                where n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString)
        addRel :: (ReadQuery, (NodeName, Maybe Relation, Maybe Alias)) -> Relation -> (ReadQuery, (NodeName, Maybe Relation, Maybe Alias))
        addRel (query', (n, _, a)) r = (query' {from=fromRelation}, (n, Just r, a))
          where fromRelation = map (\t -> if t == n then tableName (relTable r) else t) (from query')

-    _ -> Node (query, (name, Nothing, alias)) <$> updatedForest
+    _ -> n' <$> updateForest (Just (n' forest))
+      where
+        n' = Node (query, (name, Just r, alias))
+        t = Table schema name True -- !!! TODO find another way to get the table from the query
+        r = Relation t [] t [] Root Nothing Nothing Nothing
  where
-    updatedForest = mapM (addRelations schema allRelations (Just node)) forest
-    -- Searches through all the relations and returns a match given the parameter conditions.
-    -- Will only find a relation where both schemas are in the PostgREST schema.
-    -- `findRelationByColumn` also does a ducktype check to see if the column name has any variation of `id` or `fk`. If so then the relation is returned as a match.
-    findRelationByTable s t1 t2 =
-      find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t1 == tableName (relTable r) && t2 == tableName (relFTable r)) allRelations
-    findRelationByColumn s t c =
-      find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t == tableName (relFTable r) && length (relFColumns r) == 1 && c `colMatches` fromMaybe "" (colName <$> (head . relFColumns) r)) allRelations
-      where n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString)
+    updateForest :: Maybe ReadRequest -> Either Text [ReadRequest]
+    updateForest n = mapM (addRelations schema allRelations n) forest

 addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
 addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
  case r of
-    Nothing -> Node nn  <$> updatedForest -- this is the root node
+    Just Relation{relType=Root} -> Node nn  <$> updatedForest -- this is the root node
    Just rel@Relation{relType=Child} -> Node (addCond query (getJoinConditions rel),(n,r,a)) <$> updatedForest
    Just Relation{relType=Parent} -> Node nn <$> updatedForest
    Just rel@Relation{relType=Many, relLTable=(Just linkTable)} ->
@@ -284,7 +326,7 @@ requestToQuery _ _ (DbMutate (Update _ (PayloadParseError _) _)) = undefined
 requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions ord range, (nodeName, maybeRelation, _)) forest)) =
  query
  where
-    -- TODO! the folloing helper functions are just to remove the "schema" part when the table is "source" which is the name
+    -- TODO! the following helper functions are just to remove the "schema" part when the table is "source" which is the name
    -- of our WITH query part
    mainTbl = fromMaybe nodeName (tableName . relTable <$> maybeRelation)
    tblSchema tbl = if tbl == sourceCTEName then "" else schema
@@ -319,6 +361,7 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions
           <> "FROM (" <> subquery <> ") " <> pgFmtIdent table
           <> "), '[]') AS " <> pgFmtIdent (fromMaybe name alias)
           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
@@ -339,7 +382,7 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions
    --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 (Node (_,(_,Nothing,_)) _) _ = undefined
+    getQueryParts _ _ = undefined --error "undefined getQueryParts"
 requestToQuery schema _ (DbMutate (Insert mainTbl (PayloadJSON (UniformObjects rows)))) =
  let qi = QualifiedIdentifier schema mainTbl
      cols = map pgFmtIdent $ fromMaybe [] (HM.keys <$> (rows V.!? 0))
@@ -437,6 +480,7 @@ getJoinConditions (Relation t cols ft fcs typ lt lc1 lc2) =
    Child  -> zipWith (toFilter tN ftN) cols fcs
    Parent -> zipWith (toFilter tN ftN) cols fcs
    Many   -> zipWith (toFilter tN ltN) cols (fromMaybe [] lc1) ++ zipWith (toFilter ftN ltN) fcs (fromMaybe [] lc2)
+    Root   -> undefined --error "undefined getJoinConditions"
  where
    s = if typ == Parent then "" else tableSchema t
    tN = tableName t
@@ -88,7 +88,7 @@ data QualifiedIdentifier = QualifiedIdentifier {
 } deriving (Show, Eq)


-data RelationType = Child | Parent | Many deriving (Show, Eq)
+data RelationType = Child | Parent | Many | Root deriving (Show, Eq)
 data Relation = Relation {
  relTable    :: Table
 , relColumns  :: [Column]