author | unc0rr |
Fri, 27 Feb 2009 19:51:22 +0000 | |
changeset 1847 | 2178c0fc838c |
parent 1841 | fba7210b438b |
child 1857 | b835395659e2 |
permissions | -rw-r--r-- |
1804 | 1 |
module OfficialServer.DBInteraction |
2 |
( |
|
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
3 |
startDBConnection |
1804 | 4 |
) where |
5 |
||
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
6 |
import Prelude hiding (catch); |
1804 | 7 |
import Database.HDBC |
8 |
import Database.HDBC.MySQL |
|
9 |
import System.IO |
|
10 |
import Control.Concurrent |
|
11 |
import Control.Exception |
|
1833 | 12 |
import Monad |
1834 | 13 |
import Maybe |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
14 |
import System.Log.Logger |
1833 | 15 |
------------------------ |
16 |
import CoreTypes |
|
1804 | 17 |
|
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
18 |
|
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
19 |
------------------------------------------------------------------- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
20 |
-- borrowed from base 4.0.0 --------------------------------------- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
21 |
onException :: IO a -> IO b -> IO a -- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
22 |
onException io what = io `catch` \e -> do what -- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
23 |
throw (e :: Exception) -- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
24 |
-- to be deleted -------------------------------------------------- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
25 |
------------------------------------------------------------------- |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
26 |
|
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
27 |
dbQueryString = |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
28 |
"SELECT users.pass, users_roles.rid FROM `users`, users_roles " |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
29 |
++ "WHERE users.name = ? AND users_roles.uid = users.uid" |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
30 |
|
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
31 |
dbInteractionLoop queries coreChan dbConn = do |
1833 | 32 |
q <- readChan queries |
1804 | 33 |
case q of |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
34 |
CheckAccount clID name -> do |
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
35 |
statement <- prepare dbConn dbQueryString |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
36 |
execute statement [SqlString name] |
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
37 |
passAndRole <- fetchRow statement |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
38 |
finish statement |
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
39 |
if isJust passAndRole then |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
40 |
writeChan coreChan $ |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
41 |
ClientAccountInfo clID $ |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
42 |
HasAccount |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
43 |
(fromSql $ head $ fromJust $ passAndRole) |
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
44 |
((fromSql $ last $ fromJust $ passAndRole) == (3 :: Int)) |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
45 |
else |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
46 |
writeChan coreChan $ ClientAccountInfo clID Guest |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
47 |
`onException` |
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
48 |
(unGetChan queries $ CheckAccount clID name) |
1804 | 49 |
|
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
50 |
dbInteractionLoop queries coreChan dbConn |
1804 | 51 |
|
1833 | 52 |
dbConnectionLoop serverInfo = do |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
53 |
Control.Exception.handle (\e -> infoM "Database" $ show e) $ handleSqlError $ |
1804 | 54 |
bracket |
1833 | 55 |
(connectMySQL defaultMySQLConnectInfo {mysqlHost = dbHost serverInfo, mysqlDatabase = "hedge_main", mysqlUser = dbLogin serverInfo, mysqlPassword = dbPassword serverInfo }) |
1804 | 56 |
(disconnect) |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
57 |
(dbInteractionLoop (dbQueries serverInfo) (coreChan serverInfo)) |
1804 | 58 |
|
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1834
diff
changeset
|
59 |
threadDelay (5 * 10^6) |
1833 | 60 |
dbConnectionLoop serverInfo |
1804 | 61 |
|
1833 | 62 |
startDBConnection serverInfo = |
63 |
when (not . null $ dbHost serverInfo) ((forkIO $ dbConnectionLoop serverInfo) >> return ()) |