From 93a3951d875a120ab917e1ceb669c04bc2012e87 Mon Sep 17 00:00:00 2001 From: rakeshkky Date: Fri, 21 Dec 2018 15:44:21 +0530 Subject: [PATCH] improve startup logging, close #1236 --- server/src-exec/Main.hs | 68 ++++++++++++++----------- server/src-exec/Ops.hs | 14 ++--- server/src-lib/Hasura/Events/Lib.hs | 1 - server/src-lib/Hasura/Server/App.hs | 2 - server/src-lib/Hasura/Server/Auth.hs | 6 ++- server/src-lib/Hasura/Server/Init.hs | 32 ++++++++++++ server/src-lib/Hasura/Server/Logging.hs | 43 ++++++++-------- 7 files changed, 103 insertions(+), 63 deletions(-) diff --git a/server/src-exec/Main.hs b/server/src-exec/Main.hs index afd450c222085..425f943bf8eb8 100644 --- a/server/src-exec/Main.hs +++ b/server/src-exec/Main.hs @@ -20,7 +20,8 @@ import qualified Network.HTTP.Client.TLS as HTTP import qualified Network.Wai.Handler.Warp as Warp import Hasura.Events.Lib -import Hasura.Logging (defaultLoggerSettings, mkLoggerCtx) +import Hasura.Logging (Logger (..), defaultLoggerSettings, + mkLogger, mkLoggerCtx) import Hasura.Prelude import Hasura.RQL.DDL.Metadata (fetchMetadata) import Hasura.RQL.Types (QErr, adminUserInfo, @@ -91,43 +92,36 @@ printJSON = BLC.putStrLn . A.encode printYaml :: (A.ToJSON a) => a -> IO () printYaml = BC.putStrLn . Y.encode -procConnInfo :: RawConnInfo -> IO Q.ConnInfo -procConnInfo rci = do - ci <- either (printErrExit . connInfoErrModifier) - return $ mkConnInfo rci - printConnInfo ci - return ci - where - printConnInfo ci = - putStrLn $ - "Postgres connection info:" - ++ "\n Host: " ++ Q.connHost ci - ++ "\n Port: " ++ show (Q.connPort ci) - ++ "\n User: " ++ Q.connUser ci - ++ "\n Database: " ++ Q.connDatabase ci - main :: IO () main = do (HGEOptionsG rci hgeCmd) <- parseArgs -- global http manager httpManager <- HTTP.newManager HTTP.tlsManagerSettings + loggerCtx <- mkLoggerCtx $ defaultLoggerSettings True + let logger = mkLogger loggerCtx case hgeCmd of - HCServe (ServeOptions port cp isoL mRootDir mAccessKey mAuthHook mJwtSecret + HCServe so@(ServeOptions port cp isoL mRootDir mAccessKey mAuthHook mJwtSecret mUnAuthRole corsCfg enableConsole) -> do - loggerCtx <- mkLoggerCtx $ defaultLoggerSettings True + -- log serve options + unLogger logger $ serveOptsToLog so hloggerCtx <- mkLoggerCtx $ defaultLoggerSettings False authModeRes <- runExceptT $ mkAuthMode mAccessKey mAuthHook mJwtSecret mUnAuthRole httpManager loggerCtx am <- either (printErrExit . T.unpack) return authModeRes + ci <- procConnInfo rci - initialise ci httpManager + -- log postgres connection info + unLogger logger $ connInfoToLog ci + -- safe init catalog + initialise logger ci httpManager -- migrate catalog if necessary - migrate ci httpManager - prepareEvents ci + migrate logger ci httpManager + -- prepare event triggers data + prepareEvents logger ci + pool <- Q.initPGPool ci cp - putStrLn $ "server: running on port " ++ show port (app, cacheRef) <- mkWaiApp isoL mRootDir loggerCtx pool httpManager am corsCfg enableConsole let warpSettings = Warp.setPort port Warp.defaultSettings @@ -143,23 +137,30 @@ main = do eventEngineCtx <- atomically $ initEventEngineCtx maxEvThrds evFetchMilliSec httpSession <- WrqS.newSessionControl Nothing TLS.tlsManagerSettings + unLogger logger $ + mkGenericStrLog "event_triggers" "starting workers" void $ C.forkIO $ processEventQueue hloggerCtx logEnvHeaders httpSession pool cacheRef eventEngineCtx + unLogger logger $ + mkGenericStrLog "server" "starting API server" Warp.runSettings warpSettings app HCExport -> do ci <- procConnInfo rci res <- runTx ci fetchMetadata either printErrJExit printJSON res + HCClean -> do ci <- procConnInfo rci res <- runTx ci cleanCatalog either printErrJExit (const cleanSuccess) res + HCExecute -> do queryBs <- BL.getContents ci <- procConnInfo rci res <- runAsAdmin ci httpManager $ execQuery queryBs either printErrJExit BLC.putStrLn res + HCVersion -> putStrLn $ "Hasura GraphQL Engine: " ++ T.unpack currentVersion where runTx :: Q.ConnInfo -> Q.TxE QErr a -> IO (Either QErr a) @@ -172,19 +173,27 @@ main = do res <- runExceptT $ peelRun emptySchemaCache adminUserInfo httpManager pool Q.Serializable m return $ fmap fst res + + procConnInfo rci = + either (printErrExit . connInfoErrModifier) return $ + mkConnInfo rci + getMinimalPool ci = do let connParams = Q.defaultConnParams { Q.cpConns = 1 } Q.initPGPool ci connParams - initialise ci httpMgr = do + + initialise (Logger logger) ci httpMgr = do currentTime <- getCurrentTime res <- runAsAdmin ci httpMgr $ initCatalogSafe currentTime - either printErrJExit putStrLn res - migrate ci httpMgr = do + either printErrJExit (logger . mkGenericStrLog "db_init") res + + migrate (Logger logger) ci httpMgr = do currentTime <- getCurrentTime res <- runAsAdmin ci httpMgr $ migrateCatalog currentTime - either printErrJExit putStrLn res - prepareEvents ci = do - putStrLn "event_triggers: preparing data" + either printErrJExit (logger . mkGenericStrLog "db_migrate") res + + prepareEvents (Logger logger) ci = do + logger $ mkGenericStrLog "event_triggers" "preparing data" res <- runTx ci unlockAllEvents either printErrJExit return res @@ -197,4 +206,5 @@ main = do eRes = maybe (Left $ "Wrong expected type for environment variable: " <> env) Right mRes either printErrExit return eRes - cleanSuccess = putStrLn "successfully cleaned graphql-engine related data" + cleanSuccess = + putStrLn "successfully cleaned graphql-engine related data" diff --git a/server/src-exec/Ops.hs b/server/src-exec/Ops.hs index 34b72d42db84c..c22c811f886f0 100644 --- a/server/src-exec/Ops.hs +++ b/server/src-exec/Ops.hs @@ -6,7 +6,7 @@ module Ops ) where import Data.Time.Clock (UTCTime) -import Language.Haskell.TH.Syntax (Q, TExp, unTypeQ) +import Language.Haskell.TH.Syntax (Q, TExp, unTypeQ) import Hasura.Prelude import Hasura.RQL.DDL.Schema.Table @@ -18,7 +18,7 @@ import Hasura.SQL.Types import qualified Data.Aeson as A import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T -import qualified Data.Yaml.TH as Y +import qualified Data.Yaml.TH as Y import qualified Database.PG.Query as Q import qualified Database.PG.Query.Connection as Q @@ -40,7 +40,7 @@ initCatalogSafe initTime = do (SchemaName "hdb_catalog") (TableName "hdb_version") bool (initCatalogStrict False initTime) (return initialisedMsg) versionExists - initialisedMsg = "initialise: the state is already initialised" + initialisedMsg = "the state is already initialised" doesVersionTblExist sn tblN = (runIdentity . Q.getRow) <$> Q.withQ [Q.sql| @@ -86,7 +86,7 @@ initCatalogStrict createSchema initTime = do void $ runQueryM metadataQuery setAllAsSystemDefined >> addVersion initTime - return "initialise: successfully initialised" + return "successfully initialised" where metadataQuery = @@ -240,7 +240,7 @@ migrateCatalog migrateCatalog migrationTime = do preVer <- getCatalogVersion if | preVer == curCatalogVer -> - return "migrate: already at the latest version" + return "already at the latest version" | preVer == "0.8" -> from08ToCurrent | preVer == "1" -> from1ToCurrent | preVer == "2" -> from2ToCurrent @@ -248,7 +248,7 @@ migrateCatalog migrationTime = do | preVer == "4" -> from4ToCurrent | preVer == "5" -> from5ToCurrent | otherwise -> throw400 NotSupported $ - "migrate: unsupported version : " <> preVer + "unsupported version : " <> preVer where from5ToCurrent = do from5To6 @@ -281,7 +281,7 @@ migrateCatalog migrationTime = do liftTx $ Q.catchE defaultTxErrorHandler clearHdbViews -- try building the schema cache void buildSchemaCache - return $ "migrate: successfully migrated to " ++ show curCatalogVer + return $ "successfully migrated to " ++ show curCatalogVer updateVersion = liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql| diff --git a/server/src-lib/Hasura/Events/Lib.hs b/server/src-lib/Hasura/Events/Lib.hs index 61064fb2b0421..d546a611a335f 100644 --- a/server/src-lib/Hasura/Events/Lib.hs +++ b/server/src-lib/Hasura/Events/Lib.hs @@ -146,7 +146,6 @@ initEventEngineCtx maxT fetchI = do processEventQueue :: L.LoggerCtx -> LogEnvHeaders -> WS.Session -> Q.PGPool -> CacheRef -> EventEngineCtx -> IO () processEventQueue logctx logenv httpSess pool cacheRef eectx = do - putStrLn "event_trigger: starting workers" threads <- mapM async [fetchThread , consumeThread] void $ waitAny threads where diff --git a/server/src-lib/Hasura/Server/App.hs b/server/src-lib/Hasura/Server/App.hs index 23dde4eed3dde..83b45f1cab192 100644 --- a/server/src-lib/Hasura/Server/App.hs +++ b/server/src-lib/Hasura/Server/App.hs @@ -301,8 +301,6 @@ mkWaiApp isoLevel mRootDir loggerCtx pool httpManager mode corsCfg enableConsole httpApp :: Maybe String -> CorsConfig -> ServerCtx -> Bool -> SpockT IO () httpApp mRootDir corsCfg serverCtx enableConsole = do - liftIO $ putStrLn "HasuraDB is now waiting for connections" - -- cors middleware unless (ccDisabled corsCfg) $ middleware $ corsMiddleware (mkDefaultCorsPolicy $ ccDomain corsCfg) diff --git a/server/src-lib/Hasura/Server/Auth.hs b/server/src-lib/Hasura/Server/Auth.hs index cb027507937a7..05b186bb21d7c 100644 --- a/server/src-lib/Hasura/Server/Auth.hs +++ b/server/src-lib/Hasura/Server/Auth.hs @@ -52,7 +52,11 @@ newtype AccessKey data AuthHookType = AHTGet | AHTPost - deriving (Show, Eq) + deriving (Eq) + +instance Show AuthHookType where + show AHTGet = "GET" + show AHTPost = "POST" data AuthHookG a b = AuthHookG diff --git a/server/src-lib/Hasura/Server/Init.hs b/server/src-lib/Hasura/Server/Init.hs index a1f213e9bd257..925d311137060 100644 --- a/server/src-lib/Hasura/Server/Init.hs +++ b/server/src-lib/Hasura/Server/Init.hs @@ -5,13 +5,16 @@ import qualified Database.PG.Query as Q import Options.Applicative import System.Exit (exitFailure) +import qualified Data.Aeson as J import qualified Data.Text as T +import qualified Hasura.Logging as L import qualified Text.PrettyPrint.ANSI.Leijen as PP import Hasura.Prelude import Hasura.RQL.DDL.Utils import Hasura.RQL.Types (RoleName (..)) import Hasura.Server.Auth +import Hasura.Server.Logging import Hasura.Server.Utils initErrExit :: (Show e) => e -> IO a @@ -582,3 +585,32 @@ parseEnableConsole = switch ( long "enable-console" <> help (snd enableConsoleEnv) ) + +-- Init logging related +connInfoToLog :: Q.ConnInfo -> StartupLog +connInfoToLog (Q.ConnInfo host port user _ db _) = + StartupLog L.LevelInfo "postgres_connection" infoVal + where + infoVal = J.object [ "host" J..= host + , "port" J..= port + , "user" J..= user + , "database" J..= db + ] + +serveOptsToLog :: ServeOptions -> StartupLog +serveOptsToLog so = + StartupLog L.LevelInfo "serve_options" infoVal + where + infoVal = J.object [ "port" J..= soPort so + , "accesskey_set" J..= isJust (soAccessKey so) + , "auth_hook" J..= (ahUrl <$> soAuthHook so) + , "auth_hook_mode" J..= (show . ahType <$> soAuthHook so) + , "unauth_role" J..= soUnAuthRole so + , "cors_domain" J..= (ccDomain . soCorsConfig) so + , "cors_disabled" J..= (ccDisabled . soCorsConfig) so + , "enable_console" J..= soEnableConsole so + ] + +mkGenericStrLog :: T.Text -> String -> StartupLog +mkGenericStrLog k msg = + StartupLog L.LevelInfo k $ J.toJSON msg diff --git a/server/src-lib/Hasura/Server/Logging.hs b/server/src-lib/Hasura/Server/Logging.hs index af1e90c55ec34..9e23b3b6abfdf 100644 --- a/server/src-lib/Hasura/Server/Logging.hs +++ b/server/src-lib/Hasura/Server/Logging.hs @@ -1,7 +1,8 @@ -- This is taken from wai-logger and customised for our use module Hasura.Server.Logging - ( mkAccessLog + ( StartupLog(..) + , mkAccessLog , getRequestHeader , WebHookLog(..) , WebHookLogger @@ -29,12 +30,29 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.CaseInsensitive as CI import qualified Network.HTTP.Types as N +import Hasura.HTTP import qualified Hasura.Logging as L import Hasura.Prelude import Hasura.RQL.Types.Error import Hasura.RQL.Types.Permission import Hasura.Server.Utils -import Hasura.HTTP + +data StartupLog + = StartupLog + { slLogLevel :: !L.LogLevel + , slKind :: !T.Text + , slInfo :: !Value + } deriving (Show, Eq) + +instance ToJSON StartupLog where + toJSON (StartupLog _ k info) = + object [ "kind" .= k + , "info" .= info + ] + +instance L.ToEngineLog StartupLog where + toEngineLog startupLog = + (slLogLevel startupLog, "startup", toJSON startupLog) data WebHookLog = WebHookLog @@ -107,27 +125,6 @@ instance ToJSON LogDetail where , "error" .= e ] --- type ServerLogger = Request -> BL.ByteString -> Either QErr BL.ByteString -> IO () --- type ServerLogger r = Request -> r -> Maybe (UTCTime, UTCTime) -> IO () - --- type LogDetailG r = Request -> r -> (N.Status, Maybe Value, Maybe T.Text, Maybe Int64) - --- withStdoutLogger :: LogDetailG r -> (ServerLogger r -> IO a) -> IO a --- withStdoutLogger detailF appf = --- bracket setup teardown $ \(rlogger, _) -> appf rlogger --- where --- setup = do --- getter <- newTimeCache "%FT%T%z" --- lgrset <- newStdoutLoggerSet defaultBufSize --- let logger req env timeT = do --- zdata <- getter --- let serverLog = mkAccessLog detailF zdata req env timeT --- pushLogStrLn lgrset $ toLogStr $ encode serverLog --- when (isJust $ slDetail serverLog) $ flushLogStr lgrset --- remover = rmLoggerSet lgrset --- return (logger, remover) --- teardown (_, remover) = void remover - ravenLogGen :: (BL.ByteString, Either QErr BL.ByteString) -> (N.Status, Maybe Value, Maybe T.Text, Maybe Int64)