From 40bcd5545ba59e4b1fa9176c5638488b3e647e94 Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Wed, 18 Jan 2023 15:51:15 +0000 Subject: [PATCH] [server/tests] make `useHge` work with Fixtures PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7560 GitOrigin-RevId: 370e5b3ee4d508e7ca5eea426886bf6c82d0cde9 --- .../src/Test/Schema/ConflictsSpec.hs | 47 +++--- .../src/Harness/Services/GraphqlEngine.hs | 146 ++++++++++-------- .../test-harness/src/Harness/Test/Fixture.hs | 39 ++++- .../src/Harness/TestEnvironment.hs | 3 + 4 files changed, 139 insertions(+), 96 deletions(-) diff --git a/server/lib/api-tests/src/Test/Schema/ConflictsSpec.hs b/server/lib/api-tests/src/Test/Schema/ConflictsSpec.hs index 36cb7f1403f..d4131262a4a 100644 --- a/server/lib/api-tests/src/Test/Schema/ConflictsSpec.hs +++ b/server/lib/api-tests/src/Test/Schema/ConflictsSpec.hs @@ -21,33 +21,26 @@ import Test.Hspec (SpecWith, describe, it) spec :: SpecWith GlobalTestEnvironment spec = - Fixture.run - ( NE.fromList - [ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata) - { Fixture.setupTeardown = \(testEnvironment, _) -> - [ Postgres.setupTablesAction schema testEnvironment - ], - Fixture.customOptions = - Just $ - Fixture.defaultOptions - { Fixture.skipTests = - Just "Disabled until we can dynamically change server settings per test. To test, add EFHideUpdateManyFields to soSubscriptions in Harness.Constants -> serveOptions" - } - }, - (Fixture.fixture $ Fixture.Backend Cockroach.backendTypeMetadata) - { Fixture.setupTeardown = \(testEnv, _) -> - [ Cockroach.setupTablesAction schema testEnv - ], - Fixture.customOptions = - Just $ - Fixture.defaultOptions - { Fixture.skipTests = - Just "Disabled until we can dynamically change server settings per test. To test, add EFHideUpdateManyFields to soSubscriptions in Harness.Constants -> serveOptions" - } - } - ] - ) - tests + Fixture.hgeWithEnv + [ ( "HASURA_GRAPHQL_EXPERIMENTAL_FEATURES", + "hide_update_many_fields" + ) + ] + $ Fixture.run + ( NE.fromList + [ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata) + { Fixture.setupTeardown = \(testEnvironment, _) -> + [ Postgres.setupTablesAction schema testEnvironment + ] + }, + (Fixture.fixture $ Fixture.Backend Cockroach.backendTypeMetadata) + { Fixture.setupTeardown = \(testEnv, _) -> + [ Cockroach.setupTablesAction schema testEnv + ] + } + ] + ) + tests -------------------------------------------------------------------------------- -- Schema diff --git a/server/lib/test-harness/src/Harness/Services/GraphqlEngine.hs b/server/lib/test-harness/src/Harness/Services/GraphqlEngine.hs index 34ce99d9786..1b5d06c9122 100644 --- a/server/lib/test-harness/src/Harness/Services/GraphqlEngine.hs +++ b/server/lib/test-harness/src/Harness/Services/GraphqlEngine.hs @@ -2,8 +2,11 @@ -- with Graphql Engine. module Harness.Services.GraphqlEngine ( HgeBinPath (..), - HgeServerInstance (getHgeServerInstanceUrl), + HgeServerInstance (..), + getHgeServerInstanceUrl, + HgeConfig (..), withHge, + spawnServer, emptyHgeConfig, ) where @@ -17,6 +20,7 @@ import Data.Has import Data.IORef import Data.Text qualified as T import Data.Text.Encoding (decodeUtf8) +import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime) import Data.Vector (fromList) import Harness.Exceptions import Harness.Http qualified as Http @@ -38,7 +42,14 @@ data HgeConfig = HgeConfig { hgeConfigEnvironmentVars :: [(String, String)] } -newtype HgeServerInstance = HgeServerInstance {getHgeServerInstanceUrl :: Text} +data HgeServerInstance = HgeServerInstance + { hgeServerHost :: Text, + hgeServerPort :: Int + } + +getHgeServerInstanceUrl :: HgeServerInstance -> Text +getHgeServerInstanceUrl (HgeServerInstance {hgeServerHost, hgeServerPort}) = + "http://" <> hgeServerHost <> ":" <> tshow hgeServerPort <> "/" emptyHgeConfig :: HgeConfig emptyHgeConfig = HgeConfig [] @@ -58,72 +69,79 @@ withHge :: HgeConfig -> SpecWith (HgeServerInstance, a) -> SpecWith a -withHge HgeConfig {..} specs = do +withHge hgeConfig specs = do flip aroundWith specs \action a -> runManaged do let hgeBin = getter a pgUrl = getter a let logger = getter @Logger a - port <- spawnServer logger pgUrl hgeBin - liftIO do - let urlPrefix = "http://127.0.0.1" - let server = HgeServerInstance (urlPrefix <> ":" <> tshow port <> "/") - result <- Http.healthCheck' (T.unpack $ getHgeServerInstanceUrl server) - case result of - Http.Healthy -> action (server, a) - Http.Unhealthy failures -> do - runLogger logger $ HgeInstanceFailedHealthcheckMessage failures - error "Graphql-Engine failed http healthcheck." - where - spawnServer :: Logger -> PostgresServerUrl -> HgeBinPath -> Managed Warp.Port - spawnServer logger pgUrl (HgeBinPath hgeBinPath) = do - freshDb <- mkFreshPostgresDb logger pgUrl - let metadataDbUrl = mkFreshDbConnectionString pgUrl freshDb - ((_, Just hgeStdOut, Just hgeStdErr, _), port) <- - managed - ( bracket - ( do - port <- bracket (Warp.openFreePort) (Socket.close . snd) (pure . fst) - runLogger logger $ HgeInstanceStartMessage port + server <- spawnServer logger pgUrl hgeBin hgeConfig + liftIO $ action (server, a) - process <- - createProcess - ( proc - hgeBinPath - [ "serve", - "--enable-console", - "--server-port", - show port, - "--metadata-database-url", - T.unpack (getPostgresServerUrl metadataDbUrl) - ] - ) - { env = - Just $ - ("HASURA_GRAPHQL_GRACEFUL_SHUTDOWN_TIMEOUT", "0") - : hgeConfigEnvironmentVars, - std_out = CreatePipe, - std_err = CreatePipe, - create_group = True - } - `catchAny` ( \exn -> - error $ - unlines - [ "Failed to spawn Graphql-Engine process:", - show exn - ] - ) - return $ (process, port) - ) - ( \(process@(_, _, _, ph), port) -> do - interruptProcessGroupOf ph - exitCode <- waitForProcess ph - cleanupProcess process - runLogger logger $ HgeInstanceShutdownMessage port exitCode - ) +-- | spin up a Manager HGE instance and check it is healthy +spawnServer :: + Logger -> + PostgresServerUrl -> + HgeBinPath -> + HgeConfig -> + Managed HgeServerInstance +spawnServer logger pgUrl (HgeBinPath hgeBinPath) (HgeConfig {hgeConfigEnvironmentVars}) = do + freshDb <- mkFreshPostgresDb logger pgUrl + let metadataDbUrl = mkFreshDbConnectionString pgUrl freshDb + ((_, Just hgeStdOut, Just hgeStdErr, _), port) <- + managed + ( bracket + ( do + port <- bracket (Warp.openFreePort) (Socket.close . snd) (pure . fst) + runLogger logger $ HgeInstanceStartMessage port + + process <- + createProcess + ( proc + hgeBinPath + [ "serve", + "--enable-console", + "--server-port", + show port, + "--metadata-database-url", + T.unpack (getPostgresServerUrl metadataDbUrl) + ] + ) + { env = + Just $ + ("HASURA_GRAPHQL_GRACEFUL_SHUTDOWN_TIMEOUT", "0") + : hgeConfigEnvironmentVars, + std_out = CreatePipe, + std_err = CreatePipe, + create_group = True + } + `catchAny` ( \exn -> + error $ + unlines + [ "Failed to spawn Graphql-Engine process:", + show exn + ] + ) + return $ (process, port) ) - hgeLogRelayThread logger hgeStdOut - hgeStdErrRelayThread logger hgeStdErr - return port + ( \(process@(_, _, _, ph), port) -> do + startTime <- getCurrentTime + interruptProcessGroupOf ph + exitCode <- waitForProcess ph + cleanupProcess process + endTime <- getCurrentTime + runLogger logger $ HgeInstanceShutdownMessage port exitCode (diffUTCTime endTime startTime) + ) + ) + hgeLogRelayThread logger hgeStdOut + hgeStdErrRelayThread logger hgeStdErr + liftIO do + let server = HgeServerInstance "127.0.0.1" port + result <- Http.healthCheck' (T.unpack $ getHgeServerInstanceUrl server) + case result of + Http.Healthy -> pure server + Http.Unhealthy failures -> do + runLogger logger $ HgeInstanceFailedHealthcheckMessage failures + error "Graphql-Engine failed http healthcheck." -- | Log message type used to indicate a HGE server instance has started. data HgeInstanceStartMessage = HgeInstanceStartMessage {hiStartPort :: Int} @@ -150,7 +168,8 @@ instance LoggableMessage HgeInstanceFailedHealthcheckMessage where -- | Log message type used to indicate a HGE server instance has shutdown. data HgeInstanceShutdownMessage = HgeInstanceShutdownMessage { hiShutdownPort :: Int, - hiShutdownExitCode :: ExitCode + hiShutdownExitCode :: ExitCode, + hiShutdownDuration :: NominalDiffTime } instance LoggableMessage HgeInstanceShutdownMessage where @@ -158,6 +177,7 @@ instance LoggableMessage HgeInstanceShutdownMessage where object [ ("type", String "HgeInstanceShutdownMessage"), ("port", Number (fromIntegral hiShutdownPort)), + ("duration", Number (realToFrac hiShutdownDuration)), ("exit-code", String (tshow hiShutdownExitCode)) ] diff --git a/server/lib/test-harness/src/Harness/Test/Fixture.hs b/server/lib/test-harness/src/Harness/Test/Fixture.hs index 9dcb2c5b6b4..9f835954600 100644 --- a/server/lib/test-harness/src/Harness/Test/Fixture.hs +++ b/server/lib/test-harness/src/Harness/Test/Fixture.hs @@ -10,6 +10,7 @@ module Harness.Test.Fixture runWithLocalTestEnvironment, runWithLocalTestEnvironmentSingleSetup, runWithLocalTestEnvironmentInternal, + hgeWithEnv, createDatabases, Fixture (..), fixture, @@ -31,8 +32,10 @@ module Harness.Test.Fixture ) where +import Control.Concurrent.Async qualified as Async import Control.Monad.Managed (Managed, runManaged, with) import Data.Aeson (Value) +import Data.Has (getter) import Data.Set qualified as S import Data.Text qualified as T import Data.UUID.V4 (nextRandom) @@ -42,6 +45,7 @@ import Harness.Backend.Postgres qualified as Postgres import Harness.Backend.Sqlserver qualified as Sqlserver import Harness.Exceptions import Harness.Logging +import Harness.Services.GraphqlEngine import Harness.Test.BackendType import Harness.Test.CustomOptions import Harness.Test.FixtureName @@ -49,7 +53,7 @@ import Harness.Test.SetupAction (SetupAction (..)) import Harness.Test.SetupAction qualified as SetupAction import Harness.TestEnvironment ( GlobalTestEnvironment (..), - Server, + Server (..), TestEnvironment (..), TestingMode (..), UniqueTestId (..), @@ -86,7 +90,34 @@ import Test.Hspec run :: NonEmpty (Fixture ()) -> (Options -> SpecWith TestEnvironment) -> SpecWith GlobalTestEnvironment run = runSingleSetup --- runWithLocalTestEnvironment fixtures (\opts -> beforeWith (\(te, ()) -> return te) (tests opts)) +-- given a fresh HgeServerInstance, add it in our `TestEnvironment` +useHgeInTestEnvironment :: GlobalTestEnvironment -> HgeServerInstance -> IO GlobalTestEnvironment +useHgeInTestEnvironment globalTestEnvironment (HgeServerInstance {hgeServerHost, hgeServerPort}) = do + serverThreadIrrelevant <- Async.async (return ()) + let server = + Server + { port = fromIntegral hgeServerPort, + urlPrefix = "http://" <> T.unpack hgeServerHost, + thread = serverThreadIrrelevant + } + pure $ globalTestEnvironment {server = server} + +-- | Start an instance of HGE which has certain environment variables defined +-- and pass it around inside the `GlobalTestEnvironment` +hgeWithEnv :: [(String, String)] -> SpecWith GlobalTestEnvironment -> SpecWith GlobalTestEnvironment +hgeWithEnv env = do + let hgeConfig = emptyHgeConfig {hgeConfigEnvironmentVars = env} + + aroundAllWith + ( \specs globalTestEnvironment -> runManaged $ do + hgeServerInstance <- + spawnServer + (getter globalTestEnvironment) + (getter globalTestEnvironment) + (getter globalTestEnvironment) + hgeConfig + liftIO $ useHgeInTestEnvironment globalTestEnvironment hgeServerInstance >>= specs + ) {-# DEPRECATED runSingleSetup "runSingleSetup lets all specs in aFixture share a single database environment, which impedes parallelisation and out-of-order execution." #-} runSingleSetup :: NonEmpty (Fixture ()) -> (Options -> SpecWith TestEnvironment) -> SpecWith GlobalTestEnvironment @@ -273,10 +304,6 @@ runSetupActions logger acts = go acts [] [] -> return (rethrowAll cleanupAcc) SetupAction {setupAction, teardownAction} : rest -> do a <- try setupAction - -- It would be nice to be able to log the execution of setup actions - -- into a logfile or similar. Using `putStrLn` interferes with the - -- default Hspec test runner's output, so the lines below have been left - -- commented out. case a of Left (exn :: SomeException) -> do log $ LogFixtureSetupFailed (length cleanupAcc) diff --git a/server/lib/test-harness/src/Harness/TestEnvironment.hs b/server/lib/test-harness/src/Harness/TestEnvironment.hs index 17b105d5ea2..2295ed8f1c7 100644 --- a/server/lib/test-harness/src/Harness/TestEnvironment.hs +++ b/server/lib/test-harness/src/Harness/TestEnvironment.hs @@ -183,6 +183,9 @@ data Server = Server thread :: Async () } +instance Show Server where + show = serverUrl + -- | Retrieve the 'Server' associated with some 'TestEnvironment'. getServer :: TestEnvironment -> Server getServer TestEnvironment {globalEnvironment} = server globalEnvironment