gameServer/NetRoutines.hs
author nemo
Sun, 17 Apr 2011 23:44:54 -0400
changeset 5153 c1df8a73f916
parent 4987 cf9470964dba
child 5209 f7a610e2ef5f
permissions -rw-r--r--
I'm not saying this fixes anything, I'm just hoping it inspires Tiy to take an interest in the theme. (removes the background water effect that just wasn't working, puts in new spray objects including removing the copyrighted one, tries for a sand that doesn't look like sandpaper)

{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
module NetRoutines where

import Network.Socket
import Control.Concurrent.Chan
import qualified Control.Exception as Exception
import Data.Time
import Control.Monad
import Data.Unique
-----------------------------
import CoreTypes
import Utils
import RoomsAndClients

acceptLoop :: Socket -> Chan CoreMessage -> IO ()
acceptLoop servSock chan = forever $
    Exception.handle
        (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
        do
        (sock, sockAddr) <- Network.Socket.accept servSock

        clientHost <- sockAddr2String sockAddr

        currentTime <- getCurrentTime

        sendChan' <- newChan

        uid <- newUnique

        let newClient =
                (ClientInfo
                    uid
                    sendChan'
                    sock
                    clientHost
                    currentTime
                    ""
                    ""
                    False
                    0
                    lobbyId
                    0
                    False
                    False
                    False
                    Nothing
                    0
                    )

        writeChan chan $ Accept newClient
        return ()