open a socket properly

src-server/Main.hs

@@ -2,6 +2,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 
+import Control.Exception (catch, throwIO)
+
 import Control.Monad.RWS.Strict
 
 import qualified Data.ByteString.Char8 as B8
@@ -12,10 +14,16 @@ import Data.Time
 
 import Data.Yaml
 
-import Network.Socket
+import Network.Socket as Net
 
 import Options.Applicative
 
+import System.Posix.Signals
+
+import System.Directory
+
+import System.IO.Error
+
 -- internal imports
 
 import Library.Types
@@ -39,15 +47,19 @@ main = do
       let sockAddr = SockAddrUnix setSocketPath
       unless (isSupportedSockAddr sockAddr)
         (error $ "invalid socket path " <> setSocketPath)
-      let hints = defaultHints
-            { addrFamily     = AF_UNIX
-            , addrSocketType = Stream
-            , addrAddress    = sockAddr
-            }
-      addr <- head <$> getAddrInfo (Just hints) Nothing Nothing
-      sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
-      bind sock (addrAddress addr)
-      putStrLn "Bound to socket:"
+      removeIfExists setSocketPath
+      sock <- socket AF_UNIX Stream 0
+      bind sock sockAddr
+      touchSocket sock
+      void $ installHandler
+        keyboardSignal
+        (CatchOnce $ do
+          close' sock
+          removeIfExists setSocketPath
+        )
+        Nothing
+      Net.listen sock 1024
+      putStrLn "Bound and listening to socket:"
       print =<< getSocketName sock
       putStrLn "-----------------------------------------------------------------------------------"
       arena <- generateArena setMapRows setMapColumns setSpawnerProbability
@@ -66,3 +78,9 @@ main = do
         <> progDesc "Run the \"wizard-wipeout\" Server."
         <> header "wizard-wipeout - Last Mage standing"
         )
+
+removeIfExists :: FilePath -> IO ()
+removeIfExists fileName = removeFile fileName `catch` handleExists
+  where handleExists e
+          | isDoesNotExistError e = return ()
+          | otherwise = throwIO e

wizard-wipeout.cabal

@@ -51,6 +51,7 @@ executable wizard-wipeout-server
     build-depends:    base ^>=4.17.2.1
                     , aeson
                     , bytestring
+                    , directory
                     , linear
                     , matrix
                     , monad-loops
@@ -60,6 +61,7 @@ executable wizard-wipeout-server
                     , text
                     , time
                     , random
+                    , unix
                     , wizard-wipeout
                     , yaml
     hs-source-dirs:   src-server