hasura · 0x777 · Jan 2, 2019 · Dec 21, 2018 · Dec 21, 2018 · Jan 2, 2019
@@ -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,
@@ -90,43 +91,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 mAccessKey mAuthHook mJwtSecret
+    HCServe so@(ServeOptions port cp isoL 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 loggerCtx pool httpManager
                          am corsCfg enableConsole
       let warpSettings = Warp.setPort port Warp.defaultSettings
@@ -142,23 +136,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)
@@ -171,19 +172,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
 
@@ -196,4 +205,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"
@@ -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,15 +240,15 @@ 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
      | preVer == "3"   -> from3ToCurrent
      | 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|

@@ -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

@@ -310,8 +310,6 @@ mkWaiApp isoLevel loggerCtx pool httpManager mode corsCfg enableConsole = do
 
 httpApp :: CorsConfig -> ServerCtx -> Bool -> SpockT IO ()
 httpApp corsCfg serverCtx enableConsole = do
-    liftIO $ putStrLn "HasuraDB is now waiting for connections"
-
     -- cors middleware
     unless (ccDisabled corsCfg) $
       middleware $ corsMiddleware (mkDefaultCorsPolicy $ ccDomain corsCfg)

@@ -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

@@ -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
@@ -565,3 +568,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
@@ -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)