Repository: hasura/graphql-engine
File: server/src-lib/Hasura/App.hs (Haskell)

Code before:
  connInfo <- liftIO procConnInfo
  (loggers, pool) <- case hgeCmd of
    -- for server command generate a proper pool
    HCServe so@ServeOptions{..} -> do
      l@(Loggers _ logger pgLogger) <- mkLoggers soEnabledLogTypes soLogLevel
      -- log serve options
      unLogger logger $ serveOptsToLog so
      -- log postgres connection info
      unLogger logger $ connInfoToLog connInfo
      pool <- liftIO $ Q.initPGPool connInfo soConnParams pgLogger
      -- safe init catalog
      initialiseCatalog pool (SQLGenCtx soStringifyNum) httpManager logger

      return (l, pool)

    -- for other commands generate a minimal pool
    _ -> do
      l@(Loggers _ _ pgLogger) <- mkLoggers defaultEnabledLogTypes LevelInfo
      pool <- getMinimalPool pgLogger connInfo
      return (l, pool)

  -- get the unique db id
  eDbId <- liftIO $ runExceptT $ Q.runTx pool (Q.Serializable, Nothing) getDbId
  dbId <- either printErrJExit return eDbId

  -- get the pg version
  ePgVersion <- liftIO $ runExceptT $ Q.runTx pool (Q.ReadCommitted, Nothing) getPgVersion
  pgVersion <- either printErrJExit return ePgVersion
  return (InitCtx httpManager instanceId dbId loggers connInfo pool pgVersion, initTime)

  where
    procConnInfo =
      either (printErrExit . connInfoErrModifier) return $ mkConnInfo rci

    getMinimalPool pgLogger ci = do
      let connParams = Q.defaultConnParams { Q.cpConns = 1 }
      liftIO $ Q.initPGPool ci connParams pgLogger

    mkLoggers enabledLogs logLevel = do
      loggerCtx <- liftIO $ mkLoggerCtx (defaultLoggerSettings True logLevel) enabledLogs
      let logger = mkLogger loggerCtx
          pgLogger = mkPGLogger logger
      return $ Loggers loggerCtx logger pgLogger

    initialiseCatalog pool sqlGenCtx httpManager (Logger logger) = do
      currentTime <- liftIO getCurrentTime
      -- initialise the catalog
      initRes <- runAsAdmin pool sqlGenCtx httpManager $ migrateCatalog currentTime
      either printErrJExit (\(result, schemaCache) -> logger result $> schemaCache) initRes

runHGEServer

Review comment (refactor):
You can use [`serverVersion`](https://github.com/hasura/pg-client-hs/blob/master/src/Database/PG/Query/Transaction.hs#L251) to get the underlying Postgres version.

There seems to be a lot of `runExceptT $ runTx` followed by `printErrJExit`, so might as well clean up this section by having a function as follows:
```haskell
-- | runs a transaction, on error, it is logged and the program is aborted
runTxIO :: Q.Pool -> Q.IsolationLevel -> Tx e a -> IO a
runTxIO = ...
```

Code after:
  instanceId <- liftIO generateInstanceId
  connInfo <- liftIO procConnInfo
  (loggers, pool) <- case hgeCmd of
    -- for server command generate a proper pool
    HCServe so@ServeOptions{..} -> do
      l@(Loggers _ logger pgLogger) <- mkLoggers soEnabledLogTypes soLogLevel
      -- log serve options
      unLogger logger $ serveOptsToLog so
      -- log postgres connection info
      unLogger logger $ connInfoToLog connInfo
      pool <- liftIO $ Q.initPGPool connInfo soConnParams pgLogger
      -- safe init catalog
      initialiseCatalog pool (SQLGenCtx soStringifyNum) httpManager logger

      return (l, pool)

    -- for other commands generate a minimal pool
    _ -> do
      l@(Loggers _ _ pgLogger) <- mkLoggers defaultEnabledLogTypes LevelInfo
      pool <- getMinimalPool pgLogger connInfo
      return (l, pool)

  -- get the unique db id
  dbId <- liftIO $ runTxIO pool (Q.Serializable, Nothing) getDbId

  -- get the pg version
  pgVersion <- liftIO $ runTxIO pool (Q.ReadCommitted, Nothing) getPgVersion

  return (InitCtx httpManager instanceId dbId loggers connInfo pool pgVersion, initTime)

  where
    procConnInfo =
      either (printErrExit . connInfoErrModifier) return $ mkConnInfo rci

    getMinimalPool pgLogger ci = do
      let connParams = Q.defaultConnParams { Q.cpConns = 1 }
      liftIO $ Q.initPGPool ci connParams pgLogger

    mkLoggers enabledLogs logLevel = do
      loggerCtx <- liftIO $ mkLoggerCtx (defaultLoggerSettings True logLevel) enabledLogs
      let logger = mkLogger loggerCtx
          pgLogger = mkPGLogger logger
      return $ Loggers loggerCtx logger pgLogger

    initialiseCatalog pool sqlGenCtx httpManager (Logger logger) = do
      currentTime <- liftIO getCurrentTime
      -- initialise the catalog
      initRes <- runAsAdmin pool sqlGenCtx httpManager $ migrateCatalog currentTime
      either printErrJExit (\(result, schemaCache) -> logger result $> schemaCache) initRes

-- | Run a transaction and if an error is encountered, log the error and abort the program