[server] parser for interpolated SQL queries

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7726
GitOrigin-RevId: 4b6ad28aa8a4d75bfcf6ce1ec4d89324f7f1ae74

server/graphql-engine.cabal

@@ -1154,6 +1154,7 @@ test-suite graphql-engine-tests
     Hasura.Backends.MySQL.TypesSpec
     Hasura.Backends.Postgres.Connection.VersionCheckSpec
     Hasura.Backends.Postgres.Execute.PrepareSpec
+    Hasura.Backends.Postgres.NativeQuery.NativeQuerySpec
     Hasura.Backends.Postgres.RQLGenerator
     Hasura.Backends.Postgres.RQLGenerator.GenAnnSelectG
     Hasura.Backends.Postgres.RQLGenerator.GenAssociatedTypes

server/src-lib/Hasura/Backends/Postgres/SQL/DML.hs

@@ -31,7 +31,7 @@ module Hasura.Backends.Postgres.SQL.DML
     OrderType (OTAsc, OTDesc),
     QIdentifier (QIdentifier),
     Qual (QualTable, QualVar, QualifiedIdentifier),
-    RawSQL (..),
+    RawQuery (..),
     RetExp (RetExp),
     SQLConflict (..),
     SQLConflictTarget (SQLColumn, SQLConstraint),
@@ -114,6 +114,7 @@ import Data.String (fromString)
 import Data.Text (pack)
 import Data.Text.Extended
 import Hasura.Backends.Postgres.SQL.Types
+import Hasura.NativeQuery.Metadata
 import Hasura.Prelude
 import Hasura.SQL.Types
 import Text.Builder qualified as TB
@@ -1170,7 +1171,7 @@ data TopLevelCTE
   | CTEInsert SQLInsert
   | CTEUpdate SQLUpdate
   | CTEDelete SQLDelete
-  | CTEUnsafeRawSQL RawSQL
+  | CTEUnsafeRawSQL RawQuery
   deriving (Show, Eq)
 
 instance ToSQL TopLevelCTE where
@@ -1179,10 +1180,7 @@ instance ToSQL TopLevelCTE where
     CTEInsert q -> toSQL q
     CTEUpdate q -> toSQL q
     CTEDelete q -> toSQL q
-    CTEUnsafeRawSQL (RawSQL q) -> TB.text q
-
-newtype RawSQL = RawSQL Text
-  deriving newtype (Eq, Ord, Show)
+    CTEUnsafeRawSQL (RawQuery q) -> TB.text q
 
 -- | A @SELECT@ statement with Common Table Expressions.
 --   <https://www.postgresql.org/docs/current/queries-with.html>

server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/Process.hs

@@ -176,7 +176,7 @@ processSelectParams
           tell $
             mempty
               { _swCustomSQLCTEs =
-                  CustomSQLCTEs (HM.singleton cteName (S.RawSQL $ nqCode nq))
+                  CustomSQLCTEs (HM.singleton cteName (S.RawQuery $ nqCode nq))
               }
 
           pure $ S.QualifiedIdentifier (S.tableAliasToIdentifier cteName) Nothing

server/src-lib/Hasura/Backends/Postgres/Translate/Types.hs

@@ -254,7 +254,7 @@ type SimilarArrayFields = HM.HashMap FieldName [FieldName]
 ----
 
 newtype CustomSQLCTEs = CustomSQLCTEs
-  { getCustomSQLCTEs :: HM.HashMap Postgres.TableAlias Postgres.RawSQL
+  { getCustomSQLCTEs :: HM.HashMap Postgres.TableAlias Postgres.RawQuery
   }
   deriving newtype (Eq, Show, Semigroup, Monoid)
 

server/src-lib/Hasura/NativeQuery/Metadata.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 -- | This module houses the types and functions associated with the default
@@ -7,6 +8,10 @@ module Hasura.NativeQuery.Metadata
     NativeQueryNameImpl (..),
     NativeQueryInfoImpl (..),
     TrackNativeQueryImpl (..),
+    RawQuery (..),
+    InterpolatedItem (..),
+    InterpolatedQuery (..),
+    parseInterpolatedQuery,
     defaultNativeQueryTrackToInfo,
     module Hasura.NativeQuery.Types,
   )
@@ -15,6 +20,7 @@ where
 import Autodocodec
 import Autodocodec qualified as AC
 import Data.Aeson
+import Data.Text qualified as T
 import Data.Text.Extended (ToTxt)
 import Data.Voidable
 import Hasura.Metadata.DTO.Utils (codecNamePrefix)
@@ -26,7 +32,8 @@ import Hasura.SQL.Backend
 
 -- The name of a native query. This appears as a root field name in the graphql schema.
 newtype NativeQueryNameImpl = NativeQueryNameImpl {getNativeQueryNameImpl :: Text}
-  deriving (Eq, Ord, Show, Generic, Hashable, NFData, ToJSON, FromJSON, ToTxt)
+  deriving newtype (Eq, Ord, Show, Hashable, NFData, ToJSON, FromJSON, ToTxt)
+  deriving stock (Generic)
 
 instance FromJSONKey NativeQueryNameImpl
 
@@ -34,17 +41,62 @@ instance ToJSONKey NativeQueryNameImpl
 
 deriving instance Eq (Voidable NativeQueryNameImpl)
 
-deriving instance Hashable (Voidable NativeQueryNameImpl)
+deriving newtype instance Hashable (Voidable NativeQueryNameImpl)
 
-deriving instance FromJSON (Voidable NativeQueryNameImpl)
+deriving newtype instance FromJSON (Voidable NativeQueryNameImpl)
 
-deriving instance FromJSONKey (Voidable NativeQueryNameImpl)
+deriving newtype instance FromJSONKey (Voidable NativeQueryNameImpl)
 
 deriving instance Show (Voidable NativeQueryNameImpl)
 
-deriving instance ToJSON (Voidable NativeQueryNameImpl)
+deriving newtype instance ToJSON (Voidable NativeQueryNameImpl)
 
-deriving instance ToJSONKey (Voidable NativeQueryNameImpl)
+---------------------------------------
+
+newtype RawQuery = RawQuery {getRawQuery :: Text}
+  deriving newtype (Eq, Ord, Show, FromJSON, ToJSON)
+
+instance HasCodec RawQuery where
+  codec = dimapCodec RawQuery getRawQuery codec
+
+---------------------------------------
+
+data InterpolatedItem variable
+  = IIText Text
+  | IIVariable variable
+  deriving stock (Eq, Ord, Show, Functor, Foldable, Generic, Traversable)
+
+deriving instance (Hashable variable) => Hashable (InterpolatedItem variable)
+
+deriving instance (NFData variable) => NFData (InterpolatedItem variable)
+
+---------------------------------------
+
+newtype InterpolatedQuery variable = InterpolatedQuery {getInterpolatedQuery :: [InterpolatedItem variable]}
+  deriving newtype (Eq, Ord, Show, Generic)
+
+deriving newtype instance (Hashable variable) => Hashable (InterpolatedQuery variable)
+
+deriving newtype instance (NFData variable) => NFData (InterpolatedQuery variable)
+
+instance Functor InterpolatedQuery where
+  fmap f (InterpolatedQuery parts) = InterpolatedQuery ((fmap . fmap) f parts)
+
+instance Foldable InterpolatedQuery where
+  foldr f b (InterpolatedQuery parts) =
+    foldr f b (mapMaybe unwrap parts)
+    where
+      unwrap = \case
+        IIVariable var -> Just var
+        _ -> Nothing
+
+instance Traversable InterpolatedQuery where
+  traverse f (InterpolatedQuery parts) =
+    InterpolatedQuery <$> (traverse . traverse) f parts
+
+---------------------------------------
+
+deriving newtype instance ToJSONKey (Voidable NativeQueryNameImpl)
 
 instance HasCodec NativeQueryNameImpl where
   codec = coerceCodec @Text
@@ -120,7 +172,8 @@ deriving newtype instance (Backend b, HasCodec (ScalarType b)) => FromJSON (Void
 deriving newtype instance (Backend b, HasCodec (ScalarType b)) => ToJSON (Voidable (NativeQueryInfoImpl b))
 
 newtype NativeQueryArgumentName = NativeQueryArgumentName {getNativeQueryArgumentName :: Text}
-  deriving (Eq, Ord, Show, Generic, Hashable)
+  deriving newtype (Eq, Ord, Show, Hashable)
+  deriving stock (Generic)
 
 deriving newtype instance ToJSON NativeQueryArgumentName
 
@@ -144,18 +197,18 @@ data TrackNativeQueryImpl (b :: BackendType) = TrackNativeQueryImpl
 
 -- | Default implementation of the method 'nativeQueryTrackToInfo'.
 defaultNativeQueryTrackToInfo :: TrackNativeQueryImpl b -> NativeQueryInfoImpl b
-defaultNativeQueryTrackToInfo TrackNativeQueryImpl {..} =
+defaultNativeQueryTrackToInfo TrackNativeQueryImpl {..} = do
   NativeQueryInfoImpl {..}
   where
     nqiiRootFieldName = tnqRootFieldName
-    nqiiCode = tnqCode
     nqiiReturns = tnqReturns
     nqiiArguments = tnqArguments
     nqiiDescription = tnqDescription
+    nqiiCode = tnqCode
 
-deriving instance (Backend b, HasCodec (ScalarType b)) => FromJSON (Voidable (TrackNativeQueryImpl b))
+deriving newtype instance (Backend b, HasCodec (ScalarType b)) => FromJSON (Voidable (TrackNativeQueryImpl b))
 
-deriving instance (Backend b, HasCodec (ScalarType b)) => ToJSON (Voidable (TrackNativeQueryImpl b))
+deriving newtype instance (Backend b, HasCodec (ScalarType b)) => ToJSON (Voidable (TrackNativeQueryImpl b))
 
 instance (Backend b, HasCodec (ScalarType b)) => HasCodec (TrackNativeQueryImpl b) where
   codec =
@@ -192,3 +245,42 @@ deriving via
   (Autodocodec (TrackNativeQueryImpl b))
   instance
     (Backend b, HasCodec (ScalarType b)) => ToJSON (TrackNativeQueryImpl b)
+
+-- | extract all of the `{{ variable }}` inside our query string
+parseInterpolatedQuery ::
+  Text ->
+  Either Text (InterpolatedQuery NativeQueryArgumentName)
+parseInterpolatedQuery =
+  fmap
+    ( InterpolatedQuery
+        . mergeAdjacent
+        . trashEmpties
+    )
+    . consumeString
+    . T.unpack
+  where
+    trashEmpties = filter (/= IIText "")
+
+    mergeAdjacent = \case
+      (IIText a : IIText b : rest) ->
+        mergeAdjacent (IIText (a <> b) : rest)
+      (a : rest) -> a : mergeAdjacent rest
+      [] -> []
+
+    consumeString :: String -> Either Text [InterpolatedItem NativeQueryArgumentName]
+    consumeString str =
+      let (beforeCurly, fromCurly) = break (== '{') str
+       in case fromCurly of
+            ('{' : '{' : rest) ->
+              (IIText (T.pack beforeCurly) :) <$> consumeVar rest
+            ('{' : other) ->
+              (IIText (T.pack (beforeCurly <> "{")) :) <$> consumeString other
+            _other -> pure [IIText (T.pack beforeCurly)]
+
+    consumeVar :: String -> Either Text [InterpolatedItem NativeQueryArgumentName]
+    consumeVar str =
+      let (beforeCloseCurly, fromClosedCurly) = break (== '}') str
+       in case fromClosedCurly of
+            ('}' : '}' : rest) ->
+              (IIVariable (NativeQueryArgumentName $ T.pack beforeCloseCurly) :) <$> consumeString rest
+            _ -> Left "Found '{{' without a matching closing '}}'"

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

@@ -6,6 +6,7 @@
 -- are free to provide their own as needed.
 module Hasura.NativeQuery.Types
   ( NativeQueryMetadata (..),
+    NativeQueryParseError (..),
     BackendTrackNativeQuery (..),
   )
 where
@@ -82,3 +83,7 @@ class
 newtype BackendTrackNativeQuery b = BackendTrackNativeQuery {getBackendTrackNativeQuery :: Voidable (TrackNativeQuery b)}
 
 deriving newtype instance NativeQueryMetadata b => FromJSON (BackendTrackNativeQuery b)
+
+-- Things that might go wrong when converting a Native Query metadata request
+-- into a valid metadata item (such as failure to interpolate the query)
+newtype NativeQueryParseError = NativeQueryParseError Text

server/src-test/Hasura/Backends/Postgres/NativeQuery/NativeQuerySpec.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hasura.Backends.Postgres.NativeQuery.NativeQuerySpec
+  ( spec,
+  )
+where
+
+import Hasura.Base.Error.TestInstances ()
+import Hasura.NativeQuery.Metadata
+import Test.Hspec (Spec, describe, it, shouldBe)
+import Prelude
+
+spec :: Spec
+spec = do
+  describe "Parses RawQuery into InterpolatedQuery" do
+    it "Parses SQL with no parameters in it" $ do
+      let rawSQL = "SELECT * FROM dogs"
+      parseInterpolatedQuery rawSQL `shouldBe` Right (InterpolatedQuery [IIText "SELECT * FROM dogs"])
+
+    it "Parses only a variable" $ do
+      let rawSQL = "{{dogs}}"
+      parseInterpolatedQuery rawSQL `shouldBe` Right (InterpolatedQuery [IIVariable (NativeQueryArgumentName "dogs")])
+
+    it "Parses SQL with one parameter in it" $ do
+      let rawSQL = "SELECT * FROM dogs WHERE name = {{name}}"
+      parseInterpolatedQuery rawSQL
+        `shouldBe` Right
+          ( InterpolatedQuery
+              [ IIText "SELECT * FROM dogs WHERE name = ",
+                IIVariable (NativeQueryArgumentName "name")
+              ]
+          )
+
+    it "Parses SQL with one parameter in the middle of the string" $ do
+      let rawSQL = "SELECT * FROM dogs WHERE {{name}} = name"
+      parseInterpolatedQuery rawSQL
+        `shouldBe` Right
+          ( InterpolatedQuery
+              [ IIText "SELECT * FROM dogs WHERE ",
+                IIVariable (NativeQueryArgumentName "name"),
+                IIText " = name"
+              ]
+          )
+
+    it "Parses SQL with one parameter and a loose { hanging around" $ do
+      let rawSQL = "SELECT * FROM dogs WHERE {{name}} = '{doggy friend}'"
+      parseInterpolatedQuery rawSQL
+        `shouldBe` Right
+          ( InterpolatedQuery
+              [ IIText "SELECT * FROM dogs WHERE ",
+                IIVariable (NativeQueryArgumentName "name"),
+                IIText " = '{doggy friend}'"
+              ]
+          )
+
+    it "What should happen for unclosed variable" $ do
+      let rawSQL = "SELECT * FROM dogs WHERE {{name"
+      parseInterpolatedQuery rawSQL `shouldBe` Left "Found '{{' without a matching closing '}}'"