gameServer/NetRoutines.hs
author dag10 <gottlieb.drew@gmail.com>
Wed, 16 Jan 2013 18:34:43 -0500
changeset 8393 85bd6c7b2641
parent 8372 3c193ec03e09
child 8507 f4475782cf45
permissions -rw-r--r--
Can now change theme for static and mission maps. Fixed mission map descriptions that had commas which broke them. Now, you must escape commas in map descriptions. Made bgwidget repaint on animation tick to avoid buffer-not-clearing issue with widgets that change overtop the background leaving a ghost image of the widget's previous state. Generated map is now the default map in the mapconfig widget.
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Data.Time
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
     7
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
     8
import Data.Unique
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
-----------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import CoreTypes
1917
c94045b70142 - Better ip2string implementation
unc0rr
parents: 1847
diff changeset
    11
import Utils
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    12
import RoomsAndClients
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    14
acceptLoop :: Socket -> Chan CoreMessage -> IO ()
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4918
diff changeset
    15
acceptLoop servSock chan = forever $
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    16
        do
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    17
        (sock, sockAddr) <- Network.Socket.accept servSock
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    19
        clientHost <- sockAddr2String sockAddr
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    21
        currentTime <- getCurrentTime
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    22
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    23
        sendChan' <- newChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
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
    25
        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
    26
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    27
        let newClient =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    28
                (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
    29
                    uid
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    30
                    sendChan'
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    31
                    sock
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    32
                    clientHost
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    33
                    currentTime
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    34
                    ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    35
                    ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    36
                    False
8372
3c193ec03e09 Logon procedure for checkers, introduce invisible clients
unc0rr
parents: 8371
diff changeset
    37
                    False
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    38
                    0
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    39
                    lobbyId
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    40
                    0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    41
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    42
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    43
                    False
7757
c20e6c80e249 Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents: 5209
diff changeset
    44
                    False
8245
d1a830c304c7 Change room name if room admin is kicked
unc0rr
parents: 7766
diff changeset
    45
                    False
8371
0551b5c3de9a - Start work on checker
unc0rr
parents: 8245
diff changeset
    46
                    False
4986
33fe91b2bcbf Use Maybe for storing client's clan, allows less error-prone spectator checks
unc0rr
parents: 4932
diff changeset
    47
                    Nothing
4987
cf9470964dba Use 'undefined' less (replace with default values and 'error')
unc0rr
parents: 4986
diff changeset
    48
                    0
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    49
                    )
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
4905
7842d085acf4 Fix merge :D
unc0rr
parents: 4568
diff changeset
    51
        writeChan chan $ Accept newClient
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    52
        return ()