From f2824ef200d165db41a0ff2d644264970c5778dc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 22 Aug 2026 13:24:23 +0200
Subject: Return from startServer only after initializing the socket

---
 src/Erebos/Network.hs | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

(limited to 'src/Erebos')

diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index 2f3b278..225ba4a 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -449,16 +449,16 @@ startServer serverOptions serverOrigHead logd' serverServices = do
 
             erebosNetworkProtocol (headLocalIdentity serverOrigHead) logd logt protocolRawPath protocolControlFlow
 
-    forkServerThread server "main-loop" $ withSocketsDo $ do
+    withSocketsDo $ do
         let hints = defaultHints
-              { addrFlags = [AI_PASSIVE]
+              { addrFlags = [ AI_PASSIVE ]
               , addrFamily = AF_INET6
               , addrSocketType = Datagram
               }
         addr:_ <- getAddrInfo (Just hints) Nothing (Just $ show $ serverPort serverOptions)
         let open = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
             closeAndNotify sock = close sock >> putMVar serverSocketClosed ()
-        bracket open closeAndNotify $ \sock -> do
+        bracketOnError open closeAndNotify $ \sock -> do
             withFdSocket sock setCloseOnExecIfNeeded
             setSocketOption sock Broadcast 1
             bind sock (addrAddress addr) `catchIOError` \e -> if
@@ -470,7 +470,8 @@ startServer serverOptions serverOrigHead logd' serverServices = do
                       bind sock (SockAddrInet6 0 f h s)
                 | otherwise -> ioError e
             putMVar serverSocket sock
-            loop sock
+            forkServerThread server "main-loop" $ do
+                loop sock `finally` closeAndNotify sock
 
     forkServerThread server "service-handler" $ forever $ do
         ( peer, paddr, svc, ref, streams ) <- atomically $ readTQueue chanSvc
-- 
cgit v1.2.3