mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 04:24:35 +03:00
3f405915e9
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4890 GitOrigin-RevId: 605408bddf03bef66eb03be8c242797e8fcf89bb
68 lines
2.7 KiB
Haskell
68 lines
2.7 KiB
Haskell
module Main (main) where
|
|
|
|
import Command (AgentCapabilities (..), Command (..), TestOptions (..), parseCommandLine)
|
|
import Control.Exception (throwIO)
|
|
import Control.Monad ((>=>))
|
|
import Data.Aeson.Text (encodeToLazyText)
|
|
import Data.Proxy (Proxy (..))
|
|
import Data.Text.Lazy.IO qualified as Text
|
|
import Hasura.Backends.DataConnector.API (Routes (..), apiClient, openApiSchema)
|
|
import Hasura.Backends.DataConnector.API qualified as API
|
|
import Network.HTTP.Client (defaultManagerSettings, newManager)
|
|
import Servant.API (NamedRoutes)
|
|
import Servant.Client (Client, ClientError, hoistClient, mkClientEnv, runClientM, (//))
|
|
import Test.CapabilitiesSpec qualified
|
|
import Test.HealthSpec qualified
|
|
import Test.Hspec (Spec)
|
|
import Test.Hspec.Core.Runner (runSpec)
|
|
import Test.Hspec.Core.Util (filterPredicate)
|
|
import Test.Hspec.Runner (Config (..), defaultConfig, evaluateSummary)
|
|
import Test.QuerySpec qualified
|
|
import Test.SchemaSpec qualified
|
|
import Prelude
|
|
|
|
testSourceName :: API.SourceName
|
|
testSourceName = "dc-api-tests"
|
|
|
|
tests :: Client IO (NamedRoutes Routes) -> API.SourceName -> API.Config -> API.Capabilities -> Spec
|
|
tests api sourceName agentConfig capabilities = do
|
|
Test.HealthSpec.spec api sourceName agentConfig
|
|
Test.CapabilitiesSpec.spec api agentConfig capabilities
|
|
Test.SchemaSpec.spec api sourceName agentConfig
|
|
Test.QuerySpec.spec api sourceName agentConfig capabilities
|
|
|
|
main :: IO ()
|
|
main = do
|
|
command <- parseCommandLine
|
|
case command of
|
|
Test testOptions@TestOptions {..} -> do
|
|
api <- mkIOApiClient testOptions
|
|
agentCapabilities <- getAgentCapabilities api _toAgentCapabilities
|
|
runSpec (tests api testSourceName _toAgentConfig agentCapabilities) (applyTestConfig defaultConfig testOptions) >>= evaluateSummary
|
|
ExportOpenAPISpec ->
|
|
Text.putStrLn $ encodeToLazyText openApiSchema
|
|
|
|
pure ()
|
|
|
|
mkIOApiClient :: TestOptions -> IO (Client IO (NamedRoutes Routes))
|
|
mkIOApiClient TestOptions {..} = do
|
|
manager <- newManager defaultManagerSettings
|
|
let clientEnv = mkClientEnv manager _toAgentBaseUrl
|
|
pure $ hoistClient (Proxy @(NamedRoutes Routes)) (flip runClientM clientEnv >=> throwClientError) apiClient
|
|
|
|
throwClientError :: Either ClientError a -> IO a
|
|
throwClientError = either throwIO pure
|
|
|
|
getAgentCapabilities :: Client IO (NamedRoutes Routes) -> AgentCapabilities -> IO API.Capabilities
|
|
getAgentCapabilities api = \case
|
|
AutoDetect -> API.crCapabilities <$> (api // _capabilities)
|
|
Explicit capabilities -> pure capabilities
|
|
|
|
applyTestConfig :: Config -> TestOptions -> Config
|
|
applyTestConfig config TestOptions {..} =
|
|
config
|
|
{ configConcurrentJobs = _toParallelDegree,
|
|
configFilterPredicate = filterPredicate <$> _toMatch,
|
|
configSkipPredicate = filterPredicate <$> _toSkip
|
|
}
|