diff --git a/server/src-exec/Main.hs b/server/src-exec/Main.hs index 07a64a2f994bd..6cde6dfe09c66 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, @@ -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" 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/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 8c9dc714939d8..da9dbedfa04bb 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -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) diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs index 56311fd9fb6e2..7c692ec38e11d 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Diff.hs @@ -37,8 +37,9 @@ $(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''PGColMeta) data ConstraintMeta = ConstraintMeta - { cmConstraintName :: !ConstraintName - , cmConstraintOid :: !Int + { cmName :: !ConstraintName + , cmOid :: !Int + , cmType :: !ConstraintType } deriving (Show, Eq) $(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''ConstraintMeta) @@ -84,11 +85,19 @@ fetchTableMeta = do ON (t.table_schema = c.table_schema AND t.table_name = c.table_name) LEFT OUTER JOIN (SELECT - table_schema, - table_name, - json_agg((SELECT r FROM (SELECT constraint_name, constraint_oid) r)) as constraints + tc.table_schema, + tc.table_name, + json_agg( + json_build_object( + 'name', tc.constraint_name, + 'oid', r.oid::integer, + 'type', tc.constraint_type + ) + ) as constraints FROM - hdb_catalog.hdb_foreign_key_constraint + information_schema.table_constraints tc + JOIN pg_catalog.pg_constraint r + ON tc.constraint_name = r.conname GROUP BY table_schema, table_name) f ON (t.table_schema = f.table_schema AND t.table_name = f.table_name) @@ -114,21 +123,29 @@ getDifference getKey left right = data TableDiff = TableDiff - { _tdNewName :: !(Maybe QualifiedTable) - , _tdDroppedCols :: ![PGCol] - , _tdAddedCols :: ![PGColInfo] - , _tdAlteredCols :: ![(PGColInfo, PGColInfo)] - , _tdDroppedCons :: ![ConstraintName] + { _tdNewName :: !(Maybe QualifiedTable) + , _tdDroppedCols :: ![PGCol] + , _tdAddedCols :: ![PGColInfo] + , _tdAlteredCols :: ![(PGColInfo, PGColInfo)] + , _tdDroppedFKeyCons :: ![ConstraintName] + -- The final list of uniq/primary constraint names + -- used for generating types on_conflict clauses + -- TODO: this ideally should't be part of TableDiff + , _tdUniqOrPriCons :: ![ConstraintName] } deriving (Show, Eq) getTableDiff :: TableMeta -> TableMeta -> TableDiff getTableDiff oldtm newtm = - TableDiff mNewName droppedCols addedCols alteredCols droppedConstraints + TableDiff mNewName droppedCols addedCols alteredCols + droppedFKeyConstraints uniqueOrPrimaryCons where mNewName = bool (Just $ tmTable newtm) Nothing $ tmTable oldtm == tmTable newtm oldCols = tmColumns oldtm newCols = tmColumns newtm + uniqueOrPrimaryCons = + [cmName cm | cm <- tmConstraints newtm, isUniqueOrPrimary $ cmType cm] + droppedCols = map pcmColumnName $ getDifference pcmOrdinalPosition oldCols newCols @@ -144,8 +161,8 @@ getTableDiff oldtm newtm = flip map (filter (uncurry (/=)) existingCols) $ \(pcmo, pcmn) -> (pcmToPci pcmo, pcmToPci pcmn) - droppedConstraints = - map cmConstraintName $ getDifference cmConstraintOid + droppedFKeyConstraints = map cmName $ + filter (isForeignKey . cmType) $ getDifference cmOid (tmConstraints oldtm) (tmConstraints newtm) getTableChangeDeps @@ -158,13 +175,13 @@ getTableChangeDeps ti tableDiff = do let objId = SOTableObj tn $ TOCol droppedCol return $ getDependentObjs sc objId -- for all dropped constraints - droppedConsDeps <- fmap concat $ forM droppedConstraints $ \droppedCons -> do + droppedConsDeps <- fmap concat $ forM droppedFKeyConstraints $ \droppedCons -> do let objId = SOTableObj tn $ TOCons droppedCons return $ getDependentObjs sc objId return $ droppedConsDeps <> droppedColDeps where tn = tiName ti - TableDiff _ droppedCols _ _ droppedConstraints = tableDiff + TableDiff _ droppedCols _ _ droppedFKeyConstraints _ = tableDiff data SchemaDiff = SchemaDiff diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index f99269577063f..4c2d27fee8d65 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -135,6 +135,9 @@ processTableChanges ti tableDiff = do when (isJust mNewName) $ throw400 NotSupported $ "table renames are not yet supported : " <>> tn + -- replace constraints + replaceConstraints + -- for all the dropped columns forM_ droppedCols $ \droppedCol -> -- Drop the column from the cache @@ -168,8 +171,10 @@ processTableChanges ti tableDiff = do updateFldInCache cn ci = do delColFromCache cn tn addColToCache cn ci tn + replaceConstraints = flip modTableInCache tn $ \tInfo -> + return $ tInfo {tiUniqOrPrimConstraints = constraints} tn = tiName ti - TableDiff mNewName droppedCols addedCols alteredCols _ = tableDiff + TableDiff mNewName droppedCols addedCols alteredCols _ constraints = tableDiff delTableAndDirectDeps :: (QErrM m, CacheRWM m, MonadTx m) => QualifiedTable -> m () diff --git a/server/src-lib/Hasura/RQL/DML/Insert.hs b/server/src-lib/Hasura/RQL/DML/Insert.hs index cffa2277bed5c..951103535ba2e 100644 --- a/server/src-lib/Hasura/RQL/DML/Insert.hs +++ b/server/src-lib/Hasura/RQL/DML/Insert.hs @@ -145,7 +145,7 @@ buildConflictClause tableInfo inpCols (OnConflict mTCol mTCons act) = \pgCol -> askPGType fieldInfoMap pgCol "" validateConstraint c = do - let tableConsNames = map tcName $ tiConstraints tableInfo + let tableConsNames = tiUniqOrPrimConstraints tableInfo withPathK "constraint" $ unless (c `elem` tableConsNames) $ throw400 Unexpected $ "constraint " <> getConstraintTxt c diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index abb9e4a85bde6..a5b4d08ad1acb 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -16,6 +16,7 @@ module Hasura.RQL.Types.SchemaCache , onlyJSONBCols , onlyComparableCols , isUniqueOrPrimary + , isForeignKey , mkTableInfo , addTableToCache , modTableInCache @@ -259,8 +260,6 @@ data ConstraintType | CTUNIQUE deriving Eq -$(deriveToJSON defaultOptions{constructorTagModifier = drop 2} ''ConstraintType) - constraintTyToTxt :: ConstraintType -> T.Text constraintTyToTxt ty = case ty of CTCHECK -> "CHECK" @@ -279,6 +278,20 @@ instance FromJSON ConstraintType where "UNIQUE" -> return CTUNIQUE c -> fail $ "unexpected ConstraintType: " <> T.unpack c +instance ToJSON ConstraintType where + toJSON = String . constraintTyToTxt + +isUniqueOrPrimary :: ConstraintType -> Bool +isUniqueOrPrimary = \case + CTPRIMARYKEY -> True + CTUNIQUE -> True + _ -> False + +isForeignKey :: ConstraintType -> Bool +isForeignKey = \case + CTFOREIGNKEY -> True + _ -> False + data TableConstraint = TableConstraint { tcType :: !ConstraintType @@ -287,13 +300,6 @@ data TableConstraint $(deriveJSON (aesonDrop 2 snakeCase) ''TableConstraint) -isUniqueOrPrimary :: TableConstraint -> Bool -isUniqueOrPrimary (TableConstraint ty _) = case ty of - CTCHECK -> False - CTFOREIGNKEY -> False - CTPRIMARYKEY -> True - CTUNIQUE -> True - data ViewInfo = ViewInfo { viIsUpdatable :: !Bool @@ -316,14 +322,14 @@ mutableView qt f mVI operation = data TableInfo = TableInfo - { tiName :: !QualifiedTable - , tiSystemDefined :: !Bool - , tiFieldInfoMap :: !FieldInfoMap - , tiRolePermInfoMap :: !RolePermInfoMap - , tiConstraints :: ![TableConstraint] - , tiPrimaryKeyCols :: ![PGCol] - , tiViewInfo :: !(Maybe ViewInfo) - , tiEventTriggerInfoMap :: !EventTriggerInfoMap + { tiName :: !QualifiedTable + , tiSystemDefined :: !Bool + , tiFieldInfoMap :: !FieldInfoMap + , tiRolePermInfoMap :: !RolePermInfoMap + , tiUniqOrPrimConstraints :: ![ConstraintName] + , tiPrimaryKeyCols :: ![PGCol] + , tiViewInfo :: !(Maybe ViewInfo) + , tiEventTriggerInfoMap :: !EventTriggerInfoMap } deriving (Show, Eq) $(deriveToJSON (aesonDrop 2 snakeCase) ''TableInfo) @@ -331,13 +337,13 @@ $(deriveToJSON (aesonDrop 2 snakeCase) ''TableInfo) mkTableInfo :: QualifiedTable -> Bool - -> [TableConstraint] + -> [ConstraintName] -> [PGColInfo] -> [PGCol] -> Maybe ViewInfo -> TableInfo -mkTableInfo tn isSystemDefined constraints cols pcols mVI = +mkTableInfo tn isSystemDefined uniqCons cols pcols mVI = TableInfo tn isSystemDefined colMap (M.fromList []) - constraints pcols mVI (M.fromList []) + uniqCons pcols mVI (M.fromList []) where colMap = M.fromList $ map f cols f colInfo = (fromPGCol $ pgiName colInfo, FIColumn colInfo) diff --git a/server/src-lib/Hasura/Server/App.hs b/server/src-lib/Hasura/Server/App.hs index 19539d4ce304e..084e36f10cfc3 100644 --- a/server/src-lib/Hasura/Server/App.hs +++ b/server/src-lib/Hasura/Server/App.hs @@ -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) 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 c37cc9cab78ac..f3ea35286a80a 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 @@ -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 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) diff --git a/server/src-rsr/table_info.sql b/server/src-rsr/table_info.sql index 406fc0b9d25a0..cf53f85c57cdd 100644 --- a/server/src-rsr/table_info.sql +++ b/server/src-rsr/table_info.sql @@ -38,16 +38,12 @@ from select c.table_schema, c.table_name, - json_agg( - json_build_object( - 'name', - constraint_name, - 'type', - constraint_type - ) - ) as constraints + json_agg(constraint_name) as constraints from information_schema.table_constraints c + where + c.constraint_type = 'UNIQUE' + or c.constraint_type = 'PRIMARY KEY' group by c.table_schema, c.table_name