2022-04-20 20:15:42 +03:00
|
|
|
-- | TestEnvironment shared by tests. We intentionally use an abstract type to
|
2021-11-23 21:15:17 +03:00
|
|
|
-- wrap up the values we need for tests, with accessors. This way, the
|
|
|
|
-- tests are less liable to refactorings when we add or change the
|
2022-04-20 20:15:42 +03:00
|
|
|
-- testEnvironment.
|
|
|
|
module Harness.TestEnvironment
|
|
|
|
( TestEnvironment (..),
|
2021-11-23 21:15:17 +03:00
|
|
|
Server (..),
|
2022-02-14 20:24:24 +03:00
|
|
|
getServer,
|
|
|
|
serverUrl,
|
2022-03-17 23:53:56 +03:00
|
|
|
stopServer,
|
2021-11-23 21:15:17 +03:00
|
|
|
)
|
|
|
|
where
|
|
|
|
|
2022-03-17 23:53:56 +03:00
|
|
|
import Control.Concurrent (ThreadId, killThread)
|
2021-11-23 21:15:17 +03:00
|
|
|
import Data.Word
|
2022-04-20 20:15:42 +03:00
|
|
|
import Hasura.Prelude
|
2022-08-03 17:18:43 +03:00
|
|
|
import System.Log.FastLogger qualified as FL
|
2021-11-23 21:15:17 +03:00
|
|
|
|
2022-04-20 20:15:42 +03:00
|
|
|
-- | A testEnvironment that's passed to all tests.
|
|
|
|
data TestEnvironment = TestEnvironment
|
2022-08-03 17:18:43 +03:00
|
|
|
{ server :: Server,
|
|
|
|
logger :: FL.LogStr -> IO (),
|
|
|
|
loggerCleanup :: IO ()
|
2021-11-23 21:15:17 +03:00
|
|
|
}
|
|
|
|
|
2022-06-08 19:35:44 +03:00
|
|
|
instance Show TestEnvironment where
|
|
|
|
show TestEnvironment {server} = "<TestEnvironment: " ++ urlPrefix server ++ ":" ++ show (port server) ++ " >"
|
|
|
|
|
2022-02-14 20:24:24 +03:00
|
|
|
-- | Information about a server that we're working with.
|
2021-11-23 21:15:17 +03:00
|
|
|
data Server = Server
|
|
|
|
{ -- | The port to connect on.
|
|
|
|
port :: Word16,
|
2022-02-14 20:24:24 +03:00
|
|
|
-- | The full URI prefix e.g. http://localhost
|
2021-11-23 21:15:17 +03:00
|
|
|
urlPrefix :: String,
|
|
|
|
-- | The thread that the server is running on, so we can stop it later.
|
|
|
|
threadId :: ThreadId
|
|
|
|
}
|
|
|
|
|
2022-04-20 20:15:42 +03:00
|
|
|
-- | Retrieve the 'Server' associated with some 'TestEnvironment'.
|
|
|
|
getServer :: TestEnvironment -> Server
|
|
|
|
getServer TestEnvironment {server} = server
|
2022-02-14 20:24:24 +03:00
|
|
|
|
|
|
|
-- | Extracts the full URL prefix and port number from a given 'Server'.
|
|
|
|
--
|
|
|
|
-- @
|
|
|
|
-- > serverUrl (Server 8080 "http://localhost" someThreadId)
|
|
|
|
-- "http://localhost:8080"
|
|
|
|
-- @
|
|
|
|
serverUrl :: Server -> String
|
|
|
|
serverUrl Server {urlPrefix, port} = urlPrefix ++ ":" ++ show port
|
2022-03-17 23:53:56 +03:00
|
|
|
|
|
|
|
-- | Forcibly stop a given 'Server'.
|
|
|
|
stopServer :: Server -> IO ()
|
|
|
|
stopServer Server {threadId} = killThread threadId
|