mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 09:51:59 +03:00
204cd3514b
1. Reuses postgres connections during startup which reduces the overhead of opening and closing connections. 2. Faster schema cache building. This is done by fetching all the required data in a single sql statement.
274 lines
10 KiB
Haskell
274 lines
10 KiB
Haskell
{-# LANGUAGE TypeApplications #-}
|
|
module Main where
|
|
|
|
import Migrate (migrateCatalog)
|
|
import Ops
|
|
|
|
import Control.Monad.STM (atomically)
|
|
import Data.Time.Clock (getCurrentTime)
|
|
import Options.Applicative
|
|
import System.Environment (getEnvironment, lookupEnv)
|
|
import System.Exit (exitFailure)
|
|
|
|
|
|
import qualified Control.Concurrent as C
|
|
import qualified Data.Aeson as A
|
|
import qualified Data.ByteString.Char8 as BC
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import qualified Data.ByteString.Lazy.Char8 as BLC
|
|
import qualified Data.Text as T
|
|
import qualified Data.Time.Clock as Clock
|
|
import qualified Data.Yaml as Y
|
|
import qualified Network.HTTP.Client as HTTP
|
|
import qualified Network.HTTP.Client.TLS as HTTP
|
|
import qualified Network.Wai.Handler.Warp as Warp
|
|
|
|
import Hasura.Db
|
|
import Hasura.Events.Lib
|
|
import Hasura.Logging
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DDL.Metadata (fetchMetadata)
|
|
import Hasura.RQL.Types (SQLGenCtx (..), SchemaCache (..),
|
|
adminUserInfo, emptySchemaCache)
|
|
import Hasura.Server.App (SchemaCacheRef (..), getSCFromRef,
|
|
logInconsObjs, mkWaiApp)
|
|
import Hasura.Server.Auth
|
|
import Hasura.Server.CheckUpdates (checkForUpdates)
|
|
import Hasura.Server.Init
|
|
import Hasura.Server.Logging
|
|
import Hasura.Server.Query (peelRun)
|
|
import Hasura.Server.SchemaUpdate
|
|
import Hasura.Server.Telemetry
|
|
import Hasura.Server.Version (currentVersion)
|
|
|
|
import qualified Database.PG.Query as Q
|
|
|
|
printErrExit :: forall a . String -> IO a
|
|
printErrExit = (>> exitFailure) . putStrLn
|
|
|
|
printErrJExit :: A.ToJSON a => forall b . a -> IO b
|
|
printErrJExit = (>> exitFailure) . printJSON
|
|
|
|
parseHGECommand :: Parser RawHGECommand
|
|
parseHGECommand =
|
|
subparser
|
|
( command "serve" (info (helper <*> (HCServe <$> serveOpts))
|
|
( progDesc "Start the GraphQL Engine Server"
|
|
<> footerDoc (Just serveCmdFooter)
|
|
))
|
|
<> command "export" (info (pure HCExport)
|
|
( progDesc "Export graphql-engine's metadata to stdout" ))
|
|
<> command "clean" (info (pure HCClean)
|
|
( progDesc "Clean graphql-engine's metadata to start afresh" ))
|
|
<> command "execute" (info (pure HCExecute)
|
|
( progDesc "Execute a query" ))
|
|
<> command "version" (info (pure HCVersion)
|
|
(progDesc "Prints the version of GraphQL Engine"))
|
|
)
|
|
where
|
|
serveOpts = RawServeOptions
|
|
<$> parseServerPort
|
|
<*> parseServerHost
|
|
<*> parseConnParams
|
|
<*> parseTxIsolation
|
|
<*> (parseAdminSecret <|> parseAccessKey)
|
|
<*> parseWebHook
|
|
<*> parseJwtSecret
|
|
<*> parseUnAuthRole
|
|
<*> parseCorsConfig
|
|
<*> parseEnableConsole
|
|
<*> parseEnableTelemetry
|
|
<*> parseWsReadCookie
|
|
<*> parseStringifyNum
|
|
<*> parseEnabledAPIs
|
|
<*> parseMxRefetchInt
|
|
<*> parseMxBatchSize
|
|
<*> parseFallbackRefetchInt
|
|
|
|
|
|
parseArgs :: IO HGEOptions
|
|
parseArgs = do
|
|
rawHGEOpts <- execParser opts
|
|
env <- getEnvironment
|
|
let eitherOpts = runWithEnv env $ mkHGEOptions rawHGEOpts
|
|
either printErrExit return eitherOpts
|
|
where
|
|
opts = info (helper <*> hgeOpts)
|
|
( fullDesc <>
|
|
header "Hasura GraphQL Engine: Realtime GraphQL API over Postgres with access control" <>
|
|
footerDoc (Just mainCmdFooter)
|
|
)
|
|
hgeOpts = HGEOptionsG <$> parseRawConnInfo <*> parseHGECommand
|
|
|
|
printJSON :: (A.ToJSON a) => a -> IO ()
|
|
printJSON = BLC.putStrLn . A.encode
|
|
|
|
printYaml :: (A.ToJSON a) => a -> IO ()
|
|
printYaml = BC.putStrLn . Y.encode
|
|
|
|
mkPGLogger :: Logger -> Q.PGLogger
|
|
mkPGLogger (Logger logger) (Q.PLERetryMsg msg) =
|
|
logger $ PGLog LevelWarn msg
|
|
|
|
main :: IO ()
|
|
main = do
|
|
(HGEOptionsG rci hgeCmd) <- parseArgs
|
|
-- global http manager
|
|
httpManager <- HTTP.newManager HTTP.tlsManagerSettings
|
|
loggerCtx <- mkLoggerCtx $ defaultLoggerSettings True
|
|
instanceId <- mkInstanceId
|
|
let logger = mkLogger loggerCtx
|
|
pgLogger = mkPGLogger logger
|
|
case hgeCmd of
|
|
HCServe so@(ServeOptions port host cp isoL mAdminSecret mAuthHook
|
|
mJwtSecret mUnAuthRole corsCfg enableConsole
|
|
enableTelemetry strfyNum enabledAPIs lqOpts) -> do
|
|
let sqlGenCtx = SQLGenCtx strfyNum
|
|
|
|
initTime <- Clock.getCurrentTime
|
|
-- log serve options
|
|
unLogger logger $ serveOptsToLog so
|
|
hloggerCtx <- mkLoggerCtx $ defaultLoggerSettings False
|
|
|
|
authModeRes <- runExceptT $ mkAuthMode mAdminSecret mAuthHook mJwtSecret
|
|
mUnAuthRole httpManager loggerCtx
|
|
|
|
am <- either (printErrExit . T.unpack) return authModeRes
|
|
|
|
ci <- procConnInfo rci
|
|
-- log postgres connection info
|
|
unLogger logger $ connInfoToLog ci
|
|
|
|
pool <- Q.initPGPool ci cp pgLogger
|
|
|
|
-- safe init catalog
|
|
initRes <- initialise pool sqlGenCtx logger httpManager
|
|
|
|
(app, cacheRef, cacheInitTime) <-
|
|
mkWaiApp isoL loggerCtx sqlGenCtx pool ci httpManager am
|
|
corsCfg enableConsole enableTelemetry instanceId enabledAPIs lqOpts
|
|
|
|
-- log inconsistent schema objects
|
|
inconsObjs <- scInconsistentObjs <$> getSCFromRef cacheRef
|
|
logInconsObjs logger inconsObjs
|
|
|
|
-- start a background thread for schema sync
|
|
startSchemaSync sqlGenCtx pool logger httpManager
|
|
cacheRef instanceId cacheInitTime
|
|
|
|
let warpSettings = Warp.setPort port $ Warp.setHost host Warp.defaultSettings
|
|
|
|
maxEvThrds <- getFromEnv defaultMaxEventThreads "HASURA_GRAPHQL_EVENTS_HTTP_POOL_SIZE"
|
|
evFetchMilliSec <- getFromEnv defaultFetchIntervalMilliSec "HASURA_GRAPHQL_EVENTS_FETCH_INTERVAL"
|
|
logEnvHeaders <- getFromEnv False "LOG_HEADERS_FROM_ENV"
|
|
|
|
-- prepare event triggers data
|
|
prepareEvents pool logger
|
|
eventEngineCtx <- atomically $ initEventEngineCtx maxEvThrds evFetchMilliSec
|
|
let scRef = _scrCache cacheRef
|
|
unLogger logger $
|
|
mkGenericStrLog "event_triggers" "starting workers"
|
|
void $ C.forkIO $ processEventQueue hloggerCtx logEnvHeaders
|
|
httpManager pool scRef eventEngineCtx
|
|
|
|
-- start a background thread to check for updates
|
|
void $ C.forkIO $ checkForUpdates loggerCtx httpManager
|
|
|
|
-- start a background thread for telemetry
|
|
when enableTelemetry $ do
|
|
unLogger logger $ mkGenericStrLog "telemetry" telemetryNotice
|
|
void $ C.forkIO $ runTelemetry logger httpManager scRef initRes
|
|
|
|
finishTime <- Clock.getCurrentTime
|
|
let apiInitTime = realToFrac $ Clock.diffUTCTime finishTime initTime
|
|
unLogger logger $
|
|
mkGenericStrLog "server" $
|
|
"starting API server, took " <> show @Double apiInitTime <> "s"
|
|
Warp.runSettings warpSettings app
|
|
|
|
HCExport -> do
|
|
ci <- procConnInfo rci
|
|
res <- runTx' pgLogger ci fetchMetadata
|
|
either printErrJExit printJSON res
|
|
|
|
HCClean -> do
|
|
ci <- procConnInfo rci
|
|
res <- runTx' pgLogger ci cleanCatalog
|
|
either printErrJExit (const cleanSuccess) res
|
|
|
|
HCExecute -> do
|
|
queryBs <- BL.getContents
|
|
ci <- procConnInfo rci
|
|
let sqlGenCtx = SQLGenCtx False
|
|
pool <- getMinimalPool pgLogger ci
|
|
res <- runAsAdmin pool sqlGenCtx httpManager $ execQuery queryBs
|
|
either printErrJExit BLC.putStrLn res
|
|
|
|
HCVersion -> putStrLn $ "Hasura GraphQL Engine: " ++ T.unpack currentVersion
|
|
where
|
|
|
|
runTx pool tx =
|
|
runExceptT $ Q.runTx pool (Q.Serializable, Nothing) tx
|
|
|
|
runTx' pgLogger ci tx = do
|
|
pool <- getMinimalPool pgLogger ci
|
|
runExceptT $ Q.runTx pool (Q.Serializable, Nothing) tx
|
|
|
|
runAsAdmin pool sqlGenCtx httpManager m = do
|
|
res <- runExceptT $ peelRun emptySchemaCache adminUserInfo
|
|
httpManager sqlGenCtx (PGExecCtx pool Q.Serializable) m
|
|
return $ fmap fst res
|
|
|
|
procConnInfo rci =
|
|
either (printErrExit . connInfoErrModifier) return $
|
|
mkConnInfo rci
|
|
|
|
getMinimalPool pgLogger ci = do
|
|
let connParams = Q.defaultConnParams { Q.cpConns = 1 }
|
|
Q.initPGPool ci connParams pgLogger
|
|
|
|
initialise pool sqlGenCtx (Logger logger) httpMgr = do
|
|
currentTime <- getCurrentTime
|
|
-- initialise the catalog
|
|
initRes <- runAsAdmin pool sqlGenCtx httpMgr $
|
|
initCatalogSafe currentTime
|
|
either printErrJExit (logger . mkGenericStrLog "db_init") initRes
|
|
|
|
-- migrate catalog if necessary
|
|
migRes <- runAsAdmin pool sqlGenCtx httpMgr $
|
|
migrateCatalog currentTime
|
|
either printErrJExit (logger . mkGenericStrLog "db_migrate") migRes
|
|
|
|
-- generate and retrieve uuids
|
|
getUniqIds pool
|
|
|
|
prepareEvents pool (Logger logger) = do
|
|
logger $ mkGenericStrLog "event_triggers" "preparing data"
|
|
res <- runTx pool unlockAllEvents
|
|
either printErrJExit return res
|
|
|
|
getUniqIds pool = do
|
|
eDbId <- runTx pool getDbId
|
|
dbId <- either printErrJExit return eDbId
|
|
fp <- liftIO generateFingerprint
|
|
return (dbId, fp)
|
|
|
|
getFromEnv :: (Read a) => a -> String -> IO a
|
|
getFromEnv defaults env = do
|
|
mEnv <- lookupEnv env
|
|
let mRes = case mEnv of
|
|
Nothing -> Just defaults
|
|
Just val -> readMaybe val
|
|
eRes = maybe (Left $ "Wrong expected type for environment variable: " <> env) Right mRes
|
|
either printErrExit return eRes
|
|
|
|
cleanSuccess =
|
|
putStrLn "successfully cleaned graphql-engine related data"
|
|
|
|
|
|
telemetryNotice :: String
|
|
telemetryNotice =
|
|
"Help us improve Hasura! The graphql-engine server collects anonymized "
|
|
<> "usage stats which allows us to keep improving Hasura at warp speed. "
|
|
<> "To read more or opt-out, visit https://docs.hasura.io/1.0/graphql/manual/guides/telemetry.html"
|