2019-11-26 15:14:21 +03:00
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
2018-06-27 16:11:32 +03:00
|
|
|
|
2019-11-26 15:14:21 +03:00
|
|
|
module Main where
|
2019-03-12 08:46:27 +03:00
|
|
|
|
2020-07-14 22:00:58 +03:00
|
|
|
import Control.Exception
|
2020-12-28 15:56:00 +03:00
|
|
|
import Control.Monad.Trans.Managed (ManagedT (..), lowerManagedT)
|
|
|
|
import Data.Int (Int64)
|
|
|
|
import Data.Text.Conversions (convertText)
|
|
|
|
import Data.Time.Clock (getCurrentTime)
|
|
|
|
import Data.Time.Clock.POSIX (getPOSIXTime)
|
2020-01-23 00:55:55 +03:00
|
|
|
|
2019-11-26 15:14:21 +03:00
|
|
|
import Hasura.App
|
2020-12-28 15:56:00 +03:00
|
|
|
import Hasura.Logging (Hasura, LogLevel (..),
|
|
|
|
defaultEnabledEngineLogTypes)
|
2020-12-14 07:30:19 +03:00
|
|
|
import Hasura.Metadata.Class
|
2018-06-27 16:11:32 +03:00
|
|
|
import Hasura.Prelude
|
2019-11-20 21:21:30 +03:00
|
|
|
import Hasura.RQL.DDL.Schema
|
2020-12-28 15:56:00 +03:00
|
|
|
import Hasura.RQL.DDL.Schema.Cache.Common
|
|
|
|
import Hasura.RQL.DDL.Schema.Source
|
2019-10-21 19:01:05 +03:00
|
|
|
import Hasura.RQL.Types
|
2018-06-27 16:11:32 +03:00
|
|
|
import Hasura.Server.Init
|
2021-01-07 12:04:22 +03:00
|
|
|
import Hasura.Server.Migrate (downgradeCatalog)
|
2019-11-26 15:14:21 +03:00
|
|
|
import Hasura.Server.Version
|
2018-06-27 16:11:32 +03:00
|
|
|
|
2020-12-28 15:56:00 +03:00
|
|
|
import qualified Control.Concurrent.Extended as C
|
|
|
|
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.Environment as Env
|
|
|
|
import qualified Database.PG.Query as Q
|
|
|
|
import qualified Hasura.GC as GC
|
|
|
|
import qualified Hasura.Tracing as Tracing
|
|
|
|
import qualified System.Exit as Sys
|
|
|
|
import qualified System.Metrics as EKG
|
|
|
|
import qualified System.Posix.Signals as Signals
|
2020-08-18 22:53:12 +03:00
|
|
|
|
2019-03-12 08:46:27 +03:00
|
|
|
|
2018-06-27 16:11:32 +03:00
|
|
|
main :: IO ()
|
2020-07-14 22:00:58 +03:00
|
|
|
main = do
|
|
|
|
tryExit $ do
|
|
|
|
args <- parseArgs
|
|
|
|
env <- Env.getEnvironment
|
2020-11-25 13:56:44 +03:00
|
|
|
runApp env args
|
2020-07-14 22:00:58 +03:00
|
|
|
where
|
|
|
|
tryExit io = try io >>= \case
|
|
|
|
Left (ExitException _code msg) -> BC.putStrLn msg >> Sys.exitFailure
|
2021-01-28 14:39:17 +03:00
|
|
|
Right r -> return r
|
2018-07-27 12:34:50 +03:00
|
|
|
|
2020-11-25 13:56:44 +03:00
|
|
|
runApp :: Env.Environment -> HGEOptions Hasura -> IO ()
|
2020-12-28 15:56:00 +03:00
|
|
|
runApp env (HGEOptionsG rci metadataDbUrl hgeCmd) = do
|
2020-11-24 09:10:04 +03:00
|
|
|
initTime <- liftIO getCurrentTime
|
2020-12-28 15:56:00 +03:00
|
|
|
globalCtx@GlobalCtx{..} <- initGlobalCtx env metadataDbUrl rci
|
2021-01-07 12:04:22 +03:00
|
|
|
let (maybeDefaultPgConnInfo, maybeRetries) = _gcDefaultPostgresConnInfo
|
2020-11-24 09:10:04 +03:00
|
|
|
|
2020-07-14 22:00:58 +03:00
|
|
|
withVersion $$(getVersionFromEnvironment) $ case hgeCmd of
|
2019-11-26 15:14:21 +03:00
|
|
|
HCServe serveOptions -> do
|
2020-09-08 19:19:52 +03:00
|
|
|
ekgStore <- liftIO do
|
|
|
|
s <- EKG.newStore
|
|
|
|
EKG.registerGcMetrics s
|
2020-11-12 12:25:48 +03:00
|
|
|
|
2020-09-08 21:13:35 +03:00
|
|
|
let getTimeMs :: IO Int64
|
|
|
|
getTimeMs = (round . (* 1000)) `fmap` getPOSIXTime
|
|
|
|
|
|
|
|
EKG.registerCounter "ekg.server_timestamp_ms" getTimeMs s
|
2020-09-08 19:19:52 +03:00
|
|
|
pure s
|
2020-11-12 12:25:48 +03:00
|
|
|
|
2020-12-21 21:56:00 +03:00
|
|
|
-- It'd be nice if we didn't have to call runManagedT twice here, but
|
|
|
|
-- there is a data dependency problem since the call to runPGMetadataStorageApp
|
|
|
|
-- below depends on serveCtx.
|
|
|
|
runManagedT (initialiseServeCtx env globalCtx serveOptions) $ \serveCtx -> do
|
|
|
|
-- Catches the SIGTERM signal and initiates a graceful shutdown.
|
|
|
|
-- Graceful shutdown for regular HTTP requests is already implemented in
|
|
|
|
-- Warp, and is triggered by invoking the 'closeSocket' callback.
|
|
|
|
-- We only catch the SIGTERM signal once, that is, if the user hits CTRL-C
|
|
|
|
-- once again, we terminate the process immediately.
|
|
|
|
_ <- liftIO $ Signals.installHandler
|
|
|
|
Signals.sigTERM
|
|
|
|
(Signals.CatchOnce (shutdownGracefully $ _scShutdownLatch serveCtx))
|
|
|
|
Nothing
|
2020-12-28 15:56:00 +03:00
|
|
|
|
|
|
|
let Loggers _ logger pgLogger = _scLoggers serveCtx
|
2020-12-21 21:56:00 +03:00
|
|
|
_idleGCThread <- C.forkImmortal "ourIdleGC" logger $
|
|
|
|
GC.ourIdleGC logger (seconds 0.3) (seconds 10) (seconds 60)
|
2020-12-28 15:56:00 +03:00
|
|
|
|
2020-12-21 21:56:00 +03:00
|
|
|
serverMetrics <- liftIO $ createServerMetrics ekgStore
|
2020-12-28 15:56:00 +03:00
|
|
|
flip runPGMetadataStorageApp (_scMetadataDbPool serveCtx, pgLogger) . lowerManagedT $ do
|
|
|
|
runHGEServer env serveOptions serveCtx initTime Nothing serverMetrics ekgStore
|
2020-07-14 22:00:58 +03:00
|
|
|
|
2018-12-19 14:38:33 +03:00
|
|
|
HCExport -> do
|
2021-01-07 12:04:22 +03:00
|
|
|
res <- runTxWithMinimalPool _gcMetadataDbConnInfo fetchMetadataFromCatalog
|
2020-07-14 22:00:58 +03:00
|
|
|
either (printErrJExit MetadataExportError) printJSON res
|
2019-01-02 14:24:17 +03:00
|
|
|
|
2018-12-19 14:38:33 +03:00
|
|
|
HCClean -> do
|
2021-01-07 12:04:22 +03:00
|
|
|
res <- runTxWithMinimalPool _gcMetadataDbConnInfo dropHdbCatalogSchema
|
2020-11-24 09:10:04 +03:00
|
|
|
let cleanSuccessMsg = "successfully cleaned graphql-engine related data"
|
|
|
|
either (printErrJExit MetadataCleanError) (const $ liftIO $ putStrLn cleanSuccessMsg) res
|
2019-01-02 14:24:17 +03:00
|
|
|
|
2018-12-19 14:38:33 +03:00
|
|
|
HCExecute -> do
|
2019-11-26 15:14:21 +03:00
|
|
|
queryBs <- liftIO BL.getContents
|
2019-04-17 19:29:39 +03:00
|
|
|
let sqlGenCtx = SQLGenCtx False
|
2020-12-28 15:56:00 +03:00
|
|
|
remoteSchemaPermsCtx = RemoteSchemaPermsDisabled
|
|
|
|
pgLogger = print
|
|
|
|
pgSourceResolver = mkPgSourceResolver pgLogger
|
2021-01-29 08:48:17 +03:00
|
|
|
functionPermsCtx = FunctionPermissionsInferred
|
|
|
|
serverConfigCtx = ServerConfigCtx functionPermsCtx remoteSchemaPermsCtx sqlGenCtx
|
|
|
|
cacheBuildParams = CacheBuildParams _gcHttpManager pgSourceResolver serverConfigCtx
|
2020-12-28 15:56:00 +03:00
|
|
|
runManagedT (mkMinimalPool _gcMetadataDbConnInfo) $ \metadataDbPool -> do
|
|
|
|
res <- flip runPGMetadataStorageApp (metadataDbPool, pgLogger) $
|
|
|
|
runMetadataStorageT $ liftEitherM do
|
|
|
|
metadata <- fetchMetadata
|
2021-01-29 08:48:17 +03:00
|
|
|
runAsAdmin sqlGenCtx _gcHttpManager remoteSchemaPermsCtx functionPermsCtx $ do
|
2020-12-28 15:56:00 +03:00
|
|
|
schemaCache <- runCacheBuild cacheBuildParams $
|
|
|
|
buildRebuildableSchemaCache env metadata
|
2020-12-21 21:56:00 +03:00
|
|
|
execQuery env queryBs
|
|
|
|
& Tracing.runTraceTWithReporter Tracing.noReporter "execute"
|
|
|
|
& runMetadataT metadata
|
|
|
|
& runCacheRWT schemaCache
|
|
|
|
& fmap (\((res, _), _, _) -> res)
|
|
|
|
either (printErrJExit ExecuteProcessError) (liftIO . BLC.putStrLn) res
|
2019-01-28 16:55:28 +03:00
|
|
|
|
2020-02-07 14:03:12 +03:00
|
|
|
HCDowngrade opts -> do
|
2021-01-07 12:04:22 +03:00
|
|
|
let defaultSourceConfig = maybeDefaultPgConnInfo <&> \(dbUrlConf, _) ->
|
|
|
|
let pgSourceConnInfo = PostgresSourceConnInfo dbUrlConf
|
|
|
|
defaultPostgresPoolSettings{_ppsRetries = fromMaybe 1 maybeRetries}
|
|
|
|
in SourceConfiguration pgSourceConnInfo Nothing
|
2020-12-28 15:56:00 +03:00
|
|
|
res <- runTxWithMinimalPool _gcMetadataDbConnInfo $ downgradeCatalog defaultSourceConfig opts initTime
|
2020-07-14 22:00:58 +03:00
|
|
|
either (printErrJExit DowngradeProcessError) (liftIO . print) res
|
2020-02-07 14:03:12 +03:00
|
|
|
|
2020-01-23 00:55:55 +03:00
|
|
|
HCVersion -> liftIO $ putStrLn $ "Hasura GraphQL Engine: " ++ convertText currentVersion
|
2019-11-26 15:14:21 +03:00
|
|
|
where
|
2020-12-21 21:56:00 +03:00
|
|
|
runTxWithMinimalPool connInfo tx = lowerManagedT $ do
|
2020-11-24 09:10:04 +03:00
|
|
|
minimalPool <- mkMinimalPool connInfo
|
|
|
|
liftIO $ runExceptT $ Q.runTx minimalPool (Q.ReadCommitted, Nothing) tx
|
|
|
|
|
|
|
|
-- | Generate Postgres pool with single connection.
|
|
|
|
-- It is useful when graphql-engine executes a transaction on database
|
|
|
|
-- and exits in commands other than 'serve'.
|
|
|
|
mkMinimalPool connInfo = do
|
|
|
|
pgLogger <- _lsPgLogger <$> mkLoggers defaultEnabledEngineLogTypes LevelInfo
|
|
|
|
let connParams = Q.defaultConnParams { Q.cpConns = 1 }
|
|
|
|
liftIO $ Q.initPGPool connInfo connParams pgLogger
|