fix: fix startup on unix-socket

This commit is contained in:
Gregor Kleen 2019-09-25 18:01:20 +02:00
parent 977840446e
commit 39f12957f5

View File

@ -77,7 +77,7 @@ import System.Posix.Process (getProcessID)
import System.Posix.Signals (SignalInfo(..), installHandler, sigTERM) import System.Posix.Signals (SignalInfo(..), installHandler, sigTERM)
import qualified System.Posix.Signals as Signals (Handler(..)) import qualified System.Posix.Signals as Signals (Handler(..))
import Network.Socket (socketPort) import Network.Socket (socketPort, Socket, PortNumber)
import qualified Network.Socket as Socket (close) import qualified Network.Socket as Socket (close)
import Control.Concurrent.STM.Delay import Control.Concurrent.STM.Delay
@ -370,7 +370,7 @@ develMain = runResourceT $ do
liftIO . develMainHelper $ return (wsettings, app) liftIO . develMainHelper $ return (wsettings, app)
-- | The @main@ function for an executable running this site. -- | The @main@ function for an executable running this site.
appMain :: MonadUnliftIO m => m () appMain :: forall m. MonadUnliftIO m => m ()
appMain = runResourceT $ do appMain = runResourceT $ do
settings <- getAppSettings settings <- getAppSettings
@ -398,7 +398,7 @@ appMain = runResourceT $ do
$logInfoS "bind" [st|Listening on #{tshow host} port #{tshow port} as per configuration|] $logInfoS "bind" [st|Listening on #{tshow host} port #{tshow port} as per configuration|]
liftIO $ pure <$> bindPortTCP port host liftIO $ pure <$> bindPortTCP port host
$logDebugS "bind" . tshow =<< mapM (liftIO . socketPort) sockets $logDebugS "bind" . tshow =<< mapM (liftIO . try . socketPort :: Socket -> _ (Either SomeException PortNumber)) sockets
mainThreadId <- myThreadId mainThreadId <- myThreadId
liftIO . void . flip (installHandler sigTERM) Nothing . Signals.CatchInfo $ \SignalInfo{..} -> runAppLoggingT foundation $ do liftIO . void . flip (installHandler sigTERM) Nothing . Signals.CatchInfo $ \SignalInfo{..} -> runAppLoggingT foundation $ do