1 {-# LANGUAGE ScopedTypeVariables #-} |
1 {-# LANGUAGE ScopedTypeVariables #-} |
2 module NetRoutines where |
2 module NetRoutines where |
3 |
3 |
4 import Network |
|
5 import Network.Socket |
4 import Network.Socket |
6 import System.IO |
5 import System.IO |
7 import Control.Concurrent |
|
8 import Control.Concurrent.Chan |
6 import Control.Concurrent.Chan |
9 import Control.Concurrent.STM |
|
10 import qualified Control.Exception as Exception |
7 import qualified Control.Exception as Exception |
11 import Data.Time |
8 import Data.Time |
|
9 import Control.Monad |
12 ----------------------------- |
10 ----------------------------- |
13 import CoreTypes |
11 import CoreTypes |
14 import ClientIO |
|
15 import Utils |
12 import Utils |
16 |
13 |
17 acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO () |
14 acceptLoop :: Socket -> Chan CoreMessage -> IO () |
18 acceptLoop servSock coreChan clientCounter = do |
15 acceptLoop servSock chan = forever $ do |
19 Exception.handle |
16 Exception.handle |
20 (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $ |
17 (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $ |
21 do |
18 do |
22 (socket, sockAddr) <- Network.Socket.accept servSock |
19 (sock, sockAddr) <- Network.Socket.accept servSock |
23 |
20 |
24 cHandle <- socketToHandle socket ReadWriteMode |
21 cHandle <- socketToHandle sock ReadWriteMode |
25 hSetBuffering cHandle LineBuffering |
22 hSetBuffering cHandle LineBuffering |
26 clientHost <- sockAddr2String sockAddr |
23 clientHost <- sockAddr2String sockAddr |
27 |
24 |
28 currentTime <- getCurrentTime |
25 currentTime <- getCurrentTime |
29 |
26 |
30 sendChan <- newChan |
27 sendChan' <- newChan |
31 |
28 |
32 let newClient = |
29 let newClient = |
33 (ClientInfo |
30 (ClientInfo |
34 nextID |
31 sendChan' |
35 sendChan |
|
36 cHandle |
32 cHandle |
37 clientHost |
33 clientHost |
38 currentTime |
34 currentTime |
39 "" |
35 "" |
40 "" |
36 "" |