diff --git a/src-server/Main.hs b/src-server/Main.hs index 3fa8f58..b6d8e30 100644 --- a/src-server/Main.hs +++ b/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 diff --git a/wizard-wipeout.cabal b/wizard-wipeout.cabal index 5c43b6e..29247e9 100644 --- a/wizard-wipeout.cabal +++ b/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