refactor: make sure proper sockets cleanup is performed in App.run

Right now code in App.run does not properly use bracket/finally to close sockets and clean-up mainSocketRef. This is not a big problem at the moment because the application is going to exit enyway but introducting proper resource handling will make future refactorings safer.
This commit is contained in:
Michał Kłeczek
2026-07-06 10:59:05 -05:00
committed by Steve Chavez
parent 56df1dc532
commit c5c9dc33c9
+26 -22
View File
@@ -24,7 +24,6 @@ import GHC.IO.Exception (IOErrorType (..))
import System.IO.Error (ioeGetErrorType) import System.IO.Error (ioeGetErrorType)
import Control.Monad.Except (liftEither) import Control.Monad.Except (liftEither)
import Control.Monad.Extra (whenJust)
import Data.Either.Combinators (mapLeft, whenLeft) import Data.Either.Combinators (mapLeft, whenLeft)
import Data.IORef (atomicWriteIORef, newIORef, import Data.IORef (atomicWriteIORef, newIORef,
readIORef) readIORef)
@@ -83,39 +82,44 @@ run appState = do
conf <- AppState.getConfig appState conf <- AppState.getConfig appState
mainSocketRef <- newIORef Nothing mainSocketRef <- newIORef Nothing
adminSocket <- initAdminServerSocket conf let setMainSocketRef = atomicWriteIORef mainSocketRef . Just
clearMainSocketRef = atomicWriteIORef mainSocketRef Nothing
let closeSockets = do bracket (initAdminServerSocket conf) ensureSocketClosed $ \adminSocket -> do
whenJust adminSocket NS.close
readIORef mainSocketRef >>= foldMap NS.close
Unix.installSignalHandlers observer closeSockets (AppState.schemaCacheLoader appState) (AppState.readInDbConfig False appState)
Admin.runAdmin appState adminSocket (checkMainAppLive (readIORef mainSocketRef)) (serverSettings conf) let closeSockets = do
ensureSocketClosed adminSocket
ensureSocketClosed =<< readIORef mainSocketRef
Unix.installSignalHandlers observer closeSockets (AppState.schemaCacheLoader appState) (AppState.readInDbConfig False appState)
Listener.runListener appState Admin.runAdmin appState adminSocket (checkMainAppLive (readIORef mainSocketRef)) (serverSettings conf)
-- Kick off and wait for the initial SchemaCache load before creating the Listener.runListener appState
-- main API socket.
AppState.schemaCacheLoader appState
AppState.waitForSchemaCacheInit appState
mainSocket <- initServerSocket conf -- Kick off and wait for the initial SchemaCache load before creating the
atomicWriteIORef mainSocketRef $ Just mainSocket -- main API socket.
AppState.schemaCacheLoader appState
AppState.waitForSchemaCacheInit appState
let app = postgrest appState (AppState.schemaCacheLoader appState) bracket (initServerSocket conf) NS.close $ \mainSocket -> do
address <- resolveSocketToAddress mainSocket let app = postgrest appState (AppState.schemaCacheLoader appState)
let address <- resolveSocketToAddress mainSocket
appServerSettings = serverSettings conf
& setPort (configServerPort conf)
& setOnException onWarpException
& setBeforeMainLoop (observer $ AppServerAddressObs address)
Warp.runSettingsSocket appServerSettings mainSocket app let
appServerSettings = serverSettings conf
& setPort (configServerPort conf)
& setOnException onWarpException
& setBeforeMainLoop (setMainSocketRef mainSocket *> observer (AppServerAddressObs address))
Warp.runSettingsSocket appServerSettings mainSocket app
`finally` clearMainSocketRef
where where
observer = AppState.getObserver appState observer = AppState.getObserver appState
ensureSocketClosed = foldMap NS.close
onWarpException :: Maybe Wai.Request -> SomeException -> IO () onWarpException :: Maybe Wai.Request -> SomeException -> IO ()
onWarpException _ ex = onWarpException _ ex =
when (shouldDisplayException ex) $ when (shouldDisplayException ex) $