22 onException io what = io `catch` \e -> do what -- |
22 onException io what = io `catch` \e -> do what -- |
23 throw (e :: Exception) -- |
23 throw (e :: Exception) -- |
24 -- to be deleted -------------------------------------------------- |
24 -- to be deleted -------------------------------------------------- |
25 ------------------------------------------------------------------- |
25 ------------------------------------------------------------------- |
26 |
26 |
|
27 dbQueryString = |
|
28 "SELECT users.pass, users_roles.rid FROM `users`, users_roles " |
|
29 ++ "WHERE users.name = ? AND users_roles.uid = users.uid" |
27 |
30 |
28 dbInteractionLoop queries coreChan dbConn = do |
31 dbInteractionLoop queries coreChan dbConn = do |
29 q <- readChan queries |
32 q <- readChan queries |
30 case q of |
33 case q of |
31 CheckAccount clID name -> do |
34 CheckAccount clID name -> do |
32 statement <- prepare dbConn "SELECT pass FROM users WHERE name=?" |
35 statement <- prepare dbConn dbQueryString |
33 execute statement [SqlString name] |
36 execute statement [SqlString name] |
34 pass <- fetchRow statement |
37 passAndRole <- fetchRow statement |
35 finish statement |
38 finish statement |
36 if isJust pass then |
39 if isJust passAndRole then |
37 writeChan coreChan $ ClientAccountInfo clID (HasAccount $ fromSql $ head $ fromJust $ pass) |
40 writeChan coreChan $ |
|
41 ClientAccountInfo clID $ |
|
42 HasAccount |
|
43 (fromSql $ head $ fromJust $ passAndRole) |
|
44 ((fromSql $ last $ fromJust $ passAndRole) == (3 :: Int)) |
38 else |
45 else |
39 writeChan coreChan $ ClientAccountInfo clID Guest |
46 writeChan coreChan $ ClientAccountInfo clID Guest |
40 `onException` |
47 `onException` |
41 (unGetChan queries $ CheckAccount clID name) |
48 (unGetChan queries $ CheckAccount clID name) |
42 |
|
43 CheckPassword queryStr -> putStrLn queryStr |
|
44 |
49 |
45 dbInteractionLoop queries coreChan dbConn |
50 dbInteractionLoop queries coreChan dbConn |
46 |
51 |
47 dbConnectionLoop serverInfo = do |
52 dbConnectionLoop serverInfo = do |
48 Control.Exception.handle (\e -> infoM "Database" $ show e) $ handleSqlError $ |
53 Control.Exception.handle (\e -> infoM "Database" $ show e) $ handleSqlError $ |