gameServer/NetRoutines.hs
author sheepluva
Sun, 06 Feb 2011 11:39:11 +0100
changeset 4929 3dca560e6510
parent 4918 c6d3aec73f93
child 4932 f11d80bac7ed
permissions -rw-r--r--
I need this export in order to not have the wrapper.c fail to find Game() on linux From this point on compilation and usage of library should work on linux, at least does for me :P
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
     1
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
module NetRoutines where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
import Network.Socket
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import Control.Concurrent.Chan
2296
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2245
diff changeset
     6
import qualified Control.Exception as Exception
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Data.Time
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
     8
import Control.Monad
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4905
diff changeset
     9
import Data.Unique
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
-----------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import CoreTypes
1917
c94045b70142 - Better ip2string implementation
unc0rr
parents: 1847
diff changeset
    12
import Utils
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    13
import RoomsAndClients
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    15
acceptLoop :: Socket -> Chan CoreMessage -> IO ()
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    16
acceptLoop servSock chan = forever $ do
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    17
    Exception.handle
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    18
        (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    19
        do
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    20
        (sock, sockAddr) <- Network.Socket.accept servSock
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    22
        clientHost <- sockAddr2String sockAddr
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    24
        currentTime <- getCurrentTime
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    25
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    26
        sendChan' <- newChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4905
diff changeset
    28
        uid <- newUnique
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4905
diff changeset
    29
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    30
        let newClient =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    31
                (ClientInfo
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4905
diff changeset
    32
                    uid
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    33
                    sendChan'
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    34
                    sock
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    35
                    clientHost
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    36
                    currentTime
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    37
                    ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    38
                    ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    39
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    40
                    0
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    41
                    lobbyId
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    42
                    0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    43
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    44
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    45
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    46
                    undefined
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    47
                    undefined
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    48
                    )
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    50
        writeChan chan $ Accept newClient
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    51
        return ()