Structured logging in test-harness

PR-URL: hasura/graphql-engine-mono#7092 GitOrigin-RevId: 201ee3ddc205bfc9d55c167e0b70b6606dbe4aa7
QiaoXingLi · Nov 30, 2022 · 9bc1ff1 · 9bc1ff1
1 parent e084126
commit 9bc1ff1
Show file tree

Hide file tree

Showing 17 changed files with 224 additions and 92 deletions.
diff --git a/.hlint.yaml b/.hlint.yaml
@@ -50,6 +50,38 @@
         within: []
         message: "Specs with focusing should only be used during development"
 
+      - name: "Harness.TestEnvironment.testLogHarness"
+        within: []
+        message: "testLogHarness should only be ad-hoc during development. Please define proper log message data types for published code"
+
+      - name: "Harness.Logging.LogHarness"
+        within: []
+        message: "LogHarness should only be ad-hoc during development. Please define proper log message data types for published code"
+
+      - name: "Harness.Logging.Messages.LogHarness"
+        within: []
+        message: "LogHarness should only be ad-hoc during development. Please define proper log message data types for published code"
+
+      - name: "Harness.TestEnvironment.testLogTrace"
+        within: ["Test.**"]
+        message: "testLogTrace should only be used outside the test-harness package"
+
+      - name: "Harness.Logging.LogTrace"
+        within: ["Test.**"]
+        message: "LogTrace should only be used outside the test-harness package"
+
+      - name: "Harness.Logging.Messages.LogTrace"
+        within: ["Test.**"]
+        message: "LogTrace should only be used outside the test-harness package"
+
+      - name: "Harness.Logging.logTrace"
+        within: ["Test.**"]
+        message: "logTrace should only be used outside the test-harness package"
+
+      - name: "Harness.Logging.Messages.logTrace"
+        within: ["Test.**"]
+        message: "logTrace should only be used outside the test-harness package"
+
 # Add custom hints for this project
 #
 # Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"

diff --git a/server/lib/api-tests/src/Test/EventTriggers/MSSQL/EventTriggerDropSourceCleanupSpec.hs b/server/lib/api-tests/src/Test/EventTriggers/MSSQL/EventTriggerDropSourceCleanupSpec.hs
@@ -14,6 +14,7 @@ import Harness.Quoter.Yaml
 import Harness.Test.Fixture qualified as Fixture
 import Harness.Test.Schema (Table (..), table)
 import Harness.Test.Schema qualified as Schema
+import Harness.Test.SetupAction (permitTeardownFail)
 import Harness.TestEnvironment (TestEnvironment)
 import Harness.Webhook qualified as Webhook
 import Harness.Yaml (shouldBeYaml, shouldReturnYaml)
@@ -34,7 +35,7 @@ spec =
               -- so that the server can be referenced while testing
               Fixture.mkLocalTestEnvironment = const Webhook.run,
               Fixture.setupTeardown = \(testEnvironment, (webhookServer, _)) ->
-                [ Sqlserver.setupTablesActionDiscardingTeardownErrors (schema "authors") testEnvironment,
+                [ permitTeardownFail (Sqlserver.setupTablesAction (schema "authors") testEnvironment),
                   Fixture.SetupAction
                     { Fixture.setupAction = mssqlSetupWithEventTriggers testEnvironment webhookServer,
                       Fixture.teardownAction = \_ -> pure ()

diff --git a/server/lib/api-tests/src/Test/EventTriggers/MSSQL/EventTriggersUntrackTableCleanupSpec.hs b/server/lib/api-tests/src/Test/EventTriggers/MSSQL/EventTriggersUntrackTableCleanupSpec.hs
@@ -13,6 +13,7 @@ import Harness.Quoter.Yaml
 import Harness.Test.Fixture qualified as Fixture
 import Harness.Test.Schema (Table (..), table)
 import Harness.Test.Schema qualified as Schema
+import Harness.Test.SetupAction (permitTeardownFail)
 import Harness.TestEnvironment (TestEnvironment)
 import Harness.Webhook qualified as Webhook
 import Harness.Yaml (shouldBeYaml, shouldReturnYaml)
@@ -33,7 +34,7 @@ spec =
               -- so that the server can be referenced while testing
               Fixture.mkLocalTestEnvironment = const Webhook.run,
               Fixture.setupTeardown = \(testEnvironment, (webhookServer, _)) ->
-                [ Sqlserver.setupTablesActionDiscardingTeardownErrors (schema "authors") testEnvironment,
+                [ permitTeardownFail (Sqlserver.setupTablesAction (schema "authors") testEnvironment),
                   Fixture.SetupAction
                     { Fixture.setupAction = mssqlSetup testEnvironment webhookServer,
                       Fixture.teardownAction = \_ -> pure ()

diff --git a/server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersExtensionSchemaSpec.hs b/server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersExtensionSchemaSpec.hs
@@ -15,6 +15,7 @@ import Harness.Test.BackendType qualified as BackendType
 import Harness.Test.Fixture qualified as Fixture
 import Harness.Test.Schema (Table (..), table)
 import Harness.Test.Schema qualified as Schema
+import Harness.Test.SetupAction (permitTeardownFail)
 import Harness.TestEnvironment (TestEnvironment)
 import Harness.Webhook qualified as Webhook
 import Harness.Yaml (shouldBeYaml, shouldReturnYaml)
@@ -35,7 +36,7 @@ spec =
               -- so that the server can be referenced while testing
               Fixture.mkLocalTestEnvironment = const Webhook.run,
               Fixture.setupTeardown = \(testEnvironment, (webhookServer, _)) ->
-                [ Postgres.setupTablesActionDiscardingTeardownErrors schema testEnvironment,
+                [ permitTeardownFail (Postgres.setupTablesAction schema testEnvironment),
                   Fixture.SetupAction
                     { Fixture.setupAction = postgresSetup testEnvironment webhookServer,
                       Fixture.teardownAction = \_ -> postgresTeardown testEnvironment

diff --git a/server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersReplaceMetadataCleanupSpec.hs b/server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersReplaceMetadataCleanupSpec.hs
@@ -15,6 +15,7 @@ import Harness.Quoter.Yaml
 import Harness.Test.Fixture qualified as Fixture
 import Harness.Test.Schema (Table (..), table)
 import Harness.Test.Schema qualified as Schema
+import Harness.Test.SetupAction (permitTeardownFail)
 import Harness.TestEnvironment (TestEnvironment)
 import Harness.Webhook qualified as Webhook
 import Harness.Yaml (shouldReturnYaml)
@@ -33,7 +34,7 @@ spec =
               -- so that the server can be referenced while testing
               Fixture.mkLocalTestEnvironment = const Webhook.run,
               Fixture.setupTeardown = \(testEnvironment, (webhookServer, _)) ->
-                [ Postgres.setupTablesActionDiscardingTeardownErrors (schema "authors") testEnvironment,
+                [ permitTeardownFail (Postgres.setupTablesAction (schema "authors") testEnvironment),
                   Fixture.SetupAction
                     { Fixture.setupAction = postgresSetup testEnvironment webhookServer,
                       Fixture.teardownAction = \_ -> pure ()

diff --git a/server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersRunSQLSpec.hs b/server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersRunSQLSpec.hs
@@ -17,6 +17,7 @@ import Harness.Quoter.Yaml
 import Harness.Test.Fixture qualified as Fixture
 import Harness.Test.Schema (Table (..), table)
 import Harness.Test.Schema qualified as Schema
+import Harness.Test.SetupAction (permitTeardownFail)
 import Harness.TestEnvironment (Server (..), TestEnvironment, getServer)
 import Harness.Webhook qualified as Webhook
 import Harness.Yaml (shouldBeYaml, shouldReturnYaml)
@@ -38,7 +39,7 @@ spec =
               -- so that the server can be referenced while testing
               Fixture.mkLocalTestEnvironment = const Webhook.run,
               Fixture.setupTeardown = \(testEnvironment, (webhookServer, _)) ->
-                [ Postgres.setupTablesActionDiscardingTeardownErrors (schema "authors") testEnvironment,
+                [ permitTeardownFail (Postgres.setupTablesAction (schema "authors") testEnvironment),
                   Fixture.SetupAction
                     { Fixture.setupAction = postgresSetup testEnvironment webhookServer,
                       Fixture.teardownAction = \_ -> postgresTeardown testEnvironment

diff --git a/server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersUntrackTableCleanupSpec.hs b/server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersUntrackTableCleanupSpec.hs
@@ -13,6 +13,7 @@ import Harness.Quoter.Yaml
 import Harness.Test.Fixture qualified as Fixture
 import Harness.Test.Schema (Table (..), table)
 import Harness.Test.Schema qualified as Schema
+import Harness.Test.SetupAction (permitTeardownFail)
 import Harness.TestEnvironment (TestEnvironment)
 import Harness.Webhook qualified as Webhook
 import Harness.Yaml (shouldBeYaml, shouldReturnYaml)
@@ -33,7 +34,7 @@ spec =
               -- so that the server can be referenced while testing
               Fixture.mkLocalTestEnvironment = const Webhook.run,
               Fixture.setupTeardown = \(testEnvironment, (webhookServer, _)) ->
-                [ Postgres.setupTablesActionDiscardingTeardownErrors (schema "authors") testEnvironment,
+                [ permitTeardownFail (Postgres.setupTablesAction (schema "authors") testEnvironment),
                   Fixture.SetupAction
                     { Fixture.setupAction = postgresSetup testEnvironment webhookServer,
                       Fixture.teardownAction = \_ -> pure ()

diff --git a/server/lib/test-harness/src/Harness/Backend/Citus.hs b/server/lib/test-harness/src/Harness/Backend/Citus.hs
@@ -42,13 +42,14 @@ import Harness.Backend.Postgres qualified as Postgres
 import Harness.Constants as Constants
 import Harness.Exceptions
 import Harness.GraphqlEngine qualified as GraphqlEngine
+import Harness.Logging
 import Harness.Quoter.Yaml (interpolateYaml)
 import Harness.Test.BackendType (BackendType (Citus), defaultBackendTypeString, defaultSource)
 import Harness.Test.Permissions qualified as Permissions
 import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..), SchemaName (..))
 import Harness.Test.Schema qualified as Schema
 import Harness.Test.SetupAction (SetupAction (..))
-import Harness.TestEnvironment (TestEnvironment (..), testLogHarness)
+import Harness.TestEnvironment (TestEnvironment (..), testLogMessage)
 import Hasura.Prelude
 import System.Process.Typed
 
@@ -86,14 +87,7 @@ run_ testEnvironment =
 -- On error, print something useful for debugging.
 runInternal :: HasCallStack => TestEnvironment -> String -> String -> IO ()
 runInternal testEnvironment connectionString query = do
-  testLogHarness
-    testEnvironment
-    ( "Executing connection string: "
-        <> connectionString
-        <> "\n"
-        <> "Query: "
-        <> query
-    )
+  testLogMessage testEnvironment $ LogDBQuery (T.pack connectionString) (T.pack query)
   catch
     ( bracket
         ( Postgres.connectPostgreSQL
@@ -255,10 +249,11 @@ createDatabase testEnvironment = do
 -- up.
 dropDatabase :: TestEnvironment -> IO ()
 dropDatabase testEnvironment = do
+  let dbName = uniqueDbName (uniqueTestId testEnvironment)
   runWithInitialDb_
     testEnvironment
-    ("DROP DATABASE " <> uniqueDbName (uniqueTestId testEnvironment) <> " WITH (FORCE);")
-    `catch` \(ex :: SomeException) -> testLogHarness testEnvironment ("Failed to drop the database: " <> show ex)
+    ("DROP DATABASE " <> dbName <> " WITH (FORCE);")
+    `catch` \(ex :: SomeException) -> testLogMessage testEnvironment (LogDropDBFailedWarning (T.pack dbName) ex)
 
 -- | Setup the schema in the most expected way.
 -- NOTE: Certain test modules may warrant having their own local version.

diff --git a/server/lib/test-harness/src/Harness/Backend/Cockroach.hs b/server/lib/test-harness/src/Harness/Backend/Cockroach.hs
@@ -41,13 +41,14 @@ import Harness.Backend.Postgres qualified as Postgres
 import Harness.Constants as Constants
 import Harness.Exceptions
 import Harness.GraphqlEngine qualified as GraphqlEngine
+import Harness.Logging
 import Harness.Quoter.Yaml (interpolateYaml)
 import Harness.Test.BackendType (BackendType (Cockroach), defaultBackendTypeString, defaultSource)
 import Harness.Test.Permissions qualified as Permissions
 import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..), SchemaName (..))
 import Harness.Test.Schema qualified as Schema
 import Harness.Test.SetupAction (SetupAction (..))
-import Harness.TestEnvironment (TestEnvironment (..), testLogHarness)
+import Harness.TestEnvironment (TestEnvironment (..), testLogMessage)
 import Hasura.Prelude
 import System.Process.Typed
 
@@ -86,14 +87,7 @@ run_ testEnvironment =
 -- On error, print something useful for debugging.
 runInternal :: HasCallStack => TestEnvironment -> String -> String -> IO ()
 runInternal testEnvironment connectionString query = do
-  testLogHarness
-    testEnvironment
-    ( "Executing connection string: "
-        <> connectionString
-        <> "\n"
-        <> "Query: "
-        <> query
-    )
+  testLogMessage testEnvironment $ LogDBQuery (T.pack connectionString) (T.pack query)
   catch
     ( bracket
         ( Postgres.connectPostgreSQL
@@ -261,7 +255,7 @@ dropDatabase testEnvironment = do
   runWithInitialDb_
     testEnvironment
     ("DROP DATABASE " <> dbName <> ";")
-    `catch` \(ex :: SomeException) -> testLogHarness testEnvironment ("Failed to drop the database: " <> show ex)
+    `catch` \(ex :: SomeException) -> testLogMessage testEnvironment (LogDropDBFailedWarning (T.pack dbName) ex)
 
 -- Because the test harness sets the schema name we use for testing, we need
 -- to make sure it exists before we run the tests.

diff --git a/server/lib/test-harness/src/Harness/Backend/Postgres.hs b/server/lib/test-harness/src/Harness/Backend/Postgres.hs
@@ -20,7 +20,6 @@ module Harness.Backend.Postgres
     trackTable,
     untrackTable,
     setupTablesAction,
-    setupTablesActionDiscardingTeardownErrors,
     setupPermissionsAction,
     setupFunctionRootFieldAction,
     setupComputedFieldAction,
@@ -41,12 +40,14 @@ import Data.ByteString.Char8 qualified as S8
 import Data.String (fromString)
 import Data.String.Interpolate (i)
 import Data.Text qualified as T
+import Data.Text.Encoding (decodeUtf8)
 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
 import Harness.GraphqlEngine qualified as GraphqlEngine
+import Harness.Logging
 import Harness.Quoter.Yaml (interpolateYaml)
 import Harness.Test.BackendType (BackendType (Postgres), defaultBackendTypeString, defaultSource)
 import Harness.Test.Permissions qualified as Permissions
@@ -58,7 +59,7 @@ import Harness.Test.Schema
   )
 import Harness.Test.Schema qualified as Schema
 import Harness.Test.SetupAction (SetupAction (..))
-import Harness.TestEnvironment (TestEnvironment (..), TestingMode (..), testLogHarness)
+import Harness.TestEnvironment (TestEnvironment (..), TestingMode (..), testLogMessage)
 import Hasura.Prelude
 import System.Process.Typed
 
@@ -137,14 +138,7 @@ run_ testEnvironment =
 -- On error, print something useful for debugging.
 runInternal :: HasCallStack => TestEnvironment -> S8.ByteString -> String -> IO ()
 runInternal testEnvironment connectionString query = do
-  testLogHarness
-    testEnvironment
-    ( "Executing connection string: "
-        <> show connectionString
-        <> "\n"
-        <> "Query: "
-        <> query
-    )
+  testLogMessage testEnvironment $ LogDBQuery (decodeUtf8 connectionString) (T.pack query)
   catch
     ( bracket
         ( Postgres.connectPostgreSQL
@@ -174,14 +168,7 @@ queryWithInitialDb testEnvironment =
 -- On error, print something useful for debugging.
 queryInternal :: (Postgres.FromRow a) => HasCallStack => TestEnvironment -> S8.ByteString -> String -> IO [a]
 queryInternal testEnvironment connectionString query = do
-  testLogHarness
-    testEnvironment
-    ( "Querying connection string: "
-        <> show connectionString
-        <> "\n"
-        <> "Query: "
-        <> query
-    )
+  testLogMessage testEnvironment $ LogDBQuery (decodeUtf8 connectionString) (T.pack query)
   catch
     ( bracket
         ( Postgres.connectPostgreSQL
@@ -394,7 +381,7 @@ dropDatabase testEnvironment = do
   runWithInitialDb_
     testEnvironment
     ("DROP DATABASE " <> dbName <> ";")
-    `catch` \(ex :: SomeException) -> testLogHarness testEnvironment ("Failed to drop the database: " <> show ex)
+    `catch` \(ex :: SomeException) -> testLogMessage testEnvironment (LogDropDBFailedWarning (T.pack dbName) ex)
 
 -- Because the test harness sets the schema name we use for testing, we need
 -- to make sure it exists before we run the tests.
@@ -444,12 +431,6 @@ setupTablesAction ts env =
     (setup ts (env, ()))
     (const $ teardown ts (env, ()))
 
-setupTablesActionDiscardingTeardownErrors :: [Schema.Table] -> TestEnvironment -> SetupAction
-setupTablesActionDiscardingTeardownErrors ts env =
-  SetupAction
-    (setup ts (env, ()))
-    (const $ teardown ts (env, ()) `catchAny` \ex -> testLogHarness env ("Teardown failed: " <> show ex))
-
 setupPermissionsAction :: [Permissions.Permission] -> TestEnvironment -> SetupAction
 setupPermissionsAction permissions env =
   SetupAction

diff --git a/server/lib/test-harness/src/Harness/Backend/Sqlserver.hs b/server/lib/test-harness/src/Harness/Backend/Sqlserver.hs
@@ -15,7 +15,6 @@ module Harness.Backend.Sqlserver
     dropTable,
     untrackTable,
     setupTablesAction,
-    setupTablesActionDiscardingTeardownErrors,
     setupPermissionsAction,
   )
 where
@@ -32,13 +31,14 @@ import Database.ODBC.SQLServer qualified as Sqlserver
 import Harness.Constants qualified as Constants
 import Harness.Exceptions
 import Harness.GraphqlEngine qualified as GraphqlEngine
+import Harness.Logging
 import Harness.Quoter.Yaml (yaml)
 import Harness.Test.BackendType (BackendType (SQLServer), defaultBackendTypeString, defaultSource)
 import Harness.Test.Permissions qualified as Permissions
 import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..))
 import Harness.Test.Schema qualified as Schema
 import Harness.Test.SetupAction (SetupAction (..))
-import Harness.TestEnvironment (TestEnvironment (..), testLogHarness)
+import Harness.TestEnvironment (TestEnvironment (..), testLogMessage)
 import Hasura.Prelude
 import System.Process.Typed
 
@@ -74,14 +74,7 @@ runWithInitialDb_ testEnvironment =
 -- result. Just checks for errors.
 runInternal :: HasCallStack => TestEnvironment -> Text -> String -> IO ()
 runInternal testEnvironment connectionString query' = do
-  testLogHarness
-    testEnvironment
-    ( "Executing with connection string: "
-        <> show connectionString
-        <> "\n"
-        <> "Query: "
-        <> query'
-    )
+  testLogMessage testEnvironment $ LogDBQuery connectionString (T.pack query')
   catch
     ( bracket
         (Sqlserver.connect connectionString)
@@ -279,7 +272,7 @@ dropDatabase testEnvironment = do
   runWithInitialDb_
     testEnvironment
     [i|DROP DATABASE #{dbName}|]
-    `catch` \(ex :: SomeException) -> testLogHarness testEnvironment ("Failed to drop the database: " <> show ex)
+    `catch` \(ex :: SomeException) -> testLogMessage testEnvironment (LogDropDBFailedWarning (T.pack dbName) ex)
 
 -- Because the test harness sets the schema name we use for testing, we need
 -- to make sure it exists before we run the tests.
@@ -330,12 +323,6 @@ setupTablesAction ts env =
     (setup ts (env, ()))
     (const $ teardown ts (env, ()))
 
-setupTablesActionDiscardingTeardownErrors :: [Schema.Table] -> TestEnvironment -> SetupAction
-setupTablesActionDiscardingTeardownErrors ts env =
-  SetupAction
-    (setup ts (env, ()))
-    (const $ teardown ts (env, ()) `catchAny` \ex -> testLogHarness env ("Teardown failed: " <> show ex))
-
 setupPermissionsAction :: [Permissions.Permission] -> TestEnvironment -> SetupAction
 setupPermissionsAction permissions env =
   SetupAction

diff --git a/server/lib/test-harness/src/Harness/GraphqlEngine.hs b/server/lib/test-harness/src/Harness/GraphqlEngine.hs
@@ -54,8 +54,9 @@ import Data.Time (getCurrentTime)
 import Harness.Constants qualified as Constants
 import Harness.Exceptions (bracket, withFrozenCallStack)
 import Harness.Http qualified as Http
+import Harness.Logging
 import Harness.Quoter.Yaml (yaml)
-import Harness.TestEnvironment (Server (..), TestEnvironment (..), getServer, serverUrl, testLogHarness)
+import Harness.TestEnvironment (Server (..), TestEnvironment (..), getServer, serverUrl, testLogMessage)
 import Hasura.App (Loggers (..), ServeCtx (..))
 import Hasura.App qualified as App
 import Hasura.Logging (Hasura)
@@ -111,10 +112,9 @@ postWithHeaders =
 postWithHeadersStatus ::
   HasCallStack => Int -> TestEnvironment -> String -> Http.RequestHeaders -> Value -> IO Value
 postWithHeadersStatus statusCode testEnv@(getServer -> Server {urlPrefix, port}) path headers requestBody = do
-  testLogHarness testEnv $ "Posting to " <> T.pack path
-  testLogHarness testEnv $ "Request body: " <> AP.encodePretty requestBody
+  testLogMessage testEnv $ LogHGERequest (T.pack path) requestBody
   responseBody <- withFrozenCallStack $ Http.postValueWithStatus statusCode (urlPrefix ++ ":" ++ show port ++ path) headers requestBody
-  testLogHarness testEnv $ "Response body: " <> AP.encodePretty responseBody
+  testLogMessage testEnv $ LogHGEResponse (T.pack path) responseBody
   pure responseBody
 
 -- | Post some JSON to graphql-engine, getting back more JSON.