gameServer/ClientIO.hs
changeset 4996 76ef3d8bd78e
parent 4982 3572eaf14340
child 4998 cdcdf37e5532
equal deleted inserted replaced
4995:d3ca68e4860e 4996:76ef3d8bd78e
    43                 forM_ packets sendPacket
    43                 forM_ packets sendPacket
    44                 recieveWithBufferLoop newrecvBuf
    44                 recieveWithBufferLoop newrecvBuf
    45 
    45 
    46         sendPacket packet = writeChan chan $ ClientMessage (ci, packet)
    46         sendPacket packet = writeChan chan $ ClientMessage (ci, packet)
    47 
    47 
    48 
       
    49 clientRecvLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO ()
    48 clientRecvLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO ()
    50 clientRecvLoop s chan ci = do
    49 clientRecvLoop s chan ci =
    51     msg <- (listenLoop s chan ci >> return "Connection closed") `catch` (return . B.pack . show)
    50     do
    52     clientOff msg
    51         msg <- (listenLoop s chan ci >> return "Connection closed") `catch` (return . B.pack . show)
       
    52         clientOff msg
       
    53     `Exception.finally`
       
    54         remove
    53     where
    55     where
    54         clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg])
    56         clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg])
       
    57         remove = writeChan chan $ Remove ci
    55 
    58 
    56 
    59 
    57 
    60 
    58 clientSendLoop :: Socket -> ThreadId -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO ()
    61 clientSendLoop :: Socket -> ThreadId -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO ()
    59 clientSendLoop s tId cChan chan ci = do
    62 clientSendLoop s tId cChan chan ci = do
    63             sendAll s $ B.unlines answer `B.append` B.singleton '\n'
    66             sendAll s $ B.unlines answer `B.append` B.singleton '\n'
    64 
    67 
    65     if isQuit answer then
    68     if isQuit answer then
    66         do
    69         do
    67         Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s
    70         Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s
    68         killThread tId
    71         Exception.throwTo tId ShutdownThreadException
    69         writeChan cChan $ Remove ci
       
    70         else
    72         else
    71         clientSendLoop s tId cChan chan ci
    73         clientSendLoop s tId cChan chan ci
    72 
    74 
    73     where
    75     where
    74         sendQuit e = do
    76         sendQuit e = do