first working socket experiments

This commit is contained in:
nek0 2023-12-10 02:02:09 +01:00
parent 734511b5f9
commit 822a2178b4
5 changed files with 56 additions and 16 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 ()