equal
deleted
inserted
replaced
4 import Network.Socket |
4 import Network.Socket |
5 import Control.Concurrent.Chan |
5 import Control.Concurrent.Chan |
6 import Data.Time |
6 import Data.Time |
7 import Control.Monad |
7 import Control.Monad |
8 import Data.Unique |
8 import Data.Unique |
|
9 import qualified Codec.Binary.Base64 as Base64 |
|
10 import qualified Data.ByteString as BW |
|
11 import qualified Data.ByteString.Char8 as B |
|
12 import qualified Control.Exception as E |
|
13 import System.Entropy |
9 ----------------------------- |
14 ----------------------------- |
10 import CoreTypes |
15 import CoreTypes |
11 import Utils |
16 import Utils |
12 import RoomsAndClients |
17 |
13 |
18 |
14 acceptLoop :: Socket -> Chan CoreMessage -> IO () |
19 acceptLoop :: Socket -> Chan CoreMessage -> IO () |
15 acceptLoop servSock chan = forever $ |
20 acceptLoop servSock chan = E.bracket openHandle closeHandle f |
|
21 where |
|
22 f ch = forever $ |
16 do |
23 do |
17 (sock, sockAddr) <- Network.Socket.accept servSock |
24 (sock, sockAddr) <- Network.Socket.accept servSock |
18 |
25 |
19 clientHost <- sockAddr2String sockAddr |
26 clientHost <- sockAddr2String sockAddr |
20 |
27 |
21 currentTime <- getCurrentTime |
28 currentTime <- getCurrentTime |
22 |
29 |
23 sendChan' <- newChan |
30 sendChan' <- newChan |
24 |
31 |
25 uid <- newUnique |
32 uid <- newUnique |
|
33 salt <- liftM (B.pack . Base64.encode . BW.unpack) $ hGetEntropy ch 16 |
26 |
34 |
27 let newClient = |
35 let newClient = |
28 (ClientInfo |
36 (ClientInfo |
29 uid |
37 uid |
30 sendChan' |
38 sendChan' |
31 sock |
39 sock |
32 clientHost |
40 clientHost |
33 currentTime |
41 currentTime |
34 "" |
42 "" |
35 "" |
43 "" |
|
44 salt |
36 False |
45 False |
37 False |
46 False |
38 0 |
47 0 |
39 0 |
48 0 |
40 False |
49 False |