hasura · rakeshkky · Aug 1, 2018 · Jan 2, 2019 · Jan 2, 2019 · 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

@@ -169,11 +169,9 @@ isValidField = \case
     isRelEligible rn rt = isValidName (G.Name $ getRelTxt rn)
                           && isValidTableName rt
 
-upsertable :: [TableConstraint] -> Bool -> Bool -> Bool
-upsertable constraints isUpsertAllowed view =
+upsertable :: [ConstraintName] -> Bool -> Bool -> Bool
+upsertable uniqueOrPrimaryCons isUpsertAllowed view =
   not (null uniqueOrPrimaryCons) && isUpsertAllowed && not view
-  where
-    uniqueOrPrimaryCons = filter isUniqueOrPrimary constraints
 
 toValidFieldInfos :: FieldInfoMap -> [FieldInfo]
 toValidFieldInfos = filter isValidField . Map.elems
@@ -187,11 +185,9 @@ getValidCols = fst . validPartitionFieldInfoMap
 getValidRels :: FieldInfoMap -> [RelInfo]
 getValidRels = snd . validPartitionFieldInfoMap
 
-mkValidConstraints :: [TableConstraint] -> [TableConstraint]
-mkValidConstraints = filter isValid
-  where
-    isValid (TableConstraint _ n) =
-      isValidName $ G.Name $ getConstraintTxt n
+mkValidConstraints :: [ConstraintName] -> [ConstraintName]
+mkValidConstraints =
+  filter (isValidName . G.Name . getConstraintTxt)
 
 isRelNullable :: FieldInfoMap -> RelInfo -> Bool
 isRelNullable fim ri = isNullable
@@ -1056,11 +1052,11 @@ mkInsMutFld tn isUpsertable =
     onConflictArg =
       InpValInfo (Just onConflictDesc) "on_conflict" $ G.toGT $ mkOnConflictInpTy tn
 
-mkConstriantTy :: QualifiedTable -> [TableConstraint] -> EnumTyInfo
+mkConstriantTy :: QualifiedTable -> [ConstraintName] -> EnumTyInfo
 mkConstriantTy tn cons = enumTyInfo
   where
     enumTyInfo = mkHsraEnumTyInfo (Just desc) (mkConstraintInpTy tn) $
-                 mapFromL _eviVal $ map (mkConstraintEnumVal . tcName ) cons
+                 mapFromL _eviVal $ map mkConstraintEnumVal cons
 
     desc = G.Description $
       "unique or primary key constraints on table " <>> tn
@@ -1258,16 +1254,15 @@ mkOrdByInpObj tn selFlds = (inpObjTy, ordByCtx)
 --   mappend  = (<>)
 
 mkOnConflictTypes
-  :: QualifiedTable -> [TableConstraint] -> [PGCol] -> Bool -> [TypeInfo]
-mkOnConflictTypes tn c cols =
+  :: QualifiedTable -> [ConstraintName] -> [PGCol] -> Bool -> [TypeInfo]
+mkOnConflictTypes tn uniqueOrPrimaryCons cols =
   bool [] tyInfos
   where
     tyInfos = [ TIEnum $ mkConflictActionTy isUpdAllowed
-              , TIEnum $ mkConstriantTy tn constraints
+              , TIEnum $ mkConstriantTy tn uniqueOrPrimaryCons
               , TIEnum $ mkUpdColumnTy tn cols
               , TIInpObj $ mkOnConflictInp tn
               ]
-    constraints = filter isUniqueOrPrimary c
     isUpdAllowed = not $ null cols
 
 mkGCtxRole'
@@ -1283,7 +1278,7 @@ mkGCtxRole'
   -- primary key columns
   -> [PGColInfo]
   -- constraints
-  -> [TableConstraint]
+  -> [ConstraintName]
   -> Maybe ViewInfo
   -> TyAgg
 mkGCtxRole' tn insPermM selPermM updColsM delPermM pkeyCols constraints viM =
@@ -1433,7 +1428,7 @@ mkGCtxRole' tn insPermM selPermM updColsM delPermM pkeyCols constraints viM =
 getRootFldsRole'
   :: QualifiedTable
   -> [PGCol]
-  -> [TableConstraint]
+  -> [ConstraintName]
   -> FieldInfoMap
   -> Maybe ([T.Text], Bool) -- insert perm
   -> Maybe (AnnBoolExpSQL, Maybe Int, [T.Text], Bool) -- select filter
@@ -1576,7 +1571,7 @@ mkGCtxRole
   -> QualifiedTable
   -> FieldInfoMap
   -> [PGCol]
-  -> [TableConstraint]
+  -> [ConstraintName]
   -> Maybe ViewInfo
   -> RoleName
   -> RolePermInfo
@@ -1601,7 +1596,7 @@ mkGCtxRole tableCache tn fields pCols constraints viM role permInfo = do
 getRootFldsRole
   :: QualifiedTable
   -> [PGCol]
-  -> [TableConstraint]
+  -> [ConstraintName]
   -> FieldInfoMap
   -> Maybe ViewInfo
   -> RolePermInfo
@@ -1671,7 +1666,7 @@ checkSchemaConflicts gCtx remoteCtx = do
                     (\k _ -> G.unNamedType k `notElem` builtinTy ++ rmRootNames)
                     $ _gTypes remoteCtx
 
-      isTyInfoSame ty = any (\t -> tyinfoEq t ty) hTypes
+      isTyInfoSame ty = any (`tyinfoEq` ty) hTypes
       -- name is same and structure is not same
       isSame n ty = G.unNamedType n `elem` hTyNames &&
                     not (isTyInfoSame ty)