Properly check that custom field names do not conflict with other fields

server/src-lib/Hasura/RQL/DDL/Schema/Cache/Fields.hs

@@ -10,6 +10,7 @@ import           Hasura.Prelude
 import qualified Data.HashMap.Strict.Extended       as M
 import qualified Data.HashSet                       as HS
 import qualified Data.Sequence                      as Seq
+import qualified Language.GraphQL.Draft.Syntax      as G
 
 import           Control.Arrow.Extended
 import           Data.Aeson
@@ -32,39 +33,44 @@ addNonColumnFields
      , [CatalogRelation]
      , [CatalogComputedField]
      ) `arr` FieldInfoMap FieldInfo
-addNonColumnFields =
-  proc (rawTableInfo, columns, relationships, computedFields) -> do
-    let foreignKeys = _tciForeignKeys <$> rawTableInfo
-    relationshipInfos <-
-      (| Inc.keyed (\_ relationshipsByName -> do
-           maybeRelationship <- noDuplicates mkRelationshipMetadataObject -< relationshipsByName
-           (\info -> join info >- returnA) <-<
-             (| traverseA (\relationship -> do
-                  info <- buildRelationship -< (foreignKeys, relationship)
-                  returnA -< info <&> (, mkRelationshipMetadataObject relationship))
-             |) maybeRelationship)
-      |) (M.groupOn _crRelName relationships)
+addNonColumnFields = proc (rawTableInfo, columns, relationships, computedFields) -> do
+  let foreignKeys = _tciForeignKeys <$> rawTableInfo
+  relationshipInfos <-
+    (| Inc.keyed (\_ relationshipsByName -> do
+         maybeRelationship <- noDuplicates mkRelationshipMetadataObject -< relationshipsByName
+         (\info -> join info >- returnA) <-<
+           (| traverseA (\relationship -> do
+                info <- buildRelationship -< (foreignKeys, relationship)
+                returnA -< info <&> (, mkRelationshipMetadataObject relationship))
+           |) maybeRelationship)
+    |) (M.groupOn _crRelName relationships)
 
-    let trackedTableNames = HS.fromList $ M.keys rawTableInfo
-    computedFieldInfos <-
-      (| Inc.keyed (\_ computedFieldsByName -> do
-           maybeComputedField <- noDuplicates mkComputedFieldMetadataObject -< computedFieldsByName
-           (\info -> join info >- returnA) <-<
-             (| traverseA (\computedField -> do
-                  info <- buildComputedField -< (trackedTableNames, computedField)
-                  returnA -< info <&> (, mkComputedFieldMetadataObject computedField))
-             |) maybeComputedField)
-      |) (M.groupOn (_afcName . _cccComputedField) computedFields)
+  let trackedTableNames = HS.fromList $ M.keys rawTableInfo
+  computedFieldInfos <-
+    (| Inc.keyed (\_ computedFieldsByName -> do
+         maybeComputedField <- noDuplicates mkComputedFieldMetadataObject -< computedFieldsByName
+         (\info -> join info >- returnA) <-<
+           (| traverseA (\computedField -> do
+                info <- buildComputedField -< (trackedTableNames, computedField)
+                returnA -< info <&> (, mkComputedFieldMetadataObject computedField))
+           |) maybeComputedField)
+    |) (M.groupOn (_afcName . _cccComputedField) computedFields)
 
-    let mapKey f = M.fromList . map (first f) . M.toList
-        relationshipFields = mapKey fromRel $ M.catMaybes relationshipInfos
-        computedFieldFields = mapKey fromComputedField $ M.catMaybes computedFieldInfos
-    nonColumnFields <-
-      (| Inc.keyed (\fieldName fields -> noFieldConflicts -< (fieldName, fields))
-      |) (align relationshipFields computedFieldFields)
+  let mapKey f = M.fromList . map (first f) . M.toList
+      relationshipFields = mapKey fromRel $ M.catMaybes relationshipInfos
+      computedFieldFields = mapKey fromComputedField $ M.catMaybes computedFieldInfos
 
-    (| Inc.keyed (\_ fields -> noColumnConflicts -< fields)
-     |) (align columns (M.catMaybes nonColumnFields))
+  -- First, check for conflicts between non-column fields, since we can raise a better error
+  -- message in terms of the two metadata objects that define them.
+  (align relationshipFields computedFieldFields >- returnA)
+    >-> (| Inc.keyed (\fieldName fields -> (fieldName, fields) >- noFieldConflicts) |)
+    -- Next, check for conflicts with custom field names. This is easiest to do before merging with
+    -- the column info itself because we have access to the information separately, and custom field
+    -- names are not currently stored as a separate map (but maybe should be!).
+    >-> (\fields -> (columns, M.catMaybes fields) >- noCustomFieldConflicts)
+    -- Finally, check for conflicts with the columns themselves.
+    >-> (\fields -> align columns (M.catMaybes fields) >- returnA)
+    >-> (| Inc.keyed (\_ fields -> fields >- noColumnConflicts) |)
   where
     noFieldConflicts = proc (fieldName, fields) -> case fields of
       This (relationship, metadata) -> returnA -< Just (FIRelationship relationship, metadata)
@@ -75,6 +81,24 @@ addNonColumnFields =
           [relationshipMetadata, computedFieldMetadata]
         returnA -< Nothing
 
+    noCustomFieldConflicts = proc (columns, nonColumnFields) -> do
+      let columnsByGQLName = mapFromL pgiName $ M.elems columns
+      (| Inc.keyed (\_ (fieldInfo, metadata) ->
+         (| withRecordInconsistency (do
+            (| traverseA_ (\fieldGQLName -> case M.lookup fieldGQLName columnsByGQLName of
+                 -- Only raise an error if the GQL name isn’t the same as the Postgres column name.
+                 -- If they are the same, `noColumnConflicts` will catch it, and it will produce a
+                 -- more useful error message.
+                 Just columnInfo | getPGColTxt (pgiColumn columnInfo) /= G.unName fieldGQLName ->
+                   throwA -< err400 AlreadyExists
+                     $ "field definition conflicts with custom field name for postgres column "
+                     <>> pgiColumn columnInfo
+                 _ -> returnA -< ())
+             |) (fieldInfoGraphQLNames fieldInfo)
+            returnA -< (fieldInfo, metadata))
+         |) metadata)
+       |) nonColumnFields
+
     noColumnConflicts = proc fields -> case fields of
       This columnInfo -> returnA -< FIColumn columnInfo
       That (fieldInfo, _) -> returnA -< fieldInfo

server/src-lib/Hasura/RQL/DDL/Schema/Table.hs

@@ -33,6 +33,7 @@ import           Hasura.RQL.DDL.Schema.Enum
 import           Hasura.RQL.DDL.Schema.Rename
 import           Hasura.RQL.Types
 import           Hasura.RQL.Types.Catalog
+import           Hasura.Server.Utils
 import           Hasura.SQL.Types
 
 import qualified Database.PG.Query                  as Q
@@ -319,51 +320,31 @@ buildTableCache = Inc.cache proc catalogTables -> do
     -- Step 1: Build the raw table cache from metadata information.
     buildRawTableInfo :: ErrorA QErr arr CatalogTable (TableCoreInfoG PGRawColumnInfo PGCol)
     buildRawTableInfo = Inc.cache proc (CatalogTable name systemDefined isEnum config maybeInfo) -> do
-        catalogInfo <-
-          (| onNothingA (throwA -<
-               err400 NotExists $ "no such table/view exists in postgres: " <>> name)
-          |) maybeInfo
+      catalogInfo <-
+        (| onNothingA (throwA -<
+             err400 NotExists $ "no such table/view exists in postgres: " <>> name)
+        |) maybeInfo
 
-        let columns = _ctiColumns catalogInfo
-            columnMap = mapFromL (fromPGCol . prciName) columns
-            primaryKey = _ctiPrimaryKey catalogInfo
+      let columns = _ctiColumns catalogInfo
+          columnMap = mapFromL (fromPGCol . prciName) columns
+          primaryKey = _ctiPrimaryKey catalogInfo
+      rawPrimaryKey <- liftEitherA -< traverse (resolvePrimaryKeyColumns columnMap) primaryKey
+      enumValues <- if isEnum
+        then bindErrorA -< Just <$> fetchAndValidateEnumValues name rawPrimaryKey columns
+        else returnA -< Nothing
 
-        rawPrimaryKey <- liftEitherA -< traverse (resolvePrimaryKeyColumns columnMap) primaryKey
-        enumValues <- if isEnum
-          then bindErrorA -< Just <$> fetchAndValidateEnumValues name rawPrimaryKey columns
-          else returnA -< Nothing
-
-        -- validate tableConfig
-        -- FIXME
-        -- withPathK "configuration" $ validateTableConfig info config
-        returnA -< TableCoreInfo
-          { _tciName = name
-          , _tciSystemDefined = systemDefined
-          , _tciFieldInfoMap = columnMap
-          , _tciPrimaryKey = primaryKey
-          , _tciUniqueConstraints = _ctiUniqueConstraints catalogInfo
-          , _tciForeignKeys = S.map unCatalogForeignKey $ _ctiForeignKeys catalogInfo
-          , _tciViewInfo = _ctiViewInfo catalogInfo
-          , _tciEnumValues = enumValues
-          , _tciCustomConfig = config
-          , _tciDescription = _ctiDescription catalogInfo
-          }
-
-    -- validateTableConfig :: TableCoreInfo a -> TableConfig -> m ()
-    -- validateTableConfig tableInfo (TableConfig rootFlds colFlds) = do
-    --     withPathK "custom_root_fields" $ do
-    --       sc <- askSchemaCache
-    --       let defRemoteGCtx = scDefaultRemoteGCtx sc
-    --       validateCustomRootFlds defRemoteGCtx rootFlds
-    --     withPathK "custom_column_names" $
-    --       forM_ (M.toList colFlds) $ \(col, customName) -> do
-    --         void $ askPGColInfo (_tciFieldInfoMap tableInfo) col ""
-    --         withPathK (getPGColTxt col) $
-    --           _checkForFieldConflict tableInfo $ FieldName $ G.unName customName
-    --         when (not $ null duplicateNames) $ throw400 NotSupported $
-    --           "the following names are duplicated: " <> showNames duplicateNames
-    --   where
-    --     duplicateNames = duplicates $ M.elems colFlds
+      returnA -< TableCoreInfo
+        { _tciName = name
+        , _tciSystemDefined = systemDefined
+        , _tciFieldInfoMap = columnMap
+        , _tciPrimaryKey = primaryKey
+        , _tciUniqueConstraints = _ctiUniqueConstraints catalogInfo
+        , _tciForeignKeys = S.map unCatalogForeignKey $ _ctiForeignKeys catalogInfo
+        , _tciViewInfo = _ctiViewInfo catalogInfo
+        , _tciEnumValues = enumValues
+        , _tciCustomConfig = config
+        , _tciDescription = _ctiDescription catalogInfo
+        }
 
     -- Step 2: Process the raw table cache to replace Postgres column types with logical column
     -- types.
@@ -373,14 +354,14 @@ buildTableCache = Inc.cache proc catalogTables -> do
        , TableCoreInfoG PGRawColumnInfo PGCol
        ) TableRawInfo
     processTableInfo = proc (enumTables, rawInfo) -> liftEitherA -< do
-      let tableName = _tciName rawInfo
+      let columns = _tciFieldInfoMap rawInfo
           enumReferences = resolveEnumReferences enumTables (_tciForeignKeys rawInfo)
-          customFields = _tcCustomColumnNames $ _tciCustomConfig rawInfo
+      columnInfoMap <-
+            alignCustomColumnNames columns (_tcCustomColumnNames $ _tciCustomConfig rawInfo)
+        >>= traverse (processColumnInfo enumReferences (_tciName rawInfo))
+      assertNoDuplicateFieldNames (M.elems columnInfoMap)
 
-      columnInfoMap <- _tciFieldInfoMap rawInfo
-        & traverse (processColumnInfo enumReferences customFields tableName)
       primaryKey <- traverse (resolvePrimaryKeyColumns columnInfoMap) (_tciPrimaryKey rawInfo)
-
       pure rawInfo
         { _tciFieldInfoMap = columnInfoMap
         , _tciPrimaryKey = primaryKey
@@ -392,27 +373,38 @@ buildTableCache = Inc.cache proc catalogTables -> do
       M.lookup (fromPGCol columnName) columnMap
         `onNothing` throw500 "column in primary key not in table!"
 
+    alignCustomColumnNames
+      :: (QErrM n)
+      => FieldInfoMap PGRawColumnInfo
+      -> CustomColumnNames
+      -> n (FieldInfoMap (PGRawColumnInfo, G.Name))
+    alignCustomColumnNames columns customNames = do
+      let customNamesByFieldName = M.fromList $ map (first fromPGCol) $ M.toList customNames
+      flip M.traverseWithKey (align columns customNamesByFieldName) \columnName -> \case
+        This column -> pure (column, G.Name $ getFieldNameTxt columnName)
+        These column customName -> pure (column, customName)
+        That customName -> throw400 NotExists $ "the custom field name " <> customName
+          <<> " was given for the column " <> columnName <<> ", but no such column exists"
+
     -- | “Processes” a 'PGRawColumnInfo' into a 'PGColumnInfo' by resolving its type using a map of
     -- known enum tables.
     processColumnInfo
       :: (QErrM n)
       => M.HashMap PGCol (NonEmpty EnumReference)
-      -> CustomColumnNames -- ^ customised graphql names
       -> QualifiedTable -- ^ the table this column belongs to
-      -> PGRawColumnInfo -- ^ the column’s raw information
+      -> (PGRawColumnInfo, G.Name)
       -> n PGColumnInfo
-    processColumnInfo tableEnumReferences customFields tableName rawInfo = do
+    processColumnInfo tableEnumReferences tableName (rawInfo, name) = do
       resolvedType <- resolveColumnType
       pure PGColumnInfo
         { pgiColumn = pgCol
-        , pgiName = graphqlName
+        , pgiName = name
         , pgiType = resolvedType
         , pgiIsNullable = prciIsNullable rawInfo
         , pgiDescription = prciDescription rawInfo
         }
       where
         pgCol = prciName rawInfo
-        graphqlName = fromMaybe (G.Name $ getPGColTxt pgCol) $ M.lookup pgCol customFields
         resolveColumnType =
           case M.lookup pgCol tableEnumReferences of
             -- no references? not an enum
@@ -424,3 +416,11 @@ buildTableCache = Inc.cache proc catalogTables -> do
               $ "column " <> prciName rawInfo <<> " in table " <> tableName
               <<> " references multiple enum tables ("
               <> T.intercalate ", " (map (dquote . erTable) $ toList enumReferences) <> ")"
+
+    assertNoDuplicateFieldNames columns =
+      flip M.traverseWithKey (M.groupOn pgiName columns) \name columnsWithName ->
+        case columnsWithName of
+          one:two:more -> throw400 AlreadyExists $ "the definitions of columns "
+            <> englishList (dquoteTxt . pgiColumn <$> (one:|two:more))
+            <> " are in conflict: they are mapped to the same field name, " <>> name
+          _ -> pure ()

server/src-lib/Hasura/RQL/Types/SchemaCache.hs

@@ -59,7 +59,7 @@ module Hasura.RQL.Types.SchemaCache
   , _FIRelationship
   , _FIComputedField
   , fieldInfoName
-  , possibleNonColumnGraphQLFields
+  , fieldInfoGraphQLNames
   , getCols
   , getRels
   , getComputedFieldInfos
@@ -172,22 +172,22 @@ type FieldInfoMap = M.HashMap FieldName
 
 fieldInfoName :: FieldInfo -> FieldName
 fieldInfoName = \case
-  -- TODO: should this be pgiName?
   FIColumn info -> fromPGCol $ pgiColumn info
   FIRelationship info -> fromRel $ riName info
   FIComputedField info -> fromComputedField $ _cfiName info
 
-possibleNonColumnGraphQLFields :: FieldInfoMap FieldInfo -> [G.Name]
-possibleNonColumnGraphQLFields fields =
-  flip concatMap (M.toList fields) $ \case
-    (_, FIColumn _)             -> []
-    (_, FIRelationship relInfo) ->
-      let relationshipName = G.Name $ relNameToTxt $ riName relInfo
-      in case riType relInfo of
-           ObjRel -> [relationshipName]
-           ArrRel -> [relationshipName, relationshipName <> "_aggregate"]
-    (_, FIComputedField info) ->
-      pure $ G.Name $ computedFieldNameToText $ _cfiName info
+-- | Returns all the field names created for the given field. Columns, object relationships, and
+-- computed fields only ever produce a single field, but array relationships also contain an
+-- @_aggregate@ field.
+fieldInfoGraphQLNames :: FieldInfo -> [G.Name]
+fieldInfoGraphQLNames = \case
+  FIColumn info -> [pgiName info]
+  FIRelationship info ->
+    let name = G.Name . relNameToTxt $ riName info
+    in case riType info of
+      ObjRel -> [name]
+      ArrRel -> [name, name <> "_aggregate"]
+  FIComputedField info -> [G.Name . computedFieldNameToText $ _cfiName info]
 
 getCols :: FieldInfoMap FieldInfo -> [PGColumnInfo]
 getCols = mapMaybe (^? _FIColumn) . M.elems

server/src-lib/Hasura/SQL/Types.hs

@@ -63,23 +63,24 @@ module Hasura.SQL.Types
   )
 where
 
-import qualified Database.PG.Query          as Q
-import qualified Database.PG.Query.PTI      as PTI
+import qualified Database.PG.Query             as Q
+import qualified Database.PG.Query.PTI         as PTI
 
 import           Hasura.Prelude
 
 import           Data.Aeson
 import           Data.Aeson.Casing
-import           Data.Aeson.Encoding        (text)
+import           Data.Aeson.Encoding           (text)
 import           Data.Aeson.TH
-import           Data.Aeson.Types           (toJSONKeyText)
-import           Instances.TH.Lift          ()
-import           Language.Haskell.TH.Syntax (Lift)
+import           Data.Aeson.Types              (toJSONKeyText)
+import           Instances.TH.Lift             ()
+import           Language.Haskell.TH.Syntax    (Lift)
 
-import qualified Data.Text.Extended         as T
-import qualified Database.PostgreSQL.LibPQ  as PQ
-import qualified PostgreSQL.Binary.Decoding as PD
-import qualified Text.Builder               as TB
+import qualified Data.Text.Extended            as T
+import qualified Database.PostgreSQL.LibPQ     as PQ
+import qualified Language.GraphQL.Draft.Syntax as G
+import qualified PostgreSQL.Binary.Decoding    as PD
+import qualified Text.Builder                  as TB
 
 class ToSQL a where
   toSQL :: a -> TB.Builder
@@ -118,6 +119,8 @@ instance DQuote T.Text where
   dquoteTxt = id
   {-# INLINE dquoteTxt #-}
 
+deriving instance DQuote G.Name
+
 dquote :: (DQuote a) => a -> T.Text
 dquote = T.dquote . dquoteTxt
 {-# INLINE dquote #-}

server/src-lib/Hasura/Server/Utils.hs

@@ -13,6 +13,7 @@ import           System.Process
 import qualified Data.ByteString            as B
 import qualified Data.CaseInsensitive       as CI
 import qualified Data.HashSet               as Set
+import qualified Data.List.NonEmpty         as NE
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as TE
 import qualified Data.Text.IO               as TI
@@ -208,6 +209,14 @@ instance FromJSON APIVersion where
       2 -> return VIVersion2
       i -> fail $ "expected 1 or 2, encountered " ++ show i
 
+englishList :: NonEmpty Text -> Text
+englishList = \case
+  one :| []    -> one
+  one :| [two] -> one <> " and " <> two
+  several      ->
+    let final :| initials = NE.reverse several
+    in T.intercalate ", " (reverse initials) <> ", and " <> final
+
 makeReasonMessage :: [a] -> (a -> Text) -> Text
 makeReasonMessage errors showError =
   case errors of

server/tests-py/queries/v1/set_table_custom_fields/conflict_with_relationship.yaml

@@ -2,10 +2,21 @@ description: Set custom column names conflicting with existing relationship
 url: /v1/query
 status: 400
 response:
-  path: "$.args.custom_column_names"
-  error: 'the following custom column names conflict with existing non-column fields:
-    articles_aggregate, articles'
-  code: not-supported
+  internal:
+  - definition:
+      using:
+        foreign_key_constraint_on:
+          column: author_id
+          table: article
+      name: articles
+      comment:
+      table: author
+    reason: field definition conflicts with custom field name for postgres column
+      "name"
+    type: array_relation
+  path: $.args
+  error: cannot continue due to new inconsistent metadata
+  code: unexpected
 query:
   type: set_table_custom_fields
   version: 2

server/tests-py/queries/v1/set_table_custom_fields/relationship_conflict_with_custom_column.yaml

@@ -2,9 +2,21 @@ description: Try to define a relationship with custom column name
 url: /v1/query
 status: 400
 response:
-  path: "$.args"
-  error: custom column name "AuthorId" of table "author" already exists
-  code: already-exists
+  internal:
+  - definition:
+      using:
+        foreign_key_constraint_on:
+          column: author_id
+          table: article
+      name: AuthorId
+      comment:
+      table: author
+    reason: field definition conflicts with custom field name for postgres column
+      "id"
+    type: array_relation
+  path: $.args
+  error: field definition conflicts with custom field name for postgres column "id"
+  code: constraint-violation
 query:
   type: create_array_relationship
   args: