mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-21 06:21:39 +03:00
3a8fadb22b
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2578 Co-authored-by: Rikin Kachhia <54616969+rikinsk@users.noreply.github.com> Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com> GitOrigin-RevId: 88a02f8a617006853b350f48f4317c78ab97435b
352 lines
12 KiB
Haskell
352 lines
12 KiB
Haskell
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
-- | A module for running graphql-engine in a testing context.
|
|
module Hasura.Test.App
|
|
( TestM,
|
|
runTestM,
|
|
withHasuraTestApp,
|
|
)
|
|
where
|
|
|
|
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
|
|
import Control.Monad.Trans.Control (MonadBaseControl (..))
|
|
import Control.Monad.Trans.Managed (lowerManagedT)
|
|
import Data.Environment (mkEnvironment)
|
|
import Data.HashSet qualified as HS
|
|
import Data.Time.Clock (getCurrentTime)
|
|
import Database.PG.Query qualified as Q
|
|
import Hasura.App
|
|
( GlobalCtx (..),
|
|
accessDeniedErrMsg,
|
|
getCatalogStateTx,
|
|
initGlobalCtx,
|
|
initialiseServeCtx,
|
|
mkHGEServer,
|
|
mkMSSQLSourceResolver,
|
|
mkPgSourceResolver,
|
|
notifySchemaCacheSyncTx,
|
|
setCatalogStateTx,
|
|
)
|
|
import Hasura.Backends.Postgres.Connection (checkDbConnection)
|
|
import Hasura.Base.Error
|
|
( Code (AccessDenied),
|
|
QErr,
|
|
throw400,
|
|
withPathK,
|
|
)
|
|
import Hasura.Eventing.ScheduledTrigger
|
|
import Hasura.GraphQL.Execute (checkQueryInAllowlist)
|
|
import Hasura.GraphQL.Execute.Action
|
|
import Hasura.GraphQL.Execute.Backend (ExecutionStep (..), MonadQueryTags (..))
|
|
import Hasura.GraphQL.Execute.Common (MonadGQLExecutionCheck (..))
|
|
import Hasura.GraphQL.Logging (MonadQueryLog (..))
|
|
import Hasura.GraphQL.Transport.HTTP
|
|
( CacheStoreSuccess (CacheStoreSkipped),
|
|
MonadExecuteQuery (..),
|
|
)
|
|
import Hasura.GraphQL.Transport.HTTP.Protocol (toParsed)
|
|
import Hasura.GraphQL.Transport.WebSocket.Server (MonadWSLog (..))
|
|
import Hasura.Logging qualified as Logging
|
|
import Hasura.Metadata.Class
|
|
( MetadataStorageT (..),
|
|
MonadMetadataStorage (..),
|
|
)
|
|
import Hasura.Prelude
|
|
import Hasura.QueryTags (emptyQueryTagsComment)
|
|
import Hasura.RQL.DDL.Schema.Catalog
|
|
import Hasura.RQL.Types.Source (MonadResolveSource (..))
|
|
import Hasura.Server.API.Query (requiresAdmin)
|
|
import Hasura.Server.App
|
|
( ConsoleRenderer (..),
|
|
HandlerCtx (hcUser),
|
|
MonadConfigApiHandler (..),
|
|
MonadMetadataApiAuthorization (..),
|
|
)
|
|
import Hasura.Server.Auth
|
|
( AuthHookG (AuthHookG),
|
|
UserAuthentication (..),
|
|
getUserInfoWithExpTime,
|
|
)
|
|
import Hasura.Server.Init (getDbId, logLevelEnv, mkServeOptions)
|
|
import Hasura.Server.Init.Config
|
|
( API (..),
|
|
PostgresConnInfo (PostgresConnInfo),
|
|
RawConnParams (RawConnParams),
|
|
RawServeOptions (..),
|
|
ServeOptions (soEnabledAPIs),
|
|
runWithEnv,
|
|
)
|
|
import Hasura.Server.Limits (HasResourceLimits (..), ResourceLimits (..))
|
|
import Hasura.Server.Logging (HttpLog (..))
|
|
import Hasura.Server.Metrics (ServerMetrics, createServerMetrics)
|
|
import Hasura.Session (UserInfo (_uiRole), adminRoleName)
|
|
import Hasura.Tracing (HasReporter (..), TraceT, noReporter)
|
|
import Network.Wai (Application)
|
|
import System.Environment (getEnvironment)
|
|
import System.Metrics qualified as EKG
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | A concrete monad for running the GraphQL-engine. This is the context in
|
|
-- which tests will run.
|
|
newtype TestM a = TestM {_runTestM :: TestConfig -> IO a}
|
|
deriving
|
|
( Functor,
|
|
Applicative,
|
|
Monad,
|
|
MonadIO,
|
|
MonadBase IO,
|
|
MonadBaseControl IO,
|
|
MonadCatch,
|
|
MonadMask,
|
|
MonadThrow,
|
|
MonadReader TestConfig
|
|
)
|
|
via (ReaderT TestConfig IO)
|
|
|
|
-- | Exposed `TestM` deconstructor
|
|
runTestM :: TestM a -> TestConfig -> IO a
|
|
runTestM = _runTestM
|
|
|
|
-- | The testing environment
|
|
data TestConfig = TestConfig
|
|
{ tcPostgresPool :: Q.PGPool,
|
|
tcPostgresLogger :: Q.PGLogger
|
|
}
|
|
|
|
-- | Exposed `TestConfig` constructor
|
|
mkTestConfig :: Q.ConnInfo -> IO TestConfig
|
|
mkTestConfig pgConnInfo = do
|
|
let pgLogger = print
|
|
connParams = Q.defaultConnParams {Q.cpConns = 1}
|
|
pgPool <- Q.initPGPool pgConnInfo connParams pgLogger
|
|
pure $
|
|
TestConfig
|
|
{ tcPostgresPool = pgPool,
|
|
tcPostgresLogger = pgLogger
|
|
}
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- GraphQL-engine instances
|
|
|
|
-- Note: For consistency, the following typeclass instances should mirror those
|
|
-- used by the open source graphql-engine, unless we intend to mock certain
|
|
-- operations.
|
|
|
|
instance MonadMetadataStorage (MetadataStorageT TestM) where
|
|
fetchMetadataResourceVersion = runInSeparateTx fetchMetadataResourceVersionFromCatalog
|
|
fetchMetadata = runInSeparateTx fetchMetadataAndResourceVersionFromCatalog
|
|
fetchMetadataNotifications a b = runInSeparateTx $ fetchMetadataNotificationsFromCatalog a b
|
|
setMetadata r = runInSeparateTx . setMetadataInCatalog (Just r)
|
|
notifySchemaCacheSync a b c = runInSeparateTx $ notifySchemaCacheSyncTx a b c
|
|
getCatalogState = runInSeparateTx getCatalogStateTx
|
|
setCatalogState a b = runInSeparateTx $ setCatalogStateTx a b
|
|
|
|
getDatabaseUid = runInSeparateTx getDbId
|
|
checkMetadataStorageHealth = lift (asks tcPostgresPool) >>= checkDbConnection
|
|
|
|
getDeprivedCronTriggerStats = runInSeparateTx . getDeprivedCronTriggerStatsTx
|
|
getScheduledEventsForDelivery = runInSeparateTx getScheduledEventsForDeliveryTx
|
|
insertCronEvents = runInSeparateTx . insertCronEventsTx
|
|
insertOneOffScheduledEvent = runInSeparateTx . insertOneOffScheduledEventTx
|
|
insertScheduledEventInvocation a b = runInSeparateTx $ insertInvocationTx a b
|
|
setScheduledEventOp a b c = runInSeparateTx $ setScheduledEventOpTx a b c
|
|
unlockScheduledEvents a b = runInSeparateTx $ unlockScheduledEventsTx a b
|
|
unlockAllLockedScheduledEvents = runInSeparateTx unlockAllLockedScheduledEventsTx
|
|
clearFutureCronEvents = runInSeparateTx . dropFutureCronEventsTx
|
|
getOneOffScheduledEvents a b = runInSeparateTx $ getOneOffScheduledEventsTx a b
|
|
getCronEvents a b c = runInSeparateTx $ getCronEventsTx a b c
|
|
getInvocations a b = runInSeparateTx $ getInvocationsTx a b
|
|
deleteScheduledEvent a b = runInSeparateTx $ deleteScheduledEventTx a b
|
|
|
|
insertAction a b c d = runInSeparateTx $ insertActionTx a b c d
|
|
fetchUndeliveredActionEvents = runInSeparateTx fetchUndeliveredActionEventsTx
|
|
setActionStatus a b = runInSeparateTx $ setActionStatusTx a b
|
|
fetchActionResponse = runInSeparateTx . fetchActionResponseTx
|
|
clearActionData = runInSeparateTx . clearActionDataTx
|
|
setProcessingActionLogsToPending = runInSeparateTx . setProcessingActionLogsToPendingTx
|
|
|
|
runInSeparateTx :: Q.TxE QErr a -> MetadataStorageT TestM a
|
|
runInSeparateTx tx = do
|
|
pool <- lift $ asks tcPostgresPool
|
|
liftEitherM $ liftIO $ runExceptT $ Q.runTx pool (Q.RepeatableRead, Nothing) tx
|
|
|
|
instance MonadResolveSource TestM where
|
|
getPGSourceResolver = mkPgSourceResolver <$> asks tcPostgresLogger
|
|
getMSSQLSourceResolver = return mkMSSQLSourceResolver
|
|
|
|
instance UserAuthentication (TraceT TestM) where
|
|
resolveUserInfo logger manager headers authMode reqs =
|
|
runExceptT $ getUserInfoWithExpTime logger manager headers authMode reqs
|
|
|
|
instance MonadMetadataApiAuthorization TestM where
|
|
authorizeV1QueryApi query handlerCtx = runExceptT do
|
|
let currRole = _uiRole $ hcUser handlerCtx
|
|
when (requiresAdmin query && currRole /= adminRoleName) $
|
|
withPathK "args" $ throw400 AccessDenied accessDeniedErrMsg
|
|
|
|
authorizeV1MetadataApi _ handlerCtx = runExceptT do
|
|
let currRole = _uiRole $ hcUser handlerCtx
|
|
when (currRole /= adminRoleName) $
|
|
withPathK "args" $ throw400 AccessDenied accessDeniedErrMsg
|
|
|
|
authorizeV2QueryApi _ handlerCtx = runExceptT do
|
|
let currRole = _uiRole $ hcUser handlerCtx
|
|
when (currRole /= adminRoleName) $
|
|
withPathK "args" $ throw400 AccessDenied accessDeniedErrMsg
|
|
|
|
instance MonadGQLExecutionCheck TestM where
|
|
checkGQLExecution userInfo _ enableAL sc query = runExceptT $ do
|
|
req <- toParsed query
|
|
checkQueryInAllowlist enableAL userInfo req sc
|
|
return req
|
|
executeIntrospection _ introspectionQuery _ =
|
|
pure $ Right $ ExecStepRaw introspectionQuery
|
|
|
|
instance HttpLog TestM where
|
|
type ExtraHttpLogMetadata TestM = ()
|
|
emptyExtraHttpLogMetadata = ()
|
|
buildExtraHttpLogMetadata = const ()
|
|
logHttpError _a _b _c _d _e _f _g _h = pure ()
|
|
logHttpSuccess _a _b _c _d _e _f _g _h _i _j _k _l = pure ()
|
|
|
|
instance MonadQueryLog TestM where
|
|
logQueryLog = Logging.unLogger
|
|
|
|
instance MonadQueryTags TestM where
|
|
createQueryTags _qtSourceConfig _attributes = pure emptyQueryTagsComment
|
|
|
|
instance HasReporter TestM where
|
|
askReporter = pure noReporter
|
|
|
|
instance HasResourceLimits TestM where
|
|
askHTTPHandlerLimit = pure $ ResourceLimits id
|
|
askGraphqlOperationLimit = pure $ \_ _ -> ResourceLimits id
|
|
|
|
instance MonadExecuteQuery TestM where
|
|
cacheLookup _ _ _ _ = pure ([], Nothing)
|
|
cacheStore _ _ _ = pure (Right CacheStoreSkipped)
|
|
|
|
-- Instances not currently needed
|
|
|
|
instance ConsoleRenderer TestM where
|
|
renderConsole = error "renderConsole: unimplemented for testing"
|
|
|
|
instance MonadWSLog TestM where
|
|
logWSLog = error "logWSLog: unimplemented for testing"
|
|
|
|
instance MonadConfigApiHandler TestM where
|
|
runConfigApiHandler = error "runConfigApiHandler: unimplemented for testing"
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- | Run an instance of the GraphQL-engine in a testing environment, exposed as
|
|
-- a WAI app.
|
|
withHasuraTestApp ::
|
|
-- | Metadata database URL
|
|
String ->
|
|
(Application -> TestM a) ->
|
|
IO a
|
|
withHasuraTestApp metadataDbUrl action = do
|
|
let setupHook = \_ -> pure ()
|
|
postPollHook = Nothing
|
|
|
|
initTime <- getCurrentTime
|
|
(ekgStore, serverMetrics) <- initMetrics
|
|
|
|
rawEnv <- filter ((`elem` envAllowList) . fst) <$> getEnvironment
|
|
let serveOptions = makeServeOptions rawEnv
|
|
env = mkEnvironment rawEnv
|
|
globalCtx <-
|
|
initGlobalCtx env (Just metadataDbUrl) $ PostgresConnInfo Nothing Nothing
|
|
testConfig <- mkTestConfig (_gcMetadataDbConnInfo globalCtx)
|
|
|
|
flip runTestM testConfig $
|
|
lowerManagedT $ do
|
|
serveCtx <- initialiseServeCtx env globalCtx serveOptions
|
|
waiApp <-
|
|
mkHGEServer
|
|
setupHook
|
|
env
|
|
serveOptions
|
|
serveCtx
|
|
initTime
|
|
postPollHook
|
|
serverMetrics
|
|
ekgStore
|
|
lift $ action waiApp
|
|
|
|
-- A whitelist of environment variables that are safe to use in testing
|
|
envAllowList :: [String]
|
|
envAllowList = [fst logLevelEnv]
|
|
|
|
-- For now, we use the default server options for simplicity.
|
|
makeServeOptions :: [(String, String)] -> ServeOptions Logging.Hasura
|
|
makeServeOptions env =
|
|
case runWithEnv env (mkServeOptions defaultRawServeOptions) of
|
|
Left errMsg -> error $ "makeServeOptions: " ++ errMsg
|
|
Right opts -> setEnabledAPIs opts
|
|
|
|
-- Enabling only those APIs needed for testing
|
|
setEnabledAPIs ::
|
|
ServeOptions Logging.Hasura -> ServeOptions Logging.Hasura
|
|
setEnabledAPIs serveOptions =
|
|
serveOptions {soEnabledAPIs = HS.fromList [GRAPHQL, METADATA]}
|
|
|
|
initMetrics :: IO (EKG.Store EKG.EmptyMetrics, ServerMetrics)
|
|
initMetrics = do
|
|
ekgStore <- liftIO EKG.newStore
|
|
serverMetrics <- liftIO $ createServerMetrics ekgStore
|
|
pure (EKG.subset EKG.emptyOf ekgStore, serverMetrics)
|
|
|
|
defaultRawServeOptions :: RawServeOptions impl
|
|
defaultRawServeOptions =
|
|
RawServeOptions
|
|
{ rsoPort = Nothing,
|
|
rsoHost = Nothing,
|
|
rsoConnParams =
|
|
RawConnParams
|
|
Nothing
|
|
Nothing
|
|
Nothing
|
|
Nothing
|
|
Nothing
|
|
Nothing,
|
|
rsoTxIso = Nothing,
|
|
rsoAdminSecret = Nothing,
|
|
rsoAuthHook = AuthHookG Nothing Nothing,
|
|
rsoJwtSecret = Nothing,
|
|
rsoUnAuthRole = Nothing,
|
|
rsoCorsConfig = Nothing,
|
|
rsoEnableConsole = False,
|
|
rsoConsoleAssetsDir = Nothing,
|
|
rsoEnableTelemetry = Nothing,
|
|
rsoWsReadCookie = False,
|
|
rsoStringifyNum = False,
|
|
rsoDangerousBooleanCollapse = Nothing,
|
|
rsoEnabledAPIs = Nothing,
|
|
rsoMxRefetchInt = Nothing,
|
|
rsoMxBatchSize = Nothing,
|
|
rsoEnableAllowlist = False,
|
|
rsoEnabledLogTypes = Nothing,
|
|
-- Setting lowest log level by default in order to make the tests more
|
|
-- legible
|
|
rsoLogLevel = Just Logging.LevelError,
|
|
rsoDevMode = False,
|
|
rsoAdminInternalErrors = Nothing,
|
|
rsoEventsHttpPoolSize = Nothing,
|
|
rsoEventsFetchInterval = Nothing,
|
|
rsoAsyncActionsFetchInterval = Nothing,
|
|
rsoLogHeadersFromEnv = False,
|
|
rsoEnableRemoteSchemaPermissions = False,
|
|
rsoWebSocketCompression = False,
|
|
rsoWebSocketKeepAlive = Nothing,
|
|
rsoInferFunctionPermissions = Nothing,
|
|
rsoEnableMaintenanceMode = False,
|
|
rsoSchemaPollInterval = Nothing,
|
|
rsoExperimentalFeatures = Nothing,
|
|
rsoEventsFetchBatchSize = Nothing,
|
|
rsoGracefulShutdownTimeout = Nothing,
|
|
rsoWebSocketConnectionInitTimeout = Nothing
|
|
}
|