From 822a2178b4d4ef6bb4335c3041b25751efc1ced6 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 10 Dec 2023 02:02:09 +0100 Subject: [PATCH] first working socket experiments --- src-lib/Library/Types.hs | 7 ------ src-server/Main.hs | 4 +-- src-server/Server/Communication.hs | 39 ++++++++++++++++++++++++++++-- src-server/Server/Game.hs | 8 ++++-- src-server/Server/Types.hs | 14 ++++++++--- 5 files changed, 56 insertions(+), 16 deletions(-) diff --git a/src-lib/Library/Types.hs b/src-lib/Library/Types.hs index 231c7a1..57589ce 100644 --- a/src-lib/Library/Types.hs +++ b/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 diff --git a/src-server/Main.hs b/src-server/Main.hs index bf00a5c..db3a309 100644 --- a/src-server/Main.hs +++ b/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 diff --git a/src-server/Server/Communication.hs b/src-server/Server/Communication.hs index c185474..bb84bc9 100644 --- a/src-server/Server/Communication.hs +++ b/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 diff --git a/src-server/Server/Game.hs b/src-server/Server/Game.hs index 68a924b..a2b0758 100644 --- a/src-server/Server/Game.hs +++ b/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 diff --git a/src-server/Server/Types.hs b/src-server/Server/Types.hs index 58095e8..74fa717 100644 --- a/src-server/Server/Types.hs +++ b/src-server/Server/Types.hs @@ -40,9 +40,9 @@ options = Options ) data ReaderContainer = ReaderContainer - { rcMap :: ServerMap - , rcFPS :: Int - , rcSocket :: Socket + { rcMap :: ServerMap + , rcFPS :: Int + , 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 ()