server: better error message on column type mismatch

GitOrigin-RevId: d3d1ff4278e4ced37e90e950fd9043883f72d37f

server/src-lib/Hasura/Backends/Postgres/DDL/BoolExp.hs

@@ -274,31 +274,22 @@ parseBoolExpOperations rhsParser rootTable fim columnInfo value = do
           _ -> throwError $ buildMsg colTy [PGGeometry, PGGeography]
 
         decodeAndValidateRhsCol :: Value -> m (PGCol, Maybe QualifiedTable)
-        decodeAndValidateRhsCol v@(String _) = do
-          j <- decodeValue v
-          col <- validateRhsCol fim j
-          pure (col, Nothing)
-        decodeAndValidateRhsCol (Array path) = do
-          case toList path of
+        decodeAndValidateRhsCol v = case v of
+          String _   -> go Nothing fim v
+          Array path -> case toList path of
             [] -> throw400 Unexpected "path cannot be empty"
-            [col] -> do
-              j <- decodeValue col
-              col' <- validateRhsCol fim j
-              pure $ (col', Nothing)
-            (root : col : []) -> do
-              root' :: Text <- decodeValue root
-              unless (root' == "$") $
-                throw400 NotSupported "Relationship references are not supported in column comparison RHS"
-              rootTableInfo <-
-                lookupTableCoreInfo rootTable
-                >>= (`onNothing` (throw500 $ "unexpected: " <> rootTable <<> " doesn't exist"))
-              j <- decodeValue col
-              col' <- validateRhsCol (_tciFieldInfoMap rootTableInfo) j
-              pure $ (col', Just rootTable)
+            [col] -> go Nothing fim col
+            [String "$", col] -> do
+              rootTableInfo <- lookupTableCoreInfo rootTable >>=
+                flip onNothing (throw500 $ "unexpected: " <> rootTable <<> " doesn't exist")
+              go (Just rootTable) (_tciFieldInfoMap rootTableInfo) col
             _ -> throw400 NotSupported "Relationship references are not supported in column comparison RHS"
-
-        decodeAndValidateRhsCol _ =
-          throw400 Unexpected "a boolean expression JSON can either be a string or an array"
+          _ -> throw400 Unexpected "a boolean expression JSON must be either a string or an array"
+          where
+            go rootInfo fieldsInfoMap columnValue = do
+              colName <- decodeValue columnValue
+              colInfo <- validateRhsCol fieldsInfoMap colName
+              pure (colInfo, rootInfo)
 
         parseST3DDWithinObj = ABackendSpecific <$> do
           guardType [PGGeometry]
@@ -308,12 +299,12 @@ parseBoolExpOperations rhsParser rootTable fim columnInfo value = do
           return $ AST3DDWithinGeom $ DWithinGeomOp dist from
 
         validateRhsCol fieldInfoMap rhsCol = do
-          let errMsg = "column operators can only compare postgres columns"
-          rhsType <- askColumnType fieldInfoMap rhsCol errMsg
-          if colTy /= rhsType
-            then throw400 UnexpectedPayload $
-                 "incompatible column types : " <> column <<> ", " <>> rhsCol
-            else return rhsCol
+          rhsType <- askColumnType fieldInfoMap rhsCol "column operators can only compare postgres columns"
+          when (colTy /= rhsType) $
+            throw400 UnexpectedPayload $ "incompatible column types: " <>
+            column <<> " has type " <> colTy <<> ", but " <>
+            rhsCol <<> " has type " <>> rhsType
+          pure rhsCol
 
         parseWithTy ty = rhsParser (CollectableTypeScalar ty) val