Metadata API for Suggesting Relationships from HGE

[GDC-629]: https://hasurahq.atlassian.net/browse/GDC-629?atlOrigin=eyJpIjoiNWRkNTljNzYxNjVmNDY3MDlhMDU5Y2ZhYzA5YTRkZjUiLCJwIjoiZ2l0aHViLWNvbS1KU1cifQ

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7420
GitOrigin-RevId: 0bf69f8409d5141783f9cf5d8d54f798d9e05e65

server/graphql-engine.cabal

@@ -799,6 +799,7 @@ library
                      , Hasura.RQL.DDL.QueryTags
                      , Hasura.RQL.DDL.Relationship
                      , Hasura.RQL.DDL.Relationship.Rename
+                     , Hasura.RQL.DDL.Relationship.Suggest
                      , Hasura.RQL.DDL.RemoteRelationship
                      , Hasura.RQL.DDL.Webhook.Transform
                      , Hasura.RQL.DDL.Webhook.Transform.Body

server/lib/api-tests/api-tests.cabal

@@ -71,6 +71,7 @@ library
     Test.API.ConcurrentBulkSpec
     Test.API.ExplainSpec
     Test.API.Metadata.ComputedFieldsSpec
+    Test.API.Metadata.SuggestRelationshipsSpec
     Test.API.Metadata.InconsistentSpec
     Test.API.Metadata.TransparentDefaultsSpec
     Test.API.Schema.RunSQLSpec

server/lib/api-tests/src/Test/API/Metadata/SuggestRelationshipsSpec.hs

@@ -0,0 +1,319 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+-- | All tests related to metadata API for relationship suggestion API
+module Test.API.Metadata.SuggestRelationshipsSpec (spec) where
+
+import Data.List.NonEmpty qualified as NE
+import Data.Maybe qualified as Maybe
+import Harness.Backend.Postgres qualified as Postgres
+import Harness.GraphqlEngine qualified as GraphqlEngine
+import Harness.Quoter.Yaml (yaml)
+import Harness.Test.Fixture qualified as Fixture
+import Harness.Test.Schema qualified as Schema
+import Harness.TestEnvironment (GlobalTestEnvironment, TestEnvironment, getBackendTypeConfig)
+import Harness.Yaml (mapObject, shouldReturnYaml, shouldReturnYamlF, sortArray)
+import Hasura.Prelude
+import Test.Hspec (SpecWith, describe, it)
+
+-- ** Preamble
+
+spec :: SpecWith GlobalTestEnvironment
+spec =
+  Fixture.run
+    ( NE.fromList
+        [ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnv, _) ->
+                [ Postgres.setupTablesAction schema testEnv,
+                  setupMetadata testEnv
+                ]
+            }
+        ]
+    )
+    tests
+
+-- ** Schema
+
+schema :: [Schema.Table]
+schema =
+  [ (Schema.table "author")
+      { Schema.tableColumns =
+          [ Schema.column "id" Schema.TInt,
+            Schema.column "name" Schema.TStr
+          ],
+        Schema.tablePrimaryKey = ["id"]
+      },
+    (Schema.table "publication")
+      { Schema.tableColumns =
+          [ Schema.column "id" Schema.TInt,
+            Schema.column "name" Schema.TStr
+          ],
+        Schema.tablePrimaryKey = ["id"]
+      },
+    (Schema.table "article")
+      { Schema.tableColumns =
+          [ Schema.column "id" Schema.TInt,
+            Schema.column "title" Schema.TStr,
+            Schema.column "content" Schema.TStr,
+            Schema.column "author_id" Schema.TInt,
+            Schema.column "publication_id" Schema.TInt
+          ],
+        Schema.tablePrimaryKey = ["id"],
+        Schema.tableReferences =
+          [ Schema.reference "publication_id" "publication" "id",
+            Schema.reference "author_id" "author" "id"
+          ],
+        Schema.tableUniqueIndexes =
+          [ Schema.UniqueIndexColumns ["publication_id"]
+          ]
+      }
+  ]
+
+setupMetadata :: TestEnvironment -> Fixture.SetupAction
+setupMetadata testEnv = do
+  let backendTypeMetadata = fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnv
+      sourceName = Fixture.backendSourceName backendTypeMetadata
+      schemaName = Schema.getSchemaName testEnv
+      sourceConfiguration = Postgres.defaultSourceConfiguration testEnv
+
+      setup :: IO ()
+      setup =
+        GraphqlEngine.postMetadata_
+          testEnv
+          [yaml|
+            type: replace_metadata
+            args:
+              metadata:
+                version: 3
+                sources:
+                  - name: *sourceName
+                    kind: postgres
+                    configuration: *sourceConfiguration
+                    tables:
+                      - table:
+                          name: author
+                          schema: *schemaName
+                      - table:
+                          name: article
+                          schema: *schemaName
+                        object_relationships:
+                          - name: publication
+                            using:
+                              foreign_key_constraint_on: publication_id
+                      - table:
+                          name: publication
+                          schema: *schemaName
+          |]
+
+      teardown :: IO ()
+      teardown =
+        GraphqlEngine.postMetadata_
+          testEnv
+          [yaml|
+            type: replace_metadata
+            args:
+              metadata:
+                version: 3
+                sources:
+                  - name: *sourceName
+                    kind: postgres
+                    configuration: *sourceConfiguration
+                    tables: []
+          |]
+
+  Fixture.SetupAction setup (const teardown)
+
+-- * Tests
+
+tests :: Fixture.Options -> SpecWith TestEnvironment
+tests opts = do
+  describe "Suggest Relationships" do
+    it "Uses reciprocal object relations if there is a unique constraint on the FK column" $ \testEnv -> do
+      let backendTypeMetadata = Maybe.fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnv
+          sourceName = Fixture.backendSourceName backendTypeMetadata
+          schemaName = Schema.unSchemaName $ Schema.getSchemaName testEnv
+
+      shouldReturnYaml
+        opts
+        ( GraphqlEngine.postMetadataWithStatus
+            200
+            testEnv
+            [yaml|
+              type: pg_suggest_relationships
+              version: 1
+              args:
+                source: *sourceName
+                tables:
+                  - name: article
+                    schema: *schemaName
+                  - name: publication
+                    schema: *schemaName
+            |]
+        )
+        [yaml|
+          relationships:
+            - from:
+                columns:
+                  - publication_id
+                table:
+                  name: article
+                  schema: hasura
+              to:
+                columns:
+                  - id
+                table:
+                  name: publication
+                  schema: hasura
+              type: object
+            - from:
+                columns:
+                  - id
+                table:
+                  name: publication
+                  schema: hasura
+              to:
+                columns:
+                  - publication_id
+                table:
+                  name: article
+                  schema: hasura
+              type: object
+        |]
+
+    it "Omits tracked relationships if that is requested" $ \testEnv -> do
+      let backendTypeMetadata = Maybe.fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnv
+          sourceName = Fixture.backendSourceName backendTypeMetadata
+
+      shouldReturnYaml
+        opts
+        ( GraphqlEngine.postMetadataWithStatus
+            200
+            testEnv
+            [yaml|
+              type: pg_suggest_relationships
+              version: 1
+              args:
+                source: *sourceName
+                omit_tracked: true
+            |]
+        )
+        [yaml|
+          relationships:
+            - from:
+                columns:
+                  - author_id
+                table:
+                  name: article
+                  schema: hasura
+              to:
+                columns:
+                  - id
+                table:
+                  name: author
+                  schema: hasura
+              type: object
+            - from:
+                columns:
+                  - id
+                table:
+                  name: author
+                  schema: hasura
+              to:
+                columns:
+                  - author_id
+                table:
+                  name: article
+                  schema: hasura
+              type: array
+        |]
+
+    it "Recommendations should only include listed tables if included" $ \testEnv -> do
+      let backendTypeMetadata = Maybe.fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnv
+          sourceName = Fixture.backendSourceName backendTypeMetadata
+
+      shouldReturnYaml
+        opts
+        ( GraphqlEngine.postMetadataWithStatus
+            200
+            testEnv
+            [yaml|
+              type: pg_suggest_relationships
+              version: 1
+              args:
+                source: *sourceName
+                tables: []
+            |]
+        )
+        [yaml| relationships: [] |]
+
+    it "All recommendations are made by default" $ \testEnv -> do
+      let backendTypeMetadata = Maybe.fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnv
+          sourceName = Fixture.backendSourceName backendTypeMetadata
+
+      shouldReturnYamlF
+        (pure . mapObject sortArray)
+        opts
+        ( GraphqlEngine.postMetadataWithStatus
+            200
+            testEnv
+            [yaml|
+              type: pg_suggest_relationships
+              version: 1
+              args:
+                source: *sourceName
+            |]
+        )
+        [yaml|
+          relationships:
+            - from:
+                columns:
+                  - author_id
+                table:
+                  name: article
+                  schema: hasura
+              to:
+                columns:
+                  - id
+                table:
+                  name: author
+                  schema: hasura
+              type: object
+            - from:
+                columns:
+                  - id
+                table:
+                  name: author
+                  schema: hasura
+              to:
+                columns:
+                  - author_id
+                table:
+                  name: article
+                  schema: hasura
+              type: array
+            - from:
+                columns:
+                  - id
+                table:
+                  name: publication
+                  schema: hasura
+              to:
+                columns:
+                  - publication_id
+                table:
+                  name: article
+                  schema: hasura
+              type: object
+            - from:
+                columns:
+                  - publication_id
+                table:
+                  name: article
+                  schema: hasura
+              to:
+                columns:
+                  - id
+                table:
+                  name: publication
+                  schema: hasura
+              type: object
+        |]

server/lib/test-harness/src/Harness/Yaml.hs

@@ -2,6 +2,8 @@
 module Harness.Yaml
   ( combinationsObject,
     fromObject,
+    mapObject,
+    sortArray,
     combinationsObjectUsingValue,
     shouldReturnYaml,
     shouldReturnYamlF,
@@ -35,6 +37,14 @@ fromObject :: Value -> Object
 fromObject (Object x) = x
 fromObject v = error $ "fromObject: Expected object, received" <> show v
 
+mapObject :: (Value -> Value) -> Value -> Value
+mapObject f (Object x) = Object $ fmap f x
+mapObject _ _ = error "mapObject can only be called on Object Values"
+
+sortArray :: Value -> Value
+sortArray (Array a) = Array (V.fromList (sort (V.toList a)))
+sortArray _ = error "sortArray can only be called on Array Values"
+
 -- | Compute all variations of an object and construct a list of
 -- 'Value' based on the higher order function that is passed to it.  A
 -- single variation of 'Object' is constructed as an 'Array' before

server/src-lib/Hasura/RQL/DDL/Relationship/Suggest.hs

@@ -0,0 +1,199 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedLists #-}
+
+-- | This module provides an API for suggesting relationships so that
+--   the console (or client) does not need to construct and submit relationship queries itself.
+--
+--   This suggests reciprocal object relationships A -> object -> B -> object -> A if there is a unique
+--   constraint on the column(s) in A mapping A->B, and if not then a reciprocal array relationship
+--   A -> object -> B -> array -> A is suggested.
+--
+--   All JSON fields to the main exported function `runSuggestRels` are optional and behave as follows:
+--
+--   * _srsSource: The source to suggest relationships for - Defaults to `defaultSource`
+--   * _srsTables: The tables to suggest relationships between - Defaults to all tables
+--   * _srsOmitTracked: Only suggest untracked relationships - Defaults to False
+--
+--   Autodocodec Codecs instances are implemented for these datatypes.
+module Hasura.RQL.DDL.Relationship.Suggest
+  ( SuggestRels,
+    runSuggestRels,
+  )
+where
+
+import Autodocodec
+import Autodocodec.OpenAPI ()
+import Control.Lens (preview)
+import Data.Aeson (FromJSON (), ToJSON ())
+import Data.HashMap.Strict qualified as Map
+import Data.HashMap.Strict.NonEmpty qualified as MapNE
+import Data.HashSet qualified as H
+import Data.OpenApi (ToSchema (..))
+import Hasura.Base.Error
+import Hasura.EncJSON
+import Hasura.Prelude
+import Hasura.RQL.Types.Backend
+import Hasura.RQL.Types.Common
+import Hasura.RQL.Types.Metadata.Backend
+import Hasura.RQL.Types.Relationships.Local (RelInfo (riMapping, riRTable))
+import Hasura.RQL.Types.SchemaCache
+import Hasura.RQL.Types.SchemaCache.Build
+import Hasura.RQL.Types.Table (ForeignKey, UniqueConstraint, _fkColumnMapping, _fkForeignTable, _ucColumns)
+
+-- | Datatype used by Metadata API to represent Request for Suggested Relationships
+data SuggestRels b = SuggestRels
+  { _srsSource :: SourceName,
+    _srsTables :: Maybe [TableName b],
+    _srsOmitTracked :: Bool
+  }
+  deriving (Generic)
+  deriving (FromJSON, ToJSON, ToSchema) via Autodocodec (SuggestRels b)
+
+instance Backend b => HasCodec (SuggestRels b) where
+  codec =
+    object
+      "SuggestRels"
+      ( SuggestRels
+          <$> optionalFieldWithOmittedDefault "source" defaultSource "The source to suggest relationships for - Defaults to 'default'."
+            .= _srsSource
+          <*> optionalFieldOrNull "tables" "The list of tables to suggest relationships for - Defaults to all tracked tables."
+            .= _srsTables
+          <*> optionalFieldWithOmittedDefault "omit_tracked" False "Determines if currently tracked relationships should be ommited from suggestions - Defaults to false."
+            .= _srsOmitTracked
+      )
+      <??> ["API call to request suggestions for relationships"]
+
+newtype SuggestedRelationships b = Relationships
+  { sRelationships :: [Relationship b]
+  }
+  deriving (Generic)
+  deriving (FromJSON, ToJSON, ToSchema) via Autodocodec (SuggestedRelationships b)
+
+instance Backend b => HasCodec (SuggestedRelationships b) where
+  codec =
+    object
+      "SuggestedRelationships"
+      ( Relationships
+          <$> requiredField' "relationships"
+            .= sRelationships
+      )
+
+data Relationship b = Relationship
+  { rType :: RelType,
+    rFrom :: Mapping b,
+    rTo :: Mapping b
+  }
+  deriving (Generic)
+  deriving (FromJSON, ToJSON, ToSchema) via Autodocodec (Relationship b)
+
+instance Backend b => HasCodec (Relationship b) where
+  codec =
+    object
+      "Relationship"
+      ( Relationship
+          <$> requiredField' "type"
+            .= rType
+          <*> requiredField' "from"
+            .= rFrom
+          <*> requiredField' "to"
+            .= rTo
+      )
+
+data Mapping b = Mapping
+  { mTable :: TableName b,
+    mColumns :: [Column b]
+  }
+  deriving (Generic)
+  deriving (FromJSON, ToJSON, ToSchema) via Autodocodec (Mapping b)
+
+instance Backend b => HasCodec (Mapping b) where
+  codec =
+    object
+      "Mapping"
+      ( Mapping
+          <$> requiredField' "table"
+            .= mTable
+          <*> requiredField' "columns"
+            .= mColumns
+      )
+
+--  | Most of the heavy lifting for this module occurs in this function.
+--    Suggests reciprocal relationships for foreign keys.
+--    Incorporates logic to omit previously-tracked relationships
+--    and only considers required tables.
+suggestRelsFK ::
+  forall b.
+  Backend b =>
+  -- | Omits currently tracked relationships from recommendations if True.
+  Bool ->
+  HashMap (TableName b) (TableCoreInfo b) ->
+  TableName b ->
+  HashSet (UniqueConstraint b) ->
+  H.HashSet (TableName b, HashMap (Column b) (Column b)) ->
+  ForeignKey b ->
+  [Relationship b]
+suggestRelsFK omitTracked tables name uniqueConstraints tracked foreignKey =
+  case (omitTracked, H.member (relatedTable, columnRelationships) tracked, Map.lookup relatedTable tables) of
+    (True, True, _) -> []
+    (_, _, Nothing) -> []
+    (_, _, Just _) ->
+      [ Relationship
+          { rType = ObjRel,
+            rFrom = Mapping {mTable = name, mColumns = localColumns},
+            rTo = Mapping {mTable = relatedTable, mColumns = relatedColumns}
+          },
+        Relationship
+          { rType = if H.fromList localColumns `H.member` uniqueConstraintColumns then ObjRel else ArrRel,
+            rTo = Mapping {mTable = name, mColumns = localColumns},
+            rFrom = Mapping {mTable = relatedTable, mColumns = relatedColumns}
+          }
+      ]
+  where
+    columnRelationships = MapNE.toHashMap (_fkColumnMapping foreignKey)
+    localColumns = Map.keys columnRelationships
+    relatedColumns = Map.elems columnRelationships
+    uniqueConstraintColumns = H.map _ucColumns uniqueConstraints
+    relatedTable = _fkForeignTable foreignKey
+
+suggestRelsTable ::
+  forall b.
+  Backend b =>
+  Bool ->
+  HashMap (TableName b) (TableCoreInfo b) ->
+  (TableName b, TableCoreInfo b) ->
+  [Relationship b]
+suggestRelsTable omitTracked tables (name, table) =
+  suggestRelsFK omitTracked tables name constraints tracked =<< toList foreignKeys
+  where
+    foreignKeys = _tciForeignKeys table
+    constraints = _tciUniqueConstraints table
+    tracked = H.fromList $ mapMaybe (relationships (riRTable &&& riMapping)) $ Map.elems $ _tciFieldInfoMap table
+    relationships f = fmap f . preview _FIRelationship
+
+-- NOTE: This could be grouped by table instead of a list, console stakeholders are happy with this being a list.
+suggestRelsResponse ::
+  forall b.
+  Backend b =>
+  Bool ->
+  HashMap (TableName b) (TableCoreInfo b) ->
+  SuggestedRelationships b
+suggestRelsResponse omitTracked tables =
+  Relationships $
+    suggestRelsTable omitTracked tables =<< Map.toList tables
+
+-- | Helper to filter tables considered for relationships
+pluck :: Eq a => Maybe [a] -> Map.HashMap a b -> Map.HashMap a b
+pluck Nothing = id
+pluck (Just ks) = Map.mapMaybeWithKey (\k v -> if k `elem` ks then Just v else Nothing)
+
+-- | The method invoked when dispatching on metadata calls in POST /v1/metadata
+runSuggestRels ::
+  forall b m.
+  (MonadError QErr m, CacheRWM m, BackendMetadata b) =>
+  SuggestRels b ->
+  m EncJSON
+runSuggestRels (SuggestRels source tablesM omitExistingB) = do
+  tableCacheM <- fmap (fmap (_tiCoreInfo)) <$> askTableCache @b source
+  case tableCacheM of
+    Nothing -> throw500 "Couldn't find any schema source information"
+    Just tableCache -> pure $ encJFromJValue $ suggestRelsResponse @b omitExistingB (pluck tablesM tableCache)

server/src-lib/Hasura/Server/API/Backend.hs

@@ -135,7 +135,8 @@ relationshipCommands =
     commandParser "create_array_relationship" $ RMCreateArrayRelationship . mkAnyBackend @b,
     commandParser "set_relationship_comment" $ RMSetRelationshipComment . mkAnyBackend @b,
     commandParser "rename_relationship" $ RMRenameRelationship . mkAnyBackend @b,
-    commandParser "drop_relationship" $ RMDropRelationship . mkAnyBackend @b
+    commandParser "drop_relationship" $ RMDropRelationship . mkAnyBackend @b,
+    commandParser "suggest_relationships" $ RMSuggestRelationships . mkAnyBackend @b
   ]
 
 remoteRelationshipCommands :: forall (b :: BackendType). Backend b => [CommandParser b]

server/src-lib/Hasura/Server/API/Metadata.hs

@@ -40,6 +40,7 @@ import Hasura.RQL.DDL.QueryCollection
 import Hasura.RQL.DDL.QueryTags
 import Hasura.RQL.DDL.Relationship
 import Hasura.RQL.DDL.Relationship.Rename
+import Hasura.RQL.DDL.Relationship.Suggest
 import Hasura.RQL.DDL.RemoteRelationship
 import Hasura.RQL.DDL.ScheduledTrigger
 import Hasura.RQL.DDL.Schema
@@ -111,6 +112,7 @@ data RQLMetadataV1
   | RMDropRelationship !(AnyBackend DropRel)
   | RMSetRelationshipComment !(AnyBackend SetRelComment)
   | RMRenameRelationship !(AnyBackend RenameRel)
+  | RMSuggestRelationships !(AnyBackend SuggestRels)
   | -- Tables remote relationships
     RMCreateRemoteRelationship !(AnyBackend CreateFromSourceRelationship)
   | RMUpdateRemoteRelationship !(AnyBackend CreateFromSourceRelationship)
@@ -475,6 +477,7 @@ queryModifiesMetadata = \case
       RMListSourceKinds _ -> False
       RMGetSourceTables _ -> False
       RMGetTableInfo _ -> False
+      RMSuggestRelationships _ -> False
       RMBulk qs -> any queryModifiesMetadata qs
       -- We used to assume that the fallthrough was True,
       -- but it is better to be explicit here to warn when new constructors are added.
@@ -643,6 +646,7 @@ runMetadataQueryV1M env currentResourceVersion = \case
   RMDropRelationship q -> dispatchMetadata runDropRel q
   RMSetRelationshipComment q -> dispatchMetadata runSetRelComment q
   RMRenameRelationship q -> dispatchMetadata runRenameRel q
+  RMSuggestRelationships q -> dispatchMetadata runSuggestRels q
   RMCreateRemoteRelationship q -> dispatchMetadata runCreateRemoteRelationship q
   RMUpdateRemoteRelationship q -> dispatchMetadata runUpdateRemoteRelationship q
   RMDeleteRemoteRelationship q -> dispatchMetadata runDeleteRemoteRelationship q

server/src-lib/Hasura/Server/API/Metadata.hs-boot

@@ -12,6 +12,7 @@ import Hasura.RQL.DDL.Permission
 import Hasura.RQL.DDL.QueryTags
 import Hasura.RQL.DDL.Relationship
 import Hasura.RQL.DDL.Relationship.Rename
+import Hasura.RQL.DDL.Relationship.Suggest
 import Hasura.RQL.DDL.RemoteRelationship
 import Hasura.RQL.DDL.Schema
 import Hasura.RQL.DDL.Schema.Source
@@ -66,6 +67,7 @@ data RQLMetadataV1
   | RMDropRelationship !(AnyBackend DropRel)
   | RMSetRelationshipComment !(AnyBackend SetRelComment)
   | RMRenameRelationship !(AnyBackend RenameRel)
+  | RMSuggestRelationships !(AnyBackend SuggestRels)
   | -- Tables remote relationships
     RMCreateRemoteRelationship !(AnyBackend CreateFromSourceRelationship)
   | RMUpdateRemoteRelationship !(AnyBackend CreateFromSourceRelationship)