gameServer/NetRoutines.hs
author koda
Sat, 05 Jun 2010 14:07:58 +0000
changeset 3495 a6b4f351d400
parent 3435 4e4f88a7bdf2
child 3500 af8390d807d6
permissions -rw-r--r--
now engine can be optionally built as library, there's an example wrapper of how to use it building server is now disabled by default, saves users some headaches
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
2348
b39d826e1ccd Drop support for ghc 6.8, use 6.10 instead
unc0rr
parents: 2296
diff changeset
     1
{-# LANGUAGE ScopedTypeVariables #-}
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 System.IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Control.Concurrent.Chan
2296
19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that)
unc0rr
parents: 2245
diff changeset
     7
import qualified Control.Exception as Exception
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Data.Time
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
     9
import Control.Monad
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
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    14
acceptLoop :: Socket -> Chan CoreMessage -> IO ()
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    15
acceptLoop servSock chan = forever $ do
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    16
    Exception.handle
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    17
        (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    18
        do
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    19
        (sock, sockAddr) <- Network.Socket.accept servSock
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    21
        cHandle <- socketToHandle sock ReadWriteMode
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    22
        hSetBuffering cHandle LineBuffering
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    23
        clientHost <- sockAddr2String sockAddr
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    25
        currentTime <- getCurrentTime
3425
ead2ed20dfd4 Start the server refactoring
unc0rr
parents: 2867
diff changeset
    26
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    27
        sendChan' <- newChan
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    29
        let newClient =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    30
                (ClientInfo
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    31
                    sendChan'
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    32
                    cHandle
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    33
                    clientHost
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    34
                    currentTime
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
                    ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    37
                    False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    38
                    0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    39
                    0
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
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    44
                    undefined
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    45
                    undefined
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    46
                    )
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    47
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    48
        writeChan chan $ Accept newClient
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2403
diff changeset
    49
        return ()