first working socket experiments

src-lib/Library/Types.hs

@@ -31,13 +31,6 @@ data ClientState = ClientState
   , clientStop     :: Bool -- ^ client shutdown
   }
 
--- | Data object for storing the server's state
-data ServerState = ServerState
-  { serverGameOver :: Bool -- ^ global game over state (only one contestant left)
-  , serverStop     :: Bool -- ^ Server shutdown
-  }
-  deriving (Show, Eq)
-
 -- | Type synonym for the Map. Translates to a Matrix of 'Tile's
 type ServerMap = Matrix Tile
 

src-server/Main.hs

@@ -40,7 +40,7 @@ main = do
     Right (Settings {..}) -> do
       sock <- bindSocket setSocketPath
       terminateSocketOnSigint sock
-      Net.listen sock 1024
+      -- Net.listen sock 1024
       putStrLn "Bound and listening to socket:"
       print =<< getSocketName sock
       putStrLn "-----------------------------------------------------------------------------------"
@@ -51,7 +51,7 @@ main = do
       putStrLn "starting game…"
       now <- getCurrentTime
       let initRead  = ReaderContainer (arenaMap arena) setFPS sock
-          initState = StateContainer (arenaSpawners arena) [] (ServerState False False) now
+          initState = StateContainer (arenaSpawners arena) [] (ServerState False False) now []
       (finalState, finalWrite) <- execRWST runGame initRead initState
       print finalWrite
   where

src-server/Server/Communication.hs

@@ -1,13 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Server.Communication where
 
 import Control.Monad
 
-import Network.Socket
+import Control.Monad.IO.Class
+
+import Control.Monad.RWS.Strict
+
+import Network.Socket as Net
+
+import System.IO
 
 import System.Posix.Signals
 
 -- internal imports
 
+import Server.Types
 import Server.Util
 
 -- | Function which determines whether the given filePath is a supported socket path and
@@ -20,8 +28,9 @@ bindSocket path = do
   unless (isSupportedSockAddr sockAddr)
     (error $ "invalid socket path " <> path)
   -- aremoveIfExists path
-  sock <- socket AF_UNIX Stream 0
+  sock <- socket AF_UNIX Stream defaultProtocol
   bind sock sockAddr
+  Net.listen sock 5
   pure sock
 
 -- | Function that installs a handler on SIGINT to close and remove the given socket
@@ -39,3 +48,29 @@ terminateSocketOnSigint sock =
       raiseSignal keyboardSignal
     )
     Nothing
+
+-- | Process incoming connection requests
+processRequests :: Game
+processRequests = do
+  mainSocket <- asks rcMainSocket
+  clientSock <- liftIO $ do
+    (clientSock, _) <- accept mainSocket
+    putStrLn $ "accepted new connection"
+    pure clientSock
+  modify' (\st ->
+    st
+      {scClientSockets = clientSock : scClientSockets st}
+    )
+
+-- | process incomeing messages from clients
+processMessages :: Game
+processMessages = do
+  clientSocks <- gets scClientSockets
+  mapM_
+    (\clientSocket -> liftIO $ do
+      connectionHandle <- socketToHandle clientSocket ReadMode
+      hSetBuffering connectionHandle LineBuffering
+      messages <- hGetContents' connectionHandle
+      print messages
+    )
+    clientSocks

src-server/Server/Game.hs

@@ -12,6 +12,7 @@ import Data.Time
 
 import Library.Types
 
+import Server.Communication
 import Server.Types
 
 runGame :: Game
@@ -22,6 +23,9 @@ runGame = do
       before <- gets scServerLastTick
       now <- liftIO getCurrentTime
       let delta = realToFrac $ diffUTCTime now before
+
+      processRequests
+      processMessages
       updateSpawners delta
       updateWizards delta
       fps <- asks rcFPS
@@ -32,7 +36,7 @@ runGame = do
 
 updateSpawners :: Float -> Game
 updateSpawners dt =
-  modify' (\sc@(StateContainer spawners _ _ _) ->
+  modify' (\sc@(StateContainer spawners _ _ _ _) ->
     let newSpawners = map
           (\spawner -> do
             let newTTL = spawnerReloadTTL spawner - dt
@@ -53,7 +57,7 @@ updateSpawners dt =
 
 updateWizards :: Float -> Game
 updateWizards dt =
-  modify' (\sc@(StateContainer _ wizards _ _) ->
+  modify' (\sc@(StateContainer _ wizards _ _ _) ->
     let newWizards = map
           (\wizard@(Wizard _ _ health _ _ effects) ->
             let newEffects = foldl

src-server/Server/Types.hs

@@ -40,9 +40,9 @@ options = Options
     )
 
 data ReaderContainer = ReaderContainer
-  { rcMap    :: ServerMap
+  { rcMap        :: ServerMap
-  , rcFPS    :: Int
+  , rcFPS        :: Int
-  , rcSocket :: Socket
+  , rcMainSocket :: Socket
   }
   deriving (Eq, Show)
 
@@ -51,6 +51,14 @@ data StateContainer = StateContainer
   , scPlayers        :: [ Wizard ]
   , scServerState    :: ServerState
   , scServerLastTick :: UTCTime
+  , scClientSockets  :: [ Socket ]
   }
 
+-- | Data object for storing the server's state
+data ServerState = ServerState
+  { serverGameOver :: Bool -- ^ global game over state (only one contestant left)
+  , serverStop     :: Bool -- ^ Server shutdown
+  }
+  deriving (Show, Eq)
+
 type Game = RWST ReaderContainer String StateContainer IO ()