gameServer/OfficialServer/DBInteraction.hs
author unc0rr
Mon, 23 Feb 2009 20:25:07 +0000
changeset 1833 e901ec5644b4
parent 1804 4e78ad846fb6
child 1834 71cb978dc85f
permissions -rw-r--r--
Add options for configuring database access
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module OfficialServer.DBInteraction
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
(
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
	startDBConnection,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
	DBQuery(HasRegistered, CheckPassword)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
) where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Database.HDBC
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Database.HDBC.MySQL
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import System.IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import Control.Concurrent
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Control.Exception
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    12
import Monad
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    13
------------------------
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    14
import CoreTypes
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
dbInteractionLoop queries dbConn = do
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    17
	q <- readChan queries
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
	case q of
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
		HasRegistered queryStr -> putStrLn queryStr
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
		CheckPassword queryStr -> putStrLn queryStr
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
	dbInteractionLoop queries dbConn
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    24
dbConnectionLoop serverInfo = do
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
	Control.Exception.handle (\e -> print e) $ handleSqlError $
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
		bracket
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    27
			(connectMySQL defaultMySQLConnectInfo {mysqlHost = dbHost serverInfo, mysqlDatabase = "hedge_main", mysqlUser = dbLogin serverInfo, mysqlPassword = dbPassword serverInfo })
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
			(disconnect)
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    29
			(dbInteractionLoop $ dbQueries serverInfo)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
	threadDelay (15 * 10^6)
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    32
	dbConnectionLoop serverInfo
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    34
startDBConnection serverInfo =
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1804
diff changeset
    35
	when (not . null $ dbHost serverInfo) ((forkIO $ dbConnectionLoop serverInfo) >> return ())