Cleanup port binding logic.

pkg/hs/king/lib/Vere/Http/Server.hs

@@ -380,36 +380,44 @@ app env sId liv plan which req respond =
 -- Top-Level Driver Interface --------------------------------------------------
 
 {-
-    TODO if a bunch of these fail, then I get errors. Something is wrong.
+    Opens a socket on some port, accepting connections from `127.0.0.1`
+    if fake and `0.0.0.0` if real.
 
-        ...
+    It will attempt to open a socket on each of the supplied ports in
-        [warn] Network.Socket.socket: resource exhausted (Too many open files)
+    order. If they all fail, it will ask the operating system to give
-        [warn] Failed to open port 48541
+    us an open socket on *any* open port. If that fails, it will throw
-        ...
+    an exception.
 -}
-
+openPort :: HasLogFunc e => Bool -> [W.Port] -> RIO e (W.Port, Net.Socket)
-openPort :: HasLogFunc e => [W.Port] -> RIO e (W.Port, Net.Socket)
+openPort isFake = go
-openPort = \case
-    []   -> io W.openFreePort
-    x:xs -> io (tryOpenPort x) >>= \case
-                Left err -> do
-                    logWarn (display ("Failed to open port " <> tshow x))
-                    logWarn (display (tshow err))
-                    openPort xs
-                Right ps -> do
-                    logTrace (display ("Opening port " <> tshow (fst ps)))
-                    pure ps
   where
-    -- TODO XX Don't catch SomeException. Catch specific excception. This
+    go = \case
-    -- is actually a really foul hack. Change this now!
+        []   -> io W.openFreePort
-    tryOpenPort ∷ W.Port → IO (Either SomeException (W.Port, Net.Socket))
+        x:xs -> io (tryOpen x) >>= \case
-    tryOpenPort por = try $ do
+                    Left (err∷IOError) -> do
-        s <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol
+                        logWarn (display ("Failed to open port " <> tshow x))
-        localhost <- Net.inet_addr "0.0.0.0"
+                        logWarn (display (tshow err))
-        Net.bind s (Net.SockAddrInet (fromIntegral por) localhost)
+                        go xs
-        Net.listen s 1
+                    Right ps -> do
-        port <- Net.socketPort s
+                        logTrace (display ("Opening port " <> tshow (fst ps)))
-        return (fromIntegral port, s)
+                        pure ps
+
+    bindTo = if isFake then "127.0.0.1" else "0.0.0.0"
+
+    bindListenPort ∷ W.Port → Net.Socket → IO Net.PortNumber
+    bindListenPort por sok = do
+        bindAddr <- Net.inet_addr bindTo
+        Net.bind sok (Net.SockAddrInet (fromIntegral por) bindAddr)
+        Net.listen sok 1
+        Net.socketPort sok
+
+    --  `inet_addr`, `bind`, and `listen` all throw `IOError` if they fail.
+    tryOpen ∷ W.Port → IO (Either IOError (W.Port, Net.Socket))
+    tryOpen por = do
+        sok <- Net.socket Net.AF_INET Net.Stream Net.defaultProtocol
+        try (bindListenPort por sok) >>= \case
+            Left exn  -> Net.close sok $> Left exn
+            Right por -> pure (Right (fromIntegral por, sok))
 
 {-
     TODO Need to find an open port.
@@ -426,12 +434,12 @@ startServ isFake conf plan = do
   sId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32)
   liv <- newTVarIO emptyLiveReqs
 
-  let insP = [8080..8085]
+  let insPor = if isFake then [8080..8085] else (80  : [8080..8085])
-      secP = [8443..8448]
+      secPor = if isFake then [8443..8448] else (443 : [8443..8448])
 
-  (httpPortInt,  httpSock)  <- openPort (if isFake then insP else 80:insP)
+  (httpPortInt,  httpSock)  <- openPort isFake insPor
-  (httpsPortInt, httpsSock) <- openPort (if isFake then secP else 443:secP)
+  (httpsPortInt, httpsSock) <- openPort isFake secPor
-  (loopPortInt,  loopSock)  <- openPort [12321..12326]
+  (loopPortInt,  loopSock)  <- openPort isFake [12321..12326]
 
   let httpPort  = Port (fromIntegral httpPortInt)
       httpsPort = Port (fromIntegral httpsPortInt)