@@ -10,6 +10,7 @@ Some of its functionality includes:
1010- Content Negotiation
1111-}
1212{-# LANGUAGE FlexibleContexts #-}
13+ {-# LANGUAGE LambdaCase #-}
1314{-# LANGUAGE NamedFieldPuns #-}
1415{-# LANGUAGE RecordWildCards #-}
1516{-# LANGUAGE ScopedTypeVariables #-}
@@ -19,8 +20,9 @@ module PostgREST.App
1920 , run
2021 ) where
2122
22-
23+ import GHC.Conc ( ThreadStatus ( .. ), threadStatus )
2324import GHC.IO.Exception (IOErrorType (.. ))
25+ import GHC.Weak
2426import System.IO.Error (ioeGetErrorType )
2527
2628import Control.Monad.Except (liftEither )
@@ -71,14 +73,14 @@ import qualified Data.Text as T
7173import qualified Network.HTTP.Types as HTTP
7274import Network.HTTP.Types.Header (hVary )
7375import qualified Network.Socket as NS
74- import Network.Socket.ByteString (send )
7576import PostgREST.Unix (createAndBindDomainSocket )
7677import System.Posix.Types (FileMode )
7778
78- import Protolude hiding (Handler )
79+ import Protolude hiding (Handler )
80+ import System.Directory (doesPathExist )
7981
80- run :: AppState -> IO ()
81- run appState = do
82+ run :: AppState -> Weak ThreadId -> IO ()
83+ run appState mainThreadIdRef = do
8284 conf <- AppState. getConfig appState
8385
8486 mainSocketRef <- newIORef Nothing
@@ -92,7 +94,7 @@ run appState = do
9294 ensureSocketClosed =<< readIORef mainSocketRef
9395 Unix. installSignalHandlers observer closeSockets (AppState. schemaCacheLoader appState) (AppState. readInDbConfig False appState)
9496
95- Admin. runAdmin appState adminSocket (checkMainAppLive (readIORef mainSocketRef)) (serverSettings conf)
97+ Admin. runAdmin appState adminSocket (checkMainAppLive (readIORef mainSocketRef) mainThreadIdRef ) (serverSettings conf)
9698
9799 Listener. runListener appState
98100
@@ -297,21 +299,21 @@ initAdminServerSocket AppConfig{..} =
297299 configAdminServerUnixSocket configAdminServerUnixSocketMode
298300 configAdminServerHost configAdminServerPort
299301
300- checkMainAppLive :: IO (Maybe NS. Socket ) -> IO Bool
301- checkMainAppLive getMainSocket =
302- getMainSocket >>= maybe (pure False ) (fmap isRight . reachMainApp)
303-
304- -- Try to connect to the main app socket
305- -- Note that it doesn't even send a valid HTTP request, we just want to check that the main app is accepting connections
306- reachMainApp :: NS. Socket -> IO (Either IOException () )
307- reachMainApp appSock = do
308- sockAddr <- NS. getSocketName appSock
309- sock <- NS. socket (addrFamily sockAddr) NS. Stream NS. defaultProtocol
310- try $ do
311- NS. connect sock sockAddr
312- NS. withSocketsDo $ bracket (pure sock) NS. close sendEmpty
302+ checkMainAppLive :: IO (Maybe NS. Socket ) -> Weak ThreadId -> IO Bool
303+ checkMainAppLive getMainSocket mainThreadIdRef =
304+ handle (\ (_ :: IOException ) -> pure False ) $
305+ checkMainThread <&&> checkSocket
313306 where
314- sendEmpty sock = void $ send sock mempty
315- addrFamily (NS. SockAddrInet _ _) = NS. AF_INET
316- addrFamily (NS. SockAddrInet6 {}) = NS. AF_INET6
317- addrFamily (NS. SockAddrUnix _) = NS. AF_UNIX
307+ checkSocket = getMainSocket >>=
308+ maybe (pure False )
309+ (NS. getSocketName >=> \ case
310+ -- in case of unix socket, check if it still exists
311+ NS. SockAddrUnix fp -> doesPathExist fp
312+ _ -> pure True )
313+ checkMainThread = deRefWeak mainThreadIdRef >>=
314+ maybe (pure False )
315+ (fmap isRunning . threadStatus)
316+ isRunning = \ case
317+ ThreadRunning -> True
318+ ThreadBlocked _ -> True
319+ _ -> False
0 commit comments