Add primitives, utilities for hspec test suite

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4246
GitOrigin-RevId: 2bd6db4f7189f1e9283f4aaacadce46a6f5bfec5

server/tests-hspec/Harness/Backend/BigQuery.hs

@@ -21,21 +21,24 @@ where
 import Data.Bool (bool)
 import Data.Foldable (for_)
 import Data.String
-import Data.Text (Text)
+import Data.Text (Text, pack, replace)
 import Data.Text qualified as T
 import Data.Text.Extended (commaSeparated)
+import Data.Time (defaultTimeLocale, formatTime)
+import GHC.Stack
 import Harness.Constants as Constants
 import Harness.Env
-import Harness.Exceptions (HasCallStack, forFinally_)
+import Harness.Exceptions (forFinally_)
 import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Yaml (yaml)
 import Harness.State (State)
 import Harness.Test.Context (BackendType (BigQuery), defaultBackendTypeString, defaultSource)
+import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..), formatBackendScalarValue)
 import Harness.Test.Schema qualified as Schema
 import Hasura.Backends.BigQuery.Connection (initConnection)
 import Hasura.Backends.BigQuery.Execute qualified as Execute
 import Hasura.Backends.BigQuery.Source (ServiceAccount)
-import Hasura.Prelude (onLeft)
+import Hasura.Prelude (onLeft, tshow)
 import Prelude
 
 getServiceAccount :: HasCallStack => IO ServiceAccount
@@ -89,7 +92,7 @@ scalarType = \case
   Schema.TStr -> "STRING"
   Schema.TUTCTime -> "DATETIME"
   Schema.TBool -> "BIT"
-  t -> error $ "Unexpected scalar type used for BigQuery: " <> show t
+  Schema.TCustomType txt -> Schema.getBackendScalarType txt bstBigQuery
 
 mkColumn :: Schema.Column -> Text
 mkColumn Schema.Column {columnName, columnType, columnNullable, columnDefault} =
@@ -122,11 +125,21 @@ insertTable Schema.Table {tableName, tableColumns, tableData}
             ";"
           ]
 
+-- | 'ScalarValue' serializer for BigQuery
+serialize :: ScalarValue -> Text
+serialize = \case
+  VInt i -> tshow i
+  VStr s -> "'" <> replace "'" "\'" s <> "'"
+  VUTCTime t -> pack $ formatTime defaultTimeLocale "'%F %T'" t
+  VBool b -> tshow @Int $ if b then 1 else 0
+  VNull -> "NULL"
+  VCustomValue bsv -> "'" <> formatBackendScalarValue bsv bsvBigQuery <> "'"
+
 mkRow :: [Schema.ScalarValue] -> Text
 mkRow row =
   T.unwords
     [ "(",
-      commaSeparated $ Schema.serialize <$> row,
+      commaSeparated $ serialize <$> row,
       ")"
     ]
 

server/tests-hspec/Harness/Backend/Citus.hs

@@ -26,9 +26,10 @@ import Data.Bool (bool)
 import Data.ByteString.Char8 qualified as S8
 import Data.Foldable (for_)
 import Data.String
-import Data.Text (Text)
+import Data.Text (Text, pack, replace)
 import Data.Text qualified as T
 import Data.Text.Extended (commaSeparated)
+import Data.Time (defaultTimeLocale, formatTime)
 import Database.PostgreSQL.Simple qualified as Postgres
 import Harness.Constants as Constants
 import Harness.Exceptions
@@ -36,7 +37,9 @@ import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Yaml (yaml)
 import Harness.State (State)
 import Harness.Test.Context (BackendType (Citus), defaultSource)
+import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..), formatBackendScalarValue)
 import Harness.Test.Schema qualified as Schema
+import Hasura.Prelude (tshow)
 import System.Process.Typed
 import Prelude
 
@@ -118,7 +121,7 @@ scalarType = \case
   Schema.TStr -> "VARCHAR"
   Schema.TUTCTime -> "TIMESTAMP"
   Schema.TBool -> "BOOLEAN"
-  t -> error $ "Unexpected scalar type used for Citus: " <> show t
+  Schema.TCustomType txt -> Schema.getBackendScalarType txt bstCitus
 
 mkColumn :: Schema.Column -> Text
 mkColumn Schema.Column {columnName, columnType, columnNullable, columnDefault} =
@@ -176,11 +179,21 @@ insertTable Schema.Table {tableName, tableColumns, tableData}
 wrapIdentifier :: Text -> Text
 wrapIdentifier identifier = "\"" <> identifier <> "\""
 
+-- | 'ScalarValue' serializer for Citus
+serialize :: ScalarValue -> Text
+serialize = \case
+  VInt i -> tshow i
+  VStr s -> "'" <> replace "'" "\'" s <> "'"
+  VUTCTime t -> pack $ formatTime defaultTimeLocale "'%F %T'" t
+  VBool b -> tshow @Int $ if b then 1 else 0
+  VNull -> "NULL"
+  VCustomValue bsv -> "'" <> formatBackendScalarValue bsv bsvCitus <> "'"
+
 mkRow :: [Schema.ScalarValue] -> Text
 mkRow row =
   T.unwords
     [ "(",
-      commaSeparated $ Schema.serialize <$> row,
+      commaSeparated $ serialize <$> row,
       ")"
     ]
 

server/tests-hspec/Harness/Backend/Mysql.hs

@@ -24,9 +24,10 @@ import Data.Aeson (Value)
 import Data.Bool (bool)
 import Data.Foldable (for_)
 import Data.String
-import Data.Text (Text)
+import Data.Text (Text, pack, replace)
 import Data.Text qualified as T
 import Data.Text.Extended (commaSeparated)
+import Data.Time (defaultTimeLocale, formatTime)
 import Database.MySQL.Simple as Mysql
 import Harness.Constants as Constants
 import Harness.Exceptions
@@ -34,7 +35,9 @@ import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Yaml (yaml)
 import Harness.State (State)
 import Harness.Test.Context (BackendType (MySQL), defaultBackendTypeString, defaultSource)
+import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..), formatBackendScalarValue)
 import Harness.Test.Schema qualified as Schema
+import Hasura.Prelude (tshow)
 import System.Process.Typed
 import Prelude
 
@@ -117,7 +120,7 @@ scalarType = \case
   Schema.TStr -> "TEXT"
   Schema.TUTCTime -> "DATETIME"
   Schema.TBool -> "BIT"
-  t -> error $ "Unexpected scalar type used for MySQL: " <> show t
+  Schema.TCustomType txt -> Schema.getBackendScalarType txt bstMysql
 
 mkColumn :: Schema.Column -> Text
 mkColumn Schema.Column {columnName, columnType, columnNullable, columnDefault} =
@@ -171,11 +174,21 @@ insertTable Schema.Table {tableName, tableColumns, tableData}
             ";"
           ]
 
+-- | 'ScalarValue' serializer for Mysql
+serialize :: ScalarValue -> Text
+serialize = \case
+  VInt i -> tshow i
+  VStr s -> "'" <> replace "'" "\'" s <> "'"
+  VUTCTime t -> pack $ formatTime defaultTimeLocale "'%F %T'" t
+  VBool b -> tshow @Int $ if b then 1 else 0
+  VNull -> "NULL"
+  VCustomValue bsv -> "'" <> formatBackendScalarValue bsv bsvMysql <> "'"
+
 mkRow :: [Schema.ScalarValue] -> Text
 mkRow row =
   T.unwords
     [ "(",
-      commaSeparated $ Schema.serialize <$> row,
+      commaSeparated $ serialize <$> row,
       ")"
     ]
 

server/tests-hspec/Harness/Backend/Postgres.hs

@@ -26,9 +26,10 @@ import Data.Bool (bool)
 import Data.ByteString.Char8 qualified as S8
 import Data.Foldable (for_)
 import Data.String
-import Data.Text (Text)
+import Data.Text (Text, pack, replace)
 import Data.Text qualified as T
 import Data.Text.Extended (commaSeparated)
+import Data.Time (defaultTimeLocale, formatTime)
 import Database.PostgreSQL.Simple qualified as Postgres
 import Harness.Constants as Constants
 import Harness.Exceptions
@@ -36,7 +37,9 @@ import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Yaml (yaml)
 import Harness.State (State)
 import Harness.Test.Context (BackendType (Postgres), defaultBackendTypeString, defaultSource)
+import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..), formatBackendScalarValue)
 import Harness.Test.Schema qualified as Schema
+import Hasura.Prelude (tshow)
 import System.Process.Typed
 import Prelude
 
@@ -125,7 +128,7 @@ scalarType = \case
   Schema.TStr -> "VARCHAR"
   Schema.TUTCTime -> "TIMESTAMP"
   Schema.TBool -> "BOOLEAN"
-  t -> error $ "Unexpected scalar type used for Postgres: " <> show t
+  Schema.TCustomType txt -> Schema.getBackendScalarType txt bstPostgres
 
 mkColumn :: Schema.Column -> Text
 mkColumn Schema.Column {columnName, columnType, columnNullable, columnDefault} =
@@ -186,11 +189,21 @@ insertTable Schema.Table {tableName, tableColumns, tableData}
 wrapIdentifier :: Text -> Text
 wrapIdentifier identifier = "\"" <> identifier <> "\""
 
+-- | 'ScalarValue' serializer for Postgres
+serialize :: ScalarValue -> Text
+serialize = \case
+  VInt i -> tshow i
+  VStr s -> "'" <> replace "'" "\'" s <> "'"
+  VUTCTime t -> pack $ formatTime defaultTimeLocale "'%F %T'" t
+  VBool b -> tshow @Int $ if b then 1 else 0
+  VNull -> "NULL"
+  VCustomValue bsv -> "'" <> formatBackendScalarValue bsv bsvPostgres <> "'"
+
 mkRow :: [Schema.ScalarValue] -> Text
 mkRow row =
   T.unwords
     [ "(",
-      commaSeparated $ Schema.serialize <$> row,
+      commaSeparated $ serialize <$> row,
       ")"
     ]
 

server/tests-hspec/Harness/Backend/Sqlserver.hs

@@ -25,9 +25,10 @@ import Data.Aeson (Value)
 import Data.Bool (bool)
 import Data.Foldable (for_)
 import Data.String
-import Data.Text (Text)
+import Data.Text (Text, pack, replace)
 import Data.Text qualified as T (pack, unpack, unwords)
 import Data.Text.Extended (commaSeparated)
+import Data.Time (defaultTimeLocale, formatTime)
 import Database.ODBC.SQLServer qualified as Sqlserver
 import Harness.Constants qualified as Constants
 import Harness.Exceptions
@@ -35,7 +36,9 @@ import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Yaml (yaml)
 import Harness.State (State)
 import Harness.Test.Context (BackendType (SQLServer), defaultBackendTypeString, defaultSource)
+import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..), formatBackendScalarValue)
 import Harness.Test.Schema qualified as Schema
+import Hasura.Prelude (tshow)
 import System.Process.Typed
 import Prelude
 
@@ -122,7 +125,7 @@ scalarType = \case
   Schema.TStr -> "NVARCHAR(127)"
   Schema.TUTCTime -> "DATETIME"
   Schema.TBool -> "BOOLEAN"
-  Schema.TVarchar50 -> "VARCHAR(50)"
+  Schema.TCustomType txt -> Schema.getBackendScalarType txt bstMssql
 
 mkColumn :: Schema.Column -> Text
 mkColumn Schema.Column {columnName, columnType, columnNullable, columnDefault} =
@@ -183,11 +186,21 @@ insertTable Schema.Table {tableName, tableColumns, tableData}
 wrapIdentifier :: Text -> Text
 wrapIdentifier identifier = "[" <> identifier <> "]"
 
+-- | 'ScalarValue' serializer for Mssql
+serialize :: ScalarValue -> Text
+serialize = \case
+  VInt i -> tshow i
+  VStr s -> "'" <> replace "'" "\'" s <> "'"
+  VUTCTime t -> pack $ formatTime defaultTimeLocale "'%F %T'" t
+  VBool b -> tshow @Int $ if b then 1 else 0
+  VNull -> "NULL"
+  VCustomValue bsv -> "'" <> formatBackendScalarValue bsv bsvMssql <> "'"
+
 mkRow :: [Schema.ScalarValue] -> Text
 mkRow row =
   T.unwords
     [ "(",
-      commaSeparated $ Schema.serialize <$> row,
+      commaSeparated $ serialize <$> row,
       ")"
     ]
 

server/tests-hspec/Harness/GraphqlEngine.hs

@@ -16,6 +16,7 @@ module Harness.GraphqlEngine
     postGraphqlYaml,
     postGraphqlYamlWithHeaders,
     postGraphql,
+    postGraphqlWithPair,
     postGraphqlWithHeaders,
     clearMetadata,
     postV2Query,
@@ -38,6 +39,7 @@ where
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Monad.Trans.Managed (ManagedT (..), lowerManagedT)
 import Data.Aeson (Value, object, (.=))
+import Data.Aeson.Types (Pair)
 import Data.Environment qualified as Env
 import Data.Text qualified as T
 import Data.Time (getCurrentTime)
@@ -134,6 +136,12 @@ postGraphql :: HasCallStack => State -> Value -> IO Value
 postGraphql state value =
   withFrozenCallStack $ postGraphqlYaml state (object ["query" .= value])
 
+-- | Same as postGraphql but accepts a list of 'Pair' to pass
+-- additional parameters to the endpoint.
+postGraphqlWithPair :: HasCallStack => State -> Value -> [Pair] -> IO Value
+postGraphqlWithPair state value pair =
+  withFrozenCallStack $ postGraphqlYaml state (object $ ["query" .= value] <> pair)
+
 -- | Same as 'postGraphqlYamlWithHeaders', but adds the @{query:..}@ wrapper.
 --
 -- Note: We add 'withFrozenCallStack' to reduce stack trace clutter.

server/tests-hspec/Harness/Test/Schema.hs

@@ -7,9 +7,15 @@ module Harness.Test.Schema
     Column (..),
     ScalarType (..),
     ScalarValue (..),
-    serialize,
+    BackendScalarType (..),
+    BackendScalarValue (..),
     column,
     columnNull,
+    defaultBackendScalarType,
+    getBackendScalarType,
+    defaultBackendScalarValue,
+    getBackendScalarValue,
+    formatBackendScalarValue,
     parseUTCTimeOrError,
     trackTable,
     untrackTable,
@@ -20,15 +26,14 @@ module Harness.Test.Schema
 where
 
 import Data.Foldable (for_)
-import Data.Text (Text, pack, replace)
-import Data.Time (UTCTime, defaultTimeLocale, formatTime)
+import Data.Text (Text)
+import Data.Time (UTCTime, defaultTimeLocale)
 import Data.Time.Format (parseTimeOrError)
 import Harness.Exceptions
 import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Yaml (yaml)
 import Harness.State (State)
 import Harness.Test.Context (BackendType, defaultBackendTypeString, defaultSchema, defaultSource)
-import Hasura.Prelude (tshow)
 import Prelude
 
 -- | Generic type to use to specify schema tables for all backends.
@@ -67,6 +72,87 @@ data Column = Column
   }
   deriving (Show, Eq)
 
+-- | Generic type to represent ScalarType for multiple backends. This
+-- type can be used to encapsulate the column types for different
+-- backends by providing explicit name of the datatype. This provides
+-- flexibility and scalability which is difficult to achieve by just
+-- extending ScalarType.
+--
+-- To give a concrete usecase, right now we have 'ScalarType' with
+-- value 'TUTCTime'. This is treated as TIMESTAMP for Citus and
+-- DATETIME for MSSQL server. There might be usecases where you want
+-- your table column to treat it as TIMESTAMP for Citus and
+-- <https://docs.microsoft.com/en-us/sql/t-sql/data-types/datetime2-transact-sql?redirectedfrom=MSDN&view=sql-server-ver15
+-- DATETIME2> for MSSQL server. BackendScalarType makes such use case
+-- very simple to achive instead of making you define a new sum type
+-- and handling it.
+data BackendScalarType = BackendScalarType
+  { bstMysql :: Maybe Text,
+    bstCitus :: Maybe Text,
+    bstPostgres :: Maybe Text,
+    bstBigQuery :: Maybe Text,
+    bstMssql :: Maybe Text
+  }
+  deriving (Show, Eq)
+
+-- | Default value for 'BackendScalarType' initialized with 'Nothing'
+-- for all the fields.
+defaultBackendScalarType :: BackendScalarType
+defaultBackendScalarType =
+  BackendScalarType
+    { bstMysql = Nothing,
+      bstCitus = Nothing,
+      bstMssql = Nothing,
+      bstPostgres = Nothing,
+      bstBigQuery = Nothing
+    }
+
+-- | Access specific backend scalar type out of 'BackendScalarType'
+getBackendScalarType :: BackendScalarType -> (BackendScalarType -> Maybe Text) -> Text
+getBackendScalarType bst fn =
+  case fn bst of
+    Just scalarType -> scalarType
+    Nothing -> error $ "getBackendScalarType: BackendScalarType is Nothing, passed " <> show bst
+
+-- | Generic type to represent ScalarValue for multiple backends. This
+-- type can be used to encapsulate the column values for different
+-- backends by providing explicit data for individual backend. This provides
+-- flexibility and scalability which is difficult to achieve by just
+-- extending ScalarValue.
+--
+-- To give a concrete usecase, right now we have timestamp column for
+-- out database. Depending on the database, the value can be
+-- different. For postgres backend, we use 2017-09-21T09:39:44 to
+-- represent timestamp. But we would want to use 2017-09-21T09:39:44Z
+-- for Microsoft's SQL server backend. This type provides flexibility
+-- to provide such options.
+data BackendScalarValue = BackendScalarValue
+  { bsvMysql :: Maybe Text,
+    bsvCitus :: Maybe Text,
+    bsvPostgres :: Maybe Text,
+    bsvBigQuery :: Maybe Text,
+    bsvMssql :: Maybe Text
+  }
+  deriving (Show, Eq)
+
+-- | Default value for 'BackendScalarValue' initialized with 'Nothing'
+-- for all the fields.
+defaultBackendScalarValue :: BackendScalarValue
+defaultBackendScalarValue =
+  BackendScalarValue
+    { bsvMysql = Nothing,
+      bsvCitus = Nothing,
+      bsvPostgres = Nothing,
+      bsvBigQuery = Nothing,
+      bsvMssql = Nothing
+    }
+
+-- | Access specific backend scalar value out of 'BackendScalarValue'
+getBackendScalarValue :: BackendScalarValue -> (BackendScalarValue -> Maybe Text) -> Text
+getBackendScalarValue bsv fn = case fn bsv of
+  Nothing -> error $ "getBackendScalarValue: BackendScalarValue is Nothing, passed " <> show bsv
+  Just scalarValue -> scalarValue
+
 -- | Generic scalar type for all backends, for simplicity.
 -- Ideally, we would be wiring in @'Backend@ specific scalar types here to make
 -- sure all backend-specific scalar types are also covered by tests, perhaps in
@@ -76,10 +162,7 @@ data ScalarType
   | TStr
   | TUTCTime
   | TBool
-  | -- | Specialized. See: https://github.com/hasura/graphql-engine/issues/8158
-    -- session variable string values are not truncated to default (30) length in Test.RequestHeadersSpec
-    -- works with VStr
-    TVarchar50
+  | TCustomType BackendScalarType
   deriving (Show, Eq)
 
 -- | Generic scalar value type for all backends, that should directly correspond
@@ -90,19 +173,13 @@ data ScalarValue
   | VUTCTime UTCTime
   | VBool Bool
   | VNull
+  | VCustomValue BackendScalarValue
   deriving (Show, Eq)
 
--- | Generic 'ScalarValue' serializer.
---
--- NOTE: For serialization of 'ScalarType' we need to have backend-specific
--- functions as they correspond to the query language of the specific backend
-serialize :: ScalarValue -> Text
-serialize = \case
-  VInt i -> tshow i
-  VStr s -> "'" <> replace "'" "\'" s <> "'"
-  VUTCTime t -> pack $ formatTime defaultTimeLocale "'%F %T'" t
-  VBool b -> tshow @Int $ if b then 1 else 0
-  VNull -> "NULL"
+formatBackendScalarValue :: BackendScalarValue -> (BackendScalarValue -> Maybe Text) -> Text
+formatBackendScalarValue bsv fn = case fn bsv of
+  Nothing -> error $ "formatBackendScalarValue: Retrieved value is Nothing, passed " <> show bsv
+  Just scalarValue -> scalarValue
 
 -- | Helper function to construct 'Column's with common defaults
 column :: Text -> ScalarType -> Column

server/tests-hspec/Test/RequestHeadersSpec.hs

@@ -9,6 +9,10 @@ import Harness.Quoter.Graphql (graphql)
 import Harness.Quoter.Yaml (shouldReturnYaml, yaml)
 import Harness.State (State)
 import Harness.Test.Context qualified as Context
+import Harness.Test.Schema
+  ( BackendScalarType (..),
+    defaultBackendScalarType,
+  )
 import Harness.Test.Schema qualified as Schema
 import Test.Hspec (SpecWith, it)
 import Prelude
@@ -40,7 +44,13 @@ author :: Schema.Table
 author =
   Schema.Table
     "author"
-    [ Schema.column "uuid" Schema.TVarchar50,
+    [ Schema.column
+        "uuid"
+        ( Schema.TCustomType
+            defaultBackendScalarType
+              { bstMssql = Just "VARCHAR(50)"
+              }
+        ),
       Schema.column "name" Schema.TStr
     ]
     ["uuid"]