perf: Relationship list to a hash map

src/PostgREST/DbStructure.hs

@@ -51,7 +51,8 @@ import PostgREST.DbStructure.Proc         (PgType (..),
                                            ProcsMap, RetType (..))
 import PostgREST.DbStructure.Relationship (Cardinality (..),
                                            Junction (..),
-                                           Relationship (..))
+                                           Relationship (..),
+                                           RelationshipsMap)
 import PostgREST.DbStructure.Table        (Column (..), Table (..),
                                            TablesMap)
 
@@ -60,7 +61,7 @@ import Protolude
 
 data DbStructure = DbStructure
   { dbTables        :: TablesMap
-  , dbRelationships :: [Relationship]
+  , dbRelationships :: RelationshipsMap
   , dbProcs         :: ProcsMap
   }
   deriving (Generic, JSON.ToJSON)
@@ -95,22 +96,24 @@ queryDbStructure schemas extraSearchPath prepared = do
   procs   <- SQL.statement schemas $ allProcs pgVer prepared
 
   let tabsWViewsPks = addViewPrimaryKeys tabs keyDeps
-      rels          = addO2MRels $ addM2MRels tabsWViewsPks $ addViewM2ORels keyDeps m2oRels
+      rels          = relsToMap $ addO2MRels $ addM2MRels tabsWViewsPks $ addViewM2ORels keyDeps m2oRels
 
   return $ removeInternal schemas $ DbStructure {
       dbTables = tabsWViewsPks
     , dbRelationships = rels
     , dbProcs = procs
     }
+  where
+    relsToMap = map sort . M.fromListWith (++) . map ((\(x,y) -> (x, [y])) . addKey)
+    addKey rel = (relTable rel, rel)
 
 -- | Remove db objects that belong to an internal schema(not exposed through the API) from the DbStructure.
 removeInternal :: [Schema] -> DbStructure -> DbStructure
 removeInternal schemas dbStruct =
   DbStructure {
       dbTables        = M.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas) $ dbTables dbStruct
-    , dbRelationships = filter (\x -> qiSchema (relTable x) `elem` schemas &&
+    , dbRelationships = filter (\r -> qiSchema (relForeignTable r) `elem` schemas && not (hasInternalJunction r)) <$>
-                                      qiSchema (relForeignTable x) `elem` schemas &&
+                        M.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch `elem` schemas ) (dbRelationships dbStruct)
-                                      not (hasInternalJunction x)) $ dbRelationships dbStruct
     , dbProcs         = dbProcs dbStruct -- procs are only obtained from the exposed schemas, no need to filter them.
     }
   where
@@ -143,20 +146,13 @@ decodeTables =
 
 decodeRels :: HD.Result [Relationship]
 decodeRels =
-  map relFromRow <$> HD.rowList relRow
+ HD.rowList relRow
  where
-  relRow = (,,,,,)
+  relRow =
-    <$> column HD.text <*> column HD.text
+    Relationship <$>
-    <*> column HD.text <*> column HD.text
+    (QualifiedIdentifier <$> column HD.text <*> column HD.text) <*>
-    <*> column HD.text
+    (QualifiedIdentifier <$> column HD.text <*> column HD.text) <*>
-    <*> compositeArrayColumn
+    (M2O <$> column HD.text <*> compositeArrayColumn ((,) <$> compositeField HD.text <*> compositeField HD.text))
-        ((,)
-        <$> compositeField HD.text
-        <*> compositeField HD.text)
-
-relFromRow :: (Text, Text, Text, Text, Text, [(Text, Text)]) -> Relationship
-relFromRow (rs, rt, frs, frt, cn, cs) =
-  Relationship (QualifiedIdentifier rs rt) (QualifiedIdentifier frs frt) (M2O cn cs)
 
 decodeViewKeyDeps :: HD.Result [ViewKeyDependency]
 decodeViewKeyDeps =

src/PostgREST/DbStructure/Relationship.hs

@@ -6,9 +6,11 @@ module PostgREST.DbStructure.Relationship
   , Relationship(..)
   , Junction(..)
   , isSelfReference
+  , RelationshipsMap
   ) where
 
-import qualified Data.Aeson as JSON
+import qualified Data.Aeson          as JSON
+import qualified Data.HashMap.Strict as M
 
 import PostgREST.DbStructure.Identifiers (FieldName,
                                           QualifiedIdentifier)
@@ -22,7 +24,7 @@ data Relationship = Relationship
   , relForeignTable :: QualifiedIdentifier
   , relCardinality  :: Cardinality
   }
-  deriving (Eq, Generic, JSON.ToJSON)
+  deriving (Eq, Ord, Generic, JSON.ToJSON)
 
 -- | The relationship cardinality
 -- | https://en.wikipedia.org/wiki/Cardinality_(data_modeling)
@@ -34,7 +36,7 @@ data Cardinality
   -- ^ many-to-one
   | M2M Junction
   -- ^ many-to-many
-  deriving (Eq, Generic, JSON.ToJSON)
+  deriving (Eq, Ord, Generic, JSON.ToJSON)
 
 type FKConstraint = Text
 
@@ -46,7 +48,9 @@ data Junction = Junction
   , junColumns1    :: [(FieldName, FieldName)]
   , junColumns2    :: [(FieldName, FieldName)]
   }
-  deriving (Eq, Generic, JSON.ToJSON)
+  deriving (Eq, Ord, Generic, JSON.ToJSON)
 
 isSelfReference :: Relationship -> Bool
 isSelfReference r = relTable r == relForeignTable r
+
+type RelationshipsMap = M.HashMap QualifiedIdentifier [Relationship]

src/PostgREST/OpenAPI.hs

@@ -31,7 +31,8 @@ import PostgREST.DbStructure.Identifiers  (QualifiedIdentifier (..))
 import PostgREST.DbStructure.Proc         (ProcDescription (..),
                                            ProcParam (..))
 import PostgREST.DbStructure.Relationship (Cardinality (..),
-                                           Relationship (..))
+                                           Relationship (..),
+                                           RelationshipsMap)
 import PostgREST.DbStructure.Table        (Column (..), Table (..),
                                            TablesMap)
 import PostgREST.Version                  (docsVersion, prettyVersion)
@@ -79,7 +80,7 @@ parseDefault colType colDefault =
   where
     wrapInQuotations text = "\"" <> text <> "\""
 
-makeTableDef :: [Relationship] -> Table -> (Text, Schema)
+makeTableDef :: RelationshipsMap -> Table -> (Text, Schema)
 makeTableDef rels t =
   let tn = tableName t in
       (tn, (mempty :: Schema)
@@ -88,7 +89,7 @@ makeTableDef rels t =
         & properties .~ fromList (makeProperty t rels <$> tableColumns t)
         & required .~ fmap colName (filter (not . colNullable) $ tableColumns t))
 
-makeProperty :: Table -> [Relationship] -> Column -> (Text, Referenced Schema)
+makeProperty :: Table -> RelationshipsMap -> Column -> (Text, Referenced Schema)
 makeProperty tbl rels col = (colName col, Inline s)
   where
     e = if null $ colEnum col then Nothing else JSON.decode $ JSON.encode $ colEnum col
@@ -99,7 +100,7 @@ makeProperty tbl rels col = (colName col, Inline s)
         rel = find (\case
           Relationship{relCardinality=(M2O _ relColumns)} -> [colName col] == (fst <$> relColumns)
           _                                               -> False
-          ) rels
+          ) $ fromMaybe mempty $ M.lookup (QualifiedIdentifier (tableSchema tbl) (tableName tbl)) rels
         fCol = (headMay . (\r -> snd <$> relColumns (relCardinality r)) =<< rel)
         fTbl = qiName . relForeignTable <$> rel
         fTblCol = (,) <$> fTbl <*> fCol
@@ -320,7 +321,7 @@ escapeHostName "*6" = "0.0.0.0"
 escapeHostName "!6" = "0.0.0.0"
 escapeHostName h    = h
 
-postgrestSpec :: [Relationship] -> [ProcDescription] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Swagger
+postgrestSpec :: RelationshipsMap -> [ProcDescription] -> [Table] -> (Text, Text, Integer, Text) -> Maybe Text -> Swagger
 postgrestSpec rels pds ti (s, h, p, b) sd = (mempty :: Swagger)
   & basePath ?~ T.unpack b
   & schemes ?~ [s']

src/PostgREST/Request/DbRequestBuilder.hs

@@ -36,7 +36,8 @@ import PostgREST.DbStructure.Proc         (ProcDescription (..),
                                            procReturnsScalar)
 import PostgREST.DbStructure.Relationship (Cardinality (..),
                                            Junction (..),
-                                           Relationship (..))
+                                           Relationship (..),
+                                           RelationshipsMap)
 import PostgREST.Error                    (Error (..))
 import PostgREST.Query.SqlFragment        (sourceCTEName)
 import PostgREST.RangeQuery               (NonnegRange, allRange,
@@ -58,7 +59,7 @@ import Protolude hiding (from)
 -- | Builds the ReadRequest tree on a number of stages.
 -- | Adds filters, order, limits on its respective nodes.
 -- | Adds joins conditions obtained from resource embedding.
-readRequest :: Schema -> TableName -> Maybe Integer -> [Relationship] -> ApiRequest -> Either Error ReadRequest
+readRequest :: Schema -> TableName -> Maybe Integer -> RelationshipsMap -> ApiRequest -> Either Error ReadRequest
 readRequest schema rootTableName maxRows allRels apiRequest  =
   mapLeft ApiRequestError $
   treeRestrictRange maxRows (iAction apiRequest) =<<
@@ -105,12 +106,12 @@ treeRestrictRange maxRows _ request = pure $ nodeRestrictRange maxRows <$> reque
     nodeRestrictRange :: Maybe Integer -> ReadNode -> ReadNode
     nodeRestrictRange m (q@Select {range_=r}, i) = (q{range_=restrictRange m r }, i)
 
-augmentRequestWithJoin :: Schema -> [Relationship] -> ReadRequest -> Either ApiRequestError ReadRequest
+augmentRequestWithJoin :: Schema -> RelationshipsMap -> ReadRequest -> Either ApiRequestError ReadRequest
 augmentRequestWithJoin schema allRels request =
   addRels schema allRels Nothing request
   >>= addJoinConditions Nothing
 
-addRels :: Schema -> [Relationship] -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
+addRels :: Schema -> RelationshipsMap -> Maybe ReadRequest -> ReadRequest -> Either ApiRequestError ReadRequest
 addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, alias, hint, joinType, depth)) forest) =
   case parentNode of
     Just (Node (Select{from=parentNodeQi, fromAlias=aliasQi}, _) _) ->
@@ -139,7 +140,7 @@ addRels schema allRels parentNode (Node (query@Select{from=tbl}, (nodeName, _, a
 -- target = table / view / constraint / column-from-origin
 -- hint   = table / view / constraint / column-from-origin / column-from-target
 -- (hint can take table / view values to aid in finding the junction in an m2m relationship)
-findRel :: Schema -> [Relationship] -> NodeName -> NodeName -> Maybe Hint -> Either ApiRequestError Relationship
+findRel :: Schema -> RelationshipsMap -> NodeName -> NodeName -> Maybe Hint -> Either ApiRequestError Relationship
 findRel schema allRels origin target hint =
   case rel of
     []  -> Left $ NoRelBetween origin target schema
@@ -172,23 +173,17 @@ findRel schema allRels origin target hint =
       _                      -> False
     rel = filter (
       \Relationship{..} ->
-        -- Both relationship ends need to be on the exposed schema
+        -- foreign relationship need to be on the exposed schema
-        schema == qiSchema relTable && schema == qiSchema relForeignTable &&
+        schema == qiSchema relForeignTable &&
         (
           -- /projects?select=clients(*)
-          origin == qiName relTable  &&  -- projects
+          target == qiName relForeignTable  -- clients
-          target == qiName relForeignTable ||  -- clients
+          ||
-
           -- /projects?select=projects_client_id_fkey(*)
-          (
+          matchConstraint (Just target) relCardinality -- projects_client_id_fkey
-            origin == qiName relTable &&              -- projects
+          ||
-            matchConstraint (Just target) relCardinality -- projects_client_id_fkey
-          ) ||
           -- /projects?select=client_id(*)
-          (
+          matchFKSingleCol (Just target) relCardinality -- client_id
-            origin == qiName relTable &&                  -- projects
-            matchFKSingleCol (Just target) relCardinality -- client_id
-          )
         ) && (
           isNothing hint || -- hint is optional
 
@@ -202,7 +197,7 @@ findRel schema allRels origin target hint =
           -- /users?select=tasks!users_tasks(*) many-to-many between users and tasks
           matchJunction hint relCardinality -- users_tasks
         )
-      ) allRels
+      ) $ fromMaybe mempty $ M.lookup (QualifiedIdentifier schema origin) allRels
 
 -- previousAlias is only used for the case of self joins
 addJoinConditions :: Maybe Alias -> ReadRequest -> Either ApiRequestError ReadRequest

test/spec/Feature/OpenApi/RootSpec.hs

@@ -27,6 +27,6 @@ spec =
       request methodGet "/"
         [("Accept", "application/json")] "" `shouldRespondWith`
         [json| {
-          "qiSchema":"test","qiName":"has_fk"
+          "qiSchema":"test","qiName":"bars"
           } |]
         { matchHeaders = [matchContentTypeJson] }

test/spec/Feature/Query/EmbedDisambiguationSpec.hs

@@ -98,18 +98,18 @@ spec =
           [json|
             {
               "details": [
-                {
-                    "cardinality": "many-to-one",
-                    "relationship": "agents_department_id_fkey using agents(department_id) and departments(id)",
-                    "embedding": "agents with departments"
-                },
                 {
                     "cardinality": "one-to-many",
                     "relationship": "departments_head_id_fkey using agents(id) and departments(head_id)",
                     "embedding": "agents with departments"
+                },
+                {
+                    "cardinality": "many-to-one",
+                    "relationship": "agents_department_id_fkey using agents(department_id) and departments(id)",
+                    "embedding": "agents with departments"
                 }
               ],
-              "hint": "Try changing 'departments' to one of the following: 'departments!agents_department_id_fkey', 'departments!departments_head_id_fkey'. Find the desired relationship in the 'details' key.",
+              "hint": "Try changing 'departments' to one of the following: 'departments!departments_head_id_fkey', 'departments!agents_department_id_fkey'. Find the desired relationship in the 'details' key.",
               "message": "Could not embed because more than one relationship was found for 'agents' and 'departments'",
               "code": "PGRST201"
             }

test/spec/fixtures/schema.sql

@@ -1843,7 +1843,7 @@ case accept
   when 'application/openapi+json' then
     return openapi;
   when 'application/json' then
-    return (current_setting('request.spec', true)::json)->'dbRelationships'->0->'relTable';
+    return (current_setting('request.spec', true)::json)->'dbRelationships'->0->0;
   else
     return openapi;
   end case;