Fix conflicting data connector comparison exp GraphQL types

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6394
GitOrigin-RevId: c272e8aad426a18ccadfec005e03d5b2669e035c

server/src-lib/Hasura/Backends/DataConnector/Adapter/Schema.hs

@@ -12,7 +12,6 @@ import Data.HashMap.Strict qualified as Map
 import Data.List.NonEmpty qualified as NE
 import Data.Text.Casing (GQLNameIdentifier, fromCustomName)
 import Data.Text.Extended ((<<>))
-import Data.Text.NonEmpty qualified as NET
 import Hasura.Backends.DataConnector.API.V0.Capabilities (lookupComparisonInputObjectDefinition)
 import Hasura.Backends.DataConnector.Adapter.Backend (CustomBooleanOperator (..))
 import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
@@ -141,7 +140,7 @@ possiblyNullable' _scalarType (GQL.Nullability isNullable)
 orderByOperators' :: RQL.SourceInfo 'DataConnector -> NamingCase -> (GQL.Name, NonEmpty (P.Definition P.EnumValueInfo, (RQL.BasicOrderType 'DataConnector, RQL.NullsOrderType 'DataConnector)))
 orderByOperators' RQL.SourceInfo {_siConfiguration} _tCase =
   let dcName = DC._scDataConnectorName _siConfiguration
-      orderBy = fromMaybe Name._order_by $ GQL.mkName $ NET.unNonEmptyText (DC.unDataConnectorName dcName) <> "_order_by"
+      orderBy = GQL.addSuffixes (DC.unDataConnectorName dcName) [$$(GQL.litSuffix "_order_by")]
    in (orderBy,) $
         -- NOTE: NamingCase is not being used here as we don't support naming conventions for this DB
         NE.fromList
@@ -166,7 +165,7 @@ comparisonExps' sourceInfo columnType = P.memoizeOn 'comparisonExps' (dataConnec
   collapseIfNull <- GS.C.retrieve Options.soDangerousBooleanCollapse
 
   typedParser <- columnParser' columnType (GQL.Nullability False)
-  let name = P.getName typedParser <> $$(GQL.litName "_Dynamic_comparison_exp")
+  let name = GQL.addSuffixes (P.getName typedParser) [$$(GQL.litSuffix "_"), GQL.convertNameToSuffix (DC.unDataConnectorName dataConnectorName), $$(GQL.litSuffix "_comparison_exp")]
       desc =
         GQL.Description $
           "Boolean expression to compare columns of type "

server/src-lib/Hasura/Backends/DataConnector/Adapter/Types.hs

@@ -39,7 +39,7 @@ import Data.Data (Typeable)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Text qualified as Text
 import Data.Text.Extended (ToTxt (..))
-import Data.Text.NonEmpty (NonEmptyText (unNonEmptyText))
+import Data.Text.NonEmpty (NonEmptyText, mkNonEmptyTextUnsafe)
 import Hasura.Backends.DataConnector.API qualified as API
 import Hasura.Base.ErrorValue qualified as ErrorValue
 import Hasura.Base.ToErrorValue (ToErrorValue (..))
@@ -149,15 +149,16 @@ instance Cacheable SourceConfig where
 
 --------------------------------------------------------------------------------
 
-newtype DataConnectorName = DataConnectorName {unDataConnectorName :: NonEmptyText}
+newtype DataConnectorName = DataConnectorName {unDataConnectorName :: GQL.Name}
   deriving stock (Eq, Ord, Show, Typeable, Generic)
   deriving newtype (FromJSON, ToJSON, FromJSONKey, ToJSONKey, Hashable, ToTxt)
   deriving anyclass (Cacheable, NFData)
 
-instance Witch.From DataConnectorName NonEmptyText
+instance Witch.From DataConnectorName NonEmptyText where
+  from = mkNonEmptyTextUnsafe . GQL.unName . unDataConnectorName -- mkNonEmptyTextUnsafe is safe here since GQL.Name is never empty
 
 instance Witch.From DataConnectorName Text where
-  from = unNonEmptyText . Witch.from
+  from = GQL.unName . unDataConnectorName
 
 data DataConnectorOptions = DataConnectorOptions
   {_dcoUri :: BaseUrl}

server/src-lib/Hasura/RQL/DDL/DataConnector.hs

@@ -16,8 +16,7 @@ where
 import Data.Aeson (FromJSON, ToJSON, (.:), (.=))
 import Data.Aeson qualified as Aeson
 import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
-import Data.Text.NonEmpty (NonEmptyText)
-import Data.Text.NonEmpty qualified as Text.NE
+import Data.Text.Extended (ToTxt (..))
 import Hasura.Backends.DataConnector.Adapter.Types qualified as DC.Types
 import Hasura.Base.Error qualified as Error
 import Hasura.EncJSON (EncJSON)
@@ -32,7 +31,7 @@ import Servant.Client qualified as Servant
 --------------------------------------------------------------------------------
 
 data DCAddAgent = DCAddAgent
-  { _gdcaName :: NonEmptyText,
+  { _gdcaName :: DC.Types.DataConnectorName,
     _gdcaUrl :: Servant.BaseUrl
   }
 
@@ -56,13 +55,12 @@ runAddDataConnectorAgent ::
   DCAddAgent ->
   m EncJSON
 runAddDataConnectorAgent DCAddAgent {..} = do
-  let kind = DC.Types.DataConnectorName _gdcaName
-      agent = DC.Types.DataConnectorOptions _gdcaUrl
+  let agent = DC.Types.DataConnectorOptions _gdcaUrl
 
   let modifier =
         Metadata.MetadataModifier $
           Metadata.metaBackendConfigs %~ BackendMap.modify @'Backend.DataConnector \oldMap ->
-            Metadata.BackendConfigWrapper $ InsOrdHashMap.insert kind agent (coerce oldMap)
+            Metadata.BackendConfigWrapper $ InsOrdHashMap.insert _gdcaName agent (coerce oldMap)
 
   SC.Build.withNewInconsistentObjsCheck $ SC.Build.buildSchemaCache modifier
 
@@ -70,7 +68,7 @@ runAddDataConnectorAgent DCAddAgent {..} = do
 
 --------------------------------------------------------------------------------
 
-newtype DCDeleteAgent = DCDeleteAgent {_dcdaName :: NonEmptyText}
+newtype DCDeleteAgent = DCDeleteAgent {_dcdaName :: DC.Types.DataConnectorName}
 
 instance FromJSON DCDeleteAgent where
   parseJSON = Aeson.withObject "DCDeleteAgent" \o -> do
@@ -89,21 +87,19 @@ runDeleteDataConnectorAgent ::
   DCDeleteAgent ->
   m EncJSON
 runDeleteDataConnectorAgent DCDeleteAgent {..} = do
-  let kind = DC.Types.DataConnectorName _dcdaName
-
   oldMetadata <- Metadata.getMetadata
 
   let kindExists = do
         agentMap <- BackendMap.lookup @'Backend.DataConnector $ Metadata._metaBackendConfigs oldMetadata
-        InsOrdHashMap.lookup kind $ Metadata.unBackendConfigWrapper agentMap
+        InsOrdHashMap.lookup _dcdaName $ Metadata.unBackendConfigWrapper agentMap
   case kindExists of
-    Nothing -> Error.throw400 Error.NotFound $ "DC Agent '" <> Text.NE.unNonEmptyText _dcdaName <> "' not found"
+    Nothing -> Error.throw400 Error.NotFound $ "DC Agent '" <> toTxt _dcdaName <> "' not found"
     Just _ -> do
       let modifier =
             Metadata.MetadataModifier $
               Metadata.metaBackendConfigs
                 %~ BackendMap.alter @'Backend.DataConnector
-                  (fmap (coerce . InsOrdHashMap.delete kind . Metadata.unBackendConfigWrapper))
+                  (fmap (coerce . InsOrdHashMap.delete _dcdaName . Metadata.unBackendConfigWrapper))
 
       SC.Build.withNewInconsistentObjsCheck $ SC.Build.buildSchemaCache modifier
       pure Common.successMsg

server/src-lib/Hasura/RQL/DDL/SourceKinds.hs

@@ -31,8 +31,10 @@ import Hasura.EncJSON qualified as EncJSON
 import Hasura.Prelude
 import Hasura.RQL.Types.Metadata qualified as Metadata
 import Hasura.RQL.Types.SchemaCache qualified as SchemaCache
+import Hasura.SQL.AnyBackend qualified as AB
 import Hasura.SQL.Backend qualified as Backend
 import Hasura.SQL.BackendMap qualified as BackendMap
+import Language.GraphQL.Draft.Syntax qualified as GQL
 import Network.HTTP.Client.Manager qualified as HTTP.Manager
 
 --------------------------------------------------------------------------------
@@ -84,7 +86,7 @@ agentSourceKinds = do
 
 mkAgentSource :: DC.Types.DataConnectorName -> SourceKindInfo
 mkAgentSource (DC.Types.DataConnectorName name) =
-  SourceKindInfo {_skiSourceKind = NE.Text.unNonEmptyText name, _skiBuiltin = Agent}
+  SourceKindInfo {_skiSourceKind = GQL.unName name, _skiBuiltin = Agent}
 
 mkNativeSource :: Backend.BackendType -> Maybe SourceKindInfo
 mkNativeSource = \case
@@ -116,16 +118,19 @@ runGetSourceKindCapabilities ::
   GetSourceKindCapabilities ->
   m EncJSON
 runGetSourceKindCapabilities GetSourceKindCapabilities {..} = do
-  case Backend.backendTypeFromText $ NE.Text.unNonEmptyText _gskcKind of
-    -- NOTE: A succesful parse here implies a native backend
-    Just backend -> Error.throw400 Error.DataConnectorError (Text.E.toTxt backend <> " does not support Capabilities.")
-    Nothing -> do
-      backendCache <- fmap SchemaCache.scBackendCache $ SchemaCache.askSchemaCache
-      let capabilitiesMap = maybe mempty SchemaCache.unBackendInfoWrapper $ BackendMap.lookup @'Backend.DataConnector backendCache
-      let dataConnectorName = DC.Types.DataConnectorName _gskcKind
+  case AB.backendSourceKindFromText $ NE.Text.unNonEmptyText _gskcKind of
+    Just backendSourceKind ->
+      case AB.unpackAnyBackend @'Backend.DataConnector backendSourceKind of
+        Just (Backend.DataConnectorKind dataConnectorName) -> do
+          backendCache <- fmap SchemaCache.scBackendCache $ SchemaCache.askSchemaCache
+          let capabilitiesMap = maybe mempty SchemaCache.unBackendInfoWrapper $ BackendMap.lookup @'Backend.DataConnector backendCache
+          capabilities <-
+            HashMap.lookup dataConnectorName capabilitiesMap
+              `onNothing` Error.throw400 Error.DataConnectorError ("Source Kind " <> Text.E.toTxt dataConnectorName <> " was not found")
 
-      capabilities <-
-        HashMap.lookup dataConnectorName capabilitiesMap
-          `onNothing` Error.throw400 Error.DataConnectorError ("Source Kind " <> Text.E.toTxt dataConnectorName <> " was not found.")
-
-      pure $ EncJSON.encJFromJValue capabilities
+          pure $ EncJSON.encJFromJValue capabilities
+        Nothing ->
+          -- Must be a native backend
+          Error.throw400 Error.DataConnectorError (Text.E.toTxt _gskcKind <> " does not support Capabilities")
+    Nothing ->
+      Error.throw400 Error.DataConnectorError ("Source Kind " <> Text.E.toTxt _gskcKind <> " was not found")

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

@@ -111,12 +111,12 @@ import Control.Arrow.Extended (ArrowChoice)
 import Data.Aeson
 import Data.Aeson.Types (Parser)
 import Data.Kind (Constraint, Type)
-import Data.Text.NonEmpty (mkNonEmptyText)
 import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName (..))
 import Hasura.Incremental (Cacheable)
 import Hasura.Prelude
 import Hasura.SQL.Backend
 import Hasura.SQL.Tag
+import Language.GraphQL.Draft.Syntax qualified as GQL
 
 --------------------------------------------------------------------------------
 
@@ -478,7 +478,7 @@ backendSourceKindFromText text =
     <|> BigQueryValue <$> staticKindFromText BigQueryKind
     <|> MySQLValue <$> staticKindFromText MySQLKind
     -- IMPORTANT: This must be the last thing here, since it will accept (almost) any string
-    <|> DataConnectorValue . DataConnectorKind . DataConnectorName <$> mkNonEmptyText text
+    <|> DataConnectorValue . DataConnectorKind . DataConnectorName <$> GQL.mkName text
   where
     staticKindFromText :: BackendSourceKind b -> Maybe (BackendSourceKind b)
     staticKindFromText kind =

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

@@ -14,16 +14,17 @@ module Hasura.SQL.Backend
   )
 where
 
-import Autodocodec (HasCodec (codec), JSONCodec, bimapCodec, dimapCodec, literalTextCodec, parseAlternatives)
-import Data.Aeson
+import Autodocodec (Codec (StringCodec), HasCodec (codec), JSONCodec, bimapCodec, dimapCodec, literalTextCodec, parseAlternatives, (<?>))
+import Data.Aeson hiding ((<?>))
 import Data.Aeson.Types (Parser)
 import Data.Proxy
 import Data.Text (unpack)
 import Data.Text.Extended
-import Data.Text.NonEmpty (NonEmptyText, mkNonEmptyText, nonEmptyTextCodec, nonEmptyTextQQ)
+import Data.Text.NonEmpty (NonEmptyText, nonEmptyTextQQ)
 import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName (..))
 import Hasura.Incremental
 import Hasura.Prelude
+import Language.GraphQL.Draft.Syntax qualified as GQL
 import Witch qualified
 
 -- | Argument to Postgres; we represent backends which are variations on Postgres as sub-types of
@@ -134,8 +135,7 @@ instance FromJSON (BackendSourceKind ('MySQL)) where
 
 instance FromJSON (BackendSourceKind ('DataConnector)) where
   parseJSON = withText "BackendSourceKind" $ \text ->
-    DataConnectorKind . DataConnectorName <$> mkNonEmptyText text
-      `onNothing` fail "Cannot be empty string"
+    DataConnectorKind . DataConnectorName <$> GQL.parseName text
 
 mkParseStaticBackendSourceKind :: BackendSourceKind b -> (Value -> Parser (BackendSourceKind b))
 mkParseStaticBackendSourceKind backendSourceKind =
@@ -165,10 +165,21 @@ instance HasCodec (BackendSourceKind ('MySQL)) where
   codec = mkCodecStaticBackendSourceKind MySQLKind
 
 instance HasCodec (BackendSourceKind ('DataConnector)) where
-  codec = dimapCodec dec enc nonEmptyTextCodec
+  codec = dimapCodec dec enc gqlNameCodec
     where
       dec = DataConnectorKind . DataConnectorName
-      enc = Witch.into
+      enc :: BackendSourceKind ('DataConnector) -> GQL.Name
+      enc (DataConnectorKind (DataConnectorName name)) = name
+
+      gqlNameCodec :: JSONCodec GQL.Name
+      gqlNameCodec =
+        bimapCodec
+          parseName
+          GQL.unName
+          (StringCodec (Just "GraphQLName"))
+          <?> "A valid GraphQL name"
+
+      parseName text = GQL.mkName text `onNothing` Left (unpack text <> " is not a valid GraphQL name")
 
 mkCodecStaticBackendSourceKind :: BackendSourceKind b -> JSONCodec (BackendSourceKind b)
 mkCodecStaticBackendSourceKind backendSourceKind =

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

@@ -13,7 +13,6 @@ import Data.Aeson
 import Data.Aeson.Types (Parser)
 import Data.Environment qualified as Env
 import Data.Text qualified as T
-import Data.Text.NonEmpty (mkNonEmptyText)
 import GHC.Generics.Extended (constrName)
 import Hasura.Backends.BigQuery.DDL.RunSQL qualified as BigQuery
 import Hasura.Backends.DataConnector.Adapter.RunSQL qualified as DataConnector
@@ -47,6 +46,7 @@ import Hasura.SQL.Backend
 import Hasura.Server.Types
 import Hasura.Session
 import Hasura.Tracing qualified as Tracing
+import Language.GraphQL.Draft.Syntax qualified as GQL
 import Network.HTTP.Client qualified as HTTP
 
 data RQLQuery
@@ -72,7 +72,7 @@ instance FromJSON RQLQuery where
     t <- o .: "type"
     let args :: forall a. FromJSON a => Parser a
         args = o .: "args"
-        dcNameFromRunSql = T.stripSuffix "_run_sql" >=> mkNonEmptyText >=> pure . DataConnectorName
+        dcNameFromRunSql = T.stripSuffix "_run_sql" >=> GQL.mkName >=> pure . DataConnectorName
     case t of
       "insert" -> RQInsert <$> args
       "select" -> RQSelect <$> args