gameServer/NetRoutines.hs
author sheepluva
Sun, 30 Jan 2011 06:56:12 +0100
changeset 4884 b2006a9f0fbc
parent 4568 f85243bf890e
child 4905 7842d085acf4
permissions -rw-r--r--
nicklists: * friends go to the top * ignored people go to the bottom * first time each of those happens it automatically scrolls there (to avoid "where did it go?!"-moments) friendslist/ignorelist: adding a nick to one will remove it from other

{-# LANGUAGE ScopedTypeVariables #-}
module NetRoutines where

import Network
import Network.Socket
import System.IO
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Concurrent.STM
import qualified Control.Exception as Exception
import Data.Time
-----------------------------
import CoreTypes
import ClientIO
import Utils

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

        cHandle <- socketToHandle socket ReadWriteMode
        hSetBuffering cHandle LineBuffering
        clientHost <- sockAddr2String sockAddr

        currentTime <- getCurrentTime
        
        sendChan <- newChan

        let newClient =
                (ClientInfo
                    nextID
                    sendChan
                    cHandle
                    clientHost
                    currentTime
                    ""
                    ""
                    False
                    0
                    0
                    0
                    False
                    False
                    False
                    undefined
                    undefined
                    )

        writeChan coreChan $ Accept newClient

        forkIO $ clientRecvLoop cHandle coreChan nextID
        forkIO $ clientSendLoop cHandle coreChan sendChan nextID
        return ()

    acceptLoop servSock coreChan nextID
    where
        nextID = clientCounter + 1