From d34bea3e976479704da7c13c6c7604b9546d112e Mon Sep 17 00:00:00 2001 From: Lyndon Maydwell Date: Mon, 9 Jan 2023 17:25:32 +1000 Subject: [PATCH] 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 | 1 + server/lib/api-tests/api-tests.cabal | 1 + .../API/Metadata/SuggestRelationshipsSpec.hs | 319 ++++++++++++++++++ server/lib/test-harness/src/Harness/Yaml.hs | 10 + .../Hasura/RQL/DDL/Relationship/Suggest.hs | 199 +++++++++++ server/src-lib/Hasura/Server/API/Backend.hs | 3 +- server/src-lib/Hasura/Server/API/Metadata.hs | 4 + .../Hasura/Server/API/Metadata.hs-boot | 2 + 8 files changed, 538 insertions(+), 1 deletion(-) create mode 100644 server/lib/api-tests/src/Test/API/Metadata/SuggestRelationshipsSpec.hs create mode 100644 server/src-lib/Hasura/RQL/DDL/Relationship/Suggest.hs diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 8264b828e6b..3ca24554773 100644 --- a/server/graphql-engine.cabal +++ b/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 diff --git a/server/lib/api-tests/api-tests.cabal b/server/lib/api-tests/api-tests.cabal index 393e55faf26..b2374d8dbf0 100644 --- a/server/lib/api-tests/api-tests.cabal +++ b/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 diff --git a/server/lib/api-tests/src/Test/API/Metadata/SuggestRelationshipsSpec.hs b/server/lib/api-tests/src/Test/API/Metadata/SuggestRelationshipsSpec.hs new file mode 100644 index 00000000000..3aa34ce5421 --- /dev/null +++ b/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 + |] diff --git a/server/lib/test-harness/src/Harness/Yaml.hs b/server/lib/test-harness/src/Harness/Yaml.hs index 189d452ed41..29c2e036462 100644 --- a/server/lib/test-harness/src/Harness/Yaml.hs +++ b/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 diff --git a/server/src-lib/Hasura/RQL/DDL/Relationship/Suggest.hs b/server/src-lib/Hasura/RQL/DDL/Relationship/Suggest.hs new file mode 100644 index 00000000000..cc946d11b7c --- /dev/null +++ b/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) diff --git a/server/src-lib/Hasura/Server/API/Backend.hs b/server/src-lib/Hasura/Server/API/Backend.hs index 7280a2fe1f1..103eb3a8144 100644 --- a/server/src-lib/Hasura/Server/API/Backend.hs +++ b/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] diff --git a/server/src-lib/Hasura/Server/API/Metadata.hs b/server/src-lib/Hasura/Server/API/Metadata.hs index 7585e4b96b5..064a442ae72 100644 --- a/server/src-lib/Hasura/Server/API/Metadata.hs +++ 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 diff --git a/server/src-lib/Hasura/Server/API/Metadata.hs-boot b/server/src-lib/Hasura/Server/API/Metadata.hs-boot index 7783100a43d..4a3afec774c 100644 --- a/server/src-lib/Hasura/Server/API/Metadata.hs-boot +++ b/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)