gameServer/NetRoutines.hs
branch0.9.14
changeset 4242 5e3c5fe2cb14
parent 3502 ad38c653b7d9
child 4295 1f5604cd99be
equal deleted inserted replaced
4241:835fd7a0e1bf 4242:5e3c5fe2cb14
     1 {-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
     1 {-# LANGUAGE ScopedTypeVariables #-}
     2 module NetRoutines where
     2 module NetRoutines where
     3 
     3 
       
     4 import Network
     4 import Network.Socket
     5 import Network.Socket
     5 import System.IO
     6 import System.IO
       
     7 import Control.Concurrent
     6 import Control.Concurrent.Chan
     8 import Control.Concurrent.Chan
       
     9 import Control.Concurrent.STM
     7 import qualified Control.Exception as Exception
    10 import qualified Control.Exception as Exception
     8 import Data.Time
    11 import Data.Time
     9 import Control.Monad
       
    10 -----------------------------
    12 -----------------------------
    11 import CoreTypes
    13 import CoreTypes
       
    14 import ClientIO
    12 import Utils
    15 import Utils
    13 import RoomsAndClients
       
    14 
    16 
    15 acceptLoop :: Socket -> Chan CoreMessage -> IO ()
    17 acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO ()
    16 acceptLoop servSock chan = forever $ do
    18 acceptLoop servSock coreChan clientCounter = do
    17     Exception.handle
    19     Exception.handle
    18         (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
    20         (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
    19         do
    21         do
    20         (sock, sockAddr) <- Network.Socket.accept servSock
    22         (socket, sockAddr) <- Network.Socket.accept servSock
    21 
    23 
       
    24         cHandle <- socketToHandle socket ReadWriteMode
       
    25         hSetBuffering cHandle LineBuffering
    22         clientHost <- sockAddr2String sockAddr
    26         clientHost <- sockAddr2String sockAddr
    23 
    27 
    24         currentTime <- getCurrentTime
    28         currentTime <- getCurrentTime
    25 
    29         
    26         sendChan' <- newChan
    30         sendChan <- newChan
    27 
    31 
    28         let newClient =
    32         let newClient =
    29                 (ClientInfo
    33                 (ClientInfo
    30                     sendChan'
    34                     nextID
    31                     sock
    35                     sendChan
       
    36                     cHandle
    32                     clientHost
    37                     clientHost
    33                     currentTime
    38                     currentTime
    34                     ""
    39                     ""
    35                     ""
    40                     ""
    36                     False
    41                     False
    37                     0
    42                     0
    38                     lobbyId
    43                     0
    39                     0
    44                     0
    40                     False
    45                     False
    41                     False
    46                     False
    42                     False
    47                     False
    43                     undefined
    48                     undefined
    44                     undefined
    49                     undefined
    45                     )
    50                     )
    46 
    51 
    47         writeChan chan $ Accept newClient
    52         writeChan coreChan $ Accept newClient
       
    53 
       
    54         forkIO $ clientRecvLoop cHandle coreChan nextID
       
    55         forkIO $ clientSendLoop cHandle coreChan sendChan nextID
    48         return ()
    56         return ()
       
    57 
       
    58     acceptLoop servSock coreChan nextID
       
    59     where
       
    60         nextID = clientCounter + 1