Prohibit underscores in dataconnector names [GDC-586]

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6681
GitOrigin-RevId: 5335208fc4c8f0d1b16a45415329ef390a269b4c

server/graphql-engine.cabal

@@ -1089,6 +1089,7 @@ test-suite graphql-engine-tests
     Hasura.AppSpec
     Hasura.Base.Error.TestInstances
     Hasura.Backends.BigQuery.SourceSpec
+    Hasura.Backends.DataConnector.Adapter.TypesSpec
     Hasura.Backends.DataConnector.API.V0.AggregateSpec
     Hasura.Backends.DataConnector.API.V0.CapabilitiesSpec
     Hasura.Backends.DataConnector.API.V0.ColumnSpec

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

@@ -14,7 +14,9 @@ module Hasura.Backends.DataConnector.Adapter.Types
     scSchema,
     scTemplate,
     scTimeoutMicroseconds,
-    DataConnectorName (..),
+    DataConnectorName,
+    unDataConnectorName,
+    mkDataConnectorName,
     DataConnectorOptions (..),
     DataConnectorInfo (..),
     TableName (..),
@@ -149,11 +151,24 @@ instance Cacheable SourceConfig where
 
 --------------------------------------------------------------------------------
 
+-- | Note: Currently you should not use underscores in this name.
+--         This should be enforced in instances, and the `mkDataConnectorName`
+--         smart constructor is available to assist.
 newtype DataConnectorName = DataConnectorName {unDataConnectorName :: GQL.Name}
   deriving stock (Eq, Ord, Show, Typeable, Generic)
-  deriving newtype (FromJSON, ToJSON, FromJSONKey, ToJSONKey, Hashable, ToTxt)
+  deriving newtype (ToJSON, FromJSONKey, ToJSONKey, Hashable, ToTxt)
   deriving anyclass (Cacheable, NFData)
 
+instance FromJSON DataConnectorName where
+  parseJSON v = (`onLeft` fail) =<< (mkDataConnectorName <$> J.parseJSON v)
+
+mkDataConnectorName :: GQL.Name -> Either String DataConnectorName
+mkDataConnectorName n =
+  if ('_' `Text.elem` GQL.unName n)
+    then -- Could return other errors in future.
+      Left "DataConnectorName may not contain underscores."
+    else Right (DataConnectorName n)
+
 instance Witch.From DataConnectorName NonEmptyText where
   from = mkNonEmptyTextUnsafe . GQL.unName . unDataConnectorName -- mkNonEmptyTextUnsafe is safe here since GQL.Name is never empty
 

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

@@ -85,8 +85,8 @@ agentSourceKinds = do
       pure $ fmap mkAgentSource $ InsOrdHashMap.keys agents
 
 mkAgentSource :: DC.Types.DataConnectorName -> SourceKindInfo
-mkAgentSource (DC.Types.DataConnectorName name) =
-  SourceKindInfo {_skiSourceKind = GQL.unName name, _skiBuiltin = Agent}
+mkAgentSource dcName =
+  SourceKindInfo {_skiSourceKind = GQL.unName (DC.Types.unDataConnectorName dcName), _skiBuiltin = Agent}
 
 mkNativeSource :: Backend.BackendType -> Maybe SourceKindInfo
 mkNativeSource = \case

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

@@ -109,10 +109,11 @@ where
 
 import Control.Applicative
 import Control.Arrow.Extended (ArrowChoice)
+import Control.Lens (preview, _Right)
 import Data.Aeson
 import Data.Aeson.Types (Parser)
 import Data.Kind (Constraint, Type)
-import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName (..))
+import Hasura.Backends.DataConnector.Adapter.Types (mkDataConnectorName)
 import Hasura.Incremental (Cacheable)
 import Hasura.Prelude
 import Hasura.SQL.Backend
@@ -503,7 +504,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 <$> GQL.mkName text
+    <|> DataConnectorValue . DataConnectorKind <$> (preview _Right . mkDataConnectorName =<< GQL.mkName text)
   where
     staticKindFromText :: BackendSourceKind b -> Maybe (BackendSourceKind b)
     staticKindFromText kind =

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

@@ -14,14 +14,14 @@ module Hasura.SQL.Backend
   )
 where
 
-import Autodocodec (Codec (StringCodec), HasCodec (codec), JSONCodec, bimapCodec, dimapCodec, literalTextCodec, parseAlternatives, (<?>))
+import Autodocodec (Codec (StringCodec), HasCodec (codec), JSONCodec, bimapCodec, 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, nonEmptyTextQQ)
-import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName (..))
+import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName (..), mkDataConnectorName)
 import Hasura.Incremental
 import Hasura.Prelude
 import Language.GraphQL.Draft.Syntax qualified as GQL
@@ -134,8 +134,7 @@ instance FromJSON (BackendSourceKind ('MySQL)) where
   parseJSON = mkParseStaticBackendSourceKind MySQLKind
 
 instance FromJSON (BackendSourceKind ('DataConnector)) where
-  parseJSON = withText "BackendSourceKind" $ \text ->
-    DataConnectorKind . DataConnectorName <$> GQL.parseName text
+  parseJSON v = DataConnectorKind <$> parseJSON v
 
 mkParseStaticBackendSourceKind :: BackendSourceKind b -> (Value -> Parser (BackendSourceKind b))
 mkParseStaticBackendSourceKind backendSourceKind =
@@ -165,11 +164,13 @@ instance HasCodec (BackendSourceKind ('MySQL)) where
   codec = mkCodecStaticBackendSourceKind MySQLKind
 
 instance HasCodec (BackendSourceKind ('DataConnector)) where
-  codec = dimapCodec dec enc gqlNameCodec
+  codec = bimapCodec dec enc gqlNameCodec
     where
-      dec = DataConnectorKind . DataConnectorName
+      dec :: GQL.Name -> Either String (BackendSourceKind 'DataConnector)
+      dec n = DataConnectorKind <$> mkDataConnectorName n
+
       enc :: BackendSourceKind ('DataConnector) -> GQL.Name
-      enc (DataConnectorKind (DataConnectorName name)) = name
+      enc (DataConnectorKind dcName) = unDataConnectorName dcName
 
       gqlNameCodec :: JSONCodec GQL.Name
       gqlNameCodec =

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

@@ -8,6 +8,7 @@ module Hasura.Server.API.V2Query
   )
 where
 
+import Control.Lens (preview, _Right)
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Aeson
 import Data.Aeson.Types (Parser)
@@ -16,7 +17,7 @@ import Data.Text qualified as T
 import GHC.Generics.Extended (constrName)
 import Hasura.Backends.BigQuery.DDL.RunSQL qualified as BigQuery
 import Hasura.Backends.DataConnector.Adapter.RunSQL qualified as DataConnector
-import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName (..))
+import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName, mkDataConnectorName)
 import Hasura.Backends.MSSQL.DDL.RunSQL qualified as MSSQL
 import Hasura.Backends.MySQL.SQL qualified as MySQL
 import Hasura.Backends.Postgres.DDL.RunSQL qualified as Postgres
@@ -72,7 +73,7 @@ instance FromJSON RQLQuery where
     t <- o .: "type"
     let args :: forall a. FromJSON a => Parser a
         args = o .: "args"
-        dcNameFromRunSql = T.stripSuffix "_run_sql" >=> GQL.mkName >=> pure . DataConnectorName
+        dcNameFromRunSql = T.stripSuffix "_run_sql" >=> GQL.mkName >=> preview _Right . mkDataConnectorName
     case t of
       "insert" -> RQInsert <$> args
       "select" -> RQSelect <$> args

server/src-test/Hasura/Backends/DataConnector/Adapter/TypesSpec.hs

@@ -0,0 +1,19 @@
+module Hasura.Backends.DataConnector.Adapter.TypesSpec (spec) where
+
+import Control.Lens (preview, _Right)
+import Hasura.Backends.DataConnector.Adapter.Types
+import Hasura.Prelude
+import Language.GraphQL.Draft.Syntax qualified as GQL
+import Test.Hspec
+
+spec :: Spec
+spec = describe "DataConnectorName" do
+  it "rejects underscores" do
+    (preview _Right . mkDataConnectorName =<< GQL.mkName "hello_world") `shouldBe` Nothing
+
+  it "rejects invalid GQL names" do
+    (GQL.mkName "hello-world") `shouldBe` Nothing
+    (preview _Right . mkDataConnectorName =<< GQL.mkName "hello-world") `shouldBe` Nothing
+
+  it "accepts valid names" do
+    (preview _Right . mkDataConnectorName =<< GQL.mkName "helloworld") `shouldNotBe` Nothing