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

Code before:
      lockedEvents <- readTVarIO _eeCtxLockedEvents
      liftIO $ do
        when (not $ Set.null $ lockedEvents) $ do
          res <- runTx pool (Q.ReadCommitted, Nothing) (unlockEvents $ toList lockedEvents)
          case res of
            Left err -> logger $ mkGenericStrLog
                         LevelWarn "event_triggers" ("Error in unlocking the events " ++ (show err))
            Right count -> logger $ mkGenericStrLog
                            LevelInfo "event_triggers" ((show count) ++ " events were updated")

    -- | shutdownScheduledEvents is like the shutdownEvents action, the only difference being
    --   it is for scheduled trigger's events (cron events and standalone scheduled events)
    --   and shutdownEvents is for event trigger's events.
    shutdownScheduledEvents :: Q.PGPool -> Logger Hasura -> LockedScheduledEventsCtx -> IO ()
    shutdownScheduledEvents pool (Logger logger) LockedScheduledEventsCtx {..} = do
      liftIO $ logger $ mkGenericStrLog LevelInfo "scheduled_triggers" "unlocking scheduled events that are locked by the HGE"
      lockedCronEvents <- readTVarIO lseCronEvents
      lockedStandaloneEvents <- readTVarIO lseStandAloneEvents
      liftIO $ do
        when (not $ Set.null $ lockedCronEvents) $ do
          res <- runTx pool (Q.ReadCommitted, Nothing) (unlockCronEvents $ toList lockedCronEvents)
          case res of
            Left err -> logger $ mkGenericStrLog
                         LevelWarn "scheduled_triggers" ("Error in unlocking the cron events " ++ (show err))
            Right count -> logger $ mkGenericStrLog
                            LevelInfo "scheduled_triggers" ((show count) ++ " cron events were unlocked")
      liftIO $ do
        when (not $ Set.null $ lockedStandaloneEvents) $ do
          res <- runTx pool (Q.ReadCommitted, Nothing) (unlockStandaloneScheduledEvents $ toList lockedStandaloneEvents)
          case res of
            Left err -> logger $ mkGenericStrLog
                         LevelWarn "scheduled_triggers" ("Error in unlocking the scheduled events " ++ (show err))
            Right count -> logger $ mkGenericStrLog
                            LevelInfo "scheduled_triggers" ((show count) ++ " scheduled events were unlocked")

    getFromEnv :: (Read a) => a -> String -> IO a
    getFromEnv defaults env = do
      mEnv <- lookupEnv env
      let mRes = case mEnv of
            Nothing  -> Just defaults
            Just val -> readMaybe val
          eRes = maybe (Left $ "Wrong expected type for environment variable: " <> env) Right mRes
      either printErrExit return eRes

    runTx :: Q.PGPool -> Q.TxMode -> Q.TxE QErr a -> IO (Either QErr a)
    runTx pool txLevel tx =
      liftIO $ runExceptT $ Q.runTx pool txLevel tx

    -- | Waits for the shutdown latch 'MVar' to be filled, and then
    -- shuts down the server and associated resources.
    -- Structuring things this way lets us decide elsewhere exactly how

Review comment (refactor):
It seems like there’s a lot of duplicate logic here. It would be nice to pull the shared logic out into a function. Something along these lines:

```haskell
unlockEventsForShutdown
  :: Q.PGPool
  -> Logger Hasura
  -> Text -- ^ trigger type
  -> Text -- ^ event type
  -> ([eventId] -> Q.TxE QErr Int)
  -> TVar (Set eventId)
  -> IO ()
unlockEventsForShutdown pool (Logger logger) triggerType eventType doUnlock lockedIdsVar = do
  lockedIds <- readTVarIO lockedIdsVar
  unless (Set.null lockedIds) do
    result <- runTx pool (Q.ReadCommitted, Nothing) (doUnlock $ toList lockedIds)
    case result of
      Left err -> logger $ mkGenericStrLog LevelWarn triggerType $
        "Error while unlocking " ++ eventType ++ " events: " ++ show err
      Right count -> logger $ mkGenericStrLog LeveInfo triggerType $
        show count ++ " " ++ eventType ++ " events successfully unlocked"
```

You could then use that in three places: once in `shutdownEvents` and twice in `shutdownScheduledEvents`. (And at that point, maybe all this could happen in `shutdownEvents`; I’m not sure it’s beneficial for these to be two separate functions.)

Code after:
      :: Q.PGPool
      -> Logger Hasura
      -> LockedEventsCtx
      -> IO ()
    shutdownEvents pool hasuraLogger@(Logger logger) LockedEventsCtx {..} = do
      liftIO $ logger $ mkGenericStrLog LevelInfo "event_triggers" "unlocking events that are locked by the HGE"
      unlockEventsForShutdown pool hasuraLogger "event_triggers" "" unlockEvents leEvents
      liftIO $ logger $ mkGenericStrLog LevelInfo "scheduled_triggers" "unlocking scheduled events that are locked by the HGE"
      unlockEventsForShutdown pool hasuraLogger "scheduled_triggers" "cron events" unlockCronEvents leCronEvents
      unlockEventsForShutdown pool hasuraLogger "scheduled_triggers" "scheduled events" unlockCronEvents leStandAloneEvents

    unlockEventsForShutdown
      :: Q.PGPool
      -> Logger Hasura
      -> Text -- ^ trigger type
      -> Text -- ^ event type
      -> ([eventId] -> Q.TxE QErr Int)
      -> TVar (Set.Set eventId)
      -> IO ()
    unlockEventsForShutdown pool (Logger logger) triggerType eventType doUnlock lockedIdsVar = do
      lockedIds <- readTVarIO lockedIdsVar
      unless (Set.null lockedIds) do
        result <- runTx pool (Q.ReadCommitted, Nothing) (doUnlock $ toList lockedIds)
        case result of
          Left err -> logger $ mkGenericStrLog LevelWarn triggerType $
            "Error while unlocking " ++ T.unpack eventType ++ " events: " ++ show err
          Right count -> logger $ mkGenericStrLog LevelInfo triggerType $
            show count ++ " " ++ T.unpack eventType ++ " events successfully unlocked"

    getFromEnv :: (Read a) => a -> String -> IO a
    getFromEnv defaults env = do
      mEnv <- lookupEnv env
      let mRes = case mEnv of
            Nothing  -> Just defaults
            Just val -> readMaybe val
          eRes = maybe (Left $ "Wrong expected type for environment variable: " <> env) Right mRes
      either printErrExit return eRes

    runTx :: Q.PGPool -> Q.TxMode -> Q.TxE QErr a -> IO (Either QErr a)
    runTx pool txLevel tx =
      liftIO $ runExceptT $ Q.runTx pool txLevel tx

    -- | Waits for the shutdown latch 'MVar' to be filled, and then
    -- shuts down the server and associated resources.
    -- Structuring things this way lets us decide elsewhere exactly how
    -- we want to control shutdown.
    shutdownHandler
      :: Loggers
      -> IO ()
      -> LockedEventsCtx
      -> Q.PGPool