2021-11-23 21:15:17 +03:00
|
|
|
-- | State shared by tests. We intentionally use an abstract type to
|
|
|
|
-- 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
|
|
|
|
-- state.
|
|
|
|
module Harness.State
|
|
|
|
( State (..),
|
|
|
|
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-02-14 20:24:24 +03:00
|
|
|
import Hasura.Prelude hiding (State)
|
2021-11-23 21:15:17 +03:00
|
|
|
|
|
|
|
-- | A state that's passed to all tests.
|
|
|
|
data State = State
|
|
|
|
{ server :: 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-02-14 20:24:24 +03:00
|
|
|
-- | Retrieve the 'Server' associated with some 'State'.
|
2021-11-23 21:15:17 +03:00
|
|
|
getServer :: State -> Server
|
2022-02-14 20:24:24 +03:00
|
|
|
getServer State {server} = server
|
|
|
|
|
|
|
|
-- | 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
|